1038a64b42815ce0661aa160feff07b8fbaf199d
[sfrench/samba-autobuild/.git] / source / build / pidl / Parse / Pidl / Ethereal / NDR / Parser.pm
1 ##################################################
2 # Samba4 NDR parser generator for IDL structures
3 # Copyright tridge@samba.org 2000-2003
4 # Copyright tpot@samba.org 2001
5 # Copyright jelmer@samba.org 2004-2005
6 # released under the GNU GPL
7
8 package Parse::Pidl::Ethereal::NDR::Parser;
9
10 use strict;
11 use Parse::Pidl::Typelist;
12 use Parse::Pidl::Util qw(has_property ParseExpr);
13 use Parse::Pidl::NDR;
14
15 # the list of needed functions
16
17 # list of known types
18 my %typefamily;
19
20
21 sub NeededFunction($$)
22 {
23         my $fn = shift;
24         my $needed = shift;
25         $needed->{"pull_$fn->{NAME}"} = 1;
26         foreach my $e (@{$fn->{ELEMENTS}}) {
27                 $e->{PARENT} = $fn;
28                 unless(defined($needed->{"pull_$e->{TYPE}"})) {
29                         $needed->{"pull_$e->{TYPE}"} = 1;
30                 }
31
32                 # for Ethereal
33             $needed->{"hf_$fn->{NAME}_$e->{NAME}"} = {
34                         'name' => field2name($e->{NAME}),
35                         'type' => $e->{TYPE},
36                         'ft'   => type2ft($e->{TYPE}),
37                         'base' => elementbase($e)
38                 };
39             $needed->{"hf_$e->{TYPE}"} = {
40                         'name' => field2name($e->{NAME}),
41                         'type' => $e->{TYPE},
42                         'ft'   => type2ft($e->{TYPE}),
43                         'base' => elementbase($e)
44                 };
45             $needed->{"ett_$e->{TYPE}"} = 1;
46         }
47
48         # Add entry for return value
49         if (defined($fn->{RETURN_TYPE})) {
50                 $needed->{"hf_$fn->{NAME}_result"} = {
51             'name' => field2name('result'),
52             'type' => $fn->{RETURN_TYPE},
53             'ft' => type2ft($fn->{RETURN_TYPE}),
54             'base' => elementbase($fn)
55             };
56         }
57 }
58
59 sub NeededTypedef($$)
60 {
61         my $t = shift;
62         my $needed = shift;
63
64         if (has_property($t, "public")) {
65                 $needed->{"pull_$t->{NAME}"} = not has_property($t, "nopull");
66                 $needed->{"decl_$t->{NAME}"} = not has_property($t, "nopull");
67         }
68
69         if ($t->{DATA}->{TYPE} eq "STRUCT" or $t->{DATA}->{TYPE} eq "UNION") {
70
71                 for my $e (@{$t->{DATA}->{ELEMENTS}}) {
72                         $e->{PARENT} = $t->{DATA};
73                         if ($needed->{"pull_$t->{NAME}"} and
74                                 not defined($needed->{"pull_$e->{TYPE}"})) {
75                                 $needed->{"decl_$e->{TYPE}"} = $needed->{"pull_$e->{TYPE}"} = 1;
76                         }
77
78                 $needed->{"hf_$t->{NAME}_$e->{NAME}"} = {
79                                 'name' => field2name($e->{NAME}),
80                                 'type' => $e->{TYPE},
81                                 'ft'   => type2ft($e->{TYPE}),
82                                 'base' => elementbase($e)
83                         };
84                         $needed->{"ett_$e->{TYPE}"} = 1;
85                  }
86         }
87
88         if ($t->{DATA}->{TYPE} eq "ENUM") {
89
90                 $needed->{"hf_$t->{NAME}"} = {
91                         'name' => field2name($t->{NAME}),
92                         'ft' => 'FT_UINT16',
93                         'base' => 'BASE_DEC',
94                         'strings' => "VALS($t->{NAME}_vals)"
95                 };
96                 $needed->{"ett_$t->{NAME}"} = 1;
97         }
98
99         if ($t->{DATA}->{TYPE} eq "BITMAP") {
100         $needed->{BITMAPS}->{$t->{NAME}} = $t;
101
102                 foreach my $e (@{$t->{DATA}{ELEMENTS}}) {
103                         $e =~ /^(.*?) \( (.*?) \)$/;
104                         $needed->{"hf_$t->{NAME}_$1"} = {
105                                 'name' => "$1",
106                                 'ft' => "FT_BOOLEAN",
107                                 'base' => bitmapbase($t),
108                                 'bitmask' => "$2"
109                         };
110                 }
111                 $needed->{"ett_$t->{NAME}"} = 1;
112         }
113 }
114
115 #####################################################################
116 # work out what parse functions are needed
117 sub NeededInterface($)
118 {
119         my($interface) = shift;
120         my %needed = ();
121
122         $needed{"hf_$interface->{NAME}_opnum"} = {
123                 'name' => "Operation",
124                 'ft'   => "FT_UINT16",
125                 'base' => "BASE_DEC"
126         };
127
128         $needed{"ett_dcerpc_$interface->{NAME}"} = 1;
129         
130         foreach my $d (@{$interface->{FUNCTIONS}}) {
131             NeededFunction($d, \%needed);
132         }
133         foreach my $d (reverse @{$interface->{TYPEDEFS}}) {
134             NeededTypedef($d, \%needed);
135         }
136
137         return \%needed;
138 }
139
140 sub type2ft($)
141 {
142     my($t) = shift;
143  
144     return "FT_UINT$1" if $t =~ /uint(8|16|32|64)/;
145     return "FT_INT$1" if $t =~ /int(8|16|32|64)/;
146     return "FT_UINT64", if $t eq "HYPER_T" or $t eq "NTTIME"
147         or $t eq "NTTIME_1sec" or $t eq "NTTIME_hyper" or $t eq "hyper";
148    
149    # Type is an enum
150
151     return "FT_UINT16";
152 }
153
154 # Determine the display base for an element
155
156 sub elementbase($)
157 {
158     my($e) = shift;
159
160     if (my $base = has_property($e, "display")) {
161         return "BASE_" . uc($base);
162     }
163  
164     return "BASE_DEC", if $e->{TYPE} eq "ENUM";
165     return "BASE_DEC", if $e->{TYPE} =~ /u?int(8|16|32|64)/;
166     return "BASE_DEC", if $e->{TYPE} eq "NTTIME" or $e->{TYPE} eq "HYPER_T";
167
168     # Probably an enum
169
170     return "BASE_DEC";
171 }
172
173 # Convert a IDL structure field name (e.g access_mask) to a prettier
174 # string like 'Access Mask'.
175
176 sub field2name($)
177 {
178     my($field) = shift;
179
180     $field =~ s/_/ /g;          # Replace underscores with spaces
181     $field =~ s/(\w+)/\u\L$1/g; # Capitalise each word
182     
183     return $field;
184 }
185
186 sub bitmapbase($)
187 {
188     my $e = shift;
189
190     return "16", if has_property($e->{DATA}, "bitmap16bit");
191     return "8", if has_property($e->{DATA}, "bitmap8bit");
192
193     return "32";
194 }
195
196 sub get_typefamily($)
197 {
198         my $n = shift;
199         return $typefamily{$n};
200 }
201
202 sub append_prefix($$)
203 {
204         my $e = shift;
205         my $var_name = shift;
206         my $pointers = 0;
207
208         foreach my $l (@{$e->{LEVELS}}) {
209                 if ($l->{TYPE} eq "POINTER") {
210                         $pointers++;
211                 } elsif ($l->{TYPE} eq "ARRAY") {
212                         if (($pointers == 0) and 
213                             (not $l->{IS_FIXED}) and
214                             (not $l->{IS_INLINE})) {
215                                 return get_value_of($var_name) 
216                         }
217                 } elsif ($l->{TYPE} eq "DATA") {
218                         if (typelist::scalar_is_reference($l->{DATA_TYPE})) {
219                                 return get_value_of($var_name) unless ($pointers);
220                         }
221                 }
222         }
223         
224         return $var_name;
225 }
226
227 # see if a variable needs to be allocated by the NDR subsystem on pull
228 sub need_alloc($)
229 {
230         my $e = shift;
231
232         return 0;
233 }
234
235 sub get_pointer_to($)
236 {
237         my $var_name = shift;
238         
239         if ($var_name =~ /^\*(.*)$/) {
240                 return $1;
241         } elsif ($var_name =~ /^\&(.*)$/) {
242             return $var_name;
243 #               return "&($var_name)";
244         } else {
245                 return "&$var_name";
246         }
247 }
248
249 sub get_value_of($)
250 {
251         my $var_name = shift;
252
253         if ($var_name =~ /^\&(.*)$/) {
254                 return $1;
255         } else {
256                 return "*$var_name";
257         }
258 }
259
260 my $res;
261 my $tabs = "";
262 sub pidl($)
263 {
264         my $d = shift;
265         if ($d) {
266                 $res .= $tabs;
267                 $res .= $d;
268         }
269         $res .="\n";
270 }
271
272 sub indent()
273 {
274         $tabs .= "\t";
275 }
276
277 sub deindent()
278 {
279         $tabs = substr($tabs, 0, -1);
280 }
281
282 #####################################################################
283 # check that a variable we get from ParseExpr isn't a null pointer
284 sub check_null_pointer($)
285 {
286         my $size = shift;
287         if ($size =~ /^\*/) {
288                 my $size2 = substr($size, 1);
289                 pidl "if ($size2 == NULL) return NT_STATUS_INVALID_PARAMETER_MIX;";
290         }
291 }
292
293 #####################################################################
294 # check that a variable we get from ParseExpr isn't a null pointer
295 # void return varient
296 sub check_null_pointer_void($)
297 {
298         my $size = shift;
299         if ($size =~ /^\*/) {
300                 my $size2 = substr($size, 1);
301                 pidl "if ($size2 == NULL) return;";
302         }
303 }
304
305 #####################################################################
306 # work out is a parse function should be declared static or not
307 sub fn_prefix($)
308 {
309         my $fn = shift;
310
311         return "" if (has_property($fn, "public"));
312         return "static ";
313 }
314
315 ###################################################################
316 # setup any special flags for an element or structure
317 sub start_flags($)
318 {
319         my $e = shift;
320         my $flags = has_property($e, "flag");
321         if (defined $flags) {
322                 pidl "{ uint32_t _flags_save_$e->{TYPE} = ndr->flags;";
323                 pidl "ndr_set_flags(&ndr->flags, $flags);";
324                 indent;
325         }
326 }
327
328 ###################################################################
329 # end any special flags for an element or structure
330 sub end_flags($)
331 {
332         my $e = shift;
333         my $flags = has_property($e, "flag");
334         if (defined $flags) {
335                 pidl "ndr->flags = _flags_save_$e->{TYPE};\n\t}";
336                 deindent;
337         }
338 }
339
340 sub GenerateStructEnv($)
341 {
342         my $x = shift;
343         my %env;
344
345         foreach my $e (@{$x->{ELEMENTS}}) {
346                 $env{$e->{NAME}} = "r->$e->{NAME}";
347         }
348
349         $env{"this"} = "r";
350
351         return \%env;
352 }
353
354 sub GenerateFunctionEnv($)
355 {
356         my $fn = shift;
357         my %env;
358
359         foreach my $e (@{$fn->{ELEMENTS}}) {
360                 if (grep (/out/, @{$e->{DIRECTION}})) {
361                         $env{$e->{NAME}} = "r->out.$e->{NAME}";
362                 }
363                 if (grep (/in/, @{$e->{DIRECTION}})) {
364                         $env{$e->{NAME}} = "r->in.$e->{NAME}";
365                 }
366         }
367
368         return \%env;
369 }
370
371 #####################################################################
372 sub ParseArrayPreceding($$$)
373 {
374         my $e = shift;
375         my $l = shift;
376         my $var_name = shift;
377
378         return if ($l->{NO_METADATA});
379         
380         # non fixed arrays encode the size just before the array
381         pidl "ndr_pull_array_size(ndr, tree, " . get_pointer_to($var_name) . ");";
382 }
383
384 sub compression_alg($$)
385 {
386         my $e = shift;
387         my $l = shift;
388         my $compression = $l->{COMPRESSION};
389         my ($alg, $clen, $dlen) = split(/ /, $compression);
390
391         return $alg;
392 }
393
394 sub compression_clen($$$)
395 {
396         my $e = shift;
397         my $l = shift;
398         my $env = shift;
399         my $compression = $l->{COMPRESSION};
400         my ($alg, $clen, $dlen) = split(/ /, $compression);
401
402         return ParseExpr($clen, $env);
403 }
404
405 sub compression_dlen($$$)
406 {
407         my $e = shift;
408         my $l = shift;
409         my $env = shift;
410         my $compression = $l->{COMPRESSION};
411         my ($alg, $clen, $dlen) = split(/ /, $compression);
412
413         return ParseExpr($dlen, $env);
414 }
415
416 sub ParseCompressionStart($$$$)
417 {
418         my $e = shift;
419         my $l = shift;
420         my $subndr = shift;
421         my $env = shift;
422         my $comndr = $subndr."_compressed";
423         my $alg = compression_alg($e, $l);
424         my $dlen = compression_dlen($e, $l, $env);
425
426         pidl "{";
427         indent;
428         pidl "struct pidl_pull *$comndr;";
429         pidl "NDR_ALLOC($subndr, $comndr);";
430         pidl "ndr_pull_compression($subndr, $comndr, $alg, $dlen);";
431
432         return $comndr;
433 }
434
435 sub ParseCompressionEnd($$$)
436 {
437         my $e = shift;
438         my $l = shift;
439         my $subndr = shift;
440         my $comndr = $subndr."_compressed";
441
442         deindent;
443         pidl "}";
444 }
445
446 sub ParseObfuscationStart($$)
447 {
448         my $e = shift;
449         my $ndr = shift;
450         my $obfuscation = has_property($e, "obfuscation");
451
452         pidl "ndr_pull_obfuscation($ndr, $obfuscation);";
453
454         return $ndr;
455 }
456
457 sub ParseObfuscationEnd($$)
458 {
459         my $e = shift;
460         my $ndr = shift;
461
462         # nothing to do here
463 }
464
465 sub ParseSubcontextStart($$$$$$)
466 {
467         my $e = shift;
468         my $l = shift;
469         my $ndr = shift;
470         my $var_name = shift;
471         my $ndr_flags = shift;  
472         my $env = shift;
473         my $retndr = "_ndr_$e->{NAME}";
474
475         pidl "/* NDR_FLAGS $ndr_flags */";
476         pidl "if ((ndr_flags) & NDR_SCALARS) {";
477         indent;
478         pidl "struct pidl_pull *$retndr;";
479         pidl "NDR_ALLOC(ndr, $retndr);";
480         pidl "ndr_pull_subcontext_header($ndr, $l->{HEADER_SIZE}, $l->{SUBCONTEXT_SIZE}, $retndr);"; 
481
482         if (defined $l->{COMPRESSION}) {
483                 $retndr = ParseCompressionStart($e, $l, $retndr, $env);
484         }
485
486         if (defined $l->{OBFUSCATION}) {
487                 $retndr = ParseObfuscationStart($e, $retndr);
488         }
489         
490         return ($retndr,$var_name);
491 }
492
493 sub ParseSubcontextEnd($$)
494 {
495         my $e = shift;
496         my $l = shift;
497         my $ndr = "_ndr_$e->{NAME}";
498
499         if (defined $l->{COMPRESSION}) {
500                 ParseCompressionEnd($e, $l, $ndr);
501         }
502
503         if (defined $l->{OBFUSCATION}) {
504                 ParseObfuscationEnd($e, $ndr);
505         }
506
507         my $advance;
508         if (defined($l->{SUBCONTEXT_SIZE}) and ($l->{SUBCONTEXT_SIZE} ne "-1")) {
509                 $advance = $l->{SUBCONTEXT_SIZE};
510         } elsif ($l->{HEADER_SIZE}) {
511                 $advance = "$ndr->data_size";
512         } else {
513                 $advance = "$ndr->offset";
514         }
515         pidl "ndr_pull_advance(ndr, $advance);";
516         deindent;
517         pidl "}";
518 }
519
520 #####################################################################
521 # parse scalars in a structure element - pull size
522 sub ParseSwitch($$$$$$)
523 {
524         my($e) = shift;
525         my $l = shift;
526         my $ndr = shift;
527         my($var_name) = shift;
528         my($ndr_flags) = shift;
529         my $env = shift;
530         my $switch_var = ParseExpr($l->{SWITCH_IS}, $env);
531
532         check_null_pointer($switch_var);
533
534         $var_name = get_pointer_to($var_name);
535         pidl "ndr_pull_set_switch_value($ndr, $var_name, $switch_var);";
536
537 }
538
539 sub ParseData($$$$$)
540 {
541         my $e = shift;
542         my $l = shift;
543         my $ndr = shift;
544         my $var_name = shift;
545         my $ndr_flags = shift;
546
547         #
548         #  ALAND! for packet-dcerpc-lsa.c, uncommenting this code
549         #  produces constructs like &(&r->string), to pass to another
550         #  function, which gives compiler errors.
551         #
552         if (typelist::scalar_is_reference($l->{DATA_TYPE})) {
553                 $var_name = get_pointer_to($var_name);
554         }
555
556         $var_name = get_pointer_to($var_name);
557
558         pidl "offset += dissect_$l->{DATA_TYPE}(tvb, offset, pinfo, tree, drep, hf_FIXME, NULL);";
559
560         if (my $range = has_property($e, "range")) {
561                 $var_name = get_value_of($var_name);
562                 my ($low, $high) = split(/ /, $range, 2);
563                 if (($l->{DATA_TYPE} =~ /^uint/) and ($low eq "0")) {
564                     pidl "if ($var_name > $high) {";
565                 } else {
566                     pidl "if ($var_name < $low || $var_name > $high) {";
567                 }
568                 pidl "\treturn NT_STATUS_OK;";
569                 pidl "}";
570         }
571 }
572
573 sub CalcNdrFlags($$$)
574 {
575         my $l = shift;
576         my $primitives = shift;
577         my $deferred = shift;
578
579         my $scalars = 0;
580         my $buffers = 0;
581
582         # Add NDR_SCALARS if this one is deferred 
583         # and deferreds may be pushed
584         $scalars = 1 if ($l->{IS_DEFERRED} and $deferred);
585
586         # Add NDR_SCALARS if this one is not deferred and 
587         # primitives may be pushed
588         $scalars = 1 if (!$l->{IS_DEFERRED} and $primitives);
589         
590         # Add NDR_BUFFERS if this one contains deferred stuff
591         # and deferreds may be pushed
592         $buffers = 1 if ($l->{CONTAINS_DEFERRED} and $deferred);
593
594         return "NDR_SCALARS|NDR_BUFFERS" if ($scalars and $buffers);
595         return "NDR_SCALARS" if ($scalars);
596         return "NDR_BUFFERS" if ($buffers);
597         return undef;
598 }
599
600
601 sub ParseElementLevel
602 {
603         my($e) = shift;
604         my $l = shift;
605         my $ndr = shift;
606         my($var_name) = shift;
607         my $env = shift;
608         my $primitives = shift;
609         my $deferred = shift;
610
611         my $ndr_flags = CalcNdrFlags($l, $primitives, $deferred);
612
613         # Only pull something if there's actually something to be pulled
614         if (defined($ndr_flags)) {
615                 if ($l->{TYPE} eq "SUBCONTEXT") {
616                                 ($ndr,$var_name) = ParseSubcontextStart($e, $l, $ndr, $var_name, $ndr_flags, $env);
617                                 ParseElementLevel($e,Ndr::GetNextLevel($e,$l), $ndr, $var_name, $env, $primitives, $deferred);
618                                 ParseSubcontextEnd($e, $l);
619                 } elsif ($l->{TYPE} eq "ARRAY") {
620                         my $length = ParseArrayHeader($e, $l, $ndr, $var_name, $env); 
621                 } elsif ($l->{TYPE} eq "POINTER") {
622                         ParsePtr($e, $l, $ndr, $var_name);
623                 } elsif ($l->{TYPE} eq "SWITCH") {
624                         ParseSwitch($e, $l, $ndr, $var_name, $ndr_flags, $env);
625                 } elsif ($l->{TYPE} eq "DATA") {
626                         ParseData($e, $l, $ndr, $var_name, $ndr_flags);
627                 }
628         }
629
630         # add additional constructions
631         if ($l->{TYPE} eq "POINTER" and $deferred) {
632                 if ($l->{POINTER_TYPE} ne "ref") {
633                         pidl "if ($var_name) {";
634                         indent;
635
636                         if ($l->{POINTER_TYPE} eq "relative") {
637                                 pidl "struct ndr_pull_save _relative_save;";
638                                 pidl "ndr_pull_save(ndr, &_relative_save);";
639                                 pidl "NDR_CHECK(ndr_pull_relative_ptr2(ndr, $var_name));";
640                         }
641                 }
642
643                 $var_name = get_value_of($var_name);
644                 ParseElementLevel($e,Ndr::GetNextLevel($e,$l), $ndr, $var_name, $env, $primitives, $deferred);
645
646                 if ($l->{POINTER_TYPE} ne "ref") {
647                 if ($l->{POINTER_TYPE} eq "relative") {
648                                 pidl "ndr_pull_restore(ndr, &_relative_save);";
649                         }
650                         deindent;
651                         pidl "}";
652                 }
653         } elsif ($l->{TYPE} eq "ARRAY") {
654                 my $length = ParseExpr($l->{LENGTH_IS}, $env);
655                 my $counter = "cntr_$e->{NAME}_$l->{LEVEL_INDEX}";
656
657                 $var_name = $var_name . "[$counter]";
658                 unless ($l->{NO_METADATA}) {
659                         $var_name = get_pointer_to($var_name);
660                 }
661
662                 if (($primitives and not $l->{IS_DEFERRED}) or ($deferred and $l->{IS_DEFERRED})) {
663                         pidl "for ($counter = 0; $counter < $length; $counter++) {";
664                         indent;
665                         ParseElementLevel($e,Ndr::GetNextLevel($e,$l), $ndr, $var_name, $env, 1, 0);
666                         deindent;
667                         pidl "}";
668                 }
669
670                 if ($deferred and Ndr::ContainsDeferred($e, $l)) {
671                         pidl "for ($counter = 0; $counter < $length; $counter++) {";
672                         indent;
673                         ParseElementLevel($e,Ndr::GetNextLevel($e,$l), $ndr, $var_name, $env, 0, 1);
674                         deindent;
675                         pidl "}";
676                 }
677         } elsif ($l->{TYPE} eq "SWITCH") {
678                 ParseElementLevel($e,Ndr::GetNextLevel($e,$l), $ndr, $var_name, $env, $primitives, $deferred);
679         }
680 }
681
682 #####################################################################
683 # parse scalars in a structure element - pull size
684 sub ParseElement($$$$$$)
685 {
686         my($e) = shift;
687         my $ndr = shift;
688         my($var_prefix) = shift;
689         my $env = shift;
690         my $primitives = shift;
691         my $deferred = shift;
692
693         my $var_name = $var_prefix.$e->{NAME};
694
695         $var_name = append_prefix($e, $var_name);
696
697         return unless $primitives or ($deferred and Ndr::ContainsDeferred($e, $e->{LEVELS}[0]));
698
699         start_flags($e);
700
701         ParseElementLevel($e,$e->{LEVELS}[0],$ndr,$var_name,$env,$primitives,$deferred);
702
703         end_flags($e);
704 }
705
706 #####################################################################
707 # parse a pointer in a struct element or function
708 sub ParsePtr($$$$)
709 {
710         my($e) = shift;
711         my $l = shift;
712         my $ndr = shift;
713         my($var_name) = shift;
714
715         my $nl = Ndr::GetNextLevel($e, $l);
716         my $next_is_array = ($nl->{TYPE} eq "ARRAY");
717
718         if ($l->{LEVEL} eq "EMBEDDED") {
719                 pidl "dissect_ndr_embedded_pointer(FIXME);";
720         } elsif ($l->{POINTER_TYPE} ne "ref") {
721                         pidl "dissect_ndr_toplevel_pointer(FIXME);";
722         }
723
724         #pidl "memset($var_name, 0, sizeof($var_name));";
725         if ($l->{POINTER_TYPE} eq "relative") {
726                 pidl "ndr_pull_relative_ptr1($ndr, $var_name, _ptr_$e->{NAME});";
727         }
728 }
729
730 $typefamily{ENUM} = {
731         DECL => \&DeclEnum,
732 };
733
734 #####################################################################
735 # generate a pull function for an bitmap
736 sub ParseBitmap($$)
737 {
738         my($bitmap) = shift;
739         my $name = shift;
740         my $type_fn = $bitmap->{BASE_TYPE};
741         my($type_decl) = typelist::mapType($bitmap->{BASE_TYPE});
742
743         pidl "$type_decl v_bitmap;";
744         start_flags($bitmap);
745         pidl "dissect_$type_fn(ndr, tree, hf, &v_bitmap);";
746         
747         pidl "{\n\tproto_tree *subtree = NULL;";
748         pidl "";
749         pidl "\tif (tree->proto_tree)\n\t\tsubtree = proto_item_add_subtree(tree->proto_tree->last_child, ett_$name);";
750         pidl "";
751         foreach my $e (@{$bitmap->{DATA}{ELEMENTS}}) {
752             $e =~ /^(.*?) \( (.*?) \)$/;
753             pidl "\tproto_tree_add_boolean(subtree, hf_${name}_$1, ndr->tvb, ndr->offset - sizeof(v_bitmap), sizeof(v_bitmap), v_bitmap);";
754         }
755         pidl "}";
756
757         pidl "*r = v_bitmap;";
758
759         end_flags($bitmap);
760 }
761
762 $typefamily{BITMAP} = {
763         FN_BODY => \&ParseBitmap,
764 };
765
766 #####################################################################
767 # parse a struct - pull side
768 sub ParseStruct($$)
769 {
770         my($struct) = shift;
771         my $name = shift;
772         my $conform_e;
773
774         return unless defined $struct->{ELEMENTS};
775
776         my $env = GenerateStructEnv($struct);
777
778         # see if the structure contains a conformant array. If it
779         # does, then it must be the last element of the structure, and
780         # we need to pull the conformant length early, as it fits on
781         # the wire before the structure (and even before the structure
782         # alignment)
783         $conform_e = $struct->{SURROUNDING_ELEMENT};
784
785         # declare any internal pointers we need
786         foreach my $e (@{$struct->{ELEMENTS}}) {
787                 foreach my $l (@{$e->{LEVELS}}) {
788                         if ($l->{TYPE} eq "POINTER" and not ($l->{POINTER_TYPE} eq "ref" and $l->{LEVEL} eq "TOP")) {
789                                 pidl "uint32_t _ptr_$e->{NAME};";
790                                 last;
791                         }
792                 }
793         }
794
795         start_flags($struct);
796
797         pidl "if (ndr_flags & NDR_SCALARS) {";
798         indent;
799
800         if (defined $conform_e) {
801                 ParseArrayPreceding($conform_e, $conform_e->{LEVELS}[0], "r->$conform_e->{NAME}");
802         }
803
804         pidl "ndr_pull_align(ndr, $struct->{ALIGN});";
805
806         foreach my $e (@{$struct->{ELEMENTS}}) {
807                 ParseElement($e, "ndr", "r->", $env, 1, 0);
808         }       
809         deindent;
810         pidl "}";
811
812         pidl "if (ndr_flags & NDR_BUFFERS) {";
813         indent;
814         foreach my $e (@{$struct->{ELEMENTS}}) {
815                 ParseElement($e, "ndr", "r->", $env, 0, 0);
816         }
817
818         pidl "proto_item_set_end(tree->proto_tree, ndr->tvb, ndr->offset);";
819         deindent;
820         pidl "}";
821
822         end_flags($struct);
823 }
824
825 $typefamily{STRUCT} = {
826         FN_BODY => \&ParseStruct,
827 };
828
829 #####################################################################
830 # parse a union - pull side
831 sub ParseUnion($$$)
832 {
833         my $e = shift;
834         my $name = shift;
835         my $have_default = 0;
836         my $switch_type = $e->{SWITCH_TYPE};
837
838         pidl "int level;";
839         if (defined($switch_type)) {
840                 if (typelist::typeIs($switch_type, "ENUM")) {
841                         $switch_type = typelist::enum_type_fn(typelist::getType($switch_type));
842                 }
843                 pidl typelist::mapType($switch_type) . " _level;";
844         }
845
846         start_flags($e);
847
848         pidl "level = ndr_pull_get_switch_value(ndr, r);";
849
850         pidl "if (ndr_flags & NDR_SCALARS) {";
851         indent;
852
853         if (defined($switch_type)) {
854                 pidl "ndr_pull_$switch_type(ndr, tree, hf_${name}, &_level);";
855                 pidl "if (_level != level) {"; 
856                 pidl "\treturn NT_STATUS_OK;";
857                 pidl "}";
858         }
859
860 #       my $align = union_alignment($e);
861 #       pidl "\tndr_pull_align(ndr, $align);\n";
862
863         pidl "switch (level) {";
864         indent;
865         foreach my $el (@{$e->{ELEMENTS}}) {
866                 if ($el->{CASE} eq "default") {
867                         $have_default = 1;
868                 } 
869                 pidl "$el->{CASE}: {";
870
871                 if ($el->{TYPE} ne "EMPTY") {
872                         indent;
873                         foreach my $l (@{$el->{LEVELS}}) {
874                                 if ($l->{TYPE} eq "POINTER" and not ($l->{POINTER_TYPE} eq "ref" and $l->{LEVEL} eq "TOP")) {
875                                         pidl "uint32_t _ptr_$el->{NAME};";
876                                         last;
877                                 }
878                         }
879                         ParseElement($el, "ndr", "r->", {}, 1, 0);
880                         deindent;
881                 }
882                 pidl "break; }";
883                 pidl "";
884         }
885         if (! $have_default) {
886                 pidl "default:";
887                 pidl "\treturn NT_STATUS_OK;";
888         }
889         deindent;
890         pidl "}";
891         deindent;
892         pidl "}";
893         pidl "if (ndr_flags & NDR_BUFFERS) {";
894         indent;
895         pidl "switch (level) {";
896         indent;
897         foreach my $el (@{$e->{ELEMENTS}}) {
898                 pidl "$el->{CASE}:";
899                 if ($el->{TYPE} ne "EMPTY") {
900                         indent;
901                         ParseElement($el, "ndr", "r->", {}, 0, 1);
902                         deindent;
903                 }
904                 pidl "break;";
905                 pidl "";
906         }
907         if (! $have_default) {
908                 pidl "default:";
909                 pidl "\treturn NT_STATUS_OK;";
910         }
911         deindent;
912         pidl "}";
913         pidl "proto_item_set_end(tree->proto_tree, ndr->tvb, ndr->offset);";
914         deindent;
915         pidl "}";
916         end_flags($e);
917 }
918
919 $typefamily{UNION} = {
920         FN_BODY => \&ParseUnion,
921 };
922
923 #####################################################################
924 # parse an array
925 sub ParseArrayHeader($$$$$)
926 {
927         my $e = shift;
928         my $l = shift;
929         my $ndr = shift;
930         my $var_name = shift;
931         my $env = shift;
932
933         unless ($l->{NO_METADATA}) {
934                 $var_name = get_pointer_to($var_name);
935         }
936
937         # $var_name contains the name of the first argument here
938
939         my $length = ParseExpr($l->{SIZE_IS}, $env);
940         my $size = $length;
941
942         if ($l->{IS_CONFORMANT}) {
943                 $length = $size = "ndr_get_array_size($ndr, " . get_pointer_to($var_name) . ")";
944         }
945
946         # if this is a conformant array then we use that size to allocate, and make sure
947         # we allocate enough to pull the elements
948         if (!$l->{IS_SURROUNDING}) {
949                 ParseArrayPreceding($e, $l, $var_name);
950         }
951
952
953         if ($l->{IS_VARYING}) {
954                 pidl "NDR_CHECK(ndr_pull_array_length($ndr, " . get_pointer_to($var_name) . "));";
955                 $length = "ndr_get_array_length($ndr, " . get_pointer_to($var_name) .")";
956         }
957
958         check_null_pointer($length);
959
960         if ($length ne $size) {
961                 pidl "if ($length > $size) {";
962                 indent;
963                 pidl "return ndr_pull_error($ndr, NDR_ERR_ARRAY_SIZE, \"Bad array size %u should exceed array length %u\", $size, $length);";
964                 deindent;
965                 pidl "}";
966         }
967
968         if ($l->{IS_CONFORMANT}) {
969                 my $size = ParseExpr($l->{SIZE_IS}, $env);
970                 check_null_pointer($size);
971                 pidl "NDR_CHECK(ndr_check_array_size(ndr, (void*)" . get_pointer_to($var_name) . ", $size));";
972         }
973
974         if ($l->{IS_VARYING}) {
975                 my $length = ParseExpr($l->{LENGTH_IS}, $env);
976                 check_null_pointer($length);
977                 pidl "NDR_CHECK(ndr_check_array_length(ndr, (void*)" . get_pointer_to($var_name) . ", $length));";
978         }
979
980         return $length;
981 }
982         
983 #####################################################################
984 # parse a typedef - pull side
985 sub ParseTypedef($)
986 {
987         my($e) = shift;
988
989         return unless (defined ($typefamily{$e->{DATA}->{TYPE}}));
990
991         pidl fn_prefix($e) . "int dissect_$e->{NAME}(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *tree, int hf_index, guint32 param)";
992
993         pidl "{";
994         indent;
995         $typefamily{$e->{DATA}->{TYPE}}->{FN_BODY}->($e->{DATA}, $e->{NAME});
996         pidl "return NT_STATUS_OK;";
997         deindent;
998         pidl "}";
999         pidl "";
1000 }
1001
1002 #####################################################################
1003 # parse a function
1004 sub ParseFunctionRqst($)
1005
1006         my($fn) = shift;
1007
1008         my $env = GenerateFunctionEnv($fn);
1009
1010         # request function
1011         pidl "static int dissect_$fn->{NAME}_rqst(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *tree, guint8 *drep)";
1012         pidl "{";
1013         indent;
1014
1015         pidl "struct pidl_pull *ndr = pidl_pull_init(tvb, offset, pinfo, drep);";
1016
1017         # declare any internal pointers we need
1018         foreach my $e (@{$fn->{ELEMENTS}}) {
1019                 next unless (grep (/in/, @{$e->{DIRECTIONS}}));
1020                 foreach my $l (@{$e->{LEVELS}}) {
1021                         if ($l->{TYPE} eq "POINTER" and 
1022                                 not ($l->{POINTER_TYPE} eq "ref" and 
1023                                 $l->{LEVEL} eq "TOP")) {
1024                                 pidl "uint32_t _ptr_$e->{NAME};"; 
1025                                 last;
1026                         }
1027                 }
1028         }
1029
1030         foreach my $e (@{$fn->{ELEMENTS}}) {
1031                 next unless (grep(/in/, @{$e->{DIRECTION}}));
1032                 ParseElement($e, "ndr", "r->in.", $env, 1, 1);
1033         }
1034
1035         pidl "return offset;";
1036         deindent;
1037         pidl "}";
1038         pidl "";
1039 }
1040
1041 sub ParseFunctionResp($)
1042
1043         my($fn) = shift;
1044
1045         my $env = GenerateFunctionEnv($fn);
1046
1047         # response function
1048         pidl "static int dissect_$fn->{NAME}_resp(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *tree, guint8 *drep)";
1049         pidl "{";
1050         indent;
1051
1052         pidl "struct pidl_pull *ndr = pidl_pull_init(tvb, offset, pinfo, drep);";
1053
1054         # declare any internal pointers we need
1055         foreach my $e (@{$fn->{ELEMENTS}}) {
1056                 next unless (grep (/out/, @{$e->{DIRECTIONS}}));
1057                 foreach my $l (@{$e->{LEVELS}}) {
1058                         if ($l->{TYPE} eq "POINTER" and 
1059                                 not ($l->{POINTER_TYPE} eq "ref" and 
1060                                 $l->{LEVEL} eq "TOP")) {
1061                                 pidl "uint32_t _ptr_$e->{NAME};"; 
1062                                 last;
1063                         }
1064                 }
1065         }
1066
1067         foreach my $e (@{$fn->{ELEMENTS}}) {
1068                 next unless grep(/out/, @{$e->{DIRECTION}});
1069                 ParseElement($e, "ndr", "r->out.", $env, 1, 1);
1070         }
1071
1072         if ($fn->{RETURN_TYPE}) {
1073                 pidl "dissect_$fn->{RETURN_TYPE}(ndr, tree, hf_$fn->{NAME}_result, drep);";
1074         }
1075
1076         pidl "return offset;";
1077         deindent;
1078         pidl "}";
1079         pidl "";
1080 }
1081
1082 #####################################################################
1083 # produce a function call table
1084 sub FunctionTable($)
1085 {
1086         my($interface) = shift;
1087
1088         pidl "static dcerpc_sub_dissector dcerpc_dissectors[] = {";
1089         my $num = 0;
1090         foreach my $d (@{$interface->{FUNCTIONS}}) {
1091             # Strip interface name from function name, if present
1092             my($n) = $d->{NAME};
1093             $n = substr($d->{NAME}, length($interface->{NAME}) + 1),
1094                 if $interface->{NAME} eq substr($d->{NAME}, 0, length($interface->{NAME}));
1095             pidl "\t{ $num, \"$n\",";
1096             pidl "\t\tdissect_$d->{NAME}_rqst,";
1097             pidl "\t\tdissect_$d->{NAME}_resp },";
1098             $num++;
1099         }
1100         pidl "};\n";
1101 }
1102
1103 #####################################################################
1104 # parse the interface definitions
1105 sub ParseInterface($$)
1106 {
1107         my($interface) = shift;
1108         my $needed = shift;
1109
1110         # Typedefs
1111         foreach my $d (@{$interface->{TYPEDEFS}}) {
1112                 ($needed->{"pull_$d->{NAME}"}) && ParseTypedef($d);
1113                 # Make sure we don't generate a function twice...
1114                 $needed->{"pull_$d->{NAME}"} = 0;
1115         }
1116
1117         # Functions
1118         foreach my $d (@{$interface->{FUNCTIONS}}) {
1119                 if ($needed->{"pull_$d->{NAME}"}) {
1120                         ParseFunctionRqst($d);
1121                         ParseFunctionResp($d);
1122                 }
1123
1124                 # Make sure we don't generate a function twice...
1125                 $needed->{"pull_$d->{NAME}"} = 0;
1126         }
1127 }
1128
1129 #####################################################################
1130 # generate code to parse an enum
1131 sub DeclEnum($$)
1132 {
1133     my ($e) = shift;
1134         my $n = shift;
1135
1136     pidl "static const value_string $n\_vals[] =";
1137     pidl "{";
1138
1139     foreach my $x (@{$e->{ELEMENTS}}) {
1140         $x =~ /([^=]*)=(.*)/;
1141         pidl "\t{ $1, \"$1\" },";
1142     }
1143     
1144     pidl "};\n";
1145 }
1146
1147 sub DeclInterface($$)
1148 {
1149         my($interface) = shift;
1150         my $needed = shift;
1151
1152         # Typedefs
1153         foreach my $d (@{$interface->{TYPEDEFS}}) {
1154                 ($needed->{"decl_$d->{NAME}"}) && DeclTypedef($d, $needed);
1155         }
1156 }
1157
1158 sub DeclTypedef($$)
1159 {
1160         my $e = shift;
1161         my $needed = shift;
1162
1163         if (defined($typefamily{$e->{DATA}->{TYPE}}->{DECL})) {
1164                 $typefamily{$e->{DATA}->{TYPE}}->{DECL}->($e->{DATA}, $e->{NAME});
1165
1166                 # Make sure we don't generate a function twice...
1167                 $needed->{"decl_$e->{NAME}"} = 0;
1168         }
1169 }
1170
1171 sub RegisterInterface($$)
1172 {
1173         my $x = shift;
1174         my $needed = shift;
1175
1176         pidl "void proto_register_dcerpc_pidl_$x->{NAME}(void)";
1177         pidl "{";
1178         indent;
1179         
1180         pidl "static hf_register_info hf[] = {";
1181         pidl "{ &hf_ptr, { \"Pointer\", \"$x->{NAME}.ptr\", FT_UINT32, BASE_HEX, NULL, 0x0, \"Pointer\", HFILL }},";
1182         
1183         foreach my $x (sort keys(%{$needed})) {
1184             next, if !($x =~ /^hf_/);
1185             pidl "{ &$x,";
1186             $needed->{$x}->{strings} = "NULL", if !defined($needed->{$x}->{strings});
1187             $needed->{$x}->{bitmask} = "0", if !defined($needed->{$x}->{bitmask});
1188             pidl "  { \"$needed->{$x}->{name}\", \"$x\", $needed->{$x}->{ft}, $needed->{$x}->{base}, $needed->{$x}->{strings}, $needed->{$x}->{bitmask}, \"$x\", HFILL }},";
1189         }
1190         
1191         pidl "};\n";
1192         
1193         pidl "static gint *ett[] = {";
1194         indent;
1195         foreach my $x (sort keys(%{$needed})) {
1196             pidl "&$x,", if $x =~ /^ett_/;
1197         }
1198         deindent;
1199
1200         pidl "};\n";
1201
1202         if (defined($x->{UUID})) {
1203             # These can be changed to non-pidl names if the old dissectors
1204             # in epan/dissctors are deleted.
1205     
1206             my $name = "\"" . uc($x->{NAME}) . " (pidl)\"";
1207                 if (has_property($x, "helpstring")) {
1208                         $name = $x->{PROPERTIES}->{helpstring};
1209                 }
1210             my $short_name = "pidl_$x->{NAME}";
1211             my $filter_name = "pidl_$x->{NAME}";
1212     
1213             pidl "proto_dcerpc_pidl_$x->{NAME} = proto_register_protocol($name, \"$short_name\", \"$filter_name\");";
1214             
1215             pidl "proto_register_field_array(proto_dcerpc_pidl_$x->{NAME}, hf, array_length (hf));";
1216             pidl "proto_register_subtree_array(ett, array_length(ett));";
1217         } else {
1218             pidl "int proto_dcerpc;";
1219             pidl "proto_dcerpc = proto_get_id_by_filter_name(\"dcerpc\");";
1220             pidl "proto_register_field_array(proto_dcerpc, hf, array_length(hf));";
1221             pidl "proto_register_subtree_array(ett, array_length(ett));";
1222         }
1223             
1224         deindent;
1225         pidl "}\n";
1226 }
1227
1228 sub RegisterInterfaceHandoff($)
1229 {
1230         my $x = shift;
1231         pidl "void proto_reg_handoff_dcerpc_pidl_$x->{NAME}(void)";
1232         pidl "{";
1233         indent;
1234         pidl "dcerpc_init_uuid(proto_dcerpc_pidl_$x->{NAME}, ett_dcerpc_$x->{NAME},";
1235         pidl "\t&uuid_dcerpc_$x->{NAME}, ver_dcerpc_$x->{NAME},";
1236         pidl "\tdcerpc_dissectors, hf_$x->{NAME}_opnum);";
1237         deindent;
1238         pidl "}";
1239 }
1240
1241 sub ProcessInterface($)
1242 {
1243         my $x = shift;
1244         my $needed = NeededInterface($x);
1245
1246         # Required global declarations
1247         DeclInterface($x, $needed);
1248
1249         foreach my $y (sort keys(%{$needed})) {
1250             pidl "static int $y = -1;", if $y =~ /^hf_/;
1251         }
1252         pidl "";
1253
1254         foreach my $y (sort keys(%{$needed})) {
1255             pidl "static gint $y = -1;", if $y =~ /^ett_/;
1256         }
1257         pidl "";
1258
1259         pidl "int proto_dcerpc_pidl_$x->{NAME} = -1;\n";
1260         
1261         if (defined($x->{UUID})) {
1262                 my $if_uuid = $x->{UUID};
1263             
1264             pidl "static e_uuid_t uuid_dcerpc_$x->{NAME} = {";
1265             pidl "\t0x" . substr($if_uuid, 1, 8) 
1266                 . ", 0x" . substr($if_uuid, 10, 4)
1267             . ", 0x" . substr($if_uuid, 15, 4) . ",";
1268             pidl "\t{ 0x" . substr($if_uuid, 20, 2) 
1269                 . ", 0x" . substr($if_uuid, 22, 2)
1270             . ", 0x" . substr($if_uuid, 25, 2)
1271             . ", 0x" . substr($if_uuid, 27, 2)
1272             . ", 0x" . substr($if_uuid, 29, 2)
1273             . ", 0x" . substr($if_uuid, 31, 2)
1274             . ", 0x" . substr($if_uuid, 33, 2)
1275             . ", 0x" . substr($if_uuid, 35, 2) . " }";
1276             pidl "};\n";
1277         
1278             pidl "static guint16 ver_dcerpc_$x->{NAME} = $x->{VERSION};";
1279         }
1280
1281         # dissect_* functions
1282         ParseInterface($x, $needed);
1283
1284         # Function call tables
1285         FunctionTable($x);
1286
1287         RegisterInterface($x, $needed);
1288         RegisterInterfaceHandoff($x);
1289 }
1290
1291 #####################################################################
1292 # parse a parsed IDL structure back into an IDL file
1293 sub Parse($$$)
1294 {
1295         my($ndr) = shift;
1296         my $module = shift;
1297         my($filename) = shift;
1298
1299         $tabs = "";
1300         my $h_filename = $filename;
1301         $res = "";
1302
1303         if ($h_filename =~ /(.*)\.c/) {
1304                 $h_filename = "$1.h";
1305         }
1306
1307         pidl "/* parser auto-generated by pidl */";
1308         pidl "#include \"packet-dcerpc.h\"";
1309         pidl "#include \"$h_filename\"";
1310         pidl "";
1311         pidl "static int hf_ptr = -1;";
1312         pidl "static int hf_array_size = -1;";
1313         pidl "";
1314
1315 #       print keys %{$needed->{hf_atsvc_JobGetInfo_result}}, "\n";
1316
1317         # Ethereal protocol registration
1318
1319         ProcessInterface($_) foreach (@$ndr);
1320     
1321         return $res;
1322 }
1323
1324 1;