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
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");
26 #####################################################################
27 # parse a properties list
28 sub ParseProperties($)
31 foreach my $d (@{$props}) {
32 if (ref($d) ne "HASH") {
35 foreach my $k (keys %{$d}) {
36 $res .= "[$k($d->{$k})] ";
42 #####################################################################
43 # parse a structure element
49 # (defined $elt->{PROPERTIES}) && ParseProperties($elt->{PROPERTIES});
50 # ParseType($elt->{TYPE});
53 # if ($elt->{POINTERS}) {
54 # for (my($i)=0; $i < $elt->{POINTERS}; $i++) {
58 # $res .= "$elt->{NAME}";
59 # (defined $elt->{ARRAY_LEN}) && ($res .= "[$elt->{ARRAY_LEN}]");
63 # Arg is a policy handle
65 foreach my $prop (@{$elt->{PROPERTIES}}) {
66 if ($prop =~ /context_handle/) {
67 $res .= "\toffset = dissect_policy_hnd(tvb, offset, pinfo, tree);\n";
74 if ($flags =~ /scalars/) {
76 # Pointers are scalars
78 if ($elt->{POINTERS}) {
79 $res .= "\t\tptr_$elt->{NAME} = dissect_ptr(tvb, offset, pinfo, tree, \"$elt->{NAME}\");\n";
82 # Simple type are scalars too
84 if (is_scalar_type($elt->{TYPE})) {
85 $res .= "\t\tdissect_$elt->{TYPE}(tvb, offset, pinfo, tree, \"$elt->{NAME}}\");\n\n";
91 # Scalars are not buffers
93 if (!is_scalar_type($elt->{TYPE})) {
95 # If we have a pointer, check it
97 if ($elt->{POINTERS}) {
98 $res .= "\t\tif (ptr_$elt->{NAME}) {\n\t";
101 $res .= "\t\tdissect_$elt->{TYPE}(tvb, offset, pinfo, tree, flags, \"$elt->{NAME}\");\n\n";
103 if ($elt->{POINTERS}) {
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",
116 # if ($flags =~ /buffers/) {
117 # if ($elt->{POINTERS}) {
118 # $res .= "\t\tif (ptr_$elt->{NAME}) {\n\t";
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";
128 #####################################################################
134 if (defined $struct->{ELEMENTS}) {
138 $res .= "\tif (flags & PARSE_SCALARS) {\n";
140 foreach my $e (@{$struct->{ELEMENTS}}) {
141 ParseElement($e, "scalars");
143 # if (defined $e->{POINTERS}) {
144 # $res .= "\t\toffset = dissect_ptr(tvb, offset, pinfo, tree, &ptr_$e->{NAME}, \"$e->{NAME}\");\n";
146 # $res .= "\t\toffset = dissect_$e->{TYPE}(tvb, offset, pinfo, tree, \"$e->{NAME}\");\n";
154 $res .= "\tif (flags & PARSE_BUFFERS) {\n";
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});
167 #####################################################################
168 # parse a union element
169 sub ParseUnionElement($)
171 my($element) = shift;
173 # $res .= "int dissect_$element->{DATA}->{TYPE}()\n{\n";
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";
180 # $res .= "[case($element->{CASE})] ";
181 # ParseElement($element->{DATA});
185 #####################################################################
191 $res .= "\tswitch (level) {\n";
193 (defined $union->{PROPERTIES}) && ParseProperties($union->{PROPERTIES});
194 foreach my $e (@{$union->{DATA}}) {
195 ParseUnionElement($e);
201 #####################################################################
207 if (ref($data) eq "HASH") {
208 ($data->{TYPE} eq "STRUCT") &&
210 ($data->{TYPE} eq "UNION") &&
217 #####################################################################
221 my($typedef) = shift;
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});
229 #####################################################################
231 sub ParseFunctionArg($$)
234 my($io) = shift; # "in" or "out"
236 if (@{$arg->{PROPERTIES}}[0] =~ /$io/) {
239 ParseElement($arg, "scalars");
243 #####################################################################
247 my($function) = shift;
251 $res .= "static int $function->{NAME}_q(tvbuff_t *tvb, int offset,\
252 \tpacket_info *pinfo, proto_tree *tree, char *drep)\n{\n";
254 foreach my $arg (@{$function->{DATA}}) {
255 ParseFunctionArg($arg, "in");
258 $res .= "\n\treturn 0;\n}\n\n";
262 $res .= "static int $function->{NAME}_r(tvbuff_t *tvb, int offset,\
263 \tpacket_info *pinfo, proto_tree *tree, char *drep)\n{\n";
265 foreach my $arg (@{$function->{DATA}}) {
266 ParseFunctionArg($arg, "out");
269 $res .= "\n\toffset = dissect_ntstatus(tvb, offset, pinfo, tree);\n";
271 $res .= "\n\treturn 0;\n}\n\n";
275 #####################################################################
276 # parse the interface definitions
277 sub ParseInterface($)
279 my($interface) = shift;
280 my($data) = $interface->{DATA};
281 foreach my $d (@{$data}) {
282 ($d->{TYPE} eq "TYPEDEF") &&
284 ($d->{TYPE} eq "FUNCTION") &&
290 #####################################################################
291 # parse a parsed IDL structure back into an IDL file
295 $res = "/* parser auto-generated by pidl */\n\n";
296 foreach my $x (@{$idl}) {
297 ($x->{TYPE} eq "INTERFACE") &&