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;