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