source4/pidl/lib/Parse/Pidl/Samba/TDR.pm

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