osmocom/wireshark
14
0
Fork 1
Code Issues Pull requests Projects Releases Wiki Activity
wireshark/tools/process-x11-xcb.pl
Guy Harris e1d9a226a2 Fix the type of arrays of pointers to hf_ values for bitfield routines. 
The static arrays are supposed to be arrays of const pointers to int,
not arrays of non-const pointers to const int.

Fixing that means some bugs (scribbling on what's *supposed* to be a
const array) will be caught (see packet-ieee80211-radiotap.c for
examples, the first of which inspired this change and the second of
which was discovered while testing compiles with this change), and
removes the need for some annoying casts.

Also make some of those arrays static while we're at it.

Update documentation and dissector-generator tools.

Change-Id: I789da5fc60aadc15797cefecfd9a9fbe9a130ccc
Reviewed-on: https://code.wireshark.org/review/37517
Petri-Dish: Guy Harris <gharris@sonic.net>
Tested-by: Petri Dish Buildbot
Reviewed-by: Anders Broman <a.broman58@gmail.com>
2020-06-19 11:32:26 +00:00

1947 lines
68 KiB
Perl
Executable file
Raw Blame History

#!/usr/bin/perl
#
# Script to convert xcbproto and mesa protocol files for
# X11 dissector. Creates header files containing code to
# dissect X11 extensions.
#
# Instructions for using this script are in epan/dissectors/README.X11
#
# Copyright 2008, 2009, 2013, 2014 Open Text Corporation <pharris[AT]opentext.com>
#
# Wireshark - Network traffic analyzer
# By Gerald Combs <gerald@wireshark.org>
# Copyright 1998 Gerald Combs
#
# SPDX-License-Identifier: GPL-2.0-or-later
#
#TODO
# - support constructs that are legal in XCB, but don't appear to be used
use 5.010;
use warnings;
use strict;
# given/when is going to be removed (and/or dramatically altered)
# in 5.20. Patches welcome.
# Patches even more welcome if they rewrite this whole thing in a
# language with a proper compatibility document, such as
# http://golang.org/doc/go1compat
no if $] >= 5.018, warnings => "experimental::smartmatch";
use IO::File;
use XML::Twig;
use File::Spec;
my $srcdir = shift;
die "'$srcdir' is not a directory" unless -d $srcdir;
my @reslist = grep {!/xproto\.xml$/} glob File::Spec->catfile($srcdir, 'xcbproto', 'src', '*.xml');
my @register;
my $script_name = File::Spec->abs2rel ($0, $srcdir);
my %basictype = (
char => { size => 1, encoding => 'ENC_ASCII|ENC_NA', type => 'FT_STRING', base => 'BASE_NONE', get => 'tvb_get_guint8', list => 'listOfByte', },
void => { size => 1, encoding => 'ENC_NA', type => 'FT_BYTES', base => 'BASE_NONE', get => 'tvb_get_guint8', list => 'listOfByte', },
BYTE => { size => 1, encoding => 'ENC_NA', type => 'FT_BYTES', base => 'BASE_NONE', get => 'tvb_get_guint8', list => 'listOfByte', },
CARD8 => { size => 1, encoding => 'byte_order', type => 'FT_UINT8', base => 'BASE_HEX_DEC', get => 'tvb_get_guint8', list => 'listOfByte', },
CARD16 => { size => 2, encoding => 'byte_order', type => 'FT_UINT16', base => 'BASE_HEX_DEC', get => 'tvb_get_guint16', list => 'listOfCard16', },
CARD32 => { size => 4, encoding => 'byte_order', type => 'FT_UINT32', base => 'BASE_HEX_DEC', get => 'tvb_get_guint32', list => 'listOfCard32', },
CARD64 => { size => 8, encoding => 'byte_order', type => 'FT_UINT64', base => 'BASE_HEX_DEC', get => 'tvb_get_guint64', list => 'listOfCard64', },
INT8 => { size => 1, encoding => 'byte_order', type => 'FT_INT8', base => 'BASE_DEC', get => 'tvb_get_guint8', list => 'listOfByte', },
INT16 => { size => 2, encoding => 'byte_order', type => 'FT_INT16', base => 'BASE_DEC', get => 'tvb_get_guint16', list => 'listOfInt16', },
INT32 => { size => 4, encoding => 'byte_order', type => 'FT_INT32', base => 'BASE_DEC', get => 'tvb_get_guint32', list => 'listOfInt32', },
INT64 => { size => 8, encoding => 'byte_order', type => 'FT_INT64', base => 'BASE_DEC', get => 'tvb_get_guint64', list => 'listOfInt64', },
float => { size => 4, encoding => 'byte_order', type => 'FT_FLOAT', base => 'BASE_NONE', get => 'tvb_get_ieee_float', list => 'listOfFloat', },
double => { size => 8, encoding => 'byte_order', type => 'FT_DOUBLE', base => 'BASE_NONE', get => 'tvb_get_ieee_double', list => 'listOfDouble', },
BOOL => { size => 1, encoding => 'byte_order', type => 'FT_BOOLEAN',base => 'BASE_NONE', get => 'tvb_get_guint8', list => 'listOfByte', },
);
my %simpletype; # Reset at the beginning of each extension
my %gltype; # No need to reset, since it's only used once
my %struct = # Not reset; contains structures already defined.
# Also contains this black-list of structures never used by any
# extension (to avoid generating useless code).
(
# structures defined by xproto, but not used by any extension
'xproto:CHAR2B' => 1,
'xproto:ARC' => 1,
'xproto:FORMAT' => 1,
'xproto:VISUALTYPE' => 1,
'xproto:DEPTH' => 1,
'xproto:SCREEN' => 1,
'xproto:SetupRequest' => 1,
'xproto:SetupFailed' => 1,
'xproto:SetupAuthenticate' => 1,
'xproto:Setup' => 1,
'xproto:TIMECOORD' => 1,
'xproto:FONTPROP' => 1,
'xproto:CHARINFO' => 1,
'xproto:SEGMENT' => 1,
'xproto:COLORITEM' => 1,
'xproto:RGB' => 1,
'xproto:HOST' => 1,
'xproto:POINT' => 1,
# structures defined by xinput, but never used (except by each other)(bug in xcb?)
'xinput:KeyInfo' => 1,
'xinput:ButtonInfo' => 1,
'xinput:ValuatorInfo' => 1,
'xinput:KbdFeedbackState' => 1,
'xinput:PtrFeedbackState' => 1,
'xinput:IntegerFeedbackState' => 1,
'xinput:StringFeedbackState' => 1,
'xinput:BellFeedbackState' => 1,
'xinput:LedFeedbackState' => 1,
'xinput:KbdFeedbackCtl' => 1,
'xinput:PtrFeedbackCtl' => 1,
'xinput:IntegerFeedbackCtl' => 1,
'xinput:StringFeedbackCtl' => 1,
'xinput:BellFeedbackCtl' => 1,
'xinput:LedFeedbackCtl' => 1,
'xinput:KeyState' => 1,
'xinput:ButtonState' => 1,
'xinput:ValuatorState' => 1,
'xinput:DeviceResolutionState' => 1,
'xinput:DeviceAbsCalibState' => 1,
'xinput:DeviceAbsAreaState' => 1,
'xinput:DeviceCoreState' => 1,
'xinput:DeviceEnableState' => 1,
'xinput:DeviceResolutionCtl' => 1,
'xinput:DeviceAbsCalibCtl' => 1,
'xinput:DeviceAbsAreaCtrl' => 1,
'xinput:DeviceCoreCtrl' => 1,
'xinput:DeviceEnableCtrl' => 1,
'xinput:DeviceName' => 1,
'xinput:AddMaster' => 1,
'xinput:RemoveMaster' => 1,
'xinput:AttachSlave' => 1,
'xinput:DetachSlave' => 1,
'xinput:ButtonClass' => 1,
'xinput:KeyClass' => 1,
'xinput:ScrollClass' => 1,
'xinput:TouchClass' => 1,
'xinput:ValuatorClass' => 1,
# structures defined by xv, but never used (bug in xcb?)
'xv:Image' => 1,
# structures defined by xkb, but never used (except by each other)(bug in xcb?)
'xkb:Key' => 1,
'xkb:Outline' => 1,
'xkb:Overlay' => 1,
'xkb:OverlayKey' => 1,
'xkb:OverlayRow' => 1,
'xkb:Row' => 1,
'xkb:Shape' => 1,
);
my %enum; # Not reset; contains enums already defined.
my %enum_name;
my %type_name;
my $header;
my $extname;
my @incname;
my %request;
my %genericevent;
my %event;
my %reply;
# Output files
my $impl;
my $reg;
my $decl;
my $error;
# glRender sub-op output files
my $enum;
# Mesa API definitions keep moving
my @mesas = ($srcdir . '/mesa/src/mapi/glapi/gen', # 2010-04-26
$srcdir . '/mesa/src/mesa/glapi/gen', # 2010-02-22
$srcdir . '/mesa/src/mesa/glapi'); # 2004-05-18
my $mesadir = (grep { -d } @mesas)[0];
sub mesa_category {
my ($t, $elt) = @_;
$t->purge;
}
#used to prevent duplication and sort enumerated values
my %mesa_enum_hash = ();
sub mesa_enum {
my ($t, $elt) = @_;
my $name = $elt->att('name');
my $value = $elt->att('value');
my $hex_value = hex($value); #convert string to hex value to catch leading zeros
#make sure value isn't already in the hash, to prevent duplication in value_string
if (!exists($mesa_enum_hash{$hex_value})) {
$mesa_enum_hash{$hex_value} = $name;
}
$t->purge;
}
sub mesa_type {
my ($t, $elt) = @_;
my $name = $elt->att('name');
my $size = $elt->att('size');
my $float = $elt->att('float');
my $unsigned = $elt->att('unsigned');
my $base;
$t->purge;
if($name eq 'enum') {
# enum does not have a direct X equivalent
$gltype{'GLenum'} = { size => 4, encoding => 'byte_order', type => 'FT_UINT32', base => 'BASE_HEX|BASE_EXT_STRING',
get => 'tvb_get_guint32', list => 'listOfCard32',
val => '&mesa_enum_ext', };
return;
}
$name = 'GL'.$name;
if (defined($float) && $float eq 'true') {
$base = 'float';
$base = 'double' if ($size == 8);
} else {
$base = 'INT';
if (defined($unsigned) && $unsigned eq 'true') {
$base = 'CARD';
}
$base .= ($size * 8);
$base = 'BOOL' if ($name eq 'bool');
$base = 'BYTE' if ($name eq 'void');
}
$gltype{$name} = $basictype{$base};
}
sub registered_name($$)
{
my $name = shift;
my $field = shift;
return "hf_x11_$header"."_$name"."_$field";
}
sub mesa_function {
my ($t, $elt) = @_;
# rop == glRender sub-op
# sop == GLX minor opcode
my $glx = $elt->first_child('glx');
unless(defined $glx) { $t->purge; return; }
my $rop = $glx->att('rop');
unless (defined $rop) { $t->purge; return; }
# Ideally, we want the main name, not the alias name.
# Practically, we'd have to scan the file twice to find
# the functions that we want to skip.
my $alias = $elt->att('alias');
if (defined $alias) { $t->purge; return; }
my $name = $elt->att('name');
$request{$rop} = $name;
my $image;
my $length = 0;
my @elements = $elt->children('param');
# Wireshark defines _U_ to mean "Unused" (compiler specific define)
if (!@elements) {
print $impl <<eot
static void mesa_$name(tvbuff_t *tvb _U_, int *offsetp _U_, proto_tree *t _U_, guint byte_order _U_, int length _U_)
{
eot
;
} else {
print $impl <<eot
static void mesa_$name(tvbuff_t *tvb, int *offsetp, proto_tree *t, guint byte_order, int length _U_)
{
eot
;
}
my %type_param;
foreach my $e (@elements) {
# Detect count && variable_param
my $count = $e->att('count');
my $variable_param = $e->att('variable_param');
if (defined $count and defined $variable_param) {
$type_param{$variable_param} = 1;
}
}
foreach my $e (@elements) {
# Register field with wireshark
my $type = $e->att('type');
$type =~ s/^const //;
my $list;
$list = 1 if ($type =~ /\*$/);
$type =~ s/ \*$//;
my $fieldname = $e->att('name');
my $regname = registered_name($name, $fieldname);
my $info = $gltype{$type};
my $ft = $info->{'type'};
my $base = $info->{'base'};
my $val = $info->{'val'} // 'NULL';
my $count = $e->att('count');
my $variable_param = $e->att('variable_param');
if ($list and $count and $variable_param) {
print $decl "static int ${regname} = -1;\n";
print $reg "{ &$regname, { \"$fieldname\", \"x11.glx.render.$name.$fieldname\", FT_NONE, BASE_NONE, NULL, 0, NULL, HFILL }},\n";
print $decl "static int ${regname}_signed = -1;\n";
print $reg "{ &${regname}_signed, { \"$fieldname\", \"x11.glx.render.$name.$fieldname\", FT_INT8, BASE_DEC, NULL, 0, NULL, HFILL }},\n";
print $decl "static int ${regname}_unsigned = -1;\n";
print $reg "{ &${regname}_unsigned, { \"$fieldname\", \"x11.glx.render.$name.$fieldname\", FT_UINT8, BASE_DEC, NULL, 0, NULL, HFILL }},\n";
print $decl "static int ${regname}_item_card16 = -1;\n";
print $reg "{ &${regname}_item_card16, { \"$fieldname\", \"x11.glx.render.$name.$fieldname\", FT_UINT16, BASE_DEC, NULL, 0, NULL, HFILL }},\n";
print $decl "static int ${regname}_item_int16 = -1;\n";
print $reg "{ &${regname}_item_int16, { \"$fieldname\", \"x11.glx.render.$name.$fieldname\", FT_INT16, BASE_DEC, NULL, 0, NULL, HFILL }},\n";
print $decl "static int ${regname}_item_card32 = -1;\n";
print $reg "{ &${regname}_item_card32, { \"$fieldname\", \"x11.glx.render.$name.$fieldname\", FT_UINT32, BASE_DEC, NULL, 0, NULL, HFILL }},\n";
print $decl "static int ${regname}_item_int32 = -1;\n";
print $reg "{ &${regname}_item_int32, { \"$fieldname\", \"x11.glx.render.$name.$fieldname\", FT_INT32, BASE_DEC, NULL, 0, NULL, HFILL }},\n";
print $decl "static int ${regname}_item_float = -1;\n";
print $reg "{ &${regname}_item_float, { \"$fieldname\", \"x11.glx.render.$name.$fieldname\", FT_FLOAT, BASE_NONE, NULL, 0, NULL, HFILL }},\n";
} else {
print $decl "static int $regname = -1;\n";
if ($list and $info->{'size'} > 1) {
print $reg "{ &$regname, { \"$fieldname\", \"x11.glx.render.$name.$fieldname.list\", FT_NONE, BASE_NONE, NULL, 0, NULL, HFILL }},\n";
$regname .= '_item';
print $decl "static int $regname = -1;\n";
}
print $reg "{ &$regname, { \"$fieldname\", \"x11.glx.render.$name.$fieldname\", $ft, $base, $val, 0, NULL, HFILL }},\n";
if ($e->att('counter') or $type_param{$fieldname}) {
print $impl " int $fieldname;\n";
}
}
if ($list) {
if ($e->att('img_format')) {
$image = 1;
foreach my $wholename (('swap bytes', 'lsb first')) {
# Boolean values
my $varname = $wholename;
$varname =~ s/\s//g;
my $regname = registered_name($name, $varname);
print $decl "static int $regname = -1;\n";
print $reg "{ &$regname, { \"$wholename\", \"x11.glx.render.$name.$varname\", FT_BOOLEAN, BASE_NONE, NULL, 0, NULL, HFILL }},\n";
}
foreach my $wholename (('row length', 'skip rows', 'skip pixels', 'alignment')) {
# Integer values
my $varname = $wholename;
$varname =~ s/\s//g;
my $regname = registered_name($name, $varname);
print $decl "static int $regname = -1;\n";
print $reg "{ &$regname, { \"$wholename\", \"x11.glx.render.$name.$varname\", FT_UINT32, BASE_HEX_DEC, NULL, 0, NULL, HFILL }},\n";
}
}
}
}
# The image requests have a few implicit elements first:
if ($image) {
foreach my $wholename (('swap bytes', 'lsb first')) {
# Boolean values
my $varname = $wholename;
$varname =~ s/\s//g;
my $regname = registered_name($name, $varname);
print $impl " proto_tree_add_item(t, $regname, tvb, *offsetp, 1, byte_order);\n";
print $impl " *offsetp += 1;\n";
$length += 1;
}
print $impl " proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, 2, ENC_NA);\n";
print $impl " *offsetp += 2;\n";
$length += 2;
foreach my $wholename (('row length', 'skip rows', 'skip pixels', 'alignment')) {
# Integer values
my $varname = $wholename;
$varname =~ s/\s//g;
my $regname = registered_name($name, $varname);
print $impl " proto_tree_add_item(t, $regname, tvb, *offsetp, 4, byte_order);\n";
print $impl " *offsetp += 4;\n";
$length += 4;
}
}
foreach my $e (@elements) {
my $type = $e->att('type');
$type =~ s/^const //;
my $list;
$list = 1 if ($type =~ /\*$/);
$type =~ s/ \*$//;
my $fieldname = $e->att('name');
my $regname = registered_name($name, $fieldname);
my $info = $gltype{$type};
my $ft = $info->{'type'};
my $base = $info->{'base'};
if (!$list) {
my $size = $info->{'size'};
my $encoding = $info->{'encoding'};
my $get = $info->{'get'};
if ($e->att('counter') or $type_param{$fieldname}) {
if ($get ne "tvb_get_guint8") {
print $impl " $fieldname = $get(tvb, *offsetp, $encoding);\n";
} else {
print $impl " $fieldname = $get(tvb, *offsetp);\n";
}
}
print $impl " proto_tree_add_item(t, $regname, tvb, *offsetp, $size, $encoding);\n";
print $impl " *offsetp += $size;\n";
$length += $size;
} else { # list
my $list = $info->{'list'};
my $count = $e->att('count');
my $variable_param = $e->att('variable_param');
if (defined($count) && !defined($variable_param)) {
$regname .= ", $regname".'_item' if ($info->{'size'} > 1);
print $impl " $list(tvb, offsetp, t, $regname, $count, byte_order);\n";
} else {
if (defined($count)) {
# Currently, only CallLists has both a count and a variable_param
# The XML contains a size description of all the possibilities
# for CallLists, but not a type description. Implement by hand,
# with the caveat that more types may need to be added in the
# future.
say $impl " switch($variable_param) {";
say $impl " case 0x1400: /* BYTE */";
say $impl " listOfByte(tvb, offsetp, t, ${regname}_signed, $count, byte_order);";
say $impl " proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, (length - $length - $count), ENC_NA);";
say $impl " *offsetp += (length - $length - $count);";
say $impl " break;";
say $impl " case 0x1401: /* UNSIGNED_BYTE */";
say $impl " listOfByte(tvb, offsetp, t, ${regname}_unsigned, $count, byte_order);";
say $impl " proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, (length - $length - $count), ENC_NA);";
say $impl " *offsetp += (length - $length - $count);";
say $impl " break;";
say $impl " case 0x1402: /* SHORT */";
say $impl " listOfInt16(tvb, offsetp, t, $regname, ${regname}_item_int16, $count, byte_order);";
say $impl " proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, (length - $length - 2 * $count), ENC_NA);";
say $impl " *offsetp += (length - $length - 2 * $count);";
say $impl " break;";
say $impl " case 0x1403: /* UNSIGNED_SHORT */";
say $impl " listOfCard16(tvb, offsetp, t, $regname, ${regname}_item_card16, $count, byte_order);";
say $impl " proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, (length - $length - 2 * $count), ENC_NA);";
say $impl " *offsetp += (length - $length - 2 * $count);";
say $impl " break;";
say $impl " case 0x1404: /* INT */";
say $impl " listOfInt32(tvb, offsetp, t, $regname, ${regname}_item_int32, $count, byte_order);";
say $impl " break;";
say $impl " case 0x1405: /* UNSIGNED_INT */";
say $impl " listOfCard32(tvb, offsetp, t, $regname, ${regname}_item_card32, $count, byte_order);";
say $impl " break;";
say $impl " case 0x1406: /* FLOAT */";
say $impl " listOfFloat(tvb, offsetp, t, $regname, ${regname}_item_float, $count, byte_order);";
say $impl " break;";
say $impl " case 0x1407: /* 2_BYTES */";
say $impl " listOfCard16(tvb, offsetp, t, $regname, ${regname}_item_card16, $count, ENC_BIG_ENDIAN);";
say $impl " proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, (length - $length - 2 * $count), ENC_NA);";
say $impl " *offsetp += (length - $length - 2 * $count);";
say $impl " break;";
say $impl " case 0x1408: /* 3_BYTES */";
say $impl " UNDECODED(3 * $count);";
say $impl " proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, (length - $length - 3 * $count), ENC_NA);";
say $impl " *offsetp += (length - $length - 3 * $count);";
say $impl " break;";
say $impl " case 0x1409: /* 4_BYTES */";
say $impl " listOfCard32(tvb, offsetp, t, $regname, ${regname}_item_card32, $count, ENC_BIG_ENDIAN);";
say $impl " break;";
say $impl " case 0x140B: /* HALF_FLOAT */";
say $impl " UNDECODED(2 * $count);";
say $impl " proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, (length - $length - 2 * $count), ENC_NA);";
say $impl " *offsetp += (length - $length - 2 * $count);";
say $impl " break;";
say $impl " default: /* Unknown */";
say $impl " UNDECODED(length - $length);";
say $impl " break;";
say $impl " }";
} else {
$regname .= ", $regname".'_item' if ($info->{'size'} > 1);
print $impl " $list(tvb, offsetp, t, $regname, (length - $length) / $gltype{$type}{'size'}, byte_order);\n";
}
}
}
}
print $impl "}\n\n";
$t->purge;
}
sub get_op($;$);
sub get_unop($;$);
sub get_ref($$)
{
my $elt = shift;
my $refref = shift;
my $rv;
given($elt->name()) {
when ('fieldref') {
$rv = $elt->text();
$refref->{$rv} = 1;
$rv = 'f_'.$rv;
}
when ('value') { $rv = $elt->text(); }
when ('op') { $rv = get_op($elt, $refref); }
when (['unop','popcount']) { $rv = get_unop($elt, $refref); }
default { die "Invalid op fragment: $_" }
}
return $rv;
}
sub get_op($;$) {
my $op = shift;
my $refref = shift // {};
my @elements = $op->children(qr/fieldref|value|op|unop|popcount/);
(@elements == 2) or die ("Wrong number of children for 'op'\n");
my $left;
my $right;
$left = get_ref($elements[0], $refref);
$right = get_ref($elements[1], $refref);
return "($left " . $op->att('op') . " $right)";
}
sub get_unop($;$) {
my $op = shift;
my $refref = shift // {};
my @elements = $op->children(qr/fieldref|value|op|unop|popcount/);
(@elements == 1) or die ("Wrong number of children for 'unop'\n");
my $left;
$left = get_ref($elements[0], $refref);
given ($op->name()) {
when ('unop') {
return '(' . $op->att('op') . "$left)";
}
when ('popcount') {
return "ws_count_ones($left)";
}
default { die "Invalid unop element $op->name()\n"; }
}
}
sub qualname {
my $name = shift;
$name = $incname[0].':'.$name unless $name =~ /:/;
return $name
}
sub get_simple_info {
my $name = shift;
my $info = $basictype{$name};
return $info if (defined $info);
$info = $simpletype{$name};
return $info if (defined $info);
if (defined($type_name{$name})) {
return $simpletype{$type_name{$name}};
}
return undef
}
sub get_struct_info {
my $name = shift;
my $info = $struct{$name};
return $info if (defined $info);
if (defined($type_name{$name})) {
return $struct{$type_name{$name}};
}
return undef
}
sub getinfo {
my $name = shift;
my $info = get_simple_info($name) // get_struct_info($name);
# If the script fails here search for $name in this script and remove it from the black list
die "$name is defined to be unused in process-x11-xcb.pl but is actually used!" if (defined($info) && $info == "1");
return $info;
}
sub dump_enum_values($)
{
my $e = shift;
defined($enum{$e}) or die("Enum $e not found");
my $enumname = "x11_enum_$e";
return $enumname if (defined $enum{$e}{done});
say $enum 'static const value_string '.$enumname.'[] = {';
my $value = $enum{$e}{value};
for my $val (sort { $a <=> $b } keys %$value) {
say $enum sprintf(" { %3d, \"%s\" },", $val, $$value{$val});
}
say $enum sprintf(" { %3d, NULL },", 0);
say $enum '};';
say $enum '';
$enum{$e}{done} = 1;
return $enumname;
}
# Find all references, so we can declare only the minimum necessary
sub reference_elements($$);
sub reference_elements($$)
{
my $e = shift;
my $refref = shift;
given ($e->name()) {
when ('switch') {
my $lentype = $e->first_child();
if (defined $lentype) {
given ($lentype->name()) {
when ('fieldref') { $refref->{field}{$lentype->text()} = 1; }
when ('op') { get_op($lentype, $refref->{field}); }
}
}
my @elements = $e->children(qr/(bit)?case/);
for my $case (@elements) {
my @sub_elements = $case->children(qr/list|switch/);
foreach my $sub_e (@sub_elements) {
reference_elements($sub_e, $refref);
}
}
}
when ('list') {
my $type = $e->att('type');
my $info = getinfo($type);
if (defined $info->{paramref}) {
for my $pref (keys %{$info->{paramref}}) {
$refref->{field}{$pref} = 1;
}
}
my $lentype = $e->first_child();
if (defined $lentype) {
given ($lentype->name()) {
when ('fieldref') { $refref->{field}{$lentype->text()} = 1; }
when ('op') { get_op($lentype, $refref->{field}); }
when (['unop','popcount']) { get_unop($lentype, $refref->{field}); }
when ('sumof') { $refref->{sumof}{$lentype->att('ref')} = 1; }
}
} else {
$refref->{field}{'length'} = 1;
$refref->{'length'} = 1;
}
}
}
}
sub register_element($$$$;$)
{
my $e = shift;
my $varpat = shift;
my $humanpat = shift;
my $refref = shift;
my $indent = shift // ' ' x 4;
given ($e->name()) {
when ('pad') { return; } # Pad has no variables
when ('switch') { return; } # Switch defines varaibles in a tighter scope to avoid collisions
}
# Register field with wireshark
my $fieldname = $e->att('name');
my $type = $e->att('type') or die ("Field $fieldname does not have a valid type\n");
my $regname = 'hf_x11_'.sprintf ($varpat, $fieldname);
my $humanname = 'x11.'.sprintf ($humanpat, $fieldname);
my $info = getinfo($type);
my $ft = $info->{'type'} // 'FT_NONE';
my $base = $info->{'base'} // 'BASE_NONE';
my $vals = 'NULL';
my $enum = $e->att('enum') // $e->att('altenum');
if (defined $enum) {
my $enumname = dump_enum_values($enum_name{$enum});
$vals = "VALS($enumname)";
# Wireshark does not allow FT_BYTES, FT_BOOLEAN, or BASE_NONE to have an enum
$ft =~ s/FT_BYTES/FT_UINT8/;
$ft =~ s/FT_BOOLEAN/FT_UINT8/;
$base =~ s/BASE_NONE/BASE_DEC/;
}
$enum = $e->att('mask');
if (defined $enum) {
# Create subtree items:
defined($enum{$enum_name{$enum}}) or die("Enum $enum not found");
# Wireshark does not allow FT_BYTES or BASE_NONE to have an enum
$ft =~ s/FT_BYTES/FT_UINT8/;
$base =~ s/BASE_NONE/BASE_DEC/;
my $bitsize = $info->{'size'} * 8;
my $bit = $enum{$enum_name{$enum}}{bit};
for my $val (sort { $a <=> $b } keys %$bit) {
my $itemname = $$bit{$val};
my $item = $regname . '_mask_' . $itemname;
my $itemhuman = $humanname . '.' . $itemname;
my $bitshift = "1U << $val";
say $decl "static int $item = -1;";
say $reg "{ &$item, { \"$itemname\", \"$itemhuman\", FT_BOOLEAN, $bitsize, NULL, $bitshift, NULL, HFILL }},";
}
}
print $decl "static int $regname = -1;\n";
if ($e->name() eq 'list' and defined $info->{'size'} and $info->{'size'} > 1) {
print $reg "{ &$regname, { \"$fieldname\", \"$humanname.list\", FT_NONE, BASE_NONE, NULL, 0, NULL, HFILL }},\n";
$regname .= '_item';
print $decl "static int $regname = -1;\n";
}
print $reg "{ &$regname, { \"$fieldname\", \"$humanname\", $ft, $base, $vals, 0, NULL, HFILL }},\n";
if ($refref->{sumof}{$fieldname}) {
print $impl $indent."int sumof_$fieldname = 0;\n";
}
if ($e->name() eq 'field') {
if ($refref->{field}{$fieldname} and get_simple_info($type)) {
# Pre-declare variable
if ($ft eq 'FT_FLOAT') {
print $impl $indent."gfloat f_$fieldname;\n";
} elsif ($ft eq 'FT_DOUBLE') {
print $impl $indent."gdouble f_$fieldname;\n";
} elsif ($ft eq 'FT_INT64' or $ft eq 'FT_UINT64') {
print $impl $indent."gint64 f_$fieldname;\n";
} else {
print $impl $indent."int f_$fieldname;\n";
}
}
}
}
sub dissect_element($$$$$;$$);
sub dissect_element($$$$$;$$)
{
my $e = shift;
my $varpat = shift;
my $humanpat = shift;
my $length = shift;
my $refref = shift;
my $adjustlength = shift;
my $indent = shift // ' ' x 4;
given ($e->name()) {
when ('pad') {
my $bytes = $e->att('bytes');
my $align = $e->att('align');
if (defined $bytes) {
print $impl $indent."proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, $bytes, ENC_NA);\n";
print $impl $indent."*offsetp += $bytes;\n";
$length += $bytes;
} else {
say $impl $indent.'if (*offsetp % '.$align.') {';
say $impl $indent." proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, ($align - *offsetp % $align), ENC_NA);";
say $impl $indent." *offsetp += ($align - *offsetp % $align);";
say $impl $indent."}";
if ($length % $align != 0) {
$length += $align - $length % $align;
}
if ($adjustlength) {
say $impl $indent.'length = ((length + '.($align-1).') & ~'.($align-1).');';
}
}
}
when ('field') {
my $fieldname = $e->att('name');
my $regname = 'hf_x11_'.sprintf ($varpat, $fieldname);
my $type = $e->att('type');
if (get_simple_info($type)) {
my $info = get_simple_info($type);
my $size = $info->{'size'};
my $encoding = $info->{'encoding'};
my $get = $info->{'get'};
if ($e->att('enum') // $e->att('altenum')) {
my $fieldsize = $size * 8;
print $impl $indent;
if ($refref->{field}{$fieldname}) {
print $impl "f_$fieldname = ";
}
say $impl "field$fieldsize(tvb, offsetp, t, $regname, byte_order);";
} elsif ($e->att('mask')) {
if ($refref->{field}{$fieldname}) {
if ($get ne "tvb_get_guint8") {
say $impl $indent."f_$fieldname = $get(tvb, *offsetp, byte_order);";
} else {
say $impl $indent."f_$fieldname = $get(tvb, *offsetp);";
}
}
my $bitmask_field = $fieldname . "_bits";
say $impl $indent."{";
say $impl $indent." int* const $bitmask_field [] = {";
my $bit = $enum{$enum_name{$e->att('mask')}}{bit};
for my $val (sort { $a <=> $b } keys %$bit) {
my $item = $regname . '_mask_' . $$bit{$val};
say $impl "$indent$indent&$item,";
}
say $impl "$indent$indent" . "NULL";
say $impl $indent." };";
say $impl $indent." proto_tree_add_bitmask(t, tvb, *offsetp, $regname, ett_x11_rectangle, $bitmask_field, $encoding);";
say $impl $indent."}";
say $impl $indent."*offsetp += $size;";
} else {
if ($refref->{field}{$fieldname}) {
if ($get ne "tvb_get_guint8") {
say $impl $indent."f_$fieldname = $get(tvb, *offsetp, byte_order);";
} else {
say $impl $indent."f_$fieldname = $get(tvb, *offsetp);";
}
}
print $impl $indent."proto_tree_add_item(t, $regname, tvb, *offsetp, $size, $encoding);\n";
print $impl $indent."*offsetp += $size;\n";
}
$length += $size;
} elsif (get_struct_info($type)) {
# TODO: variable-lengths (when $info->{'size'} == 0 )
my $info = get_struct_info($type);
$length += $info->{'size'};
print $impl $indent."struct_$info->{'name'}(tvb, offsetp, t, byte_order, 1);\n";
} else {
die ("Unrecognized type: $type\n");
}
}
when ('list') {
my $fieldname = $e->att('name');
my $regname = 'hf_x11_'.sprintf ($varpat, $fieldname);
my $type = $e->att('type');
my $info = getinfo($type);
my $lencalc;
my $lentype = $e->first_child();
if (defined $info->{'size'}) {
$lencalc = "(length - $length) / $info->{'size'}";
} else {
$lencalc = "(length - $length)";
}
if (defined $lentype) {
given ($lentype->name()) {
when ('value') { $lencalc = $lentype->text(); }
when ('fieldref') { $lencalc = 'f_'.$lentype->text(); }
when ('paramref') { $lencalc = 'p_'.$lentype->text(); }
when ('op') { $lencalc = get_op($lentype); }
when (['unop','popcount']) { $lencalc = get_unop($lentype); }
when ('sumof') { $lencalc = 'sumof_'.$lentype->att('ref'); }
}
}
if (get_simple_info($type)) {
my $list = $info->{'list'};
my $size = $info->{'size'};
$regname .= ", $regname".'_item' if ($size > 1);
if ($refref->{sumof}{$fieldname}) {
my $get = $info->{'get'};
say $impl $indent."{";
say $impl $indent." int i;";
say $impl $indent." for (i = 0; i < $lencalc; i++) {";
if ($get ne "tvb_get_guint8") {
say $impl $indent." sumof_$fieldname += $get(tvb, *offsetp + i * $size, byte_order);";
} else {
say $impl $indent." sumof_$fieldname += $get(tvb, *offsetp + i * $size);";
}
say $impl $indent." }";
say $impl $indent."}";
}
print $impl $indent."$list(tvb, offsetp, t, $regname, $lencalc, byte_order);\n";
} elsif (get_struct_info($type)) {
my $si = get_struct_info($type);
my $prefs = "";
foreach my $pref (sort keys %{$si->{paramref}}) {
$prefs .= ", f_$pref";
}
print $impl $indent."struct_$info->{'name'}(tvb, offsetp, t, byte_order, $lencalc$prefs);\n";
} else {
# TODO: Fix unrecognized type. Comment out for now to generate dissector
# die ("Unrecognized type: $type\n");
}
if ($adjustlength && defined($lentype)) {
# Some requests end with a list of unspecified length
# Adjust the length field here so that the next $lencalc will be accurate
if (defined $info->{'size'}) {
say $impl $indent."length -= $lencalc * $info->{'size'};";
} else {
say $impl $indent."length -= $lencalc * 1;";
}
}
}
when ('switch') {
my $switchtype = $e->first_child() or die("Switch element not defined");
my $switchon = get_ref($switchtype, {});
my @elements = $e->children(qr/(bit)?case/);
for my $case (@elements) {
my @refs = $case->children('enumref');
my @test;
my $fieldname;
foreach my $ref (@refs) {
my $enum_ref = $ref->att('ref');
my $field = $ref->text();
$fieldname //= $field; # Use first named field
if ($case->name() eq 'bitcase') {
my $bit = $enum{$enum_name{$enum_ref}}{rbit}{$field};
if (! defined($bit)) {
for my $foo (keys %{$enum{$enum_name{$enum_ref}}{rbit}}) { say "'$foo'"; }
die ("Field '$field' not found in '$enum_ref'");
}
push @test , "$switchon & (1U << $bit)";
} else {
my $val = $enum{$enum_name{$enum_ref}}{rvalue}{$field};
if (! defined($val)) {
for my $foo (keys %{$enum{$enum_name{$enum_ref}}{rvalue}}) { say "'$foo'"; }
die ("Field '$field' not found in '$enum_ref'");
}
push @test , "$switchon == $val";
}
}
if (@test > 1) {
# We have more than one conditional, add parentheses to them.
# We don't add parentheses to all the conditionals because
# clang complains about the extra parens if you do "if ((x == y))".
my @tests_with_parens;
foreach my $conditional (@test) {
push @tests_with_parens, "($conditional)";
}
@test = @tests_with_parens;
}
my $list = join ' || ', @test;
say $impl $indent."if ($list) {";
my $vp = $varpat;
my $hp = $humanpat;
$vp =~ s/%s/${fieldname}_%s/;
$hp =~ s/%s/${fieldname}.%s/;
my @sub_elements = $case->children(qr/pad|field|list|switch/);
my $subref = { field => {}, sumof => {} };
foreach my $sub_e (@sub_elements) {
reference_elements($sub_e, $subref);
}
foreach my $sub_e (@sub_elements) {
register_element($sub_e, $vp, $hp, $subref, $indent . ' ');
}
foreach my $sub_e (@sub_elements) {
$length = dissect_element($sub_e, $vp, $hp, $length, $subref, $adjustlength, $indent . ' ');
}
say $impl $indent."}";
}
}
default { die "Unknown field type: $_\n"; }
}
return $length;
}
sub struct {
my ($t, $elt) = @_;
my $name = $elt->att('name');
my $qualname = qualname($name);
$type_name{$name} = $qualname;
if (defined $struct{$qualname}) {
$t->purge;
return;
}
my @elements = $elt->children(qr/pad|field|list|switch/);
print(" - Struct $name\n");
$name = $qualname;
$name =~ s/:/_/;
my %refs;
my %paramrefs;
my $size = 0;
my $dynamic = 0;
my $needi = 0;
# Find struct size
foreach my $e (@elements) {
my $count;
$count = 1;
given ($e->name()) {
when ('pad') {
my $bytes = $e->att('bytes');
my $align = $e->att('align');
if (defined $bytes) {
$size += $bytes;
next;
}
if (!$dynamic) {
if ($size % $align) {
$size += $align - $size % $align;
}
}
next;
}
when ('list') {
my $type = $e->att('type');
my $info = getinfo($type);
$needi = 1 if ($info->{'size'} == 0);
my $value = $e->first_child();
given($value->name()) {
when ('fieldref') {
$refs{$value->text()} = 1;
$count = 0;
$dynamic = 1;
}
when ('paramref') {
$paramrefs{$value->text()} = $value->att('type');
$count = 0;
$dynamic = 1;
}
when ('op') {
get_op($value, \%refs);
$count = 0;
$dynamic = 1;
}
when (['unop','popcount']) {
get_unop($value, \%refs);
$count = 0;
$dynamic = 1;
}
when ('value') {
$count = $value->text();
}
default { die("Invalid list size $_\n"); }
}
}
when ('field') { }
when ('switch') {
$dynamic = 1;
next;
}
default { die("unrecognized field: $_\n"); }
}
my $type = $e->att('type');
my $info = getinfo($type);
$size += $info->{'size'} * $count;
}
my $prefs = "";
if ($dynamic) {
$size = 0;
foreach my $pref (sort keys %paramrefs) {
$prefs .= ", int p_$pref";
}
print $impl <<eot
static int struct_size_$name(tvbuff_t *tvb _U_, int *offsetp _U_, guint byte_order _U_$prefs)
{
int size = 0;
eot
;
say $impl ' int i, off;' if ($needi);
foreach my $ref (sort keys %refs) {
say $impl " int f_$ref;";
}
foreach my $e (@elements) {
my $count;
$count = 1;
my $type = $e->att('type') // '';
my $info = getinfo($type);
given ($e->name()) {
when ('pad') {
my $bytes = $e->att('bytes');
my $align = $e->att('align');
if (defined $bytes) {
$size += $bytes;
} else {
say $impl ' size = (size + '.($align-1).') & ~'.($align-1).';';
}
}
when ('list') {
my $len = $e->first_child();
my $infosize = $info->{'size'};
my $sizemul;
given ($len->name()) {
when ('op') { $sizemul = get_op($len, \%refs); }
when (['unop','popcount']) { $sizemul = get_unop($len, \%refs); }
when ('fieldref') { $sizemul = 'f_'.$len->text(); }
when ('paramref') { $sizemul = 'p_'.$len->text(); }
when ('value') {
if ($infosize) {
$size += $infosize * $len->text();
} else {
$sizemul = $len->text();
}
}
default { die "Invalid list size: $_\n"; }
}
if (defined $sizemul) {
if ($infosize) {
say $impl " size += $sizemul * $infosize;";
} else {
say $impl " for (i = 0; i < $sizemul; i++) {";
say $impl " off = (*offsetp) + size + $size;";
say $impl " size += struct_size_$info->{name}(tvb, &off, byte_order);";
say $impl ' }';
}
}
}
when ('field') {
my $fname = $e->att('name');
if (defined($refs{$fname})) {
my $get = $info->{'get'};
if ($get ne "tvb_get_guint8") {
say $impl " f_$fname = $info->{'get'}(tvb, *offsetp + size + $size, byte_order);";
} else {
say $impl " f_$fname = $info->{'get'}(tvb, *offsetp + size + $size);";
}
}
$size += $info->{'size'};
}
}
}
say $impl " return size + $size;";
say $impl '}';
$size = 0; # 0 means "dynamic calcuation required"
}
print $decl "static int hf_x11_struct_$name = -1;\n";
print $reg "{ &hf_x11_struct_$name, { \"$name\", \"x11.struct.$name\", FT_NONE, BASE_NONE, NULL, 0, NULL, HFILL }},\n";
print $impl <<eot
static void struct_$name(tvbuff_t *tvb, int *offsetp, proto_tree *root, guint byte_order _U_, int count$prefs)
{
int i;
for (i = 0; i < count; i++) {
proto_item *item;
proto_tree *t;
eot
;
my $varpat = 'struct_'.$name.'_%s';
my $humanpat = "struct.$name.%s";
my $refs = { field => {}, sumof => {} };
foreach my $e (@elements) {
reference_elements($e, $refs);
}
foreach my $e (@elements) {
register_element($e, $varpat, $humanpat, $refs, " ");
}
$prefs = "";
foreach my $pref (sort keys %paramrefs) {
$prefs .= ", p_$pref";
}
my $sizecalc = $size;
$size or $sizecalc = "struct_size_$name(tvb, offsetp, byte_order$prefs)";
print $impl <<eot
item = proto_tree_add_item(root, hf_x11_struct_$name, tvb, *offsetp, $sizecalc, ENC_NA);
t = proto_item_add_subtree(item, ett_x11_rectangle);
eot
;
my $length = 0;
foreach my $e (@elements) {
$length = dissect_element($e, $varpat, $humanpat, $length, $refs, 0, " ");
}
print $impl " }\n}\n";
$struct{$qualname} = { size => $size, name => $name, paramref => \%paramrefs };
$t->purge;
}
sub union {
# TODO proper dissection
#
# Right now, the only extension to use a union is randr.
# for now, punt.
my ($t, $elt) = @_;
my $name = $elt->att('name');
my $qualname = qualname($name);
$type_name{$name} = $qualname;
if (defined $struct{$qualname}) {
$t->purge;
return;
}
my @elements = $elt->children(qr/field/);
my @sizes;
print(" - Union $name\n");
$name = $qualname;
$name =~ s/:/_/;
# Find union size
foreach my $e (@elements) {
my $type = $e->att('type');
my $info = getinfo($type);
$info->{'size'} > 0 or die ("Error: Union containing variable sized struct $type\n");
push @sizes, $info->{'size'};
}
@sizes = sort {$b <=> $a} @sizes;
my $size = $sizes[0];
print $decl "static int hf_x11_union_$name = -1;\n";
print $reg "{ &hf_x11_union_$name, { \"$name\", \"x11.union.$name\", FT_NONE, BASE_NONE, NULL, 0, NULL, HFILL }},\n";
print $impl <<eot
static void struct_$name(tvbuff_t *tvb, int *offsetp, proto_tree *root, guint byte_order, int count)
{
int i;
int base = *offsetp;
for (i = 0; i < count; i++) {
proto_item *item;
proto_tree *t;
eot
;
my $varpat = 'union_'.$name.'_%s';
my $humanpat = "union.$name.%s";
my $refs = { field => {}, sumof => {} };
foreach my $e (@elements) {
reference_elements($e, $refs);
}
foreach my $e (@elements) {
register_element($e, $varpat, $humanpat, $refs, " ");
}
print $impl <<eot
item = proto_tree_add_item(root, hf_x11_union_$name, tvb, base, $size, ENC_NA);
t = proto_item_add_subtree(item, ett_x11_rectangle);
eot
;
foreach my $e (@elements) {
say $impl ' *offsetp = base;';
dissect_element($e, $varpat, $humanpat, 0, $refs, 0, " ");
}
say $impl " base += $size;";
say $impl ' }';
say $impl ' *offsetp = base;';
say $impl '}';
$struct{$qualname} = { size => $size, name => $name };
$t->purge;
}
sub enum {
my ($t, $elt) = @_;
my $name = $elt->att('name');
my $fullname = $incname[0].'_'.$name;
$enum_name{$name} = $fullname;
$enum_name{$incname[0].':'.$name} = $fullname;
if (defined $enum{$fullname}) {
$t->purge;
return;
}
my @elements = $elt->children('item');
print(" - Enum $name\n");
my $value = {};
my $bit = {};
my $rvalue = {};
my $rbit = {};
$enum{$fullname} = { value => $value, bit => $bit, rbit => $rbit, rvalue => $rvalue };
my $nextvalue = 0;
foreach my $e (@elements) {
my $n = $e->att('name');
my $valtype = $e->first_child(qr/value|bit/);
if (defined $valtype) {
my $val = int($valtype->text());
given ($valtype->name()) {
when ('value') {
$$value{$val} = $n;
$$rvalue{$n} = $val;
$nextvalue = $val + 1;
# Ugly hack to support (temporary, hopefully) ugly
# hack in xinput:ChangeDeviceProperty
# Register certain values as bits also
given ($val) {
when (8) {
$$bit{'3'} = $n;
$$rbit{$n} = 3;
}
when (16) {
$$bit{'4'} = $n;
$$rbit{$n} = 4;
}
when (32) {
$$bit{'5'} = $n;
$$rbit{$n} = 5;
}
}
}
when ('bit') {
$$bit{$val} = $n;
$$rbit{$n} = $val;
}
}
} else {
$$value{$nextvalue} = $n;
$nextvalue++;
}
}
$t->purge;
}
sub request {
my ($t, $elt) = @_;
my $name = $elt->att('name');
print(" - Request $name\n");
$request{$elt->att('opcode')} = $name;
my $length = 4;
my @elements = $elt->children(qr/pad|field|list|switch/);
# Wireshark defines _U_ to mean "Unused" (compiler specific define)
if (!@elements) {
print $impl <<eot
static void $header$name(tvbuff_t *tvb _U_, packet_info *pinfo _U_, int *offsetp _U_, proto_tree *t _U_, guint byte_order _U_, int length _U_)
{
eot
;
} else {
print $impl <<eot
static void $header$name(tvbuff_t *tvb, packet_info *pinfo _U_, int *offsetp, proto_tree *t, guint byte_order, int length _U_)
{
eot
;
}
my $varpat = $header.'_'.$name.'_%s';
my $humanpat = "$header.$name.%s";
my $refs = { field => {}, sumof => {} };
foreach my $e (@elements) {
reference_elements($e, $refs);
}
foreach my $e (@elements) {
register_element($e, $varpat, $humanpat, $refs);
}
foreach my $e (@elements) {
if ($e->name() eq 'list' && $name eq 'Render' && $e->att('name') eq 'data' && -e "$mesadir/gl_API.xml") {
# Special case: Use mesa-generated dissector for 'data'
print $impl " dispatch_glx_render(tvb, pinfo, offsetp, t, byte_order, (length - $length));\n";
} else {
$length = dissect_element($e, $varpat, $humanpat, $length, $refs, 1);
}
}
say $impl '}';
my $reply = $elt->first_child('reply');
if ($reply) {
$reply{$elt->att('opcode')} = $name;
$varpat = $header.'_'.$name.'_reply_%s';
$humanpat = "$header.$name.reply.%s";
@elements = $reply->children(qr/pad|field|list|switch/);
# Wireshark defines _U_ to mean "Unused" (compiler specific define)
if (!@elements) {
say $impl "static void $header$name"."_Reply(tvbuff_t *tvb _U_, packet_info *pinfo, int *offsetp _U_, proto_tree *t _U_, guint byte_order _U_)\n{";
} else {
say $impl "static void $header$name"."_Reply(tvbuff_t *tvb, packet_info *pinfo, int *offsetp, proto_tree *t, guint byte_order)\n{";
}
say $impl ' int sequence_number;' if (@elements);
my $refs = { field => {}, sumof => {} };
foreach my $e (@elements) {
reference_elements($e, $refs);
}
say $impl ' int f_length;' if ($refs->{field}{'length'});
say $impl ' int length;' if ($refs->{length});
foreach my $e (@elements) {
register_element($e, $varpat, $humanpat, $refs);
}
say $impl '';
say $impl ' col_append_fstr(pinfo->cinfo, COL_INFO, "-'.$name.'");';
say $impl '';
say $impl ' REPLY(reply);';
my $first = 1;
my $length = 1;
foreach my $e (@elements) {
$length = dissect_element($e, $varpat, $humanpat, $length, $refs);
if ($first) {
$first = 0;
say $impl ' sequence_number = tvb_get_guint16(tvb, *offsetp, byte_order);';
say $impl ' proto_tree_add_uint_format_value(t, hf_x11_reply_sequencenumber, tvb, *offsetp, 2, sequence_number,';
say $impl ' "%d ('.$header.'-'.$name.')", sequence_number);';
say $impl ' *offsetp += 2;';
if ($refs->{field}{length}) {
say $impl ' f_length = tvb_get_guint32(tvb, *offsetp, byte_order);';
}
if ($refs->{length}) {
say $impl ' length = f_length * 4 + 32;';
}
say $impl ' proto_tree_add_item(t, hf_x11_replylength, tvb, *offsetp, 4, byte_order);';
say $impl ' *offsetp += 4;';
$length += 6;
}
}
say $impl '}';
}
$t->purge;
}
sub defxid(@) {
my $name;
while ($name = shift) {
my $qualname = qualname($name);
$simpletype{$qualname} = { size => 4, encoding => 'byte_order', type => 'FT_UINT32', base => 'BASE_HEX', get => 'tvb_get_guint32', list => 'listOfCard32', };
$type_name{$name} = $qualname;
}
}
sub xidtype {
my ($t, $elt) = @_;
my $name = $elt->att('name');
defxid($name);
$t->purge;
}
sub typedef {
my ($t, $elt) = @_;
my $oldname = $elt->att('oldname');
my $newname = $elt->att('newname');
my $qualname = qualname($newname);
# Duplicate the type
my $info = get_simple_info($oldname);
if ($info) {
$simpletype{$qualname} = $info;
} elsif ($info = get_struct_info($oldname)) {
$struct{$qualname} = $info;
} else {
die ("$oldname not found while attempting to typedef $newname\n");
}
$type_name{$newname} = $qualname;
$t->purge;
}
sub error {
my ($t, $elt) = @_;
my $number = $elt->att('number');
if ($number >= 0) {
my $name = $elt->att('name');
print $error " \"$header-$name\",\n";
}
$t->purge;
}
sub event {
my ($t, $elt) = @_;
my $number = $elt->att('number');
$number or return;
my $name = $elt->att('name');
my $xge = $elt->att('xge');
if ($xge) {
$genericevent{$number} = $name;
} else {
$event{$number} = $name;
}
my $length = 1;
my @elements = $elt->children(qr/pad|field|list|switch/);
# Wireshark defines _U_ to mean "Unused" (compiler specific define)
if (!@elements) {
if ($xge) {
print $impl <<eot
static void $header$name(tvbuff_t *tvb _U_, int length _U_, int *offsetp _U_, proto_tree *t _U_, guint byte_order _U_)
{
} else {
print $impl <<eot
static void $header$name(tvbuff_t *tvb _U_, int *offsetp _U_, proto_tree *t _U_, guint byte_order _U_)
{
eot
;
}
} else {
if ($xge) {
$length = 10;
print $impl <<eot
static void $header$name(tvbuff_t *tvb, int length _U_, int *offsetp, proto_tree *t, guint byte_order)
{
eot
;
} else {
print $impl <<eot
static void $header$name(tvbuff_t *tvb, int *offsetp, proto_tree *t, guint byte_order)
{
eot
;
}
}
my $varpat = $header.'_'.$name.'_%s';
my $humanpat = "$header.$name.%s";
my $refs = { field => {}, sumof => {} };
foreach my $e (@elements) {
reference_elements($e, $refs);
}
foreach my $e (@elements) {
register_element($e, $varpat, $humanpat, $refs);
}
if ($xge) {
say $impl " proto_tree_add_uint_format_value(t, hf_x11_minor_opcode, tvb, *offsetp, 2, $number,";
say $impl " \"$name ($number)\");";
foreach my $e (@elements) {
$length = dissect_element($e, $varpat, $humanpat, $length, $refs);
}
} else {
my $first = 1;
foreach my $e (@elements) {
$length = dissect_element($e, $varpat, $humanpat, $length, $refs);
if ($first) {
$first = 0;
say $impl " CARD16(event_sequencenumber);";
}
}
}
say $impl "}\n";
$t->purge;
}
sub include_start {
my ($t, $elt) = @_;
my $header = $elt->att('header');
unshift @incname, $header;
}
sub include_end {
shift @incname;
}
sub include
{
my ($t, $elt) = @_;
my $include = $elt->text();
print " - Import $include\n";
my $xml = XML::Twig->new(
start_tag_handlers => {
'xcb' => \&include_start,
},
twig_roots => {
'import' => \&include,
'struct' => \&struct,
'xidtype' => \&xidtype,
'xidunion' => \&xidtype,
'typedef' => \&typedef,
'enum' => \&enum,
},
end_tag_handlers => {
'xcb' => \&include_end,
});
$xml->parsefile("$srcdir/xcbproto/src/$include.xml") or die ("Cannot open $include.xml\n");
$t->purge;
}
sub xcb_start {
my ($t, $elt) = @_;
$header = $elt->att('header');
$extname = ($elt->att('extension-name') or $header);
unshift @incname, $header;
print("Extension $extname\n");
undef %request;
undef %genericevent;
undef %event;
undef %reply;
%simpletype = ();
%enum_name = ();
%type_name = ();
print $error "const char *$header"."_errors[] = {\n";
}
sub xcb {
my ($t, $elt) = @_;
my $xextname = $elt->att('extension-xname');
my $lookup_name = $header . "_extension_minor";
my $error_name = $header . "_errors";
my $event_name = $header . "_events";
my $genevent_name = 'NULL';
my $reply_name = $header . "_replies";
print $decl "static int hf_x11_$lookup_name = -1;\n\n";
print $impl "static const value_string $lookup_name"."[] = {\n";
foreach my $req (sort {$a <=> $b} keys %request) {
print $impl " { $req, \"$request{$req}\" },\n";
}
print $impl " { 0, NULL }\n";
print $impl "};\n";
say $impl "const x11_event_info $event_name".'[] = {';
foreach my $e (sort {$a <=> $b} keys %event) {
say $impl " { \"$header-$event{$e}\", $header$event{$e} },";
}
say $impl ' { NULL, NULL }';
say $impl '};';
if (%genericevent) {
$genevent_name = $header.'_generic_events';
say $impl 'static const x11_generic_event_info '.$genevent_name.'[] = {';
for my $val (sort { $a <=> $b } keys %genericevent) {
say $impl sprintf(" { %3d, %s },", $val, $header.$genericevent{$val});
}
say $impl sprintf(" { %3d, NULL },", 0);
say $impl '};';
say $impl '';
}
print $impl "static x11_reply_info $reply_name"."[] = {\n";
foreach my $e (sort {$a <=> $b} keys %reply) {
print $impl " { $e, $header$reply{$e}_Reply },\n";
}
print $impl " { 0, NULL }\n";
print $impl "};\n";
print $reg "{ &hf_x11_$lookup_name, { \"extension-minor\", \"x11.extension-minor\", FT_UINT8, BASE_DEC, VALS($lookup_name), 0, \"minor opcode\", HFILL }},\n\n";
print $impl <<eot
static void dispatch_$header(tvbuff_t *tvb, packet_info *pinfo, int *offsetp, proto_tree *t, guint byte_order)
{
int minor, length;
minor = CARD8($lookup_name);
length = REQUEST_LENGTH();
col_append_fstr(pinfo->cinfo, COL_INFO, "-%s",
val_to_str(minor, $lookup_name,
"<Unknown opcode %d>"));
switch (minor) {
eot
;
foreach my $req (sort {$a <=> $b} keys %request) {
print $impl " case $req:\n";
print $impl " $header$request{$req}(tvb, pinfo, offsetp, t, byte_order, length);\n";
print $impl " break;\n";
}
say $impl " /* No need for a default case here, since Unknown is printed above,";
say $impl " and UNDECODED() is taken care of by dissect_x11_request */";
print $impl " }\n}\n";
print $impl <<eot
static void register_$header(void)
{
set_handler("$xextname", dispatch_$header, $error_name, $event_name, $genevent_name, $reply_name);
}
eot
;
print $error " NULL\n};\n\n";
push @register, $header;
}
sub find_version {
#my $git = `which git`;
#chomp($git);
#-x $git or return 'unknown';
my $lib = shift;
# this will generate an error on stderr if git isn't in our $PATH
# but that's OK. The version is still set to 'unknown' in that case
# and at least the operator could see it.
my $ver = `git --git-dir=$lib/.git describe --tags`;
$ver //= 'unknown';
chomp $ver;
return $ver;
}
sub add_generated_header {
my ($out, $using) = @_;
my $ver = find_version($using);
$using = File::Spec->abs2rel ($using, $srcdir);
print $out <<eot
/* Do not modify this file. */
/* It was automatically generated by $script_name
using $using version $ver */
eot
;
# Add license text
print $out <<eot
/*
* Copyright 2008, 2009, 2013, 2014 Open Text Corporation <pharris[AT]opentext.com>
*
* Wireshark - Network traffic analyzer
* By Gerald Combs <gerald[AT]wireshark.org>
* Copyright 1998 Gerald Combs
*
* SPDX-License-Identifier: GPL-2.0-or-later
*/
eot
;
}
# initialize core X11 protocol
# Do this in the Makefile now
#system('./process-x11-fields.pl < x11-fields');
# Extension implementation
$impl = new IO::File "> $srcdir/x11-extension-implementation.h"
or die ("Cannot open $srcdir/x11-extension-implementation.h for writing\n");
$error = new IO::File "> $srcdir/x11-extension-errors.h"
or die ("Cannot open $srcdir/x11-extension-errors.h for writing\n");
add_generated_header($impl, $srcdir . '/xcbproto');
add_generated_header($error, $srcdir . '/xcbproto');
# Open the files generated by process-x11-fields.pl for appending
$reg = new IO::File ">> $srcdir/x11-register-info.h"
or die ("Cannot open $srcdir/x11-register-info.h for appending\n");
$decl = new IO::File ">> $srcdir/x11-declarations.h"
or die ("Cannot open $srcdir/x11-declarations.h for appending\n");
print $reg "\n/* Generated by $script_name below this line */\n";
print $decl "\n/* Generated by $script_name below this line */\n";
# Mesa for glRender
if (-e "$mesadir/gl_API.xml") {
$enum = new IO::File "> $srcdir/x11-glx-render-enum.h"
or die ("Cannot open $srcdir/x11-glx-render-enum.h for writing\n");
add_generated_header($enum, $srcdir . '/mesa');
print $enum "static const value_string mesa_enum[] = {\n";
print $impl '#include "x11-glx-render-enum.h"'."\n\n";
print("Mesa glRender:\n");
$header = "glx_render";
my $xml = XML::Twig->new(
start_tag_handlers => {
},
twig_roots => {
'category' => \&mesa_category,
'enum' => \&mesa_enum,
'type' => \&mesa_type,
'function' => \&mesa_function,
});
$xml->parsefile("$mesadir/gl_API.xml") or die ("Cannot open gl_API\n");
for my $enum_key ( sort {$a<=>$b} keys %mesa_enum_hash) {
say $enum sprintf(" { 0x%04x, \"%s\" },", $enum_key, $mesa_enum_hash{$enum_key});
}
print $enum " { 0, NULL }\n";
print $enum "};\n";
$enum->close();
print $decl "static int hf_x11_glx_render_op_name = -1;\n\n";
print $impl "static const value_string glx_render_op_name"."[] = {\n";
foreach my $req (sort {$a <=> $b} keys %request) {
print $impl " { $req, \"gl$request{$req}\" },\n";
}
print $impl " { 0, NULL }\n";
print $impl "};\n";
print $impl "static value_string_ext mesa_enum_ext = VALUE_STRING_EXT_INIT(mesa_enum);\n";
print $reg "{ &hf_x11_glx_render_op_name, { \"render op\", \"x11.glx.render.op\", FT_UINT16, BASE_DEC, VALS(glx_render_op_name), 0, NULL, HFILL }},\n\n";
# Uses ett_x11_list_of_rectangle, since I am unable to see how the subtree type matters.
print $impl <<eot
static void dispatch_glx_render(tvbuff_t *tvb, packet_info *pinfo, int *offsetp, proto_tree *t, guint byte_order, int length)
{
while (length >= 4) {
guint32 op, len;
int next;
proto_item *ti;
proto_tree *tt;
len = tvb_get_guint16(tvb, *offsetp, byte_order);
op = tvb_get_guint16(tvb, *offsetp + 2, byte_order);
ti = proto_tree_add_uint(t, hf_x11_glx_render_op_name, tvb, *offsetp, len, op);
tt = proto_item_add_subtree(ti, ett_x11_list_of_rectangle);
ti = proto_tree_add_item(tt, hf_x11_request_length, tvb, *offsetp, 2, byte_order);
*offsetp += 2;
proto_tree_add_item(tt, hf_x11_glx_render_op_name, tvb, *offsetp, 2, byte_order);
*offsetp += 2;
if (len < 4) {
expert_add_info(pinfo, ti, &ei_x11_request_length);
/* Eat the rest of the packet, mark it undecoded */
len = length;
op = -1;
}
len -= 4;
next = *offsetp + len;
switch (op) {
eot
;
foreach my $req (sort {$a <=> $b} keys %request) {
print $impl " case $req:\n";
print $impl " mesa_$request{$req}(tvb, offsetp, tt, byte_order, len);\n";
print $impl " break;\n";
}
print $impl " default:\n";
print $impl " proto_tree_add_item(tt, hf_x11_undecoded, tvb, *offsetp, len, ENC_NA);\n";
print $impl " *offsetp += len;\n";
print $impl " }\n";
print $impl " if (*offsetp < next) {\n";
print $impl " proto_tree_add_item(tt, hf_x11_unused, tvb, *offsetp, next - *offsetp, ENC_NA);\n";
print $impl " *offsetp = next;\n";
print $impl " }\n";
print $impl " length -= (len + 4);\n";
print $impl " }\n}\n";
}
$enum = new IO::File "> $srcdir/x11-enum.h"
or die ("Cannot open $srcdir/x11-enum.h for writing\n");
add_generated_header($enum, $srcdir . '/xcbproto');
print $impl '#include "x11-enum.h"'."\n\n";
# XCB
foreach my $ext (@reslist) {
my $xml = XML::Twig->new(
start_tag_handlers => {
'xcb' => \&xcb_start,
},
twig_roots => {
'xcb' => \&xcb,
'import' => \&include,
'request' => \&request,
'struct' => \&struct,
'union' => \&union,
'xidtype' => \&xidtype,
'xidunion' => \&xidtype,
'typedef' => \&typedef,
'error' => \&error,
'errorcopy' => \&error,
'event' => \&event,
'enum' => \&enum,
});
$xml->parsefile($ext) or die ("Cannot open $ext\n");
}
print $impl "static void register_x11_extensions(void)\n{\n";
foreach my $reg (@register) {
print $impl " register_$reg();\n";
}
print $impl "}\n";
#
# Editor modelines
#
# Local Variables:
# c-basic-offset: 4
# tab-width: 8
# indent-tabs-mode: nil
# End:
#
# ex: set shiftwidth=4 tabstop=8 expandtab:
# :indentSize=4:tabSize=8:noTabs=true:
#
Reference in a new issue View git blame Copy permalink