source/build/pidl/eparser.pm

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