Added "return offset;" to end of generated function.
[kai/samba-autobuild/.git] / 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_scalar_type($)
14 {
15     my($type) = shift;
16
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");
23     return 1, if ($type eq "wchar_t");
24
25     return 0;
26 }
27
28 sub has_property($$)
29 {
30     my($props) = shift;
31     my($p) = shift;
32
33     foreach my $d (@{$props}) {
34         if (ref($d) ne "HASH") {
35             return 1, if ($d eq $p);
36             return 1, if ($d eq "in,out" && ($p eq "in" || $p eq "out"));
37         } else {
38             foreach my $k (keys %{$d}) {
39                 return $d->{$k}, if ($k eq $p);
40             }
41         }
42     }
43
44     return 0;
45 }
46
47 #####################################################################
48 # parse a properties list
49 sub ParseProperties($)
50 {
51     my($props) = shift;
52     foreach my $d (@{$props}) {
53         if (ref($d) ne "HASH") {
54             $res .= "[$d] ";
55         } else {
56             foreach my $k (keys %{$d}) {
57                 $res .= "[$k($d->{$k})] ";
58             }
59         }
60     }
61 }
62
63 #####################################################################
64 # parse an array - called in buffers context
65 sub ParseArray($)
66 {
67     my($elt) = shift;
68
69     $res .= "\tfor (i = 0; i < count; i++) {\n";
70     if (is_scalar_type($elt)) {
71         $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, NULL, \"$elt->{NAME});\n";
72         $res .= "\t}\n\n";
73     } else {
74         $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, \"PARSE_SCALARS\", \"$elt->{NAME}\");\n";
75         $res .= "\t}\n\n";
76
77         $res .= "\tfor (i = 0; i < count; i++) {\n";
78         $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, \"PARSE_BUFFERS\", \"$elt->{NAME}\");\n";
79         $res .= "\t}\n\n";
80     }
81 }
82
83 #####################################################################
84 # parse a structure element
85 sub ParseElement($$)
86 {
87     my($elt) = shift;
88     my($flags) = shift;
89
90     # Arg is a policy handle
91             
92     if (has_property($elt->{PROPERTIES}, "context_handle")) {
93         $res .= "\toffset = prs_policy_hnd(tvb, offset, pinfo, tree);\n";
94         return;
95     }
96
97     # Parse type
98
99     if ($flags =~ /scalars/) {
100
101         # Pointers are scalars
102
103         if ($elt->{POINTERS}) {
104             $res .= "\t\toffset = prs_ptr(tvb, offset, pinfo, tree, &ptr_$elt->{NAME}, \"$elt->{NAME}\");\n";
105         } else {
106
107             # Simple type are scalars too
108
109             if (is_scalar_type($elt->{TYPE})) {
110                 $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, NULL, \"$elt->{NAME}\");\n\n";
111             }
112         }
113
114     }
115
116     if ($flags =~ /buffers/) {
117
118         # Scalars are not buffers, except if they are pointed to
119
120         if (!is_scalar_type($elt->{TYPE}) || $elt->{POINTERS}) {
121
122             # If we have a pointer, check it
123
124             if ($elt->{POINTERS}) {
125                 $res .= "\t\tif (ptr_$elt->{NAME})\n\t";
126             }
127             
128             if (has_property($elt->{PROPERTIES}, "size_is")) {
129                 ParseArray($elt);
130             } else {
131                 $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, ";
132                 if (is_scalar_type($elt->{TYPE})) {
133                     $res .= "NULL, ";
134                 } else {
135                     $res .= "flags, ";
136                 }
137                 $res .= "\"$elt->{NAME}\");\n\n";
138             }
139         }
140     }
141
142     return;
143 }
144
145 #####################################################################
146 # parse a struct
147 sub ParseStruct($)
148 {
149     my($struct) = shift;
150
151     if (defined $struct->{ELEMENTS}) {
152
153         # Parse scalars
154
155         $res .= "\tif (flags & PARSE_SCALARS) {\n";
156
157         foreach my $e (@{$struct->{ELEMENTS}}) {
158             ParseElement($e, "scalars");
159         }       
160
161         $res .= "\t}\n\n";
162
163         # Parse buffers
164
165         $res .= "\tif (flags & PARSE_BUFFERS) {\n";
166
167         foreach my $e (@{$struct->{ELEMENTS}}) {
168             ParseElement($e, "buffers");
169         }
170
171         $res .= "\t}\n\n";
172     }
173 }
174
175
176 #####################################################################
177 # parse a union element
178 sub ParseUnionElement($)
179 {
180     my($element) = shift;
181     
182     $res .= "\tcase $element->{DATA}->{NAME}: \n";
183     $res .= "\t\toffset = prs_$element->{DATA}->{TYPE}(tvb, offset, pinfo, tree, \"$element->{DATA}->{NAME}\");\n\t\tbreak;\n";
184
185 }
186
187 #####################################################################
188 # parse a union
189 sub ParseUnion($)
190 {
191     my($union) = shift;
192
193     $res .= "\tswitch (level) {\n";
194
195     (defined $union->{PROPERTIES}) && ParseProperties($union->{PROPERTIES});
196     foreach my $e (@{$union->{DATA}}) {
197         ParseUnionElement($e);
198     }
199     
200     $res .= "\t}\n";
201 }
202
203 #####################################################################
204 # parse a type
205 sub ParseType($)
206 {
207     my($data) = shift;
208
209     if (ref($data) eq "HASH") {
210         ($data->{TYPE} eq "STRUCT") &&
211             ParseStruct($data);
212         ($data->{TYPE} eq "UNION") &&
213             ParseUnion($data);
214     } else {
215         $res .= "$data";
216     }
217 }
218
219 #####################################################################
220 # parse a typedef
221 sub ParseTypedef($)
222 {
223     my($typedef) = shift;
224
225     $res .= "static int prs_$typedef->{NAME}(tvbuff_t *tvb, int offset,\
226 \tpacket_info *pinfo, proto_tree *tree, int flags, char *name)\n{\n";
227     ParseType($typedef->{DATA});
228     $res .= "\treturn offset;\n";
229     $res .= "}\n\n";
230 }
231
232 #####################################################################
233 # parse a function
234 sub ParseFunctionArg($$)
235
236     my($arg) = shift;
237     my($io) = shift;            # "in" or "out"
238
239     if (has_property($arg->{PROPERTIES}, $io)) {
240
241         # For some reason, pointers to elements in function definitions
242         # aren't parsed.
243
244         if (defined($arg->{POINTERS}) && !is_scalar_type($arg->{TYPE})) {
245             $arg->{POINTERS} -= 1, if ($arg->{POINTERS} > 0);
246             delete($arg->{POINTERS}), if ($arg->{POINTERS} == 0);
247         }
248
249         ParseElement($arg, "scalars|buffers");
250     }
251 }
252     
253 #####################################################################
254 # parse a function
255 sub ParseFunction($)
256
257     my($function) = shift;
258
259     # Input function
260
261     $res .= "static int $function->{NAME}_q(tvbuff_t *tvb, int offset,\
262 \tpacket_info *pinfo, proto_tree *tree, char *drep)\n{\n";
263
264     foreach my $arg (@{$function->{DATA}}) {
265         ParseFunctionArg($arg, "in");
266     }
267     
268     $res .= "\n\treturn offset;\n}\n\n";
269     
270     # Output function
271
272     $res .= "static int $function->{NAME}_r(tvbuff_t *tvb, int offset,\
273 \tpacket_info *pinfo, proto_tree *tree, char *drep)\n{\n";
274
275     foreach my $arg (@{$function->{DATA}}) {
276         ParseFunctionArg($arg, "out");
277     }
278
279     $res .= "\n\toffset = prs_ntstatus(tvb, offset, pinfo, tree);\n";
280
281     $res .= "\n\treturn offset;\n}\n\n";
282
283 }
284
285 #####################################################################
286 # parse the interface definitions
287 sub ParseInterface($)
288 {
289     my($interface) = shift;
290     my($data) = $interface->{DATA};
291     foreach my $d (@{$data}) {
292         ($d->{TYPE} eq "TYPEDEF") &&
293             ParseTypedef($d);
294         ($d->{TYPE} eq "FUNCTION") && 
295             ParseFunction($d);
296     }
297 }
298
299
300 #####################################################################
301 # parse a parsed IDL structure back into an IDL file
302 sub Parse($)
303 {
304     my($idl) = shift;
305     $res = "/* parser auto-generated by pidl */\n\n";
306     foreach my $x (@{$idl}) {
307         ($x->{TYPE} eq "INTERFACE") && 
308             ParseInterface($x);
309     }
310     return $res;
311 }
312
313 1;