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