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