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