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
21use 5.010;
22
23use warnings;
24use 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
31no if $] >= 5.018, warnings => "experimental::smartmatch";
32
33use IO::File;
34use XML::Twig;
35
36use File::Spec;
37
38my $srcdir = shift;
39die "'$srcdir' is not a directory" unless -d $srcdir;
40
41my @reslist = grep {!/xproto\.xml$/} glob File::Spec->catfile($srcdir, 'xcbproto', 'src', '*.xml');
42my @register;
43
44my $script_name = File::Spec->abs2rel ($0,  $srcdir);
45
46my %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
63my %simpletype;  # Reset at the beginning of each extension
64my %gltype;  # No need to reset, since it's only used once
65
66my %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);
142my %enum;  # Not reset; contains enums already defined.
143my %enum_name;
144my %type_name;
145my $header;
146my $extname;
147my @incname;
148my %request;
149my %genericevent;
150my %event;
151my %reply;
152
153# Output files
154my $impl;
155my $reg;
156my $decl;
157my $error;
158
159# glRender sub-op output files
160my $enum;
161
162# Mesa API definitions keep moving
163my @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
166my $mesadir = (grep { -d } @mesas)[0];
167
168sub mesa_category {
169    my ($t, $elt) = @_;
170    $t->purge;
171}
172
173#used to prevent duplication and sort enumerated values
174my %mesa_enum_hash = ();
175
176sub 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
189sub 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
226sub registered_name($$)
227{
228    my $name = shift;
229    my $field = shift;
230
231    return "hf_x11_$header"."_$name"."_$field";
232}
233
234sub 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
261static void mesa_$name(tvbuff_t *tvb _U_, int *offsetp _U_, proto_tree *t _U_, guint byte_order _U_, int length _U_)
262{
263eot
264;
265    } else {
266        print $impl <<eot
267static void mesa_$name(tvbuff_t *tvb, int *offsetp, proto_tree *t, guint byte_order, int length _U_)
268{
269eot
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
488sub get_op($;$);
489sub get_unop($;$);
490
491sub 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
511sub 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
526sub 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
547sub qualname {
548    my $name = shift;
549    $name = $incname[0].':'.$name unless $name =~ /:/;
550    return $name
551}
552
553sub 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
565sub 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
575sub 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
583sub 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
607sub reference_elements($$);
608
609sub 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
658sub 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
746sub dissect_element($$$$$;$$);
747
748sub 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."    int* const $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
979sub 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
1080static int struct_size_$name(tvbuff_t *tvb _U_, int *offsetp _U_, guint byte_order _U_$prefs)
1081{
1082    int size = 0;
1083eot
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
1162static 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;
1168eot
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);
1194eot
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
1206sub 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
1245static 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;
1252eot
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
1270eot
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
1286sub 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
1354sub 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
1368static 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{
1370eot
1371;
1372    } else {
1373        print $impl <<eot
1374
1375static void $header$name(tvbuff_t *tvb, packet_info *pinfo _U_, int *offsetp, proto_tree *t, guint byte_order, int length _U_)
1376{
1377eot
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
1464sub 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
1473sub xidtype {
1474    my ($t, $elt) = @_;
1475    my $name = $elt->att('name');
1476
1477    defxid($name);
1478
1479    $t->purge;
1480}
1481
1482sub 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
1502sub 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
1514sub 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
1537static 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
1542static void $header$name(tvbuff_t *tvb _U_, int *offsetp _U_, proto_tree *t _U_, guint byte_order _U_)
1543{
1544eot
1545;
1546        }
1547    } else {
1548        if ($xge) {
1549            $length = 10;
1550            print $impl <<eot
1551
1552static void $header$name(tvbuff_t *tvb, int length _U_, int *offsetp, proto_tree *t, guint byte_order)
1553{
1554eot
1555;
1556        } else {
1557            print $impl <<eot
1558
1559static void $header$name(tvbuff_t *tvb, int *offsetp, proto_tree *t, guint byte_order)
1560{
1561eot
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
1599sub include_start {
1600    my ($t, $elt) = @_;
1601    my $header = $elt->att('header');
1602    unshift @incname, $header;
1603}
1604
1605sub include_end {
1606    shift @incname;
1607}
1608
1609sub 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
1636sub 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
1656sub 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
1705static 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) {
1715eot
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
1728static void register_$header(void)
1729{
1730    set_handler("$xextname", dispatch_$header, $error_name, $event_name, $genevent_name, $reply_name);
1731}
1732eot
1733    ;
1734
1735    print $error "  NULL\n};\n\n";
1736
1737    push @register, $header;
1738}
1739
1740sub 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
1755sub 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 */
1765eot
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
1780eot
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
1794add_generated_header($impl, $srcdir . '/xcbproto');
1795add_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
1803print $reg "\n/* Generated by $script_name below this line */\n";
1804print $decl "\n/* Generated by $script_name below this line */\n";
1805
1806# Mesa for glRender
1807if (-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
1850static 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) {
1881eot
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");
1903add_generated_header($enum, $srcdir . '/xcbproto');
1904print $impl '#include "x11-enum.h"'."\n\n";
1905
1906# XCB
1907foreach 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
1929print $impl "static void register_x11_extensions(void)\n{\n";
1930foreach my $reg (@register) {
1931    print $impl "    register_$reg();\n";
1932}
1933print $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#
1947