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