ndr.pm

wireshark 0.99.7 最新源码

	}

	if ($d->{RETURN_TYPE} ne "void") {
		$rettype = expandAlias($d->{RETURN_TYPE});
	}
	
	my $async = 0;
	if (has_property($d, "async")) { $async = 1; }
	
	return {
			NAME => $d->{NAME},
			TYPE => "FUNCTION",
			OPNUM => $thisopnum,
			ASYNC => $async,
			RETURN_TYPE => $rettype,
			PROPERTIES => $d->{PROPERTIES},
			ELEMENTS => \@elements,
			ORIGINAL => $d
		};
}

sub CheckPointerTypes($$)
{
	my ($s,$default) = @_;

	return unless defined($s->{ELEMENTS});

	foreach my $e (@{$s->{ELEMENTS}}) {
		if ($e->{POINTERS} and not defined(pointer_type($e))) {
			$e->{PROPERTIES}->{$default} = 1;
		}
	}
}

sub FindNestedTypes($$)
{
	sub FindNestedTypes($$);
	my ($l, $t) = @_;

	return if not defined($t->{ELEMENTS});
	return if ($t->{TYPE} eq "ENUM");
	return if ($t->{TYPE} eq "BITMAP");

	foreach (@{$t->{ELEMENTS}}) {
		if (ref($_->{TYPE}) eq "HASH") {
			push (@$l, $_->{TYPE}) if (defined($_->{TYPE}->{NAME}));
			FindNestedTypes($l, $_->{TYPE});
		}
	}
}

sub ParseInterface($)
{
	my $idl = shift;
	my @types = ();
	my @consts = ();
	my @functions = ();
	my @endpoints;
	my @declares = ();
	my $opnum = 0;
	my $version;

	if (not has_property($idl, "pointer_default")) {
		# MIDL defaults to "ptr" in DCE compatible mode (/osf)
		# and "unique" in Microsoft Extensions mode (default)
		$idl->{PROPERTIES}->{pointer_default} = "unique";
	}

	if (not has_property($idl, "pointer_default_top")) {
		$idl->{PROPERTIES}->{pointer_default_top} = "ref";
	} else {
		warning($idl, "pointer_default_top() is a pidl extension and should not be used");
	}

	foreach my $d (@{$idl->{DATA}}) {
		if ($d->{TYPE} eq "DECLARE") {
			push (@declares, $d);
		} elsif ($d->{TYPE} eq "FUNCTION") {
			push (@functions, ParseFunction($idl, $d, \$opnum));
		} elsif ($d->{TYPE} eq "CONST") {
			push (@consts, ParseConst($idl, $d));
		} else {
			push (@types, ParseType($d, $idl->{PROPERTIES}->{pointer_default}));
			FindNestedTypes(\@types, $d);
		}
	}

	$version = "0.0";

	if(defined $idl->{PROPERTIES}->{version}) { 
		$version = $idl->{PROPERTIES}->{version}; 
	}

	# If no endpoint is set, default to the interface name as a named pipe
	if (!defined $idl->{PROPERTIES}->{endpoint}) {
		push @endpoints, "\"ncacn_np:[\\\\pipe\\\\" . $idl->{NAME} . "]\"";
	} else {
		@endpoints = split / /, $idl->{PROPERTIES}->{endpoint};
	}

	return { 
		NAME => $idl->{NAME},
		UUID => lc(has_property($idl, "uuid")),
		VERSION => $version,
		TYPE => "INTERFACE",
		PROPERTIES => $idl->{PROPERTIES},
		FUNCTIONS => \@functions,
		CONSTS => \@consts,
		TYPES => \@types,
		DECLARES => \@declares,
		ENDPOINTS => \@endpoints
	};
}

# Convert a IDL tree to a NDR tree
# Gives a result tree describing all that's necessary for easily generating
# NDR parsers / generators
sub Parse($)
{
	my $idl = shift;

	return undef unless (defined($idl));

	Parse::Pidl::NDR::Validate($idl);
	
	my @ndr = ();

	foreach (@{$idl}) {
		($_->{TYPE} eq "CPP_QUOTE") && push(@ndr, $_);
		($_->{TYPE} eq "INTERFACE") && push(@ndr, ParseInterface($_));
		($_->{TYPE} eq "IMPORT") && push(@ndr, $_);
	}

	return \@ndr;
}

