summaryrefslogtreecommitdiff
path: root/source4/build/pidl/Parse/Pidl/NDR.pm
diff options
context:
space:
mode:
Diffstat (limited to 'source4/build/pidl/Parse/Pidl/NDR.pm')
-rw-r--r--source4/build/pidl/Parse/Pidl/NDR.pm354
1 files changed, 354 insertions, 0 deletions
diff --git a/source4/build/pidl/Parse/Pidl/NDR.pm b/source4/build/pidl/Parse/Pidl/NDR.pm
index 64d61650f7..2c98e3254e 100644
--- a/source4/build/pidl/Parse/Pidl/NDR.pm
+++ b/source4/build/pidl/Parse/Pidl/NDR.pm
@@ -22,6 +22,14 @@ sub nonfatal($$)
}
#####################################################################
+# signal a fatal validation error
+sub fatal($$)
+{
+ my ($pos,$s) = @_;
+ die("$pos->{FILE}:$pos->{LINE}:$s\n");
+}
+
+#####################################################################
# return a table describing the order in which the parts of an element
# should be parsed
# Possible level types:
@@ -603,4 +611,350 @@ sub ContainsDeferred($$)
return 0;
}
+sub el_name($)
+{
+ my $e = shift;
+
+ if ($e->{PARENT} && $e->{PARENT}->{NAME}) {
+ return "$e->{PARENT}->{NAME}.$e->{NAME}";
+ }
+
+ if ($e->{PARENT} && $e->{PARENT}->{PARENT}->{NAME}) {
+ return "$e->{PARENT}->{PARENT}->{NAME}.$e->{NAME}";
+ }
+
+ if ($e->{PARENT}) {
+ return "$e->{PARENT}->{NAME}.$e->{NAME}";
+ }
+
+ return $e->{NAME};
+}
+
+###################################
+# find a sibling var in a structure
+sub find_sibling($$)
+{
+ my($e,$name) = @_;
+ my($fn) = $e->{PARENT};
+
+ if ($name =~ /\*(.*)/) {
+ $name = $1;
+ }
+
+ for my $e2 (@{$fn->{ELEMENTS}}) {
+ return $e2 if ($e2->{NAME} eq $name);
+ }
+
+ return undef;
+}
+
+my %property_list = (
+ # interface
+ "helpstring" => ["INTERFACE", "FUNCTION"],
+ "version" => ["INTERFACE"],
+ "uuid" => ["INTERFACE"],
+ "endpoint" => ["INTERFACE"],
+ "pointer_default" => ["INTERFACE"],
+ "pointer_default_top" => ["INTERFACE"],
+ "depends" => ["INTERFACE"],
+ "authservice" => ["INTERFACE"],
+
+ # dcom
+ "object" => ["INTERFACE"],
+ "local" => ["INTERFACE", "FUNCTION"],
+ "iid_is" => ["ELEMENT"],
+ "call_as" => ["FUNCTION"],
+ "idempotent" => ["FUNCTION"],
+
+ # function
+ "noopnum" => ["FUNCTION"],
+ "in" => ["ELEMENT"],
+ "out" => ["ELEMENT"],
+
+ # pointer
+ "ref" => ["ELEMENT"],
+ "ptr" => ["ELEMENT"],
+ "sptr" => ["ELEMENT"],
+ "unique" => ["ELEMENT"],
+ "ignore" => ["ELEMENT"],
+ "relative" => ["ELEMENT"],
+ "relative_base" => ["TYPEDEF"],
+
+ "gensize" => ["TYPEDEF"],
+ "value" => ["ELEMENT"],
+ "flag" => ["ELEMENT", "TYPEDEF"],
+
+ # generic
+ "public" => ["FUNCTION", "TYPEDEF"],
+ "nopush" => ["FUNCTION", "TYPEDEF"],
+ "nopull" => ["FUNCTION", "TYPEDEF"],
+ "noprint" => ["FUNCTION", "TYPEDEF"],
+ "noejs" => ["FUNCTION", "TYPEDEF"],
+
+ # union
+ "switch_is" => ["ELEMENT"],
+ "switch_type" => ["ELEMENT", "TYPEDEF"],
+ "nodiscriminant" => ["TYPEDEF"],
+ "case" => ["ELEMENT"],
+ "default" => ["ELEMENT"],
+
+ # subcontext
+ "subcontext" => ["ELEMENT"],
+ "subcontext_size" => ["ELEMENT"],
+ "compression" => ["ELEMENT"],
+ "obfuscation" => ["ELEMENT"],
+
+ # enum
+ "enum8bit" => ["TYPEDEF"],
+ "enum16bit" => ["TYPEDEF"],
+ "v1_enum" => ["TYPEDEF"],
+
+ # bitmap
+ "bitmap8bit" => ["TYPEDEF"],
+ "bitmap16bit" => ["TYPEDEF"],
+ "bitmap32bit" => ["TYPEDEF"],
+ "bitmap64bit" => ["TYPEDEF"],
+
+ # array
+ "range" => ["ELEMENT"],
+ "size_is" => ["ELEMENT"],
+ "string" => ["ELEMENT"],
+ "noheader" => ["ELEMENT"],
+ "charset" => ["ELEMENT"],
+ "length_is" => ["ELEMENT"],
+);
+
+#####################################################################
+# check for unknown properties
+sub ValidProperties($$)
+{
+ my ($e,$t) = @_;
+
+ return unless defined $e->{PROPERTIES};
+
+ foreach my $key (keys %{$e->{PROPERTIES}}) {
+ fatal($e, el_name($e) . ": unknown property '$key'\n")
+ unless defined($property_list{$key});
+
+ fatal($e, el_name($e) . ": property '$key' not allowed on '$t'\n")
+ unless grep($t, @{$property_list{$key}});
+ }
+}
+
+sub mapToScalar($)
+{
+ my $t = shift;
+ my $ti = getType($t);
+
+ if (not defined ($ti)) {
+ return undef;
+ } elsif ($ti->{DATA}->{TYPE} eq "ENUM") {
+ return Parse::Pidl::Typelist::enum_type_fn($ti->{DATA});
+ } elsif ($ti->{DATA}->{TYPE} eq "BITMAP") {
+ return Parse::Pidl::Typelist::enum_type_fn($ti->{DATA});
+ } elsif ($ti->{DATA}->{TYPE} eq "SCALAR") {
+ return $t;
+ }
+
+ return undef;
+}
+
+#####################################################################
+# parse a struct
+sub ValidElement($)
+{
+ my $e = shift;
+
+ ValidProperties($e,"ELEMENT");
+
+ if (has_property($e, "ptr")) {
+ fatal($e, el_name($e) . " : pidl does not support full NDR pointers yet\n");
+ }
+
+ # Check whether switches are used correctly.
+ if (my $switch = has_property($e, "switch_is")) {
+ my $e2 = find_sibling($e, $switch);
+ my $type = getType($e->{TYPE});
+
+ if (defined($type) and $type->{DATA}->{TYPE} ne "UNION") {
+ fatal($e, el_name($e) . ": switch_is() used on non-union type $e->{TYPE} which is a $type->{DATA}->{TYPE}");
+ }
+
+ if (!has_property($type, "nodiscriminant") and defined($e2)) {
+ my $discriminator_type = has_property($type, "switch_type");
+ $discriminator_type = "uint32" unless defined ($discriminator_type);
+
+ my $t1 = mapToScalar($discriminator_type);
+
+ if (not defined($t1)) {
+ fatal($e, el_name($e) . ": unable to map discriminator type '$discriminator_type' to scalar");
+ }
+
+ my $t2 = mapToScalar($e2->{TYPE});
+ if (not defined($t2)) {
+ fatal($e, el_name($e) . ": unable to map variable used for switch_is() to scalar");
+ }
+
+ if ($t1 ne $t2) {
+ nonfatal($e, el_name($e) . ": switch_is() is of type $e2->{TYPE} ($t2), while discriminator type for union $type->{NAME} is $discriminator_type ($t1)");
+ }
+ }
+ }
+
+ if (defined (has_property($e, "subcontext_size")) and not defined(has_property($e, "subcontext"))) {
+ fatal($e, el_name($e) . " : subcontext_size() on non-subcontext element");
+ }
+
+ if (defined (has_property($e, "compression")) and not defined(has_property($e, "subcontext"))) {
+ fatal($e, el_name($e) . " : compression() on non-subcontext element");
+ }
+
+ if (defined (has_property($e, "obfuscation")) and not defined(has_property($e, "subcontext"))) {
+ fatal($e, el_name($e) . " : obfuscation() on non-subcontext element");
+ }
+
+ if (!$e->{POINTERS} && (
+ has_property($e, "ptr") or
+ has_property($e, "sptr") or
+ has_property($e, "unique") or
+ has_property($e, "relative") or
+ has_property($e, "ref"))) {
+ fatal($e, el_name($e) . " : pointer properties on non-pointer element\n");
+ }
+}
+
+#####################################################################
+# parse a struct
+sub ValidStruct($)
+{
+ my($struct) = shift;
+
+ ValidProperties($struct,"STRUCT");
+
+ foreach my $e (@{$struct->{ELEMENTS}}) {
+ $e->{PARENT} = $struct;
+ ValidElement($e);
+ }
+}
+
+#####################################################################
+# parse a union
+sub ValidUnion($)
+{
+ my($union) = shift;
+
+ ValidProperties($union,"UNION");
+
+ if (has_property($union->{PARENT}, "nodiscriminant") and has_property($union->{PARENT}, "switch_type")) {
+ fatal($union->{PARENT}, $union->{PARENT}->{NAME} . ": switch_type() on union without discriminant");
+ }
+
+ foreach my $e (@{$union->{ELEMENTS}}) {
+ $e->{PARENT} = $union;
+
+ if (defined($e->{PROPERTIES}->{default}) and
+ defined($e->{PROPERTIES}->{case})) {
+ fatal $e, "Union member $e->{NAME} can not have both default and case properties!\n";
+ }
+
+ unless (defined ($e->{PROPERTIES}->{default}) or
+ defined ($e->{PROPERTIES}->{case})) {
+ fatal $e, "Union member $e->{NAME} must have default or case property\n";
+ }
+
+ if (has_property($e, "ref")) {
+ fatal($e, el_name($e) . " : embedded ref pointers are not supported yet\n");
+ }
+
+
+ ValidElement($e);
+ }
+}
+
+#####################################################################
+# parse a typedef
+sub ValidTypedef($)
+{
+ my($typedef) = shift;
+ my $data = $typedef->{DATA};
+
+ ValidProperties($typedef,"TYPEDEF");
+
+ $data->{PARENT} = $typedef;
+
+ if (ref($data) eq "HASH") {
+ if ($data->{TYPE} eq "STRUCT") {
+ ValidStruct($data);
+ }
+
+ if ($data->{TYPE} eq "UNION") {
+ ValidUnion($data);
+ }
+ }
+}
+
+#####################################################################
+# parse a function
+sub ValidFunction($)
+{
+ my($fn) = shift;
+
+ ValidProperties($fn,"FUNCTION");
+
+ foreach my $e (@{$fn->{ELEMENTS}}) {
+ $e->{PARENT} = $fn;
+ if (has_property($e, "ref") && !$e->{POINTERS}) {
+ fatal $e, "[ref] variables must be pointers ($fn->{NAME}/$e->{NAME})\n";
+ }
+ ValidElement($e);
+ }
+}
+
+#####################################################################
+# parse the interface definitions
+sub ValidInterface($)
+{
+ my($interface) = shift;
+ my($data) = $interface->{DATA};
+
+ ValidProperties($interface,"INTERFACE");
+
+ if (has_property($interface, "pointer_default") &&
+ $interface->{PROPERTIES}->{pointer_default} eq "ptr") {
+ fatal $interface, "Full pointers are not supported yet\n";
+ }
+
+ if (has_property($interface, "object")) {
+ if (has_property($interface, "version") &&
+ $interface->{PROPERTIES}->{version} != 0) {
+ fatal $interface, "Object interfaces must have version 0.0 ($interface->{NAME})\n";
+ }
+
+ if (!defined($interface->{BASE}) &&
+ not ($interface->{NAME} eq "IUnknown")) {
+ fatal $interface, "Object interfaces must all derive from IUnknown ($interface->{NAME})\n";
+ }
+ }
+
+ foreach my $d (@{$data}) {
+ ($d->{TYPE} eq "TYPEDEF") &&
+ ValidTypedef($d);
+ ($d->{TYPE} eq "FUNCTION") &&
+ ValidFunction($d);
+ }
+
+}
+
+#####################################################################
+# Validate an IDL structure
+sub Validate($)
+{
+ my($idl) = shift;
+
+ foreach my $x (@{$idl}) {
+ ($x->{TYPE} eq "INTERFACE") &&
+ ValidInterface($x);
+ }
+}
+
1;
generated by cgit (git 2.34.1) at 2024-11-11 07:44:40 +0000