From e4ba6dbc3f1e76890b22773807ea37fe8fa2b1bc Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Wed, 10 Apr 2024 22:34:10 +0200 Subject: Adding upstream version 4.2.2. Signed-off-by: Daniel Baumann --- tools/process-x11-xcb.pl | 1946 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1946 insertions(+) create mode 100755 tools/process-x11-xcb.pl (limited to 'tools/process-x11-xcb.pl') diff --git a/tools/process-x11-xcb.pl b/tools/process-x11-xcb.pl new file mode 100755 index 00000000..91dcf427 --- /dev/null +++ b/tools/process-x11-xcb.pl @@ -0,0 +1,1946 @@ +#!/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 +# +# Wireshark - Network traffic analyzer +# By Gerald Combs +# 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 <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 <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 < {}, 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 < $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 < {}, sumof => {} }; + + foreach my $e (@elements) { + reference_elements($e, $refs); + } + foreach my $e (@elements) { + register_element($e, $varpat, $humanpat, $refs, " "); + } + + print $impl < $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 < {}, 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 < {}, 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 <cinfo, COL_INFO, "-%s", + val_to_str(minor, $lookup_name, + "")); + 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 <abs2rel ($using, $srcdir); + + print $out < + * + * Wireshark - Network traffic analyzer + * By Gerald Combs + * 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 <= 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: +# -- cgit v1.2.3