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
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"));
24 foreach my $k (keys %{$d}) {
25 return $d->{$k}, if ($k eq $p);
33 #####################################################################
34 # parse a properties list
35 sub ParseProperties
($)
38 foreach my $d (@
{$props}) {
39 if (ref($d) ne "HASH") {
42 foreach my $k (keys %{$d}) {
43 $res .= "[$k($d->{$k})] ";
49 #####################################################################
50 # parse an array - called in buffers context
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";
60 $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, \"PARSE_SCALARS\", \"$elt->{NAME}\");\n";
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";
69 #####################################################################
70 # parse a structure element
76 # Arg is a policy handle
78 if (util
::has_property
($elt, "context_handle")) {
79 $res .= "\toffset = prs_policy_hnd(tvb, offset, pinfo, tree);\n";
85 if ($flags =~ /scalars/) {
87 # Pointers are scalars
89 if ($elt->{POINTERS
}) {
90 $res .= "\t\toffset = prs_ptr(tvb, offset, pinfo, tree, &ptr_$elt->{NAME}, \"$elt->{NAME}\");\n";
93 # Simple type are scalars too
95 if (util
::is_scalar_type
($elt->{TYPE
})) {
96 $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, NULL, \"$elt->{NAME}\");\n\n";
102 if ($flags =~ /buffers/) {
104 # Scalars are not buffers, except if they are pointed to
106 if (!util
::is_scalar_type
($elt->{TYPE
}) || $elt->{POINTERS
}) {
108 # If we have a pointer, check it
110 if ($elt->{POINTERS
}) {
111 $res .= "\t\tif (ptr_$elt->{NAME})\n\t";
114 if (util
::has_property
($elt, "size_is")) {
117 $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, ";
118 if (util
::is_scalar_type
($elt->{TYPE
})) {
123 $res .= "\"$elt->{NAME}\");\n\n";
131 #####################################################################
137 if (defined $struct->{ELEMENTS
}) {
141 $res .= "\tif (flags & PARSE_SCALARS) {\n";
143 foreach my $e (@
{$struct->{ELEMENTS
}}) {
144 ParseElement
($e, "scalars");
151 $res .= "\tif (flags & PARSE_BUFFERS) {\n";
153 foreach my $e (@
{$struct->{ELEMENTS
}}) {
154 ParseElement
($e, "buffers");
162 #####################################################################
163 # parse a union element
164 sub ParseUnionElement
($)
166 my($element) = shift;
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";
173 #####################################################################
179 $res .= "\tswitch (level) {\n";
181 (defined $union->{PROPERTIES
}) && ParseProperties
($union->{PROPERTIES
});
182 foreach my $e (@
{$union->{DATA
}}) {
183 ParseUnionElement
($e);
189 #####################################################################
195 if (ref($data) eq "HASH") {
196 ($data->{TYPE
} eq "STRUCT") &&
198 ($data->{TYPE
} eq "UNION") &&
205 #####################################################################
209 my($typedef) = shift;
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";
218 #####################################################################
220 sub ParseFunctionArg
($$)
223 my($io) = shift; # "in" or "out"
225 if (util
::has_property
($arg, $io)) {
227 # For some reason, pointers to elements in function definitions
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);
235 ParseElement
($arg, "scalars|buffers");
239 #####################################################################
243 my($function) = shift;
247 $res .= "static int $function->{NAME}_q(tvbuff_t *tvb, int offset,\
248 \tpacket_info *pinfo, proto_tree *tree, char *drep)\n{\n";
250 foreach my $arg (@
{$function->{DATA
}}) {
251 ParseFunctionArg
($arg, "in");
254 $res .= "\n\treturn offset;\n}\n\n";
258 $res .= "static int $function->{NAME}_r(tvbuff_t *tvb, int offset,\
259 \tpacket_info *pinfo, proto_tree *tree, char *drep)\n{\n";
261 foreach my $arg (@
{$function->{DATA
}}) {
262 ParseFunctionArg
($arg, "out");
265 $res .= "\n\toffset = prs_ntstatus(tvb, offset, pinfo, tree);\n";
267 $res .= "\n\treturn offset;\n}\n\n";
271 #####################################################################
272 # parse the interface definitions
273 sub ParseInterface
($)
275 my($interface) = shift;
276 my($data) = $interface->{DATA
};
277 foreach my $d (@
{$data}) {
278 ($d->{TYPE
} eq "TYPEDEF") &&
280 ($d->{TYPE
} eq "FUNCTION") &&
286 #####################################################################
287 # parse a parsed IDL structure back into an IDL file
291 $res = "/* parser auto-generated by pidl */\n\n";
292 foreach my $x (@
{$idl}) {
293 ($x->{TYPE
} eq "INTERFACE") &&