sub GetNextLevel($$)
{
	my $e = shift;
	my $fl = shift;

	my $seen = 0;

	foreach my $l (@{$e->{LEVELS}}) {
		return $l if ($seen);
		($seen = 1) if ($l == $fl);
	}

	return undef;
}

sub GetPrevLevel($$)
{
	my ($e,$fl) = @_;
	my $prev = undef;

	foreach my $l (@{$e->{LEVELS}}) {
		(return $prev) if ($l == $fl);
		$prev = $l;
	}

	return undef;
}

sub ContainsString($)
{
	my ($e) = @_;

	foreach my $l (@{$e->{LEVELS}}) {
		return 1 if ($l->{TYPE} eq "ARRAY" and $l->{IS_ZERO_TERMINATED});
	}

	return 0;
}

sub ContainsDeferred($$)
{
	my ($e,$l) = @_;

	return 1 if ($l->{CONTAINS_DEFERRED});

	while ($l = GetNextLevel($e,$l))
	{
		return 1 if ($l->{IS_DEFERRED}); 
		return 1 if ($l->{CONTAINS_DEFERRED});
	} 
	
	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"],
	"helper"		=> ["INTERFACE"],
	"authservice"		=> ["INTERFACE"],

	# dcom
	"object"		=> ["INTERFACE"],
	"local"			=> ["INTERFACE", "FUNCTION"],
	"iid_is"		=> ["ELEMENT"],
	"call_as"		=> ["FUNCTION"],
	"idempotent"		=> ["FUNCTION"],

	# function
	"noopnum"		=> ["FUNCTION"],
	"in"			=> ["ELEMENT"],
	"out"			=> ["ELEMENT"],
	"async"			=> ["FUNCTION"],

	# pointer
	"ref"			=> ["ELEMENT"],
	"ptr"			=> ["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"],
	"nosize"		=> ["FUNCTION", "TYPEDEF"],
	"noprint"		=> ["FUNCTION", "TYPEDEF"],
	"noejs"			=> ["FUNCTION", "TYPEDEF"],

	# union
	"switch_is"		=> ["ELEMENT"],
	"switch_type"		=> ["ELEMENT", "TYPEDEF"],
	"nodiscriminant"	=> ["TYPEDEF"],
	"case"			=> ["ELEMENT"],
	"default"		=> ["ELEMENT"],

	"represent_as"		=> ["ELEMENT"],
	"transmit_as"		=> ["ELEMENT"],

	# subcontext
	"subcontext"		=> ["ELEMENT"],
	"subcontext_size"	=> ["ELEMENT"],
	"compression"		=> ["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}}) {
		warning($e, el_name($e) . ": unknown property '$key'")
			unless defined($property_list{$key});

   		fatal($e, el_name($e) . ": property '$key' not allowed on '$t'")
			unless grep($t, @{$property_list{$key}});
	}
}

sub mapToScalar($)
{
	sub mapToScalar($);
	my $t = shift;
	return $t->{NAME} if (ref($t) eq "HASH" and $t->{TYPE} eq "SCALAR");
	my $ti = getType($t);

	if (not defined ($ti)) {
		return undef;
	} elsif ($ti->{TYPE} eq "TYPEDEF") {
		return mapToScalar($ti->{DATA});
	} elsif ($ti->{TYPE} eq "ENUM") {
		return Parse::Pidl::Typelist::enum_type_fn($ti);
	} elsif ($ti->{TYPE} eq "BITMAP") {
		return Parse::Pidl::Typelist::bitmap_type_fn($ti);
	}

	return undef;
}

