parser.pm

来自「samba最新软件」· PM 代码 · 共 2,327 行 · 第 1/5 页

###################################################
# Samba4 NDR parser generator for IDL structures
# Copyright [e-mail] 2000-2003
# Copyright [e-mail] 2001
# Copyright [e-mail] 2004-2006
# released under the GNU GPL

package Parse::Pidl::Samba4::NDR::Parser;

require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(check_null_pointer NeededFunction NeededElement NeededType $res NeededInterface TypeFunctionName ParseElementPrint);

use strict;
use Parse::Pidl::Typelist qw(hasType getType mapTypeName typeHasBody);
use Parse::Pidl::Util qw(has_property ParseExpr ParseExprExt print_uuid);
use Parse::Pidl::CUtil qw(get_pointer_to get_value_of get_array_element);
use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred is_charset_array);
use Parse::Pidl::Samba4 qw(is_intree choose_header);
use Parse::Pidl::Samba4::Header qw(GenerateFunctionInEnv GenerateFunctionOutEnv EnvSubstituteValue GenerateStructEnv);
use Parse::Pidl qw(warning);

use vars qw($VERSION);
$VERSION = '0.01';

# list of known types
my %typefamily;

sub new($$) {
	my ($class) = @_;
	my $self = { res => "", res_hdr => "", deferred => [], tabs => "", defer_tabs => "" };
	bless($self, $class);
}

sub get_typefamily($)
{
	my $n = shift;
	return $typefamily{$n};
}

sub append_prefix($$)
{
	my ($e, $var_name) = @_;
	my $pointers = 0;
	my $arrays = 0;

	foreach my $l (@{$e->{LEVELS}}) {
		if ($l->{TYPE} eq "POINTER") {
			$pointers++;
		} elsif ($l->{TYPE} eq "ARRAY") {
			$arrays++;
			if (($pointers == 0) and 
			    (not $l->{IS_FIXED}) and
			    (not $l->{IS_INLINE})) {
				return get_value_of($var_name);
			}
		} elsif ($l->{TYPE} eq "DATA") {
			if (Parse::Pidl::Typelist::scalar_is_reference($l->{DATA_TYPE})) {
				return get_value_of($var_name) unless ($pointers or $arrays);
			}
		}
	}
	
	return $var_name;
}

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

	return 0 if ($l->{TYPE} ne "ARRAY");

	my $nl = GetNextLevel($e,$l);
	return 0 unless ($nl->{TYPE} eq "DATA");
	return 0 unless (hasType($nl->{DATA_TYPE}));

	my $t = getType($nl->{DATA_TYPE});

	# Only uint8 and string have fast array functions at the moment
	return ($t->{NAME} eq "uint8") or ($t->{NAME} eq "string");
}


####################################
# pidl() is our basic output routine
sub pidl($$)
{
	my ($self, $d) = @_;
	if ($d) {
		$self->{res} .= $self->{tabs};
		$self->{res} .= $d;
	}
	$self->{res} .="\n";
}

sub pidl_hdr($$) { my ($self, $d) = @_; $self->{res_hdr} .= "$d\n"; }

####################################
# defer() is like pidl(), but adds to 
# a deferred buffer which is then added to the 
# output buffer at the end of the structure/union/function
# This is needed to cope with code that must be pushed back
# to the end of a block of elements
sub defer_indent($) { my ($self) = @_; $self->{defer_tabs}.="\t"; }
sub defer_deindent($) { my ($self) = @_; $self->{defer_tabs}=substr($self->{defer_tabs}, 0, -1); }

sub defer($$)
{
	my ($self, $d) = @_;
	if ($d) {
		push(@{$self->{deferred}}, $self->{defer_tabs}.$d);
	}
}

########################################
# add the deferred content to the current
# output
sub add_deferred($)
{
	my ($self) = @_;
	$self->pidl($_) foreach (@{$self->{deferred}});
	$self->{deferred} = [];
	$self->{defer_tabs} = "";
}

sub indent($)
{
	my ($self) = @_;
	$self->{tabs} .= "\t";
}

sub deindent($)
{
	my ($self) = @_;
	$self->{tabs} = substr($self->{tabs}, 0, -1);
}

#####################################################################
# declare a function public or static, depending on its attributes
sub fn_declare($$$$)
{
	my ($self,$type,$fn,$decl) = @_;

	if (has_property($fn, "no$type")) {
		$self->pidl_hdr("$decl;");
		return 0;
	}

	if (has_property($fn, "public")) {
		$self->pidl_hdr("$decl;");
		$self->pidl("_PUBLIC_ $decl");
	} else {
		$self->pidl("static $decl");
	}

	return 1;
}

###################################################################
# setup any special flags for an element or structure
sub start_flags($$)
{
	my ($self, $e) = @_;
	my $flags = has_property($e, "flag");
	if (defined $flags) {
		$self->pidl("{");
		$self->indent;
		$self->pidl("uint32_t _flags_save_$e->{TYPE} = ndr->flags;");
		$self->pidl("ndr_set_flags(&ndr->flags, $flags);");
	}
}

