From 8991c6cd96a6f635dffdb77390b09483bcad1c05 Mon Sep 17 00:00:00 2001 From: Stefan Metzmacher Date: Wed, 30 Jun 2004 17:35:26 +0000 Subject: 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) --- source4/build/pasn1/util.pm | 379 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 379 insertions(+) create mode 100644 source4/build/pasn1/util.pm (limited to 'source4/build/pasn1/util.pm') 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) = ; + 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; + -- cgit