r1306: commit the first steps of my ASN.1 compiler

called 'pasn1', it works like 'pidl'

and we may can autogenerate ASN.1 code out of it.
(NOTE: the complete LDAP ASN.1 definition is in the RFC 2251,
 and maybe some others too :-)

I'm not completly shure if we'll use it in future,
but I commit it so that it won't be lost...

metze
(This used to be commit ddcaf7b63a0bc49ef1fc2d85d0ba81d67db48790)

4 files changed, 769 insertions, 0 deletions

diff --git a/source4/build/pasn1/Makefile b/source4/build/pasn1/Makefile
new file mode 100644
index 0000000000..24da2b79e8
--- /dev/null
+++ b/source4/build/pasn1/Makefile
@@ -0,0 +1,5 @@
+asn1.pm: asn1.yp
+	yapp -s asn1.yp
+
+clean:
+	rm -f asn1.pm
diff --git a/source4/build/pasn1/asn1.yp b/source4/build/pasn1/asn1.yp
new file mode 100644
index 0000000000..5fa6460d7e
--- /dev/null
+++ b/source4/build/pasn1/asn1.yp
@@ -0,0 +1,271 @@
+########################
+# ASN.1 Parse::Yapp parser
+# Copyright (C) Stefan (metze) Metzmacher <metze@samba.org>
+# released under the GNU GPL version 2 or later
+
+
+
+# the precedence actually doesn't matter at all for this grammer, but
+# by providing a precedence we reduce the number of conflicts
+# enormously
+%left   '-' '+' '&' '|' '*' '>' '.' '/' '(' ')' '[' ']' ':' ',' ';'
+
+
+################
+# grammer
+%%
+
+asn1:
+	asn1_def
+		{ [ $_[1] ] }
+	| asn1 asn1_def 
+		{ push(@{$_[1]}, $_[2]); $_[1] }
+;
+
+asn1_def: 
+	asn1_target asn1_delim asn1_application asn1_type
+		{{ 
+		    "OBJECT"		=> "ASN1_DEF",
+		    "IDENTIFIER"	=> $_[1],
+		    "APPLICATION"	=> $_[3],
+		    "STRUCTURE"		=> $_[4]
+		}}
+;
+
+asn1_target:
+	identifier
+;
+
+asn1_delim: 
+	':' ':' '='
+;
+
+asn1_application:
+	#empty
+	| '[' 'APPLICATION' constant ']'
+		{ $_[3] }
+;
+
+asn1_type: 
+	asn1_boolean
+	| asn1_integer
+	| asn1_bit_string
+	| asn1_octet_string
+	| asn1_null
+	| asn1_object_identifier
+	| asn1_real
+	| asn1_enumerated
+	| asn1_sequence 
+;
+
+asn1_boolean:
+	'BOOLEAN'
+		{{
+			"TYPE"		=> "BOOLEAN",
+			"TAG"		=> 1
+		}}
+;
+
+asn1_integer:
+	'INTEGER'
+		{{
+			"TYPE"		=> "INTEGER",
+			"TAG"		=> 2
+		}}
+	| 'INTEGER' '(' constant '.' '.' constant ')'
+		{{
+			"TYPE"		=> "INTEGER",
+			"TAG"		=> 2,
+			"RANGE_LOW"	=> $_[3],
+			"RENAGE_HIGH"	=> $_[6]
+		}}
+;
+
+asn1_bit_string:
+	'BIT' 'STRING'
+		{{
+			"TYPE"		=> "BIT STRING",
+			"TAG"		=> 3
+		}}
+;
+
+asn1_octet_string:
+	'OCTET' 'STRING'
+		{{
+			"TYPE"		=> "OCTET STRING",
+			"TAG"		=> 4
+		}}
+;
+
+asn1_null:
+	'NULL'
+		{{
+			"TYPE"		=> "NULL",
+			"TAG"		=> 5
+		}}
+;
+
+asn1_object_identifier:
+	'OBJECT' 'IDENTIFIER'
+		{{
+			"TYPE"		=> "OBJECT IDENTIFIER",
+			"TAG"		=> 6
+		}}
+;
+
+asn1_real:
+	'REAL'
+		{{
+			"TYPE"		=> "REAL",
+			"TAG"		=> 9
+		}}
+;
+
+asn1_enumerated:
+	'ENUMERATED'
+		{{
+			"TYPE"		=> "ENUMERATED",
+			"TAG"		=> 10
+		}}
+;
+
+asn1_sequence:
+	'SEQUENCE' '{' asn1_var_dec_list '}'
+		{{
+			"TYPE"		=> "SEQUENCE",
+			"TAG"		=> 16,
+			"STRUCTURE"	=> $_[3]
+		}}
+;
+
+asn1_var_dec_list:
+	asn1_var_dec
+		{ [ $_[1] ] }
+	| asn1_var_dec_list ',' asn1_var_dec 
+		{ push(@{$_[1]}, $_[3]); $_[1]  }
+;
+
+asn1_var_dec: 
+	identifier asn1_type
+	{{
+		"NAME" => $_[1],
+		"TYPE" => $_[2]
+	}}
+;
+
+anytext:  #empty { "" }
+    | identifier | constant | text
+    | anytext '-' anytext  { "$_[1]$_[2]$_[3]" }
+    | anytext '.' anytext  { "$_[1]$_[2]$_[3]" }
+    | anytext '*' anytext  { "$_[1]$_[2]$_[3]" }
+    | anytext '>' anytext  { "$_[1]$_[2]$_[3]" }
+    | anytext '|' anytext  { "$_[1]$_[2]$_[3]" }
+    | anytext '&' anytext  { "$_[1]$_[2]$_[3]" }
+    | anytext '/' anytext  { "$_[1]$_[2]$_[3]" }
+    | anytext '+' anytext  { "$_[1]$_[2]$_[3]" }
+    | anytext '(' anytext ')' anytext  { "$_[1]$_[2]$_[3]$_[4]$_[5]" }
+;
+
+identifier: IDENTIFIER
+;
+
+constant: CONSTANT
+;
+
+text: TEXT { "\"$_[1]\"" }
+;
+
+#####################################
+# start code
+%%
+
+use util;
+
+sub _ASN1_Error {
+        if (exists $_[0]->YYData->{ERRMSG}) {
+		print $_[0]->YYData->{ERRMSG};
+		delete $_[0]->YYData->{ERRMSG};
+		return;
+	};
+	my $line = $_[0]->YYData->{LINE};
+	my $last_token = $_[0]->YYData->{LAST_TOKEN};
+	my $file = $_[0]->YYData->{INPUT_FILENAME};
+	
+	print "$file:$line: Syntax error near '$last_token'\n";
+}
+
+sub _ASN1_Lexer($)
+{
+	my($parser)=shift;
+
+        $parser->YYData->{INPUT}
+        or  return('',undef);
+
+again:
+	$parser->YYData->{INPUT} =~ s/^[ \t]*//;
+
+	for ($parser->YYData->{INPUT}) {
+		if (/^\#/) {
+			if (s/^\# (\d+) \"(.*?)\"( \d+|)//) {
+				$parser->YYData->{LINE} = $1-1;
+				$parser->YYData->{INPUT_FILENAME} = $2;
+				goto again;
+			}
+			if (s/^\#line (\d+) \"(.*?)\"( \d+|)//) {
+				$parser->YYData->{LINE} = $1-1;
+				$parser->YYData->{INPUT_FILENAME} = $2;
+				goto again;
+			}
+			if (s/^(\#.*)$//m) {
+				goto again;
+			}
+		}
+		if (s/^(\n)//) {
+			$parser->YYData->{LINE}++;
+			goto again;
+		}
+		if (s/^\"(.*?)\"//) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+			return('TEXT',$1); 
+		}
+		if (s/^(\d+)(\W|$)/$2/) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+			return('CONSTANT',$1); 
+		}
+		if (s/^([\w_]+)//) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+			if ($1 =~ 
+			    /^(SEQUENCE|INTEGER|OCTET|STRING|
+			       APPLICATION|OPTIONAL|NULL|COMPONENTS|OF|
+			       BOOLEAN|ENUMERATED|CHOISE|REAL|BIT|OBJECT|IDENTIFIER
+			       DEFAULT|FALSE|TRUE|SET)$/x) {
+				return $1;
+			}
+			return('IDENTIFIER',$1);
+		}
+		if (s/^(.)//s) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+			return($1,$1);
+		}
+	}
+}
+
+sub parse_asn1($$)
+{
+	my $self = shift;
+	my $filename = shift;
+
+	my $saved_delim = $/;
+	undef $/;
+	my $cpp = $ENV{CPP};
+	if (! defined $cpp) {
+		$cpp = "cpp"
+	}
+	my $data = `$cpp -xc $filename`;
+	$/ = $saved_delim;
+
+        $self->YYData->{INPUT} = $data;
+        $self->YYData->{LINE} = 0;
+        $self->YYData->{LAST_TOKEN} = "NONE";
+	return $self->YYParse( yylex => \&_ASN1_Lexer, yyerror => \&_ASN1_Error );
+}
diff --git a/source4/build/pasn1/pasn1.pl b/source4/build/pasn1/pasn1.pl
new file mode 100755
index 0000000000..f4d0b06bd2
--- /dev/null
+++ b/source4/build/pasn1/pasn1.pl
@@ -0,0 +1,114 @@
+#!/usr/bin/perl -W
+
+###################################################
+# package to parse ASN.1 files and generate code for
+# LDAP functions in Samba
+# Copyright tridge@samba.org 2002-2003
+# Copyright metze@samba.org 2004
+
+# released under the GNU GPL
+
+use strict;
+
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use lib "$RealBin/lib";
+use Getopt::Long;
+use File::Basename;
+use asn1;
+use util;
+
+my($opt_help) = 0;
+my($opt_parse) = 0;
+my($opt_dump) = 0;
+my($opt_keep) = 0;
+my($opt_output);
+
+my $asn1_parser = new asn1;
+
+#####################################################################
+# parse an ASN.1 file returning a structure containing all the data
+sub ASN1Parse($)
+{
+    my $filename = shift;
+    my $asn1 = $asn1_parser->parse_asn1($filename);
+    util::CleanData($asn1);
+    return $asn1;
+}
+
+
+#########################################
+# display help text
+sub ShowHelp()
+{
+    print "
+           perl ASN.1 parser and code generator
+           Copyright (C) tridge\@samba.org
+           Copyright (C) metze\@samba.org
+
+           Usage: pasn1.pl [options] <asn1file>
+
+           Options:
+             --help                this help page
+             --output OUTNAME      put output in OUTNAME.*
+             --parse               parse a asn1 file to a .pasn1 file
+             --dump                dump a pasn1 file back to asn1
+             --parser              create a C parser
+             --keep                keep the .pasn1 file
+           \n";
+    exit(0);
+}
+
+# main program
+GetOptions (
+	    'help|h|?' => \$opt_help, 
+	    'output=s' => \$opt_output,
+	    'parse' => \$opt_parse,
+	    'dump' => \$opt_dump,
+	    'keep' => \$opt_keep
+	    );
+
+if ($opt_help) {
+    ShowHelp();
+    exit(0);
+}
+
+sub process_file($)
+{
+	my $asn1_file = shift;
+	my $output;
+	my $pasn1;
+
+	my $basename = basename($asn1_file, ".asn1");
+
+	if (!defined($opt_output)) {
+		$output = $asn1_file;
+	} else {
+		$output = $opt_output . $basename;
+	}
+
+	my($pasn1_file) = util::ChangeExtension($output, ".pasn1");
+
+	print "Compiling $asn1_file\n";
+
+	if ($opt_parse) {
+		$pasn1 = ASN1Parse($asn1_file);
+		defined $pasn1 || die "Failed to parse $asn1_file";
+		#ASN1Validator::Validate($pasn1);
+		if ($opt_keep && !util::SaveStructure($pasn1_file, $pasn1)) {
+			    die "Failed to save $pasn1_file\n";
+		}
+	} else {
+		$pasn1 = util::LoadStructure($pasn1_file);
+		defined $pasn1 || die "Failed to load $pasn1_file - maybe you need --parse\n";
+	}
+
+	if ($opt_dump) {
+		print ASN1Dump::Dump($pasn1);
+	}
+}
+
+
+foreach my $filename (@ARGV) {
+	process_file($filename);
+}
diff --git a/source4/build/pasn1/util.pm b/source4/build/pasn1/util.pm
new file mode 100644
index 0000000000..f822222b45
--- /dev/null
+++ b/source4/build/pasn1/util.pm
@@ -0,0 +1,379 @@
+###################################################
+# utility functions to support pidl
+# Copyright tridge@samba.org 2000
+# released under the GNU GPL
+package util;
+
+#####################################################################
+# load a data structure from a file (as saved with SaveStructure)
+sub LoadStructure($)
+{
+	my $f = shift;
+	my $contents = FileLoad($f);
+	defined $contents || return undef;
+	return eval "$contents";
+}
+
+use strict;
+
+#####################################################################
+# flatten an array of arrays into a single array
+sub FlattenArray2($) 
+{ 
+    my $a = shift;
+    my @b;
+    for my $d (@{$a}) {
+	for my $d1 (@{$d}) {
+	    push(@b, $d1);
+	}
+    }
+    return \@b;
+}
+
+#####################################################################
+# flatten an array of arrays into a single array
+sub FlattenArray($) 
+{ 
+    my $a = shift;
+    my @b;
+    for my $d (@{$a}) {
+	for my $d1 (@{$d}) {
+	    push(@b, $d1);
+	}
+    }
+    return \@b;
+}
+
+#####################################################################
+# flatten an array of hashes into a single hash
+sub FlattenHash($) 
+{ 
+    my $a = shift;
+    my %b;
+    for my $d (@{$a}) {
+	for my $k (keys %{$d}) {
+	    $b{$k} = $d->{$k};
+	}
+    }
+    return \%b;
+}
+
+
+#####################################################################
+# traverse a perl data structure removing any empty arrays or
+# hashes and any hash elements that map to undef
+sub CleanData($)
+{
+    sub CleanData($);
+    my($v) = shift;
+    if (ref($v) eq "ARRAY") {
+	foreach my $i (0 .. $#{$v}) {
+	    CleanData($v->[$i]);
+	    if (ref($v->[$i]) eq "ARRAY" && $#{$v->[$i]}==-1) { 
+		    $v->[$i] = undef; 
+		    next; 
+	    }
+	}
+	# this removes any undefined elements from the array
+	@{$v} = grep { defined $_ } @{$v};
+    } elsif (ref($v) eq "HASH") {
+	foreach my $x (keys %{$v}) {
+	    CleanData($v->{$x});
+	    if (!defined $v->{$x}) { delete($v->{$x}); next; }
+	    if (ref($v->{$x}) eq "ARRAY" && $#{$v->{$x}}==-1) { delete($v->{$x}); next; }
+	}
+    }
+}
+
+
+#####################################################################
+# return the modification time of a file
+sub FileModtime($)
+{
+    my($filename) = shift;
+    return (stat($filename))[9];
+}
+
+
+#####################################################################
+# read a file into a string
+sub FileLoad($)
+{
+    my($filename) = shift;
+    local(*INPUTFILE);
+    open(INPUTFILE, $filename) || return undef;
+    my($saved_delim) = $/;
+    undef $/;
+    my($data) = <INPUTFILE>;
+    close(INPUTFILE);
+    $/ = $saved_delim;
+    return $data;
+}
+
+#####################################################################
+# write a string into a file
+sub FileSave($$)
+{
+    my($filename) = shift;
+    my($v) = shift;
+    local(*FILE);
+    open(FILE, ">$filename") || die "can't open $filename";    
+    print FILE $v;
+    close(FILE);
+}
+
+#####################################################################
+# return a filename with a changed extension
+sub ChangeExtension($$)
+{
+    my($fname) = shift;
+    my($ext) = shift;
+    if ($fname =~ /^(.*)\.(.*?)$/) {
+	return "$1$ext";
+    }
+    return "$fname$ext";
+}
+
+#####################################################################
+# a dumper wrapper to prevent dependence on the Data::Dumper module
+# unless we actually need it
+sub MyDumper($)
+{
+	require Data::Dumper;
+	my $s = shift;
+	return Data::Dumper::Dumper($s);
+}
+
+#####################################################################
+# save a data structure into a file
+sub SaveStructure($$)
+{
+	my($filename) = shift;
+	my($v) = shift;
+	FileSave($filename, MyDumper($v));
+}
+
+#####################################################################
+# see if a pidl property list contains a give property
+sub has_property($$)
+{
+	my($e) = shift;
+	my($p) = shift;
+
+	if (!defined $e->{PROPERTIES}) {
+		return undef;
+	}
+
+	return $e->{PROPERTIES}->{$p};
+}
+
+
+sub is_scalar_type($)
+{
+    my($type) = shift;
+
+    if ($type =~ /^u?int\d+/) {
+	    return 1;
+    }
+    if ($type =~ /char|short|long|NTTIME|
+	time_t|error_status_t|boolean32|unsigned32|
+	HYPER_T|wchar_t|DATA_BLOB/x) {
+	    return 1;
+    }
+
+    return 0;
+}
+
+# return the NDR alignment for a type
+sub type_align($)
+{
+    my($e) = shift;
+    my $type = $e->{TYPE};
+
+    if (need_wire_pointer($e)) {
+	    return 4;
+    }
+
+    return 4, if ($type eq "uint32");
+    return 4, if ($type eq "long");
+    return 2, if ($type eq "short");
+    return 1, if ($type eq "char");
+    return 1, if ($type eq "uint8");
+    return 2, if ($type eq "uint16");
+    return 4, if ($type eq "NTTIME");
+    return 4, if ($type eq "time_t");
+    return 8, if ($type eq "HYPER_T");
+    return 2, if ($type eq "wchar_t");
+    return 4, if ($type eq "DATA_BLOB");
+
+    # it must be an external type - all we can do is guess 
+    return 4;
+}
+
+# this is used to determine if the ndr push/pull functions will need
+# a ndr_flags field to split by buffers/scalars
+sub is_builtin_type($)
+{
+    my($type) = shift;
+
+    return 1, if (is_scalar_type($type));
+
+    return 0;
+}
+
+# determine if an element needs a reference pointer on the wire
+# in its NDR representation
+sub need_wire_pointer($)
+{
+	my $e = shift;
+	if ($e->{POINTERS} && 
+	    !has_property($e, "ref")) {
+		return $e->{POINTERS};
+	}
+	return undef;
+}
+
+# determine if an element is a pass-by-reference structure
+sub is_ref_struct($)
+{
+	my $e = shift;
+	if (!is_scalar_type($e->{TYPE}) &&
+	    has_property($e, "ref")) {
+		return 1;
+	}
+	return 0;
+}
+
+# determine if an element is a pure scalar. pure scalars do not
+# have a "buffers" section in NDR
+sub is_pure_scalar($)
+{
+	my $e = shift;
+	if (has_property($e, "ref")) {
+		return 1;
+	}
+	if (is_scalar_type($e->{TYPE}) && 
+	    !$e->{POINTERS} && 
+	    !array_size($e)) {
+		return 1;
+	}
+	return 0;
+}
+
+# determine the array size (size_is() or ARRAY_LEN)
+sub array_size($)
+{
+	my $e = shift;
+	my $size = has_property($e, "size_is");
+	if ($size) {
+		return $size;
+	}
+	$size = $e->{ARRAY_LEN};
+	if ($size) {
+		return $size;
+	}
+	return undef;
+}
+
+# see if a variable needs to be allocated by the NDR subsystem on pull
+sub need_alloc($)
+{
+	my $e = shift;
+
+	if (has_property($e, "ref")) {
+		return 0;
+	}
+
+	if ($e->{POINTERS} || array_size($e)) {
+		return 1;
+	}
+
+	return 0;
+}
+
+# determine the C prefix used to refer to a variable when passing to a push
+# function. This will be '*' for pointers to scalar types, '' for scalar
+# types and normal pointers and '&' for pass-by-reference structures
+sub c_push_prefix($)
+{
+	my $e = shift;
+
+	if ($e->{TYPE} =~ "string") {
+		return "";
+	}
+
+	if (is_scalar_type($e->{TYPE}) &&
+	    $e->{POINTERS}) {
+		return "*";
+	}
+	if (!is_scalar_type($e->{TYPE}) &&
+	    !$e->{POINTERS} &&
+	    !array_size($e)) {
+		return "&";
+	}
+	return "";
+}
+
+
+# determine the C prefix used to refer to a variable when passing to a pull
+# return '&' or ''
+sub c_pull_prefix($)
+{
+	my $e = shift;
+
+	if (!$e->{POINTERS} && !array_size($e)) {
+		return "&";
+	}
+
+	if ($e->{TYPE} =~ "string") {
+		return "&";
+	}
+
+	return "";
+}
+
+# determine if an element has a direct buffers component
+sub has_direct_buffers($)
+{
+	my $e = shift;
+	if ($e->{POINTERS} || array_size($e)) {
+		return 1;
+	}
+	return 0;
+}
+
+# return 1 if the string is a C constant
+sub is_constant($)
+{
+	my $s = shift;
+	if ($s =~ /^\d/) {
+		return 1;
+	}
+	return 0;
+}
+
+# return 1 if this is a fixed array
+sub is_fixed_array($)
+{
+	my $e = shift;
+	my $len = $e->{"ARRAY_LEN"};
+	if (defined $len && is_constant($len)) {
+		return 1;
+	}
+	return 0;
+}
+
+# return 1 if this is a inline array
+sub is_inline_array($)
+{
+	my $e = shift;
+	my $len = $e->{"ARRAY_LEN"};
+	if (is_fixed_array($e) ||
+	    defined $len && $len ne "*") {
+		return 1;
+	}
+	return 0;
+}
+
+1;
+