02319a0aa9c33779bc9e1497979a0a3f9ebb24d1
[kai/samba.git] / source / pidl / lib / Parse / Pidl / Ethereal / Conformance.pm
1 ###################################################
2 # parse an ethereal 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::Ethereal::Conformance - Conformance file parser for Ethereal
11
12 =head1 DESCRIPTION
13
14 This module supports parsing Ethereal conformance files (*.cnf).
15
16 =head1 FILE FORMAT
17
18 Pidl needs additional data for ethereal 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 then 
53 one element use the same filter name.
54
55 =item I<STRIP_PREFIX> prefix
56
57 Remove the specified prefix from all function names (if present).
58         
59 =item I<PROTOCOL> longname shortname filtername
60
61 Change the short-, long- and filter-name for the current interface in
62 Ethereal.
63
64 =item I<FIELD_DESCRIPTION> field desc
65
66 Change description for the specified header field. `field' is the hf name of the field.
67
68 =item I<IMPORT> dissector code...
69
70 Code to insert when generating the specified dissector. @HF@ and 
71 @PARAM@ will be substituted.
72
73 =item I<TFS> hf_name "true string" "false string"
74
75 Override the text shown when a bitmap boolean value is enabled or disabled.
76
77 =item I<MANUAL> fn_name
78
79 Force pidl to not generate a particular function but allow the user 
80 to write a function manually. This can be used to remove the function 
81 for only one level for a particular element rather then all the functions and 
82 ett/hf variables for a particular element as the NOEMIT command does.
83
84 =back
85
86 =head1 EXAMPLE
87
88         INFO_KEY OpenKey.Ke
89
90 =cut
91
92 package Parse::Pidl::Ethereal::Conformance;
93
94 require Exporter;
95 use vars qw($VERSION);
96 $VERSION = '0.01';
97
98 @ISA = qw(Exporter);
99 @EXPORT_OK = qw(ReadConformance);
100
101 use strict;
102
103 use Parse::Pidl::Util qw(has_property);
104
105 sub handle_type($$$$$$$$$$)
106 {
107         my ($pos,$data,$name,$dissectorname,$ft_type,$base_type,$mask,$valsstring,$alignment) = @_;
108
109         unless(defined($alignment)) {
110                 print "$pos: error incomplete TYPE command\n";
111                 return;
112         }
113
114         unless ($dissectorname =~ /.*dissect_.*/) {
115                 print "$pos: warning: dissector name does not contain `dissect'\n";
116         }
117
118         unless(valid_ft_type($ft_type)) {
119                 print "$pos: warning: invalid FT_TYPE `$ft_type'\n";
120         }
121
122         unless (valid_base_type($base_type)) {
123                 print "$pos: warning: invalid BASE_TYPE `$base_type'\n";
124         }
125
126         $data->{types}->{$name} = {
127                 NAME => $name,
128                 POS => $pos,
129                 USED => 0,
130                 DISSECTOR_NAME => $dissectorname,
131                 FT_TYPE => $ft_type,
132                 BASE_TYPE => $base_type,
133                 MASK => $mask,
134                 VALSSTRING => $valsstring,
135                 ALIGNMENT => $alignment
136         };
137 }
138
139 sub handle_tfs($$$$$)
140 {
141         my ($pos,$data,$hf,$trues,$falses) = @_;
142
143         unless(defined($falses)) {
144                 print "$pos: error: incomplete TFS command\n";
145                 return;
146         }
147
148         $data->{tfs}->{$hf} = {
149                 TRUE_STRING => $trues,
150                 FALSE_STRING => $falses
151         };
152 }
153
154 sub handle_hf_rename($$$$)
155 {
156         my ($pos,$data,$old,$new) = @_;
157
158         unless(defined($new)) {
159                 print "$pos: error: incomplete HF_RENAME command\n";
160                 return;
161         }
162
163         $data->{hf_renames}->{$old} = {
164                 OLDNAME => $old,
165                 NEWNAME => $new,
166                 POS => $pos,
167                 USED => 0
168         };
169 }
170
171 sub handle_param_value($$$$)
172 {
173         my ($pos,$data,$dissector_name,$value) = @_;
174
175         unless(defined($value)) {
176                 print "$pos: error: incomplete PARAM_VALUE command\n";
177                 return;
178         }
179
180         $data->{dissectorparams}->{$dissector_name} = {
181                 DISSECTOR => $dissector_name,
182                 PARAM => $value,
183                 POS => $pos,
184                 USED => 0
185         };
186 }
187
188 sub valid_base_type($)
189 {
190         my $t = shift;
191         return 0 unless($t =~ /^BASE_.*/);
192         return 1;
193 }
194
195 sub valid_ft_type($)
196 {
197         my $t = shift;
198         return 0 unless($t =~ /^FT_.*/);
199         return 1;
200 }
201
202 sub handle_hf_field($$$$$$$$$$)
203 {
204         my ($pos,$data,$index,$name,$filter,$ft_type,$base_type,$valsstring,$mask,$blurb) = @_;
205
206         unless(defined($blurb)) {
207                 print "$pos: error: incomplete HF_FIELD command\n";
208                 return;
209         }
210
211         unless(valid_ft_type($ft_type)) {
212                 print "$pos: warning: invalid FT_TYPE `$ft_type'\n";
213         }
214
215         unless(valid_base_type($base_type)) {
216                 print "$pos: warning: invalid BASE_TYPE `$base_type'\n";
217         }
218
219         $data->{header_fields}->{$index} = {
220                 INDEX => $index,
221                 POS => $pos,
222                 USED => 0,
223                 NAME => $name,
224                 FILTER => $filter,
225                 FT_TYPE => $ft_type,
226                 BASE_TYPE => $base_type,
227                 VALSSTRING => $valsstring,
228                 MASK => $mask,
229                 BLURB => $blurb
230         };
231 }
232
233 sub handle_strip_prefix($$$)
234 {
235         my ($pos,$data,$x) = @_;
236
237         push (@{$data->{strip_prefixes}}, $x);
238 }
239
240 sub handle_noemit($$$)
241 {
242         my ($pos,$data,$type) = @_;
243
244         if (defined($type)) {
245             $data->{noemit}->{$type} = 1;
246         } else {
247             $data->{noemit_dissector} = 1;
248         }
249 }
250
251 sub handle_manual($$$)
252 {
253         my ($pos,$data,$fn) = @_;
254
255     $data->{manual}->{$fn} = 1;
256 }
257
258 sub handle_protocol($$$$$$)
259 {
260         my ($pos, $data, $name, $longname, $shortname, $filtername) = @_;
261
262         $data->{protocols}->{$name} = {
263                 LONGNAME => $longname,
264                 SHORTNAME => $shortname,
265                 FILTERNAME => $filtername
266         };
267 }
268
269 sub handle_fielddescription($$$$)
270 {
271         my ($pos,$data,$field,$desc) = @_;
272
273         $data->{fielddescription}->{$field} = {
274                 DESCRIPTION => $desc,
275                 POS => $pos,
276                 USED => 0
277         };
278 }
279
280 sub handle_import
281 {
282         my $pos = shift @_;
283         my $data = shift @_;
284         my $dissectorname = shift @_;
285
286         unless(defined($dissectorname)) {
287                 print "$pos: error: no dissectorname specified\n";
288                 return;
289         }
290
291         $data->{imports}->{$dissectorname} = {
292                 NAME => $dissectorname,
293                 DATA => join(' ', @_),
294                 USED => 0,
295                 POS => $pos
296         };
297 }
298
299 my %field_handlers = (
300         TYPE => \&handle_type,
301         NOEMIT => \&handle_noemit, 
302         MANUAL => \&handle_manual,
303         PARAM_VALUE => \&handle_param_value, 
304         HF_FIELD => \&handle_hf_field, 
305         HF_RENAME => \&handle_hf_rename, 
306         TFS => \&handle_tfs,
307         STRIP_PREFIX => \&handle_strip_prefix,
308         PROTOCOL => \&handle_protocol,
309         FIELD_DESCRIPTION => \&handle_fielddescription,
310         IMPORT => \&handle_import
311 );
312
313 sub ReadConformance($$)
314 {
315         my ($f,$data) = @_;
316
317         $data->{override} = "";
318
319         my $incodeblock = 0;
320
321         open(IN,"<$f") or return undef;
322
323         my $ln = 0;
324
325         foreach (<IN>) {
326                 $ln++;
327                 next if (/^#.*$/);
328                 next if (/^$/);
329
330                 s/[\r\n]//g;
331
332                 if ($_ eq "CODE START") {
333                         $incodeblock = 1;
334                         next;
335                 } elsif ($incodeblock and $_ eq "CODE END") {
336                         $incodeblock = 0;
337                         next;
338                 } elsif ($incodeblock) {
339                         $data->{override}.="$_\n";
340                         next;
341                 }
342
343                 my @fields = /([^ "]+|"[^"]+")/g;
344
345                 my $cmd = $fields[0];
346
347                 shift @fields;
348
349                 if (not defined($field_handlers{$cmd})) {
350                         print "$f:$ln: Warning: Unknown command `$cmd'\n";
351                         next;
352                 }
353                 
354                 $field_handlers{$cmd}("$f:$ln", $data, @fields);
355         }
356
357         close(IN);
358 }
359
360 1;