09e2855e231ad2db0a1e603ca0dd0ec662f31c29
[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, \"" . field2name($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, \"" . field2name($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, tree, (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, \"" . field2name($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, \"" . field2name($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, \"" . field2name($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         # request function
693         pidl "int $fn->{NAME}_rqst(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *tree, guint8 *drep)\n{\n";
694
695         pidl "\tstruct pidl_pull *ndr = pidl_pull_init(tvb, offset, pinfo, drep);\n";
696         pidl "\tstruct $fn->{NAME} *r = talloc_p(NULL, struct $fn->{NAME});\n";
697         pidl "\tpidl_tree ptree;\n\n";
698
699         pidl "\tptree.proto_tree = tree;\n";
700         pidl "\tptree.subtree_list = NULL;\n\n";
701
702         pidl "\tndr_pull_$fn->{NAME}(ndr, NDR_IN, &ptree, r);\n";
703
704         pidl "\n\treturn ndr->offset;\n";
705         pidl "}\n\n";
706
707         # response function
708         pidl "int $fn->{NAME}_resp(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *tree, guint8 *drep)\n{\n";
709
710         pidl "\tstruct pidl_pull *ndr = pidl_pull_init(tvb, offset, pinfo, drep);\n";
711         pidl "\tstruct $fn->{NAME} *r = talloc_p(NULL, struct $fn->{NAME});\n";
712         pidl "\tpidl_tree ptree;\n\n";
713
714         pidl "\tptree.proto_tree = tree;\n";
715         pidl "\tptree.subtree_list = NULL;\n\n";
716
717         pidl "\tndr_pull_$fn->{NAME}(ndr, NDR_OUT, &ptree, r);\n";
718
719         pidl "\n\treturn ndr->offset;\n";
720         pidl "}\n\n";
721 }
722
723 #####################################################################
724 # produce a function call table
725 sub FunctionTable($)
726 {
727         my($interface) = shift;
728         my($data) = $interface->{DATA};
729
730         pidl "static dcerpc_sub_dissector dcerpc_dissectors[] = {\n";
731         my $num = 0;
732         foreach my $d (@{$data}) {
733                 if ($d->{TYPE} eq "FUNCTION") {
734                     # Strip module name from function name, if present
735                     my($n) = $d->{NAME};
736                     $n = substr($d->{NAME}, length($module) + 1),
737                         if $module eq substr($d->{NAME}, 0, length($module));
738                     pidl "\t{ $num, \"$n\",\n";
739                     pidl "\t\t$d->{NAME}_rqst,\n";
740                     pidl "\t\t$d->{NAME}_resp },\n";
741                     $num++;
742                 }
743         }
744         pidl "};\n\n";
745 }
746
747 #####################################################################
748 # parse the interface definitions
749 sub ParseInterface($)
750 {
751         my($interface) = shift;
752         my($data) = $interface->{DATA};
753
754         foreach my $d (@{$data}) {
755                 if ($d->{TYPE} eq "TYPEDEF") {
756                     $structs{$d->{NAME}} = $d;
757             }
758         }
759
760         foreach my $d (@{$data}) {
761                 ($d->{TYPE} eq "TYPEDEF") &&
762                     ParseTypedefPull($d);
763                 ($d->{TYPE} eq "FUNCTION") && 
764                     ParseFunctionPull($d);
765         }
766
767         FunctionTable($interface);
768 }
769
770 sub type2ft($)
771 {
772     my($t) = shift;
773  
774     return "FT_UINT32", if ($t eq "uint32");
775     return "FT_UINT16", if ($t eq "uint16");
776     return "FT_UINT8", if ($t eq "uint8");
777     return "FT_BYTES";
778 }
779
780 # Determine the display base for an element
781
782 sub elementbase($)
783 {
784     my($e) = shift;
785
786     if (my $base = util::has_property($e, "display")) {
787         return "BASE_" . uc($base);
788     }
789  
790     return "BASE_DEC", if ($e->{TYPE} eq "uint32") or 
791         ($e->{TYPE} eq "uint16") or ($e->{TYPE} eq "uint8");
792     return "BASE_NONE";
793 }
794
795 # Convert a IDL structure field name (e.g access_mask) to a prettier
796 # string like 'Access Mask'.
797
798 sub field2name($)
799 {
800     my($field) = shift;
801
802     $field =~ s/_/ /g;          # Replace underscores with spaces
803     $field =~ s/(\w+)/\u\L$1/g; # Capitalise each word
804     
805     return $field;
806 }
807
808 sub NeededFunction($)
809 {
810         my $fn = shift;
811         $needed{"pull_$fn->{NAME}"} = 1;
812         foreach my $e (@{$fn->{DATA}}) {
813                 $e->{PARENT} = $fn;
814                 $needed{"pull_$e->{TYPE}"} = 1;
815
816                 if (util::is_scalar_type($e->{TYPE})) {
817                     $needed{"hf_$e->{NAME}_$e->{TYPE}"} = {
818                         'name' => field2name($e->{NAME}),
819                         'type' => $e->{TYPE},
820                         'ft'   => type2ft($e->{TYPE}),
821                         'base' => elementbase($e)
822                         }, if !defined($needed{"hf_$e->{NAME}_$e->{TYPE}"});
823                     $e->{PARENT} = $fn;
824                 } else {
825                     $needed{"ett_$e->{TYPE}"} = 1;
826                 }
827         }
828 }
829
830 sub NeededTypedef($)
831 {
832         my $t = shift;
833         if (util::has_property($t->{DATA}, "public")) {
834                 $needed{"pull_$t->{NAME}"} = 1;
835         }
836
837         if ($t->{DATA}->{TYPE} eq "STRUCT") {
838
839             for my $e (@{$t->{DATA}->{ELEMENTS}}) {
840                 $e->{PARENT} = $t->{DATA};
841                 if ($needed{"pull_$t->{NAME}"}) {
842                     $needed{"pull_$e->{TYPE}"} = 1;
843                 }
844             
845                 if (util::is_scalar_type($e->{TYPE})) {
846                 
847                     $needed{"hf_$e->{NAME}_$e->{TYPE}"} = {
848                         'name' => field2name($e->{NAME}),
849                         'type' => $e->{TYPE},
850                         'ft'   => type2ft($e->{TYPE}),
851                         'base' => elementbase($e)
852                         };
853                     
854                     $e->{PARENT} = $t->{DATA};
855                     
856                     if ($needed{"pull_$t->{NAME}"}) {
857                         $needed{"pull_$e->{TYPE}"} = 1;
858                     }
859                 } else {
860                     
861                     $needed{"ett_$e->{TYPE}"} = 1;
862                     
863                 }
864             }
865         }
866
867         if ($t->{DATA}->{TYPE} eq "UNION") {
868                 for my $e (@{$t->{DATA}->{DATA}}) {
869                         $e->{PARENT} = $t->{DATA};
870                         if ($e->{TYPE} eq "UNION_ELEMENT") {
871                                 if ($needed{"pull_$t->{NAME}"}) {
872                                         $needed{"pull_$e->{DATA}->{TYPE}"} = 1;
873                                 }
874                                 $needed{"ett_$e->{DATA}{TYPE}"} = 1;
875                         }
876                 }
877
878             $needed{"ett_$t->{NAME}"} = 1;
879         }
880 }
881
882 #####################################################################
883 # work out what parse functions are needed
884 sub BuildNeeded($)
885 {
886         my($interface) = shift;
887         my($data) = $interface->{DATA};
888         foreach my $d (@{$data}) {
889                 ($d->{TYPE} eq "FUNCTION") && 
890                     NeededFunction($d);
891         }
892         foreach my $d (reverse @{$data}) {
893                 ($d->{TYPE} eq "TYPEDEF") &&
894                     NeededTypedef($d);
895         }
896 }
897
898 #####################################################################
899 # parse the interface definitions
900 sub ModuleHeader($)
901 {
902     my($h) = shift;
903
904     $if_uuid = $h->{PROPERTIES}->{uuid};
905     $if_version = $h->{PROPERTIES}->{version};
906     $if_endpoints = $h->{PROPERTIES}->{endpoints};
907 }
908
909 #####################################################################
910 # Generate a header file that contains function prototypes for 
911 # structs and typedefs.
912 sub ParseHeader($$)
913 {
914         my($idl) = shift;
915         my($filename) = shift;
916
917         open(OUT, ">$filename") || die "can't open $filename";    
918
919         pidl "/* parser auto-generated by pidl */\n\n";
920
921         foreach my $x (@{$idl}) {
922             if ($x->{TYPE} eq "INTERFACE") { 
923                 foreach my $d (@{$x->{DATA}}) {
924
925                     # Make prototypes for [public] structures and
926                     # unions.
927
928                     if ($d->{TYPE} eq "TYPEDEF" and 
929                         util::has_property($d->{DATA}, "public")) {
930                         
931                         if ($d->{DATA}{TYPE} eq "STRUCT") { 
932                             pidl "void ndr_pull_$d->{NAME}(struct ndr_pull *ndr, int ndr_flags, proto_tree *tree, struct $d->{NAME} *r);\n\n";
933                         }
934
935                         if ($d->{DATA}{TYPE} eq "UNION") {
936                             pidl "void ndr_pull_$d->{NAME}(struct ndr_pull *ndr, int ndr_flags, proto_tree *tree, union $d->{NAME} *r, uint16 level);\n\n";
937                         }
938                     }
939                 }
940             }
941         }
942
943         close(OUT);
944 }
945
946 #####################################################################
947 # parse a parsed IDL structure back into an IDL file
948 sub OldParse($$)
949 {
950         my($idl) = shift;
951         my($filename) = shift;
952
953         %needed = ();           # Clear after generating header file
954
955         open(OUT, ">$filename") || die "can't open $filename";    
956
957         # Look for name of module
958
959         foreach my $x (@{$idl}) {
960
961             if ($x->{TYPE} eq "INTERFACE") { 
962                 ModuleHeader($x);
963                 $module = $x->{NAME};
964                 BuildNeeded($x);
965             }
966         }
967         
968         pidl "/* parser auto-generated by pidl */\n\n";
969         pidl "#include \"eparser.h\"\n\n";
970
971         pidl "extern const value_string NT_errors[];\n\n";
972
973         pidl "static int hf_opnum = -1;\n";
974         pidl "static int hf_rc = -1;\n";
975         pidl "static int hf_ptr = -1;\n";
976         pidl "static int hf_array_size = -1;\n";
977         pidl "static int hf_array_offset = -1;\n";
978         pidl "static int hf_array_length = -1;\n";
979         pidl "static int hf_level = -1;\n";
980         pidl "static int hf_conformant_size = -1;\n";
981
982         # Declarations for hf variables
983
984         foreach my $y (keys(%needed)) {
985             pidl "static int $y = -1;\n", if $y =~ /^hf_/;
986         }
987
988         pidl "\n";
989
990         # Declarations for ett variables
991
992         foreach my $y (keys(%needed)) {
993             pidl "static gint $y = -1;\n", if $y =~ /^ett_/;
994         }
995
996         pidl "\n";
997
998         foreach my $x (@{$idl}) {
999                 ($x->{TYPE} eq "MODULEHEADER") && 
1000                     ModuleHeader($x);
1001
1002                 if ($x->{TYPE} eq "INTERFACE") { 
1003                         BuildNeeded($x);
1004                         ParseInterface($x);
1005                 }
1006         }
1007
1008         pidl "int proto_dcerpc_pidl_$module = -1;\n\n";
1009
1010         pidl "static gint ett_dcerpc_$module = -1;\n\n";
1011
1012         if (defined($if_uuid)) {
1013
1014             pidl "static e_uuid_t uuid_dcerpc_$module = {\n";
1015             pidl "\t0x" . substr($if_uuid, 0, 8);
1016             pidl ", 0x" . substr($if_uuid, 9, 4);
1017             pidl ", 0x" . substr($if_uuid, 14, 4) . ",\n";
1018             pidl "\t{ 0x" . substr($if_uuid, 19, 2);
1019             pidl ", 0x" . substr($if_uuid, 21, 2);
1020             pidl ", 0x" . substr($if_uuid, 24, 2);
1021             pidl ", 0x" . substr($if_uuid, 26, 2);
1022             pidl ", 0x" . substr($if_uuid, 28, 2);
1023             pidl ", 0x" . substr($if_uuid, 30, 2);
1024             pidl ", 0x" . substr($if_uuid, 32, 2);
1025             pidl ", 0x" . substr($if_uuid, 34, 2) . " }\n";
1026             pidl "};\n\n";
1027
1028             pidl "static guint16 ver_dcerpc_$module = " . $if_version . ";\n\n";
1029         }
1030
1031         pidl "void proto_register_dcerpc_pidl_$module(void)\n";
1032         pidl "{\n";
1033
1034         pidl "\tstatic hf_register_info hf[] = {\n";
1035         
1036         pidl "\t{ &hf_opnum, { \"Operation\", \"$module.opnum\", FT_UINT16, BASE_DEC, NULL, 0x0, \"Operation\", HFILL }},\n";
1037         pidl "\t{ &hf_rc, { \"Return code\", \"$module.rc\", FT_UINT32, BASE_HEX, VALS(NT_errors), 0x0, \"Return status code\", HFILL }},\n";
1038         pidl "\t{ &hf_array_size, { \"Array size\", \"$module.array_size\", FT_UINT32, BASE_DEC, NULL, 0x0, \"Array size\", HFILL }},\n";
1039         pidl "\t{ &hf_array_offset, { \"Array offset\", \"$module.array_offset\", FT_UINT32, BASE_DEC, NULL, 0x0, \"Array offset\", HFILL }},\n";
1040         pidl "\t{ &hf_array_length, { \"Array length\", \"$module.array_length\", FT_UINT32, BASE_DEC, NULL, 0x0, \"Array length\", HFILL }},\n";
1041         pidl "\t{ &hf_ptr, { \"Pointer\", \"$module.ptr\", FT_UINT32, BASE_HEX, NULL, 0x0, \"Pointer\", HFILL }},\n";
1042         pidl "\t{ &hf_level, { \"Level\", \"$module.level\", FT_UINT32, BASE_DEC, NULL, 0x0, \"Level\", HFILL }},\n";
1043         pidl "\t{ &hf_conformant_size, { \"Conformant size\", \"$module.conformant_size\", FT_UINT32, BASE_DEC, NULL, 0x0, \"Conformant size\", HFILL }},\n";
1044
1045         foreach my $x (keys(%needed)) {
1046             next, if !($x =~ /^hf_/);
1047             pidl "\t{ &$x,\n";
1048             pidl "\t  { \"$needed{$x}{name}\", \"$x\", $needed{$x}{ft}, $needed{$x}{base}, NULL, 0, \"$x\", HFILL }},\n";
1049         }
1050         
1051         pidl "\t};\n\n";
1052
1053         pidl "\tstatic gint *ett[] = {\n";
1054         pidl "\t\t&ett_dcerpc_$module,\n";
1055         foreach my $x (keys(%needed)) {
1056             pidl "\t\t&$x,\n", if $x =~ /^ett_/;
1057         }
1058         pidl "\t};\n\n";
1059         
1060         if (defined($if_uuid)) {
1061
1062             pidl "\tproto_dcerpc_pidl_$module = proto_register_protocol(\"pidl_$module\", \"pidl_$module\", \"pidl_$module\");\n\n";
1063
1064             pidl "\tproto_register_field_array(proto_dcerpc_pidl_$module, hf, array_length (hf));\n";
1065             pidl "\tproto_register_subtree_array(ett, array_length(ett));\n";
1066
1067             pidl "}\n\n";
1068
1069             pidl "void proto_reg_handoff_dcerpc_pidl_$module(void)\n";
1070             pidl "{\n";
1071             pidl "\tdcerpc_init_uuid(proto_dcerpc_pidl_$module, ett_dcerpc_$module, \n";
1072             pidl "\t\t&uuid_dcerpc_$module, ver_dcerpc_$module, \n";
1073             pidl "\t\tdcerpc_dissectors, hf_opnum);\n";
1074             pidl "}\n";
1075
1076         } else {
1077
1078             pidl "\tint proto_dcerpc;\n\n";
1079             pidl "\tproto_dcerpc = proto_get_id_by_filter_name(\"dcerpc\");\n";
1080             pidl "\tproto_register_field_array(proto_dcerpc, hf, array_length(hf));\n";
1081             pidl "\tproto_register_subtree_array(ett, array_length(ett));\n";
1082
1083             pidl "}\n";
1084
1085         }
1086
1087         close(OUT);
1088 }
1089
1090 #####################################################################
1091 # rewrite autogenerated header file
1092 sub RewriteHeader($$$)
1093 {
1094     my($idl) = shift;
1095     my($input) = shift;
1096     my($output) = shift;
1097
1098     %needed = ();
1099
1100     # Open files
1101
1102     open(IN, "<$input") || die "can't open $input for reading";
1103     open(OUT, ">$output") || die "can't open $output for writing";    
1104    
1105     # Read in entire file
1106
1107     undef $/;
1108
1109     while(<IN>) {
1110
1111         # Not interested in ndr_push or ndr_print routines as they
1112         # define structures we aren't interested in.
1113
1114         s/^NTSTATUS ndr_push.*?;\n//smg;
1115         s/^void ndr_print.*?;\n//smg;
1116
1117         # Get rid of async send and receive function.
1118
1119         s/^NTSTATUS dcerpc_.*?;\n//smg;
1120         s/^struct rpc_request.*?;\n\n//smg;
1121
1122         # Rewrite librpc includes
1123
1124         s/^\#include \"librpc\/gen_ndr\/ndr_(.*?).h\"$/\#include \"packet-dcerpc-$1.h\"/smg;
1125
1126         # Convert samba fixed width types to stdint types
1127
1128         s/((u)?int)([0-9]+)/$1$3_t/smg;
1129
1130         # Rename struct ndr_pull to struct pidl_pull
1131
1132         s/struct ndr_pull \*ndr/struct pidl_pull \*ndr/smg;
1133
1134         # Change prototypes for public functions
1135
1136         s/(struct pidl_pull \*ndr, int ndr_flags)/$1, pidl_tree *tree/smg;
1137
1138         pidl $_;
1139     }
1140
1141     close(OUT);   
1142 }
1143
1144 #####################################################################
1145 # rewrite autogenerated C file
1146 sub RewriteC($$$)
1147 {
1148     my($idl) = shift;
1149     my($input) = shift;
1150     my($output) = shift;
1151
1152     # Open files
1153
1154     open(IN, "<$input") || die "can't open $input for reading";
1155     open(OUT, ">$output") || die "can't open $output for writing";    
1156     
1157     # Get name of module
1158
1159     foreach my $x (@{$idl}) {
1160         if ($x->{TYPE} eq "INTERFACE") { 
1161             ModuleHeader($x);
1162             $module = $x->{NAME};
1163             BuildNeeded($x);
1164         }
1165     }
1166
1167     pidl "#include \"eparser.h\"\n\n";
1168
1169     pidl "extern const value_string NT_errors[];\n\n";
1170
1171     # Declarations for hf variables
1172
1173     pidl "static int hf_opnum = -1;\n";
1174     pidl "static int hf_ptr = -1;\n";
1175     pidl "static int hf_array_size = -1;\n";
1176     pidl "static int hf_result_NTSTATUS = -1;\n";
1177
1178     foreach my $y (keys(%needed)) {
1179         pidl "static int $y = -1;\n", if $y =~ /^hf_/;
1180     }
1181
1182     pidl "\n";
1183
1184     foreach my $y (keys(%needed)) {
1185         pidl "static gint $y = -1;\n", if $y =~ /^ett_/;
1186     }
1187
1188     pidl "\n";
1189
1190     # Read in entire file for post-processing
1191
1192     undef $/;
1193
1194     while(<IN>) {
1195
1196         # Ethereal take care of this for us.  It also makes the other
1197         # regular expressions easier to write and understand. 
1198
1199         s/NDR_CHECK\((.*)\)/$1/g;
1200
1201         # We're not interested in ndr_print or ndr_push functions.
1202
1203         s/^(static )?NTSTATUS (ndr_push[^\(]+).*?^\}\n\n//smg;
1204         s/^void (ndr_print[^\(]+).*?^\}\n\n//smg;
1205
1206         # Get rid of dcerpc interface structures and functions
1207
1208         s/^static const struct dcerpc_interface_call .*?^\};\n\n//smg;  
1209         s/^static const char \* const ([a-z]+)_endpoint_strings.*?^\};\n\n//smg;
1210         s/^static const struct dcerpc_endpoint_list .*?^\};\n\n\n//smg; 
1211         s/^const struct dcerpc_interface_table .*?^\};\n\n//smg;        
1212         s/^static NTSTATUS dcerpc_ndr_([a-z]+)_init.*?^\}\n\n//smg;     
1213         s/^NTSTATUS dcerpc_([a-z]+)_init.*?^\}\n\n//smg;        
1214
1215         # Include packet-dcerpc-foo.h instead of ndr_foo.h
1216
1217         s/^\#include \".*?ndr_(.*?).h\"$/\#include \"packet-dcerpc-$1.h\"/smg;
1218
1219         # Call ethereal wrapper for ndr_pull_ptr() function.
1220
1221         s/(ndr_pull_ptr\(ndr, ([^\)]*?)\);)/ndr_pull_ptr(ndr, tree, hf_ptr, $2);/smg;
1222
1223         # Wrap ndr_pull_array_size() - generate wrapper that won't get
1224         # caught by the regex for wrapping scalar values below (i.e
1225         # the leading space in front of the first parameter).
1226
1227         s/(ndr_pull_array_size\(ndr, ([^\)]*?)\);)/ndr_pull_array_size( ndr, tree, $2);/smg;
1228
1229         # Add tree argument to ndr_pull_array()
1230
1231         s/(ndr_pull_array([^\(]*?)\(ndr, (NDR_[^,]*?), ([^\)].*?)\);)/ndr_pull_array$2( ndr, $3, tree, $4);/smg;
1232
1233
1234         # Call ethereal wrappers for pull of scalar values in
1235         # structures and functions:
1236         #
1237         # ndr_pull_uint32(ndr, &r->in.access_mask);
1238         # ndr_pull_uint32(ndr, &r->idx);
1239
1240         s/(ndr_pull_([^\)]*?)\(ndr, (&?r->((in|out)\.)?([^\)]*?))\);)/ndr_pull_$2(ndr, tree, hf_$6_$2, $3);/smg;
1241
1242         # Pull of "internal" scalars like array sizes, levels, etcetera.
1243
1244         s/(ndr_pull_(uint32|uint16)\(ndr, (&_([^\)]*?))\);)/ndr_pull_$2(ndr, tree, hf_$4, $3);/smg;
1245
1246         # Call ethereal wrappers for pull of buffers in structures and
1247         # functions:
1248         #
1249         # ndr_pull_string(ndr, NDR_SCALARS|NDR_BUFFERS, &r->command);
1250         # ndr_pull_atsvc_enum_ctr(ndr, NDR_SCALARS|NDR_BUFFERS, r->in.ctr);
1251
1252         s/(ndr_pull_([^\)]*?)\(ndr, (NDR_[^,]*?), ([^\(].*?)\);)/ndr_pull_$2(ndr, $3, get_subtree(tree, \"$2\", ndr, ett_$2), $4);/smg;
1253
1254         # Add proto_tree parameter to pull functions:
1255         #
1256         # static NTSTATUS ndr_pull_atsvc_JobInfo(struct ndr_pull *ndr, int ndr_flags, struct atsvc_JobInfo *r)
1257
1258         s/^((static )?NTSTATUS ndr_pull_([^\(]*?)\(struct ndr_pull \*ndr, int (ndr_)?flags)/$1, proto_tree \*tree/smg;
1259
1260         # Get rid of ndr_pull_error() calls.  Ethereal should take
1261         # care of buffer overruns and inconsistent array sizes for us.
1262
1263         s/(return ndr_pull_error([^;]*?);)/return NT_STATUS_OK; \/\/ $1/smg;
1264
1265         # Rename proto_tree args to pidl_tree
1266
1267         s/(int (ndr_)?flags), proto_tree \*tree/$1, pidl_tree \*tree/smg;
1268
1269         # Rename struct ndr_pull to struct pidl_pull
1270
1271         s/struct ndr_pull \*ndr/struct pidl_pull \*ndr/smg;
1272
1273         pidl $_;
1274     }
1275
1276     # Function call table
1277
1278     foreach my $x (@{$idl}) {
1279         if ($x->{TYPE} eq "INTERFACE") { 
1280             foreach my $y (@{$x->{"INHERITED_DATA"}}) {
1281                 ($y->{TYPE} eq "FUNCTION") && ParseFunctionPull($y);
1282             }
1283
1284             FunctionTable($x);
1285         }
1286     }
1287
1288     # Ethereal protocol registration
1289
1290     pidl "int proto_dcerpc_pidl_$module = -1;\n\n";
1291
1292     pidl "static gint ett_dcerpc_$module = -1;\n\n";
1293
1294     if (defined($if_uuid)) {
1295
1296         pidl "static e_uuid_t uuid_dcerpc_$module = {\n";
1297         pidl "\t0x" . substr($if_uuid, 1, 8);
1298         pidl ", 0x" . substr($if_uuid, 10, 4);
1299         pidl ", 0x" . substr($if_uuid, 15, 4) . ",\n";
1300         pidl "\t{ 0x" . substr($if_uuid, 20, 2);
1301         pidl ", 0x" . substr($if_uuid, 22, 2);
1302         pidl ", 0x" . substr($if_uuid, 25, 2);
1303         pidl ", 0x" . substr($if_uuid, 27, 2);
1304         pidl ", 0x" . substr($if_uuid, 29, 2);
1305         pidl ", 0x" . substr($if_uuid, 31, 2);
1306         pidl ", 0x" . substr($if_uuid, 33, 2);
1307         pidl ", 0x" . substr($if_uuid, 35, 2) . " }\n";
1308         pidl "};\n\n";
1309     }
1310
1311     if (defined($if_version)) {
1312         pidl "static guint16 ver_dcerpc_$module = " . $if_version . ";\n\n";
1313     }
1314
1315     pidl "void proto_register_dcerpc_pidl_$module(void)\n";
1316     pidl "{\n";
1317
1318     pidl "\tstatic hf_register_info hf[] = {\n";
1319     pidl "\t{ &hf_opnum, { \"Operation\", \"$module.opnum\", FT_UINT16, BASE_DEC, NULL, 0x0, \"Operation\", HFILL }},\n";
1320         pidl "\t{ &hf_result_NTSTATUS, { \"Return code\", \"$module.rc\", FT_UINT32, BASE_HEX, VALS(NT_errors), 0x0, \"Return status code\", HFILL }},\n";
1321     pidl "\t{ &hf_ptr, { \"Pointer\", \"$module.ptr\", FT_UINT32, BASE_HEX, NULL, 0x0, \"Pointer\", HFILL }},\n";
1322
1323     foreach my $x (keys(%needed)) {
1324         next, if !($x =~ /^hf_/);
1325         pidl "\t{ &$x,\n";
1326         pidl "\t  { \"$needed{$x}{name}\", \"$x\", $needed{$x}{ft}, $needed{$x}{base}, NULL, 0, \"$x\", HFILL }},\n";
1327     }
1328
1329     pidl "\t};\n\n";
1330
1331     pidl "\tstatic gint *ett[] = {\n";
1332     pidl "\t\t&ett_dcerpc_$module,\n";
1333     foreach my $x (keys(%needed)) {
1334         pidl "\t\t&$x,\n", if $x =~ /^ett_/;
1335     }
1336     pidl "\t};\n\n";
1337     
1338     if (defined($if_uuid)) {
1339
1340         pidl "\tproto_dcerpc_pidl_$module = proto_register_protocol(\"pidl_$module\", \"pidl_$module\", \"pidl_$module\");\n\n";
1341
1342         pidl "\tproto_register_field_array(proto_dcerpc_pidl_$module, hf, array_length (hf));\n";
1343         pidl "\tproto_register_subtree_array(ett, array_length(ett));\n";
1344
1345         pidl "}\n\n";
1346
1347         pidl "void proto_reg_handoff_dcerpc_pidl_$module(void)\n";
1348         pidl "{\n";
1349         pidl "\tdcerpc_init_uuid(proto_dcerpc_pidl_$module, ett_dcerpc_$module, \n";
1350         pidl "\t\t&uuid_dcerpc_$module, ver_dcerpc_$module, \n";
1351         pidl "\t\tdcerpc_dissectors, hf_opnum);\n";
1352         pidl "}\n";
1353
1354     } else {
1355
1356         pidl "\tint proto_dcerpc;\n\n";
1357         pidl "\tproto_dcerpc = proto_get_id_by_filter_name(\"dcerpc\");\n";
1358         pidl "\tproto_register_field_array(proto_dcerpc, hf, array_length(hf));\n";
1359         pidl "\tproto_register_subtree_array(ett, array_length(ett));\n";
1360
1361         pidl "}\n";
1362
1363     }
1364
1365     close(OUT);   
1366 }
1367
1368 #####################################################################
1369 # parse a parsed IDL structure back into an IDL file
1370 sub Parse($$)
1371 {
1372         my($idl) = shift;
1373         my($filename) = shift;
1374
1375         %needed = ();           # Clear after generating header file
1376
1377         open(OUT, ">$filename") || die "can't open $filename";    
1378
1379         # Look for name of module
1380
1381         foreach my $x (@{$idl}) {
1382
1383             if ($x->{TYPE} eq "INTERFACE") { 
1384                 ModuleHeader($x);
1385                 $module = $x->{NAME};
1386                 BuildNeeded($x);
1387             }
1388         }
1389         
1390         pidl "/* parser auto-generated by pidl */\n\n";
1391
1392         close(OUT);
1393 }
1394
1395 1;