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