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