r4770: Change from processing ndr_*.[ch] files all at once to line-by-line.
[ira/wip.git] / source / build / pidl / eparser.pm
index 02c4063102c27b4425910baff15d554fc080d7c0..92467a62113a27d5d69405df58648eeab71be921 100644 (file)
 ###################################################
-# parser generator for IDL structures
-# Copyright tpot@samba.org 2001
-# Copyright tridge@samba.org 2000
+# Samba4 parser generator for IDL structures
+# Copyright tridge@samba.org 2000-2003
+# Copyright tpot@samba.org 2001,2004
 # released under the GNU GPL
 
 package IdlEParser;
 
-use Data::Dumper;
+use strict;
 
-my($res);
+# the list of needed functions
+my %needed;
 
-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);
-           }
-       }
-    }
+my $module;
+my $if_uuid;
+my $if_version;
+my $if_endpoints;
 
-    return 0;
+sub pidl($)
+{
+       print OUT shift;
 }
 
 #####################################################################
-# parse a properties list
-sub ParseProperties($)
+# work out is a parse function should be declared static or not
+sub fn_prefix($)
 {
-    my($props) = shift;
-    foreach my $d (@{$props}) {
-       if (ref($d) ne "HASH") {
-           $res .= "[$d] ";
-       } else {
-           foreach my $k (keys %{$d}) {
-               $res .= "[$k($d->{$k})] ";
-           }
+       my $fn = shift;
+       if ($fn->{TYPE} eq "TYPEDEF") {
+               if (util::has_property($fn, "public")) {
+                       return "";
+               }
        }
-    }
+
+       if ($fn->{TYPE} eq "FUNCTION") {
+               if (util::has_property($fn, "public")) {
+                       return "";
+               }
+       }
+       return "static ";
 }
 
+
 #####################################################################
-# parse an array - called in buffers context
-sub ParseArray($)
-{
-    my($elt) = shift;
+# parse a function
+sub ParseFunctionPull($)
+{ 
+       my($fn) = shift;
+       my $static = fn_prefix($fn);
 
-    $res .= "\tfor (i = 0; i < count; i++) {\n";
-    if (util::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";
+       # request function
+       pidl "int $fn->{NAME}_rqst(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *tree, guint8 *drep)\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";
-    }
+       pidl "\tstruct pidl_pull *ndr = pidl_pull_init(tvb, offset, pinfo, drep);\n";
+       pidl "\tstruct $fn->{NAME} *r = talloc_p(NULL, struct $fn->{NAME});\n";
+       pidl "\tpidl_tree ptree;\n\n";
+
+       pidl "\tptree.proto_tree = tree;\n";
+       pidl "\tptree.subtree_list = NULL;\n\n";
+
+       pidl "\tndr_pull_$fn->{NAME}(ndr, NDR_IN, &ptree, r);\n";
+
+       pidl "\n\treturn ndr->offset;\n";
+       pidl "}\n\n";
+
+       # response function
+       pidl "int $fn->{NAME}_resp(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *tree, guint8 *drep)\n{\n";
+
+       pidl "\tstruct pidl_pull *ndr = pidl_pull_init(tvb, offset, pinfo, drep);\n";
+       pidl "\tstruct $fn->{NAME} *r = talloc_p(NULL, struct $fn->{NAME});\n";
+       pidl "\tpidl_tree ptree;\n\n";
+
+       pidl "\tptree.proto_tree = tree;\n";
+       pidl "\tptree.subtree_list = NULL;\n\n";
+
+       pidl "\tndr_pull_$fn->{NAME}(ndr, NDR_OUT, &ptree, r);\n";
+
+       pidl "\n\treturn ndr->offset;\n";
+       pidl "}\n\n";
 }
 
 #####################################################################
-# parse a structure element
-sub ParseElement($$)
+# produce a function call table
+sub FunctionTable($)
 {
-    my($elt) = shift;
-    my($flags) = shift;
+       my($interface) = shift;
+       my($data) = $interface->{DATA};
+
+       pidl "static dcerpc_sub_dissector dcerpc_dissectors[] = {\n";
+       my $num = 0;
+       foreach my $d (@{$data}) {
+               if ($d->{TYPE} eq "FUNCTION") {
+                   # Strip module name from function name, if present
+                   my($n) = $d->{NAME};
+                   $n = substr($d->{NAME}, length($module) + 1),
+                       if $module eq substr($d->{NAME}, 0, length($module));
+                   pidl "\t{ $num, \"$n\",\n";
+                   pidl "\t\t$d->{NAME}_rqst,\n";
+                   pidl "\t\t$d->{NAME}_resp },\n";
+                   $num++;
+               }
+       }
+       pidl "};\n\n";
+}
 
-    # Arg is a policy handle
-           
-    if (util::has_property($elt, "context_handle")) {
-       $res .= "\toffset = prs_policy_hnd(tvb, offset, pinfo, tree);\n";
-       return;
-    }
+sub type2ft($)
+{
+    my($t) = shift;
+    return "FT_UINT$1" if $t =~ /uint(8|16|32|64)/;
+    return "FT_INT$1" if $t =~ /int(8|16|32|64)/;
+    return "FT_UINT64", if ($t eq "HYPER_T" or $t eq "NTTIME");
+    
+    # Type is an enum
 
-    # Parse type
+    return "FT_UINT16";
+}
 
-    if ($flags =~ /scalars/) {
+# Determine the display base for an element
 
-       # Pointers are scalars
+sub elementbase($)
+{
+    my($e) = shift;
 
-       if ($elt->{POINTERS}) {
-           $res .= "\t\toffset = prs_ptr(tvb, offset, pinfo, tree, &ptr_$elt->{NAME}, \"$elt->{NAME}\");\n";
-       } else {
+    if (my $base = util::has_property($e, "display")) {
+       return "BASE_" . uc($base);
+    }
+    return "BASE_DEC", if $e->{TYPE} eq "ENUM";
+    return "BASE_DEC", if $e->{TYPE} =~ /u?int(8|16|32|64)/;
+    return "BASE_DEC", if $e->{TYPE} eq "NTTIME" or $e->{TYPE} eq "HYPER_T";
 
-           # Simple type are scalars too
+    # Probably an enum
 
-           if (util::is_scalar_type($elt->{TYPE})) {
-               $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, NULL, \"$elt->{NAME}\");\n\n";
-           }
-       }
+    return "BASE_DEC";
+}
 
-    }
+# Convert a IDL structure field name (e.g access_mask) to a prettier
+# string like 'Access Mask'.
 
-    if ($flags =~ /buffers/) {
+sub field2name($)
+{
+    my($field) = shift;
 
-       # Scalars are not buffers, except if they are pointed to
+    $field =~ s/_/ /g;         # Replace underscores with spaces
+    $field =~ s/(\w+)/\u\L$1/g;        # Capitalise each word
+    
+    return $field;
+}
 
-       if (!util::is_scalar_type($elt->{TYPE}) || $elt->{POINTERS}) {
+sub NeededFunction($)
+{
+       my $fn = shift;
+       $needed{"pull_$fn->{NAME}"} = 1;
+       foreach my $e (@{$fn->{DATA}}) {
+               $e->{PARENT} = $fn;
+               $needed{"pull_$e->{TYPE}"} = 1;
+
+               if (util::is_scalar_type($e->{TYPE})) {
+                   $needed{"hf_$e->{NAME}_$e->{TYPE}"} = {
+                       'name' => field2name($e->{NAME}),
+                       'type' => $e->{TYPE},
+                       'ft'   => type2ft($e->{TYPE}),
+                       'base' => elementbase($e)
+                       }, if !defined($needed{"hf_$e->{NAME}_$e->{TYPE}"});
+                   $e->{PARENT} = $fn;
+               } else {
+                   $needed{"ett_$e->{TYPE}"} = 1;
+               }
+       }
+}
 
-           # If we have a pointer, check it
+sub NeededTypedef($)
+{
+       my $t = shift;
+       if (util::has_property($t, "public")) {
+               $needed{"pull_$t->{NAME}"} = 1;
+       }
 
-           if ($elt->{POINTERS}) {
-               $res .= "\t\tif (ptr_$elt->{NAME})\n\t";
-           }
+       if ($t->{DATA}->{TYPE} eq "STRUCT") {
+
+           for my $e (@{$t->{DATA}->{ELEMENTS}}) {
+               $e->{PARENT} = $t->{DATA};
+               if ($needed{"pull_$t->{NAME}"}) {
+                   $needed{"pull_$e->{TYPE}"} = 1;
+               }
            
-           if (util::has_property($elt, "size_is")) {
-               ParseArray($elt);
-           } else {
-               $res .= "\t\toffset = prs_$elt->{TYPE}(tvb, offset, pinfo, tree, ";
-               if (util::is_scalar_type($elt->{TYPE})) {
-                   $res .= "NULL, ";
+               if (util::is_scalar_type($e->{TYPE})) {
+               
+                   if (defined($e->{ARRAY_LEN}) or 
+                       util::has_property($e, "size_is")) {
+
+                       # Arrays of scalar types are FT_BYTES
+                   
+                       $needed{"hf_$e->{NAME}_$e->{TYPE}_array"} = {
+                           'name' => field2name($e->{NAME}),
+                           'type' => $e->{TYPE},
+                           'ft'   => "FT_BYTES",
+                           'base' => elementbase($e)
+                           };
+
+                   } else {
+                       $needed{"hf_$e->{NAME}_$e->{TYPE}"} = {
+                           'name' => field2name($e->{NAME}),
+                           'type' => $e->{TYPE},
+                           'ft'   => type2ft($e->{TYPE}),
+                           'base' => elementbase($e)
+                           };
+                   }
+                   
+                   $e->{PARENT} = $t->{DATA};
+                   
+                   if ($needed{"pull_$t->{NAME}"}) {
+                       $needed{"pull_$e->{TYPE}"} = 1;
+                   }
+
                } else {
-                   $res .= "flags, ";
+                   
+                   $needed{"ett_$e->{TYPE}"} = 1;
+                   
                }
-               $res .= "\"$elt->{NAME}\");\n\n";
            }
        }
-    }
 
-    return;
+       if ($t->{DATA}->{TYPE} eq "UNION") {
+               for my $e (@{$t->{DATA}->{DATA}}) {
+                       $e->{PARENT} = $t->{DATA};
+                       if ($e->{TYPE} eq "UNION_ELEMENT") {
+                               if ($needed{"pull_$t->{NAME}"}) {
+                                       $needed{"pull_$e->{DATA}->{TYPE}"} = 1;
+                               }
+                               $needed{"ett_$e->{DATA}{TYPE}"} = 1;
+                       }
+               }
+
+           $needed{"ett_$t->{NAME}"} = 1;
+       }
+
+       if ($t->{DATA}->{TYPE} eq "ENUM") {
+           $needed{"hf_$t->{NAME}"} = {
+               'name' => $t->{NAME},
+               'ft' => 'FT_UINT16',
+               'base' => 'BASE_DEC'
+               };
+       }
 }
 
 #####################################################################
-# parse a struct
-sub ParseStruct($)
+# work out what parse functions are needed
+sub BuildNeeded($)
 {
-    my($struct) = shift;
+       my($interface) = shift;
+       my($data) = $interface->{DATA};
+       foreach my $d (@{$data}) {
+               ($d->{TYPE} eq "FUNCTION") && 
+                   NeededFunction($d);
+       }
+       foreach my $d (reverse @{$data}) {
+               ($d->{TYPE} eq "TYPEDEF") &&
+                   NeededTypedef($d);
+       }
+}
 
-    if (defined $struct->{ELEMENTS}) {
+#####################################################################
+# parse the interface definitions
+sub ModuleHeader($)
+{
+    my($h) = shift;
 
-       # Parse scalars
+    $if_uuid = $h->{PROPERTIES}->{uuid};
+    $if_version = $h->{PROPERTIES}->{version};
+    $if_endpoints = $h->{PROPERTIES}->{endpoints};
+}
 
-       $res .= "\tif (flags & PARSE_SCALARS) {\n";
+#####################################################################
+# Generate a header file that contains function prototypes for 
+# structs and typedefs.
+sub ParseHeader($$)
+{
+       my($idl) = shift;
+       my($filename) = shift;
 
-       foreach my $e (@{$struct->{ELEMENTS}}) {
-           ParseElement($e, "scalars");
-       }       
+       open(OUT, ">$filename") || die "can't open $filename";    
 
-       $res .= "\t}\n\n";
+       pidl "/* parser auto-generated by pidl */\n\n";
 
-       # Parse buffers
+       foreach my $x (@{$idl}) {
+           if ($x->{TYPE} eq "INTERFACE") { 
+               foreach my $d (@{$x->{DATA}}) {
 
-       $res .= "\tif (flags & PARSE_BUFFERS) {\n";
+                   # Make prototypes for [public] structures and
+                   # unions.
 
-       foreach my $e (@{$struct->{ELEMENTS}}) {
-           ParseElement($e, "buffers");
+                   if ($d->{TYPE} eq "TYPEDEF" and 
+                       util::has_property($d, "public")) {
+                       
+                       if ($d->{DATA}{TYPE} eq "STRUCT") { 
+                           pidl "void ndr_pull_$d->{NAME}(struct ndr_pull *ndr, int ndr_flags, proto_tree *tree, struct $d->{NAME} *r);\n\n";
+                       }
+
+                       if ($d->{DATA}{TYPE} eq "UNION") {
+                           pidl "void ndr_pull_$d->{NAME}(struct ndr_pull *ndr, int ndr_flags, proto_tree *tree, union $d->{NAME} *r, uint16 level);\n\n";
+                       }
+                   }
+               }
+           }
        }
 
-       $res .= "\t}\n\n";
-    }
+       close(OUT);
 }
 
-
 #####################################################################
-# parse a union element
-sub ParseUnionElement($)
+# rewrite autogenerated header file
+sub RewriteHeader($$$)
 {
-    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";
+    my($idl) = shift;
+    my($input) = shift;
+    my($output) = shift;
 
-}
+    %needed = ();
 
-#####################################################################
-# parse a union
-sub ParseUnion($)
-{
-    my($union) = shift;
+    # Open files
+
+    open(IN, "<$input") || die "can't open $input for reading";
+    open(OUT, ">$output") || die "can't open $output for writing";    
+   
+    # Read through file
+
+    while(<IN>) {
+
+       # Not interested in ndr_push or ndr_print routines as they
+       # define structures we aren't interested in.
+
+       s/^NTSTATUS ndr_push.*?;\n//smg;
+       s/^void ndr_print.*?;\n//smg;
+
+       # Get rid of async send and receive function.
+
+       s/^NTSTATUS dcerpc_.*?;//smg;
+       s/^struct rpc_request.*?;//smg;
+
+       # Rewrite librpc includes
+
+       s/^\#include\ \"librpc\/gen_ndr\/ndr_(.*?).h\"$
+           /\#include \"packet-dcerpc-$1.h\"/smgx;
+
+       # Convert samba fixed width types to stdint types
+
+       s/((u)?int)([0-9]+)/$1$3_t/smg;
+
+       # Rename struct ndr_pull to struct pidl_pull
+
+       s/struct ndr_pull \*ndr/struct pidl_pull \*ndr/smg;
+
+       # Change prototypes for public functions
+
+       s/(struct pidl_pull \*ndr, int ndr_flags)/$1, pidl_tree *tree/smg;
+
+       # Bitmaps
 
-    $res .= "\tswitch (level) {\n";
+       s/(uint32_t \*r\);)/pidl_tree *tree, int hf, $1/smg;
 
-    (defined $union->{PROPERTIES}) && ParseProperties($union->{PROPERTIES});
-    foreach my $e (@{$union->{DATA}}) {
-       ParseUnionElement($e);
+       pidl $_;
     }
-    
-    $res .= "\t}\n";
+
+    close(OUT);   
 }
 
 #####################################################################
-# parse a type
-sub ParseType($)
+# rewrite autogenerated C file
+sub RewriteC($$$)
 {
-    my($data) = shift;
+    my($idl) = shift;
+    my($input) = shift;
+    my($output) = shift;
 
-    if (ref($data) eq "HASH") {
-       ($data->{TYPE} eq "STRUCT") &&
-           ParseStruct($data);
-       ($data->{TYPE} eq "UNION") &&
-           ParseUnion($data);
-    } else {
-       $res .= "$data";
+    # Open files
+
+    open(IN, "<$input") || die "can't open $input for reading";
+    open(OUT, ">$output") || die "can't open $output for writing";    
+    
+    # Get name of module
+
+    foreach my $x (@{$idl}) {
+       if ($x->{TYPE} eq "INTERFACE") { 
+           ModuleHeader($x);
+           $module = $x->{NAME};
+           BuildNeeded($x);
+       }
     }
-}
 
-#####################################################################
-# parse a typedef
-sub ParseTypedef($)
-{
-    my($typedef) = shift;
+    pidl "#include \"eparser.h\"\n\n";
 
-    $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";
-}
+    pidl "extern const value_string NT_errors[];\n\n";
 
-#####################################################################
-# parse a function
-sub ParseFunctionArg($$)
-{ 
-    my($arg) = shift;
-    my($io) = shift;           # "in" or "out"
+    # Declarations for hf variables
 
-    if (util::has_property($arg, $io)) {
+    pidl "static int hf_opnum = -1;\n";
+    pidl "static int hf_ptr = -1;\n";
+    pidl "static int hf_array_size = -1;\n";
+    pidl "static int hf_result_NTSTATUS = -1;\n";
 
-       # For some reason, pointers to elements in function definitions
-       # aren't parsed.
+    foreach my $y (keys(%needed)) {
+       pidl "static int $y = -1;\n", if $y =~ /^hf_/;
+    }
 
-       if (defined($arg->{POINTERS}) && !util::is_scalar_type($arg->{TYPE})) {
-           $arg->{POINTERS} -= 1, if ($arg->{POINTERS} > 0);
-           delete($arg->{POINTERS}), if ($arg->{POINTERS} == 0);
-       }
+    pidl "\n";
 
-       ParseElement($arg, "scalars|buffers");
+    foreach my $y (keys(%needed)) {
+       pidl "static gint $y = -1;\n", if $y =~ /^ett_/;
     }
-}
-    
-#####################################################################
-# parse a function
-sub ParseFunction($)
-{ 
-    my($function) = shift;
 
-    # Input function
+    pidl "\n";
+
+    # Read through file
+
+    while(<IN>) {
+
+       #
+        # Regexps to do a first pass at removing stuff we aren't
+       # interested in for ehtereal parsers.
+       #
+
+       # Remove the NDR_CHECK() macro calls.  Ethereal take care of
+       # this for us as part of the tvbuff_t structure.
+
+       s/NDR_CHECK\((.*)\)/$1/g;
+
+       # We're not interested in ndr_{print,push,size} functions so
+       # just delete them.
+
+       next, if /^(static )?NTSTATUS ndr_push/ .. /^}/;
+        next, if /^void ndr_print/ .. /^}/;
+        next, if /^size_t ndr_size/ .. /^}/;
+
+       # Get rid of dcerpc interface structures and functions since
+       # they are also not very interesting.
+
+next, if /^static const struct dcerpc_interface_call/ .. /^};/;
+next, if /^static const char \* const [a-z]+_endpoint_strings/ ../^};/;
+next, if /^static const struct dcerpc_endpoint_list/ .. /^};/;
+next, if /^const struct dcerpc_interface_table/ .. /^};/;
+next, if /^static NTSTATUS dcerpc_ndr_[a-z]+_init/ .. /^}/;
+next, if /^NTSTATUS dcerpc_[a-z]+_init/ .. /^}/;
+
+       # Rewrite includes to packet-dcerpc-foo.h instead of ndr_foo.h
+
+       s/^\#include \".*?ndr_(.*?).h\"$/\#include \"packet-dcerpc-$1.h\"/smg;
+
+       #
+       # OK start wrapping the ndr_pull functions that actually
+       # implement the NDR decoding routines.  This mainly consists
+       # of adding a couple of parameters to each function call.
+        #
+
+       # Add proto tree and hf argument to ndr_pull_ptr() calls.
+
+       s/(ndr_pull_ptr\(ndr,\ ([^\)]*?)\);)
+           /ndr_pull_ptr(ndr, tree, hf_ptr, $2);/smgx;
+
+       # Wrap ndr_pull_array_size() and ndr_pull_array_length()
+       # functions.  Add leading space in front of first parameter so
+       # we won't get caught by later regexps.
+
+       s/(ndr_pull_array_(size|length)\(ndr,\ ([^\)]*?)\);)
+           /ndr_pull_array_$2( ndr, tree, $3);/smgx;
+
+       # Add tree argument to ndr_pull_array() and
+       # ndr_pull_array_foo() calls.
+
+       s/(ndr_pull_array\(
+          ndr,\ 
+          ([^,]*?),\                                # NDR_SCALARS etc
+          (\(void\ \*\*\)r->(in|out|)\.?([^,]*?)),\ # Pointer to array entries
+          ([^\)].*?)\);)                            # All other arguments
+           /ndr_pull_array( ndr, $2, tree, $3, $6);/smgx;
+
+       s/(ndr_pull_array_([^\(]*?)\(
+          ndr,\ 
+          ([^,]*?),\                               # NDR_SCALARS etc
+          (r->((in|out).)?([^,]*?)),\              # Pointer to array elements
+          (.*?)\);)                                # Number of elements
+           /ndr_pull_array_$2( ndr, $3, tree, hf_$7_$2_array, $4, $8);/smgx;
+       # Save ndr_pull_relative{1,2}() calls from being wrapped by the
+       # proceeding regexp by adding a leading space.
+
+       s/ndr_pull_(relative1|relative2)\((.*?)\);/
+           ndr_pull_$1( $2);/smgx;
+
+       # Call ethereal wrappers for pull of scalar values in
+       # structures and functions, e.g
+       #
+       # ndr_pull_uint32(ndr, &r->in.access_mask);
+       # ndr_pull_uint32(ndr, &r->idx);
+
+       s/(ndr_pull_([^\)]*?)
+          \(ndr,\ 
+          (&?r->((in|out)\.)?         # Function args contain leading junk
+           ([^\)]*?))                 # Element name
+          \);)          
+           /ndr_pull_$2(ndr, tree, hf_$6_$2, $3);/smgx;
+
+       # Add tree and hf argument to pulls of "internal" scalars like
+       # array sizes, levels, etc.
+
+       s/(ndr_pull_(uint32|uint16)\(
+          ndr,\ 
+          (&_([^\)]*?))        # Internal arg names have leading underscore
+          \);)
+           /ndr_pull_$2(ndr, tree, hf_$4, $3);/smgx;
+
+       # Add subtree argument to calls dissecting structures, e.g
+       #
+       # ndr_pull_string(ndr, NDR_SCALARS|NDR_BUFFERS, &r->command);
+       # ndr_pull_atsvc_enum_ctr(ndr, NDR_SCALARS|NDR_BUFFERS, r->in.ctr);
+
+       s/(ndr_pull_([^\)]*?)\(
+          ndr,\ 
+          (NDR_[^,]*?),\ 
+          ([^\(].*?)\);)
+           /ndr_pull_$2(ndr, $3, get_subtree(tree, \"$2\", ndr, ett_$2), $4);
+       /smgx;
+
+       # Add proto_tree parameter to pull function prototypes, e.g
+       #
+       # static NTSTATUS ndr_pull_atsvc_JobInfo(struct ndr_pull *ndr, 
+       #         int ndr_flags, struct atsvc_JobInfo *r)
 
-    $res .= "static int $function->{NAME}_q(tvbuff_t *tvb, int offset,\
-\tpacket_info *pinfo, proto_tree *tree, char *drep)\n{\n";
+       s/^((static\ )?NTSTATUS\ ndr_pull_([^\(]*?)\(
+           struct\ ndr_pull\ \*ndr,\ 
+           int\ (ndr_)?flags)
+           /$1, proto_tree \*tree/smgx;
 
-    foreach my $arg (@{$function->{DATA}}) {
-       ParseFunctionArg($arg, "in");
+       # Add proto_tree parameter to ndr_pull_subcontext_flags_fn()
+
+        s/(ndr_pull_subcontext_flags_fn\(ndr)(.*?);/$1, tree$2;/smg;
+
+       # Get rid of ndr_pull_error() calls for the moment. Ethereal
+       # should take care of buffer overruns and inconsistent array
+       # sizes for us but it would be nice to have some error text in
+       # the dissection.
+
+       s/(return ndr_pull_error([^;]*?);)/return NT_STATUS_OK; \/\/ $1/smg;
+
+       # Rename proto_tree args to pidl_tree
+
+       s/(int (ndr_)?flags), proto_tree \*tree/$1, pidl_tree \*tree/smg;
+
+       # Rename struct ndr_pull to struct pidl_pull
+
+       s/struct ndr_pull \*ndr/struct pidl_pull \*ndr/smg;
+
+       # Fix some internal variable declarations
+
+        s/uint(16|32) _level/uint$1_t _level/smg;
+        s/ndr_pull_([^\(]*)\(ndr,\ tree,\ hf_level,\ &_level\);
+       /ndr_pull_$1(ndr, tree, hf_level_$1, &_level);/smgx;
+                               
+       # Enums
+
+        s/(^static\ NTSTATUS\ ndr_pull_(.+?),\ (enum\ .+?)\))
+           /static NTSTATUS ndr_pull_$2, pidl_tree *tree, int hf, $3)/smgx;
+       s/uint(8|16|32) v;/uint$1_t v;/smg;
+       s/(ndr_pull_([^\)]*?)\(ndr,\ &v\);)
+           /ndr_pull_$2(ndr, tree, hf, &v);/smgx;
+
+       s/(ndr_pull_([^\(]+?)\(ndr,\ &_level\);)
+           /ndr_pull_$2(ndr, tree, hf_$2, &_level);/smgx;
+
+       # Bitmaps
+
+s/(^(static\ )?NTSTATUS\ ndr_pull_(.+?),\ uint32\ \*r\))
+           /NTSTATUS ndr_pull_$3, pidl_tree *tree, int hf, uint32_t *r)/smgx;
+
+       pidl $_;
     }
-    
-    $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";
+    # Function call table
+
+    foreach my $x (@{$idl}) {
+       if ($x->{TYPE} eq "INTERFACE") { 
+           foreach my $y (@{$x->{"INHERITED_DATA"}}) {
+               ($y->{TYPE} eq "FUNCTION") && ParseFunctionPull($y);
+           }
 
-    foreach my $arg (@{$function->{DATA}}) {
-       ParseFunctionArg($arg, "out");
+           FunctionTable($x);
+       }
     }
 
-    $res .= "\n\toffset = prs_ntstatus(tvb, offset, pinfo, tree);\n";
+    # Ethereal protocol registration
 
-    $res .= "\n\treturn offset;\n}\n\n";
+    pidl "int proto_dcerpc_pidl_$module = -1;\n\n";
 
-}
+    pidl "static gint ett_dcerpc_$module = -1;\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);
+    if (defined($if_uuid)) {
+
+       pidl "static e_uuid_t uuid_dcerpc_$module = {\n";
+       pidl "\t0x" . substr($if_uuid, 1, 8);
+       pidl ", 0x" . substr($if_uuid, 10, 4);
+       pidl ", 0x" . substr($if_uuid, 15, 4) . ",\n";
+       pidl "\t{ 0x" . substr($if_uuid, 20, 2);
+       pidl ", 0x" . substr($if_uuid, 22, 2);
+       pidl ", 0x" . substr($if_uuid, 25, 2);
+       pidl ", 0x" . substr($if_uuid, 27, 2);
+       pidl ", 0x" . substr($if_uuid, 29, 2);
+       pidl ", 0x" . substr($if_uuid, 31, 2);
+       pidl ", 0x" . substr($if_uuid, 33, 2);
+       pidl ", 0x" . substr($if_uuid, 35, 2) . " }\n";
+       pidl "};\n\n";
     }
-}
 
+    if (defined($if_version)) {
+       pidl "static guint16 ver_dcerpc_$module = " . $if_version . ";\n\n";
+    }
 
-#####################################################################
-# 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);
+    pidl "void proto_register_dcerpc_pidl_$module(void)\n";
+    pidl "{\n";
+
+    pidl "\tstatic hf_register_info hf[] = {\n";
+    pidl "\t{ &hf_opnum, { \"Operation\", \"$module.opnum\", FT_UINT16, BASE_DEC, NULL, 0x0, \"Operation\", HFILL }},\n";
+       pidl "\t{ &hf_result_NTSTATUS, { \"Return code\", \"$module.rc\", FT_UINT32, BASE_HEX, VALS(NT_errors), 0x0, \"Return status code\", HFILL }},\n";
+    pidl "\t{ &hf_ptr, { \"Pointer\", \"$module.ptr\", FT_UINT32, BASE_HEX, NULL, 0x0, \"Pointer\", HFILL }},\n";
+
+    foreach my $x (keys(%needed)) {
+       next, if !($x =~ /^hf_/);
+       pidl "\t{ &$x,\n";
+       pidl "\t  { \"$needed{$x}{name}\", \"$x\", $needed{$x}{ft}, $needed{$x}{base}, NULL, 0, \"$x\", HFILL }},\n";
+    }
+
+    pidl "\t};\n\n";
+
+    pidl "\tstatic gint *ett[] = {\n";
+    pidl "\t\t&ett_dcerpc_$module,\n";
+    foreach my $x (keys(%needed)) {
+       pidl "\t\t&$x,\n", if $x =~ /^ett_/;
     }
-    return $res;
+    pidl "\t};\n\n";
+    
+    if (defined($if_uuid)) {
+
+       pidl "\tproto_dcerpc_pidl_$module = proto_register_protocol(\"pidl_$module\", \"pidl_$module\", \"pidl_$module\");\n\n";
+
+       pidl "\tproto_register_field_array(proto_dcerpc_pidl_$module, hf, array_length (hf));\n";
+       pidl "\tproto_register_subtree_array(ett, array_length(ett));\n";
+
+       pidl "}\n\n";
+
+       pidl "void proto_reg_handoff_dcerpc_pidl_$module(void)\n";
+       pidl "{\n";
+       pidl "\tdcerpc_init_uuid(proto_dcerpc_pidl_$module, ett_dcerpc_$module, \n";
+       pidl "\t\t&uuid_dcerpc_$module, ver_dcerpc_$module, \n";
+       pidl "\t\tdcerpc_dissectors, hf_opnum);\n";
+       pidl "}\n";
+
+    } else {
+
+       pidl "\tint proto_dcerpc;\n\n";
+       pidl "\tproto_dcerpc = proto_get_id_by_filter_name(\"dcerpc\");\n";
+       pidl "\tproto_register_field_array(proto_dcerpc, hf, array_length(hf));\n";
+       pidl "\tproto_register_subtree_array(ett, array_length(ett));\n";
+
+       pidl "}\n";
+
+    }
+
+    close(OUT);   
 }
 
 1;