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