098729ad945965cd65c7ab1b0d21c1883f700192
[samba.git] / source4 / build / pidl / ndr.pm
1 ###################################################
2 # Samba4 NDR parser generator for IDL structures
3 # Copyright tridge@samba.org 2000-2003
4 # Copyright tpot@samba.org 2001
5 # Copyright jelmer@samba.org 2004-2005
6 # released under the GNU GPL
7
8 package NdrParser;
9
10 use strict;
11 use needed;
12
13 # list of known types
14 our %typedefs;
15 our %typefamily;
16
17 sub RegisterPrimitives()
18 {
19         my %type_alignments = 
20     (
21      "char"           => 1,
22      "int8"           => 1,
23      "uint8"          => 1,
24      "short"          => 2,
25      "wchar_t"        => 2,
26      "int16"          => 2,
27      "uint16"         => 2,
28      "long"           => 4,
29      "int32"          => 4,
30      "uint32"         => 4,
31      "dlong"          => 4,
32      "udlong"         => 4,
33      "NTTIME"         => 4,
34      "NTTIME_1sec"    => 4,
35      "time_t"         => 4,
36      "DATA_BLOB"      => 4,
37      "error_status_t" => 4,
38      "WERROR"         => 4,
39      "boolean32"      => 4,
40      "unsigned32"     => 4,
41      "ipv4address"    => 4,
42      "hyper"          => 8,
43      "NTTIME_hyper"   => 8
44      );
45
46         foreach my $k (keys %type_alignments) {
47                 $typedefs{$k} = {
48                         NAME => $k,
49                         TYPE => "TYPEDEF",
50                         DATA => {
51                                 TYPE => "SCALAR",
52                                 ALIGN => $type_alignments{$k}
53                         }
54                 };
55         }
56 }
57
58 sub is_scalar_type($)
59 {
60     my $type = shift;
61
62         if (my $dt = $typedefs{$type}->{DATA}->{TYPE}) {
63                 return 1 if ($dt eq "SCALAR" or $dt eq "ENUM" or $dt eq "BITMAP");
64         }
65
66     return 0;
67 }
68
69 sub pointer_type($)
70 {
71         my $e = shift;
72
73         return undef unless $e->{POINTERS};
74         
75         return "ref" if (util::has_property($e, "ref"));
76         return "ptr" if (util::has_property($e, "ptr"));
77         return "unique" if (util::has_property($e, "unique"));
78         return "relative" if (util::has_property($e, "relative"));
79
80         return undef;
81 }
82
83 # determine if an element needs a reference pointer on the wire
84 # in its NDR representation
85 sub need_wire_pointer($)
86 {
87         my $e = shift;
88         my $pt;
89         
90         return 0 unless ($pt = pointer_type($e));
91
92         if ($pt ne "ref") {
93                 return 1;
94         } else {
95                 return 0;
96         }
97 }
98
99 # determine if an element is a pure scalar. pure scalars do not
100 # have a "buffers" section in NDR
101 sub is_pure_scalar($)
102 {
103         my $e = shift;
104         if (util::has_property($e, "ref")) {
105                 return 1;
106         }
107         if (is_scalar_type($e->{TYPE}) && 
108             !$e->{POINTERS} && 
109             !util::array_size($e)) {
110                 return 1;
111         }
112         return 0;
113 }
114
115 # see if a variable needs to be allocated by the NDR subsystem on pull
116 sub need_alloc($)
117 {
118         my $e = shift;
119
120         if (util::has_property($e, "ref")) {
121                 return 0;
122         }
123
124         if ($e->{POINTERS} || util::array_size($e)) {
125                 return 1;
126         }
127
128         return 0;
129 }
130
131
132 # determine the C prefix used to refer to a variable when passing to a push
133 # function. This will be '*' for pointers to scalar types, '' for scalar
134 # types and normal pointers and '&' for pass-by-reference structures
135 sub c_push_prefix($)
136 {
137         my $e = shift;
138
139         if ($e->{TYPE} =~ "string") {
140                 return "";
141         }
142
143         if (is_scalar_type($e->{TYPE}) &&
144             $e->{POINTERS}) {
145                 return "*";
146         }
147         if (!is_scalar_type($e->{TYPE}) &&
148             !$e->{POINTERS} &&
149             !util::array_size($e)) {
150                 return "&";
151         }
152         return "";
153 }
154
155
156 # determine the C prefix used to refer to a variable when passing to a pull
157 # return '&' or ''
158 sub c_pull_prefix($)
159 {
160         my $e = shift;
161
162         if (!$e->{POINTERS} && !util::array_size($e)) {
163                 return "&";
164         }
165
166         if ($e->{TYPE} =~ "string") {
167                 return "&";
168         }
169
170         return "";
171 }
172 my $res = "";
173 my $tabs = "";
174 sub pidl($)
175 {
176         my $d = shift;
177         if ($d) {
178                 $res .= $tabs;
179                 $res .= $d;
180         }
181         $res .="\n";
182 }
183
184 sub indent
185 {
186         $tabs .= "\t";
187 }
188
189 sub deindent
190 {
191         $tabs = substr($tabs, 0, -1);
192 }
193
194 ###################################
195 # find a sibling var in a structure
196 sub find_sibling($$)
197 {
198         my($e) = shift;
199         my($name) = shift;
200         my($fn) = $e->{PARENT};
201
202         if ($name =~ /\*(.*)/) {
203                 $name = $1;
204         }
205
206         if ($fn->{TYPE} eq "FUNCTION") {
207                 for my $e2 (@{$fn->{ELEMENTS}}) {
208                         if ($e2->{NAME} eq $name) {
209                                 return $e2;
210                         }
211                 }
212         }
213
214         for my $e2 (@{$fn->{ELEMENTS}}) {
215                 if ($e2->{NAME} eq $name) {
216                         return $e2;
217                 }
218         }
219         die "invalid sibling '$name'";
220 }
221
222 ####################################################################
223 # work out the name of a size_is() variable
224 sub ParseExpr($$$)
225 {
226         my($e) = shift;
227         my($size) = shift;
228         my($var_prefix) = shift;
229
230         my($fn) = $e->{PARENT};
231
232         if (util::is_constant($size)) {
233                 return $size;
234         }
235
236         if ($size =~ /ndr->|\(/) {
237                 return $size;
238         }
239
240         my $prefix = "";
241
242         if ($size =~ /\*(.*)/) {
243                 $size = $1;
244                 $prefix = "*";
245         }
246
247         if ($fn->{TYPE} ne "FUNCTION") {
248                 return $prefix . "r->$size";
249         }
250
251         my $e2 = find_sibling($e, $size);
252
253         if (util::has_property($e2, "in") && util::has_property($e2, "out")) {
254                 return $prefix . "$var_prefix$size";
255         }
256         if (util::has_property($e2, "in")) {
257                 return $prefix . "r->in.$size";
258         }
259         if (util::has_property($e2, "out")) {
260                 return $prefix . "r->out.$size";
261         }
262
263         die "invalid variable in $size for element $e->{NAME} in $fn->{NAME}\n";
264 }
265
266 #####################################################################
267 # check that a variable we get from ParseExpr isn't a null pointer
268 sub check_null_pointer($)
269 {
270         my $size = shift;
271         if ($size =~ /^\*/) {
272                 my $size2 = substr($size, 1);
273                 pidl "if ($size2 == NULL) return NT_STATUS_INVALID_PARAMETER_MIX;";
274         }
275 }
276
277 #####################################################################
278 # check that a variable we get from ParseExpr isn't a null pointer
279 # void return varient
280 sub check_null_pointer_void($)
281 {
282         my $size = shift;
283         if ($size =~ /^\*/) {
284                 my $size2 = substr($size, 1);
285                 pidl "if ($size2 == NULL) return;";
286         }
287 }
288
289
290 #####################################################################
291 # work out is a parse function should be declared static or not
292 sub fn_prefix($)
293 {
294         my $fn = shift;
295         if ($fn->{TYPE} eq "TYPEDEF") {
296                 if (util::has_property($fn, "public")) {
297                         return "";
298                 }
299         }
300
301         if ($fn->{TYPE} eq "FUNCTION") {
302                 if (util::has_property($fn, "public")) {
303                         return "";
304                 }
305         }
306         return "static ";
307 }
308
309
310 ###################################################################
311 # setup any special flags for an element or structure
312 sub start_flags($)
313 {
314         my $e = shift;
315         my $flags = util::has_property($e, "flag");
316         if (defined $flags) {
317                 pidl "{ uint32_t _flags_save_$e->{TYPE} = ndr->flags;";
318                 pidl "ndr_set_flags(&ndr->flags, $flags);";
319         }
320 }
321
322 ###################################################################
323 # end any special flags for an element or structure
324 sub end_flags($)
325 {
326         my $e = shift;
327         my $flags = util::has_property($e, "flag");
328         if (defined $flags) {
329                 pidl "ndr->flags = _flags_save_$e->{TYPE};\n\t}";
330         }
331 }
332
333 #####################################################################
334 # work out the correct alignment for a structure or union
335 sub find_largest_alignment($)
336 {
337         my $s = shift;
338
339         my $align = 1;
340         for my $e (@{$s->{ELEMENTS}}) {
341                 my $a = 1;
342
343                 if (need_wire_pointer($e)) {
344                         $a = 4; 
345                 } else { 
346                         $a = align_type($e->{TYPE}); 
347                 }
348
349                 $align = $a if ($align < $a);
350         }
351
352         return $align;
353 }
354
355 #####################################################################
356 # align a type
357 sub align_type
358 {
359         my $e = shift;
360
361         unless (defined($typedefs{$e}) && defined($typedefs{$e}->{DATA}->{TYPE})) {
362             # it must be an external type - all we can do is guess 
363                 # print "Warning: assuming alignment of unknown type '$e' is 4\n";
364             return 4;
365         }
366
367         my $dt = $typedefs{$e}->{DATA};
368
369         return $dt->{ALIGN} if ($dt->{ALIGN});
370         return $typefamily{$dt->{TYPE}}->{ALIGN}($dt);
371 }
372
373 #####################################################################
374 # parse an array - push side
375 sub ParseArrayPush($$$)
376 {
377         my $e = shift;
378         my $var_prefix = shift;
379         my $ndr_flags = shift;
380
381         my $size = ParseExpr($e, util::array_size($e), $var_prefix);
382
383         if (defined $e->{CONFORMANT_SIZE}) {
384                 # the conformant size has already been pushed
385         } elsif (!util::is_inline_array($e)) {
386                 # we need to emit the array size
387                 pidl "NDR_CHECK(ndr_push_uint32(ndr, NDR_SCALARS, $size));";
388         }
389
390         if (my $length = util::has_property($e, "length_is")) {
391                 $length = ParseExpr($e, $length, $var_prefix);
392                 pidl "NDR_CHECK(ndr_push_uint32(ndr, NDR_SCALARS, 0));";
393                 pidl "NDR_CHECK(ndr_push_uint32(ndr, NDR_SCALARS, $length));";
394                 $size = $length;
395         }
396
397         if (is_scalar_type($e->{TYPE})) {
398                 pidl "NDR_CHECK(ndr_push_array_$e->{TYPE}(ndr, $ndr_flags, $var_prefix$e->{NAME}, $size));";
399         } else {
400                 pidl "NDR_CHECK(ndr_push_array(ndr, $ndr_flags, $var_prefix$e->{NAME}, sizeof($var_prefix$e->{NAME}\[0]), $size, (ndr_push_flags_fn_t)ndr_push_$e->{TYPE}));";
401         }
402 }
403
404 #####################################################################
405 # print an array
406 sub ParseArrayPrint($$)
407 {
408         my $e = shift;
409         my $var_prefix = shift;
410         my $size = ParseExpr($e, util::array_size($e), $var_prefix);
411         my $length = util::has_property($e, "length_is");
412
413         if (defined $length) {
414                 $size = ParseExpr($e, $length, $var_prefix);
415         }
416
417         if (is_scalar_type($e->{TYPE})) {
418                 pidl "ndr_print_array_$e->{TYPE}(ndr, \"$e->{NAME}\", $var_prefix$e->{NAME}, $size);";
419         } else {
420                 pidl "ndr_print_array(ndr, \"$e->{NAME}\", $var_prefix$e->{NAME}, sizeof($var_prefix$e->{NAME}\[0]), $size, (ndr_print_fn_t)ndr_print_$e->{TYPE});";
421         }
422 }
423
424 #####################################################################
425 # check the size_is and length_is constraints
426 sub CheckArraySizes($$)
427 {
428         my $e = shift;
429         my $var_prefix = shift;
430
431         if (!defined $e->{CONFORMANT_SIZE} && 
432             util::has_property($e, "size_is")) {
433                 my $size = ParseExpr($e, util::array_size($e), $var_prefix);
434                 pidl "if ($var_prefix$e->{NAME}) {";
435                 indent;
436                 check_null_pointer($size);
437                 pidl "NDR_CHECK(ndr_check_array_size(ndr, (void*)&$var_prefix$e->{NAME}, $size));";
438                 deindent;
439                 pidl "}";
440         }
441
442         if (my $length = util::has_property($e, "length_is")) {
443                 $length = ParseExpr($e, $length, $var_prefix);
444                 pidl "if ($var_prefix$e->{NAME}) {";
445                 indent;
446                 check_null_pointer($length);
447                 pidl "NDR_CHECK(ndr_check_array_length(ndr, (void*)&$var_prefix$e->{NAME}, $length));";
448                 deindent;
449                 pidl "}";
450         }
451 }
452
453 #####################################################################
454 # parse an array - pull side
455 sub ParseArrayPull($$$)
456 {
457         my $e = shift;
458         my $var_prefix = shift;
459         my $ndr_flags = shift;
460
461         my $size = ParseExpr($e, util::array_size($e), $var_prefix);
462         my $alloc_size = $size;
463
464         # if this is a conformant array then we use that size to allocate, and make sure
465         # we allocate enough to pull the elements
466         if (defined $e->{CONFORMANT_SIZE}) {
467                 $alloc_size = $e->{CONFORMANT_SIZE};
468                 check_null_pointer($size);
469                 pidl "if ($size > $alloc_size) {";
470                 indent;
471                 pidl "return ndr_pull_error(ndr, NDR_ERR_CONFORMANT_SIZE, \"Bad conformant size %u should be %u\", $alloc_size, $size);";
472                 deindent;
473                 pidl "}";
474         } elsif (!util::is_inline_array($e)) {
475                 if ($var_prefix =~ /^r->out/ && $size =~ /^\*r->in/) {
476                         my $size2 = substr($size, 1);
477                         pidl "if (ndr->flags & LIBNDR_FLAG_REF_ALLOC) { NDR_ALLOC(ndr, $size2); }";
478                 }
479
480                 # non fixed arrays encode the size just before the array
481                 pidl "NDR_CHECK(ndr_pull_array_size(ndr, &$var_prefix$e->{NAME}));";
482                 $alloc_size = "ndr_get_array_size(ndr, &$var_prefix$e->{NAME})";
483         }
484
485         if ((need_alloc($e) && !util::is_fixed_array($e)) ||
486             ($var_prefix eq "r->in." && util::has_property($e, "ref"))) {
487                 if (!util::is_inline_array($e) || $ndr_flags eq "NDR_SCALARS") {
488                         pidl "NDR_ALLOC_N(ndr, $var_prefix$e->{NAME}, $alloc_size);";
489                 }
490         }
491
492         if (($var_prefix eq "r->out." && util::has_property($e, "ref"))) {
493                 if (!util::is_inline_array($e) || $ndr_flags eq "NDR_SCALARS") {
494                         pidl "if (ndr->flags & LIBNDR_FLAG_REF_ALLOC) {";
495                         indent;
496                         pidl "NDR_ALLOC_N(ndr, $var_prefix$e->{NAME}, $alloc_size);";
497                         deindent;
498                         pidl "}";
499                 }
500         }
501
502         if (my $length = util::has_property($e, "length_is")) {
503                 pidl "NDR_CHECK(ndr_pull_array_length(ndr, &$var_prefix$e->{NAME}));";
504                 $size = "ndr_get_array_length(ndr, &$var_prefix$e->{NAME})";
505         }
506
507         check_null_pointer($size);
508         if (is_scalar_type($e->{TYPE})) {
509                 pidl "NDR_CHECK(ndr_pull_array_$e->{TYPE}(ndr, $ndr_flags, $var_prefix$e->{NAME}, $size));";
510         } else {
511                 pidl "NDR_CHECK(ndr_pull_array(ndr, $ndr_flags, (void **)$var_prefix$e->{NAME}, sizeof($var_prefix$e->{NAME}\[0]), $size, (ndr_pull_flags_fn_t)ndr_pull_$e->{TYPE}));";
512         }
513 }
514
515 #####################################################################
516 # parse scalars in a structure element
517 sub ParseElementPushScalar($$$)
518 {
519         my($e) = shift;
520         my($var_prefix) = shift;
521         my($ndr_flags) = shift;
522         my $cprefix = c_push_prefix($e);
523         my $sub_size = util::has_property($e, "subcontext");
524
525         start_flags($e);
526
527         if (my $value = util::has_property($e, "value")) {
528                 pidl "$cprefix$var_prefix$e->{NAME} = $value;";
529         }
530
531         if (util::has_property($e, "relative")) {
532                 pidl "NDR_CHECK(ndr_push_relative_ptr1(ndr, $var_prefix$e->{NAME}));";
533         } elsif (util::is_inline_array($e)) {
534                 ParseArrayPush($e, "r->", "NDR_SCALARS");
535         } elsif (need_wire_pointer($e)) {
536                 pidl "NDR_CHECK(ndr_push_unique_ptr(ndr, $var_prefix$e->{NAME}));";
537         } elsif (need_alloc($e)) {
538                 # no scalar component
539         } elsif (my $switch = util::has_property($e, "switch_is")) {
540                 ParseElementPushSwitch($e, $var_prefix, $ndr_flags, $switch);
541         } elsif (defined $sub_size) {
542                 pidl "NDR_CHECK(ndr_push_subcontext_flags_fn(ndr, $sub_size, $cprefix$var_prefix$e->{NAME}, (ndr_push_flags_fn_t) ndr_push_$e->{TYPE}));";
543         } else {
544                 pidl "NDR_CHECK(ndr_push_$e->{TYPE}(ndr, $ndr_flags, $cprefix$var_prefix$e->{NAME}));";
545         }
546
547         end_flags($e);
548 }
549
550 #####################################################################
551 # print scalars in a structure element
552 sub ParseElementPrintScalar($$)
553 {
554         my($e) = shift;
555         my($var_prefix) = shift;
556         my $cprefix = c_push_prefix($e);
557
558         if (util::has_property($e, "noprint")) {
559                 return;
560         }
561
562         if (my $value = util::has_property($e, "value")) {
563                 pidl "if (ndr->flags & LIBNDR_PRINT_SET_VALUES) {";
564                 indent;
565                 pidl "$cprefix$var_prefix$e->{NAME} = $value;";
566                 deindent;
567                 pidl "}";
568         }
569
570         if (util::is_fixed_array($e)) {
571                 ParseElementPrintBuffer($e, $var_prefix);
572         } elsif ($e->{POINTERS} || util::array_size($e)) {
573                 pidl "ndr_print_ptr(ndr, \"$e->{NAME}\", $var_prefix$e->{NAME});";
574                 pidl "ndr->depth++;";
575                 ParseElementPrintBuffer($e, $var_prefix);
576                 pidl "ndr->depth--;";
577         } elsif (my $switch = util::has_property($e, "switch_is")) {
578                 ParseElementPrintSwitch($e, $var_prefix, $switch);
579         } else {
580                 pidl "ndr_print_$e->{TYPE}(ndr, \"$e->{NAME}\", $cprefix$var_prefix$e->{NAME});";
581         }
582 }
583
584 #####################################################################
585 # parse scalars in a structure element - pull size
586 sub ParseElementPullSwitch($$$$)
587 {
588         my($e) = shift;
589         my($var_prefix) = shift;
590         my($ndr_flags) = shift;
591         my $switch = shift;
592         my $switch_var = ParseExpr($e, $switch, $var_prefix);
593
594         my $cprefix = c_pull_prefix($e);
595
596         my $utype = $typedefs{$e->{TYPE}};
597
598         check_null_pointer($switch_var);
599
600         if (!defined $utype ||
601             !util::has_property($utype, "nodiscriminant")) {
602                 my $e2 = find_sibling($e, $switch);
603                 my $type_decl = util::map_type($e2->{TYPE});
604                 pidl "if (($ndr_flags) & NDR_SCALARS) {";
605                 indent;
606                 if ($typedefs{$e2->{TYPE}}->{DATA}->{TYPE} eq "ENUM") {
607                         $type_decl = util::enum_type_decl($e2);
608                 } elsif ($typedefs{$e2->{TYPE}}->{DATA}->{TYPE} eq "BITMAP") {
609                         $type_decl = util::bitmap_type_decl($e2);
610                 }
611                 pidl "$type_decl _level;";
612                 pidl "NDR_CHECK(ndr_pull_$e2->{TYPE}(ndr, NDR_SCALARS, &_level));";
613                 if ($switch_var =~ /r->in/) {
614                         pidl "if (!(ndr->flags & LIBNDR_FLAG_REF_ALLOC) && _level != $switch_var) {";
615                         indent;
616                 } else {
617                         pidl "if (_level != $switch_var) {"; 
618                         indent;
619                 }
620                 pidl "return ndr_pull_error(ndr, NDR_ERR_BAD_SWITCH, \"Bad switch value %u in $e->{NAME}\", _level);";
621                 deindent;
622                 if ($switch_var =~ /r->/) {
623                         pidl "} else { $switch_var = _level; }";
624                 } else {
625                         pidl "}";
626                 }
627                 deindent;
628                 pidl "}";
629         }
630
631         my $sub_size = util::has_property($e, "subcontext");
632         if (defined $sub_size) {
633                 pidl "if (($ndr_flags) & NDR_SCALARS) {";
634                 indent;
635                 pidl "NDR_CHECK(ndr_pull_subcontext_union_fn(ndr, $sub_size, $switch_var, $cprefix$var_prefix$e->{NAME}, (ndr_pull_union_fn_t) ndr_pull_$e->{TYPE}));";
636                 deindent;
637                 pidl "}";
638         } else {
639                 pidl "NDR_CHECK(ndr_pull_$e->{TYPE}(ndr, $ndr_flags, $switch_var, $cprefix$var_prefix$e->{NAME}));";
640         }
641
642
643 }
644
645 #####################################################################
646 # push switch element
647 sub ParseElementPushSwitch($$$$)
648 {
649         my($e) = shift;
650         my($var_prefix) = shift;
651         my($ndr_flags) = shift;
652         my $switch = shift;
653         my $switch_var = ParseExpr($e, $switch, $var_prefix);
654         my $cprefix = c_push_prefix($e);
655
656         check_null_pointer($switch_var);
657
658         my $utype = $typedefs{$e->{TYPE}};
659         if (!defined $utype ||
660             !util::has_property($utype, "nodiscriminant")) {
661                 my $e2 = find_sibling($e, $switch);
662                 pidl "if (($ndr_flags) & NDR_SCALARS) {";
663                 indent;
664                 pidl "NDR_CHECK(ndr_push_$e2->{TYPE}(ndr, NDR_SCALARS, $switch_var));";
665                 deindent;
666                 pidl "}";
667         }
668
669         my $sub_size = util::has_property($e, "subcontext");
670         if (defined $sub_size) {
671                 pidl "if(($ndr_flags) & NDR_SCALARS) {";
672                 indent;
673                 pidl "NDR_CHECK(ndr_push_subcontext_union_fn(ndr, $sub_size, $switch_var, $cprefix$var_prefix$e->{NAME}, (ndr_push_union_fn_t) ndr_push_$e->{TYPE}));";
674                 deindent;
675                 pidl "}";
676         } else {
677                 pidl "NDR_CHECK(ndr_push_$e->{TYPE}(ndr, $ndr_flags, $switch_var, $cprefix$var_prefix$e->{NAME}));";
678         }
679 }
680
681 #####################################################################
682 # print scalars in a structure element 
683 sub ParseElementPrintSwitch($$$)
684 {
685         my($e) = shift;
686         my($var_prefix) = shift;
687         my $switch = shift;
688         my $switch_var = ParseExpr($e, $switch, $var_prefix);
689         my $cprefix = c_push_prefix($e);
690
691         check_null_pointer_void($switch_var);
692
693         pidl "ndr_print_$e->{TYPE}(ndr, \"$e->{NAME}\", $switch_var, $cprefix$var_prefix$e->{NAME});";
694 }
695
696
697 #####################################################################
698 # parse scalars in a structure element - pull size
699 sub ParseElementPullScalar($$$)
700 {
701         my($e) = shift;
702         my($var_prefix) = shift;
703         my($ndr_flags) = shift;
704         my $cprefix = c_pull_prefix($e);
705         my $sub_size = util::has_property($e, "subcontext");
706
707         start_flags($e);
708
709         if (util::is_inline_array($e)) {
710                 ParseArrayPull($e, "r->", "NDR_SCALARS");
711         } elsif (need_wire_pointer($e)) {
712                 pidl "NDR_CHECK(ndr_pull_unique_ptr(ndr, &_ptr_$e->{NAME}));";
713                 pidl "if (_ptr_$e->{NAME}) {";
714                 indent;
715                 pidl "NDR_ALLOC(ndr, $var_prefix$e->{NAME});";
716                 if (util::has_property($e, "relative")) {
717                         pidl "NDR_CHECK(ndr_pull_relative_ptr1(ndr, $var_prefix$e->{NAME}, _ptr_$e->{NAME}));";
718                 }
719                 deindent;
720                 pidl "} else {";
721                 indent;
722                 pidl "$var_prefix$e->{NAME} = NULL;";
723                 deindent;
724                 pidl "}";
725         } elsif (need_alloc($e)) {
726                 # no scalar component
727         } elsif (my $switch = util::has_property($e, "switch_is")) {
728                 ParseElementPullSwitch($e, $var_prefix, $ndr_flags, $switch);
729         } elsif (defined $sub_size) {
730                 pidl "NDR_CHECK(ndr_pull_subcontext_flags_fn(ndr, $sub_size, $cprefix$var_prefix$e->{NAME}, (ndr_pull_flags_fn_t) ndr_pull_$e->{TYPE}));";
731         } else {
732                 pidl "NDR_CHECK(ndr_pull_$e->{TYPE}(ndr, $ndr_flags, $cprefix$var_prefix$e->{NAME}));";
733         }
734         if (my $range = util::has_property($e, "range")) {
735                 my ($low, $high) = split(/ /, $range, 2);
736                 pidl "if ($var_prefix$e->{NAME} < $low || $var_prefix$e->{NAME} > $high) {";
737                 indent;
738                 pidl "return ndr_pull_error(ndr, NDR_ERR_RANGE, \"value out of range\");";
739                 deindent;
740                 pidl "}";
741         }
742
743         end_flags($e);
744 }
745
746 #####################################################################
747 # parse buffers in a structure element
748 sub ParseElementPushBuffer($$$)
749 {
750         my($e) = shift;
751         my($var_prefix) = shift;
752         my($ndr_flags) = shift;
753         my $cprefix = c_push_prefix($e);
754         my $sub_size = util::has_property($e, "subcontext");
755
756         if (is_pure_scalar($e)) {
757                 return;
758         }
759
760         start_flags($e);
761
762         if (need_wire_pointer($e)) {
763                 pidl "if ($var_prefix$e->{NAME}) {";
764                 indent;
765                 if (util::has_property($e, "relative")) {
766                         pidl "NDR_CHECK(ndr_push_relative_ptr2(ndr, $var_prefix$e->{NAME}));";
767                 }
768         }
769             
770         if (util::is_inline_array($e)) {
771                 ParseArrayPush($e, "r->", "NDR_BUFFERS");
772         } elsif (util::array_size($e)) {
773                 ParseArrayPush($e, "r->", "NDR_SCALARS|NDR_BUFFERS");
774         } elsif (my $switch = util::has_property($e, "switch_is")) {
775                 if ($e->{POINTERS}) {
776                         ParseElementPushSwitch($e, $var_prefix, "NDR_BUFFERS|NDR_SCALARS", $switch);
777                 } else {
778                         ParseElementPushSwitch($e, $var_prefix, "NDR_BUFFERS", $switch);
779                 }
780         } elsif (defined $sub_size) {
781                 if ($e->{POINTERS}) {
782                         pidl "NDR_CHECK(ndr_push_subcontext_flags_fn(ndr, $sub_size, $cprefix$var_prefix$e->{NAME}, (ndr_push_flags_fn_t) ndr_push_$e->{TYPE}));";
783                 }
784         } elsif ($e->{POINTERS}) {
785                 pidl "NDR_CHECK(ndr_push_$e->{TYPE}(ndr, NDR_SCALARS|NDR_BUFFERS, $cprefix$var_prefix$e->{NAME}));";
786         } else {
787                 pidl "NDR_CHECK(ndr_push_$e->{TYPE}(ndr, $ndr_flags, $cprefix$var_prefix$e->{NAME}));";
788         }
789
790         if (need_wire_pointer($e)) {
791                 deindent;
792                 pidl "}";
793         }       
794
795         end_flags($e);
796 }
797
798 #####################################################################
799 # print buffers in a structure element
800 sub ParseElementPrintBuffer($$)
801 {
802         my($e) = shift;
803         my($var_prefix) = shift;
804         my $cprefix = c_push_prefix($e);
805
806         if (need_wire_pointer($e)) {
807                 pidl "if ($var_prefix$e->{NAME}) {";
808                 indent;
809         }
810             
811         if (util::array_size($e)) {
812                 ParseArrayPrint($e, $var_prefix)
813         } elsif (my $switch = util::has_property($e, "switch_is")) {
814                 ParseElementPrintSwitch($e, $var_prefix, $switch);
815         } else {
816                 pidl "ndr_print_$e->{TYPE}(ndr, \"$e->{NAME}\", $cprefix$var_prefix$e->{NAME});";
817         }
818
819         if (need_wire_pointer($e)) {
820                 deindent;
821                 pidl "}";
822         }       
823 }
824
825
826 #####################################################################
827 # parse buffers in a structure element - pull side
828 sub ParseElementPullBuffer($$$)
829 {
830         my($e) = shift;
831         my($var_prefix) = shift;
832         my($ndr_flags) = shift;
833         my $cprefix = c_pull_prefix($e);
834         my $sub_size = util::has_property($e, "subcontext");
835
836         if (is_pure_scalar($e)) {
837                 return;
838         }
839
840         start_flags($e);
841
842         if (need_wire_pointer($e)) {
843                 pidl "if ($var_prefix$e->{NAME}) {";
844                 indent;
845                 if (util::has_property($e, "relative")) {
846                         pidl "struct ndr_pull_save _relative_save;";
847                         pidl "ndr_pull_save(ndr, &_relative_save);";
848                         pidl "NDR_CHECK(ndr_pull_relative_ptr2(ndr, $var_prefix$e->{NAME}));";
849                 }
850         }
851             
852         if (util::is_inline_array($e)) {
853                 ParseArrayPull($e, "r->", "NDR_BUFFERS");
854         } elsif (util::array_size($e)) {
855                 ParseArrayPull($e, "r->", "NDR_SCALARS|NDR_BUFFERS");
856         } elsif (my $switch = util::has_property($e, "switch_is")) {
857                 if ($e->{POINTERS}) {
858                         ParseElementPullSwitch($e, $var_prefix, "NDR_SCALARS|NDR_BUFFERS", $switch);
859                 } else {
860                         ParseElementPullSwitch($e, $var_prefix, "NDR_BUFFERS", $switch);
861                 }
862         } elsif (defined $sub_size) {
863                 if ($e->{POINTERS}) {
864                         pidl "NDR_CHECK(ndr_pull_subcontext_flags_fn(ndr, $sub_size, $cprefix$var_prefix$e->{NAME}, (ndr_pull_flags_fn_t) ndr_pull_$e->{TYPE}));";
865                 }
866         } elsif ($e->{POINTERS}) {
867                 pidl "NDR_CHECK(ndr_pull_$e->{TYPE}(ndr, NDR_SCALARS|NDR_BUFFERS, $cprefix$var_prefix$e->{NAME}));";
868         } else {
869                 pidl "NDR_CHECK(ndr_pull_$e->{TYPE}(ndr, $ndr_flags, $cprefix$var_prefix$e->{NAME}));";
870         }
871
872         if (need_wire_pointer($e)) {
873                 if (util::has_property($e, "relative")) {
874                         pidl "ndr_pull_restore(ndr, &_relative_save);";
875                 }
876                 deindent;
877                 pidl "}";
878         }       
879
880         end_flags($e);
881 }
882
883 #####################################################################
884 # parse a struct
885 sub ParseStructPush($)
886 {
887         my($struct) = shift;
888         
889         if (! defined $struct->{ELEMENTS}) {
890                 return;
891         }
892
893         start_flags($struct);
894
895         # see if the structure contains a conformant array. If it
896         # does, then it must be the last element of the structure, and
897         # we need to push the conformant length early, as it fits on
898         # the wire before the structure (and even before the structure
899         # alignment)
900         my $e = $struct->{ELEMENTS}[-1];
901         if (defined $e->{ARRAY_LEN} && $e->{ARRAY_LEN} eq "*") {
902                 my $size = ParseExpr($e, util::array_size($e), "r->");
903                 $e->{CONFORMANT_SIZE} = $size;
904                 check_null_pointer($size);
905                 pidl "NDR_CHECK(ndr_push_uint32(ndr, NDR_SCALARS, $size));";
906         }
907
908         if (defined $e->{TYPE} && $e->{TYPE} eq "string" 
909             &&  util::property_matches($e, "flag", ".*LIBNDR_FLAG_STR_CONFORMANT.*")) {
910                 pidl "NDR_CHECK(ndr_push_uint32(ndr, NDR_SCALARS, ndr_string_array_size(ndr, r->$e->{NAME})));";
911         }
912
913         pidl "if (!(ndr_flags & NDR_SCALARS)) goto buffers;";
914
915         pidl "NDR_CHECK(ndr_push_struct_start(ndr));";
916
917         my $align = find_largest_alignment($struct);
918         pidl "NDR_CHECK(ndr_push_align(ndr, $align));";
919
920         foreach my $e (@{$struct->{ELEMENTS}}) {
921                 ParseElementPushScalar($e, "r->", "NDR_SCALARS");
922         }       
923
924         pidl "buffers:";
925         pidl "if (!(ndr_flags & NDR_BUFFERS)) goto done;";
926         foreach my $e (@{$struct->{ELEMENTS}}) {
927                 ParseElementPushBuffer($e, "r->", "NDR_BUFFERS");
928         }
929
930         pidl "ndr_push_struct_end(ndr);";
931
932         pidl "done:";
933
934         end_flags($struct);
935 }
936
937
938 #####################################################################
939 # generate a push function for an enum
940 sub ParseEnumPush($)
941 {
942         my($enum) = shift;
943         my($type_fn) = util::enum_type_fn($enum);
944
945         start_flags($enum);
946
947         pidl "NDR_CHECK(ndr_push_$type_fn(ndr, NDR_SCALARS, r));";
948
949         end_flags($enum);
950 }
951
952 #####################################################################
953 # generate a pull function for an enum
954 sub ParseEnumPull($)
955 {
956         my($enum) = shift;
957         my($type_fn) = util::enum_type_fn($enum);
958         my($type_v_decl) = util::map_type(util::enum_type_fn($enum));
959
960         pidl "$type_v_decl v;";
961         start_flags($enum);
962         pidl "NDR_CHECK(ndr_pull_$type_fn(ndr, NDR_SCALARS, &v));";
963         pidl "*r = v;";
964
965         end_flags($enum);
966 }
967
968 #####################################################################
969 # generate a print function for an enum
970 sub ParseEnumPrint($)
971 {
972         my($enum) = shift;
973
974         pidl "const char *val = NULL;";
975         pidl "";
976
977         start_flags($enum);
978
979         pidl "switch (r) {";
980         indent;
981         my $els = \@{$enum->{ELEMENTS}};
982         foreach my $i (0 .. $#{$els}) {
983                 my $e = ${$els}[$i];
984                 chomp $e;
985                 if ($e =~ /^(.*)=/) {
986                         $e = $1;
987                 }
988                 pidl "case $e: val = \"$e\"; break;";
989         }
990
991         deindent;
992         pidl "}";
993         
994         pidl "ndr_print_enum(ndr, name, \"$enum->{TYPE}\", val, r);";
995
996         end_flags($enum);
997 }
998
999 $typefamily{ENUM} = {
1000         PUSH_FN_BODY => \&ParseEnumPush,
1001         PULL_FN_BODY => \&ParseEnumPull,
1002         PRINT_FN_BODY => \&ParseEnumPrint,
1003         ALIGN => sub { return align_type(util::enum_type_fn(shift)); }
1004 };
1005
1006 #####################################################################
1007 # generate a push function for a bitmap
1008 sub ParseBitmapPush($)
1009 {
1010         my($bitmap) = shift;
1011         my($type_fn) = util::bitmap_type_fn($bitmap);
1012
1013         start_flags($bitmap);
1014
1015         pidl "NDR_CHECK(ndr_push_$type_fn(ndr, NDR_SCALARS, r));";
1016
1017         end_flags($bitmap);
1018 }
1019
1020 #####################################################################
1021 # generate a pull function for an bitmap
1022 sub ParseBitmapPull($)
1023 {
1024         my($bitmap) = shift;
1025         my($type_fn) = util::bitmap_type_fn($bitmap);
1026         my($type_decl) = util::bitmap_type_decl($bitmap);
1027
1028         pidl "$type_decl v;";
1029         start_flags($bitmap);
1030         pidl "NDR_CHECK(ndr_pull_$type_fn(ndr, NDR_SCALARS, &v));";
1031         pidl "*r = v;";
1032
1033         end_flags($bitmap);
1034 }
1035
1036 #####################################################################
1037 # generate a print function for an bitmap
1038 sub ParseBitmapPrintElement($$)
1039 {
1040         my($e) = shift;
1041         my($bitmap) = shift;
1042         my($type_decl) = util::bitmap_type_decl($bitmap);
1043         my($type_fn) = util::bitmap_type_fn($bitmap);
1044         my($name) = $bitmap->{PARENT}->{NAME};
1045         my($flag);
1046
1047         if ($e =~ /^(\w+) .*$/) {
1048                 $flag = "$1";
1049         } else {
1050                 die "Bitmap: \"$name\" invalid Flag: \"$e\"";
1051         }
1052
1053         pidl "ndr_print_bitmap_flag(ndr, sizeof($type_decl), \"$flag\", $flag, r);";
1054 }
1055
1056 #####################################################################
1057 # generate a print function for an bitmap
1058 sub ParseBitmapPrint($)
1059 {
1060         my($bitmap) = shift;
1061         my($type_decl) = util::bitmap_type_decl($bitmap);
1062         my($type_fn) = util::bitmap_type_fn($bitmap);
1063
1064         start_flags($bitmap);
1065
1066         pidl "ndr_print_$type_fn(ndr, name, r);";
1067
1068         pidl "ndr->depth++;";
1069         foreach my $e (@{$bitmap->{ELEMENTS}}) {
1070                 ParseBitmapPrintElement($e, $bitmap);
1071         }
1072         pidl "ndr->depth--;";
1073
1074         end_flags($bitmap);
1075 }
1076
1077 $typefamily{BITMAP} = {
1078         PUSH_FN_BODY => \&ParseBitmapPush,
1079         PULL_FN_BODY => \&ParseBitmapPull,
1080         PRINT_FN_BODY => \&ParseBitmapPrint,
1081         ALIGN => sub { return align_type(util::bitmap_type_fn(shift)); }
1082 };
1083
1084 #####################################################################
1085 # generate a struct print function
1086 sub ParseStructPrint($)
1087 {
1088         my($struct) = shift;
1089
1090         if (! defined $struct->{ELEMENTS}) {
1091                 return;
1092         }
1093
1094         start_flags($struct);
1095
1096         pidl "ndr->depth++;";
1097         foreach my $e (@{$struct->{ELEMENTS}}) {
1098                 ParseElementPrintScalar($e, "r->");
1099         }
1100         pidl "ndr->depth--;";
1101
1102         end_flags($struct);
1103 }
1104
1105 #####################################################################
1106 # parse a struct - pull side
1107 sub ParseStructPull($)
1108 {
1109         my($struct) = shift;
1110         my $conform_e;
1111
1112         if (! defined $struct->{ELEMENTS}) {
1113                 return;
1114         }
1115
1116         # see if the structure contains a conformant array. If it
1117         # does, then it must be the last element of the structure, and
1118         # we need to pull the conformant length early, as it fits on
1119         # the wire before the structure (and even before the structure
1120         # alignment)
1121         my $e = $struct->{ELEMENTS}[-1];
1122         if (defined $e->{ARRAY_LEN} && $e->{ARRAY_LEN} eq "*") {
1123                 $conform_e = $e;
1124         }
1125
1126         if (defined $e->{TYPE} && $e->{TYPE} eq "string"
1127             &&  util::property_matches($e, "flag", ".*LIBNDR_FLAG_STR_CONFORMANT.*")) {
1128                 $conform_e = $e;
1129         }
1130
1131         if (defined $conform_e) {
1132                 $conform_e = $e;
1133                 pidl "uint32_t _conformant_size;";
1134                 $conform_e->{CONFORMANT_SIZE} = "_conformant_size";
1135         }
1136
1137         # declare any internal pointers we need
1138         foreach my $e (@{$struct->{ELEMENTS}}) {
1139                 if (need_wire_pointer($e)) {
1140                         pidl "uint32_t _ptr_$e->{NAME};";
1141                 }
1142         }
1143
1144         start_flags($struct);
1145
1146         pidl "if (!(ndr_flags & NDR_SCALARS)) goto buffers;";
1147
1148         pidl "NDR_CHECK(ndr_pull_struct_start(ndr));";
1149
1150         if (defined $conform_e) {
1151                 pidl "NDR_CHECK(ndr_pull_uint32(ndr, NDR_SCALARS, &$conform_e->{CONFORMANT_SIZE}));";
1152         }
1153
1154         my $align = find_largest_alignment($struct);
1155         pidl "NDR_CHECK(ndr_pull_align(ndr, $align));";
1156
1157         foreach my $e (@{$struct->{ELEMENTS}}) {
1158                 ParseElementPullScalar($e, "r->", "NDR_SCALARS");
1159         }       
1160
1161         pidl "buffers:\n";
1162         pidl "if (!(ndr_flags & NDR_BUFFERS)) goto done;";
1163         foreach my $e (@{$struct->{ELEMENTS}}) {
1164                 ParseElementPullBuffer($e, "r->", "NDR_BUFFERS");
1165         }
1166
1167         foreach my $e (@{$struct->{ELEMENTS}}) {
1168                 CheckArraySizes($e, "r->");
1169         }
1170
1171         pidl "ndr_pull_struct_end(ndr);";
1172
1173         pidl "done:";
1174
1175         end_flags($struct);
1176 }
1177
1178 #####################################################################
1179 # calculate size of ndr struct
1180 sub ParseStructNdrSize($)
1181 {
1182         my $t = shift;
1183         my $static = fn_prefix($t);
1184         my $sizevar;
1185
1186         pidl "size_t ndr_size_$t->{NAME}(const struct $t->{NAME} *r, int flags)";
1187         pidl "{";
1188         indent;
1189         if (my $flags = util::has_property($t, "flag")) {
1190                 pidl "flags |= $flags;";
1191         }
1192         pidl "return ndr_size_struct(r, flags, (ndr_push_flags_fn_t)ndr_push_$t->{NAME});";
1193         deindent;
1194         pidl "}";
1195         pidl "";
1196 }
1197
1198 $typefamily{STRUCT} = {
1199         PUSH_FN_BODY => \&ParseStructPush,
1200         PULL_FN_BODY => \&ParseStructPull,
1201         PRINT_FN_BODY => \&ParseStructPrint,
1202         SIZE_FN => \&ParseStructNdrSize,
1203         ALIGN => \&find_largest_alignment
1204 };
1205
1206 #####################################################################
1207 # calculate size of ndr struct
1208 sub ParseUnionNdrSize($)
1209 {
1210         my $t = shift;
1211         my $static = fn_prefix($t);
1212         my $sizevar;
1213
1214         pidl "size_t ndr_size_$t->{NAME}(const union $t->{NAME} *r, int level, int flags)";
1215         pidl "{";
1216         indent;
1217         if (my $flags = util::has_property($t, "flag")) {
1218                 pidl "flags |= $flags;";
1219         }
1220         pidl "return ndr_size_union(r, flags, level, (ndr_push_union_fn_t)ndr_push_$t->{NAME});";
1221         deindent;
1222         pidl "}";
1223         pidl "";;
1224 }
1225
1226 #####################################################################
1227 # parse a union - push side
1228 sub ParseUnionPush($)
1229 {
1230         my $e = shift;
1231         my $have_default = 0;
1232
1233         start_flags($e);
1234
1235         pidl "if (!(ndr_flags & NDR_SCALARS)) goto buffers;";
1236
1237         pidl "NDR_CHECK(ndr_push_struct_start(ndr));";
1238
1239 #       my $align = union_alignment($e);
1240 #       pidl "NDR_CHECK(ndr_push_align(ndr, $align));";
1241
1242         pidl "switch (level) {";
1243         indent;
1244         foreach my $el (@{$e->{ELEMENTS}}) {
1245                 if (util::has_property($el, "default")) {
1246                         pidl "default:";
1247                         $have_default = 1;
1248                 } else {
1249                         pidl "case $el->{PROPERTIES}->{case}:";
1250
1251                 }
1252                 if ($el->{TYPE} ne "EMPTY") {
1253                         indent;
1254                         ParseElementPushScalar($el, "r->", "NDR_SCALARS");
1255                         deindent;
1256                 }
1257                 pidl "break;";
1258                 pidl "";
1259         }
1260         if (! $have_default) {
1261                 pidl "default:";
1262                 pidl "\treturn ndr_push_error(ndr, NDR_ERR_BAD_SWITCH, \"Bad switch value \%u\", level);";
1263         }
1264         deindent;
1265         pidl "}";
1266         pidl "buffers:";
1267         pidl "if (!(ndr_flags & NDR_BUFFERS)) goto done;";
1268         pidl "switch (level) {";
1269         indent;
1270         foreach my $el (@{$e->{ELEMENTS}}) {
1271                 if (util::has_property($el, "default")) {
1272                         pidl "default:";
1273                 } else {
1274                         pidl "case $el->{PROPERTIES}->{case}:";
1275                 }
1276                 if ($el->{TYPE} ne "EMPTY") {
1277                         indent;
1278                         ParseElementPushBuffer($el, "r->", "NDR_BUFFERS");
1279                         deindent;
1280                 }
1281                 pidl "break;";
1282                 pidl "";
1283         }
1284         if (! $have_default) {
1285                 pidl "default:";
1286                 pidl "\treturn ndr_push_error(ndr, NDR_ERR_BAD_SWITCH, \"Bad switch value \%u\", level);";
1287         }
1288         deindent;
1289         pidl "}";
1290         pidl "ndr_push_struct_end(ndr);";
1291         pidl "done:";
1292         end_flags($e);
1293 }
1294
1295 #####################################################################
1296 # print a union
1297 sub ParseUnionPrint($)
1298 {
1299         my $e = shift;
1300         my $have_default = 0;
1301
1302         start_flags($e);
1303
1304         pidl "switch (level) {";
1305         indent;
1306         foreach my $el (@{$e->{ELEMENTS}}) {
1307                 if (util::has_property($el, "default")) {
1308                         $have_default = 1;
1309                         pidl "default:";
1310                 } else {
1311                         pidl "case $el->{PROPERTIES}->{case}:";
1312                 }
1313                 if ($el->{TYPE} ne "EMPTY") {
1314                         indent;
1315                         ParseElementPrintScalar($el, "r->");
1316                         deindent;
1317                 }
1318                 pidl "break;";
1319                 pidl "";
1320         }
1321         if (! $have_default) {
1322                 pidl "default:";
1323                 pidl "\tndr_print_bad_level(ndr, name, level);";
1324         }
1325         deindent;
1326         pidl "}";
1327
1328         end_flags($e);
1329 }
1330
1331 #####################################################################
1332 # parse a union - pull side
1333 sub ParseUnionPull($)
1334 {
1335         my $e = shift;
1336         my $have_default = 0;
1337
1338         start_flags($e);
1339
1340         pidl "if (!(ndr_flags & NDR_SCALARS)) goto buffers;";
1341
1342         pidl "NDR_CHECK(ndr_pull_struct_start(ndr));";
1343
1344 #       my $align = union_alignment($e);
1345 #       pidl "\tNDR_CHECK(ndr_pull_align(ndr, $align));\n";
1346
1347         pidl "switch (level) {";
1348         indent;
1349         foreach my $el (@{$e->{ELEMENTS}}) {
1350                 if (util::has_property($el, "default")) {
1351                         pidl "default: {";
1352                         $have_default = 1;
1353                 } else {
1354                         pidl "case $el->{PROPERTIES}->{case}: {";
1355                 }
1356                 if ($el->{TYPE} ne "EMPTY") {
1357                         indent;
1358                         if ($el->{POINTERS}) {
1359                                 pidl "uint32_t _ptr_$el->{NAME};";
1360                         }
1361                         ParseElementPullScalar($el, "r->", "NDR_SCALARS");
1362                         deindent;
1363                 }
1364                 pidl "break; }";
1365                 pidl "";
1366         }
1367         if (! $have_default) {
1368                 pidl "default:";
1369                 pidl "\treturn ndr_pull_error(ndr, NDR_ERR_BAD_SWITCH, \"Bad switch value \%u\", level);";
1370         }
1371         deindent;
1372         pidl "}";
1373         pidl "buffers:";
1374         pidl "if (!(ndr_flags & NDR_BUFFERS)) goto done;";
1375         pidl "switch (level) {";
1376         indent;
1377         foreach my $el (@{$e->{ELEMENTS}}) {
1378                 if (util::has_property($el, "default")) {
1379                         pidl "default:";
1380                 } else {
1381                         pidl "case $el->{PROPERTIES}->{case}:";
1382                 }
1383                 if ($el->{TYPE} ne "EMPTY") {
1384                         indent;
1385                         ParseElementPullBuffer($el, "r->", "NDR_BUFFERS");
1386                         deindent;
1387                 }
1388                 pidl "break;";
1389                 pidl "";
1390         }
1391         if (! $have_default) {
1392                 pidl "default:";
1393                 pidl "\treturn ndr_pull_error(ndr, NDR_ERR_BAD_SWITCH, \"Bad switch value \%u\", level);";
1394         }
1395         deindent;
1396         pidl "}";
1397         pidl "ndr_pull_struct_end(ndr);";
1398         pidl "done:";
1399         end_flags($e);
1400 }
1401
1402 $typefamily{UNION} = {
1403         PUSH_FN_BODY => \&ParseUnionPush,
1404         PULL_FN_BODY => \&ParseUnionPull,
1405         PRINT_FN_BODY => \&ParseUnionPrint,
1406         SIZE_FN => \&ParseUnionNdrSize,
1407         ALIGN => \&find_largest_alignment
1408 };
1409
1410         
1411 #####################################################################
1412 # parse a typedef - push side
1413 sub ParseTypedefPush($)
1414 {
1415         my($e) = shift;
1416         my $static = fn_prefix($e);
1417
1418         if (! needed::is_needed("push_$e->{NAME}")) {
1419 #               print "push_$e->{NAME} not needed\n";
1420                 return;
1421         }
1422
1423         my $args;
1424         if ($e->{DATA}->{TYPE} eq "STRUCT") {
1425                 $args = "struct ndr_push *ndr, int ndr_flags, struct $e->{NAME} *r";
1426         }
1427
1428         if ($e->{DATA}->{TYPE} eq "UNION") {
1429                 $args = "struct ndr_push *ndr, int ndr_flags, int level, union $e->{NAME} *r";
1430         }
1431
1432         if ($e->{DATA}->{TYPE} eq "ENUM") {
1433                 $args = "struct ndr_push *ndr, int ndr_flags, enum $e->{NAME} r";
1434         }
1435
1436         if ($e->{DATA}->{TYPE} eq "BITMAP") {
1437                 my $type_decl = util::bitmap_type_decl($e->{DATA});
1438                 $args = "struct ndr_push *ndr, int ndr_flags, $type_decl r";
1439         }
1440         
1441         pidl $static . "NTSTATUS ndr_push_$e->{NAME}($args)";
1442
1443         pidl "{";
1444         indent;
1445         $typefamily{$e->{DATA}->{TYPE}}->{PUSH_FN_BODY}($e->{DATA});
1446         pidl "return NT_STATUS_OK;";
1447         deindent;
1448         pidl "}";
1449         pidl "";;
1450 }
1451
1452 #####################################################################
1453 # parse a typedef - pull side
1454 sub ParseTypedefPull($)
1455 {
1456         my($e) = shift;
1457         my $static = fn_prefix($e);
1458
1459         if (! needed::is_needed("pull_$e->{NAME}")) {
1460 #               print "pull_$e->{NAME} not needed\n";
1461                 return;
1462         }
1463
1464         my $args = "";
1465
1466         if ($e->{DATA}->{TYPE} eq "STRUCT") {
1467                 $args = "struct ndr_pull *ndr, int ndr_flags, struct $e->{NAME} *r";
1468         }
1469
1470         if ($e->{DATA}->{TYPE} eq "UNION") {
1471                 $args = "struct ndr_pull *ndr, int ndr_flags, int level, union $e->{NAME} *r";
1472         }
1473
1474         if ($e->{DATA}->{TYPE} eq "ENUM") {
1475                 $args = "struct ndr_pull *ndr, int ndr_flags, enum $e->{NAME} *r";
1476         }
1477
1478         if ($e->{DATA}->{TYPE} eq "BITMAP") {
1479                 my $type_decl = util::bitmap_type_decl($e->{DATA});
1480                 $args = "struct ndr_pull *ndr, int ndr_flags, $type_decl *r";
1481         }
1482         
1483         pidl $static . "NTSTATUS ndr_pull_$e->{NAME}($args)";
1484
1485         pidl "{";
1486         indent;
1487         $typefamily{$e->{DATA}->{TYPE}}->{PULL_FN_BODY}($e->{DATA});
1488         pidl "return NT_STATUS_OK;";
1489         deindent;
1490         pidl "}";
1491         pidl "";
1492 }
1493
1494 #####################################################################
1495 # parse a typedef - print side
1496 sub ParseTypedefPrint($)
1497 {
1498         my($e) = shift;
1499
1500         if ($e->{DATA}->{TYPE} eq "STRUCT") {
1501                 pidl "void ndr_print_$e->{NAME}(struct ndr_print *ndr, const char *name, struct $e->{NAME} *r)";
1502                 pidl "{";
1503                 indent;
1504                 pidl "ndr_print_struct(ndr, name, \"$e->{NAME}\");";
1505         }
1506
1507         if ($e->{DATA}->{TYPE} eq "UNION") {
1508                 pidl "void ndr_print_$e->{NAME}(struct ndr_print *ndr, const char *name, int level, union $e->{NAME} *r)";
1509                 pidl "{";
1510                 indent;
1511                 pidl "ndr_print_union(ndr, name, level, \"$e->{NAME}\");";
1512         }
1513
1514         if ($e->{DATA}->{TYPE} eq "ENUM") {
1515                 pidl "void ndr_print_$e->{NAME}(struct ndr_print *ndr, const char *name, enum $e->{NAME} r)";
1516                 pidl "{";
1517                 indent;
1518         }
1519
1520         if ($e->{DATA}->{TYPE} eq "BITMAP") {
1521                 my $type_decl = util::bitmap_type_decl($e->{DATA});
1522                 pidl "void ndr_print_$e->{NAME}(struct ndr_print *ndr, const char *name, $type_decl r)";
1523                 pidl "{";
1524                 indent;
1525         }
1526
1527         $typefamily{$e->{DATA}->{TYPE}}->{PRINT_FN_BODY}($e->{DATA});
1528         deindent;
1529         pidl "}";
1530 }
1531
1532 #####################################################################
1533 ## calculate the size of a structure
1534 sub ParseTypedefNdrSize($)
1535 {
1536         my($t) = shift;
1537         if (! needed::is_needed("ndr_size_$t->{NAME}")) {
1538                 return;
1539         }
1540
1541         $typefamily{$t->{DATA}->{TYPE}}->{SIZE_FN}($t);
1542 }
1543
1544 #####################################################################
1545 # parse a function - print side
1546 sub ParseFunctionPrint($)
1547 {
1548         my($fn) = shift;
1549
1550         pidl "void ndr_print_$fn->{NAME}(struct ndr_print *ndr, const char *name, int flags, struct $fn->{NAME} *r)";
1551         pidl "{";
1552         indent;
1553         pidl "ndr_print_struct(ndr, name, \"$fn->{NAME}\");";
1554         pidl "ndr->depth++;";
1555
1556         pidl "if (flags & NDR_SET_VALUES) {";
1557         pidl "\tndr->flags |= LIBNDR_PRINT_SET_VALUES;";
1558         pidl "}";
1559
1560         pidl "if (flags & NDR_IN) {";
1561         indent;
1562         pidl "ndr_print_struct(ndr, \"in\", \"$fn->{NAME}\");";
1563         pidl "ndr->depth++;";
1564
1565         foreach my $e (@{$fn->{ELEMENTS}}) {
1566                 if (util::has_property($e, "in")) {
1567                         ParseElementPrintScalar($e, "r->in.");
1568                 }
1569         }
1570         pidl "ndr->depth--;";
1571         deindent;
1572         pidl "}";
1573         
1574         pidl "if (flags & NDR_OUT) {";
1575         indent;
1576         pidl "ndr_print_struct(ndr, \"out\", \"$fn->{NAME}\");";
1577         pidl "ndr->depth++;";
1578         foreach my $e (@{$fn->{ELEMENTS}}) {
1579                 if (util::has_property($e, "out")) {
1580                         ParseElementPrintScalar($e, "r->out.");
1581                 }
1582         }
1583         if ($fn->{RETURN_TYPE} && $fn->{RETURN_TYPE} ne "void") {
1584                 my $cprefix = "&";
1585                 $cprefix = "" if (is_scalar_type($fn->{RETURN_TYPE})) ; # FIXME: Should really use util::c_push_prefix here
1586                 pidl "ndr_print_$fn->{RETURN_TYPE}(ndr, \"result\", $cprefix"."r->out.result);";
1587         }
1588         pidl "ndr->depth--;";
1589         deindent;
1590         pidl "}";
1591         
1592         pidl "ndr->depth--;";
1593         deindent;
1594         pidl "}";
1595         pidl "";
1596 }
1597
1598 #####################################################################
1599 # parse a function element
1600 sub ParseFunctionElementPush($$)
1601
1602         my $e = shift;
1603         my $inout = shift;
1604
1605         if (util::array_size($e)) {
1606                 if (need_wire_pointer($e)) {
1607                         pidl "NDR_CHECK(ndr_push_unique_ptr(ndr, r->$inout.$e->{NAME}));";
1608                         pidl "if (r->$inout.$e->{NAME}) {";
1609                         indent;
1610                         ParseArrayPush($e, "r->$inout.", "NDR_SCALARS|NDR_BUFFERS");
1611                         deindent;
1612                         pidl "}";
1613                 } else {
1614                         ParseArrayPush($e, "r->$inout.", "NDR_SCALARS|NDR_BUFFERS");
1615                 }
1616         } else {
1617                 ParseElementPushScalar($e, "r->$inout.", "NDR_SCALARS|NDR_BUFFERS");
1618
1619                 if ($e->{POINTERS}) {
1620                         ParseElementPushBuffer($e, "r->$inout.", "NDR_SCALARS|NDR_BUFFERS");
1621                 }
1622         }
1623 }       
1624
1625 #####################################################################
1626 # parse a function
1627 sub ParseFunctionPush($)
1628
1629         my($fn) = shift;
1630         my $static = fn_prefix($fn);
1631
1632         pidl $static . "NTSTATUS ndr_push_$fn->{NAME}(struct ndr_push *ndr, int flags, struct $fn->{NAME} *r)";
1633         pidl "{";
1634         indent;
1635
1636         pidl "if (!(flags & NDR_IN)) goto ndr_out;";
1637         pidl "";
1638
1639         foreach my $e (@{$fn->{ELEMENTS}}) {
1640                 if (util::has_property($e, "in")) {
1641                         ParseFunctionElementPush($e, "in");
1642                 }               
1643         }
1644
1645         pidl "ndr_out:";
1646         pidl "if (!(flags & NDR_OUT)) goto done;";
1647         pidl "";
1648
1649         foreach my $e (@{$fn->{ELEMENTS}}) {
1650                 if (util::has_property($e, "out")) {
1651                         ParseFunctionElementPush($e, "out");
1652                 }               
1653         }
1654
1655         if ($fn->{RETURN_TYPE} && $fn->{RETURN_TYPE} ne "void") {
1656                 pidl "NDR_CHECK(ndr_push_$fn->{RETURN_TYPE}(ndr, NDR_SCALARS, r->out.result));";
1657         }
1658     
1659         pidl "done:";
1660         pidl "return NT_STATUS_OK;";
1661         deindent;
1662         pidl "}";
1663         pidl "";
1664 }
1665
1666 #####################################################################
1667 # parse a function element
1668 sub ParseFunctionElementPull($$)
1669
1670         my $e = shift;
1671         my $inout = shift;
1672
1673         if (util::array_size($e)) {
1674                 if (need_wire_pointer($e)) {
1675                         pidl "NDR_CHECK(ndr_pull_unique_ptr(ndr, &_ptr_$e->{NAME}));";
1676                         pidl "r->$inout.$e->{NAME} = NULL;";
1677                         pidl "if (_ptr_$e->{NAME}) {";
1678                         indent;
1679                 } elsif ($inout eq "out" && util::has_property($e, "ref")) {
1680                         pidl "if (r->$inout.$e->{NAME}) {";
1681                         indent;
1682                 } else {
1683                         pidl "{";
1684                         indent;
1685                 }
1686                 ParseArrayPull($e, "r->$inout.", "NDR_SCALARS|NDR_BUFFERS");
1687                 deindent;
1688                 pidl "}";
1689         } else {
1690                 if ($inout eq "out" && util::has_property($e, "ref")) {
1691                         pidl "if (ndr->flags & LIBNDR_FLAG_REF_ALLOC) {";
1692                         pidl "\tNDR_ALLOC(ndr, r->out.$e->{NAME});";
1693                         pidl "}";
1694                 }
1695                 if ($inout eq "in" && util::has_property($e, "ref")) {
1696                         pidl "NDR_ALLOC(ndr, r->in.$e->{NAME});";
1697                 }
1698
1699                 ParseElementPullScalar($e, "r->$inout.", "NDR_SCALARS|NDR_BUFFERS");
1700                 if ($e->{POINTERS}) {
1701                         ParseElementPullBuffer($e, "r->$inout.", "NDR_SCALARS|NDR_BUFFERS");
1702                 }
1703         }
1704 }
1705
1706 ############################################################
1707 # allocate ref variables
1708 sub AllocateRefVars($)
1709 {
1710         my $e = shift;
1711         my $asize = util::array_size($e);
1712
1713         # note that if the variable is also an "in"
1714         # variable then we copy the initial value from
1715         # the in side
1716
1717         if (!defined $asize) {
1718                 # its a simple variable
1719                 pidl "NDR_ALLOC(ndr, r->out.$e->{NAME});";
1720                 if (util::has_property($e, "in")) {
1721                         pidl "*r->out.$e->{NAME} = *r->in.$e->{NAME};";
1722                 } else {
1723                         pidl "ZERO_STRUCTP(r->out.$e->{NAME});";
1724                 }
1725                 return;
1726         }
1727
1728         # its an array
1729         my $size = ParseExpr($e, $asize, "r->out.");
1730         check_null_pointer($size);
1731         pidl "NDR_ALLOC_N(ndr, r->out.$e->{NAME}, $size);";
1732         if (util::has_property($e, "in")) {
1733                 pidl "memcpy(r->out.$e->{NAME},r->in.$e->{NAME},$size * sizeof(*r->in.$e->{NAME}));";
1734         } else {
1735                 pidl "memset(r->out.$e->{NAME}, 0, $size * sizeof(*r->out.$e->{NAME}));";
1736         }
1737 }
1738
1739 #####################################################################
1740 # parse a function
1741 sub ParseFunctionPull($)
1742
1743         my($fn) = shift;
1744         my $static = fn_prefix($fn);
1745
1746         # pull function args
1747         pidl $static . "NTSTATUS ndr_pull_$fn->{NAME}(struct ndr_pull *ndr, int flags, struct $fn->{NAME} *r)";
1748         pidl "{";
1749         indent;
1750
1751         # declare any internal pointers we need
1752         foreach my $e (@{$fn->{ELEMENTS}}) {
1753                 if (need_wire_pointer($e)) {
1754                         pidl "uint32_t _ptr_$e->{NAME};";
1755                 }
1756         }
1757
1758         pidl "if (!(flags & NDR_IN)) goto ndr_out;";
1759         pidl "";
1760
1761         # auto-init the out section of a structure. I originally argued that
1762         # this was a bad idea as it hides bugs, but coping correctly
1763         # with initialisation and not wiping ref vars is turning
1764         # out to be too tricky (tridge)
1765         foreach my $e (@{$fn->{ELEMENTS}}) {
1766                 if (util::has_property($e, "out")) {
1767                         pidl "ZERO_STRUCT(r->out);";
1768                         pidl "";
1769                         last;
1770                 }
1771         }
1772
1773         foreach my $e (@{$fn->{ELEMENTS}}) {
1774                 if (util::has_property($e, "in")) {
1775                         ParseFunctionElementPull($e, "in");
1776                 }
1777                 # we need to allocate any reference output variables, so that
1778                 # a dcerpc backend can be sure they are non-null
1779                 if (util::has_property($e, "out") && util::has_property($e, "ref")) {
1780                         AllocateRefVars($e);
1781                 }
1782         }
1783
1784         foreach my $e (@{$fn->{ELEMENTS}}) {
1785                 if (util::has_property($e, "in")) {
1786                         CheckArraySizes($e, "r->in.");
1787                 }
1788         }
1789
1790         pidl "ndr_out:";
1791         pidl "if (!(flags & NDR_OUT)) goto done;";
1792         pidl "";
1793
1794         foreach my $e (@{$fn->{ELEMENTS}}) {
1795                 if (util::has_property($e, "out")) {
1796                         ParseFunctionElementPull($e, "out");
1797                 }
1798         }
1799
1800         foreach my $e (@{$fn->{ELEMENTS}}) {
1801                 if (util::has_property($e, "out")) {
1802                         CheckArraySizes($e, "r->out.");
1803                 }
1804         }
1805
1806         if ($fn->{RETURN_TYPE} && $fn->{RETURN_TYPE} ne "void") {
1807                 pidl "NDR_CHECK(ndr_pull_$fn->{RETURN_TYPE}(ndr, NDR_SCALARS, &r->out.result));";
1808         }
1809
1810         pidl "done:";
1811         pidl "";
1812         pidl "return NT_STATUS_OK;";
1813         deindent;
1814         pidl "}";
1815         pidl "";
1816 }
1817
1818 #####################################################################
1819 # produce a function call table
1820 sub FunctionTable($)
1821 {
1822         my($interface) = shift;
1823         my($data) = $interface->{INHERITED_DATA};
1824         my $count = 0;
1825         my $uname = uc $interface->{NAME};
1826
1827         foreach my $d (@{$data}) {
1828                 if ($d->{TYPE} eq "FUNCTION") { $count++; }
1829         }
1830
1831         return if ($count == 0);
1832
1833         pidl "static const struct dcerpc_interface_call $interface->{NAME}\_calls[] = {";
1834         foreach my $d (@{$data}) {
1835                 if ($d->{TYPE} eq "FUNCTION") {
1836                         pidl "\t{";
1837                         pidl "\t\t\"$d->{NAME}\",";
1838                         pidl "\t\tsizeof(struct $d->{NAME}),";
1839                         pidl "\t\t(ndr_push_flags_fn_t) ndr_push_$d->{NAME},";
1840                         pidl "\t\t(ndr_pull_flags_fn_t) ndr_pull_$d->{NAME},";
1841                         pidl "\t\t(ndr_print_function_t) ndr_print_$d->{NAME}";
1842                         pidl "\t},";
1843                 }
1844         }
1845         pidl "\t{ NULL, 0, NULL, NULL, NULL }";
1846         pidl "};";
1847         pidl "";
1848
1849         # If no endpoint is set, default to the interface name as a named pipe
1850         if (! defined $interface->{PROPERTIES}->{endpoint}) {
1851                 $interface->{PROPERTIES}->{endpoint} = "\"ncacn_np:[\\\\pipe\\\\" . $interface->{NAME} . "]\"";
1852         }
1853
1854         my @e = split / /, $interface->{PROPERTIES}->{endpoint};
1855         my $endpoint_count = $#e + 1;
1856
1857         pidl "static const char * const $interface->{NAME}\_endpoint_strings[] = {";
1858         foreach my $ep (@e) {
1859                 pidl "\t$ep, ";
1860         }
1861         pidl "};";
1862         pidl "";
1863
1864         pidl "static const struct dcerpc_endpoint_list $interface->{NAME}\_endpoints = {";
1865         pidl "\t$endpoint_count, $interface->{NAME}\_endpoint_strings";
1866         pidl "};";
1867         pidl "";
1868
1869         pidl "\nconst struct dcerpc_interface_table dcerpc_table_$interface->{NAME} = {";
1870         pidl "\t\"$interface->{NAME}\",";
1871         pidl "\tDCERPC_$uname\_UUID,";
1872         pidl "\tDCERPC_$uname\_VERSION,";
1873         pidl "\tDCERPC_$uname\_HELPSTRING,";
1874         pidl "\t$count,";
1875         pidl "\t$interface->{NAME}\_calls,";
1876         pidl "\t&$interface->{NAME}\_endpoints";
1877         pidl "};";
1878         pidl "";
1879
1880         pidl "static NTSTATUS dcerpc_ndr_$interface->{NAME}_init(void)";
1881         pidl "{";
1882         pidl "\treturn librpc_register_interface(&dcerpc_table_$interface->{NAME});";
1883         pidl "}";
1884         pidl "";
1885 }
1886
1887 #####################################################################
1888 # parse the interface definitions
1889 sub ParseInterface($)
1890 {
1891         my($interface) = shift;
1892         my($data) = $interface->{DATA};
1893
1894         # Push functions
1895         foreach my $d (@{$data}) {
1896                 ($d->{TYPE} eq "TYPEDEF") &&
1897                     ParseTypedefPush($d);
1898                 ($d->{TYPE} eq "FUNCTION") && 
1899                     ParseFunctionPush($d);
1900         }
1901
1902         # Pull functions
1903         foreach my $d (@{$data}) {
1904                 ($d->{TYPE} eq "TYPEDEF") &&
1905                     ParseTypedefPull($d);
1906                 ($d->{TYPE} eq "FUNCTION") && 
1907                     ParseFunctionPull($d);
1908         }
1909         
1910         # Print functions
1911         foreach my $d (@{$data}) {
1912                 if ($d->{TYPE} eq "TYPEDEF" &&
1913                     !util::has_property($d, "noprint")) {
1914                         ParseTypedefPrint($d);
1915                 }
1916                 if ($d->{TYPE} eq "FUNCTION" &&
1917                     !util::has_property($d, "noprint")) {
1918                         ParseFunctionPrint($d);
1919                 }
1920         }
1921
1922         # Size functions
1923         foreach my $d (@{$data}) {
1924                 ($d->{TYPE} eq "TYPEDEF") && 
1925                         ParseTypedefNdrSize($d);
1926         }
1927
1928         FunctionTable($interface);
1929 }
1930
1931 sub RegistrationFunction($$)
1932 {
1933         my $idl = shift;
1934         my $filename = shift;
1935
1936         $filename =~ /.*\/ndr_(.*).c/;
1937         my $basename = $1;
1938         pidl "NTSTATUS dcerpc_$basename\_init(void)";
1939         pidl "{";
1940         indent;
1941         pidl "NTSTATUS status = NT_STATUS_OK;";
1942         foreach my $interface (@{$idl}) {
1943                 next if $interface->{TYPE} ne "INTERFACE";
1944
1945                 my $data = $interface->{INHERITED_DATA};
1946                 my $count = 0;
1947                 foreach my $d (@{$data}) {
1948                         if ($d->{TYPE} eq "FUNCTION") { $count++; }
1949                 }
1950
1951                 next if ($count == 0);
1952
1953                 pidl "status = dcerpc_ndr_$interface->{NAME}_init();";
1954                 pidl "if (NT_STATUS_IS_ERR(status)) {";
1955                 pidl "\treturn status;";
1956                 pidl "}";
1957                 pidl "";
1958         }
1959         pidl "return status;";
1960         deindent;
1961         pidl "}";
1962         pidl "";
1963 }
1964
1965 sub CheckPointerTypes($$)
1966 {
1967         my $s = shift;
1968         my $default = shift;
1969
1970         foreach my $e (@{$s->{ELEMENTS}}) {
1971                 if ($e->{POINTERS}) {
1972                         if (not defined(pointer_type($e))) {
1973                                 $e->{PROPERTIES}->{$default} = 1;
1974                         }
1975
1976                         if (pointer_type($e) eq "ptr") {
1977                                 print "Warning: ptr is not supported by pidl yet\n";
1978                         }
1979                 }
1980         }
1981 }
1982
1983 sub LoadInterface($)
1984 {
1985         my $x = shift;
1986
1987         if (not util::has_property($x, "pointer_default")) {
1988                 # MIDL defaults to "ptr" in DCE compatible mode (/osf)
1989                 # and "unique" in Microsoft Extensions mode (default)
1990                 $x->{PROPERTIES}->{pointer_default} = "unique";
1991         }
1992
1993         foreach my $d (@{$x->{DATA}}) {
1994                 if (($d->{TYPE} eq "DECLARE") or ($d->{TYPE} eq "TYPEDEF")) {
1995                     $typedefs{$d->{NAME}} = $d;
1996                         if ($d->{DATA}->{TYPE} eq "STRUCT" or $d->{DATA}->{TYPE} eq "UNION") {
1997                                 CheckPointerTypes($d->{DATA}, $x->{PROPERTIES}->{pointer_default});
1998                         }
1999
2000                         if (defined($d->{PROPERTIES}) && !defined($d->{DATA}->{PROPERTIES})) {
2001                                 $d->{DATA}->{PROPERTIES} = $d->{PROPERTIES};
2002                         }
2003                 }
2004                 if ($d->{TYPE} eq "FUNCTION") {
2005                         CheckPointerTypes($d, 
2006                                 $x->{PROPERTIES}->{pointer_default}  # MIDL defaults to "ref"
2007                         );
2008                 }
2009         }
2010 }
2011
2012 # Add ORPC specific bits to an interface.
2013 sub InterfaceORPC($)
2014 {
2015         my $x = shift;  
2016         # Add [in] ORPCTHIS *this, [out] ORPCTHAT *that
2017         # for 'object' interfaces
2018         if (util::has_property($x, "object")) {
2019                 foreach my $e (@{$x->{DATA}}) {
2020                         if($e->{TYPE} eq "FUNCTION") {
2021                                 $e->{PROPERTIES}->{object} = 1;
2022                                 unshift(@{$e->{ELEMENTS}}, 
2023                        { 'NAME' => 'ORPCthis',
2024                          'POINTERS' => 0,
2025                          'PROPERTIES' => { 'in' => '1' },
2026                          'TYPE' => 'ORPCTHIS'
2027                        });
2028                                 unshift(@{$e->{ELEMENTS}},
2029                        { 'NAME' => 'ORPCthat',
2030                          'POINTERS' => 0,
2031                          'PROPERTIES' => { 'out' => '1' },
2032                                           'TYPE' => 'ORPCTHAT'
2033                        });
2034                         }
2035                 }
2036         }
2037 }
2038
2039 sub Load($)
2040 {
2041         my $idl = shift;
2042
2043         foreach my $x (@{$idl}) {
2044                 LoadInterface($x);
2045         }
2046 }
2047
2048 #####################################################################
2049 # parse a parsed IDL structure back into an IDL file
2050 sub Parse($$)
2051 {
2052         my($idl) = shift;
2053         my($filename) = shift;
2054         my $h_filename = $filename;
2055         $res = "";
2056
2057         Load($idl);
2058
2059         if ($h_filename =~ /(.*)\.c/) {
2060                 $h_filename = "$1.h";
2061         }
2062
2063         pidl "/* parser auto-generated by pidl */";
2064         pidl "";
2065         pidl "#include \"includes.h\"";
2066         pidl "#include \"$h_filename\"";
2067         pidl "";
2068
2069         foreach my $x (@{$idl}) {
2070                 if ($x->{TYPE} eq "INTERFACE") { 
2071                         needed::BuildNeeded($x);
2072                         ParseInterface($x);
2073                 }
2074         }
2075
2076         RegistrationFunction($idl, $filename);
2077
2078         return $res;
2079 }
2080
2081 RegisterPrimitives();
2082
2083 1;