summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefan Metzmacher <metze@samba.org>2004-06-30 17:35:26 +0000
committerGerald (Jerry) Carter <jerry@samba.org>2007-10-10 12:56:49 -0500
commit8991c6cd96a6f635dffdb77390b09483bcad1c05 (patch)
tree022033356fe734434654465ec9e6682b068b3a63
parentfb667783ac59959ac37f1ae8b6b29c32addc5e1b (diff)
downloadsamba-8991c6cd96a6f635dffdb77390b09483bcad1c05.tar.gz
samba-8991c6cd96a6f635dffdb77390b09483bcad1c05.tar.bz2
samba-8991c6cd96a6f635dffdb77390b09483bcad1c05.zip
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)
-rw-r--r--source4/build/pasn1/Makefile5
-rw-r--r--source4/build/pasn1/asn1.yp271
-rwxr-xr-xsource4/build/pasn1/pasn1.pl114
-rw-r--r--source4/build/pasn1/util.pm379
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;
+