source/build/pidl/eparser.pm

   1 ###################################################
   2 # Samba4 parser generator for IDL structures
   3 # Copyright tridge@samba.org 2000-2003
   4 # Copyright tpot@samba.org 2001,2004-2005
   5 # released under the GNU GPL
   6
   7 package IdlEParser;
   8
   9 use strict;
  10
  11 # the list of needed functions
  12 my %needed;
  13
  14 my $module;
  15 my $if_uuid;
  16 my $if_version;
  17 my $if_endpoints;
  18
  19 sub pidl($)
  20 {
  21         print OUT shift;
  22 }
  23
  24 #####################################################################
  25 # a list of annotations
  26
  27 my $nopull_typedefs = {
  28 #    "policy_handle" => "1",
  29 };
  30
  31 #####################################################################
  32 # work out is a parse function should be declared static or not
  33 sub fn_prefix($)
  34 {
  35         my $fn = shift;
  36         if ($fn->{TYPE} eq "TYPEDEF") {
  37                 if (util::has_property($fn, "public")) {
  38                         return "";
  39                 }
  40         }
  41
  42         if ($fn->{TYPE} eq "FUNCTION") {
  43                 if (util::has_property($fn, "public")) {
  44                         return "";
  45                 }
  46         }
  47         return "static ";
  48 }
  49
  50
  51 #####################################################################
  52 # parse a function
  53 sub ParseFunctionPull($)
  54 {
  55         my($fn) = shift;
  56         my $static = fn_prefix($fn);
  57
  58         # request function
  59         pidl "int $fn->{NAME}_rqst(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *tree, guint8 *drep)\n{\n";
  60
  61         pidl "\tstruct pidl_pull *ndr = pidl_pull_init(tvb, offset, pinfo, drep);\n";
  62         pidl "\tstruct $fn->{NAME} *r = talloc_p(NULL, struct $fn->{NAME});\n";
  63         pidl "\tpidl_tree ptree;\n\n";
  64
  65         pidl "\tptree.proto_tree = tree;\n";
  66         pidl "\tptree.subtree_list = NULL;\n\n";
  67
  68         pidl "\tndr_pull_$fn->{NAME}(ndr, NDR_IN, &ptree, r);\n";
  69
  70         pidl "\n\treturn ndr->offset;\n";
  71         pidl "}\n\n";
  72
  73         # response function
  74         pidl "int $fn->{NAME}_resp(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *tree, guint8 *drep)\n{\n";
  75
  76         pidl "\tstruct pidl_pull *ndr = pidl_pull_init(tvb, offset, pinfo, drep);\n";
  77         pidl "\tstruct $fn->{NAME} *r = talloc_p(NULL, struct $fn->{NAME});\n";
  78         pidl "\tpidl_tree ptree;\n\n";
  79
  80         pidl "\tptree.proto_tree = tree;\n";
  81         pidl "\tptree.subtree_list = NULL;\n\n";
  82
  83         pidl "\tndr_pull_$fn->{NAME}(ndr, NDR_OUT, &ptree, r);\n";
  84
  85         pidl "\n\treturn ndr->offset;\n";
  86         pidl "}\n\n";
  87 }
  88
  89 #####################################################################
  90 # produce a function call table
  91 sub FunctionTable($)
  92 {
  93         my($interface) = shift;
  94         my($data) = $interface->{DATA};
  95
  96         pidl "static dcerpc_sub_dissector dcerpc_dissectors[] = {\n";
  97         my $num = 0;
  98         foreach my $d (@{$data}) {
  99                 if ($d->{TYPE} eq "FUNCTION") {
 100                     # Strip module name from function name, if present
 101                     my($n) = $d->{NAME};
 102                     $n = substr($d->{NAME}, length($module) + 1),
 103                         if $module eq substr($d->{NAME}, 0, length($module));
 104                     pidl "\t{ $num, \"$n\",\n";
 105                     pidl "\t\t$d->{NAME}_rqst,\n";
 106                     pidl "\t\t$d->{NAME}_resp },\n";
 107                     $num++;
 108                 }
 109         }
 110         pidl "};\n\n";
 111 }
 112
 113 sub type2ft($)
 114 {
 115     my($t) = shift;
 116
 117     return "FT_UINT$1" if $t =~ /uint(8|16|32|64)/;
 118     return "FT_INT$1" if $t =~ /int(8|16|32|64)/;
 119     return "FT_UINT64", if ($t eq "HYPER_T" or $t eq "NTTIME");
 120
 121     # Type is an enum
 122
 123     return "FT_UINT16";
 124 }
 125
 126 # Determine the display base for an element
 127
 128 sub elementbase($)
 129 {
 130     my($e) = shift;
 131
 132     if (my $base = util::has_property($e, "display")) {
 133         return "BASE_" . uc($base);
 134     }
 135
 136     return "BASE_DEC", if $e->{TYPE} eq "ENUM";
 137     return "BASE_DEC", if $e->{TYPE} =~ /u?int(8|16|32|64)/;
 138     return "BASE_DEC", if $e->{TYPE} eq "NTTIME" or $e->{TYPE} eq "HYPER_T";
 139
 140     # Probably an enum
 141
 142     return "BASE_DEC";
 143 }
 144
 145 # Convert a IDL structure field name (e.g access_mask) to a prettier
 146 # string like 'Access Mask'.
 147
 148 sub field2name($)
 149 {
 150     my($field) = shift;
 151
 152     $field =~ s/_/ /g;          # Replace underscores with spaces
 153     $field =~ s/(\w+)/\u\L$1/g; # Capitalise each word
 154
 155     return $field;
 156 }
 157
 158 sub NeededFunction($)
 159 {
 160         my $fn = shift;
 161
 162         $needed{"pull_$fn->{NAME}"} = 1;
 163
 164         # Add entries for function arguments
 165
 166         foreach my $e (@{$fn->{DATA}}) {
 167
 168                 $e->{PARENT} = $fn;
 169                 $needed{"pull_$e->{TYPE}"} = 1;
 170
 171                 if (util::is_scalar_type($e->{TYPE})) {
 172
 173                     if (defined($e->{ARRAY_LEN}) or
 174                         util::has_property($e, "size_is")) {
 175
 176                         # Array of scalar types
 177
 178                         $needed{"hf_$fn->{NAME}_$e->{NAME}_array"} = {
 179                             'name' => field2name($e->{NAME}),
 180                             'type' => $e->{TYPE},
 181                             'ft'   => "FT_BYTES",
 182                             'base' => elementbase($e)
 183                             };
 184
 185                     } else {
 186
 187                         $needed{"hf_$fn->{NAME}_$e->{NAME}"} = {
 188                         'name' => field2name($e->{NAME}),
 189                         'type' => $e->{TYPE},
 190                         'ft'   => type2ft($e->{TYPE}),
 191                         'base' => elementbase($e)
 192                         };
 193
 194                     }
 195
 196                     $e->{PARENT} = $fn;
 197
 198                 } else {
 199                     $needed{"ett_$e->{TYPE}"} = 1;
 200                 }
 201         }
 202
 203         # Add entry for return value
 204
 205         $needed{"hf_$fn->{NAME}_result"} = {
 206             'name' => field2name('result'),
 207             'type' => $fn->{RETURN_TYPE},
 208             'ft' => type2ft($fn->{RETURN_TYPE}),
 209             'base' => elementbase($fn)
 210         };
 211 }
 212
 213 sub NeededTypedef($)
 214 {
 215         my $t = shift;
 216
 217         if (util::has_property($t, "public")) {
 218                 $needed{"pull_$t->{NAME}"} = 1;
 219         }
 220
 221         if ($t->{DATA}->{TYPE} eq "STRUCT") {
 222
 223             for my $e (@{$t->{DATA}->{ELEMENTS}}) {
 224
 225                 $e->{PARENT} = $t->{DATA};
 226
 227                 if ($needed{"pull_$t->{NAME}"}) {
 228                     $needed{"pull_$e->{TYPE}"} = 1;
 229                 }
 230
 231                 if (util::is_scalar_type($e->{TYPE})) {
 232
 233                     if (defined($e->{ARRAY_LEN}) or
 234                         util::has_property($e, "size_is")) {
 235
 236                         # Arrays of scalar types are FT_BYTES
 237
 238                         $needed{"hf_$t->{NAME}_$e->{NAME}_array"} = {
 239                             'name' => field2name($e->{NAME}),
 240                             'type' => $e->{TYPE},
 241                             'ft'   => "FT_BYTES",
 242                             'base' => elementbase($e)
 243                             };
 244
 245                     } else {
 246
 247                         $needed{"hf_$t->{NAME}_$e->{NAME}"} = {
 248                             'name' => field2name($e->{NAME}),
 249                             'type' => $e->{TYPE},
 250                             'ft'   => type2ft($e->{TYPE}),
 251                             'base' => elementbase($e)
 252                             };
 253                     }
 254
 255                     $e->{PARENT} = $t->{DATA};
 256
 257                     if ($needed{"pull_$t->{NAME}"}) {
 258                         $needed{"pull_$e->{TYPE}"} = 1;
 259                     }
 260
 261                 } else {
 262
 263                     $needed{"ett_$e->{TYPE}"} = 1;
 264
 265                 }
 266             }
 267         }
 268
 269         if ($t->{DATA}->{TYPE} eq "UNION") {
 270
 271                 for my $e (@{$t->{DATA}->{DATA}}) {
 272
 273                         $e->{PARENT} = $t->{DATA};
 274
 275                         if ($e->{TYPE} eq "UNION_ELEMENT") {
 276
 277                                 if ($needed{"pull_$t->{NAME}"}) {
 278                                         $needed{"pull_$e->{DATA}->{TYPE}"} = 1;
 279                                 }
 280
 281                                 $needed{"ett_$e->{DATA}{TYPE}"} = 1;
 282                         }
 283                 }
 284
 285             $needed{"ett_$t->{NAME}"} = 1;
 286         }
 287
 288         if ($t->{DATA}->{TYPE} eq "ENUM") {
 289
 290             $needed{"hf_$t->{NAME}"} = {
 291                 'name' => field2name($t->{NAME}),
 292                 'ft' => 'FT_UINT16',
 293                 'base' => 'BASE_DEC',
 294                 'strings' => "VALS($t->{NAME}_vals)"
 295                 };
 296         }
 297
 298         if ($t->{DATA}->{TYPE} eq "BITMAP") {
 299             foreach my $e (@{$t->{DATA}{ELEMENTS}}) {
 300                 $e =~ /^(.*?) \( (.*?) \)$/;
 301                 $needed{"hf_$t->{NAME}_$1"} = {
 302                     'name' => "$t->{NAME} $1",
 303                     'ft' => "FT_BOOLEAN",
 304                     'base' => "32",
 305                     'bitmask' => "$2"
 306                     };
 307             }
 308         }
 309 }
 310
 311 #####################################################################
 312 # work out what parse functions are needed
 313 sub BuildNeeded($)
 314 {
 315         my($interface) = shift;
 316
 317         my($data) = $interface->{DATA};
 318
 319         foreach my $d (@{$data}) {
 320                 ($d->{TYPE} eq "FUNCTION") &&
 321                     NeededFunction($d);
 322         }
 323
 324         foreach my $d (reverse @{$data}) {
 325                 ($d->{TYPE} eq "TYPEDEF") &&
 326                     NeededTypedef($d);
 327         }
 328 }
 329
 330 #####################################################################
 331 # parse the interface definitions
 332 sub ModuleHeader($)
 333 {
 334     my($h) = shift;
 335
 336     $if_uuid = $h->{PROPERTIES}->{uuid};
 337     $if_version = $h->{PROPERTIES}->{version};
 338     $if_endpoints = $h->{PROPERTIES}->{endpoints};
 339 }
 340
 341 #####################################################################
 342 # Generate a header file that contains function prototypes for
 343 # structs and typedefs.
 344 sub ParseHeader($$)
 345 {
 346         my($idl) = shift;
 347         my($filename) = shift;
 348
 349         open(OUT, ">$filename") || die "can't open $filename";
 350
 351         pidl "/* parser auto-generated by pidl */\n\n";
 352
 353         foreach my $x (@{$idl}) {
 354             if ($x->{TYPE} eq "INTERFACE") {
 355                 foreach my $d (@{$x->{DATA}}) {
 356
 357                     # Make prototypes for [public] structures and
 358                     # unions.
 359
 360                     if ($d->{TYPE} eq "TYPEDEF" and
 361                         util::has_property($d, "public")) {
 362
 363                         if ($d->{DATA}{TYPE} eq "STRUCT") {
 364                             pidl "void ndr_pull_$d->{NAME}(struct ndr_pull *ndr, int ndr_flags, proto_tree *tree, struct $d->{NAME} *r);\n\n";
 365                         }
 366
 367                         if ($d->{DATA}{TYPE} eq "UNION") {
 368                             pidl "void ndr_pull_$d->{NAME}(struct ndr_pull *ndr, int ndr_flags, proto_tree *tree, union $d->{NAME} *r, uint16 level);\n\n";
 369                         }
 370                     }
 371                 }
 372             }
 373         }
 374
 375         close(OUT);
 376 }
 377
 378 #####################################################################
 379 # generate code to parse an enum
 380
 381 sub ParseEnum($)
 382 {
 383     my ($e) = shift;
 384
 385     pidl "static const value_string $e->{PARENT}{NAME}_vals[] =\n";
 386     pidl "{\n";
 387
 388     foreach my $x (@{$e->{ELEMENTS}}) {
 389         $x =~ /([^=]*)=(.*)/;
 390         pidl "\t{ $1, \"$1\" },\n";
 391     }
 392
 393     pidl "};\n\n";
 394 }
 395
 396 #####################################################################
 397 # rewrite autogenerated header file
 398 sub RewriteHeader($$$)
 399 {
 400     my($idl) = shift;
 401     my($input) = shift;
 402     my($output) = shift;
 403
 404     %needed = ();
 405
 406     # Open files
 407
 408     open(IN, "<$input") || die "can't open $input for reading";
 409     open(OUT, ">$output") || die "can't open $output for writing";
 410
 411     # Read through file
 412
 413     while(<IN>) {
 414
 415         # Not interested in ndr_push or ndr_print routines as they
 416         # define structures we aren't interested in.
 417
 418         s/^NTSTATUS ndr_push.*?;\n//smg;
 419         s/^void ndr_print.*?;\n//smg;
 420
 421         # Get rid of async send and receive function.
 422
 423         s/^NTSTATUS dcerpc_.*?;//smg;
 424         s/^struct rpc_request.*?;//smg;
 425
 426         # Rewrite librpc includes
 427
 428         s/^\#include\ \"librpc\/gen_ndr\/ndr_(.*?).h\"$
 429             /\#include \"packet-dcerpc-$1.h\"/smgx;
 430
 431         # Convert samba fixed width types to stdint types
 432
 433         s/((u)?int)([0-9]+)/$1$3_t/smg;
 434
 435         # Rename struct ndr_pull to struct pidl_pull
 436
 437         s/struct ndr_pull \*ndr/struct pidl_pull \*ndr/smg;
 438
 439         # Change prototypes for public functions
 440
 441         s/(struct pidl_pull \*ndr, int ndr_flags)/$1, pidl_tree *tree/smg;
 442
 443         # Bitmaps
 444
 445         s/(uint32_t \*r\);)/pidl_tree *tree, int hf, $1/smg;
 446
 447         pidl $_;
 448     }
 449
 450     close(OUT);
 451 }
 452
 453 #####################################################################
 454 # rewrite autogenerated C file
 455 sub RewriteC($$$)
 456 {
 457     my($idl) = shift;
 458     my($input) = shift;
 459     my($output) = shift;
 460
 461     # Open files
 462
 463     open(IN, "<$input") || die "can't open $input for reading";
 464     open(OUT, ">$output") || die "can't open $output for writing";
 465
 466     # Get name of module
 467
 468     foreach my $x (@{$idl}) {
 469         if ($x->{TYPE} eq "INTERFACE") {
 470             ModuleHeader($x);
 471             $module = $x->{NAME};
 472             BuildNeeded($x);
 473         }
 474     }
 475
 476     pidl "#include \"eparser.h\"\n\n";
 477
 478     pidl "extern const value_string NT_errors[];\n\n";
 479
 480     # Declarations for hf variables
 481
 482     pidl "static int hf_opnum = -1;\n";
 483     pidl "static int hf_ptr = -1;\n";
 484     pidl "static int hf_array_size = -1;\n";
 485     pidl "static int hf_result_NTSTATUS = -1;\n";
 486
 487     pidl "\n";
 488
 489     foreach my $y (keys(%needed)) {
 490         pidl "static int $y = -1;\n", if $y =~ /^hf_/;
 491     }
 492
 493     pidl "\n";
 494
 495     foreach my $y (keys(%needed)) {
 496         pidl "static gint $y = -1;\n", if $y =~ /^ett_/;
 497     }
 498
 499     pidl "\n";
 500
 501     # Read through file
 502
 503     my $cur_fn = "";
 504
 505     while(<IN>) {
 506
 507         #
 508         # Regexps to do a first pass at removing stuff we aren't
 509         # interested in for ethereal parsers.
 510         #
 511
 512         next, if /^\#include \"includes.h\"/;
 513
 514         # Rewrite includes to packet-dcerpc-foo.h instead of ndr_foo.h
 515
 516         s/^\#include \".*?ndr_(.*?).h\"$/\#include \"packet-dcerpc-$1.h\"/smg;
 517
 518         if (/\.h\"$/) {
 519             pidl $_;
 520             foreach my $x (@{$idl}) {
 521                 if ($x->{TYPE} eq "INTERFACE") {
 522                     foreach my $y (@{$x->{INHERITED_DATA}}) {
 523                         if ($y->{TYPE} eq "TYPEDEF") {
 524                             ParseEnum($y->{DATA}), if $y->{DATA}{TYPE} eq "ENUM";
 525                         }
 526                     }
 527                 }
 528             }
 529             next;
 530         }
 531
 532         # Remove the NDR_CHECK() macro calls.  Ethereal take care of
 533         # this for us as part of the tvbuff_t structure.
 534
 535         s/NDR_CHECK\((.*)\)/$1/g;
 536
 537         # We're not interested in ndr_{print,push,size} functions so
 538         # just delete them.
 539
 540         next, if /^(static )?NTSTATUS ndr_push/ .. /^}/;
 541         next, if /^void ndr_print/ .. /^}/;
 542         next, if /^size_t ndr_size/ .. /^}/;
 543
 544         # Get rid of dcerpc interface structures and functions since
 545         # they are also not very interesting.
 546
 547         next, if /^static const struct dcerpc_interface_call/ .. /^};/;
 548         next, if /^static const char \* const [a-z]+_endpoint_strings/ ../^};/;
 549         next, if /^static const struct dcerpc_endpoint_list/ .. /^};/;
 550         next, if /^const struct dcerpc_interface_table/ .. /^};/;
 551         next, if /^static NTSTATUS dcerpc_ndr_[a-z]+_init/ .. /^}/;
 552         next, if /^NTSTATUS dcerpc_[a-z]+_init/ .. /^}/;
 553
 554         #
 555         # Remember which structure or function we are processing.
 556         #
 557
 558         $cur_fn = $1, if /NTSTATUS ndr_pull_(.*?)\(struct/;
 559
 560         # Skip functions we have marked as nopull
 561
 562         my $skip_fn = 0;
 563
 564         foreach my $f (keys(%{$nopull_typedefs})) {
 565             $skip_fn = 1, if $cur_fn eq $f;
 566         }
 567
 568         $cur_fn = "", if /^}/;
 569
 570         next, if $skip_fn;
 571
 572         #
 573         # OK start wrapping the ndr_pull functions that actually
 574         # implement the NDR decoding routines.  This mainly consists
 575         # of adding a couple of parameters to each function call.
 576         #
 577
 578         # Add proto tree and name argument to ndr_pull_ptr() calls.
 579
 580         s/(ndr_pull_ptr\(ndr,\ (&_ptr_([^\)]*?))\);)
 581             /ndr_pull_ptr(ndr, tree, "$3", $2);/smgx;
 582
 583         # Wrap ndr_pull_array_size() and ndr_pull_array_length()
 584         # functions.  Add leading space in front of first parameter so
 585         # we won't get caught by later regexps.
 586
 587         s/(ndr_pull_array_(size|length)\(ndr,\ ([^\)]*?)\);)
 588             /ndr_pull_array_$2( ndr, tree, $3);/smgx;
 589
 590         # Add tree argument to ndr_pull_array() and
 591         # ndr_pull_array_foo() calls.
 592
 593         s/(ndr_pull_array\(
 594            ndr,\
 595            ([^,]*?),\                                # NDR_SCALARS etc
 596            (\(void\ \*\*\)r->(in|out|)\.?([^,]*?)),\ # Pointer to array entries
 597            ([^\)].*?)\);)                            # All other arguments
 598             /ndr_pull_array( ndr, $2, tree, $3, $6);/smgx;
 599
 600         s/(ndr_pull_array_([^\(]*?)\(
 601            ndr,\
 602            ([^,]*?),\                               # NDR_SCALARS etc
 603            (r->((in|out).)?([^,]*?)),\              # Pointer to array elements
 604            (.*?)\);)                                # Number of elements
 605             /ndr_pull_array_$2( ndr, $3, tree, hf_${cur_fn}_$7_array, $4, $8);/smgx;
 606
 607         # Save ndr_pull_relative{1,2}() calls from being wrapped by the
 608         # proceeding regexp by adding a leading space.
 609
 610         s/ndr_pull_(relative1|relative2)\((.*?)\);/
 611             ndr_pull_$1( $2);/smgx;
 612
 613         # Enums
 614
 615         s/(^static\ NTSTATUS\ ndr_pull_(.+?),\ (enum\ .+?)\))
 616             /static NTSTATUS ndr_pull_$2, pidl_tree *tree, int hf, $3)/smgx;
 617         s/uint(8|16|32) v;/uint$1_t v;/smg;
 618         s/(ndr_pull_([^\)]*?)\(ndr,\ &v\);)
 619             /ndr_pull_$2(ndr, tree, hf, &v);/smgx;
 620
 621         s/(ndr_pull_([^\(]+?)\(ndr,\ &_level\);)
 622             /ndr_pull_$2(ndr, tree, hf_${cur_fn}_level, &_level);/smgx;
 623
 624         # Bitmaps
 625
 626         s/(^(static\ )?NTSTATUS\ ndr_pull_(.+?),\ uint(8|16|32)\ \*r\))
 627             /NTSTATUS ndr_pull_$3, pidl_tree *tree, int hf, uint$4_t *r)/smgx;
 628
 629         # Call ethereal wrappers for pull of scalar values in
 630         # structures and functions, e.g
 631         #
 632         # ndr_pull_uint32(ndr, &r->in.access_mask);
 633         # ndr_pull_uint32(ndr, &r->idx);
 634
 635         if (/(ndr_pull_([^\)]*?)\(ndr, (&?r->((in|out)\.)?([^\)]*?))\);)/) {
 636
 637             my $pull_type = "${cur_fn}_$6";
 638
 639             if (defined($needed{"hf_$2"})) {
 640                 $pull_type = "$2";
 641             }
 642
 643             s/(ndr_pull_([^\)]*?)
 644                \(ndr,\
 645                (&?r->((in|out)\.)?         # Function args contain leading junk
 646                 ([^\)]*?))                 # Element name
 647                \);)
 648                 /ndr_pull_$2(ndr, tree, hf_$pull_type, $3);/smgx;
 649         }
 650
 651         # Add tree and hf argument to pulls of "internal" scalars like
 652         # array sizes, levels, etc.
 653
 654         s/(ndr_pull_(uint32|uint16)\(
 655            ndr,\
 656            (&_([^\)]*?))        # Internal arg names have leading underscore
 657            \);)
 658             /ndr_pull_$2(ndr, tree, hf_$4, $3);/smgx;
 659
 660         # Add subtree argument to calls dissecting structures/unions, e.g
 661         #
 662         # ndr_pull_string(ndr, NDR_SCALARS|NDR_BUFFERS, &r->command);
 663         # ndr_pull_atsvc_enum_ctr(ndr, NDR_SCALARS|NDR_BUFFERS, r->in.ctr);
 664
 665         # Three argument version is for structures
 666
 667         if (/ndr_pull([^\)]*?)\(ndr, (NDR_[^,]*?), ([^,]*?)\);/) {
 668
 669             s/(ndr_pull_([^\)]*?)\(
 670                ndr,\
 671                (NDR_[^,]*?),\
 672                (&?r->(in|out|)\.?([^\(].*?))\);)
 673                 /ndr_pull_$2(ndr, $3, get_subtree(tree, \"$6\", ndr, ett_$2), $4);
 674             /smgx;
 675         }
 676
 677         # Four argument version if for unions
 678
 679         if (/ndr_pull([^\)]*?)\(ndr, (NDR_[SB][^,]*?), ([^,]*?), ([^,]*?)\);/) {
 680             s/(ndr_pull_([^\)]*?)\(
 681                ndr,\
 682                (NDR_[^,]*?),\
 683                (&?r->(in|out|)\.?([^\(].*?))\);)
 684                 /ndr_pull_$2(ndr, $3, get_subtree(tree, \"$2\", ndr, ett_$2), $4);
 685             /smgx;
 686         }
 687
 688         # Add proto_tree parameter to pull function prototypes, e.g
 689         #
 690         # static NTSTATUS ndr_pull_atsvc_JobInfo(struct ndr_pull *ndr,
 691         #         int ndr_flags, struct atsvc_JobInfo *r)
 692
 693         s/^((static\ )?NTSTATUS\ ndr_pull_([^\(]*?)\(
 694             struct\ ndr_pull\ \*ndr,\
 695             int\ (ndr_)?flags)
 696             /$1, proto_tree \*tree/smgx;
 697
 698         # Add proto_tree parameter to ndr_pull_subcontext_flags_fn()
 699
 700         s/(ndr_pull_subcontext_flags_fn\(ndr)(.*?);/$1, tree$2;/smg;
 701
 702         # Get rid of ndr_pull_error() calls for the moment. Ethereal
 703         # should take care of buffer overruns and inconsistent array
 704         # sizes for us but it would be nice to have some error text in
 705         # the dissection.
 706
 707         s/(return ndr_pull_error([^;]*?);)/return NT_STATUS_OK; \/\/ $1/smg;
 708
 709         # Rename proto_tree args to pidl_tree
 710
 711         s/(int (ndr_)?flags), proto_tree \*tree/$1, pidl_tree \*tree/smg;
 712
 713         # Rename struct ndr_pull to struct pidl_pull
 714
 715         s/struct ndr_pull \*ndr/struct pidl_pull \*ndr/smg;
 716
 717         # Fix some internal variable declarations
 718
 719         s/(u?)int(8|16|32) _level;/$1int$2_t _level;/smg;
 720         s/ndr_pull_([^\(]*)\(ndr,\ tree,\ hf_level,\ &_level\);
 721             /ndr_pull_$1(ndr, tree, hf_level_$1, &_level);/smgx;
 722
 723         # Set the end of a structure
 724
 725         s/(ndr_pull_struct_end.*)/$1\tproto_item_set_end(tree->proto_tree, ndr->tvb, ndr->offset);\n/smg;
 726
 727         pidl $_;
 728     }
 729
 730     # Function call table
 731
 732     foreach my $x (@{$idl}) {
 733         if ($x->{TYPE} eq "INTERFACE") {
 734             foreach my $y (@{$x->{"INHERITED_DATA"}}) {
 735                 ($y->{TYPE} eq "FUNCTION") && ParseFunctionPull($y);
 736             }
 737
 738             FunctionTable($x);
 739         }
 740     }
 741
 742     # Ethereal protocol registration
 743
 744     pidl "int proto_dcerpc_pidl_$module = -1;\n\n";
 745
 746     pidl "static gint ett_dcerpc_$module = -1;\n\n";
 747
 748     if (defined($if_uuid)) {
 749
 750         pidl "static e_uuid_t uuid_dcerpc_$module = {\n";
 751         pidl "\t0x" . substr($if_uuid, 1, 8);
 752         pidl ", 0x" . substr($if_uuid, 10, 4);
 753         pidl ", 0x" . substr($if_uuid, 15, 4) . ",\n";
 754         pidl "\t{ 0x" . substr($if_uuid, 20, 2);
 755         pidl ", 0x" . substr($if_uuid, 22, 2);
 756         pidl ", 0x" . substr($if_uuid, 25, 2);
 757         pidl ", 0x" . substr($if_uuid, 27, 2);
 758         pidl ", 0x" . substr($if_uuid, 29, 2);
 759         pidl ", 0x" . substr($if_uuid, 31, 2);
 760         pidl ", 0x" . substr($if_uuid, 33, 2);
 761         pidl ", 0x" . substr($if_uuid, 35, 2) . " }\n";
 762         pidl "};\n\n";
 763     }
 764
 765     if (defined($if_version)) {
 766         pidl "static guint16 ver_dcerpc_$module = " . $if_version . ";\n\n";
 767     }
 768
 769     pidl "void proto_register_dcerpc_pidl_$module(void)\n";
 770     pidl "{\n";
 771
 772     pidl "\tstatic hf_register_info hf[] = {\n";
 773     pidl "\t{ &hf_opnum, { \"Operation\", \"$module.opnum\", FT_UINT16, BASE_DEC, NULL, 0x0, \"Operation\", HFILL }},\n";
 774         pidl "\t{ &hf_result_NTSTATUS, { \"Return code\", \"$module.rc\", FT_UINT32, BASE_HEX, VALS(NT_errors), 0x0, \"Return status code\", HFILL }},\n";
 775     pidl "\t{ &hf_ptr, { \"Pointer\", \"$module.ptr\", FT_UINT32, BASE_HEX, NULL, 0x0, \"Pointer\", HFILL }},\n";
 776
 777     foreach my $x (keys(%needed)) {
 778         next, if !($x =~ /^hf_/);
 779         pidl "\t{ &$x,\n";
 780         $needed{$x}{strings} = "NULL", if !defined($needed{$x}{strings});
 781         $needed{$x}{bitmask} = "0", if !defined($needed{$x}{bitmask});
 782         pidl "\t  { \"$needed{$x}{name}\", \"$x\", $needed{$x}{ft}, $needed{$x}{base}, $needed{$x}{strings}, $needed{$x}{bitmask}, \"$x\", HFILL }},\n";
 783     }
 784
 785     pidl "\t};\n\n";
 786
 787     pidl "\tstatic gint *ett[] = {\n";
 788     pidl "\t\t&ett_dcerpc_$module,\n";
 789     foreach my $x (keys(%needed)) {
 790         pidl "\t\t&$x,\n", if $x =~ /^ett_/;
 791     }
 792     pidl "\t};\n\n";
 793
 794     if (defined($if_uuid)) {
 795
 796         # These can be changed to non-pidl names if the old dissectors
 797         # in epan/dissctors are deleted.
 798
 799         my $name = uc($module) . " (pidl)";
 800         my $short_name = "pidl_$module";
 801         my $filter_name = "pidl_$module";
 802
 803         pidl "\tproto_dcerpc_pidl_$module = proto_register_protocol(\"$name\", \"$short_name\", \"$filter_name\");\n\n";
 804
 805         pidl "\tproto_register_field_array(proto_dcerpc_pidl_$module, hf, array_length (hf));\n";
 806         pidl "\tproto_register_subtree_array(ett, array_length(ett));\n";
 807
 808         pidl "}\n\n";
 809
 810         pidl "void proto_reg_handoff_dcerpc_pidl_$module(void)\n";
 811         pidl "{\n";
 812         pidl "\tdcerpc_init_uuid(proto_dcerpc_pidl_$module, ett_dcerpc_$module, \n";
 813         pidl "\t\t&uuid_dcerpc_$module, ver_dcerpc_$module, \n";
 814         pidl "\t\tdcerpc_dissectors, hf_opnum);\n";
 815         pidl "}\n";
 816
 817     } else {
 818
 819         pidl "\tint proto_dcerpc;\n\n";
 820         pidl "\tproto_dcerpc = proto_get_id_by_filter_name(\"dcerpc\");\n";
 821         pidl "\tproto_register_field_array(proto_dcerpc, hf, array_length(hf));\n";
 822         pidl "\tproto_register_subtree_array(ett, array_length(ett));\n";
 823
 824         pidl "}\n";
 825
 826     }
 827
 828     close(OUT);
 829 }
 830
 831 1;