5c37b4a0c4f8eab2f02851e896d85c7f86ab0c92
[ira/wip.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
114 sub handle_type($$$$$$$$$$)
115 {
116         my ($pos,$data,$name,$dissectorname,$ft_type,$base_type,$mask,$valsstring,$alignment) = @_;
117
118         unless(defined($alignment)) {
119                 error($pos, "incomplete TYPE command");
120                 return;
121         }
122
123         unless ($dissectorname =~ /.*dissect_.*/) {
124                 warning($pos, "dissector name does not contain `dissect'");
125         }
126
127         unless(valid_ft_type($ft_type)) {
128                 warning($pos, "invalid FT_TYPE `$ft_type'");
129         }
130
131         unless (valid_base_type($base_type)) {
132                 warning($pos, "invalid BASE_TYPE `$base_type'");
133         }
134
135         $dissectorname =~ s/^\"(.*)\"$/$1/g;
136
137         if (not ($dissectorname =~ /;$/)) {
138                 warning($pos, "missing semicolon");
139         }
140
141         $data->{types}->{$name} = {
142                 NAME => $name,
143                 POS => $pos,
144                 USED => 0,
145                 DISSECTOR_NAME => $dissectorname,
146                 FT_TYPE => $ft_type,
147                 BASE_TYPE => $base_type,
148                 MASK => $mask,
149                 VALSSTRING => $valsstring,
150                 ALIGNMENT => $alignment
151         };
152 }
153
154 sub handle_tfs($$$$$)
155 {
156         my ($pos,$data,$hf,$trues,$falses) = @_;
157
158         unless(defined($falses)) {
159                 error($pos, "incomplete TFS command");
160                 return;
161         }
162
163         $data->{tfs}->{$hf} = {
164                 TRUE_STRING => $trues,
165                 FALSE_STRING => $falses
166         };
167 }
168
169 sub handle_hf_rename($$$$)
170 {
171         my ($pos,$data,$old,$new) = @_;
172
173         unless(defined($new)) {
174                 warning($pos, "incomplete HF_RENAME command");
175                 return;
176         }
177
178         $data->{hf_renames}->{$old} = {
179                 OLDNAME => $old,
180                 NEWNAME => $new,
181                 POS => $pos,
182                 USED => 0
183         };
184 }
185
186 sub handle_param_value($$$$)
187 {
188         my ($pos,$data,$dissector_name,$value) = @_;
189
190         unless(defined($value)) {
191                 error($pos, "incomplete PARAM_VALUE command");
192                 return;
193         }
194
195         $data->{dissectorparams}->{$dissector_name} = {
196                 DISSECTOR => $dissector_name,
197                 PARAM => $value,
198                 POS => $pos,
199                 USED => 0
200         };
201 }
202
203 sub valid_base_type($)
204 {
205         my $t = shift;
206         return 0 unless($t =~ /^BASE_.*/);
207         return 1;
208 }
209
210 sub valid_ft_type($)
211 {
212         my $t = shift;
213         return 0 unless($t =~ /^FT_.*/);
214         return 1;
215 }
216
217 sub handle_hf_field($$$$$$$$$$)
218 {
219         my ($pos,$data,$index,$name,$filter,$ft_type,$base_type,$valsstring,$mask,$blurb) = @_;
220
221         unless(defined($blurb)) {
222                 error($pos, "incomplete HF_FIELD command");
223                 return;
224         }
225
226         unless(valid_ft_type($ft_type)) {
227                 warning($pos, "invalid FT_TYPE `$ft_type'");
228         }
229
230         unless(valid_base_type($base_type)) {
231                 warning($pos, "invalid BASE_TYPE `$base_type'");
232         }
233
234         $data->{header_fields}->{$index} = {
235                 INDEX => $index,
236                 POS => $pos,
237                 USED => 0,
238                 NAME => $name,
239                 FILTER => $filter,
240                 FT_TYPE => $ft_type,
241                 BASE_TYPE => $base_type,
242                 VALSSTRING => $valsstring,
243                 MASK => $mask,
244                 BLURB => $blurb
245         };
246 }
247
248 sub handle_strip_prefix($$$)
249 {
250         my ($pos,$data,$x) = @_;
251
252         push (@{$data->{strip_prefixes}}, $x);
253 }
254
255 sub handle_noemit($$$)
256 {
257         my ($pos,$data,$type) = @_;
258
259         if (defined($type)) {
260             $data->{noemit}->{$type} = 1;
261         } else {
262             $data->{noemit_dissector} = 1;
263         }
264 }
265
266 sub handle_manual($$$)
267 {
268         my ($pos,$data,$fn) = @_;
269
270         unless(defined($fn)) {
271                 warning($pos, "incomplete MANUAL command");
272                 return;
273         }
274
275     $data->{manual}->{$fn} = 1;
276 }
277
278 sub handle_protocol($$$$$$)
279 {
280         my ($pos, $data, $name, $longname, $shortname, $filtername) = @_;
281
282         $data->{protocols}->{$name} = {
283                 LONGNAME => $longname,
284                 SHORTNAME => $shortname,
285                 FILTERNAME => $filtername
286         };
287 }
288
289 sub handle_fielddescription($$$$)
290 {
291         my ($pos,$data,$field,$desc) = @_;
292
293         unless(defined($desc)) {
294                 warning($pos, "incomplete FIELD_DESCRIPTION command");
295                 return;
296         }
297
298         $data->{fielddescription}->{$field} = {
299                 DESCRIPTION => $desc,
300                 POS => $pos,
301                 USED => 0
302         };
303 }
304
305 sub handle_import
306 {
307         my $pos = shift @_;
308         my $data = shift @_;
309         my $dissectorname = shift @_;
310
311         unless(defined($dissectorname)) {
312                 error($pos, "no dissectorname specified");
313                 return;
314         }
315
316         $data->{imports}->{$dissectorname} = {
317                 NAME => $dissectorname,
318                 DATA => join(' ', @_),
319                 USED => 0,
320                 POS => $pos
321         };
322 }
323
324 sub handle_ett_field
325 {
326         my $pos = shift @_;
327         my $data = shift @_;
328         my $ett = shift @_;
329
330         unless(defined($ett)) {
331                 error($pos, "incomplete ETT_FIELD command");
332                 return;
333         }
334
335         push (@{$data->{ett}}, $ett);
336 }
337
338 sub handle_include
339 {
340         my $pos = shift @_;
341         my $data = shift @_;
342         my $fn = shift @_;
343
344         unless(defined($fn)) {
345                 error($pos, "incomplete INCLUDE command");
346                 return;
347         }
348
349         ReadConformance($fn, $data);
350 }
351
352 my %field_handlers = (
353         TYPE => \&handle_type,
354         NOEMIT => \&handle_noemit, 
355         MANUAL => \&handle_manual,
356         PARAM_VALUE => \&handle_param_value, 
357         HF_FIELD => \&handle_hf_field, 
358         HF_RENAME => \&handle_hf_rename, 
359         ETT_FIELD => \&handle_ett_field,
360         TFS => \&handle_tfs,
361         STRIP_PREFIX => \&handle_strip_prefix,
362         PROTOCOL => \&handle_protocol,
363         FIELD_DESCRIPTION => \&handle_fielddescription,
364         IMPORT => \&handle_import,
365         INCLUDE => \&handle_include
366 );
367
368 sub ReadConformance($$)
369 {
370         my ($f,$data) = @_;
371         my $ret;
372
373         open(IN,"<$f") or return undef;
374
375         $ret = ReadConformanceFH(*IN, $data, $f);
376
377         close(IN);
378
379         return $ret;
380 }
381
382 sub ReadConformanceFH($$$)
383 {
384         my ($fh,$data,$f) = @_;
385
386         my $incodeblock = 0;
387
388         my $ln = 0;
389
390         foreach (<$fh>) {
391                 $ln++;
392                 next if (/^#.*$/);
393                 next if (/^$/);
394
395                 s/[\r\n]//g;
396
397                 if ($_ eq "CODE START") {
398                         $incodeblock = 1;
399                         next;
400                 } elsif ($incodeblock and $_ eq "CODE END") {
401                         $incodeblock = 0;
402                         next;
403                 } elsif ($incodeblock) {
404                         if (exists $data->{override}) {
405                                 $data->{override}.="$_\n";
406                         } else {
407                                 $data->{override} = "$_\n";
408                         }
409                         next;
410                 }
411
412                 my @fields = /([^ "]+|"[^"]+")/g;
413
414                 my $cmd = $fields[0];
415
416                 shift @fields;
417
418                 my $pos = { FILE => $f, LINE => $ln };
419
420                 next unless(defined($cmd));
421
422                 if (not defined($field_handlers{$cmd})) {
423                         warning($pos, "Unknown command `$cmd'");
424                         next;
425                 }
426                 
427                 $field_handlers{$cmd}($pos, $data, @fields);
428         }
429
430         if ($incodeblock) {
431                 warning({ FILE => $f, LINE => $ln }, 
432                         "Expecting CODE END");
433                 return undef;
434         }
435
436         return 1;
437 }
438
439 1;