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

   1 ###################################################
   2 # Trivial Parser Generator
   3 # Copyright jelmer@samba.org 2005-2007
   4 # released under the GNU GPL
   5
   6 package Parse::Pidl::Samba4::TDR;
   7 use Parse::Pidl qw(fatal);
   8 use Parse::Pidl::Util qw(has_property ParseExpr is_constant);
   9 use Parse::Pidl::Samba4 qw(is_intree choose_header);
  10
  11 use Exporter;
  12 @ISA = qw(Exporter);
  13 @EXPORT_OK = qw(ParserType $ret $ret_hdr);
  14
  15 use vars qw($VERSION);
  16 $VERSION = '0.01';
  17
  18 use strict;
  19
  20 sub new($) {
  21         my ($class) = shift;
  22         my $self = { ret => "", ret_hdr => "", tabs => "" };
  23         bless($self, $class);
  24 }
  25
  26 sub indent($) { my $self = shift; $self->{tabs}.="\t"; }
  27 sub deindent($) { my $self = shift; $self->{tabs} = substr($self->{tabs}, 1); }
  28 sub pidl($$) { my $self = shift; $self->{ret} .= $self->{tabs}.(shift)."\n"; }
  29 sub pidl_hdr($$) { my $self = shift; $self->{ret_hdr} .= (shift)."\n"; }
  30 sub typearg($) {
  31         my $t = shift;
  32         return(", const char *name") if ($t eq "print");
  33         return(", TALLOC_CTX *mem_ctx") if ($t eq "pull");
  34         return("");
  35 }
  36
  37 sub fn_declare($$$)
  38 {
  39         my ($self, $p, $d) = @_;
  40         if ($p) {
  41                 $self->pidl($d); $self->pidl_hdr("$d;");
  42         } else {
  43                 $self->pidl("static $d");
  44         }
  45 }
  46
  47 sub ContainsArray($)
  48 {
  49         my $e = shift;
  50         foreach (@{$e->{ELEMENTS}}) {
  51                 next if (has_property($_, "charset") and
  52                         scalar(@{$_->{ARRAY_LEN}}) == 1);
  53                 return 1 if (defined($_->{ARRAY_LEN}) and
  54                                 scalar(@{$_->{ARRAY_LEN}}) > 0);
  55         }
  56         return 0;
  57 }
  58
  59 sub ParserElement($$$$)
  60 {
  61         my ($self, $e,$t,$env) = @_;
  62         my $switch = "";
  63         my $array = "";
  64         my $name = "";
  65         my $mem_ctx = "mem_ctx";
  66
  67         fatal($e,"Pointers not supported in TDR") if ($e->{POINTERS} > 0);
  68         fatal($e,"size_is() not supported in TDR") if (has_property($e, "size_is"));
  69         fatal($e,"length_is() not supported in TDR") if (has_property($e, "length_is"));
  70
  71         if ($t eq "print") {
  72                 $name = ", \"$e->{NAME}\"$array";
  73         }
  74
  75         if (has_property($e, "flag")) {
  76                 $self->pidl("{");
  77                 $self->indent;
  78                 $self->pidl("uint32_t saved_flags = tdr->flags;");
  79                 $self->pidl("tdr->flags |= $e->{PROPERTIES}->{flag};");
  80         }
  81
  82         if (has_property($e, "charset")) {
  83                 fatal($e,"charset() on non-array element") unless (defined($e->{ARRAY_LEN}) and scalar(@{$e->{ARRAY_LEN}}) > 0);
  84
  85                 my $len = ParseExpr(@{$e->{ARRAY_LEN}}[0], $env, $e);
  86                 if ($len eq "*") { $len = "-1"; }
  87                 $name = ", mem_ctx" if ($t eq "pull");
  88                 $self->pidl("TDR_CHECK(tdr_$t\_charset(tdr$name, &v->$e->{NAME}, $len, sizeof($e->{TYPE}_t), CH_$e->{PROPERTIES}->{charset}));");
  89                 return;
  90         }
  91
  92         if (has_property($e, "switch_is")) {
  93                 $switch = ", " . ParseExpr($e->{PROPERTIES}->{switch_is}, $env, $e);
  94         }
  95
  96         if (defined($e->{ARRAY_LEN}) and scalar(@{$e->{ARRAY_LEN}}) > 0) {
  97                 my $len = ParseExpr($e->{ARRAY_LEN}[0], $env, $e);
  98
  99                 if ($t eq "pull" and not is_constant($len)) {
 100                         $self->pidl("TDR_ALLOC(mem_ctx, v->$e->{NAME}, $len);");
 101                         $mem_ctx = "v->$e->{NAME}";
 102                 }
 103
 104                 $self->pidl("for (i = 0; i < $len; i++) {");
 105                 $self->indent;
 106                 $array = "[i]";
 107         }
 108
 109         if ($t eq "pull") {
 110                 $name = ", $mem_ctx";
 111         }
 112
 113         if (has_property($e, "value") && $t eq "push") {
 114                 $self->pidl("v->$e->{NAME} = ".ParseExpr($e->{PROPERTIES}->{value}, $env, $e).";");
 115         }
 116
 117         $self->pidl("TDR_CHECK(tdr_$t\_$e->{TYPE}(tdr$name$switch, &v->$e->{NAME}$array));");
 118
 119         if ($array) { $self->deindent; $self->pidl("}"); }
 120
 121         if (has_property($e, "flag")) {
 122                 $self->pidl("tdr->flags = saved_flags;");
 123                 $self->deindent;
 124                 $self->pidl("}");
 125         }
 126 }
 127
 128 sub ParserStruct($$$$$)
 129 {
 130         my ($self, $e,$t,$p) = @_;
 131
 132         $self->fn_declare($p,"NTSTATUS tdr_$t\_$e->{NAME} (struct tdr_$t *tdr".typearg($t).", struct $e->{NAME} *v)");
 133         $self->pidl("{"); $self->indent;
 134         $self->pidl("int i;") if (ContainsArray($e));
 135
 136         if ($t eq "print") {
 137                 $self->pidl("tdr->print(tdr, \"\%-25s: struct $e->{NAME}\", name);");
 138                 $self->pidl("tdr->level++;");
 139         }
 140
 141         my %env = map { $_->{NAME} => "v->$_->{NAME}" } @{$e->{ELEMENTS}};
 142         $env{"this"} = "v";
 143         $self->ParserElement($_, $t, \%env) foreach (@{$e->{ELEMENTS}});
 144
 145         if ($t eq "print") {
 146                 $self->pidl("tdr->level--;");
 147         }
 148
 149         $self->pidl("return NT_STATUS_OK;");
 150
 151         $self->deindent; $self->pidl("}");
 152 }
 153
 154 sub ParserUnion($$$$)
 155 {
 156         my ($self, $e,$t,$p) = @_;
 157
 158         $self->fn_declare($p,"NTSTATUS tdr_$t\_$e->{NAME}(struct tdr_$t *tdr".typearg($t).", int level, union $e->{NAME} *v)");
 159         $self->pidl("{"); $self->indent;
 160         $self->pidl("int i;") if (ContainsArray($e));
 161
 162         if ($t eq "print") {
 163                 $self->pidl("tdr->print(tdr, \"\%-25s: union $e->{NAME}\", name);");
 164                 $self->pidl("tdr->level++;");
 165         }
 166
 167         $self->pidl("switch (level) {"); $self->indent;
 168         foreach (@{$e->{ELEMENTS}}) {
 169                 if (has_property($_, "case")) {
 170                         $self->pidl("case " . $_->{PROPERTIES}->{case} . ":");
 171                 } elsif (has_property($_, "default")) {
 172                         $self->pidl("default:");
 173                 }
 174                 $self->indent; $self->ParserElement($_, $t, {}); $self->deindent;
 175                 $self->pidl("break;");
 176         }
 177         $self->deindent; $self->pidl("}");
 178
 179         if ($t eq "print") {
 180                 $self->pidl("tdr->level--;");
 181         }
 182
 183         $self->pidl("return NT_STATUS_OK;\n");
 184         $self->deindent; $self->pidl("}");
 185 }
 186
 187 sub ParserBitmap($$$$)
 188 {
 189         my ($self,$e,$t,$p) = @_;
 190         return if ($p);
 191         $self->pidl("#define tdr_$t\_$e->{NAME} tdr_$t\_" . Parse::Pidl::Typelist::bitmap_type_fn($e));
 192 }
 193
 194 sub ParserEnum($$$$)
 195 {
 196         my ($self,$e,$t,$p) = @_;
 197         my $bt = Parse::Pidl::Typelist::enum_type_fn($e);
 198
 199         $self->fn_declare($p, "NTSTATUS tdr_$t\_$e->{NAME} (struct tdr_$t *tdr".typearg($t).", enum $e->{NAME} *v)");
 200         $self->pidl("{");
 201         if ($t eq "pull") {
 202                 $self->pidl("\t$bt\_t r;");
 203                 $self->pidl("\tTDR_CHECK(tdr_$t\_$bt(tdr, mem_ctx, \&r));");
 204                 $self->pidl("\t*v = r;");
 205         } elsif ($t eq "push") {
 206                 $self->pidl("\tTDR_CHECK(tdr_$t\_$bt(tdr, ($bt\_t *)v));");
 207         } elsif ($t eq "print") {
 208                 $self->pidl("\t/* FIXME */");
 209         }
 210         $self->pidl("\treturn NT_STATUS_OK;");
 211         $self->pidl("}");
 212 }
 213
 214 sub ParserTypedef($$$$)
 215 {
 216         my ($self, $e,$t,$p) = @_;
 217
 218         $self->ParserType($e->{DATA},$t);
 219 }
 220
 221 sub ParserType($$$)
 222 {
 223         my ($self, $e,$t) = @_;
 224
 225         return if (has_property($e, "no$t"));
 226
 227         my $handlers = {
 228                 STRUCT => \&ParserStruct, UNION => \&ParserUnion,
 229                 ENUM => \&ParserEnum, BITMAP => \&ParserBitmap,
 230                 TYPEDEF => \&ParserTypedef
 231         };
 232
 233         $handlers->{$e->{TYPE}}->($self, $e, $t, has_property($e, "public"))
 234                 if (defined($handlers->{$e->{TYPE}}));
 235
 236         $self->pidl("");
 237 }
 238
 239 sub ParserInterface($$)
 240 {
 241         my ($self,$x) = @_;
 242
 243         $self->pidl_hdr("#ifndef __TDR_$x->{NAME}_HEADER__");
 244         $self->pidl_hdr("#define __TDR_$x->{NAME}_HEADER__");
 245
 246         foreach (@{$x->{DATA}}) {
 247                 $self->ParserType($_, "pull");
 248                 $self->ParserType($_, "push");
 249                 $self->ParserType($_, "print");
 250         }
 251
 252         $self->pidl_hdr("#endif /* __TDR_$x->{NAME}_HEADER__ */");
 253 }
 254
 255 sub Parser($$$$)
 256 {
 257         my ($self,$idl,$hdrname,$baseheader) = @_;
 258         $self->pidl("/* autogenerated by pidl */");
 259         if (is_intree()) {
 260                 $self->pidl("#include \"includes.h\"");
 261         } else {
 262                 $self->pidl("#include <stdio.h>");
 263                 $self->pidl("#include <stdbool.h>");
 264                 $self->pidl("#include <stdlib.h>");
 265                 $self->pidl("#include <stdint.h>");
 266                 $self->pidl("#include <stdarg.h>");
 267                 $self->pidl("#include <string.h>");
 268                 $self->pidl("#include <core/ntstatus.h>");
 269         }
 270         $self->pidl("#include \"$hdrname\"");
 271         $self->pidl("");
 272         $self->pidl_hdr("/* autogenerated by pidl */");
 273         $self->pidl_hdr("#include \"$baseheader\"");
 274         $self->pidl_hdr(choose_header("tdr/tdr.h", "tdr.h"));
 275         $self->pidl_hdr("");
 276
 277         foreach (@$idl) { $self->ParserInterface($_) if ($_->{TYPE} eq "INTERFACE"); }
 278         return ($self->{ret_hdr}, $self->{ret});
 279 }
 280
 281 1;