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
   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 %structs;
  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 # parse a properties list
  27 sub ParseProperties($)
  28 {
  29     my($props) = shift;
  30     foreach my $d (@{$props}) {
  31         if (ref($d) ne "HASH") {
  32             pidl "[$d] ";
  33         } else {
  34             foreach my $k (keys %{$d}) {
  35                 pidl "[$k($d->{$k})] ";
  36             }
  37         }
  38     }
  39 }
  40
  41 ###################################
  42 # find a sibling var in a structure
  43 sub find_sibling($$)
  44 {
  45         my($e) = shift;
  46         my($name) = shift;
  47         my($fn) = $e->{PARENT};
  48
  49         if ($name =~ /\*(.*)/) {
  50                 $name = $1;
  51         }
  52
  53         if ($fn->{TYPE} eq "FUNCTION") {
  54                 for my $e2 (@{$fn->{DATA}}) {
  55                         if ($e2->{NAME} eq $name) {
  56                                 return $e2;
  57                         }
  58                 }
  59         }
  60
  61         for my $e2 (@{$fn->{ELEMENTS}}) {
  62                 if ($e2->{NAME} eq $name) {
  63                         return $e2;
  64                 }
  65         }
  66         die "invalid sibling '$name'";
  67 }
  68
  69 ####################################################################
  70 # work out the name of a size_is() variable
  71 sub find_size_var($$)
  72 {
  73         my($e) = shift;
  74         my($size) = shift;
  75
  76         my($fn) = $e->{PARENT};
  77
  78         if (util::is_constant($size)) {
  79                 return $size;
  80         }
  81
  82         if ($size =~ /ndr->|\(/) {
  83             return $size;
  84         }
  85
  86         my $prefix = "";
  87
  88         if ($size =~ /\*(.*)/) {
  89                 $size = $1;
  90                 $prefix = "*";
  91         }
  92
  93         if ($fn->{TYPE} ne "FUNCTION") {
  94                 return $prefix . "elt_$size";
  95         }
  96
  97         my $e2 = find_sibling($e, $size);
  98
  99         if (util::has_property($e2, "in") && util::has_property($e2, "out")) {
 100                 return $prefix . "elt_$size";
 101         }
 102         if (util::has_property($e2, "in")) {
 103                 return $prefix . "elt_$size";
 104         }
 105         if (util::has_property($e2, "out")) {
 106                 return $prefix . "elt_$size";
 107         }
 108
 109         die "invalid variable in $size for element $e->{NAME} in $fn->{NAME}\n";
 110 }
 111
 112
 113 #####################################################################
 114 # work out is a parse function should be declared static or not
 115 sub fn_prefix($)
 116 {
 117         my $fn = shift;
 118         if ($fn->{TYPE} eq "TYPEDEF") {
 119                 if (util::has_property($fn->{DATA}, "public")) {
 120                         return "";
 121                 }
 122         }
 123
 124         if ($fn->{TYPE} eq "FUNCTION") {
 125                 if (util::has_property($fn, "public")) {
 126                         return "";
 127                 }
 128         }
 129         return "static ";
 130 }
 131
 132
 133 ###################################################################
 134 # setup any special flags for an element or structure
 135 sub start_flags($)
 136 {
 137         my $e = shift;
 138         my $flags = util::has_property($e, "flag");
 139         if (defined $flags) {
 140                 pidl "\t{ guint32 _flags_save_$e->{TYPE} = ndr->flags;\n";
 141                 pidl "\tndr->flags |= $flags;\n";
 142         }
 143 }
 144
 145 ###################################################################
 146 # end any special flags for an element or structure
 147 sub end_flags($)
 148 {
 149         my $e = shift;
 150         my $flags = util::has_property($e, "flag");
 151         if (defined $flags) {
 152                 pidl "\tndr->flags = _flags_save_$e->{TYPE};\n\t}\n";
 153         }
 154 }
 155
 156
 157 #####################################################################
 158 # work out the correct alignment for a structure
 159 sub struct_alignment
 160 {
 161         my $s = shift;
 162
 163         my $align = 1;
 164         for my $e (@{$s->{ELEMENTS}}) {
 165                 my $a = 1;
 166
 167                 if (!util::need_wire_pointer($e)
 168                     && defined $structs{$e->{TYPE}}) {
 169                         if ($structs{$e->{TYPE}}->{DATA}->{TYPE} eq "STRUCT") {
 170                                 $a = struct_alignment($structs{$e->{TYPE}}->{DATA});
 171                         } elsif ($structs{$e->{TYPE}}->{DATA}->{TYPE} eq "UNION") {
 172                                 if (defined $structs{$e->{TYPE}}->{DATA}) {
 173                                         $a = union_alignment($structs{$e->{TYPE}}->{DATA});
 174                                 }
 175                         }
 176                 } else {
 177                         $a = util::type_align($e);
 178                 }
 179
 180                 if ($align < $a) {
 181                         $align = $a;
 182                 }
 183         }
 184
 185         return $align;
 186 }
 187
 188 #####################################################################
 189 # work out the correct alignment for a union
 190 sub union_alignment
 191 {
 192         my $u = shift;
 193
 194         my $align = 1;
 195
 196         foreach my $e (@{$u->{DATA}}) {
 197                 my $a = 1;
 198
 199                 if ($e->{TYPE} eq "EMPTY") {
 200                         next;
 201                 }
 202
 203                 if (!util::need_wire_pointer($e)
 204                     && defined $structs{$e->{DATA}->{TYPE}}) {
 205                         my $s = $structs{$e->{DATA}->{TYPE}};
 206                         if ($s->{DATA}->{TYPE} eq "STRUCT") {
 207                                 $a = struct_alignment($s->{DATA});
 208                         } elsif ($s->{DATA}->{TYPE} eq "UNION") {
 209                                 $a = union_alignment($s->{DATA});
 210                         }
 211                 } else {
 212                         $a = util::type_align($e->{DATA});
 213                 }
 214
 215                 if ($align < $a) {
 216                         $align = $a;
 217                 }
 218         }
 219
 220         return $align;
 221 }
 222
 223 #####################################################################
 224 # parse an array - pull side
 225 sub ParseArrayPull($$)
 226 {
 227         my $e = shift;
 228         my $ndr_flags = shift;
 229
 230         my $size = find_size_var($e, util::array_size($e));
 231         my $alloc_size = $size;
 232
 233         # if this is a conformant array then we use that size to allocate, and make sure
 234         # we allocate enough to pull the elements
 235         if (defined $e->{CONFORMANT_SIZE}) {
 236                 $alloc_size = $e->{CONFORMANT_SIZE};
 237
 238                 pidl "\tif ($size > $alloc_size) {\n";
 239                 pidl "\t\tproto_tree_add_text(subtree, ndr->tvb, ndr->offset, 0, \"Bad conformant size (%u should be %u)\", $alloc_size, $size);\n";
 240                 pidl "\t\tif (check_col(ndr->pinfo->cinfo, COL_INFO))\n";
 241                 pidl "\t\t\tcol_append_fstr(ndr->pinfo->cinfo, COL_INFO, \", Bad conformant size\", $alloc_size, $size);\n";
 242                 pidl "\t\treturn;\n";
 243                 pidl "\t}\n";
 244         } elsif (!util::is_inline_array($e)) {
 245 #               if ($var_prefix =~ /^r->out/ && $size =~ /^\*r->in/) {
 246 #                       my $size2 = substr($size, 1);
 247 #                       pidl "if (ndr->flags & LIBNDR_FLAG_REF_ALLOC) { NDR_ALLOC(ndr, $size2); }\n";
 248 #               }
 249
 250                 # non fixed arrays encode the size just before the array
 251                 pidl "\t{\n";
 252                 pidl "\t\tguint32 _array_size;\n\n";
 253                 pidl "\t\tndr_pull_uint32(ndr, subtree, hf_array_size, &_array_size);\n";
 254                 if ($size =~ /r->in/) {
 255                         pidl "\t\tif (!(ndr->flags & LIBNDR_FLAG_REF_ALLOC) && _array_size != $size) {\n";
 256                 } else {
 257                         pidl "\t\tif ($size != _array_size) {\n";
 258                 }
 259                 pidl "\t\t\tproto_tree_add_text(subtree, ndr->tvb, ndr->offset, 0, \"Bad array size (%u should be %u)\", _array_size, $size);\n";
 260                 pidl "\t\t\tif (check_col(ndr->pinfo->cinfo, COL_INFO))\n";
 261                 pidl "\t\t\t\tcol_append_fstr(ndr->pinfo->cinfo, COL_INFO, \", Bad array size\", _array_size, $size);\n";
 262                 pidl "\t\t\treturn;\n";
 263                 pidl "\t\t}\n";
 264                 if ($size =~ /r->in/) {
 265                         pidl "else { $size = _array_size; }\n";
 266                 }
 267                 pidl "\t}\n";
 268         }
 269
 270 #       if ((util::need_alloc($e) && !util::is_fixed_array($e)) ||
 271 #           ($var_prefix eq "r->in." && util::has_property($e, "ref"))) {
 272 #               if (!util::is_inline_array($e) || $ndr_flags eq "NDR_SCALARS") {
 273 #                       pidl "\t\tNDR_ALLOC_N(ndr, $var_prefix$e->{NAME}, MAX(1, $alloc_size));\n";
 274 #               }
 275 #       }
 276
 277 #       if (($var_prefix eq "r->out." && util::has_property($e, "ref"))) {
 278 #               if (!util::is_inline_array($e) || $ndr_flags eq "NDR_SCALARS") {
 279 #                       pidl "\tif (ndr->flags & LIBNDR_FLAG_REF_ALLOC) {";
 280 #                       pidl "\t\tNDR_ALLOC_N(ndr, $var_prefix$e->{NAME}, MAX(1, $alloc_size));\n";
 281 #                       pidl "\t}\n";
 282 #               }
 283 #       }
 284
 285         pidl "\t{\n";
 286
 287         if (my $length = util::has_property($e, "length_is")) {
 288                 $length = find_size_var($e, $length);
 289                 pidl "\t\tguint32 _offset, _length;\n";
 290                 pidl "\t\tndr_pull_uint32(ndr, subtree, hf_array_offset, &_offset);\n";
 291                 pidl "\t\tndr_pull_uint32(ndr, subtree, hf_array_length, &_length);\n";
 292                 pidl "\t\tif (_offset != 0) {\n";
 293                 pidl "\t\t\tproto_tree_add_text(subtree, ndr->tvb, ndr->offset, 0, \"Bad array offset %d\", _offset);\n";
 294                 pidl "\t\t\tif (check_col(ndr->pinfo->cinfo, COL_INFO))\n";
 295                 pidl "\t\t\t\tcol_append_fstr(ndr->pinfo->cinfo, COL_INFO, \"Bad array offset %d\", _offset);\n";
 296                 pidl "\t\t\treturn;\n";
 297                 pidl "\t\t}\n";
 298                 pidl "\t\tif (_length > $size || _length != $length) {\n";
 299                 pidl "\t\t\tproto_tree_add_text(subtree, ndr->tvb, ndr->offset, 0, \"Bad array length %d > size %d\", _offset, $size);\n";
 300                 pidl "\t\t\tif (check_col(ndr->pinfo->cinfo, COL_INFO))\n";
 301                 pidl "\t\t\t\tcol_append_fstr(ndr->pinfo->cinfo, COL_INFO, \", Bad array length %d > size %d\", _offset, $size);\n";
 302                 pidl "\t\t\treturn;\n";
 303                 pidl "\t\t}\n";
 304                 $size = "_length";
 305         }
 306
 307         if (util::is_scalar_type($e->{TYPE})) {
 308                 pidl "\t\tndr_pull_array_$e->{TYPE}(ndr, subtree, hf_$e->{NAME}_$e->{TYPE}, $ndr_flags, $size);\n";
 309         } else {
 310                 pidl "\t\tndr_pull_array(ndr, subtree, $ndr_flags, $size, ndr_pull_$e->{TYPE});\n";
 311         }
 312
 313         pidl "\t}\n";
 314 }
 315
 316
 317 #####################################################################
 318 # parse scalars in a structure element - pull size
 319 sub ParseElementPullSwitch($$$)
 320 {
 321         my($e) = shift;
 322         my($ndr_flags) = shift;
 323         my $switch = shift;
 324         my $switch_var = find_size_var($e, $switch);
 325
 326         my $cprefix = util::c_pull_prefix($e);
 327
 328         my $utype = $structs{$e->{TYPE}};
 329         if (!defined $utype ||
 330             !util::has_property($utype->{DATA}, "nodiscriminant")) {
 331                 my $e2 = find_sibling($e, $switch);
 332                 pidl "\tguint16 _level;\n";
 333                 pidl "\tif (($ndr_flags) & NDR_SCALARS) {\n";
 334                 pidl "\t\tndr_pull_level(ndr, subtree, hf_level, &_level);\n";
 335                 pidl "\t}\n";
 336         }
 337
 338         my $sub_size = util::has_property($e, "subcontext");
 339         if (defined $sub_size) {
 340                 pidl "\tndr_pull_subcontext_union_fn(ndr, subtree, $sub_size, $switch_var, (ndr_pull_union_fn_t) ndr_pull_$e->{TYPE});\n";
 341         } else {
 342                 pidl "\tndr_pull_$e->{TYPE}(ndr, subtree, $ndr_flags, _level);\n";
 343         }
 344
 345
 346 }
 347
 348 #####################################################################
 349 # parse scalars in a structure element - pull size
 350 sub ParseElementPullScalar($$)
 351 {
 352         my($e) = shift;
 353         my($ndr_flags) = shift;
 354         my $cprefix = util::c_pull_prefix($e);
 355         my $sub_size = util::has_property($e, "subcontext");
 356
 357         start_flags($e);
 358
 359         if (util::has_property($e, "relative")) {
 360                 pidl "\tndr_pull_relative(ndr, subtree, ndr_pull_$e->{TYPE});\n";
 361         } elsif (util::is_inline_array($e)) {
 362                 ParseArrayPull($e, "NDR_SCALARS");
 363         } elsif (util::need_wire_pointer($e)) {
 364                 pidl "\tndr_pull_ptr(ndr, subtree, hf_ptr, &ptr_$e->{NAME});\n";
 365 #               pidl "\tif (ptr_$e->{NAME}) {\n";
 366 #               pidl "\t\tNDR_ALLOC(ndr, $var_prefix$e->{NAME});\n";
 367 #               pidl "\t} else {\n";
 368 #               pidl "\t\t$var_prefix$e->{NAME} = NULL;\n";
 369 #               pidl "\t}\n";
 370         } elsif (util::need_alloc($e)) {
 371                 # no scalar component
 372         } elsif (my $switch = util::has_property($e, "switch_is")) {
 373                 ParseElementPullSwitch($e, $ndr_flags, $switch);
 374         } elsif (defined $sub_size) {
 375                 if (util::is_builtin_type($e->{TYPE})) {
 376                         pidl "\tndr_pull_subcontext_fn(ndr, subtree, $sub_size, (ndr_pull_fn_t) ndr_pull_$e->{TYPE});\n";
 377                 } else {
 378                         pidl "\tndr_pull_subcontext_flags_fn(ndr, subtree, $sub_size, (ndr_pull_flags_fn_t) ndr_pull_$e->{TYPE});\n";
 379                 }
 380             } elsif (util::is_builtin_type($e->{TYPE})) {
 381                 pidl "\tndr_pull_$e->{TYPE}(ndr, subtree, hf_$e->{NAME}_$e->{TYPE}, &elt_$e->{NAME});\n";
 382         } else {
 383                 pidl "\tndr_pull_$e->{TYPE}(ndr, subtree, $ndr_flags);\n";
 384         }
 385
 386         end_flags($e);
 387 }
 388
 389 #####################################################################
 390 # parse buffers in a structure element - pull side
 391 sub ParseElementPullBuffer($$)
 392 {
 393         my($e) = shift;
 394         my($ndr_flags) = shift;
 395         my $cprefix = util::c_pull_prefix($e);
 396         my $sub_size = util::has_property($e, "subcontext");
 397
 398         if (util::is_pure_scalar($e)) {
 399                 return;
 400         }
 401
 402         if (util::has_property($e, "relative")) {
 403                 return;
 404         }
 405
 406         start_flags($e);
 407
 408         if (util::need_wire_pointer($e)) {
 409                 pidl "\tif (ptr_$e->{NAME}) {\n";
 410         }
 411
 412         if (util::is_inline_array($e)) {
 413                 ParseArrayPull($e, "NDR_BUFFERS");
 414         } elsif (util::array_size($e)) {
 415                 ParseArrayPull($e, "NDR_SCALARS|NDR_BUFFERS");
 416         } elsif (my $switch = util::has_property($e, "switch_is")) {
 417                 if ($e->{POINTERS}) {
 418                         ParseElementPullSwitch($e, "NDR_SCALARS|NDR_BUFFERS", $switch);
 419                 } else {
 420                         ParseElementPullSwitch($e, "NDR_BUFFERS", $switch);
 421                 }
 422         } elsif (defined $sub_size) {
 423                 if ($e->{POINTERS}) {
 424                         if (util::is_builtin_type($e->{TYPE})) {
 425                                 pidl "\tndr_pull_subcontext_fn(ndr, subtree, $sub_size, _pull_$e->{TYPE});\n";
 426                         } else {
 427                                 pidl "\tndr_pull_subcontext_flags_fn(ndr, subtree, $sub_size, ndr_pull_$e->{TYPE});\n";
 428                         }
 429                 }
 430         } elsif (util::is_builtin_type($e->{TYPE})) {
 431                 pidl "\t\tndr_pull_$e->{TYPE}(ndr, subtree, hf_$e->{NAME}_$e->{TYPE}, &elt_$e->{NAME});\n";
 432         } elsif ($e->{POINTERS}) {
 433                 pidl "\t\tndr_pull_$e->{TYPE}(ndr, subtree, NDR_SCALARS|NDR_BUFFERS);\n";
 434         } else {
 435                 pidl "\t\tndr_pull_$e->{TYPE}(ndr, subtree, $ndr_flags);\n";
 436         }
 437
 438         if (util::need_wire_pointer($e)) {
 439                 pidl "\t}\n";
 440         }
 441
 442         end_flags($e);
 443 }
 444
 445 #####################################################################
 446 # parse a struct - pull side
 447 sub ParseStructPull($)
 448 {
 449         my($struct) = shift;
 450         my $conform_e;
 451
 452         for my $x (@{$struct->{ELEMENTS}}) {
 453             pidl "\tg$x->{TYPE} elt_$x->{NAME};\n",
 454                 if util::is_builtin_type($x->{TYPE});
 455         }
 456
 457         if (! defined $struct->{ELEMENTS}) {
 458                 return;
 459         }
 460
 461         # see if the structure contains a conformant array. If it
 462         # does, then it must be the last element of the structure, and
 463         # we need to pull the conformant length early, as it fits on
 464         # the wire before the structure (and even before the structure
 465         # alignment)
 466         my $e = $struct->{ELEMENTS}[-1];
 467         if (defined $e->{ARRAY_LEN} && $e->{ARRAY_LEN} eq "*") {
 468                 $conform_e = $e;
 469                 pidl "\tguint32 _conformant_size;\n";
 470                 $conform_e->{CONFORMANT_SIZE} = "_conformant_size";
 471         }
 472
 473         # declare any internal pointers we need
 474         foreach my $e (@{$struct->{ELEMENTS}}) {
 475                 if (util::need_wire_pointer($e) &&
 476                     !util::has_property($e, "relative")) {
 477                         pidl "\tguint32 ptr_$e->{NAME};\n";
 478                 }
 479         }
 480
 481         pidl "\n";
 482
 483         start_flags($struct);
 484
 485         pidl "\titem = proto_tree_add_text(tree, ndr->tvb, ndr->offset, 0, \"$struct->{PARENT}{NAME}\");\n";
 486         pidl "\tsubtree = proto_item_add_subtree(item, ett_$struct->{PARENT}{NAME});\n";
 487
 488         pidl "\tif (!(ndr_flags & NDR_SCALARS)) goto buffers;\n";
 489
 490         pidl "\tndr_pull_struct_start(ndr);\n";
 491
 492         if (defined $conform_e) {
 493                 pidl "\tndr_pull_uint32(ndr, subtree, hf_conformant_size, &$conform_e->{CONFORMANT_SIZE});\n";
 494         }
 495
 496         my $align = struct_alignment($struct);
 497         pidl "\tndr_pull_align(ndr, $align);\n";
 498
 499         foreach my $e (@{$struct->{ELEMENTS}}) {
 500                 ParseElementPullScalar($e, "NDR_SCALARS");
 501         }
 502
 503         pidl "buffers:\n";
 504         pidl "\tif (!(ndr_flags & NDR_BUFFERS)) goto done;\n";
 505         foreach my $e (@{$struct->{ELEMENTS}}) {
 506                 ParseElementPullBuffer($e, "NDR_BUFFERS");
 507         }
 508
 509         pidl "\tndr_pull_struct_end(ndr);\n";
 510
 511         pidl "done: ;\n";
 512
 513         end_flags($struct);
 514 }
 515
 516 #####################################################################
 517 # parse a union - pull side
 518 sub ParseUnionPull($)
 519 {
 520         my $e = shift;
 521         my $have_default = 0;
 522
 523         start_flags($e);
 524
 525         pidl "\titem = proto_tree_add_text(tree, ndr->tvb, ndr->offset, 0, \"$e->{PARENT}{NAME}\");\n";
 526         pidl "\tsubtree = proto_item_add_subtree(item, ett_$e->{PARENT}{NAME});\n";
 527
 528         pidl "\tif (!(ndr_flags & NDR_SCALARS)) goto buffers;\n";
 529
 530         pidl "\tndr_pull_struct_start(ndr);\n";
 531
 532 #       my $align = union_alignment($e);
 533 #       pidl "\tndr_pull_align(ndr, $align);\n";
 534
 535         pidl "\tswitch (level) {\n";
 536         foreach my $el (@{$e->{DATA}}) {
 537                 if ($el->{CASE} eq "default") {
 538                         pidl "\t\tdefault: {\n";
 539                         $have_default = 1;
 540                 } else {
 541                         pidl "\tcase $el->{CASE}: {\n";
 542                 }
 543                 if ($el->{TYPE} eq "UNION_ELEMENT") {
 544                         my $e2 = $el->{DATA};
 545                         if ($e2->{POINTERS}) {
 546                                 pidl "\t\tguint32 ptr_$e2->{NAME};\n";
 547                         }
 548                         ParseElementPullScalar($el->{DATA}, "NDR_SCALARS");
 549                 }
 550                 pidl "\t\tbreak;\n\t}\n";
 551         }
 552         if (! $have_default) {
 553                 pidl "\tdefault:\n";
 554                 pidl "\t\tproto_tree_add_text(subtree, ndr->tvb, ndr->offset, 0, \"Bad switch value %u\", level);\n";
 555                 pidl "\t\tif (check_col(ndr->pinfo->cinfo, COL_INFO))\n";
 556                 pidl "\t\t\tcol_append_fstr(ndr->pinfo->cinfo, COL_INFO, \", 6Bad switch value %u\", level);\n";
 557                 pidl "\t\treturn;\n";
 558         }
 559         pidl "\t}\n";
 560         pidl "buffers:\n";
 561         pidl "\tif (!(ndr_flags & NDR_BUFFERS)) goto done;\n";
 562         pidl "\tswitch (level) {\n";
 563         foreach my $el (@{$e->{DATA}}) {
 564                 if ($el->{CASE} eq "default") {
 565                         pidl "\tdefault:\n";
 566                 } else {
 567                         pidl "\tcase $el->{CASE}:\n";
 568                 }
 569                 if ($el->{TYPE} eq "UNION_ELEMENT") {
 570                         ParseElementPullBuffer($el->{DATA}, "NDR_BUFFERS");
 571                 }
 572                 pidl "\t\tbreak;\n\n";
 573         }
 574         if (! $have_default) {
 575                 pidl "\tdefault:\n";
 576                 pidl "\t\tproto_tree_add_text(subtree, ndr->tvb, ndr->offset, 0, \"Bad switch value %u\", level);\n";
 577                 pidl "\t\tif (check_col(ndr->pinfo->cinfo, COL_INFO))\n";
 578                 pidl "\t\t\tcol_append_fstr(ndr->pinfo->cinfo, COL_INFO, \", 7Bad switch value %u\", level);\n";
 579                 pidl "\t\treturn;\n";
 580         }
 581         pidl "\t}\n";
 582         pidl "\tndr_pull_struct_end(ndr);\n";
 583         pidl "done:\n";
 584         end_flags($e);
 585 }
 586
 587 #####################################################################
 588 # parse a enum - pull side
 589 sub ParseEnumPull($)
 590 {
 591         my $e = shift;
 592
 593         my $name;
 594         my $ndx = 0;
 595
 596         for my $x (@{$e->{ELEMENTS}}) {
 597             if ($x =~ /([a-zA-Z_]+)=([0-9]+)/) {
 598                 $name = $1;
 599                 $ndx = $2;
 600             } else {
 601                 $name = $x;
 602             }
 603             pidl "#define $name $ndx\n";
 604             $ndx++;
 605         }
 606
 607         pidl "\n";
 608 }
 609
 610 #####################################################################
 611 # parse a type
 612 sub ParseTypePull($)
 613 {
 614         my($data) = shift;
 615
 616         if (ref($data) eq "HASH") {
 617                 ($data->{TYPE} eq "STRUCT") &&
 618                     ParseStructPull($data);
 619                 ($data->{TYPE} eq "UNION") &&
 620                     ParseUnionPull($data);
 621                 ($data->{TYPE} eq "ENUM") &&
 622                     ParseEnumPull($data);
 623         }
 624 }
 625
 626 #####################################################################
 627 # parse a typedef - pull side
 628 sub ParseTypedefPull($)
 629 {
 630         my($e) = shift;
 631         my $static = fn_prefix($e);
 632
 633 #       if (! $needed{"pull_$e->{NAME}"}) {
 634 #               print "pull_$e->{NAME} not needed\n";
 635 #               return;
 636 #       }
 637
 638         pidl "/*\n\n";
 639         pidl IdlDump::DumpTypedef($e);
 640         pidl "*/\n\n";
 641
 642         if ($e->{DATA}->{TYPE} eq "STRUCT") {
 643                 pidl "static gint ett_$e->{NAME} = -1;\n\n";
 644                 pidl $static . "void ndr_pull_$e->{NAME}(struct e_ndr_pull *ndr, proto_tree *tree, int ndr_flags)";
 645                 pidl "\n{\n";
 646                 pidl "\tproto_item *item = NULL;\n";
 647                 pidl "\tproto_tree *subtree = NULL;\n";
 648                 ParseTypePull($e->{DATA});
 649                 pidl "}\n\n";
 650         }
 651
 652         if ($e->{DATA}->{TYPE} eq "UNION") {
 653                 pidl "static gint ett_$e->{NAME} = -1;\n\n";
 654                 pidl $static . "void ndr_pull_$e->{NAME}(struct e_ndr_pull *ndr, proto_tree *tree, int ndr_flags, int level)";
 655                 pidl "\n{\n";
 656                 pidl "\tproto_item *item = NULL;\n";
 657                 pidl "\tproto_tree *subtree = NULL;\n";
 658                 ParseTypePull($e->{DATA});
 659                 pidl "}\n\n";
 660         }
 661
 662         if ($e->{DATA}->{TYPE} eq "ENUM") {
 663             ParseEnumPull($e->{DATA});
 664         }
 665 }
 666
 667
 668 #####################################################################
 669 # parse a function element
 670 sub ParseFunctionElementPull($$)
 671 {
 672         my $e = shift;
 673         my $inout = shift;
 674
 675         if (util::array_size($e)) {
 676                 if (util::need_wire_pointer($e)) {
 677                         pidl "\tndr_pull_ptr(ndr, &ptr_$e->{NAME});\n";
 678                         pidl "\tif (ptr_$e->{NAME}) {\n";
 679                 } elsif ($inout eq "out" && util::has_property($e, "ref")) {
 680                         pidl "\tif (r->$inout.$e->{NAME}) {\n";
 681                 } else {
 682                         pidl "\t{\n";
 683                 }
 684                 ParseArrayPull($e, "NDR_SCALARS|NDR_BUFFERS");
 685                 pidl "\t}\n";
 686         } else {
 687                 if ($inout eq "out" && util::has_property($e, "ref")) {
 688 #                       pidl "\tif (ndr->flags & LIBNDR_FLAG_REF_ALLOC) {\n";
 689 #                       pidl "\tNDR_ALLOC(ndr, r->out.$e->{NAME});\n";
 690 #                       pidl "\t}\n";
 691                 }
 692                 if ($inout eq "in" && util::has_property($e, "ref")) {
 693 #                       pidl "\tNDR_ALLOC(ndr, r->in.$e->{NAME});\n";
 694                 }
 695
 696                 ParseElementPullScalar($e, "NDR_SCALARS|NDR_BUFFERS");
 697                 if ($e->{POINTERS}) {
 698                         ParseElementPullBuffer($e, "NDR_SCALARS|NDR_BUFFERS");
 699                 }
 700         }
 701 }
 702
 703 #####################################################################
 704 # parse a function
 705 sub ParseFunctionPull($)
 706 {
 707         my($fn) = shift;
 708         my $static = fn_prefix($fn);
 709
 710         # Comment displaying IDL for this function
 711
 712         pidl "/*\n\n";
 713         pidl IdlDump::DumpFunction($fn);
 714         pidl "*/\n\n";
 715
 716         # Request
 717
 718         pidl $static . "int $fn->{NAME}_rqst(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *tree, guint8 *drep)\n";
 719         pidl "{\n";
 720         pidl "\tproto_tree *subtree = tree;\n";
 721         pidl "\tstruct e_ndr_pull *ndr = ndr_pull_init(tvb, offset, pinfo, drep);\n";
 722
 723         # declare any internal pointers we need
 724         foreach my $e (@{$fn->{DATA}}) {
 725
 726                 if (util::need_wire_pointer($e) &&
 727                     util::has_property($e, "in")) {
 728                         pidl "\tguint32 ptr_$e->{NAME};\n";
 729                 }
 730
 731                 if (util::has_property($e, "in")) {
 732                     pidl "\tg$e->{TYPE} elt_$e->{NAME};\n",
 733                         if util::is_builtin_type($e->{TYPE});
 734                 }
 735         }
 736
 737         pidl "\n";
 738
 739         foreach my $e (@{$fn->{DATA}}) {
 740                 if (util::has_property($e, "in")) {
 741                         ParseFunctionElementPull($e, "in");
 742                 }
 743         }
 744
 745         pidl "\toffset = ndr->offset;\n";
 746         pidl "\tndr_pull_free(ndr);\n";
 747         pidl "\n";
 748         pidl "\treturn offset;\n";
 749         pidl "}\n\n";
 750
 751         # Response
 752
 753         pidl $static . "int $fn->{NAME}_resp(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *tree, guint8 *drep)\n";
 754         pidl "{\n";
 755         pidl "\tproto_tree *subtree = tree;\n";
 756         pidl "\tstruct e_ndr_pull *ndr = ndr_pull_init(tvb, offset, pinfo, drep);\n";
 757
 758         # declare any internal pointers we need
 759         foreach my $e (@{$fn->{DATA}}) {
 760
 761                 if (util::need_wire_pointer($e) &&
 762                     util::has_property($e, "out")) {
 763                         pidl "\tguint32 ptr_$e->{NAME};\n";
 764                 }
 765
 766                 if (util::has_property($e, "out")) {
 767                     pidl "\tg$e->{TYPE} elt_$e->{NAME};\n",
 768                         if util::is_builtin_type($e->{TYPE});
 769                 }
 770         }
 771
 772         pidl "\n";
 773
 774         foreach my $e (@{$fn->{DATA}}) {
 775                 if (util::has_property($e, "out")) {
 776                         ParseFunctionElementPull($e, "out");
 777                 }
 778         }
 779
 780         if ($fn->{RETURN_TYPE} && $fn->{RETURN_TYPE} ne "void") {
 781                 pidl "\tndr_pull_$fn->{RETURN_TYPE}(ndr, subtree, hf_rc);\n";
 782         }
 783
 784         pidl "\toffset = ndr->offset;\n";
 785         pidl "\tndr_pull_free(ndr);\n";
 786         pidl "\n";
 787         pidl "\treturn offset;\n";
 788         pidl "}\n\n";
 789 }
 790
 791 #####################################################################
 792 # produce a function call table
 793 sub FunctionTable($)
 794 {
 795         my($interface) = shift;
 796         my($data) = $interface->{DATA};
 797         my $count = 0;
 798         my $uname = uc $interface->{NAME};
 799
 800         foreach my $d (@{$data}) {
 801                 if ($d->{TYPE} eq "FUNCTION") { $count++; }
 802         }
 803
 804         if ($count == 0) {
 805                 return;
 806         }
 807
 808         pidl "static dcerpc_sub_dissector dcerpc_dissectors[] = {\n";
 809         my $num = 0;
 810         foreach my $d (@{$data}) {
 811                 if ($d->{TYPE} eq "FUNCTION") {
 812                     # Strip module name from function name, if present
 813                     my($n) = $d->{NAME};
 814                     $n = substr($d->{NAME}, length($module) + 1),
 815                         if $module eq substr($d->{NAME}, 0, length($module));
 816                     pidl "\t{ $num, \"$n\",\n";
 817                     pidl "\t\t$d->{NAME}_rqst,\n";
 818                     pidl "\t\t$d->{NAME}_resp },\n";
 819                     $num++;
 820                 }
 821         }
 822         pidl "};\n\n";
 823 }
 824
 825 #####################################################################
 826 # parse the interface definitions
 827 sub ParseInterface($)
 828 {
 829         my($interface) = shift;
 830         my($data) = $interface->{DATA};
 831
 832         foreach my $d (@{$data}) {
 833                 if ($d->{TYPE} eq "TYPEDEF") {
 834                     $structs{$d->{NAME}} = $d;
 835             }
 836         }
 837
 838         foreach my $d (@{$data}) {
 839                 ($d->{TYPE} eq "TYPEDEF") &&
 840                     ParseTypedefPull($d);
 841                 ($d->{TYPE} eq "FUNCTION") &&
 842                     ParseFunctionPull($d);
 843         }
 844
 845         FunctionTable($interface);
 846 }
 847
 848 sub type2ft($)
 849 {
 850     my($t) = shift;
 851
 852     return "FT_UINT32", if ($t eq "uint32");
 853     return "FT_UINT16", if ($t eq "uint16");
 854     return "FT_UINT8", if ($t eq "uint8");
 855     return "FT_BYTES";
 856 }
 857
 858 sub type2base($)
 859 {
 860     my($t) = shift;
 861
 862     return "BASE_DEC", if ($t eq "uint32") or ($t eq "uint16") or
 863         ($t eq "uint8");
 864     return "BASE_NONE";
 865 }
 866
 867 sub NeededFunction($)
 868 {
 869         my $fn = shift;
 870         foreach my $e (@{$fn->{DATA}}) {
 871                 $needed{"hf_$e->{NAME}_$e->{TYPE}"} = {
 872                     'name' => $e->{NAME},
 873                     'type' => $e->{TYPE},
 874                     'ft'   => type2ft($e->{TYPE}),
 875                     'base' => type2base($e->{TYPE})
 876                     };
 877                 $e->{PARENT} = $fn;
 878         }
 879 }
 880
 881 sub NeededTypedef($)
 882 {
 883         my $t = shift;
 884
 885         if (util::has_property($t->{DATA}, "public")) {
 886                 $needed{"pull_$t->{NAME}"} = 1;
 887         }
 888
 889         if ($t->{DATA}->{TYPE} eq "STRUCT") {
 890
 891             $needed{"ett_$t->{NAME}"} = 1;
 892
 893                 for my $e (@{$t->{DATA}->{ELEMENTS}}) {
 894
 895                 $needed{"hf_$e->{NAME}_$e->{TYPE}"} = {
 896                     'name' => $e->{NAME},
 897                     'type' => $e->{TYPE},
 898                     'ft'   => type2ft($e->{TYPE}),
 899                     'base' => type2base($e->{TYPE})
 900                     };
 901
 902                         $e->{PARENT} = $t->{DATA};
 903                         if ($needed{"pull_$t->{NAME}"}) {
 904                                 $needed{"pull_$e->{TYPE}"} = 1;
 905                         }
 906                 }
 907         }
 908         if ($t->{DATA}->{TYPE} eq "UNION") {
 909
 910             $needed{"ett_$t->{NAME}"} = 1;
 911
 912                 for my $e (@{$t->{DATA}->{DATA}}) {
 913                         $e->{PARENT} = $t->{DATA};
 914                         if ($e->{TYPE} eq "UNION_ELEMENT") {
 915                                 if ($needed{"pull_$t->{NAME}"}) {
 916                                         $needed{"pull_$e->{DATA}->{TYPE}"} = 1;
 917                                 }
 918                         }
 919                 }
 920         }
 921 }
 922
 923 #####################################################################
 924 # work out what parse functions are needed
 925 sub BuildNeeded($)
 926 {
 927         my($interface) = shift;
 928         my($data) = $interface->{DATA};
 929         foreach my $d (@{$data}) {
 930                 ($d->{TYPE} eq "FUNCTION") &&
 931                     NeededFunction($d);
 932         }
 933         foreach my $d (reverse @{$data}) {
 934                 ($d->{TYPE} eq "TYPEDEF") &&
 935                     NeededTypedef($d);
 936         }
 937 }
 938
 939 #####################################################################
 940 # parse the interface definitions
 941 sub ModuleHeader($)
 942 {
 943     my($h) = shift;
 944
 945     $if_uuid = $h->{PROPERTIES}->{uuid};
 946     $if_version = $h->{PROPERTIES}->{version};
 947     $if_endpoints = $h->{PROPERTIES}->{endpoints};
 948 }
 949
 950 sub ParseHeader($$)
 951 {
 952         my($idl) = shift;
 953         my($filename) = shift;
 954
 955         open(OUT, ">$filename") || die "can't open $filename";
 956
 957         pidl "/* parser auto-generated by pidl */\n\n";
 958
 959         foreach my $x (@{$idl}) {
 960             if ($x->{TYPE} eq "INTERFACE") {
 961                 foreach my $d (@{$x->{DATA}}) {
 962                     if ($d->{TYPE} eq "TYPEDEF" and
 963                         util::has_property($d->{DATA}, "public")) {
 964
 965                         if ($d->{DATA}{TYPE} eq "STRUCT") {
 966                             pidl "void ndr_pull_$d->{NAME}(struct e_ndr_pull *ndr, proto_tree *tree, int ndr_flags);\n";
 967                         }
 968
 969                         if ($d->{DATA}{TYPE} eq "UNION") {
 970                             pidl "void ndr_pull_$d->{NAME}(struct e_ndr_pull *ndr, proto_tree *tree, int ndr_flags, int level);\n";
 971                         }
 972                     }
 973                 }
 974             }
 975         }
 976
 977         close(OUT);
 978 }
 979
 980 #####################################################################
 981 # parse a parsed IDL structure back into an IDL file
 982 sub Parse($$)
 983 {
 984         my($idl) = shift;
 985         my($filename) = shift;
 986
 987         %needed = ();
 988
 989         open(OUT, ">$filename") || die "can't open $filename";
 990
 991         foreach my $x (@{$idl}) {
 992                 ($x->{TYPE} eq "MODULEHEADER") &&
 993                     ModuleHeader($x);
 994
 995                 if ($x->{TYPE} eq "INTERFACE") {
 996                     $module = $x->{NAME};
 997                     BuildNeeded($x);
 998                 }
 999             }
1000
1001         pidl "/* parser auto-generated by pidl */\n\n";
1002         pidl "#ifdef HAVE_CONFIG_H\n";
1003         pidl "#include \"config.h\"\n";
1004         pidl "#endif\n\n";
1005
1006         pidl "#include \"packet-dcerpc.h\"\n";
1007         pidl "#include \"packet-dcerpc-nt.h\"\n\n";
1008         pidl "#include \"packet-dcerpc-eparser.h\"\n\n";
1009
1010         pidl "extern const value_string NT_errors[];\n\n";
1011
1012         pidl "static int proto_dcerpc_$module = -1;\n\n";
1013
1014         pidl "static gint ett_dcerpc_$module = -1;\n\n";
1015
1016         pidl "static int hf_opnum = -1;\n";
1017         pidl "static int hf_rc = -1;\n";
1018         pidl "static int hf_ptr = -1;\n";
1019         pidl "static int hf_array_size = -1;\n";
1020         pidl "static int hf_array_offset = -1;\n";
1021         pidl "static int hf_array_length = -1;\n";
1022         pidl "static int hf_conformant_size = -1;\n";
1023         pidl "static int hf_level = -1;\n";
1024
1025         # Declarations for hf variables
1026
1027         foreach my $y (keys(%needed)) {
1028             pidl "static int $y = -1;\n", if $y =~ /^hf_/;
1029         }
1030
1031         pidl "\n";
1032
1033         for my $x (@{$idl}) {
1034             ParseInterface($x);
1035         }
1036
1037         # Only perform module initialisation if we found a uuid
1038
1039         if (defined($if_uuid)) {
1040
1041             pidl "static e_uuid_t uuid_dcerpc_$module = {\n";
1042             pidl "\t0x" . substr($if_uuid, 0, 8);
1043             pidl ", 0x" . substr($if_uuid, 9, 4);
1044             pidl ", 0x" . substr($if_uuid, 14, 4) . ",\n";
1045             pidl "\t{ 0x" . substr($if_uuid, 19, 2);
1046             pidl ", 0x" . substr($if_uuid, 21, 2);
1047             pidl ", 0x" . substr($if_uuid, 24, 2);
1048             pidl ", 0x" . substr($if_uuid, 26, 2);
1049             pidl ", 0x" . substr($if_uuid, 28, 2);
1050             pidl ", 0x" . substr($if_uuid, 30, 2);
1051             pidl ", 0x" . substr($if_uuid, 32, 2);
1052             pidl ", 0x" . substr($if_uuid, 34, 2) . " }\n";
1053             pidl "};\n\n";
1054
1055             pidl "static guint16 ver_dcerpc_$module = " . $if_version . ";\n\n";
1056         }
1057
1058         pidl "void proto_register_dcerpc_$module(void)\n";
1059         pidl "{\n";
1060
1061         pidl "\tstatic hf_register_info hf[] = {\n";
1062
1063         pidl "\t{ &hf_opnum, { \"Operation\", \"$module.opnum\", FT_UINT16, BASE_DEC, NULL, 0x0, \"Operation\", HFILL }},\n";
1064         pidl "\t{ &hf_rc, { \"Return code\", \"$module.rc\", FT_UINT32, BASE_HEX, VALS(NT_errors), 0x0, \"Return status code\", HFILL }},\n";
1065         pidl "\t{ &hf_array_size, { \"Array size\", \"$module.array_size\", FT_UINT32, BASE_DEC, NULL, 0x0, \"Array size\", HFILL }},\n";
1066         pidl "\t{ &hf_array_offset, { \"Array offset\", \"$module.array_offset\", FT_UINT32, BASE_DEC, NULL, 0x0, \"Array offset\", HFILL }},\n";
1067         pidl "\t{ &hf_array_length, { \"Array length\", \"$module.array_length\", FT_UINT32, BASE_DEC, NULL, 0x0, \"Array length\", HFILL }},\n";
1068         pidl "\t{ &hf_conformant_size, { \"Conformant size\", \"$module.conformant_size\", FT_UINT32, BASE_DEC, NULL, 0x0, \"Conformant size\", HFILL }},\n";
1069         pidl "\t{ &hf_level, { \"Level\", \"$module.level\", FT_UINT32, BASE_DEC, NULL, 0x0, \"Level\", HFILL }},\n";
1070         pidl "\t{ &hf_ptr, { \"Pointer\", \"$module.ptr\", FT_UINT32, BASE_HEX, NULL, 0x0, \"Pointer\", HFILL }},\n";
1071
1072         foreach my $x (keys(%needed)) {
1073             next, if !($x =~ /^hf_/);
1074             pidl "\t{ &$x,\n";
1075             pidl "\t  { \"$needed{$x}{name}\", \"$x\", $needed{$x}{ft}, $needed{$x}{base}, NULL, 0, \"$x\", HFILL }},\n";
1076         }
1077
1078         pidl "\t};\n\n";
1079
1080         pidl "\tstatic gint *ett[] = {\n";
1081         pidl "\t\t&ett_dcerpc_$module,\n";
1082         foreach my $x (keys(%needed)) {
1083             pidl "\t\t&$x,\n", if $x =~ /^ett_/;
1084         }
1085         pidl "\t};\n\n";
1086
1087         if (defined($if_uuid)) {
1088
1089             pidl "\tproto_dcerpc_$module = proto_register_protocol(\"$module\", \"$module\", \"$module\");\n\n";
1090
1091             pidl "\tproto_register_field_array(proto_dcerpc_$module, hf, array_length (hf));\n";
1092             pidl "\tproto_register_subtree_array(ett, array_length(ett));\n";
1093
1094             pidl "}\n\n";
1095
1096             pidl "void proto_reg_handoff_dcerpc_$module(void)\n";
1097             pidl "{\n";
1098             pidl "\tdcerpc_init_uuid(proto_dcerpc_$module, ett_dcerpc_$module, \n";
1099             pidl "\t\t&uuid_dcerpc_$module, ver_dcerpc_$module, \n";
1100             pidl "\t\tdcerpc_dissectors, hf_opnum);\n";
1101             pidl "}\n";
1102
1103         } else {
1104
1105             pidl "\tint proto_dcerpc;\n\n";
1106             pidl "\tproto_dcerpc = proto_get_id_by_filter_name(\"dcerpc\");\n";
1107             pidl "\tproto_register_field_array(proto_dcerpc, hf, array_length(hf));\n";
1108             pidl "\tproto_register_subtree_array(ett, array_length(ett));\n";
1109
1110             pidl "}\n";
1111
1112         }
1113
1114         close(OUT);
1115 }
1116
1117 1;