#####################################################################
# validate an element
sub ValidElement($)
{
	my $e = shift;

	ValidProperties($e,"ELEMENT");

	# 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 (not has_property($type->{DATA}, "nodiscriminant") and defined($e2)) {
			my $discriminator_type = has_property($type->{DATA}, "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) {
				warning($e, el_name($e) . ": switch_is() is of type $e2->{TYPE} ($t2), while discriminator type for union $type->{NAME} is $discriminator_type ($t1)");
			}
		}
	}

	if (has_property($e, "subcontext") and has_property($e, "represent_as")) {
		fatal($e, el_name($e) . " : subcontext() and represent_as() can not be used on the same element");
	}

	if (has_property($e, "subcontext") and has_property($e, "transmit_as")) {
		fatal($e, el_name($e) . " : subcontext() and transmit_as() can not be used on the same element");
	}

	if (has_property($e, "represent_as") and has_property($e, "transmit_as")) {
		fatal($e, el_name($e) . " : represent_as() and transmit_as() can not be used on the same element");
	}

	if (has_property($e, "represent_as") and has_property($e, "value")) {
		fatal($e, el_name($e) . " : represent_as() and value() can not be used on the same element");
	}

	if (has_property($e, "subcontext")) {
		warning($e, "subcontext() is deprecated. Use represent_as() or transmit_as() instead");
	}

	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 (!$e->{POINTERS} && (
		has_property($e, "ptr") 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");	
	}
}

#####################################################################
# validate an enum
sub ValidEnum($)
{
	my ($enum) = @_;

	ValidProperties($enum, "ENUM");
}

#####################################################################
# validate a bitmap
sub ValidBitmap($)
{
	my ($bitmap) = @_;

	ValidProperties($bitmap, "BITMAP");
}

#####################################################################
# validate a struct
sub ValidStruct($)
{
	my($struct) = shift;

	ValidProperties($struct, "STRUCT");

	return unless defined($struct->{ELEMENTS});

	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");
	}

	return unless defined($union->{ELEMENTS});

	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!");
		}
		
		unless (defined ($e->{PROPERTIES}->{default}) or 
				defined ($e->{PROPERTIES}->{case})) {
			fatal($e, "Union member $e->{NAME} must have default or case property");
		}

		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;

	ValidType($data) if (ref($data) eq "HASH");
}

#####################################################################
# validate 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})");
		}
		ValidElement($e);
	}
}

#####################################################################
# validate a type
sub ValidType($)
{
	my ($t) = @_;

	{ 
		TYPEDEF => \&ValidTypedef,
		STRUCT => \&ValidStruct,
		UNION => \&ValidUnion,
		ENUM => \&ValidEnum,
		BITMAP => \&ValidBitmap
	}->{$t->{TYPE}}->($t);
}

#####################################################################
# parse the interface definitions
sub ValidInterface($)
{
	my($interface) = shift;
	my($data) = $interface->{DATA};

	if (has_property($interface, "helper")) {
		warning($interface, "helper() is pidl-specific and deprecated. Use `include' instead");
	}

	ValidProperties($interface,"INTERFACE");

	if (has_property($interface, "pointer_default")) {
		if (not grep (/$interface->{PROPERTIES}->{pointer_default}/, 
					("ref", "unique", "ptr"))) {
			fatal($interface, "Unknown default pointer type `$interface->{PROPERTIES}->{pointer_default}'");
		}
	}

	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})");
		}

		if (!defined($interface->{BASE}) && 
			not ($interface->{NAME} eq "IUnknown")) {
			fatal($interface, "Object interfaces must all derive from IUnknown ($interface->{NAME})");
		}
	}
		
	foreach my $d (@{$data}) {
		($d->{TYPE} eq "FUNCTION") && ValidFunction($d);
		($d->{TYPE} eq "TYPEDEF" or 
		 $d->{TYPE} eq "STRUCT" or
	 	 $d->{TYPE} eq "UNION" or 
	 	 $d->{TYPE} eq "ENUM" or
		 $d->{TYPE} eq "BITMAP") && ValidType($d);
	}

}

#####################################################################
# Validate an IDL structure
sub Validate($)
{
	my($idl) = shift;

	foreach my $x (@{$idl}) {
		($x->{TYPE} eq "INTERFACE") && 
		    ValidInterface($x);
		($x->{TYPE} eq "IMPORTLIB") &&
			fatal($x, "importlib() not supported");
	}
}

1;