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