###################################################################
# end any special flags for an element or structure
sub end_flags($$)
{
	my ($self, $e) = @_;
	my $flags = has_property($e, "flag");
	if (defined $flags) {
		$self->pidl("ndr->flags = _flags_save_$e->{TYPE};");
		$self->deindent;
		$self->pidl("}");
	}
}

#####################################################################
# parse the data of an array - push side
sub ParseArrayPushHeader($$$$$$)
{
	my ($self,$e,$l,$ndr,$var_name,$env) = @_;

	my $size;
	my $length;

	if ($l->{IS_ZERO_TERMINATED}) {
		if (has_property($e, "charset")) {
			$size = $length = "ndr_charset_length($var_name, CH_$e->{PROPERTIES}->{charset})";
		} else {
			$size = $length = "ndr_string_length($var_name, sizeof(*$var_name))";
		}
	} else {
		$size = ParseExpr($l->{SIZE_IS}, $env, $e);
		$length = ParseExpr($l->{LENGTH_IS}, $env, $e);
	}

	if ((!$l->{IS_SURROUNDING}) and $l->{IS_CONFORMANT}) {
		$self->pidl("NDR_CHECK(ndr_push_uint32($ndr, NDR_SCALARS, $size));");
	}
	
	if ($l->{IS_VARYING}) {
		$self->pidl("NDR_CHECK(ndr_push_uint32($ndr, NDR_SCALARS, 0));");  # array offset
		$self->pidl("NDR_CHECK(ndr_push_uint32($ndr, NDR_SCALARS, $length));");
	} 

	return $length;
}

sub check_fully_dereferenced($$)
{
	my ($element, $env) = @_;

	return sub ($) {
		my $origvar = shift;
		my $check = 0;

		# Figure out the number of pointers in $ptr
		my $expandedvar = $origvar;
		$expandedvar =~ s/^(\**)//;
		my $ptr = $1;

		my $var = undef;
		foreach (keys %$env) {
			if ($env->{$_} eq $expandedvar) {
				$var = $_;
				last;
			}
		}
		
		return($origvar) unless (defined($var));
		my $e;
		foreach (@{$element->{PARENT}->{ELEMENTS}}) {
			if ($_->{NAME} eq $var) {
				$e = $_;
				last;
			}
		}

		$e or die("Environment doesn't match siblings");

		# See if pointer at pointer level $level
		# needs to be checked.
		my $nump = 0;
		foreach (@{$e->{LEVELS}}) {
			if ($_->{TYPE} eq "POINTER") {
				$nump = $_->{POINTER_INDEX}+1;
			}
		}
		warning($element->{ORIGINAL}, "Got pointer for `$e->{NAME}', expected fully derefenced variable") if ($nump > length($ptr));
		return ($origvar);
	}
}	

sub check_null_pointer($$$$)
{
	my ($element, $env, $print_fn, $return) = @_;

	return sub ($) {
		my $expandedvar = shift;
		my $check = 0;

		# Figure out the number of pointers in $ptr
		$expandedvar =~ s/^(\**)//;
		my $ptr = $1;

		my $var = undef;
		foreach (keys %$env) {
			if ($env->{$_} eq $expandedvar) {
				$var = $_;
				last;
			}
		}
		
		if (defined($var)) {
			my $e;
			# lookup ptr in $e
			foreach (@{$element->{PARENT}->{ELEMENTS}}) {
				if ($_->{NAME} eq $var) {
					$e = $_;
					last;
				}
			}

			$e or die("Environment doesn't match siblings");

			# See if pointer at pointer level $level
			# needs to be checked.
			foreach my $l (@{$e->{LEVELS}}) {
				if ($l->{TYPE} eq "POINTER" and 
					$l->{POINTER_INDEX} == length($ptr)) {
					# No need to check ref pointers
					$check = ($l->{POINTER_TYPE} ne "ref");
					last;
				}

				if ($l->{TYPE} eq "DATA") {
					warning($element, "too much dereferences for `$var'");
				}
			}
		} else {
			warning($element, "unknown dereferenced expression `$expandedvar'");
			$check = 1;
		}
		
		$print_fn->("if ($ptr$expandedvar == NULL) $return") if $check;
	}
}

