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