source4/pidl/lib/Parse/Pidl/Samba4/EJS.pm

   1 ###################################################
   2 # EJS function wrapper generator
   3 # Copyright jelmer@samba.org 2005
   4 # Copyright Andrew Tridgell 2005
   5 # released under the GNU GPL
   6
   7 package Parse::Pidl::Samba4::EJS;
   8
   9 use Exporter;
  10 @ISA = qw(Exporter);
  11 @EXPORT_OK = qw(get_pointer_to get_value_of check_null_pointer $res
  12                 $res_hdr fn_declare);
  13
  14 use strict;
  15 use Parse::Pidl::Typelist;
  16 use Parse::Pidl::Util qw(has_property ParseExpr);
  17 use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel);
  18 use Parse::Pidl::Samba4::NDR::Parser qw(GenerateStructEnv GenerateFunctionInEnv
  19                                         GenerateFunctionOutEnv);
  20
  21 use vars qw($VERSION);
  22 $VERSION = '0.01';
  23
  24 our $res;
  25 our $res_hdr;
  26
  27 my %constants;
  28
  29 my $tabs = "";
  30
  31 sub pidl_hdr ($)
  32 {
  33         $res_hdr .= shift;
  34 }
  35
  36 sub pidl($)
  37 {
  38         my $d = shift;
  39         if ($d) {
  40                 $res .= $tabs;
  41                 $res .= $d;
  42         }
  43         $res .= "\n";
  44 }
  45
  46 sub indent()
  47 {
  48         $tabs .= "\t";
  49 }
  50
  51 sub deindent()
  52 {
  53         $tabs = substr($tabs, 0, -1);
  54 }
  55
  56 sub get_pointer_to($)
  57 {
  58         my $var_name = shift;
  59
  60         if ($var_name =~ /^\*(.*)$/) {
  61                 return $1;
  62         } elsif ($var_name =~ /^\&(.*)$/) {
  63                 return "&($var_name)";
  64         } else {
  65                 return "&$var_name";
  66         }
  67 }
  68
  69 sub get_value_of($)
  70 {
  71         my $var_name = shift;
  72
  73         if ($var_name =~ /^\&(.*)$/) {
  74                 return $1;
  75         } else {
  76                 return "*$var_name";
  77         }
  78 }
  79
  80 #####################################################################
  81 # check that a variable we get from ParseExpr isn't a null pointer
  82 sub check_null_pointer($)
  83 {
  84         my $size = shift;
  85         if ($size =~ /^\*/) {
  86                 my $size2 = substr($size, 1);
  87                 pidl "if ($size2 == NULL) return NT_STATUS_INVALID_PARAMETER_MIX;";
  88         }
  89 }
  90
  91 #####################################################################
  92 # work out is a parse function should be declared static or not
  93 sub fn_declare($$)
  94 {
  95         my ($fn,$decl) = @_;
  96
  97         if (has_property($fn, "public")) {
  98                 pidl_hdr "$decl;\n";
  99                 pidl "_PUBLIC_ $decl";
 100         } else {
 101                 pidl "static $decl";
 102         }
 103 }
 104
 105 ###########################
 106 # pull a scalar element
 107 sub EjsPullScalar($$$$$)
 108 {
 109         my ($e, $l, $var, $name, $env) = @_;
 110
 111         return if (has_property($e, "value"));
 112
 113         if (ref($e->{TYPE}) eq "HASH" and not defined($e->{TYPE}->{NAME})) {
 114                 EjsTypePull($e->{TYPE}, $var);
 115         } else {
 116                 my $pl = Parse::Pidl::NDR::GetPrevLevel($e, $l);
 117         $var = get_pointer_to($var);
 118         # have to handle strings specially :(
 119                 if (Parse::Pidl::Typelist::scalar_is_reference($e->{TYPE})
 120                         and (defined($pl) and $pl->{TYPE} eq "POINTER")) {
 121                 $var = get_pointer_to($var);
 122         }
 123
 124         my $t;
 125                 if (ref($e->{TYPE}) eq "HASH") {
 126                         $t = "$e->{TYPE}->{TYPE}_$e->{TYPE}->{NAME}";
 127                 } else {
 128                         $t = $e->{TYPE};
 129                 }
 130                 pidl "NDR_CHECK(ejs_pull_$t(ejs, v, $name, $var));";
 131         }
 132 }
 133
 134 ###########################
 135 # pull a pointer element
 136 sub EjsPullPointer($$$$$)
 137 {
 138         my ($e, $l, $var, $name, $env) = @_;
 139         pidl "if (ejs_pull_null(ejs, v, $name)) {";
 140         indent;
 141         if ($l->{POINTER_TYPE} eq "ref") {
 142                 pidl "return NT_STATUS_INVALID_PARAMETER_MIX;";
 143         } else {
 144                 pidl "$var = NULL;";
 145         }
 146         deindent;
 147         pidl "} else {";
 148         indent;
 149         pidl "EJS_ALLOC(ejs, $var);";
 150         $var = get_value_of($var);
 151         EjsPullElement($e, GetNextLevel($e, $l), $var, $name, $env);
 152         deindent;
 153         pidl "}";
 154 }
 155
 156 ###########################
 157 # pull a string element
 158 sub EjsPullString($$$$$)
 159 {
 160         my ($e, $l, $var, $name, $env) = @_;
 161         my $pl = GetPrevLevel($e, $l);
 162         $var = get_pointer_to($var);
 163         if (defined($pl) and $pl->{TYPE} eq "POINTER") {
 164                 $var = get_pointer_to($var);
 165         }
 166         pidl "NDR_CHECK(ejs_pull_string(ejs, v, $name, $var));";
 167 }
 168
 169 ###########################
 170 # pull an array element
 171 sub EjsPullArray($$$$$)
 172 {
 173         my ($e, $l, $var, $name, $env) = @_;
 174         my $nl = GetNextLevel($e, $l);
 175         my $length = ParseExpr($l->{LENGTH_IS}, $env, $e);
 176         my $size = ParseExpr($l->{SIZE_IS}, $env, $e);
 177         my $pl = GetPrevLevel($e, $l);
 178         if ($pl && $pl->{TYPE} eq "POINTER") {
 179                 $var = get_pointer_to($var);
 180         }
 181         # uint8 arrays are treated as data blobs
 182         if ($nl->{TYPE} eq 'DATA' && $e->{TYPE} eq 'uint8') {
 183                 if (!$l->{IS_FIXED}) {
 184                         check_null_pointer($size);
 185                         pidl "EJS_ALLOC_N(ejs, $var, $size);";
 186                 }
 187                 check_null_pointer($length);
 188                 pidl "ejs_pull_array_uint8(ejs, v, $name, $var, $length);";
 189                 return;
 190         }
 191         my $avar = $var . "[i]";
 192         pidl "{";
 193         indent;
 194         pidl "uint32_t i;";
 195         if (!$l->{IS_FIXED}) {
 196                 pidl "EJS_ALLOC_N(ejs, $var, $size);";
 197         }
 198         pidl "for (i=0;i<$length;i++) {";
 199         indent;
 200         pidl "char *id = talloc_asprintf(ejs, \"%s.%u\", $name, i);";
 201         EjsPullElement($e, $nl, $avar, "id", $env);
 202         pidl "talloc_free(id);";
 203         deindent;
 204         pidl "}";
 205         pidl "ejs_push_uint32(ejs, v, $name \".length\", &i);";
 206         deindent;
 207         pidl "}";
 208 }
 209
 210 ###########################
 211 # pull a switch element
 212 sub EjsPullSwitch($$$$$)
 213 {
 214         my ($e, $l, $var, $name, $env) = @_;
 215         my $switch_var = ParseExpr($l->{SWITCH_IS}, $env, $e);
 216         pidl "ejs_set_switch(ejs, $switch_var);";
 217         EjsPullElement($e, GetNextLevel($e, $l), $var, $name, $env);
 218 }
 219
 220 ###########################
 221 # pull a structure element
 222 sub EjsPullElement($$$$$)
 223 {
 224         my ($e, $l, $var, $name, $env) = @_;
 225         if (($l->{TYPE} eq "POINTER")) {
 226                 EjsPullPointer($e, $l, $var, $name, $env);
 227         } elsif (has_property($e, "charset")) {
 228                 EjsPullString($e, $l, $var, $name, $env);
 229         } elsif ($l->{TYPE} eq "ARRAY") {
 230                 EjsPullArray($e, $l, $var, $name, $env);
 231         } elsif ($l->{TYPE} eq "DATA") {
 232                 EjsPullScalar($e, $l, $var, $name, $env);
 233         } elsif (($l->{TYPE} eq "SWITCH")) {
 234                 EjsPullSwitch($e, $l, $var, $name, $env);
 235         } else {
 236                 pidl "return ejs_panic(ejs, \"unhandled pull type $l->{TYPE}\");";
 237         }
 238 }
 239
 240 #############################################
 241 # pull a structure/union element at top level
 242 sub EjsPullElementTop($$)
 243 {
 244         my ($e, $env) = @_;
 245         my $l = $e->{LEVELS}[0];
 246         my $var = ParseExpr($e->{NAME}, $env, $e);
 247         my $name = "\"$e->{NAME}\"";
 248         EjsPullElement($e, $l, $var, $name, $env);
 249 }
 250
 251 ###########################
 252 # pull a struct
 253 sub EjsStructPull($$)
 254 {
 255         my ($d, $varname) = @_;
 256         my $env = GenerateStructEnv($d, $varname);
 257         pidl "NDR_CHECK(ejs_pull_struct_start(ejs, &v, name));";
 258     foreach my $e (@{$d->{ELEMENTS}}) {
 259                 EjsPullElementTop($e, $env);
 260         }
 261 }
 262
 263 ###########################
 264 # pull a union
 265 sub EjsUnionPull($$)
 266 {
 267         my ($d, $varname) = @_;
 268         my $have_default = 0;
 269         pidl "NDR_CHECK(ejs_pull_struct_start(ejs, &v, name));";
 270         pidl "switch (ejs->switch_var) {";
 271         indent;
 272         foreach my $e (@{$d->{ELEMENTS}}) {
 273                 if ($e->{CASE} eq "default") {
 274                         $have_default = 1;
 275                 }
 276                 pidl "$e->{CASE}:";
 277                 indent;
 278                 if ($e->{TYPE} ne "EMPTY") {
 279                         EjsPullElementTop($e, { $e->{NAME} => "$varname->$e->{NAME}"});
 280                 }
 281                 pidl "break;";
 282                 deindent;
 283         }
 284         if (! $have_default) {
 285                 pidl "default:";
 286                 indent;
 287                 pidl "return ejs_panic(ejs, \"Bad switch value\");";
 288                 deindent;
 289         }
 290         deindent;
 291         pidl "}";
 292 }
 293
 294 ##############################################
 295 # put the enum elements in the constants array
 296 sub EjsEnumConstant($)
 297 {
 298         my $d = shift;
 299         my $v = 0;
 300         foreach my $e (@{$d->{ELEMENTS}}) {
 301                 my $el = $e;
 302                 chomp $el;
 303                 if ($el =~ /^(.*)=\s*(.*)\s*$/) {
 304                         $el = $1;
 305                         $v = $2;
 306                 }
 307                 $constants{$el} = $v;
 308                 $v++;
 309         }
 310 }
 311
 312 ###########################
 313 # pull a enum
 314 sub EjsEnumPull($$)
 315 {
 316         my ($d, $varname) = @_;
 317         EjsEnumConstant($d);
 318         pidl "unsigned e;";
 319         pidl "NDR_CHECK(ejs_pull_enum(ejs, v, name, &e));";
 320         pidl "*$varname = e;";
 321 }
 322
 323 ###########################
 324 # pull a bitmap
 325 sub EjsBitmapPull($$)
 326 {
 327         my ($d, $varname) = @_;
 328         my $type_fn = $d->{BASE_TYPE};
 329         pidl "NDR_CHECK(ejs_pull_$type_fn(ejs, v, name, $varname));";
 330 }
 331
 332 sub EjsTypePullFunction($$)
 333 {
 334         sub EjsTypePullFunction($$);
 335         my ($d, $name) = @_;
 336         return if (has_property($d, "noejs"));
 337
 338         if ($d->{TYPE} eq "TYPEDEF") {
 339                 EjsTypePullFunction($d->{DATA}, $name);
 340                 return;
 341         }
 342
 343         if ($d->{TYPE} eq "STRUCT") {
 344                 fn_declare($d, "NTSTATUS ejs_pull_$name(struct ejs_rpc *ejs, struct MprVar *v, const char *name, struct $name *r)");
 345         } elsif ($d->{TYPE} eq "UNION") {
 346                 fn_declare($d, "NTSTATUS ejs_pull_$name(struct ejs_rpc *ejs, struct MprVar *v, const char *name, union $name *r)");
 347         } elsif ($d->{TYPE} eq "ENUM") {
 348                 fn_declare($d, "NTSTATUS ejs_pull_$name(struct ejs_rpc *ejs, struct MprVar *v, const char *name, enum $name *r)");
 349         } elsif ($d->{TYPE} eq "BITMAP") {
 350                 my($type_decl) = Parse::Pidl::Typelist::mapTypeName($d->{BASE_TYPE});
 351                 fn_declare($d, "NTSTATUS ejs_pull_$name(struct ejs_rpc *ejs, struct MprVar *v, const char *name, $type_decl *r)");
 352         }
 353         pidl "{";
 354         indent;
 355
 356         EjsTypePull($d, "r");
 357
 358         pidl "return NT_STATUS_OK;";
 359         deindent;
 360         pidl "}\n";
 361 }
 362
 363 sub EjsTypePull($$)
 364 {
 365         my ($d, $varname) = @_;
 366         if ($d->{TYPE} eq 'STRUCT') {
 367                 EjsStructPull($d, $varname);
 368         } elsif ($d->{TYPE} eq 'UNION') {
 369                 EjsUnionPull($d, $varname);
 370         } elsif ($d->{TYPE} eq 'ENUM') {
 371                 EjsEnumPull($d, $varname);
 372         } elsif ($d->{TYPE} eq 'BITMAP') {
 373                 EjsBitmapPull($d, $varname);
 374         } else {
 375                 warn "Unhandled pull $varname of type $d->{TYPE}";
 376         }
 377 }
 378
 379 #####################
 380 # generate a function
 381 sub EjsPullFunction($)
 382 {
 383         my $d = shift;
 384         my $env = GenerateFunctionInEnv($d);
 385         my $name = $d->{NAME};
 386
 387         pidl "\nstatic NTSTATUS ejs_pull_$name(struct ejs_rpc *ejs, struct MprVar *v, struct $name *r)";
 388         pidl "{";
 389         indent;
 390         pidl "NDR_CHECK(ejs_pull_struct_start(ejs, &v, \"input\"));";
 391
 392         # we pull non-array elements before array elements as arrays
 393         # may have length_is() or size_is() properties that depend
 394         # on the non-array elements
 395         foreach my $e (@{$d->{ELEMENTS}}) {
 396                 next unless (grep(/in/, @{$e->{DIRECTION}}));
 397                 next if (has_property($e, "length_is") || has_property($e, "size_is"));
 398                 EjsPullElementTop($e, $env);
 399         }
 400
 401         foreach my $e (@{$d->{ELEMENTS}}) {
 402                 next unless (grep(/in/, @{$e->{DIRECTION}}));
 403                 next unless (has_property($e, "length_is") || has_property($e, "size_is"));
 404                 EjsPullElementTop($e, $env);
 405         }
 406
 407         pidl "return NT_STATUS_OK;";
 408         deindent;
 409         pidl "}\n";
 410 }
 411
 412 ###########################
 413 # push a scalar element
 414 sub EjsPushScalar($$$$$)
 415 {
 416         my ($e, $l, $var, $name, $env) = @_;
 417
 418         if (ref($e->{TYPE}) eq "HASH" and not defined($e->{TYPE}->{NAME})) {
 419                 EjsTypePush($e->{TYPE}, get_pointer_to($var));
 420         } else {
 421     # have to handle strings specially :(
 422         my $pl = GetPrevLevel($e, $l);
 423
 424                 if ((not Parse::Pidl::Typelist::scalar_is_reference($e->{TYPE}))
 425                         or (defined($pl) and $pl->{TYPE} eq "POINTER")) {
 426                                         $var = get_pointer_to($var);
 427                         }
 428
 429                 my $t;
 430                 if (ref($e->{TYPE}) eq "HASH") {
 431                         $t = "$e->{TYPE}->{TYPE}_$e->{TYPE}->{NAME}";
 432                 } else {
 433                         $t = $e->{TYPE};
 434                 }
 435
 436                 pidl "NDR_CHECK(ejs_push_$t(ejs, v, $name, $var));";
 437         }
 438 }
 439
 440 ###########################
 441 # push a string element
 442 sub EjsPushString($$$$$)
 443 {
 444         my ($e, $l, $var, $name, $env) = @_;
 445         my $pl = GetPrevLevel($e, $l);
 446         if (defined($pl) and $pl->{TYPE} eq "POINTER") {
 447                 $var = get_pointer_to($var);
 448         }
 449         pidl "NDR_CHECK(ejs_push_string(ejs, v, $name, $var));";
 450 }
 451
 452 ###########################
 453 # push a pointer element
 454 sub EjsPushPointer($$$$$)
 455 {
 456         my ($e, $l, $var, $name, $env) = @_;
 457         pidl "if (NULL == $var) {";
 458         indent;
 459         if ($l->{POINTER_TYPE} eq "ref") {
 460                 pidl "return NT_STATUS_INVALID_PARAMETER_MIX;";
 461         } else {
 462                 pidl "NDR_CHECK(ejs_push_null(ejs, v, $name));";
 463         }
 464         deindent;
 465         pidl "} else {";
 466         indent;
 467         $var = get_value_of($var);
 468         EjsPushElement($e, GetNextLevel($e, $l), $var, $name, $env);
 469         deindent;
 470         pidl "}";
 471 }
 472
 473 ###########################
 474 # push a switch element
 475 sub EjsPushSwitch($$$$$)
 476 {
 477         my ($e, $l, $var, $name, $env) = @_;
 478         my $switch_var = ParseExpr($l->{SWITCH_IS}, $env, $e);
 479         pidl "ejs_set_switch(ejs, $switch_var);";
 480         EjsPushElement($e, GetNextLevel($e, $l), $var, $name, $env);
 481 }
 482
 483 ###########################
 484 # push an array element
 485 sub EjsPushArray($$$$$)
 486 {
 487         my ($e, $l, $var, $name, $env) = @_;
 488         my $nl = GetNextLevel($e, $l);
 489         my $length = ParseExpr($l->{LENGTH_IS}, $env, $e);
 490         my $pl = GetPrevLevel($e, $l);
 491         if ($pl && $pl->{TYPE} eq "POINTER") {
 492                 $var = get_pointer_to($var);
 493         }
 494         # uint8 arrays are treated as data blobs
 495         if ($nl->{TYPE} eq 'DATA' && $e->{TYPE} eq 'uint8') {
 496                 check_null_pointer($length);
 497                 pidl "ejs_push_array_uint8(ejs, v, $name, $var, $length);";
 498                 return;
 499         }
 500         my $avar = $var . "[i]";
 501         pidl "{";
 502         indent;
 503         pidl "uint32_t i;";
 504         pidl "for (i=0;i<$length;i++) {";
 505         indent;
 506         pidl "const char *id = talloc_asprintf(ejs, \"%s.%u\", $name, i);";
 507         EjsPushElement($e, $nl, $avar, "id", $env);
 508         deindent;
 509         pidl "}";
 510         pidl "ejs_push_uint32(ejs, v, $name \".length\", &i);";
 511         deindent;
 512         pidl "}";
 513 }
 514
 515 ################################
 516 # push a structure/union element
 517 sub EjsPushElement($$$$$)
 518 {
 519         my ($e, $l, $var, $name, $env) = @_;
 520         if (($l->{TYPE} eq "POINTER")) {
 521                 EjsPushPointer($e, $l, $var, $name, $env);
 522         } elsif (has_property($e, "charset")) {
 523                 EjsPushString($e, $l, $var, $name, $env);
 524         } elsif ($l->{TYPE} eq "ARRAY") {
 525                 EjsPushArray($e, $l, $var, $name, $env);
 526         } elsif ($l->{TYPE} eq "DATA") {
 527                 EjsPushScalar($e, $l, $var, $name, $env);
 528         } elsif (($l->{TYPE} eq "SWITCH")) {
 529                 EjsPushSwitch($e, $l, $var, $name, $env);
 530         } else {
 531                 pidl "return ejs_panic(ejs, \"unhandled push type $l->{TYPE}\");";
 532         }
 533 }
 534
 535 #############################################
 536 # push a structure/union element at top level
 537 sub EjsPushElementTop($$)
 538 {
 539         my ($e, $env) = @_;
 540         my $l = $e->{LEVELS}[0];
 541         my $var = ParseExpr($e->{NAME}, $env, $e);
 542         my $name = "\"$e->{NAME}\"";
 543         EjsPushElement($e, $l, $var, $name, $env);
 544 }
 545
 546 ###########################
 547 # push a struct
 548 sub EjsStructPush($$)
 549 {
 550         my ($d, $varname) = @_;
 551         my $env = GenerateStructEnv($d, $varname);
 552         pidl "NDR_CHECK(ejs_push_struct_start(ejs, &v, name));";
 553         foreach my $e (@{$d->{ELEMENTS}}) {
 554                 EjsPushElementTop($e, $env);
 555         }
 556 }
 557
 558 ###########################
 559 # push a union
 560 sub EjsUnionPush($$)
 561 {
 562         my ($d, $varname) = @_;
 563         my $have_default = 0;
 564         pidl "NDR_CHECK(ejs_push_struct_start(ejs, &v, name));";
 565         pidl "switch (ejs->switch_var) {";
 566         indent;
 567         foreach my $e (@{$d->{ELEMENTS}}) {
 568                 if ($e->{CASE} eq "default") {
 569                         $have_default = 1;
 570                 }
 571                 pidl "$e->{CASE}:";
 572                 indent;
 573                 if ($e->{TYPE} ne "EMPTY") {
 574                         EjsPushElementTop($e, { $e->{NAME} => "$varname->$e->{NAME}"} );
 575                 }
 576                 pidl "break;";
 577                 deindent;
 578         }
 579         if (! $have_default) {
 580                 pidl "default:";
 581                 indent;
 582                 pidl "return ejs_panic(ejs, \"Bad switch value\");";
 583                 deindent;
 584         }
 585         deindent;
 586         pidl "}";
 587 }
 588
 589 ###########################
 590 # push a enum
 591 sub EjsEnumPush($$)
 592 {
 593         my ($d, $varname) = @_;
 594         EjsEnumConstant($d);
 595         pidl "unsigned e = ".get_value_of($varname).";";
 596         pidl "NDR_CHECK(ejs_push_enum(ejs, v, name, &e));";
 597 }
 598
 599 ###########################
 600 # push a bitmap
 601 sub EjsBitmapPush($$)
 602 {
 603         my ($d, $varname) = @_;
 604         my $type_fn = $d->{BASE_TYPE};
 605         # put the bitmap elements in the constants array
 606         foreach my $e (@{$d->{ELEMENTS}}) {
 607                 if ($e =~ /^(\w*)\s*(.*)\s*$/) {
 608                         my $bname = $1;
 609                         my $v = $2;
 610                         $constants{$bname} = $v;
 611                 }
 612         }
 613         pidl "NDR_CHECK(ejs_push_$type_fn(ejs, v, name, $varname));";
 614 }
 615
 616 sub EjsTypePushFunction($$)
 617 {
 618         sub EjsTypePushFunction($$);
 619         my ($d, $name) = @_;
 620         return if (has_property($d, "noejs"));
 621
 622         if ($d->{TYPE} eq "TYPEDEF") {
 623                 EjsTypePushFunction($d->{DATA}, $name);
 624                 return;
 625         }
 626
 627         if ($d->{TYPE} eq "STRUCT") {
 628                 fn_declare($d, "NTSTATUS ejs_push_$name(struct ejs_rpc *ejs, struct MprVar *v, const char *name, const struct $name *r)");
 629         } elsif ($d->{TYPE} eq "UNION") {
 630                 fn_declare($d, "NTSTATUS ejs_push_$name(struct ejs_rpc *ejs, struct MprVar *v, const char *name, const union $name *r)");
 631         } elsif ($d->{TYPE} eq "ENUM") {
 632                 fn_declare($d, "NTSTATUS ejs_push_$name(struct ejs_rpc *ejs, struct MprVar *v, const char *name, const enum $name *r)");
 633         } elsif ($d->{TYPE} eq "BITMAP") {
 634                 my($type_decl) = Parse::Pidl::Typelist::mapTypeName($d->{BASE_TYPE});
 635                 fn_declare($d, "NTSTATUS ejs_push_$name(struct ejs_rpc *ejs, struct MprVar *v, const char *name, const $type_decl *r)");
 636         }
 637         pidl "{";
 638         indent;
 639         EjsTypePush($d, "r");
 640         pidl "return NT_STATUS_OK;";
 641         deindent;
 642         pidl "}\n";
 643 }
 644
 645 sub EjsTypePush($$)
 646 {
 647         my ($d, $varname) = @_;
 648
 649         if ($d->{TYPE} eq 'STRUCT') {
 650                 EjsStructPush($d, $varname);
 651         } elsif ($d->{TYPE} eq 'UNION') {
 652                 EjsUnionPush($d, $varname);
 653         } elsif ($d->{TYPE} eq 'ENUM') {
 654                 EjsEnumPush($d, $varname);
 655         } elsif ($d->{TYPE} eq 'BITMAP') {
 656                 EjsBitmapPush($d, $varname);
 657         } else {
 658                 warn "Unhandled push $varname of type $d->{TYPE}";
 659         }
 660 }
 661
 662 #####################
 663 # generate a function
 664 sub EjsPushFunction($)
 665 {
 666         my $d = shift;
 667         my $env = GenerateFunctionOutEnv($d);
 668
 669         pidl "\nstatic NTSTATUS ejs_push_$d->{NAME}(struct ejs_rpc *ejs, struct MprVar *v, const struct $d->{NAME} *r)";
 670         pidl "{";
 671         indent;
 672         pidl "NDR_CHECK(ejs_push_struct_start(ejs, &v, \"output\"));";
 673
 674         foreach my $e (@{$d->{ELEMENTS}}) {
 675                 next unless (grep(/out/, @{$e->{DIRECTION}}));
 676                 EjsPushElementTop($e, $env);
 677         }
 678
 679         if ($d->{RETURN_TYPE}) {
 680                 my $t = $d->{RETURN_TYPE};
 681                 pidl "NDR_CHECK(ejs_push_$t(ejs, v, \"result\", &r->out.result));";
 682         }
 683
 684         pidl "return NT_STATUS_OK;";
 685         deindent;
 686         pidl "}\n";
 687 }
 688
 689 #################################
 690 # generate a ejs mapping function
 691 sub EjsFunction($$)
 692 {
 693         my ($d, $iface) = @_;
 694         my $name = $d->{NAME};
 695         my $callnum = uc("DCERPC_$name");
 696         my $table = "&dcerpc_table_$iface";
 697
 698         pidl "static int ejs_$name(int eid, int argc, struct MprVar **argv)";
 699         pidl "{";
 700         indent;
 701         pidl "return ejs_rpc_call(eid, argc, argv, $table, $callnum, (ejs_pull_function_t)ejs_pull_$name, (ejs_push_function_t)ejs_push_$name);";
 702         deindent;
 703         pidl "}\n";
 704 }
 705
 706 ###################
 707 # handle a constant
 708 sub EjsConst($)
 709 {
 710     my $const = shift;
 711     $constants{$const->{NAME}} = $const->{VALUE};
 712 }
 713
 714 sub EjsImport
 715 {
 716         my @imports = @_;
 717         foreach (@imports) {
 718                 s/\.idl\"$//;
 719                 s/^\"//;
 720                 pidl_hdr "#include \"librpc/gen_ndr/ndr_$_\_ejs\.h\"\n";
 721         }
 722 }
 723
 724 #####################################################################
 725 # parse the interface definitions
 726 sub EjsInterface($$)
 727 {
 728         my($interface,$needed) = @_;
 729         my @fns = ();
 730         my $name = $interface->{NAME};
 731
 732         %constants = ();
 733
 734         pidl_hdr "#ifndef _HEADER_EJS_$interface->{NAME}\n";
 735         pidl_hdr "#define _HEADER_EJS_$interface->{NAME}\n\n";
 736
 737         pidl_hdr "\n";
 738
 739         foreach my $d (@{$interface->{TYPES}}) {
 740                 ($needed->{"push_$d->{NAME}"}) && EjsTypePushFunction($d, $d->{NAME});
 741                 ($needed->{"pull_$d->{NAME}"}) && EjsTypePullFunction($d, $d->{NAME});
 742         }
 743
 744         foreach my $d (@{$interface->{FUNCTIONS}}) {
 745                 next if not defined($d->{OPNUM});
 746                 next if has_property($d, "noejs");
 747
 748                 EjsPullFunction($d);
 749                 EjsPushFunction($d);
 750                 EjsFunction($d, $name);
 751
 752                 push (@fns, $d->{NAME});
 753         }
 754
 755         foreach my $d (@{$interface->{CONSTS}}) {
 756                 EjsConst($d);
 757         }
 758
 759         pidl "static int ejs_$name\_init(int eid, int argc, struct MprVar **argv)";
 760         pidl "{";
 761         indent;
 762         pidl "struct MprVar *obj = mprInitObject(eid, \"$name\", argc, argv);";
 763         foreach (@fns) {
 764                 pidl "mprSetCFunction(obj, \"$_\", ejs_$_);";
 765         }
 766         foreach my $v (keys %constants) {
 767                 my $value = $constants{$v};
 768                 if (substr($value, 0, 1) eq "\"") {
 769                         pidl "mprSetVar(obj, \"$v\", mprString($value));";
 770                 } else {
 771                         pidl "mprSetVar(obj, \"$v\", mprCreateNumberVar($value));";
 772                 }
 773         }
 774         pidl "return ejs_rpc_init(obj, \"$name\");";
 775         deindent;
 776         pidl "}\n";
 777
 778         pidl "NTSTATUS ejs_init_$name(void)";
 779         pidl "{";
 780         indent;
 781         pidl "ejsDefineCFunction(-1, \"$name\_init\", ejs_$name\_init, NULL, MPR_VAR_SCRIPT_HANDLE);";
 782         pidl "return NT_STATUS_OK;";
 783         deindent;
 784         pidl "}";
 785
 786         pidl_hdr "\n";
 787         pidl_hdr "#endif /* _HEADER_EJS_$interface->{NAME} */\n";
 788 }
 789
 790 #####################################################################
 791 # parse a parsed IDL into a C header
 792 sub Parse($$)
 793 {
 794     my($ndr,$hdr) = @_;
 795
 796     my $ejs_hdr = $hdr;
 797     $ejs_hdr =~ s/.h$/_ejs.h/;
 798     $res = "";
 799         $res_hdr = "";
 800
 801     pidl_hdr "/* header auto-generated by pidl */\n\n";
 802
 803     pidl "
 804 /* EJS wrapper functions auto-generated by pidl */
 805 #include \"includes.h\"
 806 #include \"librpc/rpc/dcerpc.h\"
 807 #include \"lib/appweb/ejs/ejs.h\"
 808 #include \"scripting/ejs/ejsrpc.h\"
 809 #include \"scripting/ejs/smbcalls.h\"
 810 #include \"librpc/gen_ndr/ndr_misc_ejs.h\"
 811 #include \"$hdr\"
 812 #include \"$ejs_hdr\"
 813
 814 ";
 815
 816     my %needed = ();
 817
 818     foreach my $x (@{$ndr}) {
 819             ($x->{TYPE} eq "INTERFACE") && NeededInterface($x, \%needed);
 820     }
 821
 822     foreach my $x (@$ndr) {
 823             ($x->{TYPE} eq "INTERFACE") && EjsInterface($x, \%needed);
 824                 ($x->{TYPE} eq "IMPORT") && EjsImport(@{$x->{PATHS}});
 825     }
 826
 827     return ($res_hdr, $res);
 828 }
 829
 830 sub NeededFunction($$)
 831 {
 832         my ($fn,$needed) = @_;
 833
 834         $needed->{"pull_$fn->{NAME}"} = 1;
 835         $needed->{"push_$fn->{NAME}"} = 1;
 836
 837         foreach (@{$fn->{ELEMENTS}}) {
 838                 next if (has_property($_, "subcontext")); #FIXME: Support subcontexts
 839                 if (grep(/in/, @{$_->{DIRECTION}})) {
 840                         $needed->{"pull_$_->{TYPE}"} = 1;
 841                 }
 842                 if (grep(/out/, @{$_->{DIRECTION}})) {
 843                         $needed->{"push_$_->{TYPE}"} = 1;
 844                 }
 845         }
 846 }
 847
 848 sub NeededType($$$)
 849 {
 850         sub NeededType($$$);
 851         my ($t,$needed,$req) = @_;
 852
 853         NeededType($t->{DATA}, $needed, $req) if ($t->{TYPE} eq "TYPEDEF");
 854
 855         return if (($t->{TYPE} ne "STRUCT") and
 856                            ($t->{TYPE} ne "UNION"));
 857
 858         foreach (@{$t->{ELEMENTS}}) {
 859                 next if (has_property($_, "subcontext")); #FIXME: Support subcontexts
 860                 my $n;
 861                 if (ref($_->{TYPE}) eq "HASH" and defined($_->{TYPE}->{NAME})) {
 862                         $needed->{"$req\_$_->{TYPE}->{TYPE}_$_->{TYPE}->{NAME}"} = 1;
 863                 } elsif (ref($_->{TYPE}) ne "HASH") {
 864                         $needed->{$req."_".$_->{TYPE}} = 1;
 865                 }
 866                 NeededType($_->{TYPE}, $needed, $req) if (ref($_->{TYPE}) eq "HASH");
 867         }
 868 }
 869
 870 #####################################################################
 871 # work out what parse functions are needed
 872 sub NeededInterface($$)
 873 {
 874         my ($interface,$needed) = @_;
 875
 876         NeededFunction($_, $needed) foreach (@{$interface->{FUNCTIONS}});
 877
 878         foreach (reverse @{$interface->{TYPES}}) {
 879                 if (has_property($_, "public")) {
 880                         $needed->{"pull_$_->{NAME}"} = not has_property($_, "noejs");
 881                         $needed->{"push_$_->{NAME}"} = not has_property($_, "noejs");
 882                 }
 883
 884                 NeededType($_, $needed, "pull")  if ($needed->{"pull_$_->{NAME}"});
 885                 NeededType($_, $needed, "push")  if ($needed->{"push_$_->{NAME}"});
 886         }
 887 }
 888
 889 1;