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