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
   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 # work out is a parse function should be declared static or not
  26 sub fn_prefix($)
  27 {
  28         my $fn = shift;
  29         if ($fn->{TYPE} eq "TYPEDEF") {
  30                 if (util::has_property($fn->{DATA}, "public")) {
  31                         return "";
  32                 }
  33         }
  34
  35         if ($fn->{TYPE} eq "FUNCTION") {
  36                 if (util::has_property($fn, "public")) {
  37                         return "";
  38                 }
  39         }
  40         return "static ";
  41 }
  42
  43
  44 #####################################################################
  45 # parse a function
  46 sub ParseFunctionPull($)
  47 {
  48         my($fn) = shift;
  49         my $static = fn_prefix($fn);
  50
  51         # request function
  52         pidl "int $fn->{NAME}_rqst(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *tree, guint8 *drep)\n{\n";
  53
  54         pidl "\tstruct pidl_pull *ndr = pidl_pull_init(tvb, offset, pinfo, drep);\n";
  55         pidl "\tstruct $fn->{NAME} *r = talloc_p(NULL, struct $fn->{NAME});\n";
  56         pidl "\tpidl_tree ptree;\n\n";
  57
  58         pidl "\tptree.proto_tree = tree;\n";
  59         pidl "\tptree.subtree_list = NULL;\n\n";
  60
  61         pidl "\tndr_pull_$fn->{NAME}(ndr, NDR_IN, &ptree, r);\n";
  62
  63         pidl "\n\treturn ndr->offset;\n";
  64         pidl "}\n\n";
  65
  66         # response function
  67         pidl "int $fn->{NAME}_resp(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *tree, guint8 *drep)\n{\n";
  68
  69         pidl "\tstruct pidl_pull *ndr = pidl_pull_init(tvb, offset, pinfo, drep);\n";
  70         pidl "\tstruct $fn->{NAME} *r = talloc_p(NULL, struct $fn->{NAME});\n";
  71         pidl "\tpidl_tree ptree;\n\n";
  72
  73         pidl "\tptree.proto_tree = tree;\n";
  74         pidl "\tptree.subtree_list = NULL;\n\n";
  75
  76         pidl "\tndr_pull_$fn->{NAME}(ndr, NDR_OUT, &ptree, r);\n";
  77
  78         pidl "\n\treturn ndr->offset;\n";
  79         pidl "}\n\n";
  80 }
  81
  82 #####################################################################
  83 # produce a function call table
  84 sub FunctionTable($)
  85 {
  86         my($interface) = shift;
  87         my($data) = $interface->{DATA};
  88
  89         pidl "static dcerpc_sub_dissector dcerpc_dissectors[] = {\n";
  90         my $num = 0;
  91         foreach my $d (@{$data}) {
  92                 if ($d->{TYPE} eq "FUNCTION") {
  93                     # Strip module name from function name, if present
  94                     my($n) = $d->{NAME};
  95                     $n = substr($d->{NAME}, length($module) + 1),
  96                         if $module eq substr($d->{NAME}, 0, length($module));
  97                     pidl "\t{ $num, \"$n\",\n";
  98                     pidl "\t\t$d->{NAME}_rqst,\n";
  99                     pidl "\t\t$d->{NAME}_resp },\n";
 100                     $num++;
 101                 }
 102         }
 103         pidl "};\n\n";
 104 }
 105
 106 sub type2ft($)
 107 {
 108     my($t) = shift;
 109
 110     return "FT_UINT32", if ($t eq "uint32");
 111     return "FT_UINT16", if ($t eq "uint16");
 112     return "FT_UINT8", if ($t eq "uint8");
 113     return "FT_BYTES";
 114 }
 115
 116 # Determine the display base for an element
 117
 118 sub elementbase($)
 119 {
 120     my($e) = shift;
 121
 122     if (my $base = util::has_property($e, "display")) {
 123         return "BASE_" . uc($base);
 124     }
 125
 126     return "BASE_DEC", if ($e->{TYPE} eq "uint32") or
 127         ($e->{TYPE} eq "uint16") or ($e->{TYPE} eq "uint8");
 128     return "BASE_NONE";
 129 }
 130
 131 # Convert a IDL structure field name (e.g access_mask) to a prettier
 132 # string like 'Access Mask'.
 133
 134 sub field2name($)
 135 {
 136     my($field) = shift;
 137
 138     $field =~ s/_/ /g;          # Replace underscores with spaces
 139     $field =~ s/(\w+)/\u\L$1/g; # Capitalise each word
 140
 141     return $field;
 142 }
 143
 144 sub NeededFunction($)
 145 {
 146         my $fn = shift;
 147         $needed{"pull_$fn->{NAME}"} = 1;
 148         foreach my $e (@{$fn->{DATA}}) {
 149                 $e->{PARENT} = $fn;
 150                 $needed{"pull_$e->{TYPE}"} = 1;
 151
 152                 if (util::is_scalar_type($e->{TYPE})) {
 153                     $needed{"hf_$e->{NAME}_$e->{TYPE}"} = {
 154                         'name' => field2name($e->{NAME}),
 155                         'type' => $e->{TYPE},
 156                         'ft'   => type2ft($e->{TYPE}),
 157                         'base' => elementbase($e)
 158                         }, if !defined($needed{"hf_$e->{NAME}_$e->{TYPE}"});
 159                     $e->{PARENT} = $fn;
 160                 } else {
 161                     $needed{"ett_$e->{TYPE}"} = 1;
 162                 }
 163         }
 164 }
 165
 166 sub NeededTypedef($)
 167 {
 168         my $t = shift;
 169         if (util::has_property($t->{DATA}, "public")) {
 170                 $needed{"pull_$t->{NAME}"} = 1;
 171         }
 172
 173         if ($t->{DATA}->{TYPE} eq "STRUCT") {
 174
 175             for my $e (@{$t->{DATA}->{ELEMENTS}}) {
 176                 $e->{PARENT} = $t->{DATA};
 177                 if ($needed{"pull_$t->{NAME}"}) {
 178                     $needed{"pull_$e->{TYPE}"} = 1;
 179                 }
 180
 181                 if (util::is_scalar_type($e->{TYPE})) {
 182
 183                     if (defined($e->{ARRAY_LEN}) or
 184                         util::has_property($e, "size_is")) {
 185
 186                         # Arrays of scalar types are FT_BYTES
 187
 188                         $needed{"hf_$e->{NAME}_$e->{TYPE}_array"} = {
 189                             'name' => field2name($e->{NAME}),
 190                             'type' => $e->{TYPE},
 191                             'ft'   => "FT_BYTES",
 192                             'base' => elementbase($e)
 193                             };
 194
 195                     } else {
 196                         $needed{"hf_$e->{NAME}_$e->{TYPE}"} = {
 197                             'name' => field2name($e->{NAME}),
 198                             'type' => $e->{TYPE},
 199                             'ft'   => type2ft($e->{TYPE}),
 200                             'base' => elementbase($e)
 201                             };
 202                     }
 203
 204                     $e->{PARENT} = $t->{DATA};
 205
 206                     if ($needed{"pull_$t->{NAME}"}) {
 207                         $needed{"pull_$e->{TYPE}"} = 1;
 208                     }
 209
 210                 } else {
 211
 212                     $needed{"ett_$e->{TYPE}"} = 1;
 213
 214                 }
 215             }
 216         }
 217
 218         if ($t->{DATA}->{TYPE} eq "UNION") {
 219                 for my $e (@{$t->{DATA}->{DATA}}) {
 220                         $e->{PARENT} = $t->{DATA};
 221                         if ($e->{TYPE} eq "UNION_ELEMENT") {
 222                                 if ($needed{"pull_$t->{NAME}"}) {
 223                                         $needed{"pull_$e->{DATA}->{TYPE}"} = 1;
 224                                 }
 225                                 $needed{"ett_$e->{DATA}{TYPE}"} = 1;
 226                         }
 227                 }
 228
 229             $needed{"ett_$t->{NAME}"} = 1;
 230         }
 231 }
 232
 233 #####################################################################
 234 # work out what parse functions are needed
 235 sub BuildNeeded($)
 236 {
 237         my($interface) = shift;
 238         my($data) = $interface->{DATA};
 239         foreach my $d (@{$data}) {
 240                 ($d->{TYPE} eq "FUNCTION") &&
 241                     NeededFunction($d);
 242         }
 243         foreach my $d (reverse @{$data}) {
 244                 ($d->{TYPE} eq "TYPEDEF") &&
 245                     NeededTypedef($d);
 246         }
 247 }
 248
 249 #####################################################################
 250 # parse the interface definitions
 251 sub ModuleHeader($)
 252 {
 253     my($h) = shift;
 254
 255     $if_uuid = $h->{PROPERTIES}->{uuid};
 256     $if_version = $h->{PROPERTIES}->{version};
 257     $if_endpoints = $h->{PROPERTIES}->{endpoints};
 258 }
 259
 260 #####################################################################
 261 # Generate a header file that contains function prototypes for
 262 # structs and typedefs.
 263 sub ParseHeader($$)
 264 {
 265         my($idl) = shift;
 266         my($filename) = shift;
 267
 268         open(OUT, ">$filename") || die "can't open $filename";
 269
 270         pidl "/* parser auto-generated by pidl */\n\n";
 271
 272         foreach my $x (@{$idl}) {
 273             if ($x->{TYPE} eq "INTERFACE") {
 274                 foreach my $d (@{$x->{DATA}}) {
 275
 276                     # Make prototypes for [public] structures and
 277                     # unions.
 278
 279                     if ($d->{TYPE} eq "TYPEDEF" and
 280                         util::has_property($d->{DATA}, "public")) {
 281
 282                         if ($d->{DATA}{TYPE} eq "STRUCT") {
 283                             pidl "void ndr_pull_$d->{NAME}(struct ndr_pull *ndr, int ndr_flags, proto_tree *tree, struct $d->{NAME} *r);\n\n";
 284                         }
 285
 286                         if ($d->{DATA}{TYPE} eq "UNION") {
 287                             pidl "void ndr_pull_$d->{NAME}(struct ndr_pull *ndr, int ndr_flags, proto_tree *tree, union $d->{NAME} *r, uint16 level);\n\n";
 288                         }
 289                     }
 290                 }
 291             }
 292         }
 293
 294         close(OUT);
 295 }
 296
 297 #####################################################################
 298 # rewrite autogenerated header file
 299 sub RewriteHeader($$$)
 300 {
 301     my($idl) = shift;
 302     my($input) = shift;
 303     my($output) = shift;
 304
 305     %needed = ();
 306
 307     # Open files
 308
 309     open(IN, "<$input") || die "can't open $input for reading";
 310     open(OUT, ">$output") || die "can't open $output for writing";
 311
 312     # Read in entire file
 313
 314     undef $/;
 315
 316     while(<IN>) {
 317
 318         # Not interested in ndr_push or ndr_print routines as they
 319         # define structures we aren't interested in.
 320
 321         s/^NTSTATUS ndr_push.*?;\n//smg;
 322         s/^void ndr_print.*?;\n//smg;
 323
 324         # Get rid of async send and receive function.
 325
 326         s/^NTSTATUS dcerpc_.*?;\n//smg;
 327         s/^struct rpc_request.*?;\n\n//smg;
 328
 329         # Rewrite librpc includes
 330
 331         s/^\#include \"librpc\/gen_ndr\/ndr_(.*?).h\"$/\#include \"packet-dcerpc-$1.h\"/smg;
 332
 333         # Convert samba fixed width types to stdint types
 334
 335         s/((u)?int)([0-9]+)/$1$3_t/smg;
 336
 337         # Rename struct ndr_pull to struct pidl_pull
 338
 339         s/struct ndr_pull \*ndr/struct pidl_pull \*ndr/smg;
 340
 341         # Change prototypes for public functions
 342
 343         s/(struct pidl_pull \*ndr, int ndr_flags)/$1, pidl_tree *tree/smg;
 344
 345         pidl $_;
 346     }
 347
 348     close(OUT);
 349 }
 350
 351 #####################################################################
 352 # rewrite autogenerated C file
 353 sub RewriteC($$$)
 354 {
 355     my($idl) = shift;
 356     my($input) = shift;
 357     my($output) = shift;
 358
 359     # Open files
 360
 361     open(IN, "<$input") || die "can't open $input for reading";
 362     open(OUT, ">$output") || die "can't open $output for writing";
 363
 364     # Get name of module
 365
 366     foreach my $x (@{$idl}) {
 367         if ($x->{TYPE} eq "INTERFACE") {
 368             ModuleHeader($x);
 369             $module = $x->{NAME};
 370             BuildNeeded($x);
 371         }
 372     }
 373
 374     pidl "#include \"eparser.h\"\n\n";
 375
 376     pidl "extern const value_string NT_errors[];\n\n";
 377
 378     # Declarations for hf variables
 379
 380     pidl "static int hf_opnum = -1;\n";
 381     pidl "static int hf_ptr = -1;\n";
 382     pidl "static int hf_array_size = -1;\n";
 383     pidl "static int hf_result_NTSTATUS = -1;\n";
 384
 385     foreach my $y (keys(%needed)) {
 386         pidl "static int $y = -1;\n", if $y =~ /^hf_/;
 387     }
 388
 389     pidl "\n";
 390
 391     foreach my $y (keys(%needed)) {
 392         pidl "static gint $y = -1;\n", if $y =~ /^ett_/;
 393     }
 394
 395     pidl "\n";
 396
 397     # Read in entire file for post-processing
 398
 399     undef $/;
 400
 401     while(<IN>) {
 402
 403         # Ethereal take care of this for us.  It also makes the other
 404         # regular expressions easier to write and understand.
 405
 406         s/NDR_CHECK\((.*)\)/$1/g;
 407
 408         # We're not interested in ndr_print or ndr_push functions.
 409
 410         s/^(static )?NTSTATUS (ndr_push[^\(]+).*?^\}\n\n//smg;
 411         s/^void (ndr_print[^\(]+).*?^\}\n\n//smg;
 412
 413         # Get rid of dcerpc interface structures and functions
 414
 415         s/^static const struct dcerpc_interface_call .*?^\};\n\n//smg;
 416         s/^static const char \* const ([a-z]+)_endpoint_strings.*?^\};\n\n//smg;
 417         s/^static const struct dcerpc_endpoint_list .*?^\};\n\n\n//smg;
 418         s/^const struct dcerpc_interface_table .*?^\};\n\n//smg;
 419         s/^static NTSTATUS dcerpc_ndr_([a-z]+)_init.*?^\}\n\n//smg;
 420         s/^NTSTATUS dcerpc_([a-z]+)_init.*?^\}\n\n//smg;
 421
 422         # Include packet-dcerpc-foo.h instead of ndr_foo.h
 423
 424         s/^\#include \".*?ndr_(.*?).h\"$/\#include \"packet-dcerpc-$1.h\"/smg;
 425
 426         # Call ethereal wrapper for ndr_pull_ptr() function.
 427
 428         s/(ndr_pull_ptr\(ndr, ([^\)]*?)\);)/ndr_pull_ptr(ndr, tree, hf_ptr, $2);/smg;
 429
 430         # Wrap ndr_pull_array_size() - generate wrapper that won't get
 431         # caught by the regex for wrapping scalar values below (i.e
 432         # the leading space in front of the first parameter).
 433
 434         s/(ndr_pull_array_(size|length)\(ndr, ([^\)]*?)\);)/ndr_pull_array_$2( ndr, tree, $3);/smg;
 435
 436         # Add tree argument to ndr_pull_array()
 437
 438         s/(ndr_pull_array([^\(_]*?)\(ndr, (NDR_[^,]*?), ([^\)].*?)\);)/ndr_pull_array$2( ndr, $3, tree, $4);/smg;
 439
 440         s/(ndr_pull_array_([^\(]*?)\(ndr, (NDR_[^,]*?), (r->((in|out).)?([^,]*?)), (.*?)\);)/ndr_pull_array_$2( ndr, $3, tree, hf_$7_$2_array, $4, $8);/smg;
 441
 442         # Save ndr_pull_relative[12]() calls from being wrapped by the
 443         # proceeding regexp.
 444
 445         s/ndr_pull_(relative1|relative2)\((.*?);/ndr_pull_$1( $2;/smg;
 446
 447         # Call ethereal wrappers for pull of scalar values in
 448         # structures and functions:
 449         #
 450         # ndr_pull_uint32(ndr, &r->in.access_mask);
 451         # ndr_pull_uint32(ndr, &r->idx);
 452
 453         s/(ndr_pull_([^\)]*?)\(ndr, (&?r->((in|out)\.)?([^\)]*?))\);)/ndr_pull_$2(ndr, tree, hf_$6_$2, $3);/smg;
 454
 455         # Pull of "internal" scalars like array sizes, levels, etcetera.
 456
 457         s/(ndr_pull_(uint32|uint16)\(ndr, (&_([^\)]*?))\);)/ndr_pull_$2(ndr, tree, hf_$4, $3);/smg;
 458
 459         # Call ethereal wrappers for pull of buffers in structures and
 460         # functions:
 461         #
 462         # ndr_pull_string(ndr, NDR_SCALARS|NDR_BUFFERS, &r->command);
 463         # ndr_pull_atsvc_enum_ctr(ndr, NDR_SCALARS|NDR_BUFFERS, r->in.ctr);
 464
 465         s/(ndr_pull_([^\)]*?)\(ndr, (NDR_[^,]*?), ([^\(].*?)\);)/ndr_pull_$2(ndr, $3, get_subtree(tree, \"$2\", ndr, ett_$2), $4);/smg;
 466
 467         # Add proto_tree parameter to pull functions:
 468         #
 469         # static NTSTATUS ndr_pull_atsvc_JobInfo(struct ndr_pull *ndr, int ndr_flags, struct atsvc_JobInfo *r)
 470
 471         s/^((static )?NTSTATUS ndr_pull_([^\(]*?)\(struct ndr_pull \*ndr, int (ndr_)?flags)/$1, proto_tree \*tree/smg;
 472
 473         # Add proto_tree parameter to ndr_pull_subcontext_flags_fn()
 474
 475         s/(ndr_pull_subcontext_flags_fn\(ndr)(.*?);/$1, tree$2;/smg;
 476
 477         # Get rid of ndr_pull_error() calls.  Ethereal should take
 478         # care of buffer overruns and inconsistent array sizes for us.
 479
 480         s/(return ndr_pull_error([^;]*?);)/return NT_STATUS_OK; \/\/ $1/smg;
 481
 482         # Rename proto_tree args to pidl_tree
 483
 484         s/(int (ndr_)?flags), proto_tree \*tree/$1, pidl_tree \*tree/smg;
 485
 486         # Rename struct ndr_pull to struct pidl_pull
 487
 488         s/struct ndr_pull \*ndr/struct pidl_pull \*ndr/smg;
 489
 490         # Fix some internal variable declarations
 491
 492         s/uint(16|32) _level/uint$1_t _level/smg;
 493         s/ndr_pull_([^\(]*)\(ndr, tree, hf_level, &_level\);/ndr_pull_$1(ndr, tree, hf_level_$1, &_level);/smg;
 494
 495         pidl $_;
 496     }
 497
 498     # Function call table
 499
 500     foreach my $x (@{$idl}) {
 501         if ($x->{TYPE} eq "INTERFACE") {
 502             foreach my $y (@{$x->{"INHERITED_DATA"}}) {
 503                 ($y->{TYPE} eq "FUNCTION") && ParseFunctionPull($y);
 504             }
 505
 506             FunctionTable($x);
 507         }
 508     }
 509
 510     # Ethereal protocol registration
 511
 512     pidl "int proto_dcerpc_pidl_$module = -1;\n\n";
 513
 514     pidl "static gint ett_dcerpc_$module = -1;\n\n";
 515
 516     if (defined($if_uuid)) {
 517
 518         pidl "static e_uuid_t uuid_dcerpc_$module = {\n";
 519         pidl "\t0x" . substr($if_uuid, 1, 8);
 520         pidl ", 0x" . substr($if_uuid, 10, 4);
 521         pidl ", 0x" . substr($if_uuid, 15, 4) . ",\n";
 522         pidl "\t{ 0x" . substr($if_uuid, 20, 2);
 523         pidl ", 0x" . substr($if_uuid, 22, 2);
 524         pidl ", 0x" . substr($if_uuid, 25, 2);
 525         pidl ", 0x" . substr($if_uuid, 27, 2);
 526         pidl ", 0x" . substr($if_uuid, 29, 2);
 527         pidl ", 0x" . substr($if_uuid, 31, 2);
 528         pidl ", 0x" . substr($if_uuid, 33, 2);
 529         pidl ", 0x" . substr($if_uuid, 35, 2) . " }\n";
 530         pidl "};\n\n";
 531     }
 532
 533     if (defined($if_version)) {
 534         pidl "static guint16 ver_dcerpc_$module = " . $if_version . ";\n\n";
 535     }
 536
 537     pidl "void proto_register_dcerpc_pidl_$module(void)\n";
 538     pidl "{\n";
 539
 540     pidl "\tstatic hf_register_info hf[] = {\n";
 541     pidl "\t{ &hf_opnum, { \"Operation\", \"$module.opnum\", FT_UINT16, BASE_DEC, NULL, 0x0, \"Operation\", HFILL }},\n";
 542         pidl "\t{ &hf_result_NTSTATUS, { \"Return code\", \"$module.rc\", FT_UINT32, BASE_HEX, VALS(NT_errors), 0x0, \"Return status code\", HFILL }},\n";
 543     pidl "\t{ &hf_ptr, { \"Pointer\", \"$module.ptr\", FT_UINT32, BASE_HEX, NULL, 0x0, \"Pointer\", HFILL }},\n";
 544
 545     foreach my $x (keys(%needed)) {
 546         next, if !($x =~ /^hf_/);
 547         pidl "\t{ &$x,\n";
 548         pidl "\t  { \"$needed{$x}{name}\", \"$x\", $needed{$x}{ft}, $needed{$x}{base}, NULL, 0, \"$x\", HFILL }},\n";
 549     }
 550
 551     pidl "\t};\n\n";
 552
 553     pidl "\tstatic gint *ett[] = {\n";
 554     pidl "\t\t&ett_dcerpc_$module,\n";
 555     foreach my $x (keys(%needed)) {
 556         pidl "\t\t&$x,\n", if $x =~ /^ett_/;
 557     }
 558     pidl "\t};\n\n";
 559
 560     if (defined($if_uuid)) {
 561
 562         pidl "\tproto_dcerpc_pidl_$module = proto_register_protocol(\"pidl_$module\", \"pidl_$module\", \"pidl_$module\");\n\n";
 563
 564         pidl "\tproto_register_field_array(proto_dcerpc_pidl_$module, hf, array_length (hf));\n";
 565         pidl "\tproto_register_subtree_array(ett, array_length(ett));\n";
 566
 567         pidl "}\n\n";
 568
 569         pidl "void proto_reg_handoff_dcerpc_pidl_$module(void)\n";
 570         pidl "{\n";
 571         pidl "\tdcerpc_init_uuid(proto_dcerpc_pidl_$module, ett_dcerpc_$module, \n";
 572         pidl "\t\t&uuid_dcerpc_$module, ver_dcerpc_$module, \n";
 573         pidl "\t\tdcerpc_dissectors, hf_opnum);\n";
 574         pidl "}\n";
 575
 576     } else {
 577
 578         pidl "\tint proto_dcerpc;\n\n";
 579         pidl "\tproto_dcerpc = proto_get_id_by_filter_name(\"dcerpc\");\n";
 580         pidl "\tproto_register_field_array(proto_dcerpc, hf, array_length(hf));\n";
 581         pidl "\tproto_register_subtree_array(ett, array_length(ett));\n";
 582
 583         pidl "}\n";
 584
 585     }
 586
 587     close(OUT);
 588 }
 589
 590 1;