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