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 #####################################################################
  14 # parse a properties list
  15 sub ParseProperties($)
  16 {
  17     my($props) = shift;
  18     foreach my $d (@{$props}) {
  19         if (ref($d) ne "HASH") {
  20             $res .= "[$d] ";
  21         } else {
  22             foreach my $k (keys %{$d}) {
  23                 $res .= "[$k($d->{$k})] ";
  24             }
  25         }
  26     }
  27 }
  28
  29 #####################################################################
  30 # parse a structure element
  31 sub ParseElement($)
  32 {
  33     my($element) = shift;
  34     (defined $element->{PROPERTIES}) && ParseProperties($element->{PROPERTIES});
  35     ParseType($element->{TYPE});
  36     $res .= " ";
  37     if ($element->{POINTERS}) {
  38         for (my($i)=0; $i < $element->{POINTERS}; $i++) {
  39             $res .= "*";
  40         }
  41     }
  42     $res .= "$element->{NAME}";
  43     (defined $element->{ARRAY_LEN}) && ($res .= "[$element->{ARRAY_LEN}]");
  44 }
  45
  46 #####################################################################
  47 # parse a struct
  48 sub ParseStruct($)
  49 {
  50     my($struct) = shift;
  51
  52     if (defined $struct->{ELEMENTS}) {
  53
  54         # Parse scalars
  55
  56         $res .= "\t/* Parse scalars */\n\n";
  57
  58         foreach my $e (@{$struct->{ELEMENTS}}) {
  59             if (defined $e->{POINTERS}) {
  60                 $res .= "\toffset = dissect_ptr(tvb, offset, pinfo, tree, &ptr_$e->{NAME}, \"$e->{NAME}\");\n";
  61             } else {
  62                 $res .= "\toffset = dissect_$e->{TYPE}(tvb, offset, pinfo, tree, \"$e->{NAME}\");\n";
  63             }
  64         }
  65
  66         # Parse buffers
  67
  68         $res .= "\n\t/* Parse buffers */\n\n";
  69
  70         foreach my $e (@{$struct->{ELEMENTS}}) {
  71             $res .= "\tif (ptr_$e->{NAME})\n\t\toffset = dissect_$e->{TYPE}(tvb, offset, pinfo, tree, \"$e->{NAME}\");\n\n",
  72             if (defined $e->{POINTERS});
  73         }
  74     }
  75 }
  76
  77
  78 #####################################################################
  79 # parse a union element
  80 sub ParseUnionElement($)
  81 {
  82     my($element) = shift;
  83
  84 #    $res .= "int dissect_$element->{DATA}->{TYPE}()\n{\n";
  85
  86 #    $res .= "}\n\n";
  87
  88     $res .= "\tcase $element->{DATA}->{NAME}: \n";
  89     $res .= "\t\toffset = dissect_$element->{DATA}->{TYPE}(tvb, offset, pinfo, tree, \"$element->{DATA}->{NAME}\");\n\t\tbreak;\n";
  90
  91 #    $res .= "[case($element->{CASE})] ";
  92 #    ParseElement($element->{DATA});
  93 #    $res .= ";\n";
  94 }
  95
  96 #####################################################################
  97 # parse a union
  98 sub ParseUnion($)
  99 {
 100     my($union) = shift;
 101
 102     $res .= "\tswitch (level) {\n";
 103
 104     (defined $union->{PROPERTIES}) && ParseProperties($union->{PROPERTIES});
 105     foreach my $e (@{$union->{DATA}}) {
 106         ParseUnionElement($e);
 107     }
 108
 109     $res .= "\t}\n";
 110 }
 111
 112 #####################################################################
 113 # parse a type
 114 sub ParseType($)
 115 {
 116     my($data) = shift;
 117
 118     if (ref($data) eq "HASH") {
 119         ($data->{TYPE} eq "STRUCT") &&
 120             ParseStruct($data);
 121         ($data->{TYPE} eq "UNION") &&
 122             ParseUnion($data);
 123     } else {
 124         $res .= "$data";
 125     }
 126 }
 127
 128 #####################################################################
 129 # parse a typedef
 130 sub ParseTypedef($)
 131 {
 132     my($typedef) = shift;
 133
 134     $res .= "static int dissect_$typedef->{NAME}(tvbuff_t *tvb, int offset,\
 135 \tpacket_info *pinfo, proto_tree *tree)\n{\n";
 136     ParseType($typedef->{DATA});
 137     $res .= "}\n\n";
 138 }
 139
 140 #####################################################################
 141 # parse a function
 142 sub ParseFunctionArg($$)
 143 {
 144     my($arg) = shift;
 145     my($io) = shift;            # "in" or "out"
 146
 147     if (@{$arg->{PROPERTIES}}[0] =~ /$io/) {
 148         my $is_pol = 0;
 149
 150         # Arg is a policy handle - no pointer
 151
 152         foreach my $prop (@{$arg->{PROPERTIES}}) {
 153             if ($prop =~ /context_handle/) {
 154                 $res .= "\toffset = dissect_policy_hnd(tvb, offset, pinfo, tree, \"policy_hnd\");\n";
 155                 $is_pol = 1;
 156             }
 157         }
 158
 159         if (!$is_pol) {
 160             if ($arg->{POINTERS}) {
 161                 $res .= "\tptr_$arg->{NAME} = dissect_dcerpc_ptr(tvb, offset, pinfo, tree, \"$arg->{NAME}\");\n";
 162                 $res .= "\tif (ptr_$arg->{NAME})\
 163 \t\toffset = dissect_dcerpc_$arg->{TYPE}(tvb, offset, pinfo, tree, \"$arg->{NAME}\");\n\n";
 164             } else {
 165                 $res .= "\toffset = dissect_dcerpc_$arg->{TYPE}(tvb, offset, pinfo, tree, \"$arg->{NAME}\");\n";
 166             }
 167         }
 168     }
 169 }
 170
 171 #####################################################################
 172 # parse a function
 173 sub ParseFunction($)
 174 {
 175     my($function) = shift;
 176
 177     # Input function
 178
 179     $res .= "static int $function->{NAME}_q(tvbuff_t *tvb, int offset,\
 180 \tpacket_info *pinfo, proto_tree *tree)\n{\n";
 181
 182     foreach my $arg (@{$function->{DATA}}) {
 183         ParseFunctionArg($arg, "in");
 184     }
 185
 186     $res .= "\n\treturn 0;\n}\n\n";
 187
 188     # Output function
 189
 190     $res .= "static int $function->{NAME}_r(tvbuff_t *tvb, int offset,\
 191 \tpacket_info *pinfo, proto_tree *tree)\n{\n";
 192
 193     foreach my $arg (@{$function->{DATA}}) {
 194         ParseFunctionArg($arg, "out");
 195     }
 196
 197     $res .= "\n\toffset = dissect_ntstatus(tvb, offset, pinfo, tree, \"status\");\n";
 198
 199     $res .= "\n\treturn 0;\n}\n\n";
 200
 201 }
 202
 203 #####################################################################
 204 # parse the interface definitions
 205 sub ParseInterface($)
 206 {
 207     my($interface) = shift;
 208     my($data) = $interface->{DATA};
 209     foreach my $d (@{$data}) {
 210         ($d->{TYPE} eq "TYPEDEF") &&
 211             ParseTypedef($d);
 212         ($d->{TYPE} eq "FUNCTION") &&
 213             ParseFunction($d);
 214     }
 215 }
 216
 217
 218 #####################################################################
 219 # parse a parsed IDL structure back into an IDL file
 220 sub Parse($)
 221 {
 222     my($idl) = shift;
 223     $res = "/* parser auto-generated by pidl */\n\n";
 224     foreach my $x (@{$idl}) {
 225         ($x->{TYPE} eq "INTERFACE") &&
 226             ParseInterface($x);
 227     }
 228     return $res;
 229 }
 230
 231 1;