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