r9081: Work on new ethereal parser generator, partially based on
[sfrench/samba-autobuild/.git] / source / build / pidl / Parse / Pidl / Ethereal / NDR.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 # Portions based on idl2eth.c by Ronnie Sahlberg
7 # released under the GNU GPL
8
9 package Parse::Pidl::Ethereal::NDR::Parser;
10
11 use strict;
12 use Parse::Pidl::Typelist;
13 use Parse::Pidl::Util qw(has_property ParseExpr);
14 use Parse::Pidl::NDR;
15 use Parse::Pidl::Ethereal::Conformance qw(EmitProhibited);
16
17 my %ptrtype_define_mappings = (
18         "unique" => "NDR_POINTER_UNIQUE",
19         "ref" => "NDR_POINTER_REF",
20         "ptr" => "NDR_POINTER_PTR"
21 );
22
23 sub type2ft($)
24 {
25     my($t) = shift;
26  
27     return "FT_UINT$1" if $t =~ /uint(8|16|32|64)/;
28     return "FT_INT$1" if $t =~ /int(8|16|32|64)/;
29     return "FT_UINT64", if $t eq "HYPER_T" or $t eq "NTTIME"
30         or $t eq "NTTIME_1sec" or $t eq "NTTIME_hyper" or $t eq "hyper";
31    
32    # Type is an enum
33
34     return "FT_UINT16";
35 }
36
37 # Determine the display base for an element
38
39 sub elementbase($)
40 {
41     my($e) = shift;
42
43     if (my $base = has_property($e, "display")) {
44         return "BASE_" . uc($base);
45     }
46  
47     return "BASE_DEC", if $e->{TYPE} eq "ENUM";
48     return "BASE_DEC", if $e->{TYPE} =~ /u?int(8|16|32|64)/;
49     return "BASE_DEC", if $e->{TYPE} eq "NTTIME" or $e->{TYPE} eq "HYPER_T";
50
51     # Probably an enum
52
53     return "BASE_DEC";
54 }
55
56 # Convert a IDL structure field name (e.g access_mask) to a prettier
57 # string like 'Access Mask'.
58
59 sub field2name($)
60 {
61     my($field) = shift;
62
63     $field =~ s/_/ /g;          # Replace underscores with spaces
64     $field =~ s/(\w+)/\u\L$1/g; # Capitalise each word
65     
66     return $field;
67 }
68
69 sub bitmapbase($)
70 {
71     my $e = shift;
72
73     return "16", if has_property($e->{DATA}, "bitmap16bit");
74     return "8", if has_property($e->{DATA}, "bitmap8bit");
75
76     return "32";
77 }
78
79 my %res = ();
80 my $tabs = "";
81 sub pidl_code($)
82 {
83         my $d = shift;
84         if ($d) {
85                 $res{code} .= $tabs;
86                 $res{code} .= $d;
87         }
88         $res{code} .="\n";
89 }
90
91 sub pidl_hdr($) { $res{hdr} .= shift; }
92 sub pidl_def($) { $res{def} .= shift; }
93
94 sub indent()
95 {
96         $tabs .= "\t";
97 }
98
99 sub deindent()
100 {
101         $tabs = substr($tabs, 0, -1);
102 }
103
104 #####################################################################
105 # parse the interface definitions
106 sub Interface($)
107 {
108         my($interface) = @_;
109         Typedef($_) foreach (@{$interface->{TYPEDEFS}});
110         Function($_) foreach (@{$interface->{FUNCTIONS}});
111 }
112
113 sub Enum($$$)
114 {
115         my ($e,$name,$ifname) = @_;
116         my $valsstring = "$ifname\_$name\_vals";
117         my $dissectorname = "$ifname\_dissect\_$name";
118
119         foreach (@{$e->{ELEMENTS}}) {
120                 if (/([^=]*)=(.*)/) {
121                         pidl_hdr "#define $1 $2";
122                 }
123         }
124         
125         pidl_hdr "extern const value_string $valsstring;";
126         pidl_hdr "int $dissectorname(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *tree, guint8 *drep, int hf_index, guint32 param);";
127
128         pidl_def "const value_string ".$valsstring."[] = {";
129         indent;
130         foreach (@{$e->{ELEMENTS}}) {
131                 next unless (/([^=]*)=(.*)/);
132                 pidl_code "{ $1, \"$2\" },";
133         }
134
135         pidl_def "{ 0, NULL }";
136         deindent;
137         pidl_def "};";
138
139         pidl_code "int";
140         pidl_code "$dissectorname(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *tree, guint8 *drep, int hf_index, guint32 param _U_)";
141         pidl_code "{";
142         indent;
143         pidl_code "offset=dissect_ndr_$e->{BASE_TYPE}(tvb, offset, pinfo, tree, drep, hf_index, NULL);";
144         pidl_code "return offset;";
145         pidl_code "}";
146
147         register_type($name, $dissectorname, enum_ft($e), "BASE_DEC", "0", "VALS($valsstring)", enum_size($e));
148 }
149
150 sub Bitmap($$$)
151 {
152         my ($e,$name,$ifname) = @_;
153         my $dissectorname = "$ifname\_dissect\_$name";
154
155         register_ett("ett_$ifname\_$name");
156
157         pidl_hdr "int $dissectorname(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *tree, guint8 *drep, int hf_index, guint32 param);";
158
159         pidl_code "int";
160         pidl_code "$dissectorname(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *parent_tree, guint8 *drep, int hf_index, guint32 param _U_)";
161         pidl_code "{";
162         indent;
163         pidl_code "proto_item *item=NULL;";
164         pidl_code "proto_tree *tree=NULL;";
165
166         if ($e->{ALIGN} == 8) {
167                 pidl_code "guint8 flags;";
168         } elsif ($e->{ALIGN} == 4) {
169                 pidl_code "guint32 flags;";
170                 pidl_code "ALIGN_TO_4_BYTES;";
171         }
172
173         pidl_code "if(parent_tree) {";
174         indent;
175         pidl_code "item=proto_tree_add_item(parent_tree, hf_index, tvb, offset, $e->{ALIGN}, TRUE);";
176         pidl_code "tree=proto_item_add_subtree(item,ett_$ifname\_$name);";
177         deindent;
178         pidl_code "}";
179
180         pidl_code "offset=dissect_ndr_$e->{BASE_TYPE}(tvb, offset, pinfo, NULL, drep, -1, &flags);";
181
182         foreach (@{$e->{ELEMENTS}}) {
183                 next unless (/([^=]*)=(.*)/);
184                 my ($en,$ev) = ($1,$2);
185                 my $hf_bitname = "hf_$ifname\_$name\_$en";
186                 my $filtername = "$ifname\.$name\.$en";
187                 
188                 register_hf_field($hf_bitname, $en, $filtername, "FT_BOOLEAN", $e->{ALIGN} * 8, "TFS(&$en\_tfs)", $ev, "");
189
190                 pidl_def "static const true_false_string $name\_tfs = {";
191                 pidl_def "   \"$name is SET\",";
192                 pidl_def "   \"$name is NOT SET\",";
193                 pidl_def "};";
194                 
195                 pidl_code "proto_tree_add_boolean(tree, $hf_bitname, tvb, offset-$e->{ALIGN}, $e->{ALIGN}, flags);";
196                 pidl_code "if (flags&$ev){";
197                 pidl_code "\tproto_item_append_text(item,\"$en\");";
198                 pidl_code "}";
199                 pidl_code "flags&=(~$ev);";
200         }
201
202         pidl_code "if(flags){";
203         pidl_code "proto_item_append_text(item, \"UNKNOWN-FLAGS\");";
204         pidl_code "}";
205         deindent;
206         pidl_code "return offset;";
207         pidl_code "}";
208         register_new_type($name, $dissectorname, bitmap_ft($e), "BASE_HEX", "0", "NULL", $e->{ALIGN});
209 }
210
211 sub Element($$$)
212 {
213         my ($e,$pn,$ifname) = @_;
214
215         my $hf_index = "hf_$ifname\_$pn\_$e->{NAME}";
216         my $dissectorname = "$ifname\_dissect\_$ifname\_$pn\_$e->{NAME}";
217
218         return if (EmitProhibited($dissectorname));
219
220         my $type = FindType($e->{DATA_TYPE});
221
222         my $hf = register_hf_field($hf_index, $e->{NAME}, "$ifname.$pn.$e->{NAME}", $type->{FT_TYPE}, $type->{BASE_TYPE}, $type->{VALS}, $type->{MASK}, "");
223         
224         pidl_code "static int";
225         pidl_code "$dissectorname(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *tree, guint8 *drep)";
226         pidl_code "{";
227         indent;
228         pidl_code "guint32 param="  . Conformance::FindDissectorParam($dissectorname).";";
229         pidl_code "offset=$type->{DISSECTOR}(tvb, offset, pinfo, tree, drep, $hf, param);";
230         pidl_code "return offset;";
231         deindent;
232         pidl_code "}";
233 }
234
235 sub Function($$$)
236 {
237         my ($fn,$name,$ifname) = @_;
238         
239         register_function($ifname,$fn->{OPCODE}, $fn->{NAME}, 
240                 "$ifname\_dissect\_$fn->{NAME}_request", 
241                 "$ifname\_dissect\_$fn->{NAME}_response");
242
243         pidl_code "static int";
244         pidl_code "$ifname\_dissect\_$fn->{NAME}_response(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *tree _U_, guint8 *drep _U_)";
245         pidl_code "{";
246         indent;
247         foreach (@{$fn->{ELEMENTS}}) {
248                 Element($_, $name, $ifname) if (grep(/in/,@{$_->{DIRECTION}}));
249         }
250         pidl_code "return offset;";
251         deindent;
252         pidl_code "}";
253
254         pidl_code "static int";
255         pidl_code "$ifname\_dissect\_$fn->{NAME}_request(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *tree _U_, guint8 *drep _U_)";
256         pidl_code "{";
257         indent;
258         foreach (@{$fn->{ELEMENTS}}) {
259                 Element($_, $name, $ifname) if (grep(/out/,@{$_->{DIRECTION}}));
260         }
261         pidl_code "return offset;";
262         deindent;
263         pidl_code "}";
264 }
265
266 sub Struct($$$)
267 {
268         my ($e,$name,$ifname) = @_;
269         my $dissectorname = "$ifname\_dissect\_$name";
270
271         return if (EmitProhibited($dissectorname));
272
273         register_ett("ett_$ifname\_$name");
274
275         pidl_hdr "int $dissectorname(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *parent_tree, guint8 *drep, int hf_index, guint32 param _U_);";
276         pidl_code "int";
277         pidl_code "$dissectorname(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *parent_tree, guint8 *drep, int hf_index, guint32 param _U_)";
278         indent;
279         pidl_code "proto_item *item = NULL;";
280         pidl_code "proto_tree *tree = NULL;";
281         pidl_code "int old_offset;";
282
283         pidl_code "ALIGN_TO_$e->{ALIGN}_BYTES;";
284
285         pidl_code "old_offset=offset;";
286         pidl_code "if(parent_tree){";
287         indent;
288         pidl_code "item=proto_tree_add_item(parent_tree, hf_index, tvb, offset, -1, TRUE);";
289         pidl_code "tree=proto_item_add_subtree(item, ett_$ifname\_$name);";
290         deindent;
291         pidl_code"}";
292
293         Element($_, $name, $ifname) foreach (@{$e->{ELEMENTS}});
294
295         pidl_code "proto_item_set_len(item, offset-old_offset);";
296         pidl_code "return offset;";
297         deindent;
298         pidl_code "}";
299 }
300
301 sub Union($$$)
302 {
303         my ($e,$name,$ifname) = @_;
304
305         my $dissectorname = "$ifname\_dissect_union_$name";
306         
307         register_ett("ett_$ifname\_$name");
308
309         pidl_code "static int";
310         pidl_code "$dissectorname(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *parent_tree, guint8 *drep, int hf_index, guint32 param _U_)";
311         pidl_code "{";
312         indent;
313         pidl_code "proto_item *item=NULL;";
314         pidl_code "proto_tree *tree=NULL;";
315         pidl_code "int old_offset;";
316
317         if ($e->{ALIGN} == 2) {
318                 pidl_code "ALIGN_TO_2_BYTES;";
319         } elsif ($e->{ALIGN} == 4) {
320                 pidl_code "ALIGN_TO_4_BYTES;";
321         }
322
323         pidl_code "g$e->{SWITCH_TYPE} level;";
324
325         pidl_code "old_offset=offset;";
326         pidl_code "if(parent_tree){";
327         indent;
328         pidl_code "item=proto_tree_add_text(parent_tree,tvb,offset,-1,\"$name\");";
329         pidl_code "tree=proto_item_add_subtree(item,ett_$ifname\_$name);";
330         pidl_code "}";
331
332         pidl_code "offset = dissect_ndr_$e->{SWITCH_TYPE}(tvb, offset, pinfo, tree, drep, hf_index, &level);";
333
334         pidl_code "switch(level) {";
335         foreach (@{$e->{ELEMENTS}}) {
336                 pidl_code "$_->{CASE}:";
337                 indent;
338                 Element($_, $name, $ifname);
339                 deindent;
340                 pidl_code "break;";
341         }
342
343         pidl_code "proto_item_set_len(item, offset-old_offset);";
344         pidl_code "return offset;";
345         deindent;
346         pidl_code "}";
347
348 }
349
350 sub Typedef($$)
351 {
352         my ($e,$ifname) = @_;
353
354         {
355                 ENUM => \&Enum,
356                 STRUCT => \&Struct,
357                 UNION => \&Union,
358                 BITMAP => \&Bitmap
359         }->{$e->{DATA}->{TYPE}}->($e->{DATA}, $e->{NAME}, $ifname);
360 }
361
362 sub RegisterInterface($)
363 {
364         my ($x) = @_;
365
366         pidl_code "void proto_register_dcerpc_$x->{NAME}(void)";
367         pidl_code "{";
368         indent;
369
370         $res{code}.=DumpHfList();
371         $res{code}.=DumpEttList();
372         
373         if (defined($x->{UUID})) {
374             # These can be changed to non-pidl_code names if the old dissectors
375             # in epan/dissctors are deleted.
376     
377             my $name = "\"" . uc($x->{NAME}) . " (pidl)\"";
378                 if (has_property($x, "helpstring")) {
379                         $name = $x->{PROPERTIES}->{helpstring};
380                 }
381             my $short_name = "idl_$x->{NAME}";
382             my $filter_name = "idl_$x->{NAME}";
383     
384             pidl_code "proto_dcerpc_$x->{NAME} = proto_register_protocol($name, \"$short_name\", \"$filter_name\");";
385             
386             pidl_code "proto_register_field_array(proto_dcerpc_$x->{NAME}, hf, array_length (hf));";
387             pidl_code "proto_register_subtree_array(ett, array_length(ett));";
388         } else {
389             pidl_code "proto_dcerpc = proto_get_id_by_filter_name(\"dcerpc\");";
390             pidl_code "proto_register_field_array(proto_dcerpc, hf, array_length(hf));";
391             pidl_code "proto_register_subtree_array(ett, array_length(ett));";
392         }
393             
394         deindent;
395         pidl_code "}\n";
396 }
397
398 sub RegisterInterfaceHandoff($)
399 {
400         my $x = shift;
401         pidl_code "void proto_reg_handoff_dcerpc_pidl_$x->{NAME}(void)";
402         pidl_code "{";
403         indent;
404         pidl_code "dcerpc_init_uuid(proto_dcerpc_$x->{NAME}, ett_dcerpc_$x->{NAME},";
405         pidl_code "\t&uuid_dcerpc_$x->{NAME}, ver_dcerpc_$x->{NAME},";
406         pidl_code "\t$x->{NAME}_dissectors, hf_$x->{NAME}_opnum);";
407         deindent;
408         pidl_code "}";
409 }
410
411 sub ProcessInterface($)
412 {
413         my $x = shift;
414
415         %res = (code=>"",def=>"",hdr=>"");
416
417         if (defined($x->{UUID})) {
418                 my $if_uuid = $x->{UUID};
419             
420             pidl_def "static e_uuid_t uuid_dcerpc_$x->{NAME} = {";
421             pidl_def "\t0x" . substr($if_uuid, 1, 8) 
422                 . ", 0x" . substr($if_uuid, 10, 4)
423             . ", 0x" . substr($if_uuid, 15, 4) . ",";
424             pidl_def "\t{ 0x" . substr($if_uuid, 20, 2) 
425                 . ", 0x" . substr($if_uuid, 22, 2)
426             . ", 0x" . substr($if_uuid, 25, 2)
427             . ", 0x" . substr($if_uuid, 27, 2)
428             . ", 0x" . substr($if_uuid, 29, 2)
429             . ", 0x" . substr($if_uuid, 31, 2)
430             . ", 0x" . substr($if_uuid, 33, 2)
431             . ", 0x" . substr($if_uuid, 35, 2) . " }";
432             pidl_def "};\n";
433         
434             pidl_def "static guint16 ver_dcerpc_$x->{NAME} = $x->{VERSION};";
435         }
436
437         Interface($x);
438
439         $res{functiontable} = DumpFunctionTable($x->{NAME});
440
441         RegisterInterface($x);
442         RegisterInterfaceHandoff($x);
443 }
444
445 #####################################################################
446 # Generate ethereal parser and header code
447 sub Parse($$$)
448 {
449         my($ndr,$module,$filename) = @_;
450
451         $tabs = "";
452         my $h_filename = $filename;
453
454         if ($h_filename =~ /(.*)\.c/) {
455                 $h_filename = "$1.h";
456         }
457
458         pidl_code "/* parser auto-generated by pidl */";
459         pidl_code "#include \"packet-dcerpc.h\"";
460         pidl_code "#include \"$h_filename\"";
461         pidl_code "";
462         pidl_code "static int hf_ptr = -1;";
463         pidl_code "static int hf_array_size = -1;";
464         pidl_code "";
465
466         # Ethereal protocol registration
467
468         ProcessInterface($_) foreach (@$ndr);
469
470         $res{ett} = DumpEttDeclaration();
471         $res{hf} = DumpHfDeclaration();
472
473         my $parser = $res{ett}.$res{hf}.$res{def}.$res{code};
474         my $header = $res{hdr};
475     
476         return ($parser,$header);
477 }
478
479 ###############################################################################
480 # ETT
481 ###############################################################################
482
483 my @ett = ();
484
485 sub register_ett($)
486 {
487         my $name = shift;
488
489         push (@ett, $name);     
490 }
491
492 sub DumpEttList()
493 {
494         my $res = "\tstatic gint *ett[] = {\n";
495         foreach (@ett) {
496                 $res = "\t\t&$_,\n";
497         }
498
499         return "$res\t};\n";
500 }
501
502 sub DumpEttDeclaration()
503 {
504         my $res = "";
505         foreach (@ett) {
506                 $res .= "static gint $_ = -1;\n";
507         }
508
509         return $res;
510 }
511
512 ###############################################################################
513 # HF
514 ###############################################################################
515
516 my %hf = ();
517
518 sub register_hf_field($$$$$$$$) 
519 {
520         my ($index,$name,$filter_name,$ft_type,$base_type,$valsstring,$mask,$fixme) = @_;
521
522         $hf{$index} = {
523                 INDEX => $index,
524                 NAME => $name,
525                 FILTER => $filter_name,
526                 FT_TYPE => $ft_type,
527                 BASE_TYPE => $base_type,
528                 VALS => $valsstring,
529                 MASK => $mask
530         };
531 }
532
533 sub DumpHfDeclaration()
534 {
535         my $res = "";
536
537         foreach (keys %hf) 
538         {
539                 $res .= "static gint $_ = -1;\n";
540         }
541
542         return $res;
543 }
544
545 sub DumpHfList()
546 {
547         my $res = "\tstatic hf_register_info hf[] = {\n";
548
549         foreach (values %hf) 
550         {
551                 $res .= "\t{ &$_->{INDEX}, 
552           { \"$_->{NAME}\", \"$_->{FILTER}\", $_->{FT_TYPE}, $_->{BASE_TYPE}, $_->{VALS}, $_->{MASK}, FIXME, HFILL }},
553 ";
554         }
555
556         return $res."\t};\n";
557 }
558
559
560 ###############################################################################
561 # Function table
562 ###############################################################################
563
564 my %functions = ();
565
566 sub register_function($$$$$)
567 {
568         my ($ifname, $opcode, $name, $req, $repl) = @_;
569
570         $functions{$ifname}->{$name} = {
571                 NAME => $name,
572                 OPCODE => $opcode,
573                 REQUEST_FUNC => $req,
574                 REPLY_FUNC => $repl
575         };
576 }
577
578 sub DumpFunctionTable($)
579 {
580         my $name = shift;
581
582         my $res = "static dcerpc_sub_dissector $name\_dissectors[] = {\n";
583         
584         foreach (values %{$functions{$name}}) {
585                 $res.= "\t{ $_->{OPCODE}, \"$_->{NAME},\n";
586                 $res.= "\t   $_->{REQUEST_FUNC}, $_->{REPLY_FUNC} },\n";
587         }
588
589         $res .= "\t{ 0, NULL, NULL, NULL },\n";
590
591         return "$res\t}\n";
592 }
593
594
595 1;