tools/process-x11-xcb.pl

   1 #!/usr/bin/perl
   2 #
   3 # Script to convert xcbproto and mesa protocol files for
   4 # X11 dissector. Creates header files containing code to
   5 # dissect X11 extensions.
   6 #
   7 # Instructions for using this script are in epan/dissectors/README.X11
   8 #
   9 # Copyright 2008, 2009, 2013, 2014 Open Text Corporation <pharris[AT]opentext.com>
  10 #
  11 # Wireshark - Network traffic analyzer
  12 # By Gerald Combs <gerald@wireshark.org>
  13 # Copyright 1998 Gerald Combs
  14 #
  15 # SPDX-License-Identifier: GPL-2.0-or-later
  16 #
  17
  18 #TODO
  19 # - support constructs that are legal in XCB, but don't appear to be used
  20
  21 use 5.010;
  22
  23 use warnings;
  24 use strict;
  25
  26 # given/when is going to be removed (and/or dramatically altered)
  27 # in 5.20. Patches welcome.
  28 # Patches even more welcome if they rewrite this whole thing in a
  29 # language with a proper compatibility document, such as
  30 # http://golang.org/doc/go1compat
  31 no if $] >= 5.018, warnings => "experimental::smartmatch";
  32
  33 use IO::File;
  34 use XML::Twig;
  35
  36 use File::Spec;
  37
  38 my $srcdir = shift;
  39 die "'$srcdir' is not a directory" unless -d $srcdir;
  40
  41 my @reslist = grep {!/xproto\.xml$/} glob File::Spec->catfile($srcdir, 'xcbproto', 'src', '*.xml');
  42 my @register;
  43
  44 my $script_name = File::Spec->abs2rel ($0,  $srcdir);
  45
  46 my %basictype = (
  47     char =>   { size => 1, encoding => 'ENC_ASCII|ENC_NA', type => 'FT_STRING', base => 'BASE_NONE',    get => 'tvb_get_uint8',  list => 'listOfByte', },
  48     void =>   { size => 1, encoding => 'ENC_NA',           type => 'FT_BYTES',  base => 'BASE_NONE',    get => 'tvb_get_uint8',  list => 'listOfByte', },
  49     BYTE =>   { size => 1, encoding => 'ENC_NA',           type => 'FT_BYTES',  base => 'BASE_NONE',    get => 'tvb_get_uint8',  list => 'listOfByte', },
  50     CARD8 =>  { size => 1, encoding => 'byte_order',       type => 'FT_UINT8',  base => 'BASE_HEX_DEC', get => 'tvb_get_uint8',  list => 'listOfByte', },
  51     CARD16 => { size => 2, encoding => 'byte_order',       type => 'FT_UINT16', base => 'BASE_HEX_DEC', get => 'tvb_get_uint16', list => 'listOfCard16', },
  52     CARD32 => { size => 4, encoding => 'byte_order',       type => 'FT_UINT32', base => 'BASE_HEX_DEC', get => 'tvb_get_uint32', list => 'listOfCard32', },
  53     CARD64 => { size => 8, encoding => 'byte_order',       type => 'FT_UINT64', base => 'BASE_HEX_DEC', get => 'tvb_get_uint64', list => 'listOfCard64', },
  54     INT8 =>   { size => 1, encoding => 'byte_order',       type => 'FT_INT8',   base => 'BASE_DEC',     get => 'tvb_get_uint8',  list => 'listOfByte', },
  55     INT16 =>  { size => 2, encoding => 'byte_order',       type => 'FT_INT16',  base => 'BASE_DEC',     get => 'tvb_get_uint16', list => 'listOfInt16', },
  56     INT32 =>  { size => 4, encoding => 'byte_order',       type => 'FT_INT32',  base => 'BASE_DEC',     get => 'tvb_get_uint32', list => 'listOfInt32', },
  57     INT64 =>  { size => 8, encoding => 'byte_order',       type => 'FT_INT64',  base => 'BASE_DEC',     get => 'tvb_get_uint64', list => 'listOfInt64', },
  58     float =>  { size => 4, encoding => 'byte_order',       type => 'FT_FLOAT',  base => 'BASE_NONE',    get => 'tvb_get_ieee_float',   list => 'listOfFloat', },
  59     double => { size => 8, encoding => 'byte_order',       type => 'FT_DOUBLE', base => 'BASE_NONE',    get => 'tvb_get_ieee_double',  list => 'listOfDouble', },
  60     BOOL =>   { size => 1, encoding => 'byte_order',       type => 'FT_BOOLEAN',base => 'BASE_NONE',    get => 'tvb_get_uint8',  list => 'listOfByte', },
  61 );
  62
  63 my %simpletype;  # Reset at the beginning of each extension
  64 my %gltype;  # No need to reset, since it's only used once
  65
  66 my %struct =  # Not reset; contains structures already defined.
  67               # Also contains this black-list of structures never used by any
  68               # extension (to avoid generating useless code).
  69 (
  70     # structures defined by xproto, but not used by any extension
  71     'xproto:CHAR2B' => 1,
  72     'xproto:ARC' => 1,
  73     'xproto:FORMAT' => 1,
  74     'xproto:VISUALTYPE' => 1,
  75     'xproto:DEPTH' => 1,
  76     'xproto:SCREEN' => 1,
  77     'xproto:SetupRequest' => 1,
  78     'xproto:SetupFailed' => 1,
  79     'xproto:SetupAuthenticate' => 1,
  80     'xproto:Setup' => 1,
  81     'xproto:TIMECOORD' => 1,
  82     'xproto:FONTPROP' => 1,
  83     'xproto:CHARINFO' => 1,
  84     'xproto:SEGMENT' => 1,
  85     'xproto:COLORITEM' => 1,
  86     'xproto:RGB' => 1,
  87     'xproto:HOST' => 1,
  88     'xproto:POINT' => 1,
  89
  90     # structures defined by xinput, but never used (except by each other)(bug in xcb?)
  91     'xinput:KeyInfo' => 1,
  92     'xinput:ButtonInfo' => 1,
  93     'xinput:ValuatorInfo' => 1,
  94     'xinput:KbdFeedbackState' => 1,
  95     'xinput:PtrFeedbackState' => 1,
  96     'xinput:IntegerFeedbackState' => 1,
  97     'xinput:StringFeedbackState' => 1,
  98     'xinput:BellFeedbackState' => 1,
  99     'xinput:LedFeedbackState' => 1,
 100     'xinput:KbdFeedbackCtl' => 1,
 101     'xinput:PtrFeedbackCtl' => 1,
 102     'xinput:IntegerFeedbackCtl' => 1,
 103     'xinput:StringFeedbackCtl' => 1,
 104     'xinput:BellFeedbackCtl' => 1,
 105     'xinput:LedFeedbackCtl' => 1,
 106     'xinput:KeyState' => 1,
 107     'xinput:ButtonState' => 1,
 108     'xinput:ValuatorState' => 1,
 109     'xinput:DeviceResolutionState' => 1,
 110     'xinput:DeviceAbsCalibState' => 1,
 111     'xinput:DeviceAbsAreaState' => 1,
 112     'xinput:DeviceCoreState' => 1,
 113     'xinput:DeviceEnableState' => 1,
 114     'xinput:DeviceResolutionCtl' => 1,
 115     'xinput:DeviceAbsCalibCtl' => 1,
 116     'xinput:DeviceAbsAreaCtrl' => 1,
 117     'xinput:DeviceCoreCtrl' => 1,
 118     'xinput:DeviceEnableCtrl' => 1,
 119     'xinput:DeviceName' => 1,
 120     'xinput:AddMaster' => 1,
 121     'xinput:RemoveMaster' => 1,
 122     'xinput:AttachSlave' => 1,
 123     'xinput:DetachSlave' => 1,
 124     'xinput:ButtonClass' => 1,
 125     'xinput:KeyClass' => 1,
 126     'xinput:ScrollClass' => 1,
 127     'xinput:GestureClass' => 1,
 128     'xinput:TouchClass' => 1,
 129     'xinput:ValuatorClass' => 1,
 130
 131     # structures defined by xv, but never used (bug in xcb?)
 132     'xv:Image' => 1,
 133
 134     # structures defined by xkb, but never used (except by each other)(bug in xcb?)
 135     'xkb:Key' => 1,
 136     'xkb:Outline' => 1,
 137     'xkb:Overlay' => 1,
 138     'xkb:OverlayKey' => 1,
 139     'xkb:OverlayRow' => 1,
 140     'xkb:Row' => 1,
 141     'xkb:Shape' => 1,
 142 );
 143 my %enum;  # Not reset; contains enums already defined.
 144 my %enum_name;
 145 my %type_name;
 146 my $header;
 147 my $extname;
 148 my @incname;
 149 my %request;
 150 my %genericevent;
 151 my %event;
 152 my %reply;
 153
 154 # Output files
 155 my $impl;
 156 my $reg;
 157 my $decl;
 158 my $error;
 159
 160 # glRender sub-op output files
 161 my $enum;
 162
 163 # Mesa API definitions keep moving
 164 my @mesas = ($srcdir . '/mesa/src/mapi/glapi/gen',  # 2010-04-26
 165              $srcdir . '/mesa/src/mesa/glapi/gen',  # 2010-02-22
 166              $srcdir . '/mesa/src/mesa/glapi');     # 2004-05-18
 167 my $mesadir = (grep { -d } @mesas)[0];
 168
 169 sub mesa_category {
 170     my ($t, $elt) = @_;
 171     $t->purge;
 172 }
 173
 174 #used to prevent duplication and sort enumerated values
 175 my %mesa_enum_hash = ();
 176
 177 sub mesa_enum {
 178     my ($t, $elt) = @_;
 179     my $name = $elt->att('name');
 180     my $value = $elt->att('value');
 181     my $hex_value = hex($value); #convert string to hex value to catch leading zeros
 182
 183     #make sure value isn't already in the hash, to prevent duplication in value_string
 184     if (!exists($mesa_enum_hash{$hex_value})) {
 185         $mesa_enum_hash{$hex_value} = $name;
 186     }
 187     $t->purge;
 188 }
 189
 190 sub mesa_type {
 191     my ($t, $elt) = @_;
 192
 193     my $name = $elt->att('name');
 194     my $size = $elt->att('size');
 195     my $float = $elt->att('float');
 196     my $unsigned = $elt->att('unsigned');
 197     my $base;
 198
 199     $t->purge;
 200
 201     if($name eq 'enum') {
 202         # enum does not have a direct X equivalent
 203         $gltype{'GLenum'} = { size => 4, encoding => 'byte_order', type => 'FT_UINT32', base => 'BASE_HEX|BASE_EXT_STRING',
 204                               get => 'tvb_get_uint32', list => 'listOfCard32',
 205                               val => '&mesa_enum_ext', };
 206         return;
 207     }
 208
 209     $name = 'GL'.$name;
 210     if (defined($float) && $float eq 'true') {
 211         $base = 'float';
 212         $base = 'double' if ($size == 8);
 213     } else {
 214         $base = 'INT';
 215         if (defined($unsigned) && $unsigned eq 'true') {
 216             $base = 'CARD';
 217         }
 218         $base .= ($size * 8);
 219
 220         $base = 'BOOL' if ($name eq 'bool');
 221         $base = 'BYTE' if ($name eq 'void');
 222     }
 223
 224     $gltype{$name} = $basictype{$base};
 225 }
 226
 227 sub registered_name($$)
 228 {
 229     my $name = shift;
 230     my $field = shift;
 231
 232     return "hf_x11_$header"."_$name"."_$field";
 233 }
 234
 235 sub mesa_function {
 236     my ($t, $elt) = @_;
 237     # rop == glRender sub-op
 238     # sop == GLX minor opcode
 239     my $glx = $elt->first_child('glx');
 240     unless(defined $glx) { $t->purge; return; }
 241
 242     my $rop = $glx->att('rop');
 243     unless (defined $rop) { $t->purge; return; }
 244
 245     # Ideally, we want the main name, not the alias name.
 246     # Practically, we'd have to scan the file twice to find
 247     # the functions that we want to skip.
 248     my $alias = $elt->att('alias');
 249     if (defined $alias) { $t->purge; return; }
 250
 251     my $name = $elt->att('name');
 252     $request{$rop} = $name;
 253
 254     my $image;
 255
 256     my $length = 0;
 257     my @elements = $elt->children('param');
 258
 259     # Wireshark defines _U_ to mean "Unused" (compiler specific define)
 260     if (!@elements) {
 261         print $impl <<eot
 262 static void mesa_$name(tvbuff_t *tvb _U_, int *offsetp _U_, proto_tree *t _U_, unsigned byte_order _U_, int length _U_)
 263 {
 264 eot
 265 ;
 266     } else {
 267         print $impl <<eot
 268 static void mesa_$name(tvbuff_t *tvb, int *offsetp, proto_tree *t, unsigned byte_order, int length _U_)
 269 {
 270 eot
 271 ;
 272     }
 273
 274     my %type_param;
 275     foreach my $e (@elements) {
 276         # Detect count && variable_param
 277         my $count = $e->att('count');
 278         my $variable_param = $e->att('variable_param');
 279         if (defined $count and defined $variable_param) {
 280             $type_param{$variable_param} = 1;
 281         }
 282     }
 283     foreach my $e (@elements) {
 284         # Register field with wireshark
 285
 286         my $type = $e->att('type');
 287         $type =~ s/^const //;
 288         my $list;
 289         $list = 1 if ($type =~ /\*$/);
 290         $type =~ s/ \*$//;
 291
 292         my $fieldname = $e->att('name');
 293         my $regname = registered_name($name, $fieldname);
 294
 295         my $info = $gltype{$type};
 296         my $ft = $info->{'type'};
 297         my $base = $info->{'base'};
 298         my $val = $info->{'val'} // 'NULL';
 299         my $count = $e->att('count');
 300         my $variable_param = $e->att('variable_param');
 301
 302         if ($list and $count and $variable_param) {
 303             print $decl "static int ${regname};\n";
 304             print $reg "{ &$regname, { \"$fieldname\", \"x11.glx.render.$name.$fieldname\", FT_NONE, BASE_NONE, NULL, 0, NULL, HFILL }},\n";
 305             print $decl "static int ${regname}_signed;\n";
 306             print $reg "{ &${regname}_signed, { \"$fieldname\", \"x11.glx.render.$name.$fieldname\", FT_INT8, BASE_DEC, NULL, 0, NULL, HFILL }},\n";
 307             print $decl "static int ${regname}_unsigned;\n";
 308             print $reg "{ &${regname}_unsigned, { \"$fieldname\", \"x11.glx.render.$name.$fieldname\", FT_UINT8, BASE_DEC, NULL, 0, NULL, HFILL }},\n";
 309             print $decl "static int ${regname}_item_card16;\n";
 310             print $reg "{ &${regname}_item_card16, { \"$fieldname\", \"x11.glx.render.$name.$fieldname\", FT_UINT16, BASE_DEC, NULL, 0, NULL, HFILL }},\n";
 311             print $decl "static int ${regname}_item_int16;\n";
 312             print $reg "{ &${regname}_item_int16, { \"$fieldname\", \"x11.glx.render.$name.$fieldname\", FT_INT16, BASE_DEC, NULL, 0, NULL, HFILL }},\n";
 313             print $decl "static int ${regname}_item_card32;\n";
 314             print $reg "{ &${regname}_item_card32, { \"$fieldname\", \"x11.glx.render.$name.$fieldname\", FT_UINT32, BASE_DEC, NULL, 0, NULL, HFILL }},\n";
 315             print $decl "static int ${regname}_item_int32;\n";
 316             print $reg "{ &${regname}_item_int32, { \"$fieldname\", \"x11.glx.render.$name.$fieldname\", FT_INT32, BASE_DEC, NULL, 0, NULL, HFILL }},\n";
 317             print $decl "static int ${regname}_item_float;\n";
 318             print $reg "{ &${regname}_item_float, { \"$fieldname\", \"x11.glx.render.$name.$fieldname\", FT_FLOAT, BASE_NONE, NULL, 0, NULL, HFILL }},\n";
 319         } else {
 320             print $decl "static int $regname;\n";
 321             if ($list and $info->{'size'} > 1) {
 322                 print $reg "{ &$regname, { \"$fieldname\", \"x11.glx.render.$name.$fieldname.list\", FT_NONE, BASE_NONE, NULL, 0, NULL, HFILL }},\n";
 323                 $regname .= '_item';
 324                 print $decl "static int $regname;\n";
 325             }
 326             print $reg "{ &$regname, { \"$fieldname\", \"x11.glx.render.$name.$fieldname\", $ft, $base, $val, 0, NULL, HFILL }},\n";
 327
 328             if ($e->att('counter') or $type_param{$fieldname}) {
 329                 print $impl "    int $fieldname;\n";
 330             }
 331         }
 332
 333         if ($list) {
 334             if ($e->att('img_format')) {
 335                 $image = 1;
 336                 foreach my $wholename (('swap bytes', 'lsb first')) {
 337                     # Boolean values
 338                     my $varname = $wholename;
 339                     $varname =~ s/\s//g;
 340                     my $regname = registered_name($name, $varname);
 341                     print $decl "static int $regname;\n";
 342                     print $reg "{ &$regname, { \"$wholename\", \"x11.glx.render.$name.$varname\", FT_BOOLEAN, BASE_NONE, NULL, 0, NULL, HFILL }},\n";
 343                 }
 344                 foreach my $wholename (('row length', 'skip rows', 'skip pixels', 'alignment')) {
 345                     # Integer values
 346                     my $varname = $wholename;
 347                     $varname =~ s/\s//g;
 348                     my $regname = registered_name($name, $varname);
 349                     print $decl "static int $regname;\n";
 350                     print $reg "{ &$regname, { \"$wholename\", \"x11.glx.render.$name.$varname\", FT_UINT32, BASE_HEX_DEC, NULL, 0, NULL, HFILL }},\n";
 351                 }
 352             }
 353         }
 354     }
 355
 356     # The image requests have a few implicit elements first:
 357     if ($image) {
 358         foreach my $wholename (('swap bytes', 'lsb first')) {
 359             # Boolean values
 360             my $varname = $wholename;
 361             $varname =~ s/\s//g;
 362             my $regname = registered_name($name, $varname);
 363             print $impl "    proto_tree_add_item(t, $regname, tvb, *offsetp, 1, byte_order);\n";
 364             print $impl "    *offsetp += 1;\n";
 365             $length += 1;
 366         }
 367         print $impl "    proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, 2, ENC_NA);\n";
 368         print $impl "    *offsetp += 2;\n";
 369         $length += 2;
 370         foreach my $wholename (('row length', 'skip rows', 'skip pixels', 'alignment')) {
 371             # Integer values
 372             my $varname = $wholename;
 373             $varname =~ s/\s//g;
 374             my $regname = registered_name($name, $varname);
 375             print $impl "    proto_tree_add_item(t, $regname, tvb, *offsetp, 4, byte_order);\n";
 376             print $impl "    *offsetp += 4;\n";
 377             $length += 4;
 378         }
 379     }
 380
 381     foreach my $e (@elements) {
 382         my $type = $e->att('type');
 383         $type =~ s/^const //;
 384         my $list;
 385         $list = 1 if ($type =~ /\*$/);
 386         $type =~ s/ \*$//;
 387
 388         my $fieldname = $e->att('name');
 389         my $regname = registered_name($name, $fieldname);
 390
 391         my $info = $gltype{$type};
 392         my $ft = $info->{'type'};
 393         my $base = $info->{'base'};
 394
 395         if (!$list) {
 396             my $size = $info->{'size'};
 397             my $encoding = $info->{'encoding'};
 398             my $get = $info->{'get'};
 399
 400             if ($e->att('counter') or $type_param{$fieldname}) {
 401                 if ($get ne "tvb_get_uint8") {
 402                     print $impl "    $fieldname = $get(tvb, *offsetp, $encoding);\n";
 403                 } else {
 404                     print $impl "    $fieldname = $get(tvb, *offsetp);\n";
 405                 }
 406             }
 407             print $impl "    proto_tree_add_item(t, $regname, tvb, *offsetp, $size, $encoding);\n";
 408             print $impl "    *offsetp += $size;\n";
 409             $length += $size;
 410         } else {        # list
 411             my $list = $info->{'list'};
 412             my $count = $e->att('count');
 413             my $variable_param = $e->att('variable_param');
 414
 415             if (defined($count) && !defined($variable_param)) {
 416                 $regname .= ", $regname".'_item' if ($info->{'size'} > 1);
 417                 print $impl "    $list(tvb, offsetp, t, $regname, $count, byte_order);\n";
 418             } else {
 419                 if (defined($count)) {
 420                     # Currently, only CallLists has both a count and a variable_param
 421                     # The XML contains a size description of all the possibilities
 422                     # for CallLists, but not a type description. Implement by hand,
 423                     # with the caveat that more types may need to be added in the
 424                     # future.
 425                     say $impl "    switch($variable_param) {";
 426                     say $impl "    case 0x1400: /* BYTE */";
 427                     say $impl "        listOfByte(tvb, offsetp, t, ${regname}_signed, $count, byte_order);";
 428                     say $impl "        proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, (length - $length - $count), ENC_NA);";
 429                     say $impl "        *offsetp += (length - $length - $count);";
 430                     say $impl "        break;";
 431                     say $impl "    case 0x1401: /* UNSIGNED_BYTE */";
 432                     say $impl "        listOfByte(tvb, offsetp, t, ${regname}_unsigned, $count, byte_order);";
 433                     say $impl "        proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, (length - $length - $count), ENC_NA);";
 434                     say $impl "        *offsetp += (length - $length - $count);";
 435                     say $impl "        break;";
 436                     say $impl "    case 0x1402: /* SHORT */";
 437                     say $impl "        listOfInt16(tvb, offsetp, t, $regname, ${regname}_item_int16, $count, byte_order);";
 438                     say $impl "        proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, (length - $length - 2 * $count), ENC_NA);";
 439                     say $impl "        *offsetp += (length - $length - 2 * $count);";
 440                     say $impl "        break;";
 441                     say $impl "    case 0x1403: /* UNSIGNED_SHORT */";
 442                     say $impl "        listOfCard16(tvb, offsetp, t, $regname, ${regname}_item_card16, $count, byte_order);";
 443                     say $impl "        proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, (length - $length - 2 * $count), ENC_NA);";
 444                     say $impl "        *offsetp += (length - $length - 2 * $count);";
 445                     say $impl "        break;";
 446                     say $impl "    case 0x1404: /* INT */";
 447                     say $impl "        listOfInt32(tvb, offsetp, t, $regname, ${regname}_item_int32, $count, byte_order);";
 448                     say $impl "        break;";
 449                     say $impl "    case 0x1405: /* UNSIGNED_INT */";
 450                     say $impl "        listOfCard32(tvb, offsetp, t, $regname, ${regname}_item_card32, $count, byte_order);";
 451                     say $impl "        break;";
 452                     say $impl "    case 0x1406: /* FLOAT */";
 453                     say $impl "        listOfFloat(tvb, offsetp, t, $regname, ${regname}_item_float, $count, byte_order);";
 454                     say $impl "        break;";
 455                     say $impl "    case 0x1407: /* 2_BYTES */";
 456                     say $impl "        listOfCard16(tvb, offsetp, t, $regname, ${regname}_item_card16, $count, ENC_BIG_ENDIAN);";
 457                     say $impl "        proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, (length - $length - 2 * $count), ENC_NA);";
 458                     say $impl "        *offsetp += (length - $length - 2 * $count);";
 459                     say $impl "        break;";
 460                     say $impl "    case 0x1408: /* 3_BYTES */";
 461                     say $impl "        UNDECODED(3 * $count);";
 462                     say $impl "        proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, (length - $length - 3 * $count), ENC_NA);";
 463                     say $impl "        *offsetp += (length - $length - 3 * $count);";
 464                     say $impl "        break;";
 465                     say $impl "    case 0x1409: /* 4_BYTES */";
 466                     say $impl "        listOfCard32(tvb, offsetp, t, $regname, ${regname}_item_card32, $count, ENC_BIG_ENDIAN);";
 467                     say $impl "        break;";
 468                     say $impl "    case 0x140B: /* HALF_FLOAT */";
 469                     say $impl "        UNDECODED(2 * $count);";
 470                     say $impl "        proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, (length - $length - 2 * $count), ENC_NA);";
 471                     say $impl "        *offsetp += (length - $length - 2 * $count);";
 472                     say $impl "        break;";
 473                     say $impl "    default:     /* Unknown */";
 474                     say $impl "        UNDECODED(length - $length);";
 475                     say $impl "        break;";
 476                     say $impl "    }";
 477                 } else {
 478                     $regname .= ", $regname".'_item' if ($info->{'size'} > 1);
 479                     print $impl "    $list(tvb, offsetp, t, $regname, (length - $length) / $gltype{$type}{'size'}, byte_order);\n";
 480                 }
 481             }
 482         }
 483     }
 484
 485     print $impl "}\n\n";
 486     $t->purge;
 487 }
 488
 489 sub get_op($;$);
 490 sub get_unop($;$);
 491
 492 sub get_ref($$)
 493 {
 494     my $elt = shift;
 495     my $refref = shift;
 496     my $rv;
 497
 498     given($elt->name()) {
 499         when ('fieldref') {
 500             $rv = $elt->text();
 501             $refref->{$rv} = 1;
 502             $rv = 'f_'.$rv;
 503         }
 504         when ('value') { $rv = $elt->text(); }
 505         when ('op') { $rv = get_op($elt, $refref); }
 506         when (['unop','popcount']) { $rv = get_unop($elt, $refref); }
 507         default { die "Invalid op fragment: $_" }
 508     }
 509     return $rv;
 510 }
 511
 512 sub get_op($;$) {
 513     my $op = shift;
 514     my $refref = shift // {};
 515
 516     my @elements = $op->children(qr/fieldref|value|op|unop|popcount/);
 517     (@elements == 2) or die ("Wrong number of children for 'op'\n");
 518     my $left;
 519     my $right;
 520
 521     $left = get_ref($elements[0], $refref);
 522     $right = get_ref($elements[1], $refref);
 523
 524     return "($left " . $op->att('op') . " $right)";
 525 }
 526
 527 sub get_unop($;$) {
 528     my $op = shift;
 529     my $refref = shift // {};
 530
 531     my @elements = $op->children(qr/fieldref|value|op|unop|popcount/);
 532     (@elements == 1) or die ("Wrong number of children for 'unop'\n");
 533     my $left;
 534
 535     $left = get_ref($elements[0], $refref);
 536
 537     given ($op->name()) {
 538         when ('unop') {
 539             return '(' . $op->att('op') . "$left)";
 540         }
 541         when ('popcount') {
 542             return "ws_count_ones($left)";
 543         }
 544         default { die "Invalid unop element $op->name()\n"; }
 545     }
 546 }
 547
 548 sub qualname {
 549     my $name = shift;
 550     $name = $incname[0].':'.$name unless $name =~ /:/;
 551     return $name
 552 }
 553
 554 sub get_simple_info {
 555     my $name = shift;
 556     my $info = $basictype{$name};
 557     return $info if (defined $info);
 558     $info = $simpletype{$name};
 559     return $info if (defined $info);
 560     if (defined($type_name{$name})) {
 561         return $simpletype{$type_name{$name}};
 562     }
 563     return undef
 564 }
 565
 566 sub get_struct_info {
 567     my $name = shift;
 568     my $info = $struct{$name};
 569     return $info if (defined $info);
 570     if (defined($type_name{$name})) {
 571         return $struct{$type_name{$name}};
 572     }
 573     return undef
 574 }
 575
 576 sub getinfo {
 577     my $name = shift;
 578     my $info = get_simple_info($name) // get_struct_info($name);
 579     # If the script fails here search for $name in this script and remove it from the black list
 580     die "$name is defined to be unused in process-x11-xcb.pl but is actually used!" if (defined($info) && $info == "1");
 581     return $info;
 582 }
 583
 584 sub dump_enum_values($)
 585 {
 586     my $e = shift;
 587
 588     defined($enum{$e}) or die("Enum $e not found");
 589
 590     my $enumname = "x11_enum_$e";
 591     return $enumname if (defined $enum{$e}{done});
 592
 593     say $enum 'static const value_string '.$enumname.'[] = {';
 594
 595     my $value = $enum{$e}{value};
 596     for my $val (sort { $a <=> $b } keys %$value) {
 597         say $enum sprintf("    { %3d, \"%s\" },", $val, $$value{$val});
 598     }
 599     say $enum sprintf("    { %3d, NULL },", 0);
 600     say $enum '};';
 601     say $enum '';
 602
 603     $enum{$e}{done} = 1;
 604     return $enumname;
 605 }
 606
 607 # Find all references, so we can declare only the minimum necessary
 608 sub reference_elements($$);
 609
 610 sub reference_elements($$)
 611 {
 612     my $e = shift;
 613     my $refref = shift;
 614
 615     given ($e->name()) {
 616         when ('switch') {
 617             my $lentype = $e->first_child();
 618             if (defined $lentype) {
 619                 given ($lentype->name()) {
 620                     when ('fieldref') { $refref->{field}{$lentype->text()} = 1; }
 621                     when ('op') { get_op($lentype, $refref->{field}); }
 622                 }
 623             }
 624
 625             my @elements = $e->children(qr/(bit)?case/);
 626             for my $case (@elements) {
 627                 my @sub_elements = $case->children(qr/list|switch/);
 628
 629                 foreach my $sub_e (@sub_elements) {
 630                     reference_elements($sub_e, $refref);
 631                 }
 632             }
 633         }
 634         when ('list') {
 635             my $type = $e->att('type');
 636             my $info = getinfo($type);
 637             if (defined $info->{paramref}) {
 638                 for my $pref (keys %{$info->{paramref}}) {
 639                     $refref->{field}{$pref} = 1;
 640                 }
 641             }
 642
 643             my $lentype = $e->first_child();
 644             if (defined $lentype) {
 645                 given ($lentype->name()) {
 646                     when ('fieldref') { $refref->{field}{$lentype->text()} = 1; }
 647                     when ('op') { get_op($lentype, $refref->{field}); }
 648                     when (['unop','popcount']) { get_unop($lentype, $refref->{field}); }
 649                     when ('sumof') { $refref->{sumof}{$lentype->att('ref')} = 1; }
 650                 }
 651             } else {
 652                 $refref->{field}{'length'} = 1;
 653                 $refref->{'length'} = 1;
 654             }
 655         }
 656     }
 657 }
 658
 659 sub register_element($$$$;$)
 660 {
 661     my $e = shift;
 662     my $varpat = shift;
 663     my $humanpat = shift;
 664     my $refref = shift;
 665     my $indent = shift // ' ' x 4;
 666
 667     given ($e->name()) {
 668         when ('pad') { return; }     # Pad has no variables
 669         when ('switch') { return; }  # Switch defines variables in a tighter scope to avoid collisions
 670     }
 671
 672     # Register field with wireshark
 673
 674     my $fieldname = $e->att('name');
 675     my $type = $e->att('type') or die ("Field $fieldname does not have a valid type\n");
 676
 677     my $regname = 'hf_x11_'.sprintf ($varpat, $fieldname);
 678     my $humanname = 'x11.'.sprintf ($humanpat, $fieldname);
 679
 680     my $info = getinfo($type);
 681     my $ft = $info->{'type'} // 'FT_NONE';
 682     my $base = $info->{'base'} // 'BASE_NONE';
 683     my $vals = 'NULL';
 684
 685     my $enum = $e->att('enum') // $e->att('altenum');
 686     if (defined $enum) {
 687         my $enumname = dump_enum_values($enum_name{$enum});
 688         $vals = "VALS($enumname)";
 689
 690         # Wireshark does not allow FT_BYTES, FT_BOOLEAN, or BASE_NONE to have an enum
 691         $ft =~ s/FT_BYTES/FT_UINT8/;
 692         $ft =~ s/FT_BOOLEAN/FT_UINT8/;
 693         $base =~ s/BASE_NONE/BASE_DEC/;
 694     }
 695
 696     $enum = $e->att('mask');
 697     if (defined $enum) {
 698         # Create subtree items:
 699         defined($enum{$enum_name{$enum}}) or die("Enum $enum not found");
 700
 701         # Wireshark does not allow FT_BYTES or BASE_NONE to have an enum
 702         $ft =~ s/FT_BYTES/FT_UINT8/;
 703         $base =~ s/BASE_NONE/BASE_DEC/;
 704
 705         my $bitsize = $info->{'size'} * 8;
 706
 707         my $bit = $enum{$enum_name{$enum}}{bit};
 708         for my $val (sort { $a <=> $b } keys %$bit) {
 709             my $itemname = $$bit{$val};
 710             my $item = $regname . '_mask_' . $itemname;
 711             my $itemhuman = $humanname . '.' . $itemname;
 712             my $bitshift = "1U << $val";
 713
 714             say $decl "static int $item;";
 715             say $reg "{ &$item, { \"$itemname\", \"$itemhuman\", FT_BOOLEAN, $bitsize, NULL, $bitshift, NULL, HFILL }},";
 716         }
 717     }
 718
 719     print $decl "static int $regname;\n";
 720     if ($e->name() eq 'list' and defined $info->{'size'} and $info->{'size'} > 1) {
 721         print $reg "{ &$regname, { \"$fieldname\", \"$humanname.list\", FT_NONE, BASE_NONE, NULL, 0, NULL, HFILL }},\n";
 722         $regname .= '_item';
 723         print $decl "static int $regname;\n";
 724     }
 725     print $reg "{ &$regname, { \"$fieldname\", \"$humanname\", $ft, $base, $vals, 0, NULL, HFILL }},\n";
 726
 727     if ($refref->{sumof}{$fieldname}) {
 728         print $impl $indent."int sumof_$fieldname = 0;\n";
 729     }
 730
 731     if ($e->name() eq 'field') {
 732         if ($refref->{field}{$fieldname} and get_simple_info($type)) {
 733             # Pre-declare variable
 734             if ($ft eq 'FT_FLOAT') {
 735                 print $impl $indent."float f_$fieldname;\n";
 736             } elsif ($ft eq 'FT_DOUBLE') {
 737                 print $impl $indent."double f_$fieldname;\n";
 738             } elsif ($ft eq 'FT_INT64' or $ft eq 'FT_UINT64') {
 739                 print $impl $indent."int64_t f_$fieldname;\n";
 740             } else {
 741                 print $impl $indent."int f_$fieldname;\n";
 742             }
 743         }
 744     }
 745 }
 746
 747 sub dissect_element($$$$$;$$);
 748
 749 sub dissect_element($$$$$;$$)
 750 {
 751     my $e = shift;
 752     my $varpat = shift;
 753     my $humanpat = shift;
 754     my $length = shift;
 755     my $refref = shift;
 756     my $adjustlength = shift;
 757     my $indent = shift // ' ' x 4;
 758
 759     given ($e->name()) {
 760         when ('pad') {
 761             my $bytes = $e->att('bytes');
 762             my $align = $e->att('align');
 763             if (defined $bytes) {
 764                 print $impl $indent."proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, $bytes, ENC_NA);\n";
 765                 print $impl $indent."*offsetp += $bytes;\n";
 766                 $length += $bytes;
 767             } else {
 768                 say $impl $indent.'if (*offsetp % '.$align.') {';
 769                 say $impl $indent."    proto_tree_add_item(t, hf_x11_unused, tvb, *offsetp, ($align - *offsetp % $align), ENC_NA);";
 770                 say $impl $indent."    *offsetp += ($align - *offsetp % $align);";
 771                 say $impl $indent."}";
 772                 if ($length % $align != 0) {
 773                     $length += $align - $length % $align;
 774                 }
 775                 if ($adjustlength) {
 776                     say $impl $indent.'length = ((length + '.($align-1).') & ~'.($align-1).');';
 777                 }
 778             }
 779         }
 780         when ('field') {
 781             my $fieldname = $e->att('name');
 782             my $regname = 'hf_x11_'.sprintf ($varpat, $fieldname);
 783             my $type = $e->att('type');
 784
 785             if (get_simple_info($type)) {
 786                 my $info = get_simple_info($type);
 787                 my $size = $info->{'size'};
 788                 my $encoding = $info->{'encoding'};
 789                 my $get = $info->{'get'};
 790
 791                 if ($e->att('enum') // $e->att('altenum')) {
 792                     my $fieldsize = $size * 8;
 793                     print $impl $indent;
 794                     if ($refref->{field}{$fieldname}) {
 795                         print $impl "f_$fieldname = ";
 796                     }
 797                     say $impl "field$fieldsize(tvb, offsetp, t, $regname, byte_order);";
 798                 } elsif ($e->att('mask')) {
 799                     if ($refref->{field}{$fieldname}) {
 800                         if ($get ne "tvb_get_uint8") {
 801                             say $impl $indent."f_$fieldname = $get(tvb, *offsetp, byte_order);";
 802                         } else {
 803                             say $impl $indent."f_$fieldname = $get(tvb, *offsetp);";
 804                         }
 805                     }
 806                     my $bitmask_field = $fieldname . "_bits";
 807                     say $impl $indent."{";
 808                     say $impl $indent."    static int* const $bitmask_field [] = {";
 809                     my $bit = $enum{$enum_name{$e->att('mask')}}{bit};
 810                     for my $val (sort { $a <=> $b } keys %$bit) {
 811                         my $item = $regname . '_mask_' . $$bit{$val};
 812                         say $impl "$indent$indent&$item,";
 813                     }
 814                     say $impl "$indent$indent" . "NULL";
 815                     say $impl $indent."    };";
 816
 817                     say $impl $indent."    proto_tree_add_bitmask(t,  tvb, *offsetp, $regname, ett_x11_rectangle, $bitmask_field, $encoding);";
 818                     say $impl $indent."}";
 819                     say $impl $indent."*offsetp += $size;";
 820                 } else {
 821                     if ($refref->{field}{$fieldname}) {
 822                         if ($get ne "tvb_get_uint8") {
 823                             say $impl $indent."f_$fieldname = $get(tvb, *offsetp, byte_order);";
 824                         } else {
 825                             say $impl $indent."f_$fieldname = $get(tvb, *offsetp);";
 826                         }
 827                     }
 828                     print $impl $indent."proto_tree_add_item(t, $regname, tvb, *offsetp, $size, $encoding);\n";
 829                     print $impl $indent."*offsetp += $size;\n";
 830                 }
 831                 $length += $size;
 832             } elsif (get_struct_info($type)) {
 833                 # TODO: variable-lengths (when $info->{'size'} == 0 )
 834                 my $info = get_struct_info($type);
 835                 $length += $info->{'size'};
 836                 print $impl $indent."struct_$info->{'name'}(tvb, offsetp, t, byte_order, 1);\n";
 837             } else {
 838                 die ("Unrecognized type: $type\n");
 839             }
 840         }
 841         when ('list') {
 842             my $fieldname = $e->att('name');
 843             my $regname = 'hf_x11_'.sprintf ($varpat, $fieldname);
 844             my $type = $e->att('type');
 845
 846             my $info = getinfo($type);
 847             my $lencalc;
 848             my $lentype = $e->first_child();
 849             if (defined $info->{'size'}) {
 850                 $lencalc = "(length - $length) / $info->{'size'}";
 851             } else {
 852                 $lencalc = "(length - $length)";
 853             }
 854             if (defined $lentype) {
 855                 given ($lentype->name()) {
 856                     when ('value') { $lencalc = $lentype->text(); }
 857                     when ('fieldref') { $lencalc = 'f_'.$lentype->text(); }
 858                     when ('paramref') { $lencalc = 'p_'.$lentype->text(); }
 859                     when ('op') { $lencalc = get_op($lentype); }
 860                     when (['unop','popcount']) { $lencalc = get_unop($lentype); }
 861                     when ('sumof') { $lencalc = 'sumof_'.$lentype->att('ref'); }
 862                 }
 863             }
 864
 865             if (get_simple_info($type)) {
 866                 my $list = $info->{'list'};
 867                 my $size = $info->{'size'};
 868                 $regname .= ", $regname".'_item' if ($size > 1);
 869
 870                 if ($refref->{sumof}{$fieldname}) {
 871                     my $get = $info->{'get'};
 872                     say $impl $indent."{";
 873                     say $impl $indent."    int i;";
 874                     say $impl $indent."    for (i = 0; i < $lencalc; i++) {";
 875                     if ($get ne "tvb_get_uint8") {
 876                         say $impl $indent."        sumof_$fieldname += $get(tvb, *offsetp + i * $size, byte_order);";
 877                     } else {
 878                         say $impl $indent."        sumof_$fieldname += $get(tvb, *offsetp + i * $size);";
 879                     }
 880                     say $impl $indent."    }";
 881                     say $impl $indent."}";
 882                 }
 883
 884                 print $impl $indent."$list(tvb, offsetp, t, $regname, $lencalc, byte_order);\n";
 885             } elsif (get_struct_info($type)) {
 886                 my $si = get_struct_info($type);
 887                 my $prefs = "";
 888                 foreach my $pref (sort keys %{$si->{paramref}}) {
 889                     $prefs .= ", f_$pref";
 890                 }
 891
 892                 print $impl $indent."struct_$info->{'name'}(tvb, offsetp, t, byte_order, $lencalc$prefs);\n";
 893             } else {
 894                 # TODO: Fix unrecognized type. Comment out for now to generate dissector
 895                 # die ("Unrecognized type: $type\n");
 896             }
 897
 898             if ($adjustlength && defined($lentype)) {
 899               # Some requests end with a list of unspecified length
 900               # Adjust the length field here so that the next $lencalc will be accurate
 901               if (defined $info->{'size'}) {
 902                   say $impl $indent."length -= $lencalc * $info->{'size'};";
 903               } else {
 904                   say $impl $indent."length -= $lencalc * 1;";
 905               }
 906             }
 907         }
 908         when ('switch') {
 909             my $switchtype = $e->first_child() or die("Switch element not defined");
 910
 911             my $switchon = get_ref($switchtype, {});
 912             my @elements = $e->children(qr/(bit)?case/);
 913             for my $case (@elements) {
 914                 my @refs = $case->children('enumref');
 915                 my @test;
 916                 my $fieldname;
 917                 foreach my $ref (@refs) {
 918                     my $enum_ref = $ref->att('ref');
 919                     my $field = $ref->text();
 920                     $fieldname //= $field; # Use first named field
 921                     if ($case->name() eq 'bitcase') {
 922                         my $bit = $enum{$enum_name{$enum_ref}}{rbit}{$field};
 923                         if (! defined($bit)) {
 924                             for my $foo (keys %{$enum{$enum_name{$enum_ref}}{rbit}}) { say "'$foo'"; }
 925                             die ("Field '$field' not found in '$enum_ref'");
 926                         }
 927                         push @test , "$switchon & (1U << $bit)";
 928                     } else {
 929                         my $val = $enum{$enum_name{$enum_ref}}{rvalue}{$field};
 930                         if (! defined($val)) {
 931                             for my $foo (keys %{$enum{$enum_name{$enum_ref}}{rvalue}}) { say "'$foo'"; }
 932                             die ("Field '$field' not found in '$enum_ref'");
 933                         }
 934                         push @test , "$switchon == $val";
 935                     }
 936                 }
 937
 938                 if (@test > 1) {
 939                     # We have more than one conditional, add parentheses to them.
 940                     # We don't add parentheses to all the conditionals because
 941                     # clang complains about the extra parens if you do "if ((x == y))".
 942                     my @tests_with_parens;
 943                     foreach my $conditional (@test) {
 944                         push @tests_with_parens, "($conditional)";
 945                     }
 946
 947                     @test = @tests_with_parens;
 948                 }
 949
 950                 my $list = join ' || ', @test;
 951                 say $impl $indent."if ($list) {";
 952
 953                 my $vp = $varpat;
 954                 my $hp = $humanpat;
 955
 956                 $vp =~ s/%s/${fieldname}_%s/;
 957                 $hp =~ s/%s/${fieldname}.%s/;
 958
 959                 my @sub_elements = $case->children(qr/pad|field|list|switch/);
 960
 961                 my $subref = { field => {}, sumof => {} };
 962                 foreach my $sub_e (@sub_elements) {
 963                     reference_elements($sub_e, $subref);
 964                 }
 965                 foreach my $sub_e (@sub_elements) {
 966                     register_element($sub_e, $vp, $hp, $subref, $indent . '    ');
 967                 }
 968                 foreach my $sub_e (@sub_elements) {
 969                     $length = dissect_element($sub_e, $vp, $hp, $length, $subref, $adjustlength, $indent . '    ');
 970                 }
 971
 972                 say $impl $indent."}";
 973             }
 974         }
 975         default { die "Unknown field type: $_\n"; }
 976     }
 977     return $length;
 978 }
 979
 980 sub struct {
 981     my ($t, $elt) = @_;
 982     my $name = $elt->att('name');
 983     my $qualname = qualname($name);
 984     $type_name{$name} = $qualname;
 985
 986     if (defined $struct{$qualname}) {
 987         $t->purge;
 988         return;
 989     }
 990
 991     my @elements = $elt->children(qr/pad|field|list|switch/);
 992
 993     print(" - Struct $name\n");
 994
 995     $name = $qualname;
 996     $name =~ s/:/_/;
 997
 998     my %refs;
 999     my %paramrefs;
1000     my $size = 0;
1001     my $dynamic = 0;
1002     my $needi = 0;
1003     # Find struct size
1004     foreach my $e (@elements) {
1005         my $count;
1006         $count = 1;
1007         given ($e->name()) {
1008             when ('pad') {
1009                 my $bytes = $e->att('bytes');
1010                 my $align = $e->att('align');
1011                 if (defined $bytes) {
1012                     $size += $bytes;
1013                     next;
1014                 }
1015                 if (!$dynamic) {
1016                     if ($size % $align) {
1017                         $size += $align - $size % $align;
1018                     }
1019                 }
1020                 next;
1021             }
1022             when ('list') {
1023                 my $type = $e->att('type');
1024                 my $info = getinfo($type);
1025
1026                 $needi = 1 if ($info->{'size'} == 0);
1027
1028                 my $value = $e->first_child();
1029                 given($value->name()) {
1030                     when ('fieldref') {
1031                         $refs{$value->text()} = 1;
1032                         $count = 0;
1033                         $dynamic = 1;
1034                     }
1035                     when ('paramref') {
1036                         $paramrefs{$value->text()} = $value->att('type');
1037                         $count = 0;
1038                         $dynamic = 1;
1039                     }
1040                     when ('op') {
1041                         get_op($value, \%refs);
1042                         $count = 0;
1043                         $dynamic = 1;
1044                     }
1045                     when (['unop','popcount']) {
1046                         get_unop($value, \%refs);
1047                         $count = 0;
1048                         $dynamic = 1;
1049                     }
1050                     when ('value') {
1051                         $count = $value->text();
1052                     }
1053                     default { die("Invalid list size $_\n"); }
1054                 }
1055             }
1056             when ('field') { }
1057             when ('switch') {
1058                 $dynamic = 1;
1059                 next;
1060             }
1061             default { die("unrecognized field: $_\n"); }
1062         }
1063
1064         my $type = $e->att('type');
1065         my $info = getinfo($type);
1066
1067         $size += $info->{'size'} * $count;
1068     }
1069
1070     my $prefs = "";
1071
1072     if ($dynamic) {
1073         $size = 0;
1074
1075         foreach my $pref (sort keys %paramrefs) {
1076             $prefs .= ", int p_$pref";
1077         }
1078
1079         print $impl <<eot
1080
1081 static int struct_size_$name(tvbuff_t *tvb _U_, int *offsetp _U_, unsigned byte_order _U_$prefs)
1082 {
1083     int size = 0;
1084 eot
1085 ;
1086         say $impl '    int i, off;' if ($needi);
1087
1088         foreach my $ref (sort keys %refs) {
1089             say $impl "    int f_$ref;";
1090         }
1091
1092         foreach my $e (@elements) {
1093             my $count;
1094             $count = 1;
1095
1096             my $type = $e->att('type') // '';
1097             my $info = getinfo($type);
1098
1099             given ($e->name()) {
1100                 when ('pad') {
1101                     my $bytes = $e->att('bytes');
1102                     my $align = $e->att('align');
1103                     if (defined $bytes) {
1104                         $size += $bytes;
1105                     } else {
1106                         say $impl '    size = (size + '.($align-1).') & ~'.($align-1).';';
1107                     }
1108                 }
1109                 when ('list') {
1110                     my $len = $e->first_child();
1111                     my $infosize = $info->{'size'};
1112                     my $sizemul;
1113
1114                     given ($len->name()) {
1115                         when ('op') { $sizemul = get_op($len, \%refs); }
1116                         when (['unop','popcount']) { $sizemul = get_unop($len, \%refs); }
1117                         when ('fieldref') { $sizemul = 'f_'.$len->text(); }
1118                         when ('paramref') { $sizemul = 'p_'.$len->text(); }
1119                         when ('value') {
1120                             if ($infosize) {
1121                                 $size += $infosize * $len->text();
1122                             } else {
1123                                 $sizemul = $len->text();
1124                             }
1125                         }
1126                         default { die "Invalid list size: $_\n"; }
1127                     }
1128                     if (defined $sizemul) {
1129                         if ($infosize) {
1130                             say $impl "    size += $sizemul * $infosize;";
1131                         } else {
1132                             say $impl "    for (i = 0; i < $sizemul; i++) {";
1133                             say $impl "        off = (*offsetp) + size + $size;";
1134                             say $impl "        size += struct_size_$info->{name}(tvb, &off, byte_order);";
1135                             say $impl '    }';
1136                         }
1137                     }
1138                 }
1139                 when ('field') {
1140                     my $fname = $e->att('name');
1141                     if (defined($refs{$fname})) {
1142                         my $get = $info->{'get'};
1143                         if ($get ne "tvb_get_uint8") {
1144                             say $impl "    f_$fname = $info->{'get'}(tvb, *offsetp + size + $size, byte_order);";
1145                         } else {
1146                             say $impl "    f_$fname = $info->{'get'}(tvb, *offsetp + size + $size);";
1147                         }
1148                     }
1149                     $size += $info->{'size'};
1150                 }
1151             }
1152         }
1153         say $impl "    return size + $size;";
1154         say $impl '}';
1155         $size = 0; # 0 means "dynamic calcuation required"
1156     }
1157
1158     print $decl "static int hf_x11_struct_$name;\n";
1159     print $reg "{ &hf_x11_struct_$name, { \"$name\", \"x11.struct.$name\", FT_NONE, BASE_NONE, NULL, 0, NULL, HFILL }},\n";
1160
1161     print $impl <<eot
1162
1163 static void struct_$name(tvbuff_t *tvb, int *offsetp, proto_tree *root, unsigned byte_order _U_, int count$prefs)
1164 {
1165     int i;
1166     for (i = 0; i < count; i++) {
1167         proto_item *item;
1168         proto_tree *t;
1169 eot
1170 ;
1171
1172     my $varpat = 'struct_'.$name.'_%s';
1173     my $humanpat = "struct.$name.%s";
1174     my $refs = { field => {}, sumof => {} };
1175
1176     foreach my $e (@elements) {
1177         reference_elements($e, $refs);
1178     }
1179     foreach my $e (@elements) {
1180         register_element($e, $varpat, $humanpat, $refs, "        ");
1181     }
1182
1183     $prefs = "";
1184     foreach my $pref (sort keys %paramrefs) {
1185         $prefs .= ", p_$pref";
1186     }
1187
1188     my $sizecalc = $size;
1189     $size or $sizecalc = "struct_size_$name(tvb, offsetp, byte_order$prefs)";
1190
1191     print $impl <<eot
1192
1193         item = proto_tree_add_item(root, hf_x11_struct_$name, tvb, *offsetp, $sizecalc, ENC_NA);
1194         t = proto_item_add_subtree(item, ett_x11_rectangle);
1195 eot
1196 ;
1197     my $length = 0;
1198     foreach my $e (@elements) {
1199         $length = dissect_element($e, $varpat, $humanpat, $length, $refs, 0, "        ");
1200     }
1201
1202     print $impl "    }\n}\n";
1203     $struct{$qualname} = { size => $size, name => $name, paramref => \%paramrefs };
1204     $t->purge;
1205 }
1206
1207 sub union {
1208     # TODO proper dissection
1209     #
1210     # Right now, the only extension to use a union is randr.
1211     # for now, punt.
1212     my ($t, $elt) = @_;
1213     my $name = $elt->att('name');
1214     my $qualname = qualname($name);
1215     $type_name{$name} = $qualname;
1216
1217     if (defined $struct{$qualname}) {
1218         $t->purge;
1219         return;
1220     }
1221
1222     my @elements = $elt->children(qr/field/);
1223     my @sizes;
1224
1225     print(" - Union $name\n");
1226
1227     $name = $qualname;
1228     $name =~ s/:/_/;
1229
1230     # Find union size
1231     foreach my $e (@elements) {
1232         my $type = $e->att('type');
1233         my $info = getinfo($type);
1234
1235         $info->{'size'} > 0 or die ("Error: Union containing variable sized struct $type\n");
1236         push @sizes, $info->{'size'};
1237     }
1238     @sizes = sort {$b <=> $a} @sizes;
1239     my $size = $sizes[0];
1240
1241     print $decl "static int hf_x11_union_$name;\n";
1242     print $reg "{ &hf_x11_union_$name, { \"$name\", \"x11.union.$name\", FT_NONE, BASE_NONE, NULL, 0, NULL, HFILL }},\n";
1243
1244     print $impl <<eot
1245
1246 static void struct_$name(tvbuff_t *tvb, int *offsetp, proto_tree *root, unsigned byte_order, int count)
1247 {
1248     int i;
1249     int base = *offsetp;
1250     for (i = 0; i < count; i++) {
1251         proto_item *item;
1252         proto_tree *t;
1253 eot
1254 ;
1255
1256     my $varpat = 'union_'.$name.'_%s';
1257     my $humanpat = "union.$name.%s";
1258     my $refs = { field => {}, sumof => {} };
1259
1260     foreach my $e (@elements) {
1261         reference_elements($e, $refs);
1262     }
1263     foreach my $e (@elements) {
1264         register_element($e, $varpat, $humanpat, $refs, "        ");
1265     }
1266
1267     print $impl <<eot
1268         item = proto_tree_add_item(root, hf_x11_union_$name, tvb, base, $size, ENC_NA);
1269         t = proto_item_add_subtree(item, ett_x11_rectangle);
1270
1271 eot
1272 ;
1273
1274     foreach my $e (@elements) {
1275         say $impl '        *offsetp = base;';
1276         dissect_element($e, $varpat, $humanpat, 0, $refs, 0, "        ");
1277     }
1278     say $impl "        base += $size;";
1279     say $impl '    }';
1280     say $impl '    *offsetp = base;';
1281     say $impl '}';
1282
1283     $struct{$qualname} = { size => $size, name => $name };
1284     $t->purge;
1285 }
1286
1287 sub enum {
1288     my ($t, $elt) = @_;
1289     my $name = $elt->att('name');
1290     my $fullname = $incname[0].'_'.$name;
1291
1292     $enum_name{$name} = $fullname;
1293     $enum_name{$incname[0].':'.$name} = $fullname;
1294
1295     if (defined $enum{$fullname}) {
1296         $t->purge;
1297         return;
1298     }
1299
1300     my @elements = $elt->children('item');
1301
1302     print(" - Enum $name\n");
1303
1304     my $value = {};
1305     my $bit = {};
1306     my $rvalue = {};
1307     my $rbit = {};
1308     $enum{$fullname} = { value => $value, bit => $bit, rbit => $rbit, rvalue => $rvalue };
1309
1310     my $nextvalue = 0;
1311
1312     foreach my $e (@elements) {
1313         my $n = $e->att('name');
1314         my $valtype = $e->first_child(qr/value|bit/);
1315         if (defined $valtype) {
1316             my $val = int($valtype->text());
1317             given ($valtype->name()) {
1318                 when ('value') {
1319                     $$value{$val} = $n;
1320                     $$rvalue{$n} = $val;
1321                     $nextvalue = $val + 1;
1322
1323                     # Ugly hack to support (temporary, hopefully) ugly
1324                     # hack in xinput:ChangeDeviceProperty
1325                     # Register certain values as bits also
1326                     given ($val) {
1327                         when (8) {
1328                             $$bit{'3'} = $n;
1329                             $$rbit{$n} = 3;
1330                         }
1331                         when (16) {
1332                             $$bit{'4'} = $n;
1333                             $$rbit{$n} = 4;
1334                         }
1335                         when (32) {
1336                             $$bit{'5'} = $n;
1337                             $$rbit{$n} = 5;
1338                         }
1339                     }
1340                 }
1341                 when ('bit') {
1342                     $$bit{$val} = $n;
1343                     $$rbit{$n} = $val;
1344                 }
1345             }
1346         } else {
1347             $$value{$nextvalue} = $n;
1348             $nextvalue++;
1349         }
1350     }
1351
1352     $t->purge;
1353 }
1354
1355 sub request {
1356     my ($t, $elt) = @_;
1357     my $name = $elt->att('name');
1358
1359     print(" - Request $name\n");
1360     $request{$elt->att('opcode')} = $name;
1361
1362     my $length = 4;
1363     my @elements = $elt->children(qr/pad|field|list|switch/);
1364
1365     # Wireshark defines _U_ to mean "Unused" (compiler specific define)
1366     if (!@elements) {
1367         print $impl <<eot
1368
1369 static void $header$name(tvbuff_t *tvb _U_, packet_info *pinfo _U_, int *offsetp _U_, proto_tree *t _U_, unsigned byte_order _U_, int length _U_)
1370 {
1371 eot
1372 ;
1373     } else {
1374         print $impl <<eot
1375
1376 static void $header$name(tvbuff_t *tvb, packet_info *pinfo _U_, int *offsetp, proto_tree *t, unsigned byte_order, int length _U_)
1377 {
1378 eot
1379 ;
1380     }
1381     my $varpat = $header.'_'.$name.'_%s';
1382     my $humanpat = "$header.$name.%s";
1383     my $refs = { field => {}, sumof => {} };
1384
1385     foreach my $e (@elements) {
1386         reference_elements($e, $refs);
1387     }
1388     foreach my $e (@elements) {
1389         register_element($e, $varpat, $humanpat, $refs);
1390     }
1391
1392     foreach my $e (@elements) {
1393         if ($e->name() eq 'list' && $name eq 'Render' && $e->att('name') eq 'data' && -e "$mesadir/gl_API.xml") {
1394             # Special case: Use mesa-generated dissector for 'data'
1395             print $impl "    dispatch_glx_render(tvb, pinfo, offsetp, t, byte_order, (length - $length));\n";
1396         } else {
1397             $length = dissect_element($e, $varpat, $humanpat, $length, $refs, 1);
1398         }
1399     }
1400
1401     say $impl '}';
1402
1403     my $reply = $elt->first_child('reply');
1404     if ($reply) {
1405         $reply{$elt->att('opcode')} = $name;
1406
1407         $varpat = $header.'_'.$name.'_reply_%s';
1408         $humanpat = "$header.$name.reply.%s";
1409
1410         @elements = $reply->children(qr/pad|field|list|switch/);
1411
1412         # Wireshark defines _U_ to mean "Unused" (compiler specific define)
1413         if (!@elements) {
1414             say $impl "static void $header$name"."_Reply(tvbuff_t *tvb _U_, packet_info *pinfo, int *offsetp _U_, proto_tree *t _U_, unsigned byte_order _U_)\n{";
1415         } else {
1416             say $impl "static void $header$name"."_Reply(tvbuff_t *tvb, packet_info *pinfo, int *offsetp, proto_tree *t, unsigned byte_order)\n{";
1417         }
1418         say $impl '    int sequence_number;' if (@elements);
1419
1420         my $refs = { field => {}, sumof => {} };
1421         foreach my $e (@elements) {
1422             reference_elements($e, $refs);
1423         }
1424
1425         say $impl '    int f_length;'        if ($refs->{field}{'length'});
1426         say $impl '    int length;'          if ($refs->{length});
1427         foreach my $e (@elements) {
1428             register_element($e, $varpat, $humanpat, $refs);
1429         }
1430
1431         say $impl '';
1432         say $impl '    col_append_fstr(pinfo->cinfo, COL_INFO, "-'.$name.'");';
1433         say $impl '';
1434         say $impl '    REPLY(reply);';
1435
1436         my $first = 1;
1437         my $length = 1;
1438         foreach my $e (@elements) {
1439             $length = dissect_element($e, $varpat, $humanpat, $length, $refs);
1440             if ($first) {
1441                 $first = 0;
1442                 say $impl '    sequence_number = tvb_get_uint16(tvb, *offsetp, byte_order);';
1443                 say $impl '    proto_tree_add_uint_format_value(t, hf_x11_reply_sequencenumber, tvb, *offsetp, 2, sequence_number,';
1444                 say $impl '            "%d ('.$header.'-'.$name.')", sequence_number);';
1445                 say $impl '    *offsetp += 2;';
1446
1447                 if ($refs->{field}{length}) {
1448                     say $impl '    f_length = tvb_get_uint32(tvb, *offsetp, byte_order);';
1449                 }
1450                 if ($refs->{length}) {
1451                     say $impl '    length = f_length * 4 + 32;';
1452                 }
1453                 say $impl '    proto_tree_add_item(t, hf_x11_replylength, tvb, *offsetp, 4, byte_order);';
1454                 say $impl '    *offsetp += 4;';
1455
1456                 $length += 6;
1457             }
1458         }
1459
1460         say $impl '}';
1461     }
1462     $t->purge;
1463 }
1464
1465 sub defxid(@) {
1466     my $name;
1467     while ($name = shift) {
1468         my $qualname = qualname($name);
1469         $simpletype{$qualname} = { size => 4, encoding => 'byte_order', type => 'FT_UINT32',  base => 'BASE_HEX',  get => 'tvb_get_uint32', list => 'listOfCard32', };
1470         $type_name{$name} = $qualname;
1471     }
1472 }
1473
1474 sub xidtype {
1475     my ($t, $elt) = @_;
1476     my $name = $elt->att('name');
1477
1478     defxid($name);
1479
1480     $t->purge;
1481 }
1482
1483 sub typedef {
1484     my ($t, $elt) = @_;
1485     my $oldname = $elt->att('oldname');
1486     my $newname = $elt->att('newname');
1487     my $qualname = qualname($newname);
1488
1489     # Duplicate the type
1490     my $info = get_simple_info($oldname);
1491     if ($info) {
1492         $simpletype{$qualname} = $info;
1493     } elsif ($info = get_struct_info($oldname)) {
1494         $struct{$qualname} = $info;
1495     } else {
1496         die ("$oldname not found while attempting to typedef $newname\n");
1497     }
1498     $type_name{$newname} = $qualname;
1499
1500     $t->purge;
1501 }
1502
1503 sub error {
1504     my ($t, $elt) = @_;
1505
1506     my $number = $elt->att('number');
1507     if ($number >= 0) {
1508         my $name = $elt->att('name');
1509         print $error "  \"$header-$name\",\n";
1510     }
1511
1512     $t->purge;
1513 }
1514
1515 sub event {
1516     my ($t, $elt) = @_;
1517
1518     my $number = $elt->att('number');
1519     $number or return;
1520
1521     my $name = $elt->att('name');
1522     my $xge = $elt->att('xge');
1523
1524     if ($xge) {
1525         $genericevent{$number} = $name;
1526     } else {
1527         $event{$number} = $name;
1528     }
1529
1530     my $length = 1;
1531     my @elements = $elt->children(qr/pad|field|list|switch/);
1532
1533     # Wireshark defines _U_ to mean "Unused" (compiler specific define)
1534     if (!@elements) {
1535         if ($xge) {
1536             print $impl <<eot
1537
1538 static void $header$name(tvbuff_t *tvb _U_, int length _U_, int *offsetp _U_, proto_tree *t _U_, unsigned byte_order _U_)
1539 {
1540         } else {
1541             print $impl <<eot
1542
1543 static void $header$name(tvbuff_t *tvb _U_, int *offsetp _U_, proto_tree *t _U_, unsigned byte_order _U_)
1544 {
1545 eot
1546 ;
1547         }
1548     } else {
1549         if ($xge) {
1550             $length = 10;
1551             print $impl <<eot
1552
1553 static void $header$name(tvbuff_t *tvb, int length _U_, int *offsetp, proto_tree *t, unsigned byte_order)
1554 {
1555 eot
1556 ;
1557         } else {
1558             print $impl <<eot
1559
1560 static void $header$name(tvbuff_t *tvb, int *offsetp, proto_tree *t, unsigned byte_order)
1561 {
1562 eot
1563 ;
1564         }
1565     }
1566
1567     my $varpat = $header.'_'.$name.'_%s';
1568     my $humanpat = "$header.$name.%s";
1569     my $refs = { field => {}, sumof => {} };
1570
1571     foreach my $e (@elements) {
1572         reference_elements($e, $refs);
1573     }
1574     foreach my $e (@elements) {
1575         register_element($e, $varpat, $humanpat, $refs);
1576     }
1577
1578     if ($xge) {
1579         say $impl "    proto_tree_add_uint_format_value(t, hf_x11_minor_opcode, tvb, *offsetp, 2, $number,";
1580         say $impl "                               \"$name ($number)\");";
1581         foreach my $e (@elements) {
1582             $length = dissect_element($e, $varpat, $humanpat, $length, $refs);
1583         }
1584     } else {
1585         my $first = 1;
1586         foreach my $e (@elements) {
1587             $length = dissect_element($e, $varpat, $humanpat, $length, $refs);
1588             if ($first) {
1589                 $first = 0;
1590                 say $impl "    CARD16(event_sequencenumber);";
1591             }
1592         }
1593     }
1594
1595     say $impl "}\n";
1596
1597     $t->purge;
1598 }
1599
1600 sub include_start {
1601     my ($t, $elt) = @_;
1602     my $header = $elt->att('header');
1603     unshift @incname, $header;
1604 }
1605
1606 sub include_end {
1607     shift @incname;
1608 }
1609
1610 sub include
1611 {
1612     my ($t, $elt) = @_;
1613     my $include = $elt->text();
1614
1615     print " - Import $include\n";
1616     my $xml = XML::Twig->new(
1617                 start_tag_handlers => {
1618                     'xcb' => \&include_start,
1619                 },
1620                 twig_roots => {
1621                     'import' => \&include,
1622                     'struct' => \&struct,
1623                     'xidtype' => \&xidtype,
1624                     'xidunion' => \&xidtype,
1625                     'typedef' => \&typedef,
1626                     'enum' => \&enum,
1627                 },
1628                 end_tag_handlers => {
1629                     'xcb' => \&include_end,
1630                 });
1631     $xml->parsefile("$srcdir/xcbproto/src/$include.xml") or die ("Cannot open $include.xml\n");
1632
1633     $t->purge;
1634 }
1635
1636
1637 sub xcb_start {
1638     my ($t, $elt) = @_;
1639     $header = $elt->att('header');
1640     $extname = ($elt->att('extension-name') or $header);
1641     unshift @incname, $header;
1642
1643     print("Extension $extname\n");
1644
1645     undef %request;
1646     undef %genericevent;
1647     undef %event;
1648     undef %reply;
1649
1650     %simpletype = ();
1651     %enum_name = ();
1652     %type_name = ();
1653
1654     print $error "static const char * const $header"."_errors[] = {\n";
1655 }
1656
1657 sub xcb {
1658     my ($t, $elt) = @_;
1659
1660     my $xextname = $elt->att('extension-xname');
1661     my $lookup_name = $header . "_extension_minor";
1662     my $error_name = $header . "_errors";
1663     my $event_name = $header . "_events";
1664     my $genevent_name = 'NULL';
1665     my $reply_name = $header . "_replies";
1666
1667     print $decl "static int hf_x11_$lookup_name;\n\n";
1668
1669     print $impl "static const value_string $lookup_name"."[] = {\n";
1670     foreach my $req (sort {$a <=> $b} keys %request) {
1671         print $impl "    { $req, \"$request{$req}\" },\n";
1672     }
1673     print $impl "    { 0, NULL }\n";
1674     print $impl "};\n";
1675
1676     say $impl "static const x11_event_info $event_name".'[] = {';
1677     foreach my $e (sort {$a <=> $b} keys %event) {
1678         say $impl "    { \"$header-$event{$e}\", $header$event{$e} },";
1679     }
1680     say $impl '    { NULL, NULL }';
1681     say $impl '};';
1682
1683     if (%genericevent) {
1684         $genevent_name = $header.'_generic_events';
1685         say $impl 'static const x11_generic_event_info '.$genevent_name.'[] = {';
1686
1687         for my $val (sort { $a <=> $b } keys %genericevent) {
1688             say $impl sprintf("        { %3d, %s },", $val, $header.$genericevent{$val});
1689         }
1690         say $impl sprintf("        { %3d, NULL },", 0);
1691         say $impl '};';
1692         say $impl '';
1693     }
1694
1695     print $impl "static const x11_reply_info $reply_name"."[] = {\n";
1696     foreach my $e (sort {$a <=> $b} keys %reply) {
1697         print $impl "    { $e, $header$reply{$e}_Reply },\n";
1698     }
1699     print $impl "    { 0, NULL }\n";
1700     print $impl "};\n";
1701
1702     print $reg "{ &hf_x11_$lookup_name, { \"extension-minor\", \"x11.extension-minor\", FT_UINT8, BASE_DEC, VALS($lookup_name), 0, \"minor opcode\", HFILL }},\n\n";
1703
1704     print $impl <<eot
1705
1706 static void dispatch_$header(tvbuff_t *tvb, packet_info *pinfo, int *offsetp, proto_tree *t, unsigned byte_order)
1707 {
1708     int minor, length;
1709     minor = CARD8($lookup_name);
1710     length = REQUEST_LENGTH();
1711
1712     col_append_fstr(pinfo->cinfo, COL_INFO, "-%s",
1713                           val_to_str(minor, $lookup_name,
1714                                      "<Unknown opcode %d>"));
1715     switch (minor) {
1716 eot
1717     ;
1718
1719     foreach my $req (sort {$a <=> $b} keys %request) {
1720         print $impl "    case $req:\n";
1721         print $impl "        $header$request{$req}(tvb, pinfo, offsetp, t, byte_order, length);\n";
1722         print $impl "        break;\n";
1723     }
1724     say $impl "    /* No need for a default case here, since Unknown is printed above,";
1725     say $impl "       and UNDECODED() is taken care of by dissect_x11_request */";
1726     print $impl "    }\n}\n";
1727     print $impl <<eot
1728
1729 static void register_$header(void)
1730 {
1731     set_handler("$xextname", dispatch_$header, $error_name, $event_name, $genevent_name, $reply_name);
1732 }
1733 eot
1734     ;
1735
1736     print $error "  NULL\n};\n\n";
1737
1738     push @register, $header;
1739 }
1740
1741 sub find_version {
1742     #my $git = `which git`;
1743     #chomp($git);
1744     #-x $git or return 'unknown';
1745
1746     my $lib = shift;
1747     # this will generate an error on stderr if git isn't in our $PATH
1748     # but that's OK.  The version is still set to 'unknown' in that case
1749     # and at least the operator could see it.
1750     my $ver = `git --git-dir=$lib/.git describe --tags`;
1751     $ver //= 'unknown';
1752     chomp $ver;
1753     return $ver;
1754 }
1755
1756 sub add_generated_header {
1757     my ($out, $using) = @_;
1758     my $ver = find_version($using);
1759
1760     $using = File::Spec->abs2rel ($using,  $srcdir);
1761
1762     print $out <<eot
1763 /* Do not modify this file. */
1764 /* It was automatically generated by $script_name
1765    using $using version $ver */
1766 eot
1767     ;
1768
1769     # Add license text
1770     print $out <<eot
1771 /*
1772  * Copyright 2008, 2009, 2013, 2014 Open Text Corporation <pharris[AT]opentext.com>
1773  *
1774  * Wireshark - Network traffic analyzer
1775  * By Gerald Combs <gerald[AT]wireshark.org>
1776  * Copyright 1998 Gerald Combs
1777  *
1778  * SPDX-License-Identifier: GPL-2.0-or-later
1779  */
1780
1781 eot
1782     ;
1783 }
1784
1785 # initialize core X11 protocol
1786 # Do this in the Makefile now
1787 #system('./process-x11-fields.pl < x11-fields');
1788
1789 # Extension implementation
1790 $impl = new IO::File "> $srcdir/x11-extension-implementation.h"
1791             or die ("Cannot open $srcdir/x11-extension-implementation.h for writing\n");
1792 $error = new IO::File "> $srcdir/x11-extension-errors.h"
1793             or die ("Cannot open $srcdir/x11-extension-errors.h for writing\n");
1794
1795 add_generated_header($impl, $srcdir . '/xcbproto');
1796 add_generated_header($error, $srcdir . '/xcbproto');
1797
1798 # Open the files generated by process-x11-fields.pl for appending
1799 $reg = new IO::File ">> $srcdir/x11-register-info.h"
1800             or die ("Cannot open $srcdir/x11-register-info.h for appending\n");
1801 $decl = new IO::File ">> $srcdir/x11-declarations.h"
1802             or die ("Cannot open $srcdir/x11-declarations.h for appending\n");
1803
1804 print $reg "\n/* Generated by $script_name below this line */\n";
1805 print $decl "\n/* Generated by $script_name below this line */\n";
1806
1807 # Mesa for glRender
1808 if (-e "$mesadir/gl_API.xml") {
1809     $enum = new IO::File "> $srcdir/x11-glx-render-enum.h"
1810             or die ("Cannot open $srcdir/x11-glx-render-enum.h for writing\n");
1811     add_generated_header($enum, $srcdir . '/mesa');
1812     print $enum "static const value_string mesa_enum[] = {\n";
1813     print $impl '#include "x11-glx-render-enum.h"'."\n\n";
1814
1815     print("Mesa glRender:\n");
1816     $header = "glx_render";
1817
1818     my $xml = XML::Twig->new(
1819                 start_tag_handlers => {
1820                 },
1821                 twig_roots => {
1822                     'category' => \&mesa_category,
1823                     'enum' => \&mesa_enum,
1824                     'type' => \&mesa_type,
1825                     'function' => \&mesa_function,
1826                 });
1827     $xml->parsefile("$mesadir/gl_API.xml") or die ("Cannot open gl_API\n");
1828
1829     for my $enum_key ( sort {$a<=>$b} keys %mesa_enum_hash) {
1830         say $enum sprintf("  { 0x%04x, \"%s\" },", $enum_key, $mesa_enum_hash{$enum_key});
1831     }
1832     print $enum "    { 0, NULL }\n";
1833     print $enum "};\n";
1834     $enum->close();
1835
1836     print $decl "static int hf_x11_glx_render_op_name;\n\n";
1837
1838     print $impl "static const value_string glx_render_op_name"."[] = {\n";
1839     foreach my $req (sort {$a <=> $b} keys %request) {
1840         print $impl "    { $req, \"gl$request{$req}\" },\n";
1841     }
1842     print $impl "    { 0, NULL }\n";
1843     print $impl "};\n";
1844     print $impl "static value_string_ext mesa_enum_ext = VALUE_STRING_EXT_INIT(mesa_enum);\n";
1845
1846     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";
1847
1848 # Uses ett_x11_list_of_rectangle, since I am unable to see how the subtree type matters.
1849     print $impl <<eot
1850
1851 static void dispatch_glx_render(tvbuff_t *tvb, packet_info *pinfo, int *offsetp, proto_tree *t, unsigned byte_order, int length)
1852 {
1853     while (length >= 4) {
1854         uint32_t op, len;
1855         int next;
1856         proto_item *ti;
1857         proto_tree *tt;
1858
1859         len = tvb_get_uint16(tvb, *offsetp, byte_order);
1860
1861         op = tvb_get_uint16(tvb, *offsetp + 2, byte_order);
1862         ti = proto_tree_add_uint(t, hf_x11_glx_render_op_name, tvb, *offsetp, len, op);
1863
1864         tt = proto_item_add_subtree(ti, ett_x11_list_of_rectangle);
1865
1866         ti = proto_tree_add_item(tt, hf_x11_request_length, tvb, *offsetp, 2, byte_order);
1867         *offsetp += 2;
1868         proto_tree_add_item(tt, hf_x11_glx_render_op_name, tvb, *offsetp, 2, byte_order);
1869         *offsetp += 2;
1870
1871         if (len < 4) {
1872             expert_add_info(pinfo, ti, &ei_x11_request_length);
1873             /* Eat the rest of the packet, mark it undecoded */
1874             len = length;
1875             op = -1;
1876         }
1877         len -= 4;
1878
1879         next = *offsetp + len;
1880
1881         switch (op) {
1882 eot
1883     ;
1884     foreach my $req (sort {$a <=> $b} keys %request) {
1885         print $impl "        case $req:\n";
1886         print $impl "            mesa_$request{$req}(tvb, offsetp, tt, byte_order, len);\n";
1887         print $impl "            break;\n";
1888     }
1889     print $impl "        default:\n";
1890     print $impl "            proto_tree_add_item(tt, hf_x11_undecoded, tvb, *offsetp, len, ENC_NA);\n";
1891     print $impl "            *offsetp += len;\n";
1892
1893     print $impl "        }\n";
1894     print $impl "        if (*offsetp < next) {\n";
1895     print $impl "            proto_tree_add_item(tt, hf_x11_unused, tvb, *offsetp, next - *offsetp, ENC_NA);\n";
1896     print $impl "            *offsetp = next;\n";
1897     print $impl "        }\n";
1898     print $impl "        length -= (len + 4);\n";
1899     print $impl "    }\n}\n";
1900 }
1901
1902 $enum = new IO::File "> $srcdir/x11-enum.h"
1903         or die ("Cannot open $srcdir/x11-enum.h for writing\n");
1904 add_generated_header($enum, $srcdir . '/xcbproto');
1905 print $impl '#include "x11-enum.h"'."\n\n";
1906
1907 # XCB
1908 foreach my $ext (@reslist) {
1909     my $xml = XML::Twig->new(
1910                 start_tag_handlers => {
1911                     'xcb' => \&xcb_start,
1912                 },
1913                 twig_roots => {
1914                     'xcb' => \&xcb,
1915                     'import' => \&include,
1916                     'request' => \&request,
1917                     'struct' => \&struct,
1918                     'union' => \&union,
1919                     'xidtype' => \&xidtype,
1920                     'xidunion' => \&xidtype,
1921                     'typedef' => \&typedef,
1922                     'error' => \&error,
1923                     'errorcopy' => \&error,
1924                     'event' => \&event,
1925                     'enum' => \&enum,
1926                 });
1927     $xml->parsefile($ext) or die ("Cannot open $ext\n");
1928 }
1929
1930 print $impl "static void register_x11_extensions(void)\n{\n";
1931 foreach my $reg (@register) {
1932     print $impl "    register_$reg();\n";
1933 }
1934 print $impl "}\n";
1935
1936 #
1937 #  Editor modelines
1938 #
1939 #  Local Variables:
1940 #  c-basic-offset: 4
1941 #  tab-width: 8
1942 #  indent-tabs-mode: nil
1943 #  End:
1944 #
1945 #  ex: set shiftwidth=4 tabstop=8 expandtab:
1946 #  :indentSize=4:tabSize=8:noTabs=true:
1947 #