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");
22 return 1, if ($type eq "hyper");
32 foreach my $d (@{$props}) {
33 if (ref($d) ne "HASH") {
34 return 1, if ($d eq $p);
35 return 1, if ($d eq "in,out" && ($p eq "in" || $p eq "out"));
37 foreach my $k (keys %{$d}) {
38 return $d->{$k}, if ($k eq $p);
46 #####################################################################
47 # parse a properties list
48 sub ParseProperties($)
51 foreach my $d (@{$props}) {
52 if (ref($d) ne "HASH") {
55 foreach my $k (keys %{$d}) {
56 $res .= "[$k($d->{$k})] ";
62 #####################################################################
63 # parse an array - called in buffers context
68 $res .= "\tfor (i = 0; i < count; i++) {\n";
69 if (is_scalar_type($elt)) {
70 $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, \"$elt->{NAME});\n";
73 $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, \"PARSE_SCALARS\", \"$elt->{NAME}\");\n";
76 $res .= "\tfor (i = 0; i < count; i++) {\n";
77 $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, \"PARSE_BUFFERS\", \"$elt->{NAME}\");\n";
82 #####################################################################
83 # parse a structure element
89 # Arg is a policy handle
91 if (has_property($elt->{PROPERTIES}, "context_handle")) {
92 $res .= "\toffset = prs_policy_hnd(tvb, offset, pinfo, tree);\n";
98 if ($flags =~ /scalars/) {
100 # Pointers are scalars
102 if ($elt->{POINTERS}) {
103 $res .= "\t\toffset = prs_ptr(tvb, offset, pinfo, tree, &ptr_$elt->{NAME}, \"$elt->{NAME}\");\n";
106 # Simple type are scalars too
108 if (is_scalar_type($elt->{TYPE})) {
109 $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, \"$elt->{NAME}}\");\n\n";
115 if ($flags =~ /buffers/) {
117 # Scalars are not buffers, except if they are pointed to
119 if (!is_scalar_type($elt->{TYPE}) || $elt->{POINTERS}) {
121 # If we have a pointer, check it
123 if ($elt->{POINTERS}) {
124 $res .= "\t\tif (ptr_$elt->{NAME}) {\n\t";
127 if (has_property($elt->{PROPERTIES}, "size_is")) {
130 $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, flags, \"$elt->{NAME}\");\n\n";
133 if ($elt->{POINTERS}) {
142 #####################################################################
148 if (defined $struct->{ELEMENTS}) {
152 $res .= "\tif (flags & PARSE_SCALARS) {\n";
154 foreach my $e (@{$struct->{ELEMENTS}}) {
155 ParseElement($e, "scalars");
162 $res .= "\tif (flags & PARSE_BUFFERS) {\n";
164 foreach my $e (@{$struct->{ELEMENTS}}) {
165 ParseElement($e, "buffers");
173 #####################################################################
174 # parse a union element
175 sub ParseUnionElement($)
177 my($element) = shift;
179 $res .= "\tcase $element->{DATA}->{NAME}: \n";
180 $res .= "\t\toffset = prs_$element->{DATA}->{TYPE}(tvb, offset, pinfo, tree, \"$element->{DATA}->{NAME}\");\n\t\tbreak;\n";
184 #####################################################################
190 $res .= "\tswitch (level) {\n";
192 (defined $union->{PROPERTIES}) && ParseProperties($union->{PROPERTIES});
193 foreach my $e (@{$union->{DATA}}) {
194 ParseUnionElement($e);
200 #####################################################################
206 if (ref($data) eq "HASH") {
207 ($data->{TYPE} eq "STRUCT") &&
209 ($data->{TYPE} eq "UNION") &&
216 #####################################################################
220 my($typedef) = shift;
222 $res .= "static int prs_$typedef->{NAME}(tvbuff_t *tvb, int offset,\
223 \tpacket_info *pinfo, proto_tree *tree)\n{\n";
224 ParseType($typedef->{DATA});
228 #####################################################################
230 sub ParseFunctionArg($$)
233 my($io) = shift; # "in" or "out"
235 if (has_property($arg->{PROPERTIES}, $io)) {
236 ParseElement($arg, "scalars|buffers");
240 #####################################################################
244 my($function) = shift;
248 $res .= "static int $function->{NAME}_q(tvbuff_t *tvb, int offset,\
249 \tpacket_info *pinfo, proto_tree *tree, char *drep)\n{\n";
251 foreach my $arg (@{$function->{DATA}}) {
252 ParseFunctionArg($arg, "in");
255 $res .= "\n\treturn offset;\n}\n\n";
259 $res .= "static int $function->{NAME}_r(tvbuff_t *tvb, int offset,\
260 \tpacket_info *pinfo, proto_tree *tree, char *drep)\n{\n";
262 foreach my $arg (@{$function->{DATA}}) {
263 ParseFunctionArg($arg, "out");
266 $res .= "\n\toffset = prs_ntstatus(tvb, offset, pinfo, tree);\n";
268 $res .= "\n\treturn offset;\n}\n\n";
272 #####################################################################
273 # parse the interface definitions
274 sub ParseInterface($)
276 my($interface) = shift;
277 my($data) = $interface->{DATA};
278 foreach my $d (@{$data}) {
279 ($d->{TYPE} eq "TYPEDEF") &&
281 ($d->{TYPE} eq "FUNCTION") &&
287 #####################################################################
288 # parse a parsed IDL structure back into an IDL file
292 $res = "/* parser auto-generated by pidl */\n\n";
293 foreach my $x (@{$idl}) {
294 ($x->{TYPE} eq "INTERFACE") &&