3c7e1f51d06adf9009632da138c7fd4ebcddf5b7
[samba.git] / source / build / pidl / validator.pm
1 ###################################################
2 # check that a parsed IDL file is valid
3 # Copyright tridge@samba.org 2003
4 # released under the GNU GPL
5
6 package IdlValidator;
7 use Data::Dumper;
8
9 use strict;
10
11 #####################################################################
12 # signal a fatal validation error
13 sub fatal($$)
14 {
15         my $pos = shift;
16         my $s = shift;
17         die("$pos->{FILE}:$pos->{LINE}:$s\n");
18 }
19
20 sub nonfatal($$)
21 {
22         my $pos = shift;
23         my $s = shift;
24         warn ("$pos->{FILE}:$pos->{LINE}:warning:$s\n");
25 }
26
27 sub el_name($)
28 {
29         my $e = shift;
30
31         if ($e->{PARENT} && $e->{PARENT}->{NAME}) {
32                 return "$e->{PARENT}->{NAME}.$e->{NAME}";
33         }
34
35         if ($e->{PARENT} && $e->{PARENT}->{PARENT}->{NAME}) {
36                 return "$e->{PARENT}->{PARENT}->{NAME}.$e->{NAME}";
37         }
38
39         if ($e->{PARENT}) {
40                 return "$e->{PARENT}->{NAME}.$e->{NAME}";
41         }
42         return $e->{NAME};
43 }
44
45 my %property_list = (
46         # interface
47         "helpstring"            => {INTERFACE   => 1,
48                                     FUNCTION    => 1,
49                                     },
50         "version"               => {INTERFACE   => 1,
51                                     },
52         "uuid"                  => {INTERFACE   => 1,
53                                     },
54         "endpoint"              => {INTERFACE   => 1,
55                                     },
56         "pointer_default"       => {INTERFACE   => 1,
57                                     },
58         "pointer_default_top"   => {INTERFACE   => 1,
59                                     },
60         "depends"               => {INTERFACE   => 1,
61                                     },
62         "authservice"           => {INTERFACE   => 1,
63                                     },
64
65         # dcom
66         "object"                => {INTERFACE   => 1,
67                                     },
68         "local"                 => {INTERFACE   => 1,
69                                     FUNCTION    => 1,
70                                     },
71         "iid_is"                => {ELEMENT     => 1,
72                                     },
73         "call_as"               => {FUNCTION    => 1,
74                                     },
75         "idempotent"            => {FUNCTION    => 1,
76                                     },
77
78         # function
79         "noopnum"               => {FUNCTION    => 1,
80                                     },
81         "in"                    => {ELEMENT     => 1,
82                                     },
83         "out"                   => {ELEMENT     => 1,
84                                     },
85
86         # pointer
87         "ref"                   => {ELEMENT     => 1,
88                                     },
89         "ptr"                   => {ELEMENT     => 1,
90                                     },
91         "unique"                => {ELEMENT     => 1,
92                                     },
93         "relative"              => {ELEMENT     => 1,
94                                     },
95
96         # ndr_size
97         "gensize"               => {TYPEDEF     => 1,
98                                     },
99         "value"                 => {ELEMENT     => 1,
100                                     },
101         "flag"                  => {ELEMENT     => 1,
102                                     TYPEDEF     => 1,
103                                     },
104
105         # generic
106         "public"                => {FUNCTION    => 1,
107                                     TYPEDEF     => 1,
108                                     },
109         "nopush"                => {FUNCTION    => 1,
110                                     TYPEDEF     => 1,
111                                     },
112         "nopull"                => {FUNCTION    => 1,
113                                     TYPEDEF     => 1,
114                                     },
115         "noprint"               => {FUNCTION    => 1,
116                                     TYPEDEF     => 1,
117                                     },
118
119         # union
120         "switch_is"             => {ELEMENT     => 1,
121                                     },
122         "switch_type"           => {ELEMENT     => 1,
123                                     TYPEDEF     => 1,
124                                     },
125         "nodiscriminant"        => {TYPEDEF     => 1,
126                                     },
127         "case"                  => {ELEMENT     => 1,
128                                     },
129         "default"               => {ELEMENT     => 1,
130                                     },
131
132         # subcontext
133         "subcontext"            => {ELEMENT     => 1,
134                                     },
135         "subcontext_size"       => {ELEMENT     => 1,
136                                     },
137         "compression"           => {ELEMENT     => 1,
138                                     },
139         "obfuscation"           => {ELEMENT     => 1,
140                                     },
141
142         # enum
143         "enum8bit"              => {TYPEDEF     => 1,
144                                     },
145         "enum16bit"             => {TYPEDEF     => 1,
146                                     },
147         "v1_enum"               => {TYPEDEF     => 1,
148                                     },
149
150         # bitmap
151         "bitmap8bit"            => {TYPEDEF     => 1,
152                                     },
153         "bitmap16bit"           => {TYPEDEF     => 1,
154                                     },
155         "bitmap32bit"           => {TYPEDEF     => 1,
156                                     },
157         "bitmap64bit"           => {TYPEDEF     => 1,
158                                     },
159
160         # array
161         "range"                 => {ELEMENT     => 1,
162                                     },
163         "size_is"               => {ELEMENT     => 1,
164                                     },
165         "length_is"             => {ELEMENT     => 1,
166                                     },
167 );
168
169 #####################################################################
170 # check for unknown properties
171 sub ValidProperties($$)
172 {
173         my $e = shift;
174         my $t = shift;
175
176         return unless defined $e->{PROPERTIES};
177
178         foreach my $key (keys %{$e->{PROPERTIES}}) {
179                 fatal($e, el_name($e) . ": unknown property '$key'\n")
180                         if not defined($property_list{$key});
181
182                 next if defined($property_list{$key}{ANY});
183                 fatal($e, el_name($e) . ": property '$key' not allowed on '$t'\n")
184                         if not defined($property_list{$key}{$t});
185         }
186 }
187
188 #####################################################################
189 # parse a struct
190 sub ValidElement($)
191 {
192         my $e = shift;
193
194         ValidProperties($e,"ELEMENT");
195
196         if (util::has_property($e, "ptr")) {
197                 fatal($e, el_name($e) . " : pidl does not support full NDR pointers yet\n");
198         }
199
200         # Check whether switches are used correctly.
201         if (my $switch = util::has_property($e, "switch_is")) {
202                 my $e2 = util::find_sibling($e, $switch);
203                 my $type = typelist::getType($e->{TYPE});
204
205                 if (defined($type) and $type->{DATA}->{TYPE} ne "UNION") {
206                         fatal($e, el_name($e) . ": switch_is() used on non-union type $e->{TYPE} which is a $type->{DATA}->{TYPE}");
207                 }
208
209                 if (!util::has_property($type, "nodiscriminant") and defined($e2)) {
210                         my $discriminator_type = util::has_property($type, "switch_type");
211                         $discriminator_type = "uint32" unless defined ($discriminator_type);
212
213                         if ($e2->{TYPE} ne $discriminator_type) {
214                                 print el_name($e) . ": Warning: switch_is() is of type $e2->{TYPE}, while discriminator type for union $type->{NAME} is $discriminator_type\n";
215                         }
216                 }
217         }
218
219         if (defined (util::has_property($e, "subcontext_size")) and not defined(util::has_property($e, "subcontext"))) {
220                 fatal($e, el_name($e) . " : subcontext_size() on non-subcontext element");
221         }
222
223         if (defined (util::has_property($e, "compression")) and not defined(util::has_property($e, "subcontext"))) {
224                 fatal($e, el_name($e) . " : compression() on non-subcontext element");
225         }
226
227         if (defined (util::has_property($e, "obfuscation")) and not defined(util::has_property($e, "subcontext"))) {
228                 fatal($e, el_name($e) . " : obfuscation() on non-subcontext element");
229         }
230
231         if (!$e->{POINTERS} && (
232                 util::has_property($e, "ptr") or
233                 util::has_property($e, "unique") or
234                 util::has_property($e, "relative") or
235                 util::has_property($e, "ref"))) {
236                 fatal($e, el_name($e) . " : pointer properties on non-pointer element\n");      
237         }
238 }
239
240 #####################################################################
241 # parse a struct
242 sub ValidStruct($)
243 {
244         my($struct) = shift;
245
246         ValidProperties($struct,"STRUCT");
247
248         foreach my $e (@{$struct->{ELEMENTS}}) {
249                 $e->{PARENT} = $struct;
250                 ValidElement($e);
251         }
252 }
253
254 #####################################################################
255 # parse a union
256 sub ValidUnion($)
257 {
258         my($union) = shift;
259
260         ValidProperties($union,"UNION");
261
262         if (util::has_property($union->{PARENT}, "nodiscriminant") and util::has_property($union->{PARENT}, "switch_type")) {
263                 fatal($union->{PARENT}, $union->{PARENT}->{NAME} . ": switch_type() on union without discriminant");
264         }
265         
266         foreach my $e (@{$union->{ELEMENTS}}) {
267                 $e->{PARENT} = $union;
268
269                 if (defined($e->{PROPERTIES}->{default}) and 
270                         defined($e->{PROPERTIES}->{case})) {
271                         fatal $e, "Union member $e->{NAME} can not have both default and case properties!\n";
272                 }
273                 
274                 unless (defined ($e->{PROPERTIES}->{default}) or 
275                                 defined ($e->{PROPERTIES}->{case})) {
276                         fatal $e, "Union member $e->{NAME} must have default or case property\n";
277                 }
278
279                 if (util::has_property($e, "ref")) {
280                         fatal($e, el_name($e) . " : embedded ref pointers are not supported yet\n");
281                 }
282
283
284                 ValidElement($e);
285         }
286 }
287
288 #####################################################################
289 # parse a typedef
290 sub ValidTypedef($)
291 {
292         my($typedef) = shift;
293         my $data = $typedef->{DATA};
294
295         ValidProperties($typedef,"TYPEDEF");
296
297         $data->{PARENT} = $typedef;
298
299         if (ref($data) eq "HASH") {
300                 if ($data->{TYPE} eq "STRUCT") {
301                         ValidStruct($data);
302                 }
303
304                 if ($data->{TYPE} eq "UNION") {
305                         ValidUnion($data);
306                 }
307         }
308 }
309
310 #####################################################################
311 # parse a function
312 sub ValidFunction($)
313 {
314         my($fn) = shift;
315
316         ValidProperties($fn,"FUNCTION");
317
318         foreach my $e (@{$fn->{ELEMENTS}}) {
319                 $e->{PARENT} = $fn;
320                 if (util::has_property($e, "ref") && !$e->{POINTERS}) {
321                         fatal $e, "[ref] variables must be pointers ($fn->{NAME}/$e->{NAME})\n";
322                 }
323                 ValidElement($e);
324         }
325 }
326
327 #####################################################################
328 # parse the interface definitions
329 sub ValidInterface($)
330 {
331         my($interface) = shift;
332         my($data) = $interface->{DATA};
333
334         ValidProperties($interface,"INTERFACE");
335
336         if (util::has_property($interface, "pointer_default") && 
337                 $interface->{PROPERTIES}->{pointer_default} eq "ptr") {
338                 fatal $interface, "Full pointers are not supported yet\n";
339         }
340
341         if (util::has_property($interface, "object")) {
342                 if (util::has_property($interface, "version") && 
343                         $interface->{PROPERTIES}->{version} != 0) {
344                         fatal $interface, "Object interfaces must have version 0.0 ($interface->{NAME})\n";
345                 }
346
347                 if (!defined($interface->{BASE}) && 
348                         not ($interface->{NAME} eq "IUnknown")) {
349                         fatal $interface, "Object interfaces must all derive from IUnknown ($interface->{NAME})\n";
350                 }
351         }
352                 
353         foreach my $d (@{$data}) {
354                 ($d->{TYPE} eq "TYPEDEF") &&
355                     ValidTypedef($d);
356                 ($d->{TYPE} eq "FUNCTION") && 
357                     ValidFunction($d);
358         }
359
360 }
361
362 #####################################################################
363 # parse a parsed IDL into a C header
364 sub Validate($)
365 {
366         my($idl) = shift;
367
368         foreach my $x (@{$idl}) {
369                 ($x->{TYPE} eq "INTERFACE") && 
370                     ValidInterface($x);
371         }
372 }
373
374 1;