first version

4 files changed, 524 insertions, 0 deletions

diff --git a/source/build/pidl/dump.pm b/source/build/pidl/dump.pm
new file mode 100644
index 00000000000..4d679c0653e
--- /dev/null
+++ b/source/build/pidl/dump.pm
@@ -0,0 +1,166 @@
+package IdlDump;
+
+use Data::Dumper;
+
+my($res);
+
+#####################################################################
+# dump a properties list
+sub DumpProperties($)
+{
+    my($props) = shift;
+    foreach my $d (@{$props}) {
+	if (ref($d) ne "HASH") {
+	    $res .= "[$d] ";
+	} else {
+	    foreach my $k (keys %{$d}) {
+		$res .= "[$k($d->{$k})] ";
+	    }
+	}
+    }
+}
+
+#####################################################################
+# dump a structure element
+sub DumpElement($)
+{
+    my($element) = shift;
+    (defined $element->{PROPERTIES}) && DumpProperties($element->{PROPERTIES});
+    DumpType($element->{TYPE});
+    $res .= " ";
+    if ($element->{POINTERS}) {
+	for (my($i)=0; $i < $element->{POINTERS}; $i++) {
+	    $res .= "*";
+	}
+    }
+    $res .= "$element->{NAME}";
+    (defined $element->{ARRAY_LEN}) && ($res .= "[$element->{ARRAY_LEN}]");
+}
+
+#####################################################################
+# dump a struct
+sub DumpStruct($)
+{
+    my($struct) = shift;
+    $res .= "struct {\n";
+    if (defined $struct->{ELEMENTS}) {
+	foreach my $e (@{$struct->{ELEMENTS}}) {
+	    DumpElement($e);
+	    $res .= ";\n";
+	}
+    }
+    $res .= "}";
+}
+
+
+#####################################################################
+# dump a union element
+sub DumpUnionElement($)
+{
+    my($element) = shift;
+    $res .= "[case($element->{CASE})] ";
+    DumpElement($element->{DATA});
+    $res .= ";\n";
+}
+
+#####################################################################
+# dump a union
+sub DumpUnion($)
+{
+    my($union) = shift;
+    (defined $union->{PROPERTIES}) && DumpProperties($union->{PROPERTIES});
+    $res .= "union {\n";
+    foreach my $e (@{$union->{DATA}}) {
+	DumpUnionElement($e);
+    }
+    $res .= "}";
+}
+
+#####################################################################
+# dump a type
+sub DumpType($)
+{
+    my($data) = shift;
+    if (ref($data) eq "HASH") {
+	($data->{TYPE} eq "STRUCT") &&
+	    DumpStruct($data);
+	($data->{TYPE} eq "UNION") &&
+	    DumpUnion($data);
+    } else {
+	$res .= "$data";
+    }
+}
+
+#####################################################################
+# dump a typedef
+sub DumpTypedef($)
+{
+    my($typedef) = shift;
+    $res .= "typedef ";
+    DumpType($typedef->{DATA});
+    $res .= " $typedef->{NAME};\n\n";
+}
+
+#####################################################################
+# dump a typedef
+sub DumpFunction($)
+{
+    my($function) = shift;
+    my($first) = 1;
+    DumpType($function->{RETURN_TYPE});
+    $res .= " $function->{NAME}(\n";
+    for my $d (@{$function->{DATA}}) {
+	$first || ($res .= ",\n"); $first = 0;
+	DumpElement($d);
+    }
+    $res .= "\n);\n\n";
+}
+
+#####################################################################
+# dump a module header
+sub DumpModuleHeader($)
+{
+    my($header) = shift;
+    my($data) = $header->{DATA};
+    my($first) = 1;
+    $res .= "[\n";
+    foreach my $k (keys %{$data}) {
+	    $first || ($res .= ",\n"); $first = 0;
+	    $res .= "$k($data->{$k})";
+    }
+    $res .= "\n]\n";
+}
+
+#####################################################################
+# dump the interface definitions
+sub DumpInterface($)
+{
+    my($interface) = shift;
+    my($data) = $interface->{DATA};
+    $res .= "interface $interface->{NAME}\n{\n";
+    foreach my $d (@{$data}) {
+	($d->{TYPE} eq "TYPEDEF") &&
+	    DumpTypedef($d);
+	($d->{TYPE} eq "FUNCTION") &&
+	    DumpFunction($d);
+    }
+    $res .= "}\n";
+}
+
+
+#####################################################################
+# dump a parsed IDL structure back into an IDL file
+sub Dump($)
+{
+    my($idl) = shift;
+    $res = "/* Dumped by pidl */\n\n";
+    foreach my $x (@{$idl}) {
+	($x->{TYPE} eq "MODULEHEADER") && 
+	    DumpModuleHeader($x);
+	($x->{TYPE} eq "INTERFACE") && 
+	    DumpInterface($x);
+    }
+    return $res;
+}
+
+1;
diff --git a/source/build/pidl/idl.gram b/source/build/pidl/idl.gram
new file mode 100644
index 00000000000..00b3952ba2d
--- /dev/null
+++ b/source/build/pidl/idl.gram
@@ -0,0 +1,135 @@
+{
+	use util;
+}
+
+idl: cpp_prefix(s?) module_header interface 
+   { [$item{module_header}, $item{interface}] }
+   | <error>
+
+module_header: '[' <commit> module_param(s /,/) ']' 
+          {{ 
+              "TYPE" => "MODULEHEADER", 
+              "DATA" => util::FlattenHash($item[3])
+          }}
+	      | <error?>
+
+module_param: identifier '(' text ')'
+          {{ "$item{identifier}" => "$item{text}" }}
+          | <error>
+
+interface: 'interface' <commit> identifier '{' definition(s?) '}' 
+          {{
+                       "TYPE" => "INTERFACE", 
+		       "NAME" => $item{identifier},
+		       "DATA" => $item[5]
+          }}
+          | <error?>
+
+definition : typedef { $item[1] }
+             | function { $item[1] }
+
+typedef : 'typedef' <commit> type identifier array_len(?) ';' 
+        {{
+                     "TYPE" => "TYPEDEF", 
+		     "NAME" => $item{identifier},
+		     "DATA" => $item{type},
+		     "ARRAY_LEN" => $item{array_len}[0]
+        }}
+        | <error?>
+
+struct: 'struct' <commit> '{' element_list1(?) '}' 
+        {{
+                     "TYPE" => "STRUCT", 
+		     "ELEMENTS" => util::FlattenArray($item{element_list1})
+        }}
+      | <error?>
+
+union: property_list(s?) 'union' <commit> '{' union_element(s?) '}' 
+	 {{
+		"TYPE" => "UNION",
+		"PROPERTIES" => util::FlattenArray($item[1]),
+		"DATA" => $item{union_element}
+	 }}
+	 | <error?>
+
+union_element: '[case(' constant ')]' base_element ';'
+	 {{
+		"TYPE" => "UNION_ELEMENT",
+		"CASE" => $item{constant},
+		"DATA" => $item{base_element}
+	 }}
+         | 'case(' constant ')' base_element ';'
+	 {{
+		"TYPE" => "UNION_ELEMENT",
+		"CASE" => $item{constant},
+		"DATA" => $item{base_element}
+	 }}
+
+base_element: property_list(s?) type pointer(s?) identifier array_len(?) 
+	      {{
+			   "NAME" => $item{identifier},
+			   "TYPE" => $item{type},
+			   "PROPERTIES" => util::FlattenArray($item[1]),
+			   "POINTERS" => $#{$item{pointer}}==-1?undef:$#{$item{pointer}}+1,
+			   "ARRAY_LEN" => $item{array_len}[0]
+              }}
+            | <error>
+
+array_len: '[' <commit> constant ']' 
+         { $item{constant} }
+         | <error?>
+
+element_list1: base_element(s? /;/) ';' 
+	       { $item[1] }
+
+element_list2: 'void' 
+         | base_element(s? /,/)
+         { $item[1] }
+
+pointer: '*'
+
+property_list: '[' <commit> property(s /,/) ']' 
+	      { $item[3] }
+             | <error?>
+
+property: 'unique' 
+	  | 'in,out'
+	  | 'in'
+	  | 'out'
+	  | 'ref'
+	  | 'context_handle'
+	  | 'string'
+	  | 'byte_count_pointer' '(' expression ')' {{ "$item[1]" => "$item{expression}" }}
+          | 'size_is' '(' expression ')' {{ "$item[1]" => "$item{expression}" }}
+          | 'length_is' '(' expression ')' {{ "$item[1]" => "$item{expression}" }}
+          | 'switch_is' '(' expression ')' {{ "$item[1]" => "$item{expression}" }}
+          | 'switch_type' '(' type ')' {{ "$item[1]" => $item{type} }}
+
+identifier: /[\w?]+/
+
+expression: /[\w?\/+*-]+/
+
+function : type identifier '(' <commit> element_list2 ');' 
+	 {{
+		"TYPE" => "FUNCTION",
+		"NAME" => $item{identifier},
+		"RETURN_TYPE" => $item{type},
+		"DATA" => $item{element_list2}
+	 }}
+         | <error?>
+
+type : 
+       'unsigned' type { "$item[1] $item[2]" }
+     | 'long'    { $item[1] }
+     | 'string'  { $item[1] }
+     | 'wchar_t' { $item[1] }
+     | struct    { $item[1] }
+     | union     { $item[1] }
+     | identifier { $item[1] }
+     | <error>
+
+text: /[\w\s.?-]*/
+
+constant: /-?\d+/
+
+cpp_prefix: '#' /.*/
diff --git a/source/build/pidl/pidl.pl b/source/build/pidl/pidl.pl
new file mode 100755
index 00000000000..45aec06c023
--- /dev/null
+++ b/source/build/pidl/pidl.pl
@@ -0,0 +1,95 @@
+#!/usr/bin/perl -w
+
+###################################################
+# package to parse IDL files and generate code for 
+# rpc functions in Samba
+# Copyright tridge@samba.org 2000
+# released under the GNU GPL
+
+use strict;
+use Getopt::Long;
+use Data::Dumper;
+use Parse::RecDescent;
+use dump;
+use util;
+
+my($opt_help) = 0;
+my($opt_parse) = 0;
+my($opt_dump) = 0;
+my($opt_diff) = 0;
+
+#####################################################################
+# parse an IDL file returning a structure containing all the data
+sub IdlParse($)
+{
+    # this autoaction allows us to handle simple nodes without an action
+#    $::RD_TRACE = 1;
+    $::RD_AUTOACTION = q { 
+                          $#item==1 && ref($item[1]) eq "" ? 
+                          $item[1] : 
+                          "XX_" . $item[0] . "_XX[$#item]"  };
+    my($filename) = shift;
+    my($grammer) = util::FileLoad("idl.gram");    
+    my($parser) = Parse::RecDescent->new($grammer);
+    undef $/;
+    my($idl) = $parser->idl(`cpp $filename`);
+    util::CleanData($idl);
+    return $idl;
+}
+
+
+#########################################
+# display help text
+sub ShowHelp()
+{
+    print "
+           perl IDL parser and code generator
+           Copyright tridge\@samba.org
+
+           Usage: pidl.pl [options] <idlfile>
+
+           Options:
+             --help                this help page
+             --parse               parse a idl file to a .pidl file
+             --dump                dump a pidl file back to idl
+             --diff                run diff on the idl and dumped output
+           ";
+    exit(0);
+}
+
+# main program
+GetOptions (
+	    'help|h|?' => \$opt_help, 
+	    'parse' => \$opt_parse,
+	    'dump' => \$opt_dump,
+	    'diff' => \$opt_diff
+	    );
+
+my($idl_file) = shift;
+die "ERROR: You must specify an idl file to process" unless ($idl_file);
+
+my($pidl_file) = util::ChangeExtension($idl_file, "pidl");
+
+if ($opt_help) {
+    ShowHelp();
+}
+
+if ($opt_parse) {
+    print "Parsing $idl_file\n";
+    my($idl) = IdlParse($idl_file);
+    print "Saving $pidl_file\n";
+    util::SaveStructure($pidl_file, $idl) || die "Failed to save $pidl_file";
+}
+
+if ($opt_dump) {
+    my($idl) = util::LoadStructure($pidl_file);
+    print IdlDump::Dump($idl);
+}
+
+if ($opt_diff) {
+    my($idl) = util::LoadStructure($pidl_file);
+    my($tempfile) = util::ChangeExtension($idl_file, "tmp");
+    util::FileSave($tempfile, IdlDump::Dump($idl));
+    system("diff -wu $idl_file $tempfile");
+    unlink($tempfile);
+}
diff --git a/source/build/pidl/util.pm b/source/build/pidl/util.pm
new file mode 100644
index 00000000000..c0182bb79e8
--- /dev/null
+++ b/source/build/pidl/util.pm
@@ -0,0 +1,128 @@
+###################################################
+# utility functions to support pidl
+# Copyright tridge@samba.org 2000
+# released under the GNU GPL
+package util;
+
+use Data::Dumper;
+
+
+#####################################################################
+# 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 (%{$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) { delete($v->[$i]); 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) || die "can't open $filename";    
+    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";
+}
+
+#####################################################################
+# save a data structure into a file
+sub SaveStructure($$)
+{
+    my($filename) = shift;
+    my($v) = shift;
+    FileSave($filename, Dumper($v));
+}
+
+#####################################################################
+# load a data structure from a file (as saved with SaveStructure)
+sub LoadStructure($)
+{
+    return eval FileLoad(shift);
+}
+
+
+1;