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