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