summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--source4/build/pidl/.cvsignore1
-rw-r--r--source4/build/pidl/dump.pm171
-rw-r--r--source4/build/pidl/eparser.pm313
-rw-r--r--source4/build/pidl/header.pm134
-rw-r--r--source4/build/pidl/idl.gram135
-rw-r--r--source4/build/pidl/parser.pm145
-rwxr-xr-xsource4/build/pidl/pidl.pl130
-rw-r--r--source4/build/pidl/util.pm128
8 files changed, 1157 insertions, 0 deletions
diff --git a/source4/build/pidl/.cvsignore b/source4/build/pidl/.cvsignore
new file mode 100644
index 0000000000..bfccc9fde5
--- /dev/null
+++ b/source4/build/pidl/.cvsignore
@@ -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
index 0000000000..784a6f6f1b
--- /dev/null
+++ b/source4/build/pidl/dump.pm
@@ -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
index 0000000000..3cb71a6c7e
--- /dev/null
+++ b/source4/build/pidl/eparser.pm
@@ -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
index 0000000000..34707f8672
--- /dev/null
+++ b/source4/build/pidl/header.pm
@@ -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
index 0000000000..00b3952ba2
--- /dev/null
+++ b/source4/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/source4/build/pidl/parser.pm b/source4/build/pidl/parser.pm
new file mode 100644
index 0000000000..03bc5f3aff
--- /dev/null
+++ b/source4/build/pidl/parser.pm
@@ -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
index 0000000000..6b32ade75a
--- /dev/null
+++ b/source4/build/pidl/pidl.pl
@@ -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
index 0000000000..f0e3c2a2f8
--- /dev/null
+++ b/source4/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 (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;
generated by cgit (git 2.34.1) at 2024-11-10 16:44:46 +0000