diff options
| -rw-r--r-- | source4/build/pasn1/Makefile | 5 | ||||
| -rw-r--r-- | source4/build/pasn1/asn1.yp | 271 | ||||
| -rwxr-xr-x | source4/build/pasn1/pasn1.pl | 114 | ||||
| -rw-r--r-- | source4/build/pasn1/util.pm | 379 |
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; + |