+++ /dev/null
-########################
-# ASN.1 Parse::Yapp parser
-# Copyright (C) Stefan (metze) Metzmacher <metze@samba.org>
-# released under the GNU GPL version 3 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:
- identifier asn1_definitions asn1_delimitter asn1_begin asn1_decls asn1_end
- {{
- "OBJECT" => "ASN1_DEFINITION",
- "IDENTIFIER" => $_[1],
- "DATA" => $_[5]
- }}
-;
-
-asn1_delimitter:
- delimitter
-;
-
-asn1_definitions:
- 'DEFINITIONS'
-;
-
-asn1_begin:
- 'BEGIN'
-;
-
-asn1_end:
- 'END'
-;
-
-asn1_decls:
- asn1_def
- { [ $_[1] ] }
- | asn1_decls asn1_def
- { push(@{$_[1]}, $_[2]); $_[1] }
-;
-
-
-
-asn1_def:
- asn1_target asn1_delimitter asn1_application asn1_type
- {{
- "OBJECT" => "ASN1_DEF",
- "IDENTIFIER" => $_[1],
- "APPLICATION" => $_[3],
- "STRUCTURE" => $_[4]
- }}
-;
-
-asn1_target:
- identifier
-;
-
-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
- | identifier
-;
-
-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]" }
-;
-
-delimitter: DELIMITTER
-;
-
-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/^(--.*\n)//) {
- $parser->YYData->{LINE}++;
- goto again;
- }
- if (s/^(::=)//) {
- $parser->YYData->{LAST_TOKEN} = $1;
- return('DELIMITTER',$1);
- }
- 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|DEFINITIONS|BEGIN|END)$/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 );
-}
+++ /dev/null
-#!/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_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
- \n";
- exit(0);
-}
-
-# main program
-GetOptions (
- 'help|h|?' => \$opt_help,
- 'output|o=s' => \$opt_output,
- );
-
-if ($opt_help) {
- ShowHelp();
- exit(0);
-}
-
-sub process_file($)
-{
- my $input_file = shift;
- my $output_file;
- my $pasn1;
-
- my $basename = basename($input_file, ".asn1");
-
- if (!defined($opt_output)) {
- $output_file = util::ChangeExtension($input_file, ".pasn1");
- } else {
- $output_file = $opt_output;
- }
-
-# if (file is .pasn1) {
-# $pasn1 = util::LoadStructure($pasn1_file);
-# defined $pasn1 || die "Failed to load $pasn1_file - maybe you need --parse\n";
-# } else {
- $pasn1 = ASN1Parse($input_file);
- defined $pasn1 || die "Failed to parse $input_file";
- util::SaveStructure($output_file, $pasn1) ||
- die "Failed to save $output_file\n";
- #}
-}
-
-foreach my $filename (@ARGV) {
- process_file($filename);
-}
+++ /dev/null
-###################################################
-# 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;
-
projects / thirdparty / samba.git / commitdiff
