This commit was generated by cvs2svn to compensate for changes in r30,
authorAndrew Tridgell <tridge@samba.org>
Wed, 13 Aug 2003 01:53:07 +0000 (01:53 +0000)
committerAndrew Tridgell <tridge@samba.org>
Wed, 13 Aug 2003 01:53:07 +0000 (01:53 +0000)
which included commits to RCS files with non-trunk default branches.
(This used to be commit 3a69cffb062d4f1238b8cae10481c1f2ea4d3d8b)

source4/build/pidl/.cvsignore [new file with mode: 0644]
source4/build/pidl/dump.pm [new file with mode: 0644]
source4/build/pidl/eparser.pm [new file with mode: 0644]
source4/build/pidl/header.pm [new file with mode: 0644]
source4/build/pidl/idl.gram [new file with mode: 0644]
source4/build/pidl/parser.pm [new file with mode: 0644]
source4/build/pidl/pidl.pl [new file with mode: 0755]
source4/build/pidl/util.pm [new file with mode: 0644]

diff --git a/source4/build/pidl/.cvsignore b/source4/build/pidl/.cvsignore
new file mode 100644 (file)
index 0000000..bfccc9f
--- /dev/null
@@ -0,0 +1 @@
+*.pidl
\ No newline at end of file
diff --git a/source4/build/pidl/dump.pm b/source4/build/pidl/dump.pm
new file mode 100644 (file)
index 0000000..784a6f6
--- /dev/null
@@ -0,0 +1,171 @@
+###################################################
+# dump function for IDL structures
+# Copyright tridge@samba.org 2000
+# released under the GNU GPL
+
+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/source4/build/pidl/eparser.pm b/source4/build/pidl/eparser.pm
new file mode 100644 (file)
index 0000000..3cb71a6
--- /dev/null
@@ -0,0 +1,313 @@
+###################################################
+# Ethereal parser generator for IDL structures
+# Copyright tpot@samba.org 2001
+# Copyright tridge@samba.org 2000
+# released under the GNU GPL
+
+package IdlEParser;
+
+use Data::Dumper;
+
+my($res);
+
+sub is_scalar_type($)
+{
+    my($type) = shift;
+
+    return 1, if ($type eq "uint32");
+    return 1, if ($type eq "long");
+    return 1, if ($type eq "short");
+    return 1, if ($type eq "char");
+    return 1, if ($type eq "uint16");
+    return 1, if ($type eq "hyper");
+    return 1, if ($type eq "wchar_t");
+
+    return 0;
+}
+
+sub has_property($$)
+{
+    my($props) = shift;
+    my($p) = shift;
+
+    foreach my $d (@{$props}) {
+       if (ref($d) ne "HASH") {
+           return 1, if ($d eq $p);
+           return 1, if ($d eq "in,out" && ($p eq "in" || $p eq "out"));
+       } else {
+           foreach my $k (keys %{$d}) {
+               return $d->{$k}, if ($k eq $p);
+           }
+       }
+    }
+
+    return 0;
+}
+
+#####################################################################
+# parse a properties list
+sub ParseProperties($)
+{
+    my($props) = shift;
+    foreach my $d (@{$props}) {
+       if (ref($d) ne "HASH") {
+           $res .= "[$d] ";
+       } else {
+           foreach my $k (keys %{$d}) {
+               $res .= "[$k($d->{$k})] ";
+           }
+       }
+    }
+}
+
+#####################################################################
+# parse an array - called in buffers context
+sub ParseArray($)
+{
+    my($elt) = shift;
+
+    $res .= "\tfor (i = 0; i < count; i++) {\n";
+    if (is_scalar_type($elt)) {
+       $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, NULL, \"$elt->{NAME});\n";
+       $res .= "\t}\n\n";
+    } else {
+       $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, \"PARSE_SCALARS\", \"$elt->{NAME}\");\n";
+       $res .= "\t}\n\n";
+
+       $res .= "\tfor (i = 0; i < count; i++) {\n";
+       $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, \"PARSE_BUFFERS\", \"$elt->{NAME}\");\n";
+       $res .= "\t}\n\n";
+    }
+}
+
+#####################################################################
+# parse a structure element
+sub ParseElement($$)
+{
+    my($elt) = shift;
+    my($flags) = shift;
+
+    # Arg is a policy handle
+           
+    if (has_property($elt->{PROPERTIES}, "context_handle")) {
+       $res .= "\toffset = prs_policy_hnd(tvb, offset, pinfo, tree);\n";
+       return;
+    }
+
+    # Parse type
+
+    if ($flags =~ /scalars/) {
+
+       # Pointers are scalars
+
+       if ($elt->{POINTERS}) {
+           $res .= "\t\toffset = prs_ptr(tvb, offset, pinfo, tree, &ptr_$elt->{NAME}, \"$elt->{NAME}\");\n";
+       } else {
+
+           # Simple type are scalars too
+
+           if (is_scalar_type($elt->{TYPE})) {
+               $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, NULL, \"$elt->{NAME}\");\n\n";
+           }
+       }
+
+    }
+
+    if ($flags =~ /buffers/) {
+
+       # Scalars are not buffers, except if they are pointed to
+
+       if (!is_scalar_type($elt->{TYPE}) || $elt->{POINTERS}) {
+
+           # If we have a pointer, check it
+
+           if ($elt->{POINTERS}) {
+               $res .= "\t\tif (ptr_$elt->{NAME})\n\t";
+           }
+           
+           if (has_property($elt->{PROPERTIES}, "size_is")) {
+               ParseArray($elt);
+           } else {
+               $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, ";
+               if (is_scalar_type($elt->{TYPE})) {
+                   $res .= "NULL, ";
+               } else {
+                   $res .= "flags, ";
+               }
+               $res .= "\"$elt->{NAME}\");\n\n";
+           }
+       }
+    }
+
+    return;
+}
+
+#####################################################################
+# parse a struct
+sub ParseStruct($)
+{
+    my($struct) = shift;
+
+    if (defined $struct->{ELEMENTS}) {
+
+       # Parse scalars
+
+       $res .= "\tif (flags & PARSE_SCALARS) {\n";
+
+       foreach my $e (@{$struct->{ELEMENTS}}) {
+           ParseElement($e, "scalars");
+       }       
+
+       $res .= "\t}\n\n";
+
+       # Parse buffers
+
+       $res .= "\tif (flags & PARSE_BUFFERS) {\n";
+
+       foreach my $e (@{$struct->{ELEMENTS}}) {
+           ParseElement($e, "buffers");
+       }
+
+       $res .= "\t}\n\n";
+    }
+}
+
+
+#####################################################################
+# parse a union element
+sub ParseUnionElement($)
+{
+    my($element) = shift;
+    
+    $res .= "\tcase $element->{DATA}->{NAME}: \n";
+    $res .= "\t\toffset = prs_$element->{DATA}->{TYPE}(tvb, offset, pinfo, tree, \"$element->{DATA}->{NAME}\");\n\t\tbreak;\n";
+
+}
+
+#####################################################################
+# parse a union
+sub ParseUnion($)
+{
+    my($union) = shift;
+
+    $res .= "\tswitch (level) {\n";
+
+    (defined $union->{PROPERTIES}) && ParseProperties($union->{PROPERTIES});
+    foreach my $e (@{$union->{DATA}}) {
+       ParseUnionElement($e);
+    }
+    
+    $res .= "\t}\n";
+}
+
+#####################################################################
+# parse a type
+sub ParseType($)
+{
+    my($data) = shift;
+
+    if (ref($data) eq "HASH") {
+       ($data->{TYPE} eq "STRUCT") &&
+           ParseStruct($data);
+       ($data->{TYPE} eq "UNION") &&
+           ParseUnion($data);
+    } else {
+       $res .= "$data";
+    }
+}
+
+#####################################################################
+# parse a typedef
+sub ParseTypedef($)
+{
+    my($typedef) = shift;
+
+    $res .= "static int prs_$typedef->{NAME}(tvbuff_t *tvb, int offset,\
+\tpacket_info *pinfo, proto_tree *tree, int flags, char *name)\n{\n";
+    ParseType($typedef->{DATA});
+    $res .= "\treturn offset;\n";
+    $res .= "}\n\n";
+}
+
+#####################################################################
+# parse a function
+sub ParseFunctionArg($$)
+{ 
+    my($arg) = shift;
+    my($io) = shift;           # "in" or "out"
+
+    if (has_property($arg->{PROPERTIES}, $io)) {
+
+       # For some reason, pointers to elements in function definitions
+       # aren't parsed.
+
+       if (defined($arg->{POINTERS}) && !is_scalar_type($arg->{TYPE})) {
+           $arg->{POINTERS} -= 1, if ($arg->{POINTERS} > 0);
+           delete($arg->{POINTERS}), if ($arg->{POINTERS} == 0);
+       }
+
+       ParseElement($arg, "scalars|buffers");
+    }
+}
+    
+#####################################################################
+# parse a function
+sub ParseFunction($)
+{ 
+    my($function) = shift;
+
+    # Input function
+
+    $res .= "static int $function->{NAME}_q(tvbuff_t *tvb, int offset,\
+\tpacket_info *pinfo, proto_tree *tree, char *drep)\n{\n";
+
+    foreach my $arg (@{$function->{DATA}}) {
+       ParseFunctionArg($arg, "in");
+    }
+    
+    $res .= "\n\treturn offset;\n}\n\n";
+    
+    # Output function
+
+    $res .= "static int $function->{NAME}_r(tvbuff_t *tvb, int offset,\
+\tpacket_info *pinfo, proto_tree *tree, char *drep)\n{\n";
+
+    foreach my $arg (@{$function->{DATA}}) {
+       ParseFunctionArg($arg, "out");
+    }
+
+    $res .= "\n\toffset = prs_ntstatus(tvb, offset, pinfo, tree);\n";
+
+    $res .= "\n\treturn offset;\n}\n\n";
+
+}
+
+#####################################################################
+# parse the interface definitions
+sub ParseInterface($)
+{
+    my($interface) = shift;
+    my($data) = $interface->{DATA};
+    foreach my $d (@{$data}) {
+       ($d->{TYPE} eq "TYPEDEF") &&
+           ParseTypedef($d);
+       ($d->{TYPE} eq "FUNCTION") && 
+           ParseFunction($d);
+    }
+}
+
+
+#####################################################################
+# parse a parsed IDL structure back into an IDL file
+sub Parse($)
+{
+    my($idl) = shift;
+    $res = "/* parser auto-generated by pidl */\n\n";
+    foreach my $x (@{$idl}) {
+       ($x->{TYPE} eq "INTERFACE") && 
+           ParseInterface($x);
+    }
+    return $res;
+}
+
+1;
diff --git a/source4/build/pidl/header.pm b/source4/build/pidl/header.pm
new file mode 100644 (file)
index 0000000..34707f8
--- /dev/null
@@ -0,0 +1,134 @@
+###################################################
+# create C header files for an IDL structure
+# Copyright tridge@samba.org 2000
+# released under the GNU GPL
+package IdlHeader;
+
+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 the interface definitions
+sub DumpInterface($)
+{
+    my($interface) = shift;
+    my($data) = $interface->{DATA};
+    foreach my $d (@{$data}) {
+       ($d->{TYPE} eq "TYPEDEF") &&
+           DumpTypedef($d);
+    }
+}
+
+
+#####################################################################
+# dump a parsed IDL structure back into an IDL file
+sub Dump($)
+{
+    my($idl) = shift;
+    $res = "/* header auto-generated by pidl */\n\n";
+    foreach my $x (@{$idl}) {
+       ($x->{TYPE} eq "INTERFACE") && 
+           DumpInterface($x);
+    }
+    return $res;
+}
+
+1;
diff --git a/source4/build/pidl/idl.gram b/source4/build/pidl/idl.gram
new file mode 100644 (file)
index 0000000..00b3952
--- /dev/null
@@ -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/source4/build/pidl/parser.pm b/source4/build/pidl/parser.pm
new file mode 100644 (file)
index 0000000..03bc5f3
--- /dev/null
@@ -0,0 +1,145 @@
+###################################################
+# C parser generator for IDL structures
+# Copyright tridge@samba.org 2000
+# released under the GNU GPL
+
+package IdlParser;
+
+use Data::Dumper;
+
+my($res);
+
+#####################################################################
+# parse a properties list
+sub ParseProperties($)
+{
+    my($props) = shift;
+    foreach my $d (@{$props}) {
+       if (ref($d) ne "HASH") {
+           $res .= "[$d] ";
+       } else {
+           foreach my $k (keys %{$d}) {
+               $res .= "[$k($d->{$k})] ";
+           }
+       }
+    }
+}
+
+#####################################################################
+# parse a structure element
+sub ParseElement($)
+{
+    my($element) = shift;
+    (defined $element->{PROPERTIES}) && ParseProperties($element->{PROPERTIES});
+    ParseType($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}]");
+}
+
+#####################################################################
+# parse a struct
+sub ParseStruct($)
+{
+    my($struct) = shift;
+    $res .= "struct {\n";
+    if (defined $struct->{ELEMENTS}) {
+       foreach my $e (@{$struct->{ELEMENTS}}) {
+           ParseElement($e);
+           $res .= ";\n";
+       }
+    }
+    $res .= "}";
+}
+
+
+#####################################################################
+# parse a union element
+sub ParseUnionElement($)
+{
+    my($element) = shift;
+    $res .= "[case($element->{CASE})] ";
+    ParseElement($element->{DATA});
+    $res .= ";\n";
+}
+
+#####################################################################
+# parse a union
+sub ParseUnion($)
+{
+    my($union) = shift;
+    (defined $union->{PROPERTIES}) && ParseProperties($union->{PROPERTIES});
+    $res .= "union {\n";
+    foreach my $e (@{$union->{DATA}}) {
+       ParseUnionElement($e);
+    }
+    $res .= "}";
+}
+
+#####################################################################
+# parse a type
+sub ParseType($)
+{
+    my($data) = shift;
+    if (ref($data) eq "HASH") {
+       ($data->{TYPE} eq "STRUCT") &&
+           ParseStruct($data);
+       ($data->{TYPE} eq "UNION") &&
+           ParseUnion($data);
+    } else {
+       $res .= "$data";
+    }
+}
+
+#####################################################################
+# parse a typedef
+sub ParseTypedef($)
+{
+    my($typedef) = shift;
+    $res .= "typedef ";
+    ParseType($typedef->{DATA});
+    $res .= " $typedef->{NAME};\n\n";
+}
+
+#####################################################################
+# parse a function
+sub ParseFunction($)
+{ 
+    my($function) = shift;
+    $res .= "/* ignoring function $function->{NAME} */\n";
+}
+
+#####################################################################
+# parse the interface definitions
+sub ParseInterface($)
+{
+    my($interface) = shift;
+    my($data) = $interface->{DATA};
+    foreach my $d (@{$data}) {
+       ($d->{TYPE} eq "TYPEDEF") &&
+           ParseTypedef($d);
+       ($d->{TYPE} eq "FUNCTION") && 
+           ParseFunction($d);
+    }
+}
+
+
+#####################################################################
+# parse a parsed IDL structure back into an IDL file
+sub Parse($)
+{
+    my($idl) = shift;
+    $res = "/* parser auto-generated by pidl */\n\n";
+    foreach my $x (@{$idl}) {
+       ($x->{TYPE} eq "INTERFACE") && 
+           ParseInterface($x);
+    }
+    return $res;
+}
+
+1;
diff --git a/source4/build/pidl/pidl.pl b/source4/build/pidl/pidl.pl
new file mode 100755 (executable)
index 0000000..6b32ade
--- /dev/null
@@ -0,0 +1,130 @@
+#!/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 header;
+use parser;
+use eparser;
+use util;
+
+my($opt_help) = 0;
+my($opt_parse) = 0;
+my($opt_dump) = 0;
+my($opt_diff) = 0;
+my($opt_header) = 0;
+my($opt_parser) = 0;
+my($opt_eparser) = 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);
+    my($saved_sep) = $/;
+    undef $/;
+    my($idl) = $parser->idl(`cpp $filename`);
+    $/ = $saved_sep;
+    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
+             --header              create a C header file
+             --parser              create a C parser
+             --eparser             create an ethereal parser
+             --diff                run diff on the idl and dumped output
+           \n";
+    exit(0);
+}
+
+# main program
+GetOptions (
+           'help|h|?' => \$opt_help, 
+           'parse' => \$opt_parse,
+           'dump' => \$opt_dump,
+           'header' => \$opt_header,
+           'parser' => \$opt_parser,
+           'eparser' => \$opt_eparser,
+           'diff' => \$opt_diff
+           );
+
+if ($opt_help) {
+    ShowHelp();
+    exit(0);
+}
+
+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_parse) {
+    print "Generating $pidl_file\n";
+    my($idl) = IdlParse($idl_file);
+    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_header) {
+    my($idl) = util::LoadStructure($pidl_file);
+    my($header) = util::ChangeExtension($idl_file, "h");
+    print "Generating $header\n";
+    util::FileSave($header, IdlHeader::Dump($idl));
+}
+
+if ($opt_parser) {
+    my($idl) = util::LoadStructure($pidl_file);
+    my($parser) = util::ChangeExtension($idl_file, "c");
+    print "Generating $parser\n";
+    util::FileSave($parser, IdlParser::Parse($idl));
+}
+
+if ($opt_eparser) {
+    my($idl) = util::LoadStructure($pidl_file);
+    my($parser) = util::ChangeExtension($idl_file, "c");
+    print "Generating $parser for ethereal\n";
+    util::FileSave($parser, IdlEParser::Parse($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/source4/build/pidl/util.pm b/source4/build/pidl/util.pm
new file mode 100644 (file)
index 0000000..f0e3c2a
--- /dev/null
@@ -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 (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) { 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;