mirror of
https://github.com/samba-team/samba.git
synced 2025-01-12 09:18:10 +03:00
r8809: Merge validator with NDR.pm (validator is NDR-specific)
(This used to be commit 5c0a22167d)
This commit is contained in:
Jelmer Vernooij
Gerald (Jerry) Carter
parent
f95a494e97
commit
5090b9536c
@ -21,6 +21,14 @@ sub nonfatal($$)
|
|||||||
warn ("$e->{FILE}:$e->{LINE}: Warning: $s\n");
|
warn ("$e->{FILE}:$e->{LINE}: Warning: $s\n");
|
||||||
}
|
}
|
||||||
|
|
||||||
|
#####################################################################
|
||||||
|
# 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
|
# return a table describing the order in which the parts of an element
|
||||||
# should be parsed
|
# should be parsed
|
||||||
@ -603,4 +611,350 @@ sub ContainsDeferred($$)
|
|||||||
return 0;
|
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;
|
1;
|
||||||
|
|||||||
@ -1,372 +0,0 @@
|
|||||||
###################################################
|
|
||||||
# check that a parsed IDL file is valid
|
|
||||||
# Copyright tridge@samba.org 2003
|
|
||||||
# released under the GNU GPL
|
|
||||||
|
|
||||||
package Parse::Pidl::Validator;
|
|
||||||
|
|
||||||
use Parse::Pidl::Util qw(has_property);
|
|
||||||
use Parse::Pidl::Typelist qw(hasType getType);
|
|
||||||
|
|
||||||
use strict;
|
|
||||||
|
|
||||||
#####################################################################
|
|
||||||
# signal a fatal validation error
|
|
||||||
sub fatal($$)
|
|
||||||
{
|
|
||||||
my ($pos,$s) = @_;
|
|
||||||
die("$pos->{FILE}:$pos->{LINE}:$s\n");
|
|
||||||
}
|
|
||||||
|
|
||||||
sub nonfatal($$)
|
|
||||||
{
|
|
||||||
my ($pos,$s) = @_;
|
|
||||||
warn ("$pos->{FILE}:$pos->{LINE}:warning:$s\n");
|
|
||||||
}
|
|
||||||
|
|
||||||
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);
|
|
||||||
}
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
#####################################################################
|
|
||||||
# parse a parsed IDL into a C header
|
|
||||||
sub Validate($)
|
|
||||||
{
|
|
||||||
my($idl) = shift;
|
|
||||||
|
|
||||||
foreach my $x (@{$idl}) {
|
|
||||||
($x->{TYPE} eq "INTERFACE") &&
|
|
||||||
ValidInterface($x);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
1;
|
|
||||||
@ -146,8 +146,6 @@ sub process_file($)
|
|||||||
defined @$pidl || die "Failed to parse $idl_file";
|
defined @$pidl || die "Failed to parse $idl_file";
|
||||||
require Parse::Pidl::Typelist;
|
require Parse::Pidl::Typelist;
|
||||||
Parse::Pidl::Typelist::LoadIdl($pidl);
|
Parse::Pidl::Typelist::LoadIdl($pidl);
|
||||||
require Parse::Pidl::Validator;
|
|
||||||
Parse::Pidl::Validator::Validate($pidl);
|
|
||||||
if (defined($opt_keep) && !SaveStructure($pidl_file, $pidl)) {
|
if (defined($opt_keep) && !SaveStructure($pidl_file, $pidl)) {
|
||||||
die "Failed to save $pidl_file\n";
|
die "Failed to save $pidl_file\n";
|
||||||
}
|
}
|
||||||
@ -213,6 +211,7 @@ sub process_file($)
|
|||||||
defined($opt_server) or defined($opt_ndr_parser) or
|
defined($opt_server) or defined($opt_ndr_parser) or
|
||||||
defined($opt_ejs)) {
|
defined($opt_ejs)) {
|
||||||
require Parse::Pidl::NDR;
|
require Parse::Pidl::NDR;
|
||||||
|
Parse::Pidl::NDR::Validate($pidl);
|
||||||
$ndr = Parse::Pidl::NDR::Parse($pidl);
|
$ndr = Parse::Pidl::NDR::Parse($pidl);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user