r4535: add full support for
[samba.git] / source4 / build / pidl / header.pm
1 ###################################################
2 # create C header files for an IDL structure
3 # Copyright tridge@samba.org 2000
4 # released under the GNU GPL
5
6 package IdlHeader;
7
8 use strict;
9 use needed;
10
11 my($res);
12 my($tab_depth);
13
14 sub tabs()
15 {
16         for (my($i)=0; $i < $tab_depth; $i++) {
17                 $res .= "\t";
18         }
19 }
20
21 #####################################################################
22 # parse a properties list
23 sub HeaderProperties($)
24 {
25     my($props) = shift;
26
27     return;
28
29     foreach my $d (@{$props}) {
30         if (ref($d) ne "HASH") {
31             $res .= "/* [$d] */ ";
32         } else {
33             foreach my $k (keys %{$d}) {
34                 $res .= "/* [$k($d->{$k})] */ ";
35             }
36         }
37     }
38 }
39
40 #####################################################################
41 # parse a structure element
42 sub HeaderElement($)
43 {
44     my($element) = shift;
45
46     (defined $element->{PROPERTIES}) && HeaderProperties($element->{PROPERTIES});
47     $res .= tabs();
48     HeaderType($element, $element->{TYPE}, "");
49     $res .= " ";
50     if ($element->{POINTERS} && 
51         $element->{TYPE} ne "string") {
52             my($n) = $element->{POINTERS};
53             for (my($i)=$n; $i > 0; $i--) {
54                     $res .= "*";
55             }
56     }
57     if (defined $element->{ARRAY_LEN} && 
58         !util::is_constant($element->{ARRAY_LEN}) &&
59         !$element->{POINTERS}) {
60             # conformant arrays are ugly! I choose to implement them with
61             # pointers instead of the [1] method
62             $res .= "*";
63     }
64     $res .= "$element->{NAME}";
65     if (defined $element->{ARRAY_LEN} && util::is_constant($element->{ARRAY_LEN})) {
66             $res .= "[$element->{ARRAY_LEN}]";
67     }
68     $res .= ";\n";
69 }
70
71 #####################################################################
72 # parse a struct
73 sub HeaderStruct($$)
74 {
75     my($struct) = shift;
76     my($name) = shift;
77     $res .= "\nstruct $name {\n";
78     $tab_depth++;
79     my $el_count=0;
80     if (defined $struct->{ELEMENTS}) {
81         foreach my $e (@{$struct->{ELEMENTS}}) {
82             HeaderElement($e);
83             $el_count++;
84         }
85     }
86     if ($el_count == 0) {
87             # some compilers can't handle empty structures
88             $res .= "\tchar _empty_;\n";
89     }
90     $tab_depth--;
91     $res .= "}";
92 }
93
94 #####################################################################
95 # parse a enum
96 sub HeaderEnum($$)
97 {
98     my($enum) = shift;
99     my($name) = shift;
100
101     util::register_enum($name);
102
103     $res .= "\nenum $name {\n";
104     $tab_depth++;
105     my $els = \@{$enum->{ELEMENTS}};
106     foreach my $i (0 .. $#{$els}-1) {
107             my $e = ${$els}[$i];
108             tabs();
109             chomp $e;
110             $res .= "$e,\n";
111     }
112
113     my $e = ${$els}[$#{$els}];
114     tabs();
115     chomp $e;
116     if ($e !~ /^(.*?)\s*$/) {
117             die "Bad enum $name\n";
118     }
119     $res .= "$1\n";
120     $tab_depth--;
121     $res .= "}";
122 }
123
124 #####################################################################
125 # parse a bitmap
126 sub HeaderBitmap($$)
127 {
128     my($bitmap) = shift;
129     my($name) = shift;
130
131     util::register_bitmap($bitmap, $name);
132
133     $res .= "\n/* bitmap $name */\n";
134
135     my $els = \@{$bitmap->{ELEMENTS}};
136     foreach my $i (0 .. $#{$els}) {
137             my $e = ${$els}[$i];
138             chomp $e;
139             $res .= "#define $e\n";
140     }
141
142     $res .= "\n";
143 }
144
145 #####################################################################
146 # parse a union
147 sub HeaderUnion($$)
148 {
149         my($union) = shift;
150         my($name) = shift;
151         my %done = ();
152
153         (defined $union->{PROPERTIES}) && HeaderProperties($union->{PROPERTIES});
154         $res .= "\nunion $name {\n";
155         $tab_depth++;
156         foreach my $e (@{$union->{DATA}}) {
157                 if ($e->{TYPE} eq "UNION_ELEMENT") {
158                         if (! defined $done{$e->{DATA}->{NAME}}) {
159                                 HeaderElement($e->{DATA});
160                         }
161                         $done{$e->{DATA}->{NAME}} = 1;
162                 }
163         }
164         $tab_depth--;
165         $res .= "}";
166 }
167
168 #####################################################################
169 # parse a type
170 sub HeaderType($$$)
171 {
172         my $e = shift;
173         my($data) = shift;
174         my($name) = shift;
175         if (ref($data) eq "HASH") {
176                 ($data->{TYPE} eq "ENUM") &&
177                     HeaderEnum($data, $name);
178                 ($data->{TYPE} eq "BITMAP") &&
179                     HeaderBitmap($data, $name);
180                 ($data->{TYPE} eq "STRUCT") &&
181                     HeaderStruct($data, $name);
182                 ($data->{TYPE} eq "UNION") &&
183                     HeaderUnion($data, $name);
184                 return;
185         }
186         if ($data =~ "string") {
187                 $res .= "const char *";
188         } elsif (util::is_enum($e->{TYPE})) {
189                 $res .= "enum $data";
190         } elsif (util::is_bitmap($e->{TYPE})) {
191                 my $bitmap = util::get_bitmap($e->{TYPE});
192                 $res .= util::bitmap_type_decl($bitmap);
193         } elsif (util::is_scalar_type($data)) {
194                 $res .= "$data";
195         } elsif (util::has_property($e, "switch_is")) {
196                 $res .= "union $data";
197         } else {
198                 $res .= "struct $data";
199         }
200 }
201
202 #####################################################################
203 # parse a typedef
204 sub HeaderTypedef($)
205 {
206     my($typedef) = shift;
207     HeaderType($typedef, $typedef->{DATA}, $typedef->{NAME});
208     $res .= ";\n" unless ($typedef->{DATA}->{TYPE} eq "BITMAP");
209 }
210
211 #####################################################################
212 # prototype a typedef
213 sub HeaderTypedefProto($)
214 {
215     my($d) = shift;
216
217     if (needed::is_needed("ndr_size_$d->{NAME}")) {
218             $res .= "size_t ndr_size_$d->{NAME}(const struct $d->{NAME} *r, int flags);\n";
219     }
220
221     if (!util::has_property($d, "public")) {
222             return;
223     }
224
225     if ($d->{DATA}{TYPE} eq "STRUCT") {
226             $res .= "NTSTATUS ndr_push_$d->{NAME}(struct ndr_push *ndr, int ndr_flags, struct $d->{NAME} *r);\n";
227             $res .= "NTSTATUS ndr_pull_$d->{NAME}(struct ndr_pull *ndr, int ndr_flags, struct $d->{NAME} *r);\n";
228             if (!util::has_property($d, "noprint")) {
229                     $res .= "void ndr_print_$d->{NAME}(struct ndr_print *ndr, const char *name, struct $d->{NAME} *r);\n";
230             }
231
232     }
233     if ($d->{DATA}{TYPE} eq "UNION") {
234             $res .= "NTSTATUS ndr_push_$d->{NAME}(struct ndr_push *ndr, int ndr_flags, int level, union $d->{NAME} *r);\n";
235             $res .= "NTSTATUS ndr_pull_$d->{NAME}(struct ndr_pull *ndr, int ndr_flags, int level, union $d->{NAME} *r);\n";
236             if (!util::has_property($d, "noprint")) {
237                     $res .= "void ndr_print_$d->{NAME}(struct ndr_print *ndr, const char *name, int level, union $d->{NAME} *r);\n";
238             }
239     }
240 }
241
242 #####################################################################
243 # parse a const
244 sub HeaderConst($)
245 {
246     my($const) = shift;
247     if (!defined($const->{ARRAY_LEN})) {
248         $res .= "#define $const->{NAME}\t( $const->{VALUE} )\n";
249     } else {
250         $res .= "#define $const->{NAME}\t $const->{VALUE}\n";
251     }
252 }
253
254 #####################################################################
255 # parse a function
256 sub HeaderFunctionInOut($$)
257 {
258     my($fn) = shift;
259     my($prop) = shift;
260
261     foreach my $e (@{$fn->{DATA}}) {
262             if (util::has_property($e, $prop)) {
263                     HeaderElement($e);
264             }
265     }
266 }
267
268 #####################################################################
269 # determine if we need an "in" or "out" section
270 sub HeaderFunctionInOut_needed($$)
271 {
272     my($fn) = shift;
273     my($prop) = shift;
274
275     if ($prop eq "out" && $fn->{RETURN_TYPE} && $fn->{RETURN_TYPE} ne "void") {
276             return 1;
277     }
278
279     foreach my $e (@{$fn->{DATA}}) {
280             if (util::has_property($e, $prop)) {
281                     return 1;
282             }
283     }
284
285     return undef;
286 }
287
288
289 #####################################################################
290 # parse a function
291 sub HeaderFunction($)
292 {
293     my($fn) = shift;
294
295     $res .= "\nstruct $fn->{NAME} {\n";
296     $tab_depth++;
297     my $needed = 0;
298
299     if (HeaderFunctionInOut_needed($fn, "in")) {
300             tabs();
301             $res .= "struct {\n";
302             $tab_depth++;
303             HeaderFunctionInOut($fn, "in");
304             $tab_depth--;
305             tabs();
306             $res .= "} in;\n\n";
307             $needed++;
308     }
309
310     if (HeaderFunctionInOut_needed($fn, "out")) {
311             tabs();
312             $res .= "struct {\n";
313             $tab_depth++;
314             HeaderFunctionInOut($fn, "out");
315             if ($fn->{RETURN_TYPE} && $fn->{RETURN_TYPE} ne "void") {
316                     tabs();
317                     $res .= "$fn->{RETURN_TYPE} result;\n";
318             }
319             $tab_depth--;
320             tabs();
321             $res .= "} out;\n\n";
322             $needed++;
323     }
324
325     if (! $needed) {
326             # sigh - some compilers don't like empty structures
327             tabs();
328             $res .= "int _dummy_element;\n";
329     }
330
331     $tab_depth--;
332     $res .= "};\n\n";
333 }
334
335 #####################################################################
336 # output prototypes for a IDL function
337 sub HeaderFnProto($$)
338 {
339         my $interface = shift;
340     my $fn = shift;
341     my $name = $fn->{NAME};
342         
343     $res .= "void ndr_print_$name(struct ndr_print *ndr, const char *name, int flags, struct $name *r);\n";
344
345         if (util::has_property($interface, "object")) {
346                 $res .= "NTSTATUS dcom_$interface->{NAME}_$name (struct dcom_interface_p *d, TALLOC_CTX *mem_ctx, struct $name *r);\n";
347         } else {
348             $res .= "NTSTATUS dcerpc_$name(struct dcerpc_pipe *p, TALLOC_CTX *mem_ctx, struct $name *r);\n";
349         $res .= "struct rpc_request *dcerpc_$name\_send(struct dcerpc_pipe *p, TALLOC_CTX *mem_ctx, struct $name *r);\n";
350         }
351     $res .= "\n";
352 }
353
354
355 #####################################################################
356 # generate vtable structure for DCOM interface
357 sub HeaderVTable($)
358 {
359         my $interface = shift;
360         $res .= "struct dcom_$interface->{NAME}_vtable {\n";
361         if (defined($interface->{BASE})) {
362                 $res .= "\tstruct dcom_$interface->{BASE}\_vtable base;\n";
363         }
364
365         my $data = $interface->{DATA};
366         foreach my $d (@{$data}) {
367                 $res .= "\tNTSTATUS (*$d->{NAME}) (struct dcom_interface_p *d, TALLOC_CTX *mem_ctx, struct $d->{NAME} *r);\n" if ($d->{TYPE} eq "FUNCTION");
368         }
369         $res .= "};\n\n";
370 }
371
372
373 #####################################################################
374 # parse the interface definitions
375 sub HeaderInterface($)
376 {
377     my($interface) = shift;
378     my($data) = $interface->{DATA};
379
380     my $count = 0;
381
382     $res .= "#ifndef _HEADER_NDR_$interface->{NAME}\n";
383     $res .= "#define _HEADER_NDR_$interface->{NAME}\n\n";
384
385     if (defined $interface->{PROPERTIES}->{depends}) {
386             my @d = split / /, $interface->{PROPERTIES}->{depends};
387             foreach my $i (@d) {
388                     $res .= "#include \"librpc/gen_ndr/ndr_$i\.h\"\n";
389             }
390     }
391
392     if (defined $interface->{PROPERTIES}->{uuid}) {
393             my $name = uc $interface->{NAME};
394             $res .= "#define DCERPC_$name\_UUID " . 
395                 util::make_str($interface->{PROPERTIES}->{uuid}) . "\n";
396
397                 if(!defined $interface->{PROPERTIES}->{version}) { $interface->{PROPERTIES}->{version} = "0.0"; }
398             $res .= "#define DCERPC_$name\_VERSION $interface->{PROPERTIES}->{version}\n";
399
400             $res .= "#define DCERPC_$name\_NAME \"$interface->{NAME}\"\n";
401
402                 if(!defined $interface->{PROPERTIES}->{helpstring}) { $interface->{PROPERTIES}->{helpstring} = "NULL"; }
403                 $res .= "#define DCERPC_$name\_HELPSTRING $interface->{PROPERTIES}->{helpstring}\n";
404
405             $res .= "\nextern const struct dcerpc_interface_table dcerpc_table_$interface->{NAME};\n";
406             $res .= "NTSTATUS dcerpc_server_$interface->{NAME}_init(void);\n\n";
407     }
408
409     foreach my $d (@{$data}) {
410             if ($d->{TYPE} eq "FUNCTION") {
411                     my $u_name = uc $d->{NAME};
412                         $res .= "#define DCERPC_$u_name (";
413                 
414                         if (defined($interface->{BASE})) {
415                                 $res .= "DCERPC_" . uc $interface->{BASE} . "_CALL_COUNT + ";
416                         }
417                         
418                     $res .= sprintf("0x%02x", $count) . ")\n";
419                     $count++;
420             }
421     }
422
423         $res .= "\n#define DCERPC_" . uc $interface->{NAME} . "_CALL_COUNT (";
424         
425         if (defined($interface->{BASE})) {
426                 $res .= "DCERPC_" . uc $interface->{BASE} . "_CALL_COUNT + ";
427         }
428         
429         $res .= "$count)\n\n";
430
431     foreach my $d (@{$data}) {
432         ($d->{TYPE} eq "CONST") &&
433             HeaderConst($d);
434         ($d->{TYPE} eq "TYPEDEF") &&
435             HeaderTypedef($d);
436         ($d->{TYPE} eq "TYPEDEF") &&
437             HeaderTypedefProto($d);
438         ($d->{TYPE} eq "FUNCTION") &&
439             HeaderFunction($d);
440         ($d->{TYPE} eq "FUNCTION") &&
441                         HeaderFnProto($interface, $d);
442     }
443         
444         (util::has_property($interface, "object")) &&
445                 HeaderVTable($interface);
446
447     $res .= "#endif /* _HEADER_NDR_$interface->{NAME} */\n";
448 }
449
450 #####################################################################
451 # parse a parsed IDL into a C header
452 sub Parse($)
453 {
454     my($idl) = shift;
455     $tab_depth = 0;
456
457     $res = "/* header auto-generated by pidl */\n\n";
458     foreach my $x (@{$idl}) {
459             if ($x->{TYPE} eq "INTERFACE") {
460                     needed::BuildNeeded($x);
461                     HeaderInterface($x);
462             }
463     }
464     return $res;
465 }
466
467 1;