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