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