pidl: handle hyper attribute for wireshark
[kai/samba-autobuild/.git] / pidl / lib / Parse / Pidl / Wireshark / Conformance.pm
1 ###################################################
2 # parse an Wireshark conformance file
3 # Copyright jelmer@samba.org 2005
4 # released under the GNU GPL
5
6 =pod
7
8 =head1 NAME
9
10 Parse::Pidl::Wireshark::Conformance - Conformance file parser for Wireshark
11
12 =head1 DESCRIPTION
13
14 This module supports parsing Wireshark conformance files (*.cnf).
15
16 =head1 FILE FORMAT
17
18 Pidl needs additional data for Wireshark output. This data is read from 
19 so-called conformance files. This section describes the format of these 
20 files.
21
22 Conformance files are simple text files with a single command on each line.
23 Empty lines and lines starting with a '#' character are ignored.
24 Arguments to commands are seperated by spaces.
25
26 The following commands are currently supported:
27
28 =over 4
29
30 =item I<TYPE> name dissector ft_type base_type mask valsstring alignment
31
32 Register new data type with specified name, what dissector function to call 
33 and what properties to give header fields for elements of this type.
34
35 =item I<NOEMIT> type
36
37 Suppress emitting a dissect_type function for the specified type
38
39 =item I<PARAM_VALUE> type param
40
41 Set parameter to specify to dissector function for given type.
42
43 =item I<HF_FIELD> hf title filter ft_type base_type valsstring mask description
44
45 Generate a custom header field with specified properties.
46
47 =item I<HF_RENAME> old_hf_name new_hf_name
48
49 Force the use of new_hf_name when the parser generator was going to 
50 use old_hf_name.
51
52 This can be used in conjunction with HF_FIELD in order to make more than 
53 one element use the same filter name.
54
55 =item I<ETT_FIELD> ett
56
57 Register a custom ett field
58
59 =item I<STRIP_PREFIX> prefix
60
61 Remove the specified prefix from all function names (if present).
62         
63 =item I<PROTOCOL> longname shortname filtername
64
65 Change the short-, long- and filter-name for the current interface in
66 Wireshark.
67
68 =item I<FIELD_DESCRIPTION> field desc
69
70 Change description for the specified header field. `field' is the hf name of the field.
71
72 =item I<IMPORT> dissector code...
73
74 Code to insert when generating the specified dissector. @HF@ and 
75 @PARAM@ will be substituted.
76
77 =item I<INCLUDE> filename
78
79 Include conformance data from the specified filename in the dissector.
80
81 =item I<TFS> hf_name "true string" "false string"
82
83 Override the text shown when a bitmap boolean value is enabled or disabled.
84
85 =item I<MANUAL> fn_name
86
87 Force pidl to not generate a particular function but allow the user 
88 to write a function manually. This can be used to remove the function 
89 for only one level for a particular element rather than all the functions and 
90 ett/hf variables for a particular element as the NOEMIT command does.
91
92 =back
93
94 =head1 EXAMPLE
95
96         INFO_KEY OpenKey.Ke
97
98 =cut
99
100 package Parse::Pidl::Wireshark::Conformance;
101
102 require Exporter;
103 use vars qw($VERSION);
104 $VERSION = '0.01';
105
106 @ISA = qw(Exporter);
107 @EXPORT_OK = qw(ReadConformance ReadConformanceFH valid_ft_type valid_base_type);
108
109 use strict;
110
111 use Parse::Pidl qw(fatal warning error);
112 use Parse::Pidl::Util qw(has_property);
113 use Parse::Pidl::Typelist qw(addType);
114
115 sub handle_type($$$$$$$$$$)
116 {
117         my ($pos,$data,$name,$dissectorname,$ft_type,$base_type,$mask,$valsstring,$alignment) = @_;
118
119         unless(defined($alignment)) {
120                 error($pos, "incomplete TYPE command");
121                 return;
122         }
123
124         unless ($dissectorname =~ /.*dissect_.*/) {
125                 warning($pos, "dissector name does not contain `dissect'");
126         }
127
128         unless(valid_ft_type($ft_type)) {
129                 warning($pos, "invalid FT_TYPE `$ft_type'");
130         }
131
132         unless (valid_base_type($base_type)) {
133                 warning($pos, "invalid BASE_TYPE `$base_type'");
134         }
135
136         $dissectorname =~ s/^\"(.*)\"$/$1/g;
137
138         if (not ($dissectorname =~ /;$/)) {
139                 warning($pos, "missing semicolon");
140         }
141
142         $data->{types}->{$name} = {
143                 NAME => $name,
144                 POS => $pos,
145                 USED => 0,
146                 DISSECTOR_NAME => $dissectorname,
147                 FT_TYPE => $ft_type,
148                 BASE_TYPE => $base_type,
149                 MASK => $mask,
150                 VALSSTRING => $valsstring,
151                 ALIGNMENT => $alignment
152         };
153
154         addType({
155                 NAME => $name,
156                 TYPE => "CONFORMANCE",
157                 BASEFILE => "conformance file",
158                 DATA => {
159                         NAME => $name,
160                         TYPE => "CONFORMANCE",
161                         ALIGN => $alignment
162                 }
163         });
164 }
165
166 sub handle_tfs($$$$$)
167 {
168         my ($pos,$data,$hf,$trues,$falses) = @_;
169
170         unless(defined($falses)) {
171                 error($pos, "incomplete TFS command");
172                 return;
173         }
174
175         $data->{tfs}->{$hf} = {
176                 TRUE_STRING => $trues,
177                 FALSE_STRING => $falses
178         };
179 }
180
181 sub handle_hf_rename($$$$)
182 {
183         my ($pos,$data,$old,$new) = @_;
184
185         unless(defined($new)) {
186                 warning($pos, "incomplete HF_RENAME command");
187                 return;
188         }
189
190         $data->{hf_renames}->{$old} = {
191                 OLDNAME => $old,
192                 NEWNAME => $new,
193                 POS => $pos,
194                 USED => 0
195         };
196 }
197
198 sub handle_param_value($$$$)
199 {
200         my ($pos,$data,$dissector_name,$value) = @_;
201
202         unless(defined($value)) {
203                 error($pos, "incomplete PARAM_VALUE command");
204                 return;
205         }
206
207         $data->{dissectorparams}->{$dissector_name} = {
208                 DISSECTOR => $dissector_name,
209                 PARAM => $value,
210                 POS => $pos,
211                 USED => 0
212         };
213 }
214
215 sub valid_base_type($)
216 {
217         my $t = shift;
218         return 0 unless($t =~ /^BASE_.*/);
219         return 1;
220 }
221
222 sub valid_ft_type($)
223 {
224         my $t = shift;
225         return 0 unless($t =~ /^FT_.*/);
226         return 1;
227 }
228
229 sub handle_hf_field($$$$$$$$$$)
230 {
231         my ($pos,$data,$index,$name,$filter,$ft_type,$base_type,$valsstring,$mask,$blurb) = @_;
232
233         unless(defined($blurb)) {
234                 error($pos, "incomplete HF_FIELD command");
235                 return;
236         }
237
238         unless(valid_ft_type($ft_type)) {
239                 warning($pos, "invalid FT_TYPE `$ft_type'");
240         }
241
242         unless(valid_base_type($base_type)) {
243                 warning($pos, "invalid BASE_TYPE `$base_type'");
244         }
245
246         $data->{header_fields}->{$index} = {
247                 INDEX => $index,
248                 POS => $pos,
249                 USED => 0,
250                 NAME => $name,
251                 FILTER => $filter,
252                 FT_TYPE => $ft_type,
253                 BASE_TYPE => $base_type,
254                 VALSSTRING => $valsstring,
255                 MASK => $mask,
256                 BLURB => $blurb
257         };
258 }
259
260 sub handle_strip_prefix($$$)
261 {
262         my ($pos,$data,$x) = @_;
263
264         push (@{$data->{strip_prefixes}}, $x);
265 }
266
267 sub handle_noemit($$$)
268 {
269         my ($pos,$data,$type) = @_;
270
271         if (defined($type)) {
272             $data->{noemit}->{$type} = 1;
273         } else {
274             $data->{noemit_dissector} = 1;
275         }
276 }
277
278 sub handle_manual($$$)
279 {
280         my ($pos,$data,$fn) = @_;
281
282         unless(defined($fn)) {
283                 warning($pos, "incomplete MANUAL command");
284                 return;
285         }
286
287     $data->{manual}->{$fn} = 1;
288 }
289
290 sub handle_protocol($$$$$$)
291 {
292         my ($pos, $data, $name, $longname, $shortname, $filtername) = @_;
293
294         $data->{protocols}->{$name} = {
295                 LONGNAME => $longname,
296                 SHORTNAME => $shortname,
297                 FILTERNAME => $filtername
298         };
299 }
300
301 sub handle_fielddescription($$$$)
302 {
303         my ($pos,$data,$field,$desc) = @_;
304
305         unless(defined($desc)) {
306                 warning($pos, "incomplete FIELD_DESCRIPTION command");
307                 return;
308         }
309
310         $data->{fielddescription}->{$field} = {
311                 DESCRIPTION => $desc,
312                 POS => $pos,
313                 USED => 0
314         };
315 }
316
317 sub handle_import
318 {
319         my $pos = shift @_;
320         my $data = shift @_;
321         my $dissectorname = shift @_;
322
323         unless(defined($dissectorname)) {
324                 error($pos, "no dissectorname specified");
325                 return;
326         }
327
328         $data->{imports}->{$dissectorname} = {
329                 NAME => $dissectorname,
330                 DATA => join(' ', @_),
331                 USED => 0,
332                 POS => $pos
333         };
334 }
335
336 sub handle_ett_field
337 {
338         my $pos = shift @_;
339         my $data = shift @_;
340         my $ett = shift @_;
341
342         unless(defined($ett)) {
343                 error($pos, "incomplete ETT_FIELD command");
344                 return;
345         }
346
347         push (@{$data->{ett}}, $ett);
348 }
349
350 sub handle_include
351 {
352         my $pos = shift @_;
353         my $data = shift @_;
354         my $fn = shift @_;
355
356         unless(defined($fn)) {
357                 error($pos, "incomplete INCLUDE command");
358                 return;
359         }
360
361         ReadConformance($fn, $data);
362 }
363
364 my %field_handlers = (
365         TYPE => \&handle_type,
366         NOEMIT => \&handle_noemit, 
367         MANUAL => \&handle_manual,
368         PARAM_VALUE => \&handle_param_value, 
369         HF_FIELD => \&handle_hf_field, 
370         HF_RENAME => \&handle_hf_rename, 
371         ETT_FIELD => \&handle_ett_field,
372         TFS => \&handle_tfs,
373         STRIP_PREFIX => \&handle_strip_prefix,
374         PROTOCOL => \&handle_protocol,
375         FIELD_DESCRIPTION => \&handle_fielddescription,
376         IMPORT => \&handle_import,
377         INCLUDE => \&handle_include
378 );
379
380 sub ReadConformance($$)
381 {
382         my ($f,$data) = @_;
383         my $ret;
384
385         open(IN,"<$f") or return undef;
386
387         $ret = ReadConformanceFH(*IN, $data, $f);
388
389         close(IN);
390
391         return $ret;
392 }
393
394 sub ReadConformanceFH($$$)
395 {
396         my ($fh,$data,$f) = @_;
397
398         my $incodeblock = 0;
399
400         my $ln = 0;
401
402         foreach (<$fh>) {
403                 $ln++;
404                 next if (/^#.*$/);
405                 next if (/^$/);
406
407                 s/[\r\n]//g;
408
409                 if ($_ eq "CODE START") {
410                         $incodeblock = 1;
411                         next;
412                 } elsif ($incodeblock and $_ eq "CODE END") {
413                         $incodeblock = 0;
414                         next;
415                 } elsif ($incodeblock) {
416                         if (exists $data->{override}) {
417                                 $data->{override}.="$_\n";
418                         } else {
419                                 $data->{override} = "$_\n";
420                         }
421                         next;
422                 }
423
424                 my @fields = /([^ "]+|"[^"]+")/g;
425
426                 my $cmd = $fields[0];
427
428                 shift @fields;
429
430                 my $pos = { FILE => $f, LINE => $ln };
431
432                 next unless(defined($cmd));
433
434                 if (not defined($field_handlers{$cmd})) {
435                         warning($pos, "Unknown command `$cmd'");
436                         next;
437                 }
438                 
439                 $field_handlers{$cmd}($pos, $data, @fields);
440         }
441
442         if ($incodeblock) {
443                 warning({ FILE => $f, LINE => $ln }, 
444                         "Expecting CODE END");
445                 return undef;
446         }
447
448         return 1;
449 }
450
451 1;