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