pidl/lib/Parse/Pidl/Samba4/Header.pm

   1 ###################################################
   2 # create C header files for an IDL structure
   3 # Copyright tridge@samba.org 2000
   4 # Copyright jelmer@samba.org 2005
   5 # released under the GNU GPL
   6
   7 package Parse::Pidl::Samba4::Header;
   8 require Exporter;
   9
  10 @ISA = qw(Exporter);
  11 @EXPORT_OK = qw(GenerateFunctionInEnv GenerateFunctionOutEnv EnvSubstituteValue GenerateStructEnv);
  12
  13 use strict;
  14 use Parse::Pidl qw(fatal);
  15 use Parse::Pidl::Typelist qw(mapTypeName scalar_is_reference);
  16 use Parse::Pidl::Util qw(has_property is_constant unmake_str ParseExpr);
  17 use Parse::Pidl::Samba4 qw(is_intree ElementStars ArrayBrackets choose_header);
  18
  19 use vars qw($VERSION);
  20 $VERSION = '0.01';
  21
  22 my($res);
  23 my($tab_depth);
  24
  25 sub pidl($) { $res .= shift; }
  26
  27 sub tabs()
  28 {
  29         my $res = "";
  30         $res .="\t" foreach (1..$tab_depth);
  31         return $res;
  32 }
  33
  34 #####################################################################
  35 # parse a properties list
  36 sub HeaderProperties($$)
  37 {
  38         my($props,$ignores) = @_;
  39         my $ret = "";
  40
  41         foreach my $d (keys %{$props}) {
  42                 next if (grep(/^$d$/, @$ignores));
  43                 if($props->{$d} ne "1") {
  44                         $ret.= "$d($props->{$d}),";
  45                 } else {
  46                         $ret.="$d,";
  47                 }
  48         }
  49
  50         if ($ret) {
  51                 pidl "/* [" . substr($ret, 0, -1) . "] */";
  52         }
  53 }
  54
  55 #####################################################################
  56 # parse a structure element
  57 sub HeaderElement($)
  58 {
  59         my($element) = shift;
  60
  61         pidl tabs();
  62         if (has_property($element, "represent_as")) {
  63                 pidl mapTypeName($element->{PROPERTIES}->{represent_as})." ";
  64         } else {
  65                 if (ref($element->{TYPE}) eq "HASH") {
  66                         HeaderType($element, $element->{TYPE}, $element->{TYPE}->{NAME});
  67                 } else {
  68                         HeaderType($element, $element->{TYPE}, "");
  69                 }
  70                 pidl " ".ElementStars($element);
  71         }
  72         pidl $element->{NAME};
  73         pidl ArrayBrackets($element);
  74
  75         pidl ";";
  76         if (defined $element->{PROPERTIES}) {
  77                 HeaderProperties($element->{PROPERTIES}, ["in", "out"]);
  78         }
  79         pidl "\n";
  80 }
  81
  82 #####################################################################
  83 # parse a struct
  84 sub HeaderStruct($$;$)
  85 {
  86         my($struct,$name,$tail) = @_;
  87         pidl "struct $name";
  88         pidl $tail if defined($tail) and not defined($struct->{ELEMENTS});
  89         return if (not defined($struct->{ELEMENTS}));
  90         pidl " {\n";
  91         $tab_depth++;
  92         my $el_count=0;
  93         foreach (@{$struct->{ELEMENTS}}) {
  94                 HeaderElement($_);
  95                 $el_count++;
  96         }
  97         if ($el_count == 0) {
  98                 # some compilers can't handle empty structures
  99                 pidl tabs()."char _empty_;\n";
 100         }
 101         $tab_depth--;
 102         pidl tabs()."}";
 103         if (defined $struct->{PROPERTIES}) {
 104                 HeaderProperties($struct->{PROPERTIES}, []);
 105         }
 106         pidl $tail if defined($tail);
 107 }
 108
 109 #####################################################################
 110 # parse a enum
 111 sub HeaderEnum($$;$)
 112 {
 113         my($enum,$name,$tail) = @_;
 114         my $first = 1;
 115
 116         pidl "enum $name";
 117         if (defined($enum->{ELEMENTS})) {
 118                 pidl "\n#ifndef USE_UINT_ENUMS\n";
 119                 pidl " {\n";
 120                 $tab_depth++;
 121                 foreach my $e (@{$enum->{ELEMENTS}}) {
 122                         my @enum_els = ();
 123                         unless ($first) { pidl ",\n"; }
 124                         $first = 0;
 125                         pidl tabs();
 126                         @enum_els = split(/=/, $e);
 127                         if (@enum_els == 2) {
 128                                 pidl $enum_els[0];
 129                                 pidl "=(int)";
 130                                 pidl "(";
 131                                 pidl $enum_els[1];
 132                                 pidl ")";
 133                         } else {
 134                                 pidl $e;
 135                         }
 136                 }
 137                 pidl "\n";
 138                 $tab_depth--;
 139                 pidl "}";
 140                 pidl "\n";
 141                 pidl "#else\n";
 142                 my $count = 0;
 143                 my $with_val = 0;
 144                 my $without_val = 0;
 145                 pidl " { __do_not_use_enum_$name=0x7FFFFFFF}\n";
 146                 foreach my $e (@{$enum->{ELEMENTS}}) {
 147                         my $t = "$e";
 148                         my $name;
 149                         my $value;
 150                         if ($t =~ /(.*)=(.*)/) {
 151                                 $name = $1;
 152                                 $value = $2;
 153                                 $with_val = 1;
 154                                 fatal($e->{ORIGINAL}, "you can't mix enum member with values and without values!")
 155                                         unless ($without_val == 0);
 156                         } else {
 157                                 $name = $t;
 158                                 $value = $count++;
 159                                 $without_val = 1;
 160                                 fatal($e->{ORIGINAL}, "you can't mix enum member with values and without values!")
 161                                         unless ($with_val == 0);
 162                         }
 163                         pidl "#define $name ( $value )\n";
 164                 }
 165                 pidl "#endif\n";
 166         }
 167         pidl $tail if defined($tail);
 168 }
 169
 170 #####################################################################
 171 # parse a bitmap
 172 sub HeaderBitmap($$)
 173 {
 174         my($bitmap,$name) = @_;
 175
 176         return unless defined($bitmap->{ELEMENTS});
 177
 178         pidl "/* bitmap $name */\n";
 179         pidl "#define $_\n" foreach (@{$bitmap->{ELEMENTS}});
 180         pidl "\n";
 181 }
 182
 183 #####################################################################
 184 # parse a union
 185 sub HeaderUnion($$;$)
 186 {
 187         my($union,$name,$tail) = @_;
 188         my %done = ();
 189
 190         pidl "union $name";
 191         pidl $tail if defined($tail) and not defined($union->{ELEMENTS});
 192         return if (not defined($union->{ELEMENTS}));
 193         pidl " {\n";
 194         $tab_depth++;
 195         my $needed = 0;
 196         foreach my $e (@{$union->{ELEMENTS}}) {
 197                 if ($e->{TYPE} ne "EMPTY") {
 198                         if (! defined $done{$e->{NAME}}) {
 199                                 HeaderElement($e);
 200                         }
 201                         $done{$e->{NAME}} = 1;
 202                         $needed++;
 203                 }
 204         }
 205         if (!$needed) {
 206                 # sigh - some compilers don't like empty structures
 207                 pidl tabs()."int _dummy_element;\n";
 208         }
 209         $tab_depth--;
 210         pidl "}";
 211
 212         if (defined $union->{PROPERTIES}) {
 213                 HeaderProperties($union->{PROPERTIES}, []);
 214         }
 215         pidl $tail if defined($tail);
 216 }
 217
 218 #####################################################################
 219 # parse a pipe
 220 sub HeaderPipe($$;$)
 221 {
 222         my($pipe,$name,$tail) = @_;
 223
 224         my $struct = $pipe->{DATA};
 225         my $e = $struct->{ELEMENTS}[1];
 226
 227         pidl "struct $name;\n";
 228         pidl "struct $struct->{NAME} {\n";
 229         $tab_depth++;
 230         pidl tabs()."uint32_t count;\n";
 231         pidl tabs().mapTypeName($e->{TYPE})." *array;\n";
 232         $tab_depth--;
 233         pidl "}";
 234
 235         if (defined $struct->{PROPERTIES}) {
 236                 HeaderProperties($struct->{PROPERTIES}, []);
 237         }
 238
 239         pidl $tail if defined($tail);
 240 }
 241
 242 #####################################################################
 243 # parse a type
 244 sub HeaderType($$$;$)
 245 {
 246         my($e,$data,$name,$tail) = @_;
 247         if (ref($data) eq "HASH") {
 248                 ($data->{TYPE} eq "ENUM") && HeaderEnum($data, $name, $tail);
 249                 ($data->{TYPE} eq "BITMAP") && HeaderBitmap($data, $name);
 250                 ($data->{TYPE} eq "STRUCT") && HeaderStruct($data, $name, $tail);
 251                 ($data->{TYPE} eq "UNION") && HeaderUnion($data, $name, $tail);
 252                 ($data->{TYPE} eq "PIPE") && HeaderPipe($data, $name, $tail);
 253                 return;
 254         }
 255
 256         if (has_property($e, "charset")) {
 257                 pidl "const char";
 258         } else {
 259                 pidl mapTypeName($e->{TYPE});
 260         }
 261         pidl $tail if defined($tail);
 262 }
 263
 264 #####################################################################
 265 # parse a typedef
 266 sub HeaderTypedef($;$)
 267 {
 268         my($typedef,$tail) = @_;
 269         # Don't print empty "enum foo;", since some compilers don't like it.
 270         return if ($typedef->{DATA}->{TYPE} eq "ENUM" and not defined($typedef->{DATA}->{ELEMENTS}));
 271         HeaderType($typedef, $typedef->{DATA}, $typedef->{NAME}, $tail) if defined ($typedef->{DATA});
 272 }
 273
 274 #####################################################################
 275 # parse a const
 276 sub HeaderConst($)
 277 {
 278         my($const) = shift;
 279         if (!defined($const->{ARRAY_LEN}[0])) {
 280                 pidl "#define $const->{NAME}\t( $const->{VALUE} )\n";
 281         } else {
 282                 pidl "#define $const->{NAME}\t $const->{VALUE}\n";
 283         }
 284 }
 285
 286 sub ElementDirection($)
 287 {
 288         my ($e) = @_;
 289
 290         return "inout" if (has_property($e, "in") and has_property($e, "out"));
 291         return "in" if (has_property($e, "in"));
 292         return "out" if (has_property($e, "out"));
 293         return "inout";
 294 }
 295
 296 #####################################################################
 297 # parse a function
 298 sub HeaderFunctionInOut($$)
 299 {
 300         my($fn,$prop) = @_;
 301
 302         return unless defined($fn->{ELEMENTS});
 303
 304         foreach my $e (@{$fn->{ELEMENTS}}) {
 305                 HeaderElement($e) if (ElementDirection($e) eq $prop);
 306         }
 307 }
 308
 309 #####################################################################
 310 # determine if we need an "in" or "out" section
 311 sub HeaderFunctionInOut_needed($$)
 312 {
 313         my($fn,$prop) = @_;
 314
 315         return 1 if ($prop eq "out" && defined($fn->{RETURN_TYPE}));
 316
 317         return undef unless defined($fn->{ELEMENTS});
 318
 319         foreach my $e (@{$fn->{ELEMENTS}}) {
 320                 return 1 if (ElementDirection($e) eq $prop);
 321         }
 322
 323         return undef;
 324 }
 325
 326 my %headerstructs;
 327
 328 #####################################################################
 329 # parse a function
 330 sub HeaderFunction($)
 331 {
 332         my($fn) = shift;
 333
 334         return if ($headerstructs{$fn->{NAME}});
 335
 336         $headerstructs{$fn->{NAME}} = 1;
 337
 338         pidl "\nstruct $fn->{NAME} {\n";
 339         $tab_depth++;
 340         my $needed = 0;
 341
 342         if (HeaderFunctionInOut_needed($fn, "in") or
 343             HeaderFunctionInOut_needed($fn, "inout")) {
 344                 pidl tabs()."struct {\n";
 345                 $tab_depth++;
 346                 HeaderFunctionInOut($fn, "in");
 347                 HeaderFunctionInOut($fn, "inout");
 348                 $tab_depth--;
 349                 pidl tabs()."} in;\n\n";
 350                 $needed++;
 351         }
 352
 353         if (HeaderFunctionInOut_needed($fn, "out") or
 354             HeaderFunctionInOut_needed($fn, "inout")) {
 355                 pidl tabs()."struct {\n";
 356                 $tab_depth++;
 357                 HeaderFunctionInOut($fn, "out");
 358                 HeaderFunctionInOut($fn, "inout");
 359                 if (defined($fn->{RETURN_TYPE})) {
 360                         pidl tabs().mapTypeName($fn->{RETURN_TYPE}) . " result;\n";
 361                 }
 362                 $tab_depth--;
 363                 pidl tabs()."} out;\n\n";
 364                 $needed++;
 365         }
 366
 367         if (!$needed) {
 368                 # sigh - some compilers don't like empty structures
 369                 pidl tabs()."int _dummy_element;\n";
 370         }
 371
 372         $tab_depth--;
 373         pidl "};\n\n";
 374 }
 375
 376 sub HeaderImport
 377 {
 378         my @imports = @_;
 379         foreach my $import (@imports) {
 380                 $import = unmake_str($import);
 381                 $import =~ s/\.idl$//;
 382                 pidl choose_header("librpc/gen_ndr/$import\.h", "gen_ndr/$import.h") . "\n";
 383         }
 384 }
 385
 386 sub HeaderInclude
 387 {
 388         my @includes = @_;
 389         foreach (@includes) {
 390                 pidl "#include $_\n";
 391         }
 392 }
 393
 394 #####################################################################
 395 # parse the interface definitions
 396 sub HeaderInterface($)
 397 {
 398         my($interface) = shift;
 399
 400         pidl "#ifndef _HEADER_$interface->{NAME}\n";
 401         pidl "#define _HEADER_$interface->{NAME}\n\n";
 402
 403         foreach my $c (@{$interface->{CONSTS}}) {
 404                 HeaderConst($c);
 405         }
 406
 407         foreach my $t (@{$interface->{TYPES}}) {
 408                 HeaderTypedef($t, ";\n\n") if ($t->{TYPE} eq "TYPEDEF");
 409                 HeaderStruct($t, $t->{NAME}, ";\n\n") if ($t->{TYPE} eq "STRUCT");
 410                 HeaderUnion($t, $t->{NAME}, ";\n\n") if ($t->{TYPE} eq "UNION");
 411                 HeaderEnum($t, $t->{NAME}, ";\n\n") if ($t->{TYPE} eq "ENUM");
 412                 HeaderBitmap($t, $t->{NAME}) if ($t->{TYPE} eq "BITMAP");
 413                 HeaderPipe($t, $t->{NAME}, "\n\n") if ($t->{TYPE} eq "PIPE");
 414         }
 415
 416         foreach my $fn (@{$interface->{FUNCTIONS}}) {
 417                 HeaderFunction($fn);
 418         }
 419
 420         pidl "#endif /* _HEADER_$interface->{NAME} */\n";
 421 }
 422
 423 sub HeaderQuote($)
 424 {
 425         my($quote) = shift;
 426
 427         pidl unmake_str($quote->{DATA}) . "\n";
 428 }
 429
 430 #####################################################################
 431 # parse a parsed IDL into a C header
 432 sub Parse($)
 433 {
 434         my($ndr) = shift;
 435         $tab_depth = 0;
 436
 437         $res = "";
 438         %headerstructs = ();
 439         pidl "/* header auto-generated by pidl */\n\n";
 440
 441         my $ifacename = "";
 442
 443         # work out a unique interface name
 444         foreach (@{$ndr}) {
 445                 if ($_->{TYPE} eq "INTERFACE") {
 446                         $ifacename = $_->{NAME};
 447                         last;
 448                 }
 449         }
 450
 451         pidl "#ifndef _PIDL_HEADER_$ifacename\n";
 452         pidl "#define _PIDL_HEADER_$ifacename\n\n";
 453
 454         if (!is_intree()) {
 455                 pidl "#include <util/data_blob.h>\n";
 456         }
 457         pidl "#include <stdint.h>\n";
 458         pidl "\n";
 459         # FIXME: Include this only if NTSTATUS was actually used
 460         pidl choose_header("libcli/util/ntstatus.h", "core/ntstatus.h") . "\n";
 461         pidl "\n";
 462
 463         foreach (@{$ndr}) {
 464                 ($_->{TYPE} eq "CPP_QUOTE") && HeaderQuote($_);
 465                 ($_->{TYPE} eq "INTERFACE") && HeaderInterface($_);
 466                 ($_->{TYPE} eq "IMPORT") && HeaderImport(@{$_->{PATHS}});
 467                 ($_->{TYPE} eq "INCLUDE") && HeaderInclude(@{$_->{PATHS}});
 468         }
 469
 470         pidl "#endif /* _PIDL_HEADER_$ifacename */\n";
 471
 472         return $res;
 473 }
 474
 475 sub GenerateStructEnv($$)
 476 {
 477         my ($x, $v) = @_;
 478         my %env;
 479
 480         foreach my $e (@{$x->{ELEMENTS}}) {
 481                 $env{$e->{NAME}} = "$v->$e->{NAME}";
 482         }
 483
 484         $env{"this"} = $v;
 485
 486         return \%env;
 487 }
 488
 489 sub EnvSubstituteValue($$)
 490 {
 491         my ($env,$s) = @_;
 492
 493         # Substitute the value() values in the env
 494         foreach my $e (@{$s->{ELEMENTS}}) {
 495                 next unless (defined(my $v = has_property($e, "value")));
 496
 497                 $env->{$e->{NAME}} = ParseExpr($v, $env, $e);
 498         }
 499
 500         return $env;
 501 }
 502
 503 sub GenerateFunctionInEnv($;$)
 504 {
 505         my ($fn, $base) = @_;
 506         my %env;
 507
 508         $base = "r->" unless defined($base);
 509
 510         foreach my $e (@{$fn->{ELEMENTS}}) {
 511                 if (grep (/in/, @{$e->{DIRECTION}})) {
 512                         $env{$e->{NAME}} = $base."in.$e->{NAME}";
 513                 }
 514         }
 515
 516         return \%env;
 517 }
 518
 519 sub GenerateFunctionOutEnv($;$)
 520 {
 521         my ($fn, $base) = @_;
 522         my %env;
 523
 524         $base = "r->" unless defined($base);
 525
 526         foreach my $e (@{$fn->{ELEMENTS}}) {
 527                 if (grep (/out/, @{$e->{DIRECTION}})) {
 528                         $env{$e->{NAME}} = $base."out.$e->{NAME}";
 529                 } elsif (grep (/in/, @{$e->{DIRECTION}})) {
 530                         $env{$e->{NAME}} = $base."in.$e->{NAME}";
 531                 }
 532         }
 533
 534         return \%env;
 535 }
 536
 537 1;