r1767: Checkin of workarea. Sorry Jelmer but this overwrites some of your changes
[samba.git] / source4 / build / pidl / eparser.pm
1 ###################################################
2 # Samba4 parser generator for IDL structures
3 # Copyright tridge@samba.org 2000-2003
4 # Copyright tpot@samba.org 2001,2004
5 # released under the GNU GPL
6
7 package IdlEParser;
8
9 use strict;
10
11 # the list of needed functions
12 my %needed;
13 my %structs;
14
15 my $module;
16 my $if_uuid;
17 my $if_version;
18 my $if_endpoints;
19
20 sub pidl($)
21 {
22         print OUT shift;
23 }
24
25 #####################################################################
26 # parse a properties list
27 sub ParseProperties($)
28 {
29     my($props) = shift;
30     foreach my $d (@{$props}) {
31         if (ref($d) ne "HASH") {
32             pidl "[$d] ";
33         } else {
34             foreach my $k (keys %{$d}) {
35                 pidl "[$k($d->{$k})] ";
36             }
37         }
38     }
39 }
40
41 ###################################
42 # find a sibling var in a structure
43 sub find_sibling($$)
44 {
45         my($e) = shift;
46         my($name) = shift;
47         my($fn) = $e->{PARENT};
48
49         if ($name =~ /\*(.*)/) {
50                 $name = $1;
51         }
52
53         if ($fn->{TYPE} eq "FUNCTION") {
54                 for my $e2 (@{$fn->{DATA}}) {
55                         if ($e2->{NAME} eq $name) {
56                                 return $e2;
57                         }
58                 }
59         }
60
61         for my $e2 (@{$fn->{ELEMENTS}}) {
62                 if ($e2->{NAME} eq $name) {
63                         return $e2;
64                 }
65         }
66         die "invalid sibling '$name'";
67 }
68
69 ####################################################################
70 # work out the name of a size_is() variable
71 sub find_size_var($$$)
72 {
73         my($e) = shift;
74         my($size) = shift;
75         my($var_prefix) = shift;
76
77         my($fn) = $e->{PARENT};
78
79         if (util::is_constant($size)) {
80                 return $size;
81         }
82
83         if ($size =~ /ndr->|\(/) {
84                 return $size;
85         }
86
87         my $prefix = "";
88
89         if ($size =~ /\*(.*)/) {
90                 $size = $1;
91                 $prefix = "*";
92         }
93
94         if ($fn->{TYPE} ne "FUNCTION") {
95                 return $prefix . "r->$size";
96         }
97
98         my $e2 = find_sibling($e, $size);
99
100         if (util::has_property($e2, "in") && util::has_property($e2, "out")) {
101                 return $prefix . "$var_prefix$size";
102         }
103         if (util::has_property($e2, "in")) {
104                 return $prefix . "r->in.$size";
105         }
106         if (util::has_property($e2, "out")) {
107                 return $prefix . "r->out.$size";
108         }
109
110         die "invalid variable in $size for element $e->{NAME} in $fn->{NAME}\n";
111 }
112
113
114 #####################################################################
115 # work out is a parse function should be declared static or not
116 sub fn_prefix($)
117 {
118         my $fn = shift;
119         if ($fn->{TYPE} eq "TYPEDEF") {
120                 if (util::has_property($fn->{DATA}, "public")) {
121                         return "";
122                 }
123         }
124
125         if ($fn->{TYPE} eq "FUNCTION") {
126                 if (util::has_property($fn, "public")) {
127                         return "";
128                 }
129         }
130         return "static ";
131 }
132
133
134 ###################################################################
135 # setup any special flags for an element or structure
136 sub start_flags($)
137 {
138         my $e = shift;
139         my $flags = util::has_property($e, "flag");
140         if (defined $flags) {
141                 pidl "\t{ guint32 _flags_save_$e->{TYPE} = ndr->flags;\n";
142                 pidl "\tndr->flags |= $flags;\n";
143         }
144 }
145
146 ###################################################################
147 # end any special flags for an element or structure
148 sub end_flags($)
149 {
150         my $e = shift;
151         my $flags = util::has_property($e, "flag");
152         if (defined $flags) {
153                 pidl "\tndr->flags = _flags_save_$e->{TYPE};\n\t}\n";
154         }
155 }
156
157
158 #####################################################################
159 # work out the correct alignment for a structure
160 sub struct_alignment
161 {
162         my $s = shift;
163
164         my $align = 1;
165         for my $e (@{$s->{ELEMENTS}}) {
166                 my $a = 1;
167
168                 if (!util::need_wire_pointer($e)
169                     && defined $structs{$e->{TYPE}}) {
170                         if ($structs{$e->{TYPE}}->{DATA}->{TYPE} eq "STRUCT") {
171                                 $a = struct_alignment($structs{$e->{TYPE}}->{DATA});
172                         } elsif ($structs{$e->{TYPE}}->{DATA}->{TYPE} eq "UNION") {
173                                 if (defined $structs{$e->{TYPE}}->{DATA}) {
174                                         $a = union_alignment($structs{$e->{TYPE}}->{DATA});
175                                 }
176                         }
177                 } else {
178                         $a = util::type_align($e);
179                 }
180
181                 if ($align < $a) {
182                         $align = $a;
183                 }
184         }
185
186         return $align;
187 }
188
189 #####################################################################
190 # work out the correct alignment for a union
191 sub union_alignment
192 {
193         my $u = shift;
194
195         my $align = 1;
196
197         foreach my $e (@{$u->{DATA}}) {
198                 my $a = 1;
199
200                 if ($e->{TYPE} eq "EMPTY") {
201                         next;
202                 }
203
204                 if (!util::need_wire_pointer($e)
205                     && defined $structs{$e->{DATA}->{TYPE}}) {
206                         my $s = $structs{$e->{DATA}->{TYPE}};
207                         if ($s->{DATA}->{TYPE} eq "STRUCT") {
208                                 $a = struct_alignment($s->{DATA});
209                         } elsif ($s->{DATA}->{TYPE} eq "UNION") {
210                                 $a = union_alignment($s->{DATA});
211                         }
212                 } else {
213                         $a = util::type_align($e->{DATA});
214                 }
215
216                 if ($align < $a) {
217                         $align = $a;
218                 }
219         }
220
221         return $align;
222 }
223
224 #####################################################################
225 # parse an array - pull side
226 sub ParseArrayPull($$$)
227 {
228         my $e = shift;
229         my $var_prefix = shift;
230         my $ndr_flags = shift;
231
232         my $size = find_size_var($e, util::array_size($e), $var_prefix);
233         my $alloc_size = $size;
234
235         # if this is a conformant array then we use that size to allocate, and make sure
236         # we allocate enough to pull the elements
237         if (defined $e->{CONFORMANT_SIZE}) {
238                 $alloc_size = $e->{CONFORMANT_SIZE};
239
240                 pidl "\tif ($size > $alloc_size) {\n";
241                 pidl "\t\treturn; // ndr_pull_error(ndr, NDR_ERR_CONFORMANT_SIZE, \"Bad conformant size %u should be %u\", $alloc_size, $size);\n";
242                 pidl "\t}\n";
243         } elsif (!util::is_inline_array($e)) {
244                 if ($var_prefix =~ /^r->out/ && $size =~ /^\*r->in/) {
245                         my $size2 = substr($size, 1);
246                         pidl "if (ndr->flags & LIBNDR_FLAG_REF_ALLOC) { NDR_ALLOC(ndr, $size2); }\n";
247                 }
248
249                 # non fixed arrays encode the size just before the array
250                 pidl "\t{\n";
251                 pidl "\t\tuint32_t _array_size;\n";
252                 pidl "\t\tndr_pull_uint32(ndr, tree, hf_array_size, &_array_size);\n";
253                 if ($size =~ /r->in/) {
254                         pidl "\t\tif (!(ndr->flags & LIBNDR_FLAG_REF_ALLOC) && _array_size != $size) {\n";
255                 } else {
256                         pidl "\t\tif ($size != _array_size) {\n";
257                 }
258                 pidl "\t\t\t//return ndr_pull_error(ndr, NDR_ERR_ARRAY_SIZE, \"Bad array size %u should be %u\", _array_size, $size);\n";
259                 pidl "\t\t\treturn;\n";
260                 pidl "\t\t}\n";
261                 if ($size =~ /r->in/) {
262                         pidl "else { $size = _array_size; }\n";
263                 }
264                 pidl "\t}\n";
265         }
266
267         if ((util::need_alloc($e) && !util::is_fixed_array($e)) ||
268             ($var_prefix eq "r->in." && util::has_property($e, "ref"))) {
269                 if (!util::is_inline_array($e) || $ndr_flags eq "NDR_SCALARS") {
270                         pidl "\t\tNDR_ALLOC_N(ndr, $var_prefix$e->{NAME}, MAX(1, $alloc_size));\n";
271                 }
272         }
273
274         if (($var_prefix eq "r->out." && util::has_property($e, "ref"))) {
275                 if (!util::is_inline_array($e) || $ndr_flags eq "NDR_SCALARS") {
276                         pidl "\tif (ndr->flags & LIBNDR_FLAG_REF_ALLOC) {";
277                         pidl "\t\tNDR_ALLOC_N(ndr, $var_prefix$e->{NAME}, MAX(1, $alloc_size));\n";
278                         pidl "\t}\n";
279                 }
280         }
281
282         pidl "\t{\n";
283
284         if (my $length = util::has_property($e, "length_is")) {
285                 $length = find_size_var($e, $length, $var_prefix);
286                 pidl "\t\tuint32_t _offset, _length;\n";
287                 pidl "\t\tndr_pull_uint32(ndr, tree, hf_array_offset, &_offset);\n";
288                 pidl "\t\tndr_pull_uint32(ndr, tree, hf_array_length, &_length);\n";
289                 pidl "\t\tif (_offset != 0) return; // ndr_pull_error(ndr, NDR_ERR_OFFSET, \"Bad array offset 0x%08x\", _offset);\n";
290                 pidl "\t\tif (_length > $size || _length != $length) return; // ndr_pull_error(ndr, NDR_ERR_LENGTH, \"Bad array length 0x%08x > size 0x%08x\", _offset, $size);\n\n";
291                 $size = "_length";
292         }
293
294         if (util::is_scalar_type($e->{TYPE})) {
295                 pidl "\t\tndr_pull_array_$e->{TYPE}(ndr, $ndr_flags, tree, \"$e->{NAME}\", hf_$e->{NAME}_$e->{TYPE}, $var_prefix$e->{NAME}, $size);\n";
296         } else {
297                 pidl "\t\tndr_pull_array(ndr, $ndr_flags, tree, \"$e->{NAME}\", (void **)$var_prefix$e->{NAME}, sizeof($var_prefix$e->{NAME}\[0]), $size, (ndr_pull_flags_fn_t)ndr_pull_$e->{TYPE});\n";
298         }
299
300         pidl "\t}\n";
301 }
302
303
304 #####################################################################
305 # parse scalars in a structure element - pull size
306 sub ParseElementPullSwitch($$$$)
307 {
308         my($e) = shift;
309         my($var_prefix) = shift;
310         my($ndr_flags) = shift;
311         my $switch = shift;
312         my $switch_var = find_size_var($e, $switch, $var_prefix);
313
314         my $cprefix = util::c_pull_prefix($e);
315
316         my $utype = $structs{$e->{TYPE}};
317         if (!defined $utype ||
318             !util::has_property($utype->{DATA}, "nodiscriminant")) {
319                 my $e2 = find_sibling($e, $switch);
320                 pidl "\tif (($ndr_flags) & NDR_SCALARS) {\n";
321                 pidl "\t\t $e2->{TYPE} _level;\n";
322                 pidl "\t\tndr_pull_$e2->{TYPE}(ndr, tree, hf_level, &_level);\n";
323                 if ($switch_var =~ /r->in/) {
324                         pidl "\t\tif (!(ndr->flags & LIBNDR_FLAG_REF_ALLOC) && _level != $switch_var) {\n";
325                 } else {
326                         pidl "\t\tif (_level != $switch_var) {\n";
327                 }
328                 pidl "\t\t\treturn; // ndr_pull_error(ndr, NDR_ERR_BAD_SWITCH, \"Bad switch value %u in $e->{NAME}\", _level);\n";
329                 pidl "\t\t}\n";
330                 if ($switch_var =~ /r->/) {
331                         pidl "else { $switch_var = _level; }\n";
332                 }
333                 pidl "\t}\n";
334         }
335
336         my $sub_size = util::has_property($e, "subcontext");
337         if (defined $sub_size) {
338                 pidl "\tndr_pull_subcontext_union_fn(ndr, $sub_size, $switch_var, $cprefix$var_prefix$e->{NAME}, (ndr_pull_union_fn_t) ndr_pull_$e->{TYPE});\n";
339         } else {
340                 pidl "\tndr_pull_$e->{TYPE}(ndr, $ndr_flags, tree, $switch_var, $cprefix$var_prefix$e->{NAME});\n";
341         }
342
343
344 }
345
346 #####################################################################
347 # parse scalars in a structure element - pull size
348 sub ParseElementPullScalar($$$)
349 {
350         my($e) = shift;
351         my($var_prefix) = shift;
352         my($ndr_flags) = shift;
353         my $cprefix = util::c_pull_prefix($e);
354         my $sub_size = util::has_property($e, "subcontext");
355
356         start_flags($e);
357
358         if (util::has_property($e, "relative")) {
359                 pidl "\tndr_pull_relative(ndr, (const void **)&$var_prefix$e->{NAME}, sizeof(*$var_prefix$e->{NAME}), (ndr_pull_flags_fn_t)ndr_pull_$e->{TYPE});\n";
360         } elsif (util::is_inline_array($e)) {
361                 ParseArrayPull($e, "r->", "NDR_SCALARS");
362         } elsif (util::need_wire_pointer($e)) {
363                 pidl "\tndr_pull_ptr(ndr, tree, hf_ptr, &_ptr_$e->{NAME});\n";
364                 pidl "\tif (_ptr_$e->{NAME}) {\n";
365                 pidl "\t\tNDR_ALLOC(ndr, $var_prefix$e->{NAME});\n";
366                 pidl "\t} else {\n";
367                 pidl "\t\t$var_prefix$e->{NAME} = NULL;\n";
368                 pidl "\t}\n";
369         } elsif (util::need_alloc($e)) {
370                 # no scalar component
371         } elsif (my $switch = util::has_property($e, "switch_is")) {
372                 ParseElementPullSwitch($e, $var_prefix, $ndr_flags, $switch);
373         } elsif (defined $sub_size) {
374                 if (util::is_builtin_type($e->{TYPE})) {
375                         pidl "\tndr_pull_subcontext_fn(ndr, tree, $sub_size, $cprefix$var_prefix$e->{NAME}, (ndr_pull_fn_t) ndr_pull_$e->{TYPE});\n";
376                 } else {
377                         pidl "\tndr_pull_subcontext_flags_fn(ndr, tree, $sub_size, $cprefix$var_prefix$e->{NAME}, (ndr_pull_flags_fn_t) ndr_pull_$e->{TYPE});\n";
378                 }
379         } elsif (util::is_builtin_type($e->{TYPE})) {
380                 pidl "\tndr_pull_$e->{TYPE}(ndr, tree, hf_$e->{NAME}_$e->{TYPE}, $cprefix$var_prefix$e->{NAME});\n";
381         } else {
382                 pidl "\tndr_pull_$e->{TYPE}(ndr, $ndr_flags, get_subtree(tree, \"$e->{NAME}\", ndr, ett_$e->{TYPE}), $cprefix$var_prefix$e->{NAME});\n";
383         }
384
385         end_flags($e);
386 }
387
388 #####################################################################
389 # parse buffers in a structure element - pull side
390 sub ParseElementPullBuffer($$$)
391 {
392         my($e) = shift;
393         my($var_prefix) = shift;
394         my($ndr_flags) = shift;
395         my $cprefix = util::c_pull_prefix($e);
396         my $sub_size = util::has_property($e, "subcontext");
397
398         if (util::is_pure_scalar($e)) {
399                 return;
400         }
401
402         if (util::has_property($e, "relative")) {
403                 return;
404         }
405
406         start_flags($e);
407
408         if (util::need_wire_pointer($e)) {
409                 pidl "\tif ($var_prefix$e->{NAME}) {\n";
410         }
411             
412         if (util::is_inline_array($e)) {
413                 ParseArrayPull($e, "r->", "NDR_BUFFERS");
414         } elsif (util::array_size($e)) {
415                 ParseArrayPull($e, "r->", "NDR_SCALARS|NDR_BUFFERS");
416         } elsif (my $switch = util::has_property($e, "switch_is")) {
417                 if ($e->{POINTERS}) {
418                         ParseElementPullSwitch($e, $var_prefix, "NDR_SCALARS|NDR_BUFFERS", $switch);
419                 } else {
420                         ParseElementPullSwitch($e, $var_prefix, "NDR_BUFFERS", $switch);
421                 }
422         } elsif (defined $sub_size) {
423                 if ($e->{POINTERS}) {
424                         if (util::is_builtin_type($e->{TYPE})) {
425                                 pidl "\tndr_pull_subcontext_fn(ndr, $sub_size, $cprefix$var_prefix$e->{NAME}, (ndr_pull_fn_t) ndr_pull_$e->{TYPE});\n";
426                         } else {
427                                 pidl "\tndr_pull_subcontext_flags_fn(ndr, tree, $sub_size, $cprefix$var_prefix$e->{NAME}, (ndr_pull_flags_fn_t) ndr_pull_$e->{TYPE});\n";
428                         }
429                 }
430         } elsif (util::is_builtin_type($e->{TYPE})) {
431                 pidl "\t\tndr_pull_$e->{TYPE}(ndr, tree, hf_$e->{NAME}_$e->{TYPE}, $cprefix$var_prefix$e->{NAME});\n";
432         } elsif ($e->{POINTERS}) {
433                 pidl "\t\tndr_pull_$e->{TYPE}(ndr, NDR_SCALARS|NDR_BUFFERS, get_subtree(tree, \"$e->{NAME}\", ndr, ett_$e->{TYPE}), $cprefix$var_prefix$e->{NAME});\n";
434         } else {
435                 pidl "\t\tndr_pull_$e->{TYPE}(ndr, $ndr_flags, get_subtree(tree, \"$e->{NAME}\", ndr, ett_$e->{TYPE}), $cprefix$var_prefix$e->{NAME});\n";
436         }
437
438         if (util::need_wire_pointer($e)) {
439                 pidl "\t}\n";
440         }       
441
442         end_flags($e);
443 }
444
445 #####################################################################
446 # parse a struct - pull side
447 sub ParseStructPull($)
448 {
449         my($struct) = shift;
450         my $conform_e;
451
452         if (! defined $struct->{ELEMENTS}) {
453                 return;
454         }
455
456         # see if the structure contains a conformant array. If it
457         # does, then it must be the last element of the structure, and
458         # we need to pull the conformant length early, as it fits on
459         # the wire before the structure (and even before the structure
460         # alignment)
461         my $e = $struct->{ELEMENTS}[-1];
462         if (defined $e->{ARRAY_LEN} && $e->{ARRAY_LEN} eq "*") {
463                 $conform_e = $e;
464                 pidl "\tuint32_t _conformant_size;\n";
465                 $conform_e->{CONFORMANT_SIZE} = "_conformant_size";
466         }
467
468         # declare any internal pointers we need
469         foreach my $e (@{$struct->{ELEMENTS}}) {
470                 if (util::need_wire_pointer($e) &&
471                     !util::has_property($e, "relative")) {
472                         pidl "\tuint32_t _ptr_$e->{NAME};\n";
473                 }
474         }
475
476         start_flags($struct);
477
478         pidl "\tif (!(ndr_flags & NDR_SCALARS)) goto buffers;\n";
479
480         pidl "\tndr_pull_struct_start(ndr);\n";
481
482         if (defined $conform_e) {
483                 pidl "\tndr_pull_uint32(ndr, tree, hf_conformant_size, &$conform_e->{CONFORMANT_SIZE});\n";
484         }
485
486         my $align = struct_alignment($struct);
487         pidl "\tndr_pull_align(ndr, $align);\n";
488
489         foreach my $e (@{$struct->{ELEMENTS}}) {
490                 ParseElementPullScalar($e, "r->", "NDR_SCALARS");
491         }       
492
493         pidl "buffers:\n";
494         pidl "\tif (!(ndr_flags & NDR_BUFFERS)) goto done;\n";
495         foreach my $e (@{$struct->{ELEMENTS}}) {
496                 ParseElementPullBuffer($e, "r->", "NDR_BUFFERS");
497         }
498
499         pidl "\tndr_pull_struct_end(ndr);\n";
500
501         pidl "done:\n";
502
503         end_flags($struct);
504 }
505
506
507 #####################################################################
508 # parse a union - pull side
509 sub ParseUnionPull($)
510 {
511         my $e = shift;
512         my $have_default = 0;
513
514         start_flags($e);
515
516         pidl "\tif (!(ndr_flags & NDR_SCALARS)) goto buffers;\n";
517
518         pidl "\tndr_pull_struct_start(ndr);\n";
519
520 #       my $align = union_alignment($e);
521 #       pidl "\tndr_pull_align(ndr, $align);\n";
522
523         pidl "\tswitch (level) {\n";
524         foreach my $el (@{$e->{DATA}}) {
525                 if ($el->{CASE} eq "default") {
526                         pidl "\tdefault: {\n";
527                         $have_default = 1;
528                 } else {
529                         pidl "\tcase $el->{CASE}: {\n";
530                 }
531                 if ($el->{TYPE} eq "UNION_ELEMENT") {
532                         my $e2 = $el->{DATA};
533                         if ($e2->{POINTERS}) {
534                                 pidl "\t\tuint32_t _ptr_$e2->{NAME};\n";
535                         }
536                         ParseElementPullScalar($el->{DATA}, "r->", "NDR_SCALARS");
537                 }
538                 pidl "\tbreak; }\n\n";
539         }
540         if (! $have_default) {
541                 pidl "\tdefault:\n";
542                 pidl "\t\treturn; // ndr_pull_error(ndr, NDR_ERR_BAD_SWITCH, \"Bad switch value \%u\", level);\n";
543         }
544         pidl "\t}\n";
545         pidl "buffers:\n";
546         pidl "\tif (!(ndr_flags & NDR_BUFFERS)) goto done;\n";
547         pidl "\tswitch (level) {\n";
548         foreach my $el (@{$e->{DATA}}) {
549                 if ($el->{CASE} eq "default") {
550                         pidl "\tdefault:\n";
551                 } else {
552                         pidl "\tcase $el->{CASE}:\n";
553                 }
554                 if ($el->{TYPE} eq "UNION_ELEMENT") {
555                         ParseElementPullBuffer($el->{DATA}, "r->", "NDR_BUFFERS");
556                 }
557                 pidl "\tbreak;\n\n";
558         }
559         if (! $have_default) {
560                 pidl "\tdefault:\n";
561                 pidl "\t\treturn; // ndr_pull_error(ndr, NDR_ERR_BAD_SWITCH, \"Bad switch value \%u\", level);\n";
562         }
563         pidl "\t}\n";
564         pidl "\tndr_pull_struct_end(ndr);\n";
565         pidl "done:\n";
566         end_flags($e);
567 }
568
569 #####################################################################
570 # parse a type
571 sub ParseTypePull($)
572 {
573         my($data) = shift;
574
575         if (ref($data) eq "HASH") {
576                 ($data->{TYPE} eq "STRUCT") &&
577                     ParseStructPull($data);
578                 ($data->{TYPE} eq "UNION") &&
579                     ParseUnionPull($data);
580         }
581 }
582
583 #####################################################################
584 # parse a typedef - pull side
585 sub ParseTypedefPull($)
586 {
587         my($e) = shift;
588         my $static = fn_prefix($e);
589
590         if (! $needed{"pull_$e->{NAME}"}) {
591 #               print "pull_$e->{NAME} not needed\n";
592                 return;
593         }
594
595         pidl "/*\n\n";
596         pidl IdlDump::DumpTypedef($e);
597         pidl "*/\n\n";
598
599         if ($e->{DATA}->{TYPE} eq "STRUCT") {
600                 pidl $static . "void ndr_pull_$e->{NAME}(struct ndr_pull *ndr, int ndr_flags, proto_tree *tree, struct $e->{NAME} *r)";
601                 pidl "\n{\n";
602                 ParseTypePull($e->{DATA});
603                 pidl "\treturn;\n";
604                 pidl "}\n\n";
605         }
606
607         if ($e->{DATA}->{TYPE} eq "UNION") {
608                 pidl $static . "void ndr_pull_$e->{NAME}(struct ndr_pull *ndr, int ndr_flags, proto_tree *tree, uint16_t level, union $e->{NAME} *r)";
609                 pidl "\n{\n";
610                 ParseTypePull($e->{DATA});
611                 pidl "\treturn;\n";
612                 pidl "}\n\n";
613         }
614 }
615
616 #####################################################################
617 # parse a function element
618 sub ParseFunctionElementPull($$)
619
620         my $e = shift;
621         my $inout = shift;
622
623         if (util::array_size($e)) {
624                 if (util::need_wire_pointer($e)) {
625                         pidl "\tndr_pull_ptr(ndr, &_ptr_$e->{NAME});\n";
626                         pidl "\tif (_ptr_$e->{NAME}) {\n";
627                 } elsif ($inout eq "out" && util::has_property($e, "ref")) {
628                         pidl "\tif (r->$inout.$e->{NAME}) {\n";
629                 } else {
630                         pidl "\t{\n";
631                 }
632                 ParseArrayPull($e, "r->$inout.", "NDR_SCALARS|NDR_BUFFERS");
633                 pidl "\t}\n";
634         } else {
635                 if ($inout eq "out" && util::has_property($e, "ref")) {
636                         pidl "\tif (ndr->flags & LIBNDR_FLAG_REF_ALLOC) {\n";
637                         pidl "\tNDR_ALLOC(ndr, r->out.$e->{NAME});\n";
638                         pidl "\t}\n";
639                 }
640                 if ($inout eq "in" && util::has_property($e, "ref")) {
641                         pidl "\tNDR_ALLOC(ndr, r->in.$e->{NAME});\n";
642                 }
643
644                 ParseElementPullScalar($e, "r->$inout.", "NDR_SCALARS|NDR_BUFFERS");
645                 if ($e->{POINTERS}) {
646                         ParseElementPullBuffer($e, "r->$inout.", "NDR_SCALARS|NDR_BUFFERS");
647                 }
648         }
649 }
650
651
652 ############################################################
653 # allocate ref variables
654 sub AllocateRefVars($)
655 {
656         my $e = shift;
657         my $asize = util::array_size($e);
658
659         # note that if the variable is also an "in"
660         # variable then we copy the initial value from
661         # the in side
662
663         if (!defined $asize) {
664                 # its a simple variable
665                 pidl "\tNDR_ALLOC(ndr, r->out.$e->{NAME});\n";
666                 if (util::has_property($e, "in")) {
667                         pidl "\t*r->out.$e->{NAME} = *r->in.$e->{NAME};\n";
668                 } else {
669                         pidl "\tZERO_STRUCTP(r->out.$e->{NAME});\n";
670                 }
671                 return;
672         }
673
674         # its an array
675         my $size = find_size_var($e, $asize, "r->out.");
676         pidl "\tNDR_ALLOC_N(ndr, r->out.$e->{NAME}, MAX(1, $size));\n";
677         if (util::has_property($e, "in")) {
678                 pidl "\tmemcpy(r->out.$e->{NAME},r->in.$e->{NAME},$size * sizeof(*r->in.$e->{NAME}));\n";
679         } else {
680                 pidl "\tmemset(r->out.$e->{NAME}, 0, $size * sizeof(*r->out.$e->{NAME}));\n";
681         }
682 }
683
684
685 #####################################################################
686 # parse a function
687 sub ParseFunctionPull($)
688
689         my($fn) = shift;
690         my $static = fn_prefix($fn);
691
692         pidl "/*\n\n";
693         pidl IdlDump::DumpFunction($fn);
694         pidl "*/\n\n";
695
696         # request function
697         pidl "int $fn->{NAME}_rqst(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *tree, guint8 *drep)\n{\n";
698
699         pidl "\tstruct ndr_pull *ndr = ndr_pull_init(tvb, offset, pinfo, drep);\n";
700         pidl "\tstruct $fn->{NAME} *r = (struct $fn->{NAME} *)g_malloc(sizeof(struct $fn->{NAME}));\n\n";
701
702         # declare any internal pointers we need
703         foreach my $e (@{$fn->{DATA}}) {
704                 if (util::need_wire_pointer($e) &&
705                     util::has_property($e, "in")) {
706                         pidl "\tuint32_t _ptr_$e->{NAME};\n";
707                 }
708         }
709
710         pidl "\n\tZERO_STRUCTP(r);\n\n";
711
712         # auto-init the out section of a structure. I originally argued that
713         # this was a bad idea as it hides bugs, but coping correctly
714         # with initialisation and not wiping ref vars is turning
715         # out to be too tricky (tridge)
716         foreach my $e (@{$fn->{DATA}}) {
717                 if (util::has_property($e, "out")) {
718                         pidl "\tZERO_STRUCT(r->out);\n\n";
719                         last;
720                 }
721         }
722
723         foreach my $e (@{$fn->{DATA}}) {
724                 if (util::has_property($e, "in")) {
725                         ParseFunctionElementPull($e, "in");
726                 }
727                 # we need to allocate any reference output variables, so that
728                 # a dcerpc backend can be sure they are non-null
729                 if (util::has_property($e, "out") && util::has_property($e, "ref")) {
730                         AllocateRefVars($e);
731                 }
732         }
733
734         pidl "\n\treturn ndr->offset;\n";
735         pidl "}\n\n";
736
737         # response function
738         pidl "int $fn->{NAME}_resp(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *tree, guint8 *drep)\n{\n";
739
740         pidl "\tstruct ndr_pull *ndr = ndr_pull_init(tvb, offset, pinfo, drep);\n";
741         pidl "\tstruct $fn->{NAME} *r = (struct $fn->{NAME} *)g_malloc(sizeof(struct $fn->{NAME}));\n\n";
742
743         # declare any internal pointers we need
744         foreach my $e (@{$fn->{DATA}}) {
745                 if (util::need_wire_pointer($e) &&
746                     util::has_property($e, "out")) {
747                         pidl "\tuint32_t _ptr_$e->{NAME};\n";
748                 }
749         }
750
751         pidl "\tZERO_STRUCTP(r);\n\n";
752
753         foreach my $e (@{$fn->{DATA}}) {
754                 if (util::has_property($e, "out")) {
755                         ParseFunctionElementPull($e, "out");
756                 }
757         }
758
759         if ($fn->{RETURN_TYPE} && $fn->{RETURN_TYPE} ne "void") {
760                 pidl "\tndr_pull_$fn->{RETURN_TYPE}(ndr, tree, hf_rc, &r->out.result);\n";
761         }
762
763         pidl "\n\treturn ndr->offset;\n";
764         pidl "}\n\n";
765 }
766
767 #####################################################################
768 # produce a function call table
769 sub FunctionTable($)
770 {
771         my($interface) = shift;
772         my($data) = $interface->{DATA};
773
774         pidl "static dcerpc_sub_dissector dcerpc_dissectors[] = {\n";
775         my $num = 0;
776         foreach my $d (@{$data}) {
777                 if ($d->{TYPE} eq "FUNCTION") {
778                     # Strip module name from function name, if present
779                     my($n) = $d->{NAME};
780                     $n = substr($d->{NAME}, length($module) + 1),
781                         if $module eq substr($d->{NAME}, 0, length($module));
782                     pidl "\t{ $num, \"$n\",\n";
783                     pidl "\t\t$d->{NAME}_rqst,\n";
784                     pidl "\t\t$d->{NAME}_resp },\n";
785                     $num++;
786                 }
787         }
788         pidl "};\n\n";
789 }
790
791 #####################################################################
792 # parse the interface definitions
793 sub ParseInterface($)
794 {
795         my($interface) = shift;
796         my($data) = $interface->{DATA};
797
798         foreach my $d (@{$data}) {
799                 if ($d->{TYPE} eq "TYPEDEF") {
800                     $structs{$d->{NAME}} = $d;
801             }
802         }
803
804         foreach my $d (@{$data}) {
805                 ($d->{TYPE} eq "TYPEDEF") &&
806                     ParseTypedefPull($d);
807                 ($d->{TYPE} eq "FUNCTION") && 
808                     ParseFunctionPull($d);
809         }
810
811         FunctionTable($interface);
812
813 }
814
815 sub type2ft($)
816 {
817     my($t) = shift;
818  
819     return "FT_UINT32", if ($t eq "uint32");
820     return "FT_UINT16", if ($t eq "uint16");
821     return "FT_UINT8", if ($t eq "uint8");
822     return "FT_BYTES";
823 }
824
825 sub type2base($)
826 {
827     my($t) = shift;
828  
829     return "BASE_DEC", if ($t eq "uint32") or ($t eq "uint16") or
830         ($t eq "uint8");
831     return "BASE_NONE";
832 }
833
834 sub NeededFunction($)
835 {
836         my $fn = shift;
837         $needed{"pull_$fn->{NAME}"} = 1;
838         foreach my $e (@{$fn->{DATA}}) {
839                 $e->{PARENT} = $fn;
840                 $needed{"pull_$e->{TYPE}"} = 1;
841
842                 if (util::is_scalar_type($e->{TYPE})) {
843                     $needed{"hf_$e->{NAME}_$e->{TYPE}"} = {
844                         'name' => $e->{NAME},
845                         'type' => $e->{TYPE},
846                         'ft'   => type2ft($e->{TYPE}),
847                         'base' => type2base($e->{TYPE})
848                         };
849                     $e->{PARENT} = $fn;
850                 } else {
851                     $needed{"ett_$e->{TYPE}"} = 1;
852                 }
853         }
854 }
855
856 sub NeededTypedef($)
857 {
858         my $t = shift;
859         if (util::has_property($t->{DATA}, "public")) {
860                 $needed{"pull_$t->{NAME}"} = 1;
861         }
862
863         if ($t->{DATA}->{TYPE} eq "STRUCT") {
864
865             for my $e (@{$t->{DATA}->{ELEMENTS}}) {
866                 $e->{PARENT} = $t->{DATA};
867                 if ($needed{"pull_$t->{NAME}"}) {
868                     $needed{"pull_$e->{TYPE}"} = 1;
869                 }
870             
871                 if (util::is_scalar_type($e->{TYPE})) {
872                 
873                     $needed{"hf_$e->{NAME}_$e->{TYPE}"} = {
874                         'name' => $e->{NAME},
875                         'type' => $e->{TYPE},
876                         'ft'   => type2ft($e->{TYPE}),
877                         'base' => type2base($e->{TYPE})
878                         };
879                     
880                     $e->{PARENT} = $t->{DATA};
881                     
882                     if ($needed{"pull_$t->{NAME}"}) {
883                         $needed{"pull_$e->{TYPE}"} = 1;
884                     }
885                 } else {
886                     
887                     $needed{"ett_$e->{TYPE}"} = 1;
888                     
889                 }
890             }
891         }
892
893         if ($t->{DATA}->{TYPE} eq "UNION") {
894                 for my $e (@{$t->{DATA}->{DATA}}) {
895                         $e->{PARENT} = $t->{DATA};
896                         if ($e->{TYPE} eq "UNION_ELEMENT") {
897                                 if ($needed{"pull_$t->{NAME}"}) {
898                                         $needed{"pull_$e->{DATA}->{TYPE}"} = 1;
899                                 }
900                                 $needed{"ett_$e->{DATA}{TYPE}"} = 1;
901                         }
902                 }
903
904             $needed{"ett_$t->{NAME}"} = 1;
905         }
906 }
907
908 #####################################################################
909 # work out what parse functions are needed
910 sub BuildNeeded($)
911 {
912         my($interface) = shift;
913         my($data) = $interface->{DATA};
914         foreach my $d (@{$data}) {
915                 ($d->{TYPE} eq "FUNCTION") && 
916                     NeededFunction($d);
917         }
918         foreach my $d (reverse @{$data}) {
919                 ($d->{TYPE} eq "TYPEDEF") &&
920                     NeededTypedef($d);
921         }
922 }
923
924 #####################################################################
925 # parse the interface definitions
926 sub ModuleHeader($)
927 {
928     my($h) = shift;
929
930     $if_uuid = $h->{PROPERTIES}->{uuid};
931     $if_version = $h->{PROPERTIES}->{version};
932     $if_endpoints = $h->{PROPERTIES}->{endpoints};
933 }
934
935 #####################################################################
936 # Generate a header file that contains function prototypes for 
937 # structs and typedefs.
938 sub ParseHeader($$)
939 {
940         my($idl) = shift;
941         my($filename) = shift;
942
943         open(OUT, ">$filename") || die "can't open $filename";    
944
945         pidl "/* parser auto-generated by pidl */\n\n";
946
947         pidl "#include \"ndr_$module.h\"\n\n";
948
949         foreach my $x (@{$idl}) {
950             if ($x->{TYPE} eq "INTERFACE") { 
951                 foreach my $d (@{$x->{DATA}}) {
952
953                     # Make prototypes for [public] structures and
954                     # unions.
955
956                     if ($d->{TYPE} eq "TYPEDEF" and 
957                         util::has_property($d->{DATA}, "public")) {
958                         
959                         if ($d->{DATA}{TYPE} eq "STRUCT") { 
960                             pidl "void ndr_pull_$d->{NAME}(struct ndr_pull *ndr, int ndr_flags, proto_tree *tree, struct $d->{NAME} *r);\n\n";
961                         }
962
963                         if ($d->{DATA}{TYPE} eq "UNION") {
964                             pidl "void ndr_pull_$d->{NAME}(struct ndr_pull *ndr, int ndr_flags, proto_tree *tree, struct $d->{NAME} *r, uint16 level);\n\n";
965                         }
966                     }
967                 }
968             }
969         }
970
971         close(OUT);
972 }
973
974 #####################################################################
975 # parse a parsed IDL structure back into an IDL file
976 sub Parse($$)
977 {
978         my($idl) = shift;
979         my($filename) = shift;
980
981         %needed = ();           # Clear after generating header file
982
983         open(OUT, ">$filename") || die "can't open $filename";    
984
985         # Look for name of module
986
987         foreach my $x (@{$idl}) {
988
989             ($x->{TYPE} eq "MODULEHEADER") && ModuleHeader($x);
990                 
991             if ($x->{TYPE} eq "INTERFACE") { 
992                 $module = $x->{NAME};
993                 BuildNeeded($x);
994             }
995         }
996         
997         pidl "/* parser auto-generated by pidl */\n\n";
998         pidl "#include \"eparser.h\"\n\n";
999
1000         pidl "extern const value_string NT_errors[];\n\n";
1001
1002         pidl "static int hf_opnum = -1;\n";
1003         pidl "static int hf_rc = -1;\n";
1004         pidl "static int hf_ptr = -1;\n";
1005         pidl "static int hf_array_size = -1;\n";
1006         pidl "static int hf_array_offset = -1;\n";
1007         pidl "static int hf_array_length = -1;\n";
1008         pidl "static int hf_level = -1;\n";
1009         pidl "static int hf_conformant_size = -1;\n";
1010
1011         # Declarations for hf variables
1012
1013         foreach my $y (keys(%needed)) {
1014             pidl "static int $y = -1;\n", if $y =~ /^hf_/;
1015         }
1016
1017         pidl "\n";
1018
1019         # Declarations for ett variables
1020
1021         foreach my $y (keys(%needed)) {
1022             pidl "static gint $y = -1;\n", if $y =~ /^ett_/;
1023         }
1024
1025         pidl "\n";
1026
1027         foreach my $x (@{$idl}) {
1028                 ($x->{TYPE} eq "MODULEHEADER") && 
1029                     ModuleHeader($x);
1030
1031                 if ($x->{TYPE} eq "INTERFACE") { 
1032                         BuildNeeded($x);
1033                         ParseInterface($x);
1034                 }
1035         }
1036
1037         pidl "int proto_dcerpc_pidl_$module = -1;\n\n";
1038
1039         pidl "static gint ett_dcerpc_$module = -1;\n\n";
1040
1041         if (defined($if_uuid)) {
1042
1043             pidl "static e_uuid_t uuid_dcerpc_$module = {\n";
1044             pidl "\t0x" . substr($if_uuid, 0, 8);
1045             pidl ", 0x" . substr($if_uuid, 9, 4);
1046             pidl ", 0x" . substr($if_uuid, 14, 4) . ",\n";
1047             pidl "\t{ 0x" . substr($if_uuid, 19, 2);
1048             pidl ", 0x" . substr($if_uuid, 21, 2);
1049             pidl ", 0x" . substr($if_uuid, 24, 2);
1050             pidl ", 0x" . substr($if_uuid, 26, 2);
1051             pidl ", 0x" . substr($if_uuid, 28, 2);
1052             pidl ", 0x" . substr($if_uuid, 30, 2);
1053             pidl ", 0x" . substr($if_uuid, 32, 2);
1054             pidl ", 0x" . substr($if_uuid, 34, 2) . " }\n";
1055             pidl "};\n\n";
1056
1057             pidl "static guint16 ver_dcerpc_$module = " . $if_version . ";\n\n";
1058         }
1059
1060         pidl "void proto_register_dcerpc_pidl_$module(void)\n";
1061         pidl "{\n";
1062
1063         pidl "\tstatic hf_register_info hf[] = {\n";
1064         
1065         pidl "\t{ &hf_opnum, { \"Operation\", \"$module.opnum\", FT_UINT16, BASE_DEC, NULL, 0x0, \"Operation\", HFILL }},\n";
1066         pidl "\t{ &hf_rc, { \"Return code\", \"$module.rc\", FT_UINT32, BASE_HEX, VALS(NT_errors), 0x0, \"Return status code\", HFILL }},\n";
1067         pidl "\t{ &hf_array_size, { \"Array size\", \"$module.array_size\", FT_UINT32, BASE_DEC, NULL, 0x0, \"Array size\", HFILL }},\n";
1068         pidl "\t{ &hf_array_offset, { \"Array offset\", \"$module.array_offset\", FT_UINT32, BASE_DEC, NULL, 0x0, \"Array offset\", HFILL }},\n";
1069         pidl "\t{ &hf_array_length, { \"Array length\", \"$module.array_length\", FT_UINT32, BASE_DEC, NULL, 0x0, \"Array length\", HFILL }},\n";
1070         pidl "\t{ &hf_ptr, { \"Pointer\", \"$module.ptr\", FT_UINT32, BASE_HEX, NULL, 0x0, \"Pointer\", HFILL }},\n";
1071         pidl "\t{ &hf_level, { \"Level\", \"$module.level\", FT_UINT32, BASE_DEC, NULL, 0x0, \"Level\", HFILL }},\n";
1072         pidl "\t{ &hf_conformant_size, { \"Conformant size\", \"$module.conformant_size\", FT_UINT32, BASE_DEC, NULL, 0x0, \"Conformant size\", HFILL }},\n";
1073
1074         foreach my $x (keys(%needed)) {
1075             next, if !($x =~ /^hf_/);
1076             pidl "\t{ &$x,\n";
1077             pidl "\t  { \"$needed{$x}{name}\", \"$x\", $needed{$x}{ft}, $needed{$x}{base}, NULL, 0, \"$x\", HFILL }},\n";
1078         }
1079         
1080         pidl "\t};\n\n";
1081
1082         pidl "\tstatic gint *ett[] = {\n";
1083         pidl "\t\t&ett_dcerpc_$module,\n";
1084         foreach my $x (keys(%needed)) {
1085             pidl "\t\t&$x,\n", if $x =~ /^ett_/;
1086         }
1087         pidl "\t};\n\n";
1088         
1089         if (defined($if_uuid)) {
1090
1091             pidl "\tproto_dcerpc_pidl_$module = proto_register_protocol(\"pidl_$module\", \"pidl_$module\", \"pidl_$module\");\n\n";
1092
1093             pidl "\tproto_register_field_array(proto_dcerpc_pidl_$module, hf, array_length (hf));\n";
1094             pidl "\tproto_register_subtree_array(ett, array_length(ett));\n";
1095
1096             pidl "}\n\n";
1097
1098             pidl "void proto_reg_handoff_dcerpc_pidl_$module(void)\n";
1099             pidl "{\n";
1100             pidl "\tdcerpc_init_uuid(proto_dcerpc_pidl_$module, ett_dcerpc_$module, \n";
1101             pidl "\t\t&uuid_dcerpc_$module, ver_dcerpc_$module, \n";
1102             pidl "\t\tdcerpc_dissectors, hf_opnum);\n";
1103             pidl "}\n";
1104
1105         } else {
1106
1107             pidl "\tint proto_dcerpc;\n\n";
1108             pidl "\tproto_dcerpc = proto_get_id_by_filter_name(\"dcerpc\");\n";
1109             pidl "\tproto_register_field_array(proto_dcerpc, hf, array_length(hf));\n";
1110             pidl "\tproto_register_subtree_array(ett, array_length(ett));\n";
1111
1112             pidl "}\n";
1113
1114         }
1115
1116         close(OUT);
1117 }
1118
1119 1;