#####################################################################
# parse an array - pull side
sub ParseArrayPullHeader($$$$$$)
{
	my ($self,$e,$l,$ndr,$var_name,$env) = @_;

	my $length;
	my $size;

	if ($l->{IS_CONFORMANT}) {
		$length = $size = "ndr_get_array_size($ndr, " . get_pointer_to($var_name) . ")";
	} elsif ($l->{IS_ZERO_TERMINATED}) { # Noheader arrays
		$length = $size = "ndr_get_string_size($ndr, sizeof(*$var_name))";
	} else {
		$length = $size = ParseExprExt($l->{SIZE_IS}, $env, $e->{ORIGINAL},
			check_null_pointer($e, $env, sub { $self->pidl(shift); },
					   "return ndr_pull_error(ndr, NDR_ERR_INVALID_POINTER, \"NULL Pointer for size_is()\");"),
			check_fully_dereferenced($e, $env));
	}

	if ((!$l->{IS_SURROUNDING}) and $l->{IS_CONFORMANT}) {
		$self->pidl("NDR_CHECK(ndr_pull_array_size(ndr, " . get_pointer_to($var_name) . "));");
	}

	if ($l->{IS_VARYING}) {
		$self->pidl("NDR_CHECK(ndr_pull_array_length($ndr, " . get_pointer_to($var_name) . "));");
		$length = "ndr_get_array_length($ndr, " . get_pointer_to($var_name) .")";
	}

	if ($length ne $size) {
		$self->pidl("if ($length > $size) {");
		$self->indent;
		$self->pidl("return ndr_pull_error($ndr, NDR_ERR_ARRAY_SIZE, \"Bad array size %u should exceed array length %u\", $size, $length);");
		$self->deindent;
		$self->pidl("}");
	}

	if ($l->{IS_CONFORMANT} and not $l->{IS_ZERO_TERMINATED}) {
		$self->defer("if ($var_name) {");
		$self->defer_indent;
		my $size = ParseExprExt($l->{SIZE_IS}, $env, $e->{ORIGINAL},
			check_null_pointer($e, $env, sub { $self->defer(shift); },
					   "return ndr_pull_error(ndr, NDR_ERR_INVALID_POINTER, \"NULL Pointer for size_is()\");"),
			check_fully_dereferenced($e, $env));
		$self->defer("NDR_CHECK(ndr_check_array_size(ndr, (void*)" . get_pointer_to($var_name) . ", $size));");
		$self->defer_deindent;
		$self->defer("}");
	}

	if ($l->{IS_VARYING} and not $l->{IS_ZERO_TERMINATED}) {
		$self->defer("if ($var_name) {");
		$self->defer_indent;
		my $length = ParseExprExt($l->{LENGTH_IS}, $env, $e->{ORIGINAL}, 
			check_null_pointer($e, $env, sub { $self->defer(shift); },
					   "return ndr_pull_error(ndr, NDR_ERR_INVALID_POINTER, \"NULL Pointer for length_is()\");"),
			check_fully_dereferenced($e, $env));
		$self->defer("NDR_CHECK(ndr_check_array_length(ndr, (void*)" . get_pointer_to($var_name) . ", $length));");
		$self->defer_deindent;
		$self->defer("}");
	}

	if (not $l->{IS_FIXED} and not is_charset_array($e, $l)) {
		$self->AllocateArrayLevel($e,$l,$ndr,$var_name,$size);
	}

	return $length;
}

sub compression_alg($$)
{
	my ($e, $l) = @_;
	my ($alg, $clen, $dlen) = split(/,/, $l->{COMPRESSION});

	return $alg;
}

sub compression_clen($$$)
{
	my ($e, $l, $env) = @_;
	my ($alg, $clen, $dlen) = split(/,/, $l->{COMPRESSION});

	return ParseExpr($clen, $env, $e->{ORIGINAL});
}

sub compression_dlen($$$)
{
	my ($e,$l,$env) = @_;
	my ($alg, $clen, $dlen) = split(/,/, $l->{COMPRESSION});

	return ParseExpr($dlen, $env, $e->{ORIGINAL});
}

sub ParseCompressionPushStart($$$$$)
{
	my ($self,$e,$l,$ndr,$env) = @_;
	my $comndr = "$ndr\_compressed";
	my $alg = compression_alg($e, $l);
	my $dlen = compression_dlen($e, $l, $env);

	$self->pidl("{");
	$self->indent;
	$self->pidl("struct ndr_push *$comndr;");
	$self->pidl("NDR_CHECK(ndr_push_compression_start($ndr, &$comndr, $alg, $dlen));");

	return $comndr;
}

sub ParseCompressionPushEnd($$$$$)
{
	my ($self,$e,$l,$ndr,$env) = @_;
	my $comndr = "$ndr\_compressed";
	my $alg = compression_alg($e, $l);
	my $dlen = compression_dlen($e, $l, $env);

	$self->pidl("NDR_CHECK(ndr_push_compression_end($ndr, $comndr, $alg, $dlen));");
	$self->deindent;
	$self->pidl("}");
}

sub ParseCompressionPullStart($$$$$)
{
	my ($self,$e,$l,$ndr,$env) = @_;
	my $comndr = "$ndr\_compressed";
	my $alg = compression_alg($e, $l);
	my $dlen = compression_dlen($e, $l, $env);

	$self->pidl("{");
	$self->indent;
	$self->pidl("struct ndr_pull *$comndr;");
	$self->pidl("NDR_CHECK(ndr_pull_compression_start($ndr, &$comndr, $alg, $dlen));");

	return $comndr;
}

sub ParseCompressionPullEnd($$$$$)
{
	my ($self,$e,$l,$ndr,$env) = @_;
	my $comndr = "$ndr\_compressed";
	my $alg = compression_alg($e, $l);
	my $dlen = compression_dlen($e, $l, $env);

	$self->pidl("NDR_CHECK(ndr_pull_compression_end($ndr, $comndr, $alg, $dlen));");
	$self->deindent;
	$self->pidl("}");
}

sub ParseSubcontextPushStart($$$$$)
{
	my ($self,$e,$l,$ndr,$env) = @_;