source/pidl/lib/Parse/Pidl/Samba3/Parser.pm

   1 ###################################################
   2 # Samba3 NDR parser generator for IDL structures
   3 # Copyright jelmer@samba.org 2005
   4 # released under the GNU GPL
   5
   6 package Parse::Pidl::Samba3::Parser;
   7
   8 use strict;
   9 use Parse::Pidl::Typelist qw(hasType getType mapType);
  10 use Parse::Pidl::Util qw(has_property ParseExpr);
  11 use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred);
  12 use Parse::Pidl::Samba3::Types qw(DeclShort DeclLong InitType DissectType);
  13
  14 use vars qw($VERSION);
  15 $VERSION = '0.01';
  16
  17 use constant PRIMITIVES => 1;
  18 use constant DEFERRED => 2;
  19
  20 my $res = "";
  21 my $tabs = "";
  22 sub indent() { $tabs.="\t"; }
  23 sub deindent() { $tabs = substr($tabs, 1); }
  24 sub pidl($) { $res .= $tabs.(shift)."\n"; }
  25 sub fatal($$) { my ($e,$s) = @_; die("$e->{FILE}:$e->{LINE}: $s\n"); }
  26
  27 #TODO:
  28 # - Add some security checks (array sizes, memory alloc == NULL, etc)
  29 # - Don't add seperate _p and _d functions if there is no deferred data
  30 # - [string]
  31 # - subcontext()
  32 # - DATA_BLOB
  33
  34 sub Align($$)
  35 {
  36         my ($a,$b) = @_;
  37
  38         # Only align if previous element was smaller then current one
  39         if ($$a < $b) {
  40                 pidl "if (!prs_align_custom(ps, $b))";
  41                 pidl "\treturn False;";
  42                 pidl "";
  43         }
  44
  45         $$a = $b;
  46 }
  47
  48 sub DeclareArrayVariables
  49 {
  50         my $es = shift;
  51         my $what = shift;
  52
  53         my $output = 0;
  54
  55         foreach my $e (@$es) {
  56                 foreach my $l (@{$e->{LEVELS}}) {
  57                         if ($what) {
  58                                 next if ($l->{IS_DEFERRED} and $what == PRIMITIVES);
  59                                 next if (not $l->{IS_DEFERRED} and $what == DEFERRED);
  60                         }
  61                         if ($l->{TYPE} eq "ARRAY") {
  62                                 pidl "uint32 i_$e->{NAME}_$l->{LEVEL_INDEX};";
  63                                 $output = 1;
  64                         }
  65                 }
  66         }
  67         pidl "" if $output;
  68 }
  69
  70 sub ParseElementLevelData($$$$$$$)
  71 {
  72         my ($e,$l,$nl,$env,$varname,$what,$align) = @_;
  73
  74         my $c = DissectType($e,$l,$varname,$what,$align);
  75         return if not $c;
  76
  77         if (defined($e->{ALIGN})) {
  78                 Align($align, $e->{ALIGN});
  79         } else {
  80                 # Default to 4
  81                 Align($align, 4);
  82         }
  83
  84         pidl "if (!$c)";
  85         pidl "\treturn False;";
  86 }
  87
  88 sub ParseElementLevelArray($$$$$$$)
  89 {
  90         my ($e,$l,$nl,$env,$varname,$what,$align) = @_;
  91
  92         if ($l->{IS_ZERO_TERMINATED}) {
  93                 fatal($e, "[string] attribute not supported for Samba3 yet");
  94
  95                 #FIXME
  96         }
  97
  98         my $len = ParseExpr($l->{LENGTH_IS}, $env);
  99         my $size = ParseExpr($l->{SIZE_IS}, $env);
 100
 101         if ($what == PRIMITIVES) {
 102                 # Fetch headers
 103                 if ($l->{IS_CONFORMANT} and not $l->{IS_SURROUNDING}) {
 104                         Align($align, 4);
 105                         pidl "if (!prs_uint32(\"size_$e->{NAME}\", ps, depth, &" . ParseExpr("size_$e->{NAME}", $env) . "))";
 106                         pidl "\treturn False;";
 107                         pidl "";
 108                 }
 109
 110                 if ($l->{IS_VARYING}) {
 111                         Align($align, 4);
 112                         pidl "if (!prs_uint32(\"offset_$e->{NAME}\", ps, depth, &" . ParseExpr("offset_$e->{NAME}", $env) . "))";
 113                         pidl "\treturn False;";
 114                         pidl "";
 115
 116                         pidl "if (!prs_uint32(\"length_$e->{NAME}\", ps, depth, &" . ParseExpr("length_$e->{NAME}", $env) . "))";
 117                         pidl "\treturn False;";
 118                         pidl "";
 119                 }
 120         }
 121
 122         # Everything but fixed arrays have to be allocated
 123         if (!$l->{IS_FIXED} and $what == PRIMITIVES) {
 124                 pidl "if (UNMARSHALLING(ps)) {";
 125                 indent;
 126                 pidl "$varname = (void *)PRS_ALLOC_MEM_VOID(ps,sizeof(*$varname)*$size);";
 127                 deindent;
 128                 pidl "}";
 129         }
 130
 131         return if ($what == DEFERRED and not ContainsDeferred($e,$l));
 132
 133         my $i = "i_$e->{NAME}_$l->{LEVEL_INDEX}";
 134         pidl "for ($i=0; $i<$len;$i++) {";
 135         indent;
 136         ParseElementLevel($e,$nl,$env,$varname."[$i]",$what,$align);
 137         deindent;
 138         pidl "}";
 139 }
 140
 141 sub ParseElementLevelSwitch($$$$$$$)
 142 {
 143         my ($e,$l,$nl,$env,$varname,$what,$align) = @_;
 144
 145         ParseElementLevel($e,$nl,$env,$varname,$what,$align);
 146 }
 147
 148 sub ParseElementLevelPtr($$$$$$$)
 149 {
 150         my ($e,$l,$nl,$env,$varname,$what,$align) = @_;
 151
 152         if ($what == PRIMITIVES) {
 153                 if (($l->{POINTER_TYPE} eq "ref") and ($l->{LEVEL} eq "EMBEDDED")) {
 154                         # Ref pointers always have to be non-NULL
 155                         pidl "if (MARSHALLING(ps) && !" . ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . ")";
 156                         pidl "\treturn False;";
 157                         pidl "";
 158                 }
 159
 160                 unless ($l->{POINTER_TYPE} eq "ref" and $l->{LEVEL} eq "TOP") {
 161                         Align($align, 4);
 162                         pidl "if (!prs_uint32(\"ptr$l->{POINTER_INDEX}_$e->{NAME}\", ps, depth, &" . ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . "))";
 163                         pidl "\treturn False;";
 164                         pidl "";
 165                 }
 166         }
 167
 168         if ($l->{POINTER_TYPE} eq "relative") {
 169                 fatal($e, "relative pointers not supported for Samba 3");
 170                 #FIXME
 171         }
 172
 173         if ($what == DEFERRED) {
 174                 if ($l->{POINTER_TYPE} ne "ref") {
 175                         pidl "if (" . ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . ") {";
 176                         indent;
 177                 }
 178                 ParseElementLevel($e,$nl,$env,$varname,PRIMITIVES,$align);
 179                 ParseElementLevel($e,$nl,$env,$varname,DEFERRED,$align);
 180                 if ($l->{POINTER_TYPE} ne "ref") {
 181                         deindent;
 182                         pidl "}";
 183                 }
 184                 $$align = 0;
 185         }
 186 }
 187
 188 sub ParseElementLevelSubcontext($$$$$$$)
 189 {
 190         my ($e,$l,$nl,$env,$varname,$what,$align) = @_;
 191
 192         fatal($e, "subcontext() not supported for Samba 3");
 193         #FIXME
 194 }
 195
 196 sub ParseElementLevel($$$$$$)
 197 {
 198         my ($e,$l,$env,$varname,$what,$align) = @_;
 199
 200         {
 201                 DATA => \&ParseElementLevelData,
 202                 SUBCONTEXT => \&ParseElementLevelSubcontext,
 203                 POINTER => \&ParseElementLevelPtr,
 204                 SWITCH => \&ParseElementLevelSwitch,
 205                 ARRAY => \&ParseElementLevelArray
 206         }->{$l->{TYPE}}->($e,$l,GetNextLevel($e,$l),$env,$varname,$what,$align);
 207 }
 208
 209 sub ParseElement($$$$)
 210 {
 211         my ($e,$env,$what,$align) = @_;
 212
 213         ParseElementLevel($e, $e->{LEVELS}[0], $env, ParseExpr($e->{NAME}, $env), $what, $align);
 214 }
 215
 216 sub InitLevel($$$$)
 217 {
 218         sub InitLevel($$$$);
 219         my ($e,$l,$varname,$env) = @_;
 220
 221         if ($l->{TYPE} eq "POINTER") {
 222                 if ($l->{POINTER_TYPE} eq "ref") {
 223                         pidl "if (!$varname)";
 224                         pidl "\treturn False;";
 225                         pidl "";
 226                 } else {
 227                         pidl "if ($varname) {";
 228                         indent;
 229                 }
 230
 231                 pidl ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . " = 1;";
 232                 InitLevel($e, GetNextLevel($e,$l), "*$varname", $env);
 233
 234                 if ($l->{POINTER_TYPE} ne "ref") {
 235                         deindent;
 236                         pidl "} else {";
 237                         pidl "\t" . ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . " = 0;";
 238                         pidl "}";
 239                 }
 240         } elsif ($l->{TYPE} eq "ARRAY") {
 241                 pidl ParseExpr($e->{NAME}, $env) . " = $varname;";
 242         } elsif ($l->{TYPE} eq "DATA") {
 243                 pidl InitType($e, $l, ParseExpr($e->{NAME}, $env), $varname);
 244         } elsif ($l->{TYPE} eq "SWITCH") {
 245                 InitLevel($e, GetNextLevel($e,$l), $varname, $env);
 246                 pidl ParseExpr($e->{NAME}, $env) . ".switch_value = " . ParseExpr($l->{SWITCH_IS}, $env) . ";";
 247         }
 248 }
 249
 250 sub GenerateEnvElement($$)
 251 {
 252         my ($e,$env) = @_;
 253         foreach my $l (@{$e->{LEVELS}}) {
 254                 if ($l->{TYPE} eq "DATA") {
 255                         $env->{$e->{NAME}} = "v->$e->{NAME}";
 256                 } elsif ($l->{TYPE} eq "POINTER") {
 257                         $env->{"ptr$l->{POINTER_INDEX}_$e->{NAME}"} = "v->ptr$l->{POINTER_INDEX}_$e->{NAME}";
 258                 } elsif ($l->{TYPE} eq "SWITCH") {
 259                 } elsif ($l->{TYPE} eq "ARRAY") {
 260                         $env->{"length_$e->{NAME}"} = "v->length_$e->{NAME}";
 261                         $env->{"size_$e->{NAME}"} = "v->size_$e->{NAME}";
 262                         $env->{"offset_$e->{NAME}"} = "v->offset_$e->{NAME}";
 263                 }
 264         }
 265 }
 266
 267 sub ParseStruct($$$)
 268 {
 269         my ($if,$s,$n) = @_;
 270
 271         my $fn = "$if->{NAME}_io_$n";
 272         my $sn = uc("$if->{NAME}_$n");
 273         my $ifn = "init_$if->{NAME}_$n";
 274
 275         my $args = "";
 276         foreach (@{$s->{ELEMENTS}}) {
 277                 $args .= ", " . DeclLong($_);
 278         }
 279
 280         my $env = { "this" => "v" };
 281         GenerateEnvElement($_, $env) foreach (@{$s->{ELEMENTS}});
 282
 283         pidl "BOOL $ifn($sn *v$args)";
 284         pidl "{";
 285         indent;
 286         pidl "DEBUG(5,(\"$ifn\\n\"));";
 287         pidl "";
 288         # Call init for all arguments
 289         foreach (@{$s->{ELEMENTS}}) {
 290                 InitLevel($_, $_->{LEVELS}[0], $_->{NAME}, $env);
 291                 pidl "";
 292         }
 293         pidl "return True;";
 294         deindent;
 295         pidl "}";
 296         pidl "";
 297
 298         my $pfn = "$fn\_p";
 299         my $dfn = "$fn\_d";
 300
 301         pidl "BOOL $pfn(const char *desc, $sn *v, prs_struct *ps, int depth)";
 302         pidl "{";
 303         indent;
 304         DeclareArrayVariables($s->{ELEMENTS}, PRIMITIVES);
 305         pidl "if (v == NULL)";
 306         pidl "\treturn False;";
 307         pidl "";
 308         pidl "prs_debug(ps, depth, desc, \"$pfn\");";
 309         pidl "depth++;";
 310
 311         my $align = 8;
 312         if ($s->{SURROUNDING_ELEMENT}) {
 313                 pidl "if (!prs_uint32(\"size_$s->{SURROUNDING_ELEMENT}->{NAME}\", ps, depth, &" . ParseExpr("size_$s->{SURROUNDING_ELEMENT}->{NAME}", $env) . "))";
 314                 pidl "\treturn False;";
 315                 pidl "";
 316                 $align = 4;
 317
 318         }
 319
 320         foreach (@{$s->{ELEMENTS}}) {
 321                 ParseElement($_, $env, PRIMITIVES, \$align);
 322                 pidl "";
 323         }
 324
 325         pidl "return True;";
 326         deindent;
 327         pidl "}";
 328         pidl "";
 329
 330         pidl "BOOL $dfn(const char *desc, $sn *v, prs_struct *ps, int depth)";
 331         pidl "{";
 332         indent;
 333         DeclareArrayVariables($s->{ELEMENTS}, DEFERRED);
 334         pidl "if (v == NULL)";
 335         pidl "\treturn False;";
 336         pidl "";
 337         pidl "prs_debug(ps, depth, desc, \"$dfn\");";
 338         pidl "depth++;";
 339
 340         $align = 0;
 341         foreach (@{$s->{ELEMENTS}}) {
 342                 ParseElement($_, $env, DEFERRED, \$align);
 343                 pidl "";
 344         }
 345
 346         pidl "return True;";
 347         deindent;
 348         pidl "}";
 349         pidl "";
 350 }
 351
 352 sub UnionGenerateEnvElement($)
 353 {
 354         my $e = shift;
 355         my $env = {};
 356
 357         foreach my $l (@{$e->{LEVELS}}) {
 358                 if ($l->{TYPE} eq "DATA") {
 359                         $env->{$e->{NAME}} = "v->u.$e->{NAME}";
 360                 } elsif ($l->{TYPE} eq "POINTER") {
 361                         $env->{"ptr$l->{POINTER_INDEX}_$e->{NAME}"} = "v->ptr$l->{POINTER_INDEX}";
 362                 } elsif ($l->{TYPE} eq "SWITCH") {
 363                 } elsif ($l->{TYPE} eq "ARRAY") {
 364                         $env->{"length_$e->{NAME}"} = "v->length";
 365                         $env->{"size_$e->{NAME}"} = "v->size";
 366                         $env->{"offset_$e->{NAME}"} = "v->offset";
 367                 }
 368         }
 369
 370         return $env;
 371 }
 372
 373 sub ParseUnion($$$)
 374 {
 375         my ($if,$u,$n) = @_;
 376
 377         my $fn = "$if->{NAME}_io_$n";
 378         my $sn = uc("$if->{NAME}_$n\_ctr");
 379
 380         my $pfn = "$fn\_p";
 381         my $dfn = "$fn\_d";
 382
 383         pidl "BOOL $pfn(const char *desc, $sn* v, prs_struct *ps, int depth)";
 384         pidl "{";
 385         indent;
 386         DeclareArrayVariables($u->{ELEMENTS});
 387
 388         if (defined ($u->{SWITCH_TYPE})) {
 389                 pidl "if (!prs_$u->{SWITCH_TYPE}(\"switch_value\", ps, depth, &v->switch_value))";
 390                 pidl "\treturn False;";
 391                 pidl "";
 392         }
 393
 394         # Maybe check here that level and v->switch_value are equal?
 395
 396         pidl "switch (v->switch_value) {";
 397         indent;
 398
 399         foreach (@{$u->{ELEMENTS}}) {
 400                 pidl "$_->{CASE}:";
 401                 indent;
 402                 if ($_->{TYPE} ne "EMPTY") {
 403                         pidl "depth++;";
 404                         my $env = UnionGenerateEnvElement($_);
 405                         my $align = 8;
 406                         ParseElement($_, $env, PRIMITIVES, \$align);
 407                         pidl "depth--;";
 408                 }
 409                 pidl "break;";
 410                 deindent;
 411                 pidl "";
 412         }
 413
 414         unless ($u->{HAS_DEFAULT}) {
 415                 pidl "default:";
 416                 pidl "\treturn False;";
 417                 pidl "";
 418         }
 419
 420         deindent;
 421         pidl "}";
 422         pidl "";
 423         pidl "return True;";
 424         deindent;
 425         pidl "}";
 426         pidl "";
 427
 428         pidl "BOOL $dfn(const char *desc, $sn* v, prs_struct *ps, int depth)";
 429         pidl "{";
 430         indent;
 431         DeclareArrayVariables($u->{ELEMENTS});
 432
 433         if (defined($u->{SWITCH_TYPE})) {
 434                 pidl "switch (v->switch_value) {";
 435         } else {
 436                 pidl "switch (level) {";
 437         }
 438         indent;
 439
 440         foreach (@{$u->{ELEMENTS}}) {
 441                 pidl "$_->{CASE}:";
 442                 indent;
 443                 if ($_->{TYPE} ne "EMPTY") {
 444                         pidl "depth++;";
 445                         my $env = UnionGenerateEnvElement($_);
 446                         my $align = 0;
 447                         ParseElement($_, $env, DEFERRED, \$align);
 448                         pidl "depth--;";
 449                 }
 450                 pidl "break;";
 451                 deindent;
 452                 pidl "";
 453         }
 454
 455         deindent;
 456         pidl "}";
 457         pidl "";
 458         pidl "return True;";
 459         deindent;
 460         pidl "}";
 461
 462 }
 463
 464 sub CreateFnDirection($$$$$)
 465 {
 466         my ($fn,$ifn,$s,$all,$es) = @_;
 467
 468         my $args = "";
 469         foreach (@$all) { $args .= ", " . DeclLong($_); }
 470
 471         my $env = { };
 472         GenerateEnvElement($_, $env) foreach (@$es);
 473
 474         pidl "BOOL $ifn($s *v$args)";
 475         pidl "{";
 476         indent;
 477         pidl "DEBUG(5,(\"$ifn\\n\"));";
 478         pidl "";
 479         # Call init for all arguments
 480         foreach (@$es) {
 481                 InitLevel($_, $_->{LEVELS}[0], $_->{NAME}, $env);
 482                 pidl "";
 483         }
 484         pidl "return True;";
 485         deindent;
 486         pidl "}";
 487         pidl "";
 488
 489         pidl "BOOL $fn(const char *desc, $s *v, prs_struct *ps, int depth)";
 490         pidl "{";
 491         indent;
 492         DeclareArrayVariables($es);
 493         pidl "if (v == NULL)";
 494         pidl "\treturn False;";
 495         pidl "";
 496         pidl "prs_debug(ps, depth, desc, \"$fn\");";
 497         pidl "depth++;";
 498
 499         my $align = 8;
 500         foreach (@$es) {
 501                 ParseElement($_, $env, PRIMITIVES, \$align);
 502                 ParseElement($_, $env, DEFERRED, \$align);
 503                 pidl "";
 504         }
 505
 506         pidl "return True;";
 507         deindent;
 508         pidl "}";
 509         pidl "";
 510 }
 511
 512 sub ParseFunction($$)
 513 {
 514         my ($if,$fn) = @_;
 515
 516         my @in = ();
 517         my @out = ();
 518         my @all = @{$fn->{ELEMENTS}};
 519
 520         foreach (@{$fn->{ELEMENTS}}) {
 521                 push (@in, $_) if (grep(/in/, @{$_->{DIRECTION}}));
 522                 push (@out, $_) if (grep(/out/, @{$_->{DIRECTION}}));
 523         }
 524
 525         if (defined($fn->{RETURN_TYPE})) {
 526                 my $status = {
 527                         NAME => "status",
 528                         TYPE => $fn->{RETURN_TYPE},
 529                         LEVELS => [
 530                                 {
 531                                         TYPE => "DATA",
 532                                         DATA_TYPE => $fn->{RETURN_TYPE}
 533                                 }
 534                         ]
 535                 };
 536
 537                 push (@out, $status);
 538                 push (@all, $status);
 539         }
 540
 541         CreateFnDirection("$if->{NAME}_io_q_$fn->{NAME}",
 542                                  "init_$if->{NAME}_q_$fn->{NAME}",
 543                                  uc("$if->{NAME}_q_$fn->{NAME}"),
 544                                  \@in, \@in);
 545         CreateFnDirection("$if->{NAME}_io_r_$fn->{NAME}",
 546                                  "init_$if->{NAME}_r_$fn->{NAME}",
 547                                  uc("$if->{NAME}_r_$fn->{NAME}"),
 548                                  \@all, \@out);
 549 }
 550
 551 sub ParseInterface($)
 552 {
 553         my $if = shift;
 554
 555         # Structures first
 556         pidl "/* $if->{NAME} structures */";
 557         foreach (@{$if->{TYPEDEFS}}) {
 558                 ParseStruct($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "STRUCT");
 559                 ParseUnion($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "UNION");
 560         }
 561
 562         pidl "/* $if->{NAME} functions */";
 563         ParseFunction($if, $_) foreach (@{$if->{FUNCTIONS}});
 564 }
 565
 566 sub Parse($$)
 567 {
 568         my($ndr,$filename) = @_;
 569
 570         $tabs = "";
 571         $res = "";
 572
 573         pidl "/*";
 574         pidl " * Unix SMB/CIFS implementation.";
 575         pidl " * parser auto-generated by pidl. DO NOT MODIFY!";
 576         pidl " */";
 577         pidl "";
 578         pidl "#include \"includes.h\"";
 579         pidl "";
 580         pidl "#undef DBGC_CLASS";
 581         pidl "#define DBGC_CLASS DBGC_RPC_PARSE";
 582         pidl "";
 583
 584         foreach (@$ndr) {
 585                 ParseInterface($_) if ($_->{TYPE} eq "INTERFACE");
 586         }
 587
 588         return $res;
 589 }
 590
 591 1;