r16100: Patch from Michael Wood <mwood@icts.uct.ac.za>: s/then/than/ for correct...
[kai/samba.git] / source / pidl / lib / Parse / Pidl / Samba3 / Parser.pm
1 ###################################################
2 # Samba3 NDR parser generator for IDL structures
3 # Copyright jelmer@samba.org 2005
4 # released under the GNU GPL
5
6 package Parse::Pidl::Samba3::Parser;
7
8 use strict;
9 use Parse::Pidl::Typelist qw(hasType getType mapType);
10 use Parse::Pidl::Util qw(has_property ParseExpr);
11 use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred);
12 use Parse::Pidl::Samba3::Types qw(DeclShort DeclLong InitType DissectType StringType);
13
14 use vars qw($VERSION);
15 $VERSION = '0.01';
16
17 use constant PRIMITIVES => 1;
18 use constant DEFERRED => 2;
19
20 my $res = "";
21 my $tabs = "";
22 sub indent() { $tabs.="\t"; }
23 sub deindent() { $tabs = substr($tabs, 1); }
24 sub pidl($) { $res .= $tabs.(shift)."\n"; }
25 sub fatal($$) { my ($e,$s) = @_; die("$e->{ORIGINAL}->{FILE}:$e->{ORIGINAL}->{LINE}: $s\n"); }
26
27 #TODO:
28 # - Add some security checks (array sizes, memory alloc == NULL, etc)
29 # - Don't add seperate _p and _d functions if there is no deferred data
30 # - [string] with non-varying arrays and "surrounding" strings 
31 # - subcontext()
32 # - DATA_BLOB
33
34 sub Align($$)
35 {
36         my ($a,$b) = @_;
37
38         # Only align if previous element was smaller than current one
39         if ($$a < $b) {
40                 pidl "if (!prs_align_custom(ps, $b))";
41                 pidl "\treturn False;";
42                 pidl "";
43         }
44
45         $$a = $b;
46 }
47
48 sub DeclareArrayVariables
49 {
50         my $es = shift;
51         my $what = shift;
52
53         my $output = 0;
54
55         foreach my $e (@$es) {
56                 foreach my $l (@{$e->{LEVELS}}) {
57                         if ($what) {
58                                 next if ($l->{IS_DEFERRED} and $what == PRIMITIVES);
59                                 next if (not $l->{IS_DEFERRED} and $what == DEFERRED);
60                         }
61                         if ($l->{TYPE} eq "ARRAY" and not $l->{IS_ZERO_TERMINATED}) {
62                                 pidl "uint32 i_$e->{NAME}_$l->{LEVEL_INDEX};";
63                                 $output = 1;
64                         }
65                 }
66         }
67         pidl "" if $output;
68 }
69
70 sub ParseElementLevelData($$$$$$$)
71 {
72         my ($e,$l,$nl,$env,$varname,$what,$align) = @_;
73
74         my $c = DissectType($e,$l,$varname,$what,$align);
75         return if not $c;
76
77         if (defined($e->{ALIGN})) {
78                 Align($align, $e->{ALIGN});
79         } else {
80                 # Default to 4
81                 Align($align, 4);
82         }
83
84         pidl "if (!$c)";
85         pidl "\treturn False;";
86 }
87
88 sub ParseElementLevelArray($$$$$$$)
89 {
90         my ($e,$l,$nl,$env,$varname,$what,$align) = @_;
91
92         if ($l->{IS_ZERO_TERMINATED}) {
93                 return if ($what == DEFERRED);
94                 
95                 my ($t,$f) = StringType($e,$l);
96
97                 Align($align, 4);
98                 pidl "if (!smb_io_$t(\"$e->{NAME}\", &$varname, 1, ps, depth))";
99                 pidl "\treturn False;";
100
101                 $$align = 0;
102                 return;
103         }
104
105         my $len = ParseExpr($l->{LENGTH_IS}, $env);
106         my $size = ParseExpr($l->{SIZE_IS}, $env);
107
108         if ($what == PRIMITIVES) {
109                 # Fetch headers
110                 if ($l->{IS_CONFORMANT} and not $l->{IS_SURROUNDING}) {
111                         Align($align, 4);
112                         pidl "if (!prs_uint32(\"size_$e->{NAME}\", ps, depth, &" . ParseExpr("size_$e->{NAME}", $env) . "))";
113                         pidl "\treturn False;";
114                         pidl "";
115                 }
116         
117                 if ($l->{IS_VARYING}) {
118                         Align($align, 4);
119                         pidl "if (!prs_uint32(\"offset_$e->{NAME}\", ps, depth, &" . ParseExpr("offset_$e->{NAME}", $env) . "))";
120                         pidl "\treturn False;";
121                         pidl "";
122
123                         pidl "if (!prs_uint32(\"length_$e->{NAME}\", ps, depth, &" . ParseExpr("length_$e->{NAME}", $env) . "))";
124                         pidl "\treturn False;";
125                         pidl "";
126                 }
127         }
128
129         # Everything but fixed arrays have to be allocated
130         if (!$l->{IS_FIXED} and $what == PRIMITIVES) {
131                 pidl "if (UNMARSHALLING(ps)) {";
132                 indent;
133                 pidl "$varname = (void *)PRS_ALLOC_MEM_VOID(ps,sizeof(*$varname)*$size);";
134                 deindent;
135                 pidl "}";
136         }
137
138         return if ($what == DEFERRED and not ContainsDeferred($e,$l));
139
140         my $i = "i_$e->{NAME}_$l->{LEVEL_INDEX}";
141         pidl "for ($i=0; $i<$len;$i++) {";
142         indent;
143         ParseElementLevel($e,$nl,$env,$varname."[$i]",$what,$align);
144         deindent;
145         pidl "}";
146 }
147
148 sub ParseElementLevelSwitch($$$$$$$)
149 {
150         my ($e,$l,$nl,$env,$varname,$what,$align) = @_;
151
152         ParseElementLevel($e,$nl,$env,$varname,$what,$align);
153 }
154
155 sub ParseElementLevelPtr($$$$$$$)
156 {
157         my ($e,$l,$nl,$env,$varname,$what,$align) = @_;
158
159         if ($what == PRIMITIVES) {
160                 if (($l->{POINTER_TYPE} eq "ref") and ($l->{LEVEL} eq "EMBEDDED")) {
161                         # Ref pointers always have to be non-NULL
162                         pidl "if (MARSHALLING(ps) && !" . ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . ")";
163                         pidl "\treturn False;";
164                         pidl "";
165                 } 
166                 
167                 unless ($l->{POINTER_TYPE} eq "ref" and $l->{LEVEL} eq "TOP") {
168                         Align($align, 4);
169                         pidl "if (!prs_uint32(\"ptr$l->{POINTER_INDEX}_$e->{NAME}\", ps, depth, &" . ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . "))";
170                         pidl "\treturn False;";
171                         pidl "";
172                 }
173         }
174
175         if ($l->{POINTER_TYPE} eq "relative") {
176                 fatal($e, "relative pointers not supported for Samba 3");
177                 #FIXME
178         }
179         
180         if ($what == DEFERRED) {
181                 if ($l->{POINTER_TYPE} ne "ref") {
182                         pidl "if (" . ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . ") {";
183                         indent;
184                 }
185                 ParseElementLevel($e,$nl,$env,$varname,PRIMITIVES,$align);
186                 ParseElementLevel($e,$nl,$env,$varname,DEFERRED,$align);
187                 if ($l->{POINTER_TYPE} ne "ref") {
188                         deindent;
189                         pidl "}";
190                 }
191                 $$align = 0;
192         }
193 }
194
195 sub ParseElementLevelSubcontext($$$$$$$)
196 {
197         my ($e,$l,$nl,$env,$varname,$what,$align) = @_;
198
199         fatal($e, "subcontext() not supported for Samba 3");
200         #FIXME
201 }
202
203 sub ParseElementLevel($$$$$$)
204 {
205         my ($e,$l,$env,$varname,$what,$align) = @_;
206
207         {
208                 DATA => \&ParseElementLevelData,
209                 SUBCONTEXT => \&ParseElementLevelSubcontext,
210                 POINTER => \&ParseElementLevelPtr,
211                 SWITCH => \&ParseElementLevelSwitch,
212                 ARRAY => \&ParseElementLevelArray
213         }->{$l->{TYPE}}->($e,$l,GetNextLevel($e,$l),$env,$varname,$what,$align);
214 }
215
216 sub ParseElement($$$$)
217 {
218         my ($e,$env,$what,$align) = @_;
219
220         ParseElementLevel($e, $e->{LEVELS}[0], $env, ParseExpr($e->{NAME}, $env), $what, $align);
221 }
222
223 sub InitLevel($$$$)
224 {
225         sub InitLevel($$$$);
226         my ($e,$l,$varname,$env) = @_;
227
228         if ($l->{TYPE} eq "POINTER") {
229                 if ($l->{POINTER_TYPE} eq "ref") {
230                         pidl "if (!$varname)";
231                         pidl "\treturn False;";
232                         pidl "";
233                 } else {
234                         pidl "if ($varname) {";
235                         indent;
236                 }
237
238                 unless ($l->{POINTER_TYPE} eq "ref" and $l->{LEVEL} eq "TOP") {
239                         pidl ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . " = 1;";
240                 }
241                 InitLevel($e, GetNextLevel($e,$l), "*$varname", $env);
242                 
243                 if ($l->{POINTER_TYPE} ne "ref") {
244                         deindent;
245                         pidl "} else {";
246                         pidl "\t" . ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . " = 0;";
247                         pidl "}";
248                 }
249         } elsif ($l->{TYPE} eq "ARRAY" and $l->{IS_ZERO_TERMINATED}) {
250                 my ($t,$f) = StringType($e,$l);
251                 pidl "init_$t(&" . ParseExpr($e->{NAME}, $env) . ", ".substr($varname, 1) . ", $f);"; 
252         } elsif ($l->{TYPE} eq "ARRAY") {
253                 pidl ParseExpr($e->{NAME}, $env) . " = $varname;";
254         } elsif ($l->{TYPE} eq "DATA") {
255                 pidl InitType($e, $l, ParseExpr($e->{NAME}, $env), $varname);
256         } elsif ($l->{TYPE} eq "SWITCH") {
257                 InitLevel($e, GetNextLevel($e,$l), $varname, $env);
258                 pidl ParseExpr($e->{NAME}, $env) . ".switch_value = " . ParseExpr($l->{SWITCH_IS}, $env) . ";";
259         }
260 }
261
262 sub GenerateEnvElement($$)
263 {
264         my ($e,$env) = @_;
265         foreach my $l (@{$e->{LEVELS}}) {
266                 if ($l->{TYPE} eq "DATA") {
267                         $env->{$e->{NAME}} = "v->$e->{NAME}";
268                 } elsif ($l->{TYPE} eq "POINTER") {
269                         $env->{"ptr$l->{POINTER_INDEX}_$e->{NAME}"} = "v->ptr$l->{POINTER_INDEX}_$e->{NAME}";
270                 } elsif ($l->{TYPE} eq "SWITCH") {
271                 } elsif ($l->{TYPE} eq "ARRAY" and not $l->{IS_ZERO_TERMINATED}) {
272                         $env->{"length_$e->{NAME}"} = "v->length_$e->{NAME}";
273                         $env->{"size_$e->{NAME}"} = "v->size_$e->{NAME}";
274                         $env->{"offset_$e->{NAME}"} = "v->offset_$e->{NAME}";
275                 }
276         }
277 }
278
279 sub ParseStruct($$$)
280 {
281         my ($if,$s,$n) = @_;
282
283         my $fn = "$if->{NAME}_io_$n";
284         my $sn = uc("$if->{NAME}_$n");
285         my $ifn = "init_$if->{NAME}_$n";
286
287         my $args = "";
288         foreach (@{$s->{ELEMENTS}}) {
289                 $args .= ", " . DeclLong($_);
290         }
291
292         my $env = { "this" => "v" };
293         GenerateEnvElement($_, $env) foreach (@{$s->{ELEMENTS}});
294
295         pidl "BOOL $ifn($sn *v$args)";
296         pidl "{";
297         indent;
298         pidl "DEBUG(5,(\"$ifn\\n\"));";
299         pidl "";
300         # Call init for all arguments
301         foreach (@{$s->{ELEMENTS}}) {
302                 InitLevel($_, $_->{LEVELS}[0], $_->{NAME}, $env);
303                 pidl "";
304         }
305         pidl "return True;";
306         deindent;
307         pidl "}";
308         pidl "";
309
310         my $pfn = "$fn\_p";
311         my $dfn = "$fn\_d";
312         
313         pidl "BOOL $pfn(const char *desc, $sn *v, prs_struct *ps, int depth)";
314         pidl "{";
315         indent;
316         DeclareArrayVariables($s->{ELEMENTS}, PRIMITIVES);
317         pidl "if (v == NULL)";
318         pidl "\treturn False;";
319         pidl "";
320         pidl "prs_debug(ps, depth, desc, \"$pfn\");";
321         pidl "depth++;";
322
323         my $align = 8;
324         if ($s->{SURROUNDING_ELEMENT}) {
325                 pidl "if (!prs_uint32(\"size_$s->{SURROUNDING_ELEMENT}->{NAME}\", ps, depth, &" . ParseExpr("size_$s->{SURROUNDING_ELEMENT}->{NAME}", $env) . "))";
326                 pidl "\treturn False;";
327                 pidl "";
328                 $align = 4;
329                 
330         }
331
332         foreach (@{$s->{ELEMENTS}}) {
333                 ParseElement($_, $env, PRIMITIVES, \$align); 
334                 pidl "";
335         }
336
337         pidl "return True;";
338         deindent;
339         pidl "}";
340         pidl "";
341
342         pidl "BOOL $dfn(const char *desc, $sn *v, prs_struct *ps, int depth)";
343         pidl "{";
344         indent;
345         DeclareArrayVariables($s->{ELEMENTS}, DEFERRED);
346         pidl "if (v == NULL)";
347         pidl "\treturn False;";
348         pidl "";
349         pidl "prs_debug(ps, depth, desc, \"$dfn\");";
350         pidl "depth++;";
351
352         $align = 0;
353         foreach (@{$s->{ELEMENTS}}) {
354                 ParseElement($_, $env, DEFERRED, \$align); 
355                 pidl "";
356         }
357
358         pidl "return True;";
359         deindent;
360         pidl "}";
361         pidl "";
362 }
363
364 sub UnionGenerateEnvElement($)
365 {
366         my $e = shift;
367         my $env = {};
368
369         foreach my $l (@{$e->{LEVELS}}) {
370                 if ($l->{TYPE} eq "DATA") {
371                         $env->{$e->{NAME}} = "v->u.$e->{NAME}";
372                 } elsif ($l->{TYPE} eq "POINTER") {
373                         $env->{"ptr$l->{POINTER_INDEX}_$e->{NAME}"} = "v->ptr$l->{POINTER_INDEX}";
374                 } elsif ($l->{TYPE} eq "SWITCH") {
375                 } elsif ($l->{TYPE} eq "ARRAY" and not $l->{IS_ZERO_TERMINATED}) {
376                         $env->{"length_$e->{NAME}"} = "v->length";
377                         $env->{"size_$e->{NAME}"} = "v->size";
378                         $env->{"offset_$e->{NAME}"} = "v->offset";
379                 }
380         }
381
382         return $env;
383 }
384
385 sub ParseUnion($$$)
386 {
387         my ($if,$u,$n) = @_;
388
389         my $fn = "$if->{NAME}_io_$n";
390         my $sn = uc("$if->{NAME}_$n\_ctr");
391
392         my $pfn = "$fn\_p";
393         my $dfn = "$fn\_d";
394         
395         pidl "BOOL $pfn(const char *desc, $sn* v, prs_struct *ps, int depth)";
396         pidl "{";
397         indent;
398         DeclareArrayVariables($u->{ELEMENTS});
399
400         if (defined ($u->{SWITCH_TYPE})) {
401                 pidl "if (!prs_$u->{SWITCH_TYPE}(\"switch_value\", ps, depth, &v->switch_value))";
402                 pidl "\treturn False;";
403                 pidl "";
404         }
405
406         # Maybe check here that level and v->switch_value are equal?
407
408         pidl "switch (v->switch_value) {";
409         indent;
410
411         foreach (@{$u->{ELEMENTS}}) {
412                 pidl "$_->{CASE}:";
413                 indent;
414                 if ($_->{TYPE} ne "EMPTY") {
415                         pidl "depth++;";
416                         my $env = UnionGenerateEnvElement($_);
417                         my $align = 8;
418                         ParseElement($_, $env, PRIMITIVES, \$align); 
419                         pidl "depth--;";
420                 }
421                 pidl "break;";
422                 deindent;
423                 pidl "";
424         }
425
426         unless ($u->{HAS_DEFAULT}) {
427                 pidl "default:";
428                 pidl "\treturn False;";
429                 pidl "";
430         }
431
432         deindent;
433         pidl "}";
434         pidl "";
435         pidl "return True;";
436         deindent;
437         pidl "}";
438         pidl "";
439
440         pidl "BOOL $dfn(const char *desc, $sn* v, prs_struct *ps, int depth)";
441         pidl "{";
442         indent;
443         DeclareArrayVariables($u->{ELEMENTS});
444
445         if (defined($u->{SWITCH_TYPE})) {
446                 pidl "switch (v->switch_value) {";
447         } else {
448                 pidl "switch (level) {";
449         }
450         indent;
451
452         foreach (@{$u->{ELEMENTS}}) {
453                 pidl "$_->{CASE}:";
454                 indent;
455                 if ($_->{TYPE} ne "EMPTY") {
456                         pidl "depth++;";
457                         my $env = UnionGenerateEnvElement($_);
458                         my $align = 0;
459                         ParseElement($_, $env, DEFERRED, \$align); 
460                         pidl "depth--;";
461                 }
462                 pidl "break;";
463                 deindent;
464                 pidl "";
465         }
466
467         deindent;
468         pidl "}";
469         pidl "";
470         pidl "return True;";
471         deindent;
472         pidl "}";
473
474 }
475
476 sub CreateFnDirection($$$$$)
477 {
478         my ($fn,$ifn,$s,$all,$es) = @_;
479
480         my $args = "";
481         foreach (@$all) { $args .= ", " . DeclLong($_); }
482
483         my $env = { };
484         GenerateEnvElement($_, $env) foreach (@$es);
485
486         pidl "BOOL $ifn($s *v$args)";
487         pidl "{";
488         indent;
489         pidl "DEBUG(5,(\"$ifn\\n\"));";
490         pidl "";
491         # Call init for all arguments
492         foreach (@$es) {
493                 InitLevel($_, $_->{LEVELS}[0], $_->{NAME}, $env);
494                 pidl "";
495         }
496         pidl "return True;";
497         deindent;
498         pidl "}";
499         pidl "";
500         
501         pidl "BOOL $fn(const char *desc, $s *v, prs_struct *ps, int depth)";
502         pidl "{";
503         indent;
504         DeclareArrayVariables($es);
505         pidl "if (v == NULL)";
506         pidl "\treturn False;";
507         pidl "";
508         pidl "prs_debug(ps, depth, desc, \"$fn\");";
509         pidl "depth++;";
510
511         my $align = 8;
512         foreach (@$es) {
513                 ParseElement($_, $env, PRIMITIVES, \$align); 
514                 ParseElement($_, $env, DEFERRED, \$align); 
515                 pidl "";
516         }
517
518         pidl "return True;";
519         deindent;
520         pidl "}";
521         pidl "";
522 }
523
524 sub ParseFunction($$)
525 {
526         my ($if,$fn) = @_;
527
528         my @in = ();
529         my @out = ();
530         my @all = @{$fn->{ELEMENTS}};
531
532         foreach (@{$fn->{ELEMENTS}}) {
533                 push (@in, $_) if (grep(/in/, @{$_->{DIRECTION}}));
534                 push (@out, $_) if (grep(/out/, @{$_->{DIRECTION}}));
535         }
536
537         if (defined($fn->{RETURN_TYPE})) {
538                 my $status = { 
539                         NAME => "status", 
540                         TYPE => $fn->{RETURN_TYPE},
541                         LEVELS => [
542                                 {
543                                         TYPE => "DATA",
544                                         DATA_TYPE => $fn->{RETURN_TYPE}
545                                 }
546                         ]
547                 };
548
549                 push (@out, $status);
550                 push (@all, $status);
551         }
552
553         CreateFnDirection("$if->{NAME}_io_q_$fn->{NAME}", 
554                                  "init_$if->{NAME}_q_$fn->{NAME}", 
555                                  uc("$if->{NAME}_q_$fn->{NAME}"), 
556                                  \@in, \@in);
557         CreateFnDirection("$if->{NAME}_io_r_$fn->{NAME}", 
558                                  "init_$if->{NAME}_r_$fn->{NAME}",
559                                  uc("$if->{NAME}_r_$fn->{NAME}"), 
560                                  \@all, \@out);
561 }
562
563 sub ParseInterface($)
564 {
565         my $if = shift;
566
567         # Structures first 
568         pidl "/* $if->{NAME} structures */";
569         foreach (@{$if->{TYPES}}) {
570                 ParseStruct($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "STRUCT");
571                 ParseUnion($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "UNION");
572         }
573
574         pidl "/* $if->{NAME} functions */";
575         ParseFunction($if, $_) foreach (@{$if->{FUNCTIONS}});
576 }
577
578 sub Parse($$)
579 {
580         my($ndr,$filename) = @_;
581
582         $tabs = "";
583         $res = "";
584
585         pidl "/*";
586         pidl " * Unix SMB/CIFS implementation.";
587         pidl " * parser auto-generated by pidl. DO NOT MODIFY!";
588         pidl " */";
589         pidl "";
590         pidl "#include \"includes.h\"";
591         pidl "";
592         pidl "#undef DBGC_CLASS";
593         pidl "#define DBGC_CLASS DBGC_RPC_PARSE";
594         pidl "";
595
596         foreach (@$ndr) {
597                 ParseInterface($_) if ($_->{TYPE} eq "INTERFACE");
598         }
599
600         return $res;
601 }
602
603 1;