source4/build/pidl/eparser.pm

   1 ###################################################
   2 # Ethereal parser generator for IDL structures
   3 # Copyright tpot@samba.org 2001
   4 # Copyright tridge@samba.org 2000
   5 # released under the GNU GPL
   6
   7 package IdlEParser;
   8
   9 use Data::Dumper;
  10
  11 my($res);
  12
  13 sub is_scalar_type($)
  14 {
  15     my($type) = shift;
  16
  17     return 1, if ($type eq "uint32");
  18     return 1, if ($type eq "long");
  19     return 1, if ($type eq "short");
  20     return 1, if ($type eq "char");
  21     return 1, if ($type eq "uint16");
  22     return 1, if ($type eq "hyper");
  23
  24     return 0;
  25 }
  26
  27 #####################################################################
  28 # parse a properties list
  29 sub ParseProperties($)
  30 {
  31     my($props) = shift;
  32     foreach my $d (@{$props}) {
  33         if (ref($d) ne "HASH") {
  34             $res .= "[$d] ";
  35         } else {
  36             foreach my $k (keys %{$d}) {
  37                 $res .= "[$k($d->{$k})] ";
  38             }
  39         }
  40     }
  41 }
  42
  43 #####################################################################
  44 # parse a structure element
  45 sub ParseElement($$)
  46 {
  47     my($elt) = shift;
  48     my($flags) = shift;
  49
  50 #    (defined $elt->{PROPERTIES}) && ParseProperties($elt->{PROPERTIES});
  51 #    ParseType($elt->{TYPE});
  52
  53 #    $res .= "/* ";
  54 #    if ($elt->{POINTERS}) {
  55 #       for (my($i)=0; $i < $elt->{POINTERS}; $i++) {
  56 #           $res .= "*";
  57 #       }
  58 #    }
  59 #    $res .= "$elt->{NAME}";
  60 #    (defined $elt->{ARRAY_LEN}) && ($res .= "[$elt->{ARRAY_LEN}]");
  61
  62 #    $res .= "*/\n\n";
  63
  64     # Arg is a policy handle
  65
  66     foreach my $prop (@{$elt->{PROPERTIES}}) {
  67         if ($prop =~ /context_handle/) {
  68             $res .= "\toffset = prs_policy_hnd(tvb, offset, pinfo, tree);\n";
  69             return;
  70         }
  71     }
  72
  73     # Parse type
  74
  75     if ($flags =~ /scalars/) {
  76
  77         # Pointers are scalars
  78
  79         if ($elt->{POINTERS}) {
  80             $res .= "\t\tptr_$elt->{NAME} = prs_ptr(tvb, offset, pinfo, tree, \"$elt->{NAME}\");\n";
  81         } else {
  82
  83             # Simple type are scalars too
  84
  85             if (is_scalar_type($elt->{TYPE})) {
  86                 $res .= "\t\tprs_$elt->{TYPE}(tvb, offset, pinfo, tree, \"$elt->{NAME}}\");\n\n";
  87             }
  88         }
  89
  90     } else {
  91
  92         # Scalars are not buffers
  93
  94         if (!is_scalar_type($elt->{TYPE})) {
  95
  96             # If we have a pointer, check it
  97
  98             if ($elt->{POINTERS}) {
  99                 $res .= "\t\tif (ptr_$elt->{NAME}) {\n\t";
 100             }
 101
 102             $res .= "\t\tprs_$elt->{TYPE}(tvb, offset, pinfo, tree, flags, \"$elt->{NAME}\");\n\n";
 103
 104             if ($elt->{POINTERS}) {
 105                 $res .= "\t\t}\n\n";
 106             }
 107         }
 108     }
 109
 110     return;
 111
 112 #    if (is_simple_type($elt->{TYPE})) {
 113 #       if ($flags =~ /scalars/ && !$elt->{POINTERS}) {
 114 #           $res .= "\t\tprs_$elt->{TYPE}(tvb, offset, pinfo, tree, \"$elt->{NAME}}\");\n\n",
 115 #       }
 116 #    } else {
 117 #       if ($flags =~ /buffers/) {
 118 #           if ($elt->{POINTERS}) {
 119 #               $res .= "\t\tif (ptr_$elt->{NAME}) {\n\t";
 120 #           }
 121 #           $res .= "\t\tprs_$elt->{TYPE}(tvb, offset, pinfo, tree, flags, \"$elt->{NAME}\");\n\n";
 122 #           if ($elt->{POINTERS}) {
 123 #               $res .= "\t\t}\n\n";
 124 #           }
 125 #       }
 126 #    }
 127 }
 128
 129 #####################################################################
 130 # parse a struct
 131 sub ParseStruct($)
 132 {
 133     my($struct) = shift;
 134
 135     if (defined $struct->{ELEMENTS}) {
 136
 137         # Parse scalars
 138
 139         $res .= "\tif (flags & PARSE_SCALARS) {\n";
 140
 141         foreach my $e (@{$struct->{ELEMENTS}}) {
 142             ParseElement($e, "scalars");
 143
 144 #           if (defined $e->{POINTERS}) {
 145 #               $res .= "\t\toffset = prs_ptr(tvb, offset, pinfo, tree, &ptr_$e->{NAME}, \"$e->{NAME}\");\n";
 146 #           } else {
 147 #               $res .= "\t\toffset = prs_$e->{TYPE}(tvb, offset, pinfo, tree, \"$e->{NAME}\");\n";
 148 #           }
 149         }
 150
 151         $res .= "\t}\n\n";
 152
 153         # Parse buffers
 154
 155         $res .= "\tif (flags & PARSE_BUFFERS) {\n";
 156
 157         foreach my $e (@{$struct->{ELEMENTS}}) {
 158             ParseElement($e, "buffers");
 159 #           $res .= "\t\tif (ptr_$e->{NAME})\n\t\t\toffset = prs_$e->{TYPE}(tvb, offset, pinfo, tree, \"$e->{NAME}\");\n\n",
 160 #           if (defined $e->{POINTERS});
 161         }
 162
 163         $res .= "\t}\n\n";
 164     }
 165 }
 166
 167
 168 #####################################################################
 169 # parse a union element
 170 sub ParseUnionElement($)
 171 {
 172     my($element) = shift;
 173
 174 #    $res .= "int prs_$element->{DATA}->{TYPE}()\n{\n";
 175
 176 #    $res .= "}\n\n";
 177
 178     $res .= "\tcase $element->{DATA}->{NAME}: \n";
 179     $res .= "\t\toffset = prs_$element->{DATA}->{TYPE}(tvb, offset, pinfo, tree, \"$element->{DATA}->{NAME}\");\n\t\tbreak;\n";
 180
 181 #    $res .= "[case($element->{CASE})] ";
 182 #    ParseElement($element->{DATA});
 183 #    $res .= ";\n";
 184 }
 185
 186 #####################################################################
 187 # parse a union
 188 sub ParseUnion($)
 189 {
 190     my($union) = shift;
 191
 192     $res .= "\tswitch (level) {\n";
 193
 194     (defined $union->{PROPERTIES}) && ParseProperties($union->{PROPERTIES});
 195     foreach my $e (@{$union->{DATA}}) {
 196         ParseUnionElement($e);
 197     }
 198
 199     $res .= "\t}\n";
 200 }
 201
 202 #####################################################################
 203 # parse a type
 204 sub ParseType($)
 205 {
 206     my($data) = shift;
 207
 208     if (ref($data) eq "HASH") {
 209         ($data->{TYPE} eq "STRUCT") &&
 210             ParseStruct($data);
 211         ($data->{TYPE} eq "UNION") &&
 212             ParseUnion($data);
 213     } else {
 214         $res .= "$data";
 215     }
 216 }
 217
 218 #####################################################################
 219 # parse a typedef
 220 sub ParseTypedef($)
 221 {
 222     my($typedef) = shift;
 223
 224     $res .= "static int prs_$typedef->{NAME}(tvbuff_t *tvb, int offset,\
 225 \tpacket_info *pinfo, proto_tree *tree)\n{\n";
 226     ParseType($typedef->{DATA});
 227     $res .= "}\n\n";
 228 }
 229
 230 #####################################################################
 231 # parse a function
 232 sub ParseFunctionArg($$)
 233 {
 234     my($arg) = shift;
 235     my($io) = shift;            # "in" or "out"
 236
 237     if (@{$arg->{PROPERTIES}}[0] =~ /$io/) {
 238         my $is_pol = 0;
 239
 240         ParseElement($arg, "scalars");
 241     }
 242 }
 243
 244 #####################################################################
 245 # parse a function
 246 sub ParseFunction($)
 247 {
 248     my($function) = shift;
 249
 250     # Input function
 251
 252     $res .= "static int $function->{NAME}_q(tvbuff_t *tvb, int offset,\
 253 \tpacket_info *pinfo, proto_tree *tree, char *drep)\n{\n";
 254
 255     foreach my $arg (@{$function->{DATA}}) {
 256         ParseFunctionArg($arg, "in");
 257     }
 258
 259     $res .= "\n\treturn 0;\n}\n\n";
 260
 261     # Output function
 262
 263     $res .= "static int $function->{NAME}_r(tvbuff_t *tvb, int offset,\
 264 \tpacket_info *pinfo, proto_tree *tree, char *drep)\n{\n";
 265
 266     foreach my $arg (@{$function->{DATA}}) {
 267         ParseFunctionArg($arg, "out");
 268     }
 269
 270     $res .= "\n\toffset = prs_ntstatus(tvb, offset, pinfo, tree);\n";
 271
 272     $res .= "\n\treturn 0;\n}\n\n";
 273
 274 }
 275
 276 #####################################################################
 277 # parse the interface definitions
 278 sub ParseInterface($)
 279 {
 280     my($interface) = shift;
 281     my($data) = $interface->{DATA};
 282     foreach my $d (@{$data}) {
 283         ($d->{TYPE} eq "TYPEDEF") &&
 284             ParseTypedef($d);
 285         ($d->{TYPE} eq "FUNCTION") &&
 286             ParseFunction($d);
 287     }
 288 }
 289
 290
 291 #####################################################################
 292 # parse a parsed IDL structure back into an IDL file
 293 sub Parse($)
 294 {
 295     my($idl) = shift;
 296     $res = "/* parser auto-generated by pidl */\n\n";
 297     foreach my $x (@{$idl}) {
 298         ($x->{TYPE} eq "INTERFACE") &&
 299             ParseInterface($x);
 300     }
 301     return $res;
 302 }
 303
 304 1;