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