452 lines
8.6 KiB
Perl
452 lines
8.6 KiB
Perl
###################################################
|
|
# parse an Wireshark conformance file
|
|
# Copyright jelmer@samba.org 2005
|
|
# released under the GNU GPL
|
|
|
|
=pod
|
|
|
|
=head1 NAME
|
|
|
|
Parse::Pidl::Wireshark::Conformance - Conformance file parser for Wireshark
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This module supports parsing Wireshark conformance files (*.cnf).
|
|
|
|
=head1 FILE FORMAT
|
|
|
|
Pidl needs additional data for Wireshark output. This data is read from
|
|
so-called conformance files. This section describes the format of these
|
|
files.
|
|
|
|
Conformance files are simple text files with a single command on each line.
|
|
Empty lines and lines starting with a '#' character are ignored.
|
|
Arguments to commands are seperated by spaces.
|
|
|
|
The following commands are currently supported:
|
|
|
|
=over 4
|
|
|
|
=item I<TYPE> name dissector ft_type base_type mask valsstring alignment
|
|
|
|
Register new data type with specified name, what dissector function to call
|
|
and what properties to give header fields for elements of this type.
|
|
|
|
=item I<NOEMIT> type
|
|
|
|
Suppress emitting a dissect_type function for the specified type
|
|
|
|
=item I<PARAM_VALUE> type param
|
|
|
|
Set parameter to specify to dissector function for given type.
|
|
|
|
=item I<HF_FIELD> hf title filter ft_type base_type valsstring mask description
|
|
|
|
Generate a custom header field with specified properties.
|
|
|
|
=item I<HF_RENAME> old_hf_name new_hf_name
|
|
|
|
Force the use of new_hf_name when the parser generator was going to
|
|
use old_hf_name.
|
|
|
|
This can be used in conjunction with HF_FIELD in order to make more than
|
|
one element use the same filter name.
|
|
|
|
=item I<ETT_FIELD> ett
|
|
|
|
Register a custom ett field
|
|
|
|
=item I<STRIP_PREFIX> prefix
|
|
|
|
Remove the specified prefix from all function names (if present).
|
|
|
|
=item I<PROTOCOL> longname shortname filtername
|
|
|
|
Change the short-, long- and filter-name for the current interface in
|
|
Wireshark.
|
|
|
|
=item I<FIELD_DESCRIPTION> field desc
|
|
|
|
Change description for the specified header field. `field' is the hf name of the field.
|
|
|
|
=item I<IMPORT> dissector code...
|
|
|
|
Code to insert when generating the specified dissector. @HF@ and
|
|
@PARAM@ will be substituted.
|
|
|
|
=item I<INCLUDE> filename
|
|
|
|
Include conformance data from the specified filename in the dissector.
|
|
|
|
=item I<TFS> hf_name "true string" "false string"
|
|
|
|
Override the text shown when a bitmap boolean value is enabled or disabled.
|
|
|
|
=item I<MANUAL> fn_name
|
|
|
|
Force pidl to not generate a particular function but allow the user
|
|
to write a function manually. This can be used to remove the function
|
|
for only one level for a particular element rather than all the functions and
|
|
ett/hf variables for a particular element as the NOEMIT command does.
|
|
|
|
=back
|
|
|
|
=head1 EXAMPLE
|
|
|
|
INFO_KEY OpenKey.Ke
|
|
|
|
=cut
|
|
|
|
package Parse::Pidl::Wireshark::Conformance;
|
|
|
|
require Exporter;
|
|
use vars qw($VERSION);
|
|
$VERSION = '0.01';
|
|
|
|
@ISA = qw(Exporter);
|
|
@EXPORT_OK = qw(ReadConformance ReadConformanceFH valid_ft_type valid_base_type);
|
|
|
|
use strict;
|
|
|
|
use Parse::Pidl qw(fatal warning error);
|
|
use Parse::Pidl::Util qw(has_property);
|
|
use Parse::Pidl::Typelist qw(addType);
|
|
|
|
sub handle_type($$$$$$$$$$)
|
|
{
|
|
my ($pos,$data,$name,$dissectorname,$ft_type,$base_type,$mask,$valsstring,$alignment) = @_;
|
|
|
|
unless(defined($alignment)) {
|
|
error($pos, "incomplete TYPE command");
|
|
return;
|
|
}
|
|
|
|
unless ($dissectorname =~ /.*dissect_.*/) {
|
|
warning($pos, "dissector name does not contain `dissect'");
|
|
}
|
|
|
|
unless(valid_ft_type($ft_type)) {
|
|
warning($pos, "invalid FT_TYPE `$ft_type'");
|
|
}
|
|
|
|
unless (valid_base_type($base_type)) {
|
|
warning($pos, "invalid BASE_TYPE `$base_type'");
|
|
}
|
|
|
|
$dissectorname =~ s/^\"(.*)\"$/$1/g;
|
|
|
|
if (not ($dissectorname =~ /;$/)) {
|
|
warning($pos, "missing semicolon");
|
|
}
|
|
|
|
$data->{types}->{$name} = {
|
|
NAME => $name,
|
|
POS => $pos,
|
|
USED => 0,
|
|
DISSECTOR_NAME => $dissectorname,
|
|
FT_TYPE => $ft_type,
|
|
BASE_TYPE => $base_type,
|
|
MASK => $mask,
|
|
VALSSTRING => $valsstring,
|
|
ALIGNMENT => $alignment
|
|
};
|
|
|
|
addType({
|
|
NAME => $name,
|
|
TYPE => "CONFORMANCE",
|
|
BASEFILE => "conformance file",
|
|
DATA => {
|
|
NAME => $name,
|
|
TYPE => "CONFORMANCE",
|
|
ALIGN => $alignment
|
|
}
|
|
});
|
|
}
|
|
|
|
sub handle_tfs($$$$$)
|
|
{
|
|
my ($pos,$data,$hf,$trues,$falses) = @_;
|
|
|
|
unless(defined($falses)) {
|
|
error($pos, "incomplete TFS command");
|
|
return;
|
|
}
|
|
|
|
$data->{tfs}->{$hf} = {
|
|
TRUE_STRING => $trues,
|
|
FALSE_STRING => $falses
|
|
};
|
|
}
|
|
|
|
sub handle_hf_rename($$$$)
|
|
{
|
|
my ($pos,$data,$old,$new) = @_;
|
|
|
|
unless(defined($new)) {
|
|
warning($pos, "incomplete HF_RENAME command");
|
|
return;
|
|
}
|
|
|
|
$data->{hf_renames}->{$old} = {
|
|
OLDNAME => $old,
|
|
NEWNAME => $new,
|
|
POS => $pos,
|
|
USED => 0
|
|
};
|
|
}
|
|
|
|
sub handle_param_value($$$$)
|
|
{
|
|
my ($pos,$data,$dissector_name,$value) = @_;
|
|
|
|
unless(defined($value)) {
|
|
error($pos, "incomplete PARAM_VALUE command");
|
|
return;
|
|
}
|
|
|
|
$data->{dissectorparams}->{$dissector_name} = {
|
|
DISSECTOR => $dissector_name,
|
|
PARAM => $value,
|
|
POS => $pos,
|
|
USED => 0
|
|
};
|
|
}
|
|
|
|
sub valid_base_type($)
|
|
{
|
|
my $t = shift;
|
|
return 0 unless($t =~ /^BASE_.*/);
|
|
return 1;
|
|
}
|
|
|
|
sub valid_ft_type($)
|
|
{
|
|
my $t = shift;
|
|
return 0 unless($t =~ /^FT_.*/);
|
|
return 1;
|
|
}
|
|
|
|
sub handle_hf_field($$$$$$$$$$)
|
|
{
|
|
my ($pos,$data,$index,$name,$filter,$ft_type,$base_type,$valsstring,$mask,$blurb) = @_;
|
|
|
|
unless(defined($blurb)) {
|
|
error($pos, "incomplete HF_FIELD command");
|
|
return;
|
|
}
|
|
|
|
unless(valid_ft_type($ft_type)) {
|
|
warning($pos, "invalid FT_TYPE `$ft_type'");
|
|
}
|
|
|
|
unless(valid_base_type($base_type)) {
|
|
warning($pos, "invalid BASE_TYPE `$base_type'");
|
|
}
|
|
|
|
$data->{header_fields}->{$index} = {
|
|
INDEX => $index,
|
|
POS => $pos,
|
|
USED => 0,
|
|
NAME => $name,
|
|
FILTER => $filter,
|
|
FT_TYPE => $ft_type,
|
|
BASE_TYPE => $base_type,
|
|
VALSSTRING => $valsstring,
|
|
MASK => $mask,
|
|
BLURB => $blurb
|
|
};
|
|
}
|
|
|
|
sub handle_strip_prefix($$$)
|
|
{
|
|
my ($pos,$data,$x) = @_;
|
|
|
|
push (@{$data->{strip_prefixes}}, $x);
|
|
}
|
|
|
|
sub handle_noemit($$$)
|
|
{
|
|
my ($pos,$data,$type) = @_;
|
|
|
|
if (defined($type)) {
|
|
$data->{noemit}->{$type} = 1;
|
|
} else {
|
|
$data->{noemit_dissector} = 1;
|
|
}
|
|
}
|
|
|
|
sub handle_manual($$$)
|
|
{
|
|
my ($pos,$data,$fn) = @_;
|
|
|
|
unless(defined($fn)) {
|
|
warning($pos, "incomplete MANUAL command");
|
|
return;
|
|
}
|
|
|
|
$data->{manual}->{$fn} = 1;
|
|
}
|
|
|
|
sub handle_protocol($$$$$$)
|
|
{
|
|
my ($pos, $data, $name, $longname, $shortname, $filtername) = @_;
|
|
|
|
$data->{protocols}->{$name} = {
|
|
LONGNAME => $longname,
|
|
SHORTNAME => $shortname,
|
|
FILTERNAME => $filtername
|
|
};
|
|
}
|
|
|
|
sub handle_fielddescription($$$$)
|
|
{
|
|
my ($pos,$data,$field,$desc) = @_;
|
|
|
|
unless(defined($desc)) {
|
|
warning($pos, "incomplete FIELD_DESCRIPTION command");
|
|
return;
|
|
}
|
|
|
|
$data->{fielddescription}->{$field} = {
|
|
DESCRIPTION => $desc,
|
|
POS => $pos,
|
|
USED => 0
|
|
};
|
|
}
|
|
|
|
sub handle_import
|
|
{
|
|
my $pos = shift @_;
|
|
my $data = shift @_;
|
|
my $dissectorname = shift @_;
|
|
|
|
unless(defined($dissectorname)) {
|
|
error($pos, "no dissectorname specified");
|
|
return;
|
|
}
|
|
|
|
$data->{imports}->{$dissectorname} = {
|
|
NAME => $dissectorname,
|
|
DATA => join(' ', @_),
|
|
USED => 0,
|
|
POS => $pos
|
|
};
|
|
}
|
|
|
|
sub handle_ett_field
|
|
{
|
|
my $pos = shift @_;
|
|
my $data = shift @_;
|
|
my $ett = shift @_;
|
|
|
|
unless(defined($ett)) {
|
|
error($pos, "incomplete ETT_FIELD command");
|
|
return;
|
|
}
|
|
|
|
push (@{$data->{ett}}, $ett);
|
|
}
|
|
|
|
sub handle_include
|
|
{
|
|
my $pos = shift @_;
|
|
my $data = shift @_;
|
|
my $fn = shift @_;
|
|
|
|
unless(defined($fn)) {
|
|
error($pos, "incomplete INCLUDE command");
|
|
return;
|
|
}
|
|
|
|
ReadConformance($fn, $data);
|
|
}
|
|
|
|
my %field_handlers = (
|
|
TYPE => \&handle_type,
|
|
NOEMIT => \&handle_noemit,
|
|
MANUAL => \&handle_manual,
|
|
PARAM_VALUE => \&handle_param_value,
|
|
HF_FIELD => \&handle_hf_field,
|
|
HF_RENAME => \&handle_hf_rename,
|
|
ETT_FIELD => \&handle_ett_field,
|
|
TFS => \&handle_tfs,
|
|
STRIP_PREFIX => \&handle_strip_prefix,
|
|
PROTOCOL => \&handle_protocol,
|
|
FIELD_DESCRIPTION => \&handle_fielddescription,
|
|
IMPORT => \&handle_import,
|
|
INCLUDE => \&handle_include
|
|
);
|
|
|
|
sub ReadConformance($$)
|
|
{
|
|
my ($f,$data) = @_;
|
|
my $ret;
|
|
|
|
open(IN,"<$f") or return undef;
|
|
|
|
$ret = ReadConformanceFH(*IN, $data, $f);
|
|
|
|
close(IN);
|
|
|
|
return $ret;
|
|
}
|
|
|
|
sub ReadConformanceFH($$$)
|
|
{
|
|
my ($fh,$data,$f) = @_;
|
|
|
|
my $incodeblock = 0;
|
|
|
|
my $ln = 0;
|
|
|
|
foreach (<$fh>) {
|
|
$ln++;
|
|
next if (/^#.*$/);
|
|
next if (/^$/);
|
|
|
|
s/[\r\n]//g;
|
|
|
|
if ($_ eq "CODE START") {
|
|
$incodeblock = 1;
|
|
next;
|
|
} elsif ($incodeblock and $_ eq "CODE END") {
|
|
$incodeblock = 0;
|
|
next;
|
|
} elsif ($incodeblock) {
|
|
if (exists $data->{override}) {
|
|
$data->{override}.="$_\n";
|
|
} else {
|
|
$data->{override} = "$_\n";
|
|
}
|
|
next;
|
|
}
|
|
|
|
my @fields = /([^ "]+|"[^"]+")/g;
|
|
|
|
my $cmd = $fields[0];
|
|
|
|
shift @fields;
|
|
|
|
my $pos = { FILE => $f, LINE => $ln };
|
|
|
|
next unless(defined($cmd));
|
|
|
|
if (not defined($field_handlers{$cmd})) {
|
|
warning($pos, "Unknown command `$cmd'");
|
|
next;
|
|
}
|
|
|
|
$field_handlers{$cmd}($pos, $data, @fields);
|
|
}
|
|
|
|
if ($incodeblock) {
|
|
warning({ FILE => $f, LINE => $ln },
|
|
"Expecting CODE END");
|
|
return undef;
|
|
}
|
|
|
|
return 1;
|
|
}
|
|
|
|
1;
|