#################################################### Samba4 NDR parser generator for IDL structures# Copyright tridge@samba.org 2000-2003# Copyright tpot@samba.org 2001# Copyright jelmer@samba.org 2004-2006# released under the GNU GPLpackage Parse::Pidl::Samba4::NDR::Parser;require Exporter;@ISA = qw(Exporter);@EXPORT_OK = qw(check_null_pointer GenerateFunctionInEnv GenerateFunctionOutEnv EnvSubstituteValue GenerateStructEnv NeededFunction NeededElement NeededType $res NeededInterface TypeFunctionName ParseElementPrint);use strict;use Parse::Pidl::Typelist qw(hasType getType mapTypeName);use Parse::Pidl::Util qw(has_property ParseExpr ParseExprExt print_uuid);use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred);use Parse::Pidl::Samba4 qw(is_intree choose_header);use Parse::Pidl qw(warning);use vars qw($VERSION);$VERSION = '0.01';# list of known typesmy %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;	foreach my $l (@{$e->{LEVELS}}) {		if ($l->{TYPE} eq "POINTER") {			$pointers++;		} elsif ($l->{TYPE} eq "ARRAY") {			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);			}		}	}		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");}sub is_charset_array($$){	my ($e,$l) = @_;	return 0 if ($l->{TYPE} ne "ARRAY");	my $nl = GetNextLevel($e,$l);	return 0 unless ($nl->{TYPE} eq "DATA");	return has_property($e, "charset");}sub get_pointer_to($){	my $var_name = shift;		if ($var_name =~ /^\*(.*)$/) {		return $1;	} elsif ($var_name =~ /^\&(.*)$/) {		return "&($var_name)";	} else {		return "&$var_name";	}}sub get_value_of($){	my $var_name = shift;	if ($var_name =~ /^\&(.*)$/) {		return $1;	} else {		return "*$var_name";	}}##################################### pidl() is our basic output routinesub 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 elementssub 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# outputsub 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 attributessub 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 structuresub 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 structuresub 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("}");	}}sub GenerateStructEnv($$){	my ($x, $v) = @_;	my %env;	foreach my $e (@{$x->{ELEMENTS}}) {		$env{$e->{NAME}} = "$v->$e->{NAME}";	}	$env{"this"} = $v;	return \%env;}sub EnvSubstituteValue($$){	my ($env,$s) = @_;	# Substitute the value() values in the env	foreach my $e (@{$s->{ELEMENTS}}) {		next unless (defined(my $v = has_property($e, "value")));				$env->{$e->{NAME}} = ParseExpr($v, $env, $e);	}	return $env;}sub GenerateFunctionInEnv($;$){	my ($fn, $base) = @_;	my %env;	$base = "r->" unless defined($base);	foreach my $e (@{$fn->{ELEMENTS}}) {		if (grep (/in/, @{$e->{DIRECTION}})) {			$env{$e->{NAME}} = $base."in.$e->{NAME}";		}	}	return \%env;}sub GenerateFunctionOutEnv($;$){	my ($fn, $base) = @_;	my %env;	$base = "r->" unless defined($base);	foreach my $e (@{$fn->{ELEMENTS}}) {		if (grep (/out/, @{$e->{DIRECTION}})) {			$env{$e->{NAME}} = $base."out.$e->{NAME}";		} elsif (grep (/in/, @{$e->{DIRECTION}})) {			$env{$e->{NAME}} = $base."in.$e->{NAME}";		}	}	return \%env;}###################################################################### parse the data of an array - push sidesub 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 sidesub 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("}");	}