1b550ae1e7b2ff1911fa20ee42ec90b2b3920043
[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 =back
74
75 =head1 EXAMPLE
76
77         INFO_KEY OpenKey.Ke
78
79 =cut
80
81 package Parse::Pidl::Ethereal::Conformance;
82
83 require Exporter;
84 use vars qw($VERSION);
85 $VERSION = '0.01';
86
87 @ISA = qw(Exporter);
88 @EXPORT_OK = qw(ReadConformance);
89
90 use strict;
91
92 use Parse::Pidl::Util qw(has_property);
93
94 sub handle_type($$$$$$$$$$)
95 {
96         my ($pos,$data,$name,$dissectorname,$ft_type,$base_type,$mask,$valsstring,$alignment) = @_;
97
98         unless(defined($alignment)) {
99                 print "$pos: error incomplete TYPE command\n";
100                 return;
101         }
102
103         unless ($dissectorname =~ /.*dissect_.*/) {
104                 print "$pos: warning: dissector name does not contain `dissect'\n";
105         }
106
107         unless(valid_ft_type($ft_type)) {
108                 print "$pos: warning: invalid FT_TYPE `$ft_type'\n";
109         }
110
111         unless (valid_base_type($base_type)) {
112                 print "$pos: warning: invalid BASE_TYPE `$base_type'\n";
113         }
114
115         $data->{types}->{$name} = {
116                 NAME => $name,
117                 POS => $pos,
118                 USED => 0,
119                 DISSECTOR_NAME => $dissectorname,
120                 FT_TYPE => $ft_type,
121                 BASE_TYPE => $base_type,
122                 MASK => $mask,
123                 VALSSTRING => $valsstring,
124                 ALIGNMENT => $alignment
125         };
126 }
127
128 sub handle_hf_rename($$$$)
129 {
130         my ($pos,$data,$old,$new) = @_;
131
132         unless(defined($new)) {
133                 print "$pos: error incomplete HF_RENAME command\n";
134                 return;
135         }
136
137         $data->{hf_renames}->{$old} = {
138                 OLDNAME => $old,
139                 NEWNAME => $new,
140                 POS => $pos,
141                 USED => 0
142         };
143 }
144
145 sub handle_param_value($$$$)
146 {
147         my ($pos,$data,$dissector_name,$value) = @_;
148
149         unless(defined($value)) {
150                 print "$pos: error: incomplete PARAM_VALUE command\n";
151                 return;
152         }
153
154         $data->{dissectorparams}->{$dissector_name} = {
155                 DISSECTOR => $dissector_name,
156                 PARAM => $value,
157                 POS => $pos,
158                 USED => 0
159         };
160 }
161
162 sub valid_base_type($)
163 {
164         my $t = shift;
165         return 0 unless($t =~ /^BASE_.*/);
166         return 1;
167 }
168
169 sub valid_ft_type($)
170 {
171         my $t = shift;
172         return 0 unless($t =~ /^FT_.*/);
173         return 1;
174 }
175
176 sub handle_hf_field($$$$$$$$$$)
177 {
178         my ($pos,$data,$index,$name,$filter,$ft_type,$base_type,$valsstring,$mask,$blurb) = @_;
179
180         unless(defined($blurb)) {
181                 print "$pos: error: incomplete HF_FIELD command\n";
182                 return;
183         }
184
185         unless(valid_ft_type($ft_type)) {
186                 print "$pos: warning: invalid FT_TYPE `$ft_type'\n";
187         }
188
189         unless(valid_base_type($base_type)) {
190                 print "$pos: warning: invalid BASE_TYPE `$base_type'\n";
191         }
192
193         $data->{header_fields}->{$index} = {
194                 INDEX => $index,
195                 POS => $pos,
196                 USED => 0,
197                 NAME => $name,
198                 FILTER => $filter,
199                 FT_TYPE => $ft_type,
200                 BASE_TYPE => $base_type,
201                 VALSSTRING => $valsstring,
202                 MASK => $mask,
203                 BLURB => $blurb
204         };
205 }
206
207 sub handle_strip_prefix($$$)
208 {
209         my ($pos,$data,$x) = @_;
210
211         push (@{$data->{strip_prefixes}}, $x);
212 }
213
214 sub handle_noemit($$$)
215 {
216         my ($pos,$data) = @_;
217         my $type;
218
219         $type = shift if ($#_ == 1);
220
221         if (defined($type)) {
222             $data->{noemit}->{$type} = 1;
223         } else {
224             $data->{noemit_dissector} = 1;
225         }
226 }
227
228 sub handle_protocol($$$$$$)
229 {
230         my ($pos, $data, $name, $longname, $shortname, $filtername) = @_;
231
232         $data->{protocols}->{$name} = {
233                 LONGNAME => $longname,
234                 SHORTNAME => $shortname,
235                 FILTERNAME => $filtername
236         };
237 }
238
239 sub handle_fielddescription($$$$)
240 {
241         my ($pos,$data,$field,$desc) = @_;
242
243         $data->{fielddescription}->{$field} = {
244                 DESCRIPTION => $desc,
245                 POS => $pos,
246                 USED => 0
247         };
248 }
249
250 sub handle_import
251 {
252         my $pos = shift @_;
253         my $data = shift @_;
254         my $dissectorname = shift @_;
255
256         unless(defined($dissectorname)) {
257                 print "$pos: error: no dissectorname specified\n";
258                 return;
259         }
260
261         $data->{imports}->{$dissectorname} = {
262                 NAME => $dissectorname,
263                 DATA => join(' ', @_),
264                 USED => 0,
265                 POS => $pos
266         };
267 }
268
269 my %field_handlers = (
270         TYPE => \&handle_type,
271         NOEMIT => \&handle_noemit, 
272         PARAM_VALUE => \&handle_param_value, 
273         HF_FIELD => \&handle_hf_field, 
274         HF_RENAME => \&handle_hf_rename, 
275         STRIP_PREFIX => \&handle_strip_prefix,
276         PROTOCOL => \&handle_protocol,
277         FIELD_DESCRIPTION => \&handle_fielddescription,
278         IMPORT => \&handle_import
279 );
280
281 sub ReadConformance($$)
282 {
283         my ($f,$data) = @_;
284
285         $data->{override} = "";
286
287         my $incodeblock = 0;
288
289         open(IN,"<$f") or return undef;
290
291         my $ln = 0;
292
293         foreach (<IN>) {
294                 $ln++;
295                 next if (/^#.*$/);
296                 next if (/^$/);
297
298                 s/[\r\n]//g;
299
300                 if ($_ eq "CODE START") {
301                         $incodeblock = 1;
302                         next;
303                 } elsif ($incodeblock and $_ eq "CODE END") {
304                         $incodeblock = 0;
305                         next;
306                 } elsif ($incodeblock) {
307                         $data->{override}.="$_\n";
308                         next;
309                 }
310
311                 my @fields = /([^ "]+|"[^"]+")/g;
312
313                 my $cmd = $fields[0];
314
315                 shift @fields;
316
317                 if (not defined($field_handlers{$cmd})) {
318                         print "$f:$ln: Warning: Unknown command `$cmd'\n";
319                         next;
320                 }
321                 
322                 $field_handlers{$cmd}("$f:$ln", $data, @fields);
323         }
324
325         close(IN);
326 }
327
328 1;