Add pidl. Add preliminary work on SecIP.

Please note that the Alphatronics implementation does not follow the Vebon specification.
An extra padding byte had to be added to the idl..

.gitignore

@@ -2,4 +2,8 @@
 *.d
 siahsd
 tryouts/crc_validate
-
+secipd
+secip.h
+ndr_secip.c
+ndr_secip.h
+tags

pidl/MANIFEST

@@ -0,0 +1,41 @@
+MANIFEST
+tests/parse_idl.pl
+tests/Util.pm
+tests/ndr_refptr.pl
+tests/ndr_string.pl
+tests/ndr_simple.pl
+tests/ndr_align.pl
+tests/ndr_alloc.pl
+tests/ndr_array.pl
+tests/ndr.pl
+tests/samba-ndr.pl
+tests/util.pl
+tests/test_util.pl
+tests/ndr_represent.pl
+tests/ndr_compat.pl
+tests/ndr_fullptr.pl
+tests/ndr_tagtype.pl
+tests/header.pl
+lib/Parse/Pidl/Samba3/ClientNDR.pm
+lib/Parse/Pidl/Samba3/ServerNDR.pm
+lib/Parse/Pidl/Samba4/NDR/Server.pm
+lib/Parse/Pidl/Samba4/NDR/Parser.pm
+lib/Parse/Pidl/Samba4/NDR/Client.pm
+lib/Parse/Pidl/Samba4/Header.pm
+lib/Parse/Pidl/Samba4/TDR.pm
+lib/Parse/Pidl/Samba4/Template.pm
+lib/Parse/Pidl/Samba4.pm
+lib/Parse/Pidl/Wireshark/Conformance.pm
+lib/Parse/Pidl/Wireshark/NDR.pm
+lib/Parse/Pidl/Typelist.pm
+lib/Parse/Pidl/Dump.pm
+lib/Parse/Pidl/Compat.pm
+lib/Parse/Pidl/Util.pm
+lib/Parse/Pidl/NDR.pm
+lib/Parse/Pidl.pm
+Makefile.PL
+idl.yp
+TODO
+README
+pidl
+META.yml

pidl/META.yml

@@ -0,0 +1,18 @@
+name: Parse-Pidl
+abstract: Generate parsers / DCE/RPC-clients from IDL
+author:
+    - Andrew Tridgell <tridge@samba.org>
+    - Jelmer Vernooij <jelmer@samba.org>
+    - Stefan Metzmacher <metze@samba.org>
+    - Tim Potter <tpot@samba.org>
+license: gplv3
+installdirs:  site
+homepage: http://www.samba.org/
+bugtracker: http://bugzilla.samba.org/
+requires:
+    Parse::Yapp: 0    
+recommends:
+    Data::Dumper: 0
+meta-spec:
+    version: 1.3
+    url: http://module-build.sourceforge.net/META-spec-v1.3.html

pidl/MYMETA.yml

@@ -0,0 +1,21 @@
+---
+abstract: ~
+author: []
+build_requires:
+  ExtUtils::MakeMaker: 0
+configure_requires:
+  ExtUtils::MakeMaker: 0
+distribution_type: module
+dynamic_config: 0
+generated_by: 'ExtUtils::MakeMaker version 6.57_05'
+license: unknown
+meta-spec:
+  url: http://module-build.sourceforge.net/META-spec-v1.4.html
+  version: 1.4
+name: Parse-Pidl
+no_index:
+  directory:
+    - t
+    - inc
+requires: {}
+version: 0.02

pidl/Makefile

@@ -0,0 +1,927 @@
+# This Makefile is for the Parse::Pidl extension to perl.
+#
+# It was generated automatically by MakeMaker version
+# 6.57_05 (Revision: 65705) from the contents of
+# Makefile.PL. Don't edit this file, edit Makefile.PL instead.
+#
+#       ANY CHANGES MADE HERE WILL BE LOST!
+#
+#   MakeMaker ARGV: ()
+#
+
+#   MakeMaker Parameters:
+
+#     BUILD_REQUIRES => {  }
+#     EXE_FILES => [q[pidl]]
+#     NAME => q[Parse::Pidl]
+#     PREREQ_PM => {  }
+#     VERSION_FROM => q[lib/Parse/Pidl.pm]
+#     test => { TESTS=>q[tests/*.pl] }
+
+# --- MakeMaker post_initialize section:
+
+
+# --- MakeMaker const_config section:
+
+# These definitions are from config.sh (via /usr/lib/perl/5.14/Config.pm).
+# They may have been overridden via Makefile.PL or on the command line.
+AR = ar
+CC = cc
+CCCDLFLAGS = -fPIC
+CCDLFLAGS = -Wl,-E
+DLEXT = so
+DLSRC = dl_dlopen.xs
+EXE_EXT = 
+FULL_AR = /usr/bin/ar
+LD = cc
+LDDLFLAGS = -shared -L/usr/local/lib -fstack-protector
+LDFLAGS =  -fstack-protector -L/usr/local/lib
+LIBC = 
+LIB_EXT = .a
+OBJ_EXT = .o
+OSNAME = linux
+OSVERS = 2.6.32-5-amd64
+RANLIB = :
+SITELIBEXP = /usr/local/share/perl/5.14.2
+SITEARCHEXP = /usr/local/lib/perl/5.14.2
+SO = so
+VENDORARCHEXP = /usr/lib/perl5
+VENDORLIBEXP = /usr/share/perl5
+
+
+# --- MakeMaker constants section:
+AR_STATIC_ARGS = cr
+DIRFILESEP = /
+DFSEP = $(DIRFILESEP)
+NAME = Parse::Pidl
+NAME_SYM = Parse_Pidl
+VERSION = 0.02
+VERSION_MACRO = VERSION
+VERSION_SYM = 0_02
+DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\"
+XS_VERSION = 0.02
+XS_VERSION_MACRO = XS_VERSION
+XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\"
+INST_ARCHLIB = blib/arch
+INST_SCRIPT = blib/script
+INST_BIN = blib/bin
+INST_LIB = blib/lib
+INST_MAN1DIR = blib/man1
+INST_MAN3DIR = blib/man3
+MAN1EXT = 1p
+MAN3EXT = 3pm
+INSTALLDIRS = site
+DESTDIR = 
+PREFIX = /usr
+PERLPREFIX = $(PREFIX)
+SITEPREFIX = $(PREFIX)/local
+VENDORPREFIX = $(PREFIX)
+INSTALLPRIVLIB = $(PERLPREFIX)/share/perl/5.14
+DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB)
+INSTALLSITELIB = $(SITEPREFIX)/share/perl/5.14.2
+DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB)
+INSTALLVENDORLIB = $(VENDORPREFIX)/share/perl5
+DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB)
+INSTALLARCHLIB = $(PERLPREFIX)/lib/perl/5.14
+DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB)
+INSTALLSITEARCH = $(SITEPREFIX)/lib/perl/5.14.2
+DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH)
+INSTALLVENDORARCH = $(VENDORPREFIX)/lib/perl5
+DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH)
+INSTALLBIN = $(PERLPREFIX)/bin
+DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN)
+INSTALLSITEBIN = $(SITEPREFIX)/bin
+DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN)
+INSTALLVENDORBIN = $(VENDORPREFIX)/bin
+DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN)
+INSTALLSCRIPT = $(PERLPREFIX)/bin
+DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT)
+INSTALLSITESCRIPT = $(SITEPREFIX)/bin
+DESTINSTALLSITESCRIPT = $(DESTDIR)$(INSTALLSITESCRIPT)
+INSTALLVENDORSCRIPT = $(VENDORPREFIX)/bin
+DESTINSTALLVENDORSCRIPT = $(DESTDIR)$(INSTALLVENDORSCRIPT)
+INSTALLMAN1DIR = $(PERLPREFIX)/share/man/man1
+DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR)
+INSTALLSITEMAN1DIR = $(SITEPREFIX)/man/man1
+DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR)
+INSTALLVENDORMAN1DIR = $(VENDORPREFIX)/share/man/man1
+DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR)
+INSTALLMAN3DIR = $(PERLPREFIX)/share/man/man3
+DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR)
+INSTALLSITEMAN3DIR = $(SITEPREFIX)/man/man3
+DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR)
+INSTALLVENDORMAN3DIR = $(VENDORPREFIX)/share/man/man3
+DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR)
+PERL_LIB = /usr/share/perl/5.14
+PERL_ARCHLIB = /usr/lib/perl/5.14
+LIBPERL_A = libperl.a
+FIRST_MAKEFILE = Makefile
+MAKEFILE_OLD = Makefile.old
+MAKE_APERL_FILE = Makefile.aperl
+PERLMAINCC = $(CC)
+PERL_INC = /usr/lib/perl/5.14/CORE
+PERL = /usr/bin/perl
+FULLPERL = /usr/bin/perl
+ABSPERL = $(PERL)
+PERLRUN = $(PERL)
+FULLPERLRUN = $(FULLPERL)
+ABSPERLRUN = $(ABSPERL)
+PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
+FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
+ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)"
+PERL_CORE = 0
+PERM_DIR = 755
+PERM_RW = 644
+PERM_RWX = 755
+
+MAKEMAKER   = /usr/share/perl/5.14/ExtUtils/MakeMaker.pm
+MM_VERSION  = 6.57_05
+MM_REVISION = 65705
+
+# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).
+# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)
+# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
+# DLBASE  = Basename part of dynamic library. May be just equal BASEEXT.
+MAKE = make
+FULLEXT = Parse/Pidl
+BASEEXT = Pidl
+PARENT_NAME = Parse
+DLBASE = $(BASEEXT)
+VERSION_FROM = lib/Parse/Pidl.pm
+OBJECT = 
+LDFROM = $(OBJECT)
+LINKTYPE = dynamic
+BOOTDEP = 
+
+# Handy lists of source code files:
+XS_FILES = 
+C_FILES  = 
+O_FILES  = 
+H_FILES  = 
+MAN1PODS = pidl
+MAN3PODS = lib/Parse/Pidl/Dump.pm \
+	lib/Parse/Pidl/NDR.pm \
+	lib/Parse/Pidl/Util.pm \
+	lib/Parse/Pidl/Wireshark/Conformance.pm \
+	lib/Parse/Pidl/Wireshark/NDR.pm
+
+# Where is the Config information that we are using/depend on
+CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h
+
+# Where to build things
+INST_LIBDIR      = $(INST_LIB)/Parse
+INST_ARCHLIBDIR  = $(INST_ARCHLIB)/Parse
+
+INST_AUTODIR     = $(INST_LIB)/auto/$(FULLEXT)
+INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT)
+
+INST_STATIC      = 
+INST_DYNAMIC     = 
+INST_BOOT        = 
+
+# Extra linker info
+EXPORT_LIST        = 
+PERL_ARCHIVE       = 
+PERL_ARCHIVE_AFTER = 
+
+
+TO_INST_PM = lib/Parse/Pidl.pm \
+	lib/Parse/Pidl/CUtil.pm \
+	lib/Parse/Pidl/Compat.pm \
+	lib/Parse/Pidl/Dump.pm \
+	lib/Parse/Pidl/Expr.pm \
+	lib/Parse/Pidl/IDL.pm \
+	lib/Parse/Pidl/NDR.pm \
+	lib/Parse/Pidl/ODL.pm \
+	lib/Parse/Pidl/Samba3/ClientNDR.pm \
+	lib/Parse/Pidl/Samba3/ServerNDR.pm \
+	lib/Parse/Pidl/Samba4.pm \
+	lib/Parse/Pidl/Samba4/COM/Header.pm \
+	lib/Parse/Pidl/Samba4/COM/Proxy.pm \
+	lib/Parse/Pidl/Samba4/COM/Stub.pm \
+	lib/Parse/Pidl/Samba4/Header.pm \
+	lib/Parse/Pidl/Samba4/NDR/Client.pm \
+	lib/Parse/Pidl/Samba4/NDR/Parser.pm \
+	lib/Parse/Pidl/Samba4/NDR/Server.pm \
+	lib/Parse/Pidl/Samba4/Python.pm \
+	lib/Parse/Pidl/Samba4/TDR.pm \
+	lib/Parse/Pidl/Samba4/Template.pm \
+	lib/Parse/Pidl/Typelist.pm \
+	lib/Parse/Pidl/Util.pm \
+	lib/Parse/Pidl/Wireshark/Conformance.pm \
+	lib/Parse/Pidl/Wireshark/NDR.pm \
+	lib/Parse/Yapp/Driver.pm \
+	lib/wscript_build
+
+PM_TO_BLIB = lib/Parse/Pidl/NDR.pm \
+	blib/lib/Parse/Pidl/NDR.pm \
+	lib/Parse/Pidl/Samba3/ServerNDR.pm \
+	blib/lib/Parse/Pidl/Samba3/ServerNDR.pm \
+	lib/Parse/Pidl/Compat.pm \
+	blib/lib/Parse/Pidl/Compat.pm \
+	lib/Parse/Pidl/Expr.pm \
+	blib/lib/Parse/Pidl/Expr.pm \
+	lib/Parse/Pidl/Samba4/NDR/Client.pm \
+	blib/lib/Parse/Pidl/Samba4/NDR/Client.pm \
+	lib/Parse/Pidl/Samba4/NDR/Parser.pm \
+	blib/lib/Parse/Pidl/Samba4/NDR/Parser.pm \
+	lib/Parse/Pidl/Util.pm \
+	blib/lib/Parse/Pidl/Util.pm \
+	lib/Parse/Pidl/IDL.pm \
+	blib/lib/Parse/Pidl/IDL.pm \
+	lib/wscript_build \
+	blib/lib/wscript_build \
+	lib/Parse/Pidl.pm \
+	blib/lib/Parse/Pidl.pm \
+	lib/Parse/Pidl/Samba4/TDR.pm \
+	blib/lib/Parse/Pidl/Samba4/TDR.pm \
+	lib/Parse/Pidl/CUtil.pm \
+	blib/lib/Parse/Pidl/CUtil.pm \
+	lib/Parse/Pidl/Samba4/COM/Stub.pm \
+	blib/lib/Parse/Pidl/Samba4/COM/Stub.pm \
+	lib/Parse/Yapp/Driver.pm \
+	blib/lib/Parse/Yapp/Driver.pm \
+	lib/Parse/Pidl/Samba4/Template.pm \
+	blib/lib/Parse/Pidl/Samba4/Template.pm \
+	lib/Parse/Pidl/Samba4/Python.pm \
+	blib/lib/Parse/Pidl/Samba4/Python.pm \
+	lib/Parse/Pidl/Samba4.pm \
+	blib/lib/Parse/Pidl/Samba4.pm \
+	lib/Parse/Pidl/Samba3/ClientNDR.pm \
+	blib/lib/Parse/Pidl/Samba3/ClientNDR.pm \
+	lib/Parse/Pidl/ODL.pm \
+	blib/lib/Parse/Pidl/ODL.pm \
+	lib/Parse/Pidl/Wireshark/Conformance.pm \
+	blib/lib/Parse/Pidl/Wireshark/Conformance.pm \
+	lib/Parse/Pidl/Wireshark/NDR.pm \
+	blib/lib/Parse/Pidl/Wireshark/NDR.pm \
+	lib/Parse/Pidl/Samba4/COM/Proxy.pm \
+	blib/lib/Parse/Pidl/Samba4/COM/Proxy.pm \
+	lib/Parse/Pidl/Samba4/COM/Header.pm \
+	blib/lib/Parse/Pidl/Samba4/COM/Header.pm \
+	lib/Parse/Pidl/Samba4/Header.pm \
+	blib/lib/Parse/Pidl/Samba4/Header.pm \
+	lib/Parse/Pidl/Samba4/NDR/Server.pm \
+	blib/lib/Parse/Pidl/Samba4/NDR/Server.pm \
+	lib/Parse/Pidl/Typelist.pm \
+	blib/lib/Parse/Pidl/Typelist.pm \
+	lib/Parse/Pidl/Dump.pm \
+	blib/lib/Parse/Pidl/Dump.pm
+
+
+# --- MakeMaker platform_constants section:
+MM_Unix_VERSION = 6.57_05
+PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc
+
+
+# --- MakeMaker tool_autosplit section:
+# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
+AUTOSPLITFILE = $(ABSPERLRUN)  -e 'use AutoSplit;  autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1)' --
+
+
+
+# --- MakeMaker tool_xsubpp section:
+
+
+# --- MakeMaker tools_other section:
+SHELL = /bin/sh
+CHMOD = chmod
+CP = cp
+MV = mv
+NOOP = $(TRUE)
+NOECHO = @
+RM_F = rm -f
+RM_RF = rm -rf
+TEST_F = test -f
+TOUCH = touch
+UMASK_NULL = umask 0
+DEV_NULL = > /dev/null 2>&1
+MKPATH = $(ABSPERLRUN) -MExtUtils::Command -e 'mkpath' --
+EQUALIZE_TIMESTAMP = $(ABSPERLRUN) -MExtUtils::Command -e 'eqtime' --
+FALSE = false
+TRUE = true
+ECHO = echo
+ECHO_N = echo -n
+UNINST = 0
+VERBINST = 0
+MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e 'install([ from_to => {@ARGV}, verbose => '\''$(VERBINST)'\'', uninstall_shadows => '\''$(UNINST)'\'', dir_mode => '\''$(PERM_DIR)'\'' ]);' --
+DOC_INSTALL = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'perllocal_install' --
+UNINSTALL = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'uninstall' --
+WARN_IF_OLD_PACKLIST = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'warn_if_old_packlist' --
+MACROSTART = 
+MACROEND = 
+USEMAKEFILE = -f
+FIXIN = $(ABSPERLRUN) -MExtUtils::MY -e 'MY->fixin(shift)' --
+
+
+# --- MakeMaker makemakerdflt section:
+makemakerdflt : all
+	$(NOECHO) $(NOOP)
+
+
+# --- MakeMaker dist section:
+TAR = tar
+TARFLAGS = cvf
+ZIP = zip
+ZIPFLAGS = -r
+COMPRESS = gzip --best
+SUFFIX = .gz
+SHAR = shar
+PREOP = $(NOECHO) $(NOOP)
+POSTOP = $(NOECHO) $(NOOP)
+TO_UNIX = $(NOECHO) $(NOOP)
+CI = ci -u
+RCS_LABEL = rcs -Nv$(VERSION_SYM): -q
+DIST_CP = best
+DIST_DEFAULT = tardist
+DISTNAME = Parse-Pidl
+DISTVNAME = Parse-Pidl-0.02
+
+
+# --- MakeMaker macro section:
+
+
+# --- MakeMaker depend section:
+
+
+# --- MakeMaker cflags section:
+
+
+# --- MakeMaker const_loadlibs section:
+
+
+# --- MakeMaker const_cccmd section:
+
+
+# --- MakeMaker post_constants section:
+
+
+# --- MakeMaker pasthru section:
+
+PASTHRU = LIBPERL_A="$(LIBPERL_A)"\
+	LINKTYPE="$(LINKTYPE)"\
+	LD="$(LD)"\
+	PREFIX="$(PREFIX)"
+
+
+# --- MakeMaker special_targets section:
+.SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT)
+
+.PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir
+
+
+
+# --- MakeMaker c_o section:
+
+
+# --- MakeMaker xs_c section:
+
+
+# --- MakeMaker xs_o section:
+
+
+# --- MakeMaker top_targets section:
+all :: pure_all manifypods
+	$(NOECHO) $(NOOP)
+
+
+pure_all :: config pm_to_blib subdirs linkext
+	$(NOECHO) $(NOOP)
+
+subdirs :: $(MYEXTLIB)
+	$(NOECHO) $(NOOP)
+
+config :: $(FIRST_MAKEFILE) blibdirs
+	$(NOECHO) $(NOOP)
+
+help :
+	perldoc ExtUtils::MakeMaker
+
+
+# --- MakeMaker blibdirs section:
+blibdirs : $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists $(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists $(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists
+	$(NOECHO) $(NOOP)
+
+# Backwards compat with 6.18 through 6.25
+blibdirs.ts : blibdirs
+	$(NOECHO) $(NOOP)
+
+$(INST_LIBDIR)$(DFSEP).exists :: Makefile.PL
+	$(NOECHO) $(MKPATH) $(INST_LIBDIR)
+	$(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_LIBDIR)
+	$(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists
+
+$(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL
+	$(NOECHO) $(MKPATH) $(INST_ARCHLIB)
+	$(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHLIB)
+	$(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists
+
+$(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL
+	$(NOECHO) $(MKPATH) $(INST_AUTODIR)
+	$(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_AUTODIR)
+	$(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists
+
+$(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL
+	$(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
+	$(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHAUTODIR)
+	$(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists
+
+$(INST_BIN)$(DFSEP).exists :: Makefile.PL
+	$(NOECHO) $(MKPATH) $(INST_BIN)
+	$(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_BIN)
+	$(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists
+
+$(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL
+	$(NOECHO) $(MKPATH) $(INST_SCRIPT)
+	$(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_SCRIPT)
+	$(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists
+
+$(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL
+	$(NOECHO) $(MKPATH) $(INST_MAN1DIR)
+	$(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN1DIR)
+	$(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists
+
+$(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL
+	$(NOECHO) $(MKPATH) $(INST_MAN3DIR)
+	$(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN3DIR)
+	$(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists
+
+
+
+# --- MakeMaker linkext section:
+
+linkext :: $(LINKTYPE)
+	$(NOECHO) $(NOOP)
+
+
+# --- MakeMaker dlsyms section:
+
+
+# --- MakeMaker dynamic section:
+
+dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT)
+	$(NOECHO) $(NOOP)
+
+
+# --- MakeMaker dynamic_bs section:
+
+BOOTSTRAP =
+
+
+# --- MakeMaker dynamic_lib section:
+
+
+# --- MakeMaker static section:
+
+## $(INST_PM) has been moved to the all: target.
+## It remains here for awhile to allow for old usage: "make static"
+static :: $(FIRST_MAKEFILE) $(INST_STATIC)
+	$(NOECHO) $(NOOP)
+
+
+# --- MakeMaker static_lib section:
+
+
+# --- MakeMaker manifypods section:
+
+POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--"
+POD2MAN = $(POD2MAN_EXE)
+
+
+manifypods : pure_all  \
+	pidl \
+	lib/Parse/Pidl/Util.pm \
+	lib/Parse/Pidl/NDR.pm \
+	lib/Parse/Pidl/Wireshark/Conformance.pm \
+	lib/Parse/Pidl/Wireshark/NDR.pm \
+	lib/Parse/Pidl/Dump.pm
+	$(NOECHO) $(POD2MAN) --section=$(MAN1EXT) --perm_rw=$(PERM_RW) \
+	  pidl $(INST_MAN1DIR)/pidl.$(MAN1EXT) 
+	$(NOECHO) $(POD2MAN) --section=$(MAN3EXT) --perm_rw=$(PERM_RW) \
+	  lib/Parse/Pidl/Util.pm $(INST_MAN3DIR)/Parse::Pidl::Util.$(MAN3EXT) \
+	  lib/Parse/Pidl/NDR.pm $(INST_MAN3DIR)/Parse::Pidl::NDR.$(MAN3EXT) \
+	  lib/Parse/Pidl/Wireshark/Conformance.pm $(INST_MAN3DIR)/Parse::Pidl::Wireshark::Conformance.$(MAN3EXT) \
+	  lib/Parse/Pidl/Wireshark/NDR.pm $(INST_MAN3DIR)/Parse::Pidl::Wireshark::NDR.$(MAN3EXT) \
+	  lib/Parse/Pidl/Dump.pm $(INST_MAN3DIR)/Parse::Pidl::Dump.$(MAN3EXT) 
+
+
+
+
+# --- MakeMaker processPL section:
+
+
+# --- MakeMaker installbin section:
+
+EXE_FILES = pidl
+
+pure_all :: $(INST_SCRIPT)/pidl
+	$(NOECHO) $(NOOP)
+
+realclean ::
+	$(RM_F) \
+	  $(INST_SCRIPT)/pidl 
+
+$(INST_SCRIPT)/pidl : pidl $(FIRST_MAKEFILE) $(INST_SCRIPT)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists
+	$(NOECHO) $(RM_F) $(INST_SCRIPT)/pidl
+	$(CP) pidl $(INST_SCRIPT)/pidl
+	$(FIXIN) $(INST_SCRIPT)/pidl
+	-$(NOECHO) $(CHMOD) $(PERM_RWX) $(INST_SCRIPT)/pidl
+
+
+
+# --- MakeMaker subdirs section:
+
+# none
+
+# --- MakeMaker clean_subdirs section:
+clean_subdirs :
+	$(NOECHO) $(NOOP)
+
+
+# --- MakeMaker clean section:
+
+# Delete temporary files but do not touch installed files. We don't delete
+# the Makefile here so a later make realclean still has a makefile to use.
+
+clean :: clean_subdirs
+	- $(RM_F) \
+	  *$(LIB_EXT) core \
+	  core.[0-9] $(INST_ARCHAUTODIR)/extralibs.all \
+	  core.[0-9][0-9] $(BASEEXT).bso \
+	  pm_to_blib.ts core.[0-9][0-9][0-9][0-9] \
+	  MYMETA.yml $(BASEEXT).x \
+	  $(BOOTSTRAP) perl$(EXE_EXT) \
+	  tmon.out *$(OBJ_EXT) \
+	  pm_to_blib $(INST_ARCHAUTODIR)/extralibs.ld \
+	  blibdirs.ts core.[0-9][0-9][0-9][0-9][0-9] \
+	  *perl.core core.*perl.*.? \
+	  $(MAKE_APERL_FILE) perl \
+	  $(BASEEXT).def core.[0-9][0-9][0-9] \
+	  mon.out lib$(BASEEXT).def \
+	  perlmain.c perl.exe \
+	  so_locations $(BASEEXT).exp 
+	- $(RM_RF) \
+	  blib 
+	- $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL)
+
+
+# --- MakeMaker realclean_subdirs section:
+realclean_subdirs :
+	$(NOECHO) $(NOOP)
+
+
+# --- MakeMaker realclean section:
+# Delete temporary files (via clean) and also delete dist files
+realclean purge ::  clean realclean_subdirs
+	- $(RM_F) \
+	  $(MAKEFILE_OLD) $(FIRST_MAKEFILE) 
+	- $(RM_RF) \
+	  $(DISTVNAME) 
+
+
+# --- MakeMaker metafile section:
+metafile : create_distdir
+	$(NOECHO) $(ECHO) Generating META.yml
+	$(NOECHO) $(ECHO) '--- #YAML:1.0' > META_new.yml
+	$(NOECHO) $(ECHO) 'name:               Parse-Pidl' >> META_new.yml
+	$(NOECHO) $(ECHO) 'version:            0.02' >> META_new.yml
+	$(NOECHO) $(ECHO) 'abstract:           ~' >> META_new.yml
+	$(NOECHO) $(ECHO) 'author:  []' >> META_new.yml
+	$(NOECHO) $(ECHO) 'license:            unknown' >> META_new.yml
+	$(NOECHO) $(ECHO) 'distribution_type:  module' >> META_new.yml
+	$(NOECHO) $(ECHO) 'configure_requires:' >> META_new.yml
+	$(NOECHO) $(ECHO) '    ExtUtils::MakeMaker:  0' >> META_new.yml
+	$(NOECHO) $(ECHO) 'build_requires:' >> META_new.yml
+	$(NOECHO) $(ECHO) '    ExtUtils::MakeMaker:  0' >> META_new.yml
+	$(NOECHO) $(ECHO) 'requires:  {}' >> META_new.yml
+	$(NOECHO) $(ECHO) 'no_index:' >> META_new.yml
+	$(NOECHO) $(ECHO) '    directory:' >> META_new.yml
+	$(NOECHO) $(ECHO) '        - t' >> META_new.yml
+	$(NOECHO) $(ECHO) '        - inc' >> META_new.yml
+	$(NOECHO) $(ECHO) 'generated_by:       ExtUtils::MakeMaker version 6.57_05' >> META_new.yml
+	$(NOECHO) $(ECHO) 'meta-spec:' >> META_new.yml
+	$(NOECHO) $(ECHO) '    url:      http://module-build.sourceforge.net/META-spec-v1.4.html' >> META_new.yml
+	$(NOECHO) $(ECHO) '    version:  1.4' >> META_new.yml
+	-$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml
+
+
+# --- MakeMaker signature section:
+signature :
+	cpansign -s
+
+
+# --- MakeMaker dist_basics section:
+distclean :: realclean distcheck
+	$(NOECHO) $(NOOP)
+
+distcheck :
+	$(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck
+
+skipcheck :
+	$(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck
+
+manifest :
+	$(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest
+
+veryclean : realclean
+	$(RM_F) *~ */*~ *.orig */*.orig *.bak */*.bak *.old */*.old 
+
+
+
+# --- MakeMaker dist_core section:
+
+dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE)
+	$(NOECHO) $(ABSPERLRUN) -l -e 'print '\''Warning: Makefile possibly out of date with $(VERSION_FROM)'\''' \
+	  -e '    if -e '\''$(VERSION_FROM)'\'' and -M '\''$(VERSION_FROM)'\'' < -M '\''$(FIRST_MAKEFILE)'\'';' --
+
+tardist : $(DISTVNAME).tar$(SUFFIX)
+	$(NOECHO) $(NOOP)
+
+uutardist : $(DISTVNAME).tar$(SUFFIX)
+	uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu
+
+$(DISTVNAME).tar$(SUFFIX) : distdir
+	$(PREOP)
+	$(TO_UNIX)
+	$(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
+	$(RM_RF) $(DISTVNAME)
+	$(COMPRESS) $(DISTVNAME).tar
+	$(POSTOP)
+
+zipdist : $(DISTVNAME).zip
+	$(NOECHO) $(NOOP)
+
+$(DISTVNAME).zip : distdir
+	$(PREOP)
+	$(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
+	$(RM_RF) $(DISTVNAME)
+	$(POSTOP)
+
+shdist : distdir
+	$(PREOP)
+	$(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
+	$(RM_RF) $(DISTVNAME)
+	$(POSTOP)
+
+
+# --- MakeMaker distdir section:
+create_distdir :
+	$(RM_RF) $(DISTVNAME)
+	$(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \
+		-e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
+
+distdir : create_distdir distmeta 
+	$(NOECHO) $(NOOP)
+
+
+
+# --- MakeMaker dist_test section:
+disttest : distdir
+	cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL 
+	cd $(DISTVNAME) && $(MAKE) $(PASTHRU)
+	cd $(DISTVNAME) && $(MAKE) test $(PASTHRU)
+
+
+
+# --- MakeMaker dist_ci section:
+
+ci :
+	$(PERLRUN) "-MExtUtils::Manifest=maniread" \
+	  -e "@all = keys %{ maniread() };" \
+	  -e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \
+	  -e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});"
+
+
+# --- MakeMaker distmeta section:
+distmeta : create_distdir metafile
+	$(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{META.yml} => q{Module meta-data (added by MakeMaker)}}) } ' \
+	  -e '    or print "Could not add META.yml to MANIFEST: $${'\''@'\''}\n"' --
+
+
+
+# --- MakeMaker distsignature section:
+distsignature : create_distdir
+	$(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } ' \
+	  -e '    or print "Could not add SIGNATURE to MANIFEST: $${'\''@'\''}\n"' --
+	$(NOECHO) cd $(DISTVNAME) && $(TOUCH) SIGNATURE
+	cd $(DISTVNAME) && cpansign -s
+
+
+
+# --- MakeMaker install section:
+
+install :: pure_install doc_install
+	$(NOECHO) $(NOOP)
+
+install_perl :: pure_perl_install doc_perl_install
+	$(NOECHO) $(NOOP)
+
+install_site :: pure_site_install doc_site_install
+	$(NOECHO) $(NOOP)
+
+install_vendor :: pure_vendor_install doc_vendor_install
+	$(NOECHO) $(NOOP)
+
+pure_install :: pure_$(INSTALLDIRS)_install
+	$(NOECHO) $(NOOP)
+
+doc_install :: doc_$(INSTALLDIRS)_install
+	$(NOECHO) $(NOOP)
+
+pure__install : pure_site_install
+	$(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+doc__install : doc_site_install
+	$(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+pure_perl_install :: all
+	$(NOECHO) umask 022; $(MOD_INSTALL) \
+		$(INST_LIB) $(DESTINSTALLPRIVLIB) \
+		$(INST_ARCHLIB) $(DESTINSTALLARCHLIB) \
+		$(INST_BIN) $(DESTINSTALLBIN) \
+		$(INST_SCRIPT) $(DESTINSTALLSCRIPT) \
+		$(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) \
+		$(INST_MAN3DIR) $(DESTINSTALLMAN3DIR)
+	$(NOECHO) $(WARN_IF_OLD_PACKLIST) \
+		$(SITEARCHEXP)/auto/$(FULLEXT)
+
+
+pure_site_install :: all
+	$(NOECHO) umask 02; $(MOD_INSTALL) \
+		read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \
+		write $(DESTINSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \
+		$(INST_LIB) $(DESTINSTALLSITELIB) \
+		$(INST_ARCHLIB) $(DESTINSTALLSITEARCH) \
+		$(INST_BIN) $(DESTINSTALLSITEBIN) \
+		$(INST_SCRIPT) $(DESTINSTALLSITESCRIPT) \
+		$(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) \
+		$(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR)
+	$(NOECHO) $(WARN_IF_OLD_PACKLIST) \
+		$(PERL_ARCHLIB)/auto/$(FULLEXT)
+
+pure_vendor_install :: all
+	$(NOECHO) umask 022; $(MOD_INSTALL) \
+		$(INST_LIB) $(DESTINSTALLVENDORLIB) \
+		$(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) \
+		$(INST_BIN) $(DESTINSTALLVENDORBIN) \
+		$(INST_SCRIPT) $(DESTINSTALLVENDORSCRIPT) \
+		$(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) \
+		$(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR)
+
+doc_perl_install :: all
+
+doc_site_install :: all
+	$(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLSITEARCH)/perllocal.pod
+	-$(NOECHO) umask 02; $(MKPATH) $(DESTINSTALLSITEARCH)
+	-$(NOECHO) umask 02; $(DOC_INSTALL) \
+		"Module" "$(NAME)" \
+		"installed into" "$(INSTALLSITELIB)" \
+		LINKTYPE "$(LINKTYPE)" \
+		VERSION "$(VERSION)" \
+		EXE_FILES "$(EXE_FILES)" \
+		>> $(DESTINSTALLSITEARCH)/perllocal.pod
+
+doc_vendor_install :: all
+
+
+uninstall :: uninstall_from_$(INSTALLDIRS)dirs
+	$(NOECHO) $(NOOP)
+
+uninstall_from_perldirs ::
+
+uninstall_from_sitedirs ::
+	$(NOECHO) $(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist
+
+uninstall_from_vendordirs ::
+
+
+
+# --- MakeMaker force section:
+# Phony target to force checking subdirectories.
+FORCE :
+	$(NOECHO) $(NOOP)
+
+
+# --- MakeMaker perldepend section:
+
+
+# --- MakeMaker makefile section:
+# We take a very conservative approach here, but it's worth it.
+# We move Makefile to Makefile.old here to avoid gnu make looping.
+$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP)
+	$(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?"
+	$(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..."
+	-$(NOECHO) $(RM_F) $(MAKEFILE_OLD)
+	-$(NOECHO) $(MV)   $(FIRST_MAKEFILE) $(MAKEFILE_OLD)
+	- $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL)
+	$(PERLRUN) Makefile.PL 
+	$(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <=="
+	$(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command.  <=="
+	$(FALSE)
+
+
+
+# --- MakeMaker staticmake section:
+
+# --- MakeMaker makeaperl section ---
+MAP_TARGET    = perl
+FULLPERL      = /usr/bin/perl
+
+$(MAP_TARGET) :: static $(MAKE_APERL_FILE)
+	$(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@
+
+$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib
+	$(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET)
+	$(NOECHO) $(PERLRUNINST) \
+		Makefile.PL DIR= \
+		MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
+		MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=
+
+
+# --- MakeMaker test section:
+
+TEST_VERBOSE=0
+TEST_TYPE=test_$(LINKTYPE)
+TEST_FILE = test.pl
+TEST_FILES = tests/*.pl
+TESTDB_SW = -d
+
+testdb :: testdb_$(LINKTYPE)
+
+test :: $(TEST_TYPE) subdirs-test
+
+subdirs-test ::
+	$(NOECHO) $(NOOP)
+
+
+test_dynamic :: pure_all
+	PERL_DL_NONLAZY=1 $(FULLPERLRUN) "-MExtUtils::Command::MM" "-e" "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES)
+
+testdb_dynamic :: pure_all
+	PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE)
+
+test_ : test_dynamic
+
+test_static :: test_dynamic
+testdb_static :: testdb_dynamic
+
+
+# --- MakeMaker ppd section:
+# Creates a PPD (Perl Package Description) for a binary distribution.
+ppd :
+	$(NOECHO) $(ECHO) '<SOFTPKG NAME="$(DISTNAME)" VERSION="0.02">' > $(DISTNAME).ppd
+	$(NOECHO) $(ECHO) '    <ABSTRACT></ABSTRACT>' >> $(DISTNAME).ppd
+	$(NOECHO) $(ECHO) '    <AUTHOR></AUTHOR>' >> $(DISTNAME).ppd
+	$(NOECHO) $(ECHO) '    <IMPLEMENTATION>' >> $(DISTNAME).ppd
+	$(NOECHO) $(ECHO) '        <ARCHITECTURE NAME="x86_64-linux-gnu-thread-multi-5.14" />' >> $(DISTNAME).ppd
+	$(NOECHO) $(ECHO) '        <CODEBASE HREF="" />' >> $(DISTNAME).ppd
+	$(NOECHO) $(ECHO) '    </IMPLEMENTATION>' >> $(DISTNAME).ppd
+	$(NOECHO) $(ECHO) '</SOFTPKG>' >> $(DISTNAME).ppd
+
+
+# --- MakeMaker pm_to_blib section:
+
+pm_to_blib : $(FIRST_MAKEFILE) $(TO_INST_PM)
+	$(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', q[$(PM_FILTER)], '\''$(PERM_DIR)'\'')' -- \
+	  lib/Parse/Pidl/NDR.pm blib/lib/Parse/Pidl/NDR.pm \
+	  lib/Parse/Pidl/Samba3/ServerNDR.pm blib/lib/Parse/Pidl/Samba3/ServerNDR.pm \
+	  lib/Parse/Pidl/Compat.pm blib/lib/Parse/Pidl/Compat.pm \
+	  lib/Parse/Pidl/Expr.pm blib/lib/Parse/Pidl/Expr.pm \
+	  lib/Parse/Pidl/Samba4/NDR/Client.pm blib/lib/Parse/Pidl/Samba4/NDR/Client.pm \
+	  lib/Parse/Pidl/Samba4/NDR/Parser.pm blib/lib/Parse/Pidl/Samba4/NDR/Parser.pm \
+	  lib/Parse/Pidl/Util.pm blib/lib/Parse/Pidl/Util.pm \
+	  lib/Parse/Pidl/IDL.pm blib/lib/Parse/Pidl/IDL.pm \
+	  lib/wscript_build blib/lib/wscript_build \
+	  lib/Parse/Pidl.pm blib/lib/Parse/Pidl.pm \
+	  lib/Parse/Pidl/Samba4/TDR.pm blib/lib/Parse/Pidl/Samba4/TDR.pm \
+	  lib/Parse/Pidl/CUtil.pm blib/lib/Parse/Pidl/CUtil.pm \
+	  lib/Parse/Pidl/Samba4/COM/Stub.pm blib/lib/Parse/Pidl/Samba4/COM/Stub.pm \
+	  lib/Parse/Yapp/Driver.pm blib/lib/Parse/Yapp/Driver.pm \
+	  lib/Parse/Pidl/Samba4/Template.pm blib/lib/Parse/Pidl/Samba4/Template.pm \
+	  lib/Parse/Pidl/Samba4/Python.pm blib/lib/Parse/Pidl/Samba4/Python.pm \
+	  lib/Parse/Pidl/Samba4.pm blib/lib/Parse/Pidl/Samba4.pm \
+	  lib/Parse/Pidl/Samba3/ClientNDR.pm blib/lib/Parse/Pidl/Samba3/ClientNDR.pm \
+	  lib/Parse/Pidl/ODL.pm blib/lib/Parse/Pidl/ODL.pm \
+	  lib/Parse/Pidl/Wireshark/Conformance.pm blib/lib/Parse/Pidl/Wireshark/Conformance.pm \
+	  lib/Parse/Pidl/Wireshark/NDR.pm blib/lib/Parse/Pidl/Wireshark/NDR.pm \
+	  lib/Parse/Pidl/Samba4/COM/Proxy.pm blib/lib/Parse/Pidl/Samba4/COM/Proxy.pm \
+	  lib/Parse/Pidl/Samba4/COM/Header.pm blib/lib/Parse/Pidl/Samba4/COM/Header.pm \
+	  lib/Parse/Pidl/Samba4/Header.pm blib/lib/Parse/Pidl/Samba4/Header.pm \
+	  lib/Parse/Pidl/Samba4/NDR/Server.pm blib/lib/Parse/Pidl/Samba4/NDR/Server.pm \
+	  lib/Parse/Pidl/Typelist.pm blib/lib/Parse/Pidl/Typelist.pm \
+	  lib/Parse/Pidl/Dump.pm blib/lib/Parse/Pidl/Dump.pm 
+	$(NOECHO) $(TOUCH) pm_to_blib
+
+
+# --- MakeMaker selfdocument section:
+
+
+# --- MakeMaker postamble section:
+lib/Parse/Pidl/IDL.pm: idl.yp
+	yapp -m 'Parse::Pidl::IDL' -o lib/Parse/Pidl/IDL.pm idl.yp
+
+lib/Parse/Pidl/Expr.pm: expr.yp
+	yapp -m 'Parse::Pidl::Expr' -o lib/Parse/Pidl/Expr.pm expr.yp
+
+
+# End.

pidl/Makefile.PL

@@ -0,0 +1,17 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+    'NAME'	=> 'Parse::Pidl',
+    'VERSION_FROM' => 'lib/Parse/Pidl.pm',
+	'EXE_FILES' => [ 'pidl' ],
+	'test' => { 'TESTS' => 'tests/*.pl' }
+);
+
+sub MY::postamble {
+<<'EOT';
+lib/Parse/Pidl/IDL.pm: idl.yp
+	yapp -m 'Parse::Pidl::IDL' -o lib/Parse/Pidl/IDL.pm idl.yp
+
+lib/Parse/Pidl/Expr.pm: expr.yp
+	yapp -m 'Parse::Pidl::Expr' -o lib/Parse/Pidl/Expr.pm expr.yp
+EOT
+}

pidl/README

@@ -0,0 +1,63 @@
+Introduction:
+=============
+This directory contains the source code of the pidl (Perl IDL) 
+compiler for Samba 4. 
+
+The main sources for pidl are available using Git as part of
+the combined Samba 3 / Samba 4 tree. Use:
+git clone git://git.samba.org/samba.git
+
+Pidl works by building a parse tree from a .pidl file (a simple 
+dump of it's internal parse tree) or a .idl file 
+(a file format mostly like the IDL file format midl uses). 
+The IDL file parser is in idl.yp (a yacc file converted to 
+perl code by yapp)
+
+After a parse tree is present, pidl will call one of it's backends 
+(which one depends on the options given on the command-line). Here is 
+a list of current backends:
+
+Standalone installation:
+========================
+Run Makefile.PL to generate the Makefile. 
+
+Then run "make install" (as root) to install.
+
+Internals overview:
+===================
+
+-- Generic --
+Parse::Pidl::Dump - Converts the parse tree back to an IDL file
+Parse::Pidl::Samba4::Header - Generates header file with data structures defined in IDL file
+Parse::Pidl::NDR - Generates intermediate datastructures for use by NDR parses/generators
+Parse::Pidl::ODL - Generates IDL structures from ODL structures for use in the NDR parser generator
+Parse::Pidl::Test - Utility functions for use in pidl's testsuite
+
+-- Samba NDR --
+Parse::Pidl::Samba4::NDR::Client - Generates client call functions in C using the NDR parser
+Parse::Pidl::Samba4::NDR::Parser - Generates pull/push functions for parsing NDR
+Parse::Pidl::Samba4::NDR::Server - Generates server side implementation in C
+Parse::Pidl::Samba4::TDR - Parser generator for the "Trivial Data Representation"
+Parse::Pidl::Samba4::Template - Generates stubs in C for server implementation
+Parse::Pidl::Samba4::Python - Generates bindings for Python
+
+-- Samba COM / DCOM --
+Parse::Pidl::Samba4::COM::Proxy - Generates proxy object for DCOM (client-side)
+Parse::Pidl::Samba4::COM::Stub - Generates stub call handler for DCOM (server-side)
+Parse::Pidl::Samba4::COM::Header - Generates headers for COM
+
+-- Wireshark --
+Parse::Pidl::Wireshark::NDR - Generates a parser for the Wireshark network sniffer
+Parse::Pidl::Wireshark::Conformance - Reads conformance files containing additional data for generating Wireshark parsers
+
+-- Utility modules --
+Parse::Pidl::Util - Misc utility functions used by *.pm and pidl.pl
+Parse::Pidl::Typelist - Utility functions for keeping track of known types and their representation in C
+
+Tips for hacking on pidl:
+ - Look at the pidl's parse tree by using the --keep option and looking 
+   at the generated .pidl file. 
+ - The various backends have a lot in common, if you don't understand how one 
+   implements something, look at the others
+ - See pidl(1) and the documentation on midl
+ - See 'info bison' and yapp(1) for information on the file format of idl.yp 

pidl/TODO

@@ -0,0 +1,44 @@
+- warn when union instances don't have a discriminant
+
+- true multiple dimension array / strings in arrays support
+
+- compatibility mode for generating MIDL-readable data:
+ - strip out pidl-specific properties
+
+- make bitmap an optional attribute on enum
+- support nested elements
+- support typedefs properly (e.g. allow "typedef void **bla;")
+- make typedefs generate real typedefs
+- improve represent_as(): allow it to be used for arrays and other complex 
+  types
+
+- --explain-ndr option that dumps out parse tree ?
+
+- seperate tables for NDR and DCE/RPC
+ - maybe no tables for NDR at all? we only need them for ndrdump 
+   and that can use dlsym()
+
+- allow data structures outside of interfaces
+
+- mem_ctx in the interface rather than as struct ndr member.
+
+- real typelibs
+
+- fix [in,out] handling and allocation for samba3:
+ - add inout
+ - make NULL to mean "allocate me"
+ - remove NDR_AUTO_REF_ALLOC flag
+
+- automatic test generator based on IDL pointer types
+
+- support converting structs to tuples in Python rather than objects
+- convert structs with a single mattering member to that member directly, e.g.:
+  struct bar {
+    int size;
+	[size_is(size)] uint32 *array;
+  };
+
+  should be converted to an array of uint32's
+
+- python: fill in size members automatically in some places if the struct isn't being returned
+  (so we don't have to cope with the array growing)

pidl/expr.yp

@@ -0,0 +1,202 @@
+# expr.yp
+# Copyright (C) 2006 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU GPL
+# 
+%left	'->'
+%right	'!' '~'
+%left	'*' '/' '%'
+%left	'+' '-'
+%left	'<<' '>>'
+%left	'>' '<'
+%left	'==' '!='
+%left	'&'
+%left	'|'
+%left	'&&'
+%left	'||'
+%left	'?' ':'
+%left	NEG DEREF ADDROF INV
+%left	'.'
+
+%%
+exp:
+	NUM
+	|
+	TEXT                { "\"$_[1]\"" }
+	|
+	func
+	|
+	var
+	|
+	'~' exp %prec INV   { "~$_[2]" }
+	|
+	exp '+' exp         { "$_[1] + $_[3]" }
+	|
+	exp '-' exp         { "$_[1] - $_[3]" }
+	|
+	exp '*' exp         { "$_[1] * $_[3]" }
+	|
+	exp '%' exp         { "$_[1] % $_[3]" }
+	|
+	exp '<' exp         { "$_[1] < $_[3]" }
+	|
+	exp '>' exp         { "$_[1] > $_[3]" }
+	|
+	exp '|' exp         { "$_[1] | $_[3]" }
+	|
+	exp '==' exp        { "$_[1] == $_[3]" }
+	|
+	exp '<=' exp        { "$_[1] <= $_[3]" }
+	|
+	exp '=>' exp        { "$_[1] => $_[3]" }
+	|
+	exp '<<' exp        { "$_[1] << $_[3]" }
+	|
+	exp '>>' exp        { "$_[1] >> $_[3]" }
+	|
+	exp '!=' exp        { "$_[1] != $_[3]" }
+	|
+	exp '||' exp        { "$_[1] || $_[3]" }
+	|
+	exp '&&' exp        { "$_[1] && $_[3]" }
+	|
+	exp '&' exp         { "$_[1] & $_[3]" }
+	|
+	exp '?' exp ':' exp { "$_[1]?$_[3]:$_[5]" }
+	|
+	'~' exp             { "~$_[1]" }
+	|
+	'!' exp             { "not $_[1]" }
+	|
+	exp '/' exp         { "$_[1] / $_[3]" }
+	|
+	'-' exp %prec NEG   { "-$_[2]" }
+	|
+	'&' exp %prec ADDROF { "&$_[2]" }
+	|
+	exp '^' exp         { "$_[1]^$_[3]" }
+	|
+	'(' exp ')'         { "($_[2])" }
+;
+
+possible_pointer:
+	VAR                              { $_[0]->_Lookup($_[1]) }
+	|
+	'*' possible_pointer %prec DEREF { $_[0]->_Dereference($_[2]); "*$_[2]" }
+;
+
+var:
+	possible_pointer    { $_[0]->_Use($_[1]) }
+	|
+	var '.'	VAR         { $_[0]->_Use("$_[1].$_[3]") }
+	|
+	'(' var ')'         { "($_[2])" }
+	|
+	var '->' VAR        { $_[0]->_Use("*$_[1]"); $_[1]."->".$_[3] }
+;
+
+
+func:
+	VAR '(' opt_args ')' { "$_[1]($_[3])" }
+;
+
+opt_args:
+	#empty
+	{ "" }
+	|
+	args
+;
+
+exp_or_possible_pointer:
+	exp
+	|
+	possible_pointer
+;
+
+args:
+	exp_or_possible_pointer
+	|
+	exp_or_possible_pointer ',' args { "$_[1], $_[3]" }
+;
+
+%%
+
+package Parse::Pidl::Expr;
+
+sub _Lexer {
+	my($parser)=shift;
+
+	$parser->YYData->{INPUT}=~s/^[ \t]//;
+
+	for ($parser->YYData->{INPUT}) {
+		if (s/^(0x[0-9A-Fa-f]+)//) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+			return('NUM',$1);
+		}
+		if (s/^([0-9]+(?:\.[0-9]+)?)//) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+			return('NUM',$1);
+		}
+		if (s/^([A-Za-z_][A-Za-z0-9_]*)//) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+			return('VAR',$1);
+		}
+		if (s/^\"(.*?)\"//) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+			return('TEXT',$1); 
+		}
+		if (s/^(==|!=|<=|>=|->|\|\||<<|>>|&&)//s) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+			return($1,$1);
+		}
+		if (s/^(.)//s) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+			return($1,$1);
+		}
+	}
+}
+
+sub _Use($$)
+{
+	my ($self, $x) = @_;
+	if (defined($self->YYData->{USE})) {
+		return $self->YYData->{USE}->($x);
+	}
+	return $x;
+}
+
+sub _Lookup($$) 
+{
+	my ($self, $x) = @_;
+	return $self->YYData->{LOOKUP}->($x);
+}
+
+sub _Dereference($$)
+{
+	my ($self, $x) = @_;
+	if (defined($self->YYData->{DEREFERENCE})) {
+		$self->YYData->{DEREFERENCE}->($x);
+	}
+}
+
+sub _Error($)
+{
+	my ($self) = @_;
+	if (defined($self->YYData->{LAST_TOKEN})) {
+		$self->YYData->{ERROR}->("Parse error in `".$self->YYData->{FULL_INPUT}."' near `". $self->YYData->{LAST_TOKEN} . "'");
+	} else {
+		$self->YYData->{ERROR}->("Parse error in `".$self->YYData->{FULL_INPUT}."'");
+	}
+}
+
+sub Run {
+	my($self, $data, $error, $lookup, $deref, $use) = @_;
+
+	$self->YYData->{FULL_INPUT} = $data;
+	$self->YYData->{INPUT} = $data;
+	$self->YYData->{LOOKUP} = $lookup;
+	$self->YYData->{DEREFERENCE} = $deref;
+	$self->YYData->{ERROR} = $error;
+	$self->YYData->{USE} = $use;
+
+	return $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error);
+}

pidl/idl.yp

@@ -0,0 +1,694 @@
+########################
+# IDL Parse::Yapp parser
+# Copyright (C) Andrew Tridgell <tridge@samba.org>
+# released under the GNU GPL version 3 or later
+
+
+
+# the precedence actually doesn't matter at all for this grammar, but
+# by providing a precedence we reduce the number of conflicts
+# enormously
+%left   '-' '+' '&' '|' '*' '>' '.' '/' '(' ')' '[' ',' ';'
+
+
+################
+# grammar
+%%
+idl: 
+	#empty  { {} }
+	|
+	idl interface { push(@{$_[1]}, $_[2]); $_[1] }
+	|
+	idl coclass   { push(@{$_[1]}, $_[2]); $_[1] }
+	|
+	idl import    { push(@{$_[1]}, $_[2]); $_[1] }
+	|
+	idl include   { push(@{$_[1]}, $_[2]); $_[1] }
+	|
+	idl importlib { push(@{$_[1]}, $_[2]); $_[1] }
+	|
+	idl cpp_quote { push(@{$_[1]}, $_[2]); $_[1] }
+;
+
+import:
+	'import' commalist ';'
+	{{
+		"TYPE" => "IMPORT",
+		"PATHS" => $_[2],
+		"FILE" => $_[0]->YYData->{FILE},
+		"LINE" => $_[0]->YYData->{LINE},
+	}}
+;
+
+include:
+	'include' commalist ';'
+	{{
+		"TYPE" => "INCLUDE",
+		"PATHS" => $_[2],
+		"FILE" => $_[0]->YYData->{FILE},
+		"LINE" => $_[0]->YYData->{LINE},
+	}}
+;
+
+importlib:
+	'importlib' commalist ';'
+	{{
+		"TYPE" => "IMPORTLIB",
+		"PATHS" => $_[2],
+		"FILE" => $_[0]->YYData->{FILE},
+		"LINE" => $_[0]->YYData->{LINE},
+	}}
+;
+
+commalist:
+	text { [ $_[1] ] }
+	|
+	commalist ',' text { push(@{$_[1]}, $_[3]); $_[1] }
+;
+
+coclass:
+	property_list 'coclass' identifier '{' interface_names '}' optional_semicolon
+	{{
+		"TYPE" => "COCLASS",
+		"PROPERTIES" => $_[1],
+		"NAME" => $_[3],
+		"DATA" => $_[5],
+		"FILE" => $_[0]->YYData->{FILE},
+		"LINE" => $_[0]->YYData->{LINE},
+	}}
+;
+
+interface_names:
+	#empty { {} }
+	|
+	interface_names 'interface' identifier ';' { push(@{$_[1]}, $_[2]); $_[1] }
+;
+
+interface:
+	property_list 'interface' identifier base_interface '{' definitions '}' optional_semicolon
+	{{
+		"TYPE" => "INTERFACE",
+		"PROPERTIES" => $_[1],
+		"NAME" => $_[3],
+		"BASE" => $_[4],
+		"DATA" => $_[6],
+		"FILE" => $_[0]->YYData->{FILE},
+		"LINE" => $_[0]->YYData->{LINE},
+	}}
+;
+
+base_interface:
+	#empty
+	|
+	':' identifier { $_[2] }
+;
+
+
+cpp_quote:
+	'cpp_quote' '(' text ')'
+	{{
+		 "TYPE" => "CPP_QUOTE",
+		 "DATA" => $_[3],
+		 "FILE" => $_[0]->YYData->{FILE},
+		 "LINE" => $_[0]->YYData->{LINE},
+	}}
+;
+
+definitions:
+	definition              { [ $_[1] ] }
+	|
+	definitions definition  { push(@{$_[1]}, $_[2]); $_[1] }
+;
+
+definition:
+	function
+	|
+	const
+	|
+	typedef
+	|
+	typedecl
+;
+
+const:
+	'const' identifier pointers identifier '=' anytext ';'
+	{{
+		"TYPE"  => "CONST",
+		"DTYPE"  => $_[2],
+		"POINTERS" => $_[3],
+		"NAME"  => $_[4],
+		"VALUE" => $_[6],
+		"FILE" => $_[0]->YYData->{FILE},
+		"LINE" => $_[0]->YYData->{LINE},
+	}}
+	|
+	'const' identifier pointers identifier array_len '=' anytext ';'
+	{{
+		"TYPE"  => "CONST",
+		"DTYPE"  => $_[2],
+		"POINTERS" => $_[3],
+		"NAME"  => $_[4],
+		"ARRAY_LEN" => $_[5],
+		"VALUE" => $_[7],
+		"FILE" => $_[0]->YYData->{FILE},
+		"LINE" => $_[0]->YYData->{LINE},
+	}}
+;
+
+function:
+	property_list type identifier '(' element_list2 ')' ';'
+	{{
+		"TYPE" => "FUNCTION",
+		"NAME" => $_[3],
+		"RETURN_TYPE" => $_[2],
+		"PROPERTIES" => $_[1],
+		"ELEMENTS" => $_[5],
+		"FILE" => $_[0]->YYData->{FILE},
+		"LINE" => $_[0]->YYData->{LINE},
+	}}
+;
+
+typedef:
+	property_list 'typedef' type pointers identifier array_len ';'
+	{{
+		"TYPE" => "TYPEDEF",
+		"PROPERTIES" => $_[1],
+		"NAME" => $_[5],
+		"DATA" => $_[3],
+		"POINTERS" => $_[4],
+		"ARRAY_LEN" => $_[6],
+		"FILE" => $_[0]->YYData->{FILE},
+		"LINE" => $_[0]->YYData->{LINE},
+        }}
+;
+
+usertype:
+	struct
+	|
+	union
+	|
+	enum
+	|
+	bitmap
+	|
+	pipe
+;
+
+typedecl:
+	usertype ';' { $_[1] }
+;
+
+sign:
+	'signed'
+	|
+	'unsigned'
+;
+
+existingtype:
+	sign identifier { ($_[1]?$_[1]:"signed") ." $_[2]" }
+	|
+	identifier
+;
+
+type:
+	usertype
+	|
+	existingtype
+	|
+	void { "void" }
+;
+
+enum_body:
+	'{' enum_elements '}' { $_[2] }
+;
+
+opt_enum_body:
+	#empty
+	|
+	enum_body
+;
+
+enum:
+	property_list 'enum' optional_identifier opt_enum_body
+	{{
+		"TYPE" => "ENUM",
+		"PROPERTIES" => $_[1],
+		"NAME" => $_[3],
+		"ELEMENTS" => $_[4],
+		"FILE" => $_[0]->YYData->{FILE},
+		"LINE" => $_[0]->YYData->{LINE},
+	}}
+;
+
+enum_elements:
+	enum_element                    { [ $_[1] ] }
+	|
+	enum_elements ',' enum_element  { push(@{$_[1]}, $_[3]); $_[1] }
+;
+
+enum_element:
+	identifier
+	|
+	identifier '=' anytext { "$_[1]$_[2]$_[3]" }
+;
+
+bitmap_body:
+	'{' opt_bitmap_elements '}' { $_[2] }
+;
+
+opt_bitmap_body:
+	#empty
+	|
+	bitmap_body
+;
+
+bitmap:
+	property_list 'bitmap' optional_identifier opt_bitmap_body
+	{{
+		"TYPE" => "BITMAP",
+		"PROPERTIES" => $_[1],
+		"NAME" => $_[3],
+		"ELEMENTS" => $_[4],
+		"FILE" => $_[0]->YYData->{FILE},
+		"LINE" => $_[0]->YYData->{LINE},
+	}}
+;
+
+bitmap_elements:
+	bitmap_element                      { [ $_[1] ] }
+	|
+	bitmap_elements ',' bitmap_element  { push(@{$_[1]}, $_[3]); $_[1] }
+;
+
+opt_bitmap_elements:
+	#empty
+	|
+	bitmap_elements
+;
+
+bitmap_element:
+	identifier '=' anytext { "$_[1] ( $_[3] )" }
+;
+
+struct_body:
+	'{' element_list1 '}' { $_[2] }
+;
+
+opt_struct_body:
+	#empty
+	|
+	struct_body
+;
+
+struct:
+	property_list 'struct' optional_identifier opt_struct_body
+	{{
+		"TYPE" => "STRUCT",
+		"PROPERTIES" => $_[1],
+		"NAME" => $_[3],
+		"ELEMENTS" => $_[4],
+		"FILE" => $_[0]->YYData->{FILE},
+		"LINE" => $_[0]->YYData->{LINE},
+	}}
+;
+
+empty_element:
+	property_list ';'
+	{{
+		"NAME" => "",
+		"TYPE" => "EMPTY",
+		"PROPERTIES" => $_[1],
+		"POINTERS" => 0,
+		"ARRAY_LEN" => [],
+		"FILE" => $_[0]->YYData->{FILE},
+		"LINE" => $_[0]->YYData->{LINE},
+	}}
+;
+
+base_or_empty:
+	base_element ';'
+	|
+	empty_element;
+
+optional_base_element:
+	property_list base_or_empty { $_[2]->{PROPERTIES} = FlattenHash([$_[1],$_[2]->{PROPERTIES}]); $_[2] }
+;
+
+union_elements:
+	#empty
+	|
+	union_elements optional_base_element { push(@{$_[1]}, $_[2]); $_[1] }
+;
+
+union_body:
+	'{' union_elements '}' { $_[2] }
+;
+
+opt_union_body:
+	#empty
+	|
+	union_body
+;
+
+union:
+	property_list 'union' optional_identifier opt_union_body
+	{{
+		"TYPE" => "UNION",
+		"PROPERTIES" => $_[1],
+		"NAME" => $_[3],
+		"ELEMENTS" => $_[4],
+		"FILE" => $_[0]->YYData->{FILE},
+		"LINE" => $_[0]->YYData->{LINE},
+	}}
+;
+
+base_element:
+	property_list type pointers identifier array_len
+	{{
+		"NAME" => $_[4],
+		"TYPE" => $_[2],
+		"PROPERTIES" => $_[1],
+		"POINTERS" => $_[3],
+		"ARRAY_LEN" => $_[5],
+		"FILE" => $_[0]->YYData->{FILE},
+		"LINE" => $_[0]->YYData->{LINE},
+	}}
+;
+
+pointers:
+	#empty
+	{ 0 }
+	|
+	pointers '*'  { $_[1]+1 }
+;
+
+pipe:
+	property_list 'pipe' type
+	{{
+		"TYPE" => "PIPE",
+		"PROPERTIES" => $_[1],
+		"NAME" => undef,
+		"DATA" => {
+			"TYPE" => "STRUCT",
+			"PROPERTIES" => $_[1],
+			"NAME" => undef,
+			"ELEMENTS" => [{
+				"NAME" => "count",
+				"PROPERTIES" => $_[1],
+				"POINTERS" => 0,
+				"ARRAY_LEN" => [],
+				"TYPE" => "uint3264",
+				"FILE" => $_[0]->YYData->{FILE},
+				"LINE" => $_[0]->YYData->{LINE},
+			},{
+				"NAME" => "array",
+				"PROPERTIES" => $_[1],
+				"POINTERS" => 0,
+				"ARRAY_LEN" => [ "count" ],
+				"TYPE" => $_[3],
+				"FILE" => $_[0]->YYData->{FILE},
+				"LINE" => $_[0]->YYData->{LINE},
+			}],
+			"FILE" => $_[0]->YYData->{FILE},
+			"LINE" => $_[0]->YYData->{LINE},
+		},
+		"FILE" => $_[0]->YYData->{FILE},
+		"LINE" => $_[0]->YYData->{LINE},
+	}}
+;
+
+element_list1:
+	#empty
+	{ [] }
+	|
+	element_list1 base_element ';' { push(@{$_[1]}, $_[2]); $_[1] }
+;
+
+optional_const:
+	#empty
+	|
+	'const'
+;
+
+element_list2:
+	#empty
+	|
+	'void'
+	|
+	optional_const base_element { [ $_[2] ] }
+	|
+	element_list2 ',' optional_const base_element { push(@{$_[1]}, $_[4]); $_[1] }
+;
+
+array_len:
+	#empty { [] }
+	|
+	'[' ']' array_len           { push(@{$_[3]}, "*"); $_[3] }
+	|
+	'[' anytext ']' array_len   { push(@{$_[4]}, "$_[2]"); $_[4] }
+;
+
+property_list:
+	#empty
+	|
+	property_list '[' properties ']' { FlattenHash([$_[1],$_[3]]); }
+;
+
+properties:
+	property                { $_[1] }
+	|
+	properties ',' property { FlattenHash([$_[1], $_[3]]); }
+;
+
+property:
+	identifier                       {{ "$_[1]" => "1"     }}
+	|
+	identifier '(' commalisttext ')' {{ "$_[1]" => "$_[3]" }}
+;
+
+commalisttext:
+	anytext
+	|
+	commalisttext ',' anytext { "$_[1],$_[3]" }
+;
+
+anytext:
+	#empty
+	{ "" }
+	|
+	identifier
+	|
+	constant
+	|
+	text
+	|
+	anytext '-' anytext  { "$_[1]$_[2]$_[3]" }
+	|
+	anytext '.' anytext  { "$_[1]$_[2]$_[3]" }
+	|
+	anytext '*' anytext  { "$_[1]$_[2]$_[3]" }
+	|
+	anytext '>' anytext  { "$_[1]$_[2]$_[3]" }
+	|
+	anytext '<' anytext  { "$_[1]$_[2]$_[3]" }
+	|
+	anytext '|' anytext  { "$_[1]$_[2]$_[3]" }
+	|
+	anytext '&' anytext  { "$_[1]$_[2]$_[3]" }
+	|
+	anytext '/' anytext  { "$_[1]$_[2]$_[3]" }
+	|
+	anytext '?' anytext  { "$_[1]$_[2]$_[3]" }
+	|
+	anytext ':' anytext  { "$_[1]$_[2]$_[3]" }
+	|
+	anytext '=' anytext  { "$_[1]$_[2]$_[3]" }
+	|
+	anytext '+' anytext  { "$_[1]$_[2]$_[3]" }
+	|
+	anytext '~' anytext  { "$_[1]$_[2]$_[3]" }
+	|
+	anytext '(' commalisttext ')' anytext  { "$_[1]$_[2]$_[3]$_[4]$_[5]" }
+	|
+	anytext '{' commalisttext '}' anytext  { "$_[1]$_[2]$_[3]$_[4]$_[5]" }
+;
+
+identifier:
+	IDENTIFIER
+;
+
+optional_identifier:
+	#empty { undef }
+	|
+	IDENTIFIER
+;
+
+constant:
+	CONSTANT
+;
+
+text:
+	TEXT { "\"$_[1]\"" }
+;
+
+optional_semicolon:
+	#empty
+	|
+	';'
+;
+
+
+#####################################
+# start code
+%%
+
+use Parse::Pidl qw(error);
+
+#####################################################################
+# 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;
+
+	return undef if (not defined($v));
+
+	if (ref($v) eq "ARRAY") {
+		foreach my $i (0 .. $#{$v}) {
+			CleanData($v->[$i]);
+		}
+		# 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;
+			}
+		}
+	}
+
+	return $v;
+}
+
+sub _Error {
+	if (exists $_[0]->YYData->{ERRMSG}) {
+		error($_[0]->YYData, $_[0]->YYData->{ERRMSG});
+		delete $_[0]->YYData->{ERRMSG};
+		return;
+	}
+
+	my $last_token = $_[0]->YYData->{LAST_TOKEN};
+
+	error($_[0]->YYData, "Syntax error near '$last_token'");
+}
+
+sub _Lexer($)
+{
+	my($parser)=shift;
+
+	$parser->YYData->{INPUT} or return('',undef);
+
+again:
+	$parser->YYData->{INPUT} =~ s/^[ \t]*//;
+
+	for ($parser->YYData->{INPUT}) {
+		if (/^\#/) {
+			if (s/^\# (\d+) \"(.*?)\"( \d+|)//) {
+				$parser->YYData->{LINE} = $1-1;
+				$parser->YYData->{FILE} = $2;
+				goto again;
+			}
+			if (s/^\#line (\d+) \"(.*?)\"( \d+|)//) {
+				$parser->YYData->{LINE} = $1-1;
+				$parser->YYData->{FILE} = $2;
+				goto again;
+			}
+			if (s/^(\#.*)$//m) {
+				goto again;
+			}
+		}
+		if (s/^(\n)//) {
+			$parser->YYData->{LINE}++;
+			goto again;
+		}
+		if (s/^\"(.*?)\"//) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+			return('TEXT',$1);
+		}
+		if (s/^(\d+)(\W|$)/$2/) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+			return('CONSTANT',$1);
+		}
+		if (s/^([\w_]+)//) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+			if ($1 =~
+			    /^(coclass|interface|import|importlib
+			      |include|cpp_quote|typedef
+			      |union|struct|enum|bitmap|pipe
+			      |void|const|unsigned|signed)$/x) {
+				return $1;
+			}
+			return('IDENTIFIER',$1);
+		}
+		if (s/^(.)//s) {
+			$parser->YYData->{LAST_TOKEN} = $1;
+			return($1,$1);
+		}
+	}
+}
+
+sub parse_string
+{
+	my ($data,$filename) = @_;
+
+	my $self = new Parse::Pidl::IDL;
+
+	$self->YYData->{FILE} = $filename;
+	$self->YYData->{INPUT} = $data;
+	$self->YYData->{LINE} = 0;
+	$self->YYData->{LAST_TOKEN} = "NONE";
+
+	my $idl = $self->YYParse( yylex => \&_Lexer, yyerror => \&_Error );
+
+	return CleanData($idl);
+}
+
+sub parse_file($$)
+{
+	my ($filename,$incdirs) = @_;
+
+	my $saved_delim = $/;
+	undef $/;
+	my $cpp = $ENV{CPP};
+	my $options = "";
+	if (! defined $cpp) {
+		if (defined $ENV{CC}) {
+			$cpp = "$ENV{CC}";
+			$options = "-E";
+		} else {
+			$cpp = "cpp";
+		}
+	}
+	my $includes = join('',map { " -I$_" } @$incdirs);
+	my $data = `$cpp $options -D__PIDL__$includes -xc "$filename"`;
+	$/ = $saved_delim;
+
+	return parse_string($data, $filename);
+}

pidl/lib/Parse/Pidl.pm

@@ -0,0 +1,44 @@
+###################################################
+# package to parse IDL files and generate code for
+# rpc functions in Samba
+# Copyright tridge@samba.org 2000-2003
+# Copyright jelmer@samba.org 2005
+# released under the GNU GPL
+
+package Parse::Pidl;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(warning error fatal $VERSION);
+
+use strict;
+
+use vars qw ( $VERSION );
+
+$VERSION = '0.02';
+
+sub warning
+{
+	my ($l,$m) = @_;
+	if ($l) {
+		print STDERR "$l->{FILE}:$l->{LINE}: ";
+	}
+	print STDERR "warning: $m\n";
+}
+
+sub error
+{
+	my ($l,$m) = @_;
+	if ($l) {
+		print STDERR "$l->{FILE}:$l->{LINE}: ";
+	}
+	print STDERR "error: $m\n";
+}
+
+sub fatal($$) 
+{ 
+    my ($e,$s) = @_; 
+    die("$e->{FILE}:$e->{LINE}: $s\n"); 
+}
+
+1;

pidl/lib/Parse/Pidl/CUtil.pm

@@ -0,0 +1,52 @@
+###################################################
+# C utility functions for pidl
+# Copyright jelmer@samba.org 2005-2007
+# released under the GNU GPL
+package Parse::Pidl::CUtil;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(get_pointer_to get_value_of get_array_element);
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+use strict;
+
+sub get_pointer_to($)
+{
+	my $var_name = shift;
+	
+	if ($var_name =~ /^\*(.*)$/) {
+		return $1;
+	} elsif ($var_name =~ /^\&(.*)$/) {
+		return "&($var_name)";
+	} else {
+		return "&$var_name";
+	}
+}
+
+sub get_value_of($)
+{
+	my $var_name = shift;
+
+	if ($var_name =~ /^\&(.*)$/) {
+		return $1;
+	} else {
+		return "*$var_name";
+	}
+}
+
+sub get_array_element($$)
+{
+	my ($var_name, $idx) = @_;
+
+	if ($var_name =~ /^\*.*$/) {
+		$var_name = "($var_name)";
+	} elsif ($var_name =~ /^\&.*$/) {
+		$var_name = "($var_name)";
+	}
+
+	return "$var_name"."[$idx]";
+}
+
+1;

pidl/lib/Parse/Pidl/Compat.pm

@@ -0,0 +1,168 @@
+###################################################
+# IDL Compatibility checker
+# Copyright jelmer@samba.org 2005
+# released under the GNU GPL
+
+package Parse::Pidl::Compat;
+
+use Parse::Pidl qw(warning);
+use Parse::Pidl::Util qw(has_property);
+use strict;
+
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+my %supported_properties = (
+	# interface
+	"helpstring"		=> ["INTERFACE", "FUNCTION"],
+	"version"		=> ["INTERFACE"],
+	"uuid"			=> ["INTERFACE"],
+	"endpoint"		=> ["INTERFACE"],
+	"pointer_default"	=> ["INTERFACE"],
+	"no_srv_register"	=> ["INTERFACE"],
+
+	# dcom
+	"object"		=> ["INTERFACE"],
+	"local"			=> ["INTERFACE", "FUNCTION"],
+	"iid_is"		=> ["ELEMENT"],
+	"call_as"		=> ["FUNCTION"],
+	"idempotent"		=> ["FUNCTION"],
+
+	# function
+	"in"			=> ["ELEMENT"],
+	"out"			=> ["ELEMENT"],
+
+	# pointer
+	"ref"			=> ["ELEMENT"],
+	"ptr"			=> ["ELEMENT"],
+	"unique"		=> ["ELEMENT"],
+	"ignore"		=> ["ELEMENT"],
+
+	"value"			=> ["ELEMENT"],
+
+	# generic
+	"public"		=> ["FUNCTION", "TYPEDEF"],
+	"nopush"		=> ["FUNCTION", "TYPEDEF"],
+	"nopull"		=> ["FUNCTION", "TYPEDEF"],
+	"noprint"		=> ["FUNCTION", "TYPEDEF"],
+        "nopython"              => ["FUNCTION", "TYPEDEF"],
+
+	# union
+	"switch_is"		=> ["ELEMENT"],
+	"switch_type"		=> ["ELEMENT", "TYPEDEF"],
+	"case"			=> ["ELEMENT"],
+	"default"		=> ["ELEMENT"],
+
+	# subcontext
+	"subcontext"		=> ["ELEMENT"],
+	"subcontext_size"	=> ["ELEMENT"],
+
+	# enum
+	"enum16bit"		=> ["TYPEDEF"],
+	"v1_enum"		=> ["TYPEDEF"],
+
+	# bitmap
+	"bitmap8bit"		=> ["TYPEDEF"],
+	"bitmap16bit"		=> ["TYPEDEF"],
+	"bitmap32bit"		=> ["TYPEDEF"],
+	"bitmap64bit"		=> ["TYPEDEF"],
+
+	# array
+	"range"			=> ["ELEMENT"],
+	"size_is"		=> ["ELEMENT"],
+	"string"		=> ["ELEMENT"],
+	"noheader"		=> ["ELEMENT"],
+	"charset"		=> ["ELEMENT"],
+	"length_is"		=> ["ELEMENT"],
+);
+
+sub CheckTypedef($)
+{
+	my ($td) = @_;
+
+	if (has_property($td, "nodiscriminant")) {
+		warning($td, "nodiscriminant property not supported");
+	}
+
+	if ($td->{TYPE} eq "BITMAP") {
+		warning($td, "converting bitmap to scalar");
+		#FIXME
+	}
+
+	if (has_property($td, "gensize")) {
+		warning($td, "ignoring gensize() property. ");
+	}
+
+	if (has_property($td, "enum8bit") and has_property($td, "enum16bit")) {
+		warning($td, "8 and 16 bit enums not supported, converting to scalar");
+		#FIXME
+	}
+
+	StripProperties($td);
+}
+
+sub CheckElement($)
+{
+	my $e = shift;
+
+	if (has_property($e, "noheader")) {
+		warning($e, "noheader property not supported");
+		return;
+	}
+
+	if (has_property($e, "subcontext")) {
+		warning($e, "converting subcontext to byte array");
+		#FIXME
+	}
+
+	if (has_property($e, "compression")) {
+		warning($e, "compression() property not supported");
+	}
+
+	if (has_property($e, "sptr")) {
+		warning($e, "sptr() pointer property not supported");
+	}
+
+	if (has_property($e, "relative")) {
+		warning($e, "relative() pointer property not supported");
+	}
+
+	if (has_property($e, "relative_short")) {
+		warning($e, "relative_short() pointer property not supported");
+	}
+
+	if (has_property($e, "flag")) {
+		warning($e, "ignoring flag() property");
+	}
+	
+	if (has_property($e, "value")) {
+		warning($e, "ignoring value() property");
+	}
+}
+
+sub CheckFunction($)
+{
+	my $fn = shift;
+
+	if (has_property($fn, "noopnum")) {
+		warning($fn, "noopnum not converted. Opcodes will be out of sync.");
+	}
+}
+
+sub CheckInterface($)
+{
+	my $if = shift;
+
+}
+
+sub Check($)
+{
+	my $pidl = shift;
+	my $nidl = [];
+
+	foreach (@{$pidl}) {
+		push (@$nidl, CheckInterface($_)) if ($_->{TYPE} eq "INTERFACE");
+	}
+}
+
+1;

pidl/lib/Parse/Pidl/Dump.pm

@@ -0,0 +1,294 @@
+###################################################
+# dump function for IDL structures
+# Copyright tridge@samba.org 2000
+# Copyright jelmer@samba.org 2005
+# released under the GNU GPL
+
+=pod
+
+=head1 NAME
+
+Parse::Pidl::Dump - Dump support
+
+=head1 DESCRIPTION
+
+This module provides functions that can generate IDL code from 
+internal pidl data structures.
+
+=cut
+
+package Parse::Pidl::Dump;
+
+use Exporter;
+
+use vars qw($VERSION);
+$VERSION = '0.01';
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(DumpType DumpTypedef DumpStruct DumpEnum DumpBitmap DumpUnion DumpFunction);
+
+use strict;
+use Parse::Pidl::Util qw(has_property);
+
+my($res);
+
+#####################################################################
+# dump a properties list
+sub DumpProperties($)
+{
+    my($props) = shift;
+    my $res = "";
+
+    foreach my $d ($props) {
+	foreach my $k (keys %{$d}) {
+	    if ($k eq "in") {
+		$res .= "[in] ";
+		next;
+	    }
+	    if ($k eq "out") {
+		$res .= "[out] ";
+		next;
+	    }
+	    if ($k eq "ref") {
+		$res .= "[ref] ";
+		next;
+	    }
+	    $res .= "[$k($d->{$k})] ";
+	}
+    }
+    return $res;
+}
+
+#####################################################################
+# dump a structure element
+sub DumpElement($)
+{
+    my($element) = shift;
+    my $res = "";
+
+    (defined $element->{PROPERTIES}) && 
+	($res .= DumpProperties($element->{PROPERTIES}));
+    $res .= DumpType($element->{TYPE});
+    $res .= " ";
+	for my $i (1..$element->{POINTERS}) {
+	    $res .= "*";
+    }
+    $res .= "$element->{NAME}";
+	foreach (@{$element->{ARRAY_LEN}}) {
+		$res .= "[$_]";
+	}
+
+    return $res;
+}
+
+#####################################################################
+# dump a struct
+sub DumpStruct($)
+{
+    my($struct) = shift;
+    my($res);
+
+    $res .= "struct ";
+	if ($struct->{NAME}) {
+		$res.="$struct->{NAME} ";
+	}
+	
+	$res.="{\n";
+    if (defined $struct->{ELEMENTS}) {
+		foreach (@{$struct->{ELEMENTS}}) {
+		    $res .= "\t" . DumpElement($_) . ";\n";
+		}
+    }
+    $res .= "}";
+    
+    return $res;
+}
+
+
+#####################################################################
+# dump a struct
+sub DumpEnum($)
+{
+    my($enum) = shift;
+    my($res);
+
+    $res .= "enum {\n";
+
+    foreach (@{$enum->{ELEMENTS}}) {
+    	if (/^([A-Za-z0-9_]+)[ \t]*\((.*)\)$/) {
+		$res .= "\t$1 = $2,\n";
+	} else {
+		$res .= "\t$_,\n";
+	}
+    }
+
+    $res.= "}";
+    
+    return $res;
+}
+
+#####################################################################
+# dump a struct
+sub DumpBitmap($)
+{
+    my($bitmap) = shift;
+    my($res);
+
+    $res .= "bitmap {\n";
+
+    foreach (@{$bitmap->{ELEMENTS}}) {
+    	if (/^([A-Za-z0-9_]+)[ \t]*\((.*)\)$/) {
+		$res .= "\t$1 = $2,\n";
+	} else {
+		die ("Bitmap $bitmap->{NAME} has field $_ without proper value");
+	}
+    }
+
+    $res.= "}";
+    
+    return $res;
+}
+
+
+#####################################################################
+# dump a union element
+sub DumpUnionElement($)
+{
+    my($element) = shift;
+    my($res);
+
+    if (has_property($element, "default")) {
+	$res .= "[default] ;\n";
+    } else {
+	$res .= "[case($element->{PROPERTIES}->{case})] ";
+	$res .= DumpElement($element), if defined($element);
+	$res .= ";\n";
+    }
+
+    return $res;
+}
+
+#####################################################################
+# dump a union
+sub DumpUnion($)
+{
+    my($union) = shift;
+    my($res);
+
+    (defined $union->{PROPERTIES}) && 
+	($res .= DumpProperties($union->{PROPERTIES}));
+    $res .= "union {\n";
+    foreach my $e (@{$union->{ELEMENTS}}) {
+	$res .= DumpUnionElement($e);
+    }
+    $res .= "}";
+
+    return $res;
+}
+
+#####################################################################
+# dump a type
+sub DumpType($)
+{
+    my($data) = shift;
+
+    if (ref($data) eq "HASH") {
+		return DumpStruct($data) if ($data->{TYPE} eq "STRUCT");
+		return DumpUnion($data) if ($data->{TYPE} eq "UNION");
+		return DumpEnum($data) if ($data->{TYPE} eq "ENUM");
+		return DumpBitmap($data) if ($data->{TYPE} eq "BITMAP");
+    } else {
+		return $data;
+    }
+}
+
+#####################################################################
+# dump a typedef
+sub DumpTypedef($)
+{
+    my($typedef) = shift;
+    my($res);
+
+    $res .= "typedef ";
+    $res .= DumpType($typedef->{DATA});
+    $res .= " $typedef->{NAME};\n\n";
+
+    return $res;
+}
+
+#####################################################################
+# dump a typedef
+sub DumpFunction($)
+{
+    my($function) = shift;
+    my($first) = 1;
+    my($res);
+
+    $res .= DumpType($function->{RETURN_TYPE});
+    $res .= " $function->{NAME}(\n";
+    for my $d (@{$function->{ELEMENTS}}) {
+		unless ($first) { $res .= ",\n"; } $first = 0;
+		$res .= DumpElement($d);
+    }
+    $res .= "\n);\n\n";
+
+    return $res;
+}
+
+#####################################################################
+# dump a module header
+sub DumpInterfaceProperties($)
+{
+    my($header) = shift;
+    my($data) = $header->{DATA};
+    my($first) = 1;
+    my($res);
+
+    $res .= "[\n";
+    foreach my $k (keys %{$data}) {
+	    $first || ($res .= ",\n"); $first = 0;
+	    $res .= "$k($data->{$k})";
+    }
+    $res .= "\n]\n";
+
+    return $res;
+}
+
+#####################################################################
+# dump the interface definitions
+sub DumpInterface($)
+{
+    my($interface) = shift;
+    my($data) = $interface->{DATA};
+    my($res);
+
+	$res .= DumpInterfaceProperties($interface->{PROPERTIES});
+
+    $res .= "interface $interface->{NAME}\n{\n";
+    foreach my $d (@{$data}) {
+	($d->{TYPE} eq "TYPEDEF") &&
+	    ($res .= DumpTypedef($d));
+	($d->{TYPE} eq "FUNCTION") &&
+	    ($res .= DumpFunction($d));
+    }
+    $res .= "}\n";
+
+    return $res;
+}
+
+
+#####################################################################
+# dump a parsed IDL structure back into an IDL file
+sub Dump($)
+{
+    my($idl) = shift;
+    my($res);
+
+    $res = "/* Dumped by pidl */\n\n";
+    foreach my $x (@{$idl}) {
+	($x->{TYPE} eq "INTERFACE") && 
+	    ($res .= DumpInterface($x));
+    }
+    return $res;
+}
+
+1;

pidl/lib/Parse/Pidl/ODL.pm

@@ -0,0 +1,130 @@
+##########################################
+# Converts ODL stuctures to IDL structures
+# (C) 2004-2005, 2008 Jelmer Vernooij <jelmer@samba.org>
+
+package Parse::Pidl::ODL;
+
+use Parse::Pidl qw(error);
+use Parse::Pidl::IDL;
+use Parse::Pidl::Util qw(has_property unmake_str);
+use Parse::Pidl::Typelist qw(hasType getType);
+use File::Basename;
+use strict;
+
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+sub FunctionAddObjArgs($)
+{
+	my $e = shift;
+	
+	unshift(@{$e->{ELEMENTS}}, {
+		'NAME' => 'ORPCthis',
+		'POINTERS' => 0,
+		'PROPERTIES' => { 'in' => '1' },
+		'TYPE' => 'ORPCTHIS',
+		'FILE' => $e->{FILE},
+		'LINE' => $e->{LINE}
+	});
+	unshift(@{$e->{ELEMENTS}}, {
+		'NAME' => 'ORPCthat',
+		'POINTERS' => 1,
+		'PROPERTIES' => { 'out' => '1', 'ref' => '1' },
+		'TYPE' => 'ORPCTHAT',
+		'FILE' => $e->{FILE},
+		'LINE' => $e->{LINE}
+	});
+}
+
+sub ReplaceInterfacePointers($)
+{
+	my ($e) = @_;
+	foreach my $x (@{$e->{ELEMENTS}}) {
+		next unless (hasType($x->{TYPE}));
+		next unless getType($x->{TYPE})->{DATA}->{TYPE} eq "INTERFACE";
+		
+		$x->{TYPE} = "MInterfacePointer";
+	}
+}
+
+# Add ORPC specific bits to an interface.
+sub ODL2IDL
+{
+	my ($odl, $basedir, $opt_incdirs) = (@_);
+	my $addedorpc = 0;
+	my $interfaces = {};
+
+	foreach my $x (@$odl) {
+		if ($x->{TYPE} eq "IMPORT") {
+			foreach my $idl_file (@{$x->{PATHS}}) {
+				$idl_file = unmake_str($idl_file);
+				my $idl_path = undef;
+				foreach ($basedir, @$opt_incdirs) {
+					if (-f "$_/$idl_file") {
+						$idl_path = "$_/$idl_file";
+						last;
+					}
+				}
+				unless ($idl_path) {
+					error($x, "Unable to open include file `$idl_file'");
+					next;
+				}
+				my $podl = Parse::Pidl::IDL::parse_file($idl_path, $opt_incdirs);
+				if (defined(@$podl)) {
+					require Parse::Pidl::Typelist;
+					my $basename = basename($idl_path, ".idl");
+
+					Parse::Pidl::Typelist::LoadIdl($podl, $basename);
+					my $pidl = ODL2IDL($podl, $basedir, $opt_incdirs);
+
+					foreach my $y (@$pidl) {
+						if ($y->{TYPE} eq "INTERFACE") {
+							$interfaces->{$y->{NAME}} = $y;
+						}
+					}
+				} else {
+					error($x, "Failed to parse $idl_path");
+				}
+			}
+		}
+
+		if ($x->{TYPE} eq "INTERFACE") {
+			$interfaces->{$x->{NAME}} = $x;
+			# Add [in] ORPCTHIS *this, [out] ORPCTHAT *that
+			# and replace interfacepointers with MInterfacePointer
+			# for 'object' interfaces
+			if (has_property($x, "object")) {
+				foreach my $e (@{$x->{DATA}}) {
+					($e->{TYPE} eq "FUNCTION") && FunctionAddObjArgs($e);
+					ReplaceInterfacePointers($e);
+				}
+				$addedorpc = 1;
+			}
+
+			if ($x->{BASE}) {
+				my $base = $interfaces->{$x->{BASE}};
+
+				unless (defined($base)) {
+					error($x, "Undefined base interface `$x->{BASE}'");
+				} else {
+					foreach my $fn (reverse @{$base->{DATA}}) {
+						next unless ($fn->{TYPE} eq "FUNCTION");
+						push (@{$x->{INHERITED_FUNCTIONS}}, $fn);
+					}
+				}
+			}
+		}
+	}
+
+	unshift (@$odl, {
+		TYPE => "IMPORT", 
+		PATHS => [ "\"orpc.idl\"" ],
+		FILE => undef,
+		LINE => undef
+	}) if ($addedorpc);
+
+
+	return $odl;
+}
+
+1;

pidl/lib/Parse/Pidl/Samba3/ClientNDR.pm

@@ -0,0 +1,418 @@
+###################################################
+# Samba3 client generator for IDL structures
+# on top of Samba4 style NDR functions
+# Copyright jelmer@samba.org 2005-2006
+# Copyright gd@samba.org 2008
+# released under the GNU GPL
+
+package Parse::Pidl::Samba3::ClientNDR;
+
+use Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(ParseFunction $res $res_hdr);
+
+use strict;
+use Parse::Pidl qw(fatal warning error);
+use Parse::Pidl::Util qw(has_property ParseExpr);
+use Parse::Pidl::NDR qw(ContainsPipe);
+use Parse::Pidl::Typelist qw(mapTypeName);
+use Parse::Pidl::Samba4 qw(DeclLong);
+use Parse::Pidl::Samba4::Header qw(GenerateFunctionInEnv GenerateFunctionOutEnv);
+
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+sub indent($) { my ($self) = @_; $self->{tabs}.="\t"; }
+sub deindent($) { my ($self) = @_; $self->{tabs} = substr($self->{tabs}, 1); }
+sub pidl($$) { my ($self,$txt) = @_; $self->{res} .= $txt ? "$self->{tabs}$txt\n" : "\n"; }
+sub pidl_hdr($$) { my ($self, $txt) = @_; $self->{res_hdr} .= "$txt\n"; } 
+sub fn_declare($$) { my ($self,$n) = @_; $self->pidl($n); $self->pidl_hdr("$n;"); }
+
+sub genpad($)
+{
+	my ($s) = @_;
+	my $nt = int((length($s)+1)/8);
+	my $lt = ($nt*8)-1;
+	my $ns = (length($s)-$lt);
+	return "\t"x($nt)." "x($ns);
+}
+
+sub new($)
+{
+	my ($class) = shift;
+	my $self = { res => "", res_hdr => "", tabs => "" };
+	bless($self, $class);
+}
+
+sub ElementDirection($)
+{
+	my ($e) = @_;
+
+	return "[in,out]" if (has_property($e, "in") and has_property($e, "out"));
+	return "[in]" if (has_property($e, "in"));
+	return "[out]" if (has_property($e, "out"));
+	return "[in,out]";
+}
+
+sub HeaderProperties($$)
+{
+	my($props,$ignores) = @_;
+	my $ret = "";
+
+	foreach my $d (keys %{$props}) {
+		next if (grep(/^$d$/, @$ignores));
+		if($props->{$d} ne "1") {
+			$ret.= "$d($props->{$d}),";
+		} else {
+			$ret.="$d,";
+		}
+	}
+
+	if ($ret) {
+		return "[" . substr($ret, 0, -1) . "]";
+	}
+}
+
+sub ParseInvalidResponse($$)
+{
+	my ($self, $type) = @_;
+
+	if ($type eq "sync") {
+		$self->pidl("return NT_STATUS_INVALID_NETWORK_RESPONSE;");
+	} elsif ($type eq "async") {
+		$self->pidl("tevent_req_nterror(req, NT_STATUS_INVALID_NETWORK_RESPONSE);");
+		$self->pidl("return;");
+	} else {
+		die("ParseInvalidResponse($type)");
+	}
+}
+
+sub ParseFunctionAsyncState($$$)
+{
+	my ($self, $if, $fn) = @_;
+
+	my $state_str = "struct rpccli_$fn->{NAME}_state";
+	my $done_fn = "rpccli_$fn->{NAME}_done";
+
+	$self->pidl("$state_str {");
+	$self->indent;
+	$self->pidl("TALLOC_CTX *out_mem_ctx;");
+	if (defined($fn->{RETURN_TYPE})) {
+		$self->pidl(mapTypeName($fn->{RETURN_TYPE}). " result;");
+	}
+	$self->deindent;
+	$self->pidl("};");
+	$self->pidl("");
+	$self->pidl("static void $done_fn(struct tevent_req *subreq);");
+	$self->pidl("");
+}
+
+sub ParseFunctionAsyncSend($$$)
+{
+	my ($self, $if, $fn) = @_;
+
+	my $fn_args = "";
+	my $uif = uc($if);
+	my $ufn = "NDR_".uc($fn->{NAME});
+	my $state_str = "struct rpccli_$fn->{NAME}_state";
+	my $done_fn = "rpccli_$fn->{NAME}_done";
+	my $out_mem_ctx = "rpccli_$fn->{NAME}_out_memory";
+	my $fn_str = "struct tevent_req *rpccli_$fn->{NAME}_send";
+	my $pad = genpad($fn_str);
+
+	$fn_args .= "TALLOC_CTX *mem_ctx";
+	$fn_args .= ",\n" . $pad . "struct tevent_context *ev";
+	$fn_args .= ",\n" . $pad . "struct rpc_pipe_client *cli";
+
+	foreach (@{$fn->{ELEMENTS}}) {
+		my $dir = ElementDirection($_);
+		my $prop = HeaderProperties($_->{PROPERTIES}, ["in", "out"]);
+		$fn_args .= ",\n" . $pad . DeclLong($_, "_") . " /* $dir $prop */";
+	}
+
+	$self->fn_declare("$fn_str($fn_args)");
+	$self->pidl("{");
+	$self->indent;
+	$self->pidl("struct tevent_req *req;");
+	$self->pidl("$state_str *state;");
+	$self->pidl("struct tevent_req *subreq;");
+	$self->pidl("");
+	$self->pidl("req = tevent_req_create(mem_ctx, &state,");
+	$self->pidl("\t\t\t$state_str);");
+	$self->pidl("if (req == NULL) {");
+	$self->indent;
+	$self->pidl("return NULL;");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("state->out_mem_ctx = NULL;");
+	$self->pidl("");
+
+	my $out_params = 0;
+	foreach (@{$fn->{ELEMENTS}}) {
+		if (grep(/out/, @{$_->{DIRECTION}})) {
+			$out_params++;
+		}
+	}
+
+	if ($out_params > 0) {
+		$self->pidl("state->out_mem_ctx = talloc_named_const(state, 0,");
+		$self->pidl("\t\t     \"$out_mem_ctx\");");
+		$self->pidl("if (tevent_req_nomem(state->out_mem_ctx, req)) {");
+		$self->indent;
+		$self->pidl("return tevent_req_post(req, ev);");
+		$self->deindent;
+		$self->pidl("}");
+		$self->pidl("");
+	}
+
+	$fn_str = "subreq = dcerpc_$fn->{NAME}_send";
+	$pad = "\t" . genpad($fn_str);
+	$fn_args = "state,\n" . $pad . "ev,\n" . $pad . "cli->binding_handle";
+	foreach (@{$fn->{ELEMENTS}}) {
+		$fn_args .= ",\n" . $pad . "_". $_->{NAME};
+	}
+
+	$self->pidl("$fn_str($fn_args);");
+	$self->pidl("if (tevent_req_nomem(subreq, req)) {");
+	$self->indent;
+	$self->pidl("return tevent_req_post(req, ev);");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("tevent_req_set_callback(subreq, $done_fn, req);");
+	$self->pidl("return req;");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+}
+
+sub ParseFunctionAsyncDone($$$)
+{
+	my ($self, $if, $fn) = @_;
+
+	my $state_str = "struct rpccli_$fn->{NAME}_state";
+	my $done_fn = "rpccli_$fn->{NAME}_done";
+
+	$self->pidl("static void $done_fn(struct tevent_req *subreq)");
+	$self->pidl("{");
+	$self->indent;
+	$self->pidl("struct tevent_req *req = tevent_req_callback_data(");
+	$self->pidl("\tsubreq, struct tevent_req);");
+	$self->pidl("$state_str *state = tevent_req_data(");
+	$self->pidl("\treq, $state_str);");
+	$self->pidl("NTSTATUS status;");
+	$self->pidl("TALLOC_CTX *mem_ctx;");
+	$self->pidl("");
+
+	$self->pidl("if (state->out_mem_ctx) {");
+	$self->indent;
+	$self->pidl("mem_ctx = state->out_mem_ctx;");
+	$self->deindent;
+	$self->pidl("} else {");
+	$self->indent;
+	$self->pidl("mem_ctx = state;");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+
+	my $fn_str = "status = dcerpc_$fn->{NAME}_recv";
+	my $pad = "\t" . genpad($fn_str);
+	my $fn_args = "subreq,\n" . $pad . "mem_ctx";
+	if (defined($fn->{RETURN_TYPE})) {
+		$fn_args .= ",\n" . $pad . "&state->result";
+	}
+
+	$self->pidl("$fn_str($fn_args);");
+	$self->pidl("TALLOC_FREE(subreq);");
+	$self->pidl("if (!NT_STATUS_IS_OK(status)) {");
+	$self->indent;
+	$self->pidl("tevent_req_nterror(req, status);");
+	$self->pidl("return;");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+
+	$self->pidl("tevent_req_done(req);");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+}
+
+sub ParseFunctionAsyncRecv($$$)
+{
+	my ($self, $if, $fn) = @_;
+
+	my $fn_args = "";
+	my $state_str = "struct rpccli_$fn->{NAME}_state";
+	my $fn_str = "NTSTATUS rpccli_$fn->{NAME}_recv";
+	my $pad = genpad($fn_str);
+
+	$fn_args .= "struct tevent_req *req,\n" . $pad . "TALLOC_CTX *mem_ctx";
+
+	if (defined($fn->{RETURN_TYPE})) {
+		$fn_args .= ",\n" . $pad . "$fn->{RETURN_TYPE} *result";
+	}
+
+	$self->fn_declare("$fn_str($fn_args)");
+	$self->pidl("{");
+	$self->indent;
+	$self->pidl("$state_str *state = tevent_req_data(");
+	$self->pidl("\treq, $state_str);");
+	$self->pidl("NTSTATUS status;");
+	$self->pidl("");
+	$self->pidl("if (tevent_req_is_nterror(req, &status)) {");
+	$self->indent;
+	$self->pidl("tevent_req_received(req);");
+	$self->pidl("return status;");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+
+	$self->pidl("/* Steal possible out parameters to the callers context */");
+	$self->pidl("talloc_steal(mem_ctx, state->out_mem_ctx);");
+	$self->pidl("");
+
+	if (defined($fn->{RETURN_TYPE})) {
+		$self->pidl("/* Return result */");
+		$self->pidl("*result = state->result;");
+		$self->pidl("");
+	}
+
+	$self->pidl("tevent_req_received(req);");
+	$self->pidl("return NT_STATUS_OK;");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+}
+
+sub ParseFunctionSync($$$)
+{
+	my ($self, $if, $fn) = @_;
+
+	my $fn_args = "";
+	my $uif = uc($if);
+	my $ufn = "NDR_".uc($fn->{NAME});
+	my $fn_str = "NTSTATUS rpccli_$fn->{NAME}";
+	my $pad = genpad($fn_str);
+
+	$fn_args .= "struct rpc_pipe_client *cli,\n" . $pad . "TALLOC_CTX *mem_ctx";
+
+	foreach (@{$fn->{ELEMENTS}}) {
+		my $dir = ElementDirection($_);
+		my $prop = HeaderProperties($_->{PROPERTIES}, ["in", "out"]);
+		$fn_args .= ",\n" . $pad . DeclLong($_, "_") . " /* $dir $prop */";
+	}
+
+	if (defined($fn->{RETURN_TYPE}) && ($fn->{RETURN_TYPE} eq "WERROR")) {
+		$fn_args .= ",\n" . $pad . "WERROR *werror";
+	}
+
+	$self->fn_declare("$fn_str($fn_args)");
+	$self->pidl("{");
+	$self->indent;
+	if (defined($fn->{RETURN_TYPE})) {
+		$self->pidl(mapTypeName($fn->{RETURN_TYPE})." result;");
+	}
+	$self->pidl("NTSTATUS status;");
+	$self->pidl("");
+
+	$fn_str = "status = dcerpc_$fn->{NAME}";
+	$pad = "\t" . genpad($fn_str);
+	$fn_args = "cli->binding_handle,\n" . $pad . "mem_ctx";
+	foreach (@{$fn->{ELEMENTS}}) {
+		$fn_args .= ",\n" . $pad . "_". $_->{NAME};
+	}
+	if (defined($fn->{RETURN_TYPE})) {
+		$fn_args .= ",\n" . $pad . "&result";
+	}
+
+	$self->pidl("$fn_str($fn_args);");
+	$self->pidl("if (!NT_STATUS_IS_OK(status)) {");
+	$self->indent;
+	$self->pidl("return status;");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+
+	$self->pidl("/* Return result */");
+	if (not $fn->{RETURN_TYPE}) {
+		$self->pidl("return NT_STATUS_OK;");
+	} elsif ($fn->{RETURN_TYPE} eq "NTSTATUS") {
+		$self->pidl("return result;");
+	} elsif ($fn->{RETURN_TYPE} eq "WERROR") {
+		$self->pidl("if (werror) {");
+		$self->indent;
+		$self->pidl("*werror = result;");
+		$self->deindent;
+		$self->pidl("}");
+		$self->pidl("");
+		$self->pidl("return werror_to_ntstatus(result);");
+	} else {
+		warning($fn->{ORIGINAL}, "Unable to convert $fn->{RETURN_TYPE} to NTSTATUS");
+		$self->pidl("return NT_STATUS_OK;");
+	}
+
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+}
+
+sub ParseFunction($$$)
+{
+	my ($self, $if, $fn) = @_;
+
+	$self->ParseFunctionAsyncState($if, $fn);
+	$self->ParseFunctionAsyncSend($if, $fn);
+	$self->ParseFunctionAsyncDone($if, $fn);
+	$self->ParseFunctionAsyncRecv($if, $fn);
+
+	$self->ParseFunctionSync($if, $fn);
+}
+
+sub ParseInterface($$)
+{
+	my ($self, $if) = @_;
+
+	my $uif = uc($if->{NAME});
+
+	$self->pidl_hdr("#ifndef __CLI_$uif\__");
+	$self->pidl_hdr("#define __CLI_$uif\__");
+	foreach my $fn (@{$if->{FUNCTIONS}}) {
+		next if has_property($fn, "noopnum");
+		next if has_property($fn, "todo");
+
+		my $skip = 0;
+		foreach my $e (@{$fn->{ELEMENTS}}) {
+			if (ContainsPipe($e, $e->{LEVELS}[0])) {
+				$skip = 1;
+				last;
+			}
+		}
+		next if $skip;
+
+		$self->ParseFunction($if->{NAME}, $fn);
+	}
+	$self->pidl_hdr("#endif /* __CLI_$uif\__ */");
+}
+
+sub Parse($$$$)
+{
+	my($self,$ndr,$header,$c_header) = @_;
+
+	$self->pidl("/*");
+	$self->pidl(" * Unix SMB/CIFS implementation.");
+	$self->pidl(" * client auto-generated by pidl. DO NOT MODIFY!");
+	$self->pidl(" */");
+	$self->pidl("");
+	$self->pidl("#include \"includes.h\"");
+	$self->pidl("#include \"$header\"");
+	$self->pidl_hdr("#include \"$c_header\"");
+	$self->pidl("");
+	
+	foreach (@$ndr) {
+		$self->ParseInterface($_) if ($_->{TYPE} eq "INTERFACE");
+	}
+
+	return ($self->{res}, $self->{res_hdr});
+}
+
+1;

pidl/lib/Parse/Pidl/Samba3/ServerNDR.pm

@@ -0,0 +1,309 @@
+###################################################
+# Samba3 server generator for IDL structures
+# on top of Samba4 style NDR functions
+# Copyright jelmer@samba.org 2005-2006
+# released under the GNU GPL
+
+package Parse::Pidl::Samba3::ServerNDR;
+
+use Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(DeclLevel);
+
+use strict;
+use Parse::Pidl qw(warning error fatal);
+use Parse::Pidl::Typelist qw(mapTypeName scalar_is_reference);
+use Parse::Pidl::Util qw(ParseExpr has_property is_constant);
+use Parse::Pidl::NDR qw(GetNextLevel);
+use Parse::Pidl::Samba4 qw(ElementStars DeclLong);
+use Parse::Pidl::Samba4::Header qw(GenerateFunctionOutEnv);
+
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+my $res;
+my $res_hdr;
+my $tabs = "";
+sub indent() { $tabs.="\t"; }
+sub deindent() { $tabs = substr($tabs, 1); }
+sub pidl($) { my ($txt) = @_; $res .= $txt?$tabs.(shift)."\n":"\n"; }
+sub pidl_hdr($) { $res_hdr .= (shift)."\n"; }
+sub fn_declare($) { my ($n) = @_; pidl $n; pidl_hdr "$n;"; }
+
+sub DeclLevel($$)
+{
+	my ($e, $l) = @_;
+	my $res = "";
+
+	if (has_property($e, "charset")) {
+		$res .= "const char";
+	} else {
+		$res .= mapTypeName($e->{TYPE});
+	}
+
+	my $stars = ElementStars($e, $l);
+
+	$res .= " ".$stars unless ($stars eq "");
+
+	return $res;
+}
+
+sub AllocOutVar($$$$$)
+{
+	my ($e, $mem_ctx, $name, $env, $fail) = @_;
+
+	my $l = $e->{LEVELS}[0];
+
+	# we skip pointer to arrays
+	if ($l->{TYPE} eq "POINTER") {
+		my $nl = GetNextLevel($e, $l);
+		$l = $nl if ($nl->{TYPE} eq "ARRAY");
+	} elsif
+
+	# we don't support multi-dimentional arrays yet
+	($l->{TYPE} eq "ARRAY") {
+		my $nl = GetNextLevel($e, $l);
+		if ($nl->{TYPE} eq "ARRAY") {
+			fatal($e->{ORIGINAL},"multi-dimentional [out] arrays are not supported!");
+		}
+	} else {
+		# neither pointer nor array, no need to alloc something.
+		return;
+	}
+
+	if ($l->{TYPE} eq "ARRAY") {
+		unless(defined($l->{SIZE_IS})) {
+			error($e->{ORIGINAL}, "No size known for array `$e->{NAME}'");
+			pidl "#error No size known for array `$e->{NAME}'";
+		} else {
+			my $size = ParseExpr($l->{SIZE_IS}, $env, $e);
+			pidl "$name = talloc_zero_array($mem_ctx, " . DeclLevel($e, 1) . ", $size);";
+		}
+	} else {
+		pidl "$name = talloc_zero($mem_ctx, " . DeclLevel($e, 1) . ");";
+	}
+
+	pidl "if ($name == NULL) {";
+	$fail->();
+	pidl "}";
+	pidl "";
+}
+
+sub CallWithStruct($$$$)
+{
+	my ($pipes_struct, $mem_ctx, $fn, $fail) = @_;
+	my $env = GenerateFunctionOutEnv($fn);
+	my $hasout = 0;
+	foreach (@{$fn->{ELEMENTS}}) {
+		if (grep(/out/, @{$_->{DIRECTION}})) { $hasout = 1; }
+	}
+
+	pidl "ZERO_STRUCT(r->out);" if ($hasout);
+
+	my $proto = "_$fn->{NAME}(struct pipes_struct *p, struct $fn->{NAME} *r";
+	my $ret = "_$fn->{NAME}($pipes_struct, r";
+	foreach (@{$fn->{ELEMENTS}}) {
+		my @dir = @{$_->{DIRECTION}};
+		if (grep(/in/, @dir) and grep(/out/, @dir)) {
+			pidl "r->out.$_->{NAME} = r->in.$_->{NAME};";
+		}
+	}
+
+	foreach (@{$fn->{ELEMENTS}}) {
+		my @dir = @{$_->{DIRECTION}};
+		if (grep(/in/, @dir) and grep(/out/, @dir)) {
+			# noop
+		} elsif (grep(/out/, @dir) and not
+				 has_property($_, "represent_as")) {
+			AllocOutVar($_, $mem_ctx, "r->out.$_->{NAME}", $env, $fail);
+		}
+	}
+	$ret .= ")";
+	$proto .= ");";
+
+	if ($fn->{RETURN_TYPE}) {
+		$ret = "r->out.result = $ret";
+		$proto = "$fn->{RETURN_TYPE} $proto";
+	} else {
+		$proto = "void $proto";
+	}
+
+	pidl_hdr "$proto";
+	pidl "$ret;";
+}
+
+sub ParseFunction($$)
+{
+	my ($if,$fn) = @_;
+
+	my $op = "NDR_".uc($fn->{NAME});
+
+	pidl "static bool api_$fn->{NAME}(struct pipes_struct *p)";
+	pidl "{";
+	indent;
+	pidl "const struct ndr_interface_call *call;";
+	pidl "struct ndr_pull *pull;";
+	pidl "struct ndr_push *push;";
+	pidl "enum ndr_err_code ndr_err;";
+	pidl "struct $fn->{NAME} *r;";
+	pidl "";
+	pidl "call = &ndr_table_$if->{NAME}.calls[$op];";
+	pidl "";
+	pidl "r = talloc(talloc_tos(), struct $fn->{NAME});";
+	pidl "if (r == NULL) {";
+	pidl "\treturn false;";
+	pidl "}";
+	pidl "";
+	pidl "pull = ndr_pull_init_blob(&p->in_data.data, r);";
+	pidl "if (pull == NULL) {";
+	pidl "\ttalloc_free(r);";
+	pidl "\treturn false;";
+	pidl "}";
+	pidl "";
+	pidl "pull->flags |= LIBNDR_FLAG_REF_ALLOC;";
+	pidl "if (p->endian) {";
+	pidl "\tpull->flags |= LIBNDR_FLAG_BIGENDIAN;";
+	pidl "}";
+	pidl "ndr_err = call->ndr_pull(pull, NDR_IN, r);";
+	pidl "if (!NDR_ERR_CODE_IS_SUCCESS(ndr_err)) {";
+	pidl "\ttalloc_free(r);";
+	pidl "\treturn false;";
+	pidl "}";
+	pidl "";
+	pidl "if (DEBUGLEVEL >= 10) {";
+	pidl "\tNDR_PRINT_FUNCTION_DEBUG($fn->{NAME}, NDR_IN, r);";
+	pidl "}";
+	pidl "";
+
+	CallWithStruct("p", "r", $fn, 
+	sub { 
+			pidl "\ttalloc_free(r);";
+			pidl "\treturn false;";
+		}
+	);
+
+	pidl "";
+	pidl "if (p->rng_fault_state) {";
+	pidl "\ttalloc_free(r);";
+	pidl "\t/* Return true here, srv_pipe_hnd.c will take care */";
+	pidl "\treturn true;";
+	pidl "}";
+	pidl "";
+	pidl "if (DEBUGLEVEL >= 10) {";
+	pidl "\tNDR_PRINT_FUNCTION_DEBUG($fn->{NAME}, NDR_OUT | NDR_SET_VALUES, r);";
+	pidl "}";
+	pidl "";
+	pidl "push = ndr_push_init_ctx(r);";
+	pidl "if (push == NULL) {";
+	pidl "\ttalloc_free(r);";
+	pidl "\treturn false;";
+	pidl "}";
+	pidl "";
+	pidl "/*";
+	pidl " * carry over the pointer count to the reply in case we are";
+	pidl " * using full pointer. See NDR specification for full pointers";
+	pidl " */";
+	pidl "push->ptr_count = pull->ptr_count;";
+	pidl "";
+	pidl "ndr_err = call->ndr_push(push, NDR_OUT, r);";
+	pidl "if (!NDR_ERR_CODE_IS_SUCCESS(ndr_err)) {";
+	pidl "\ttalloc_free(r);";
+	pidl "\treturn false;";
+	pidl "}";
+	pidl "";
+	pidl "p->out_data.rdata = ndr_push_blob(push);";
+	pidl "talloc_steal(p->mem_ctx, p->out_data.rdata.data);";
+	pidl "";
+	pidl "talloc_free(r);";
+	pidl "";
+	pidl "return true;";
+	deindent;
+	pidl "}";
+	pidl "";
+}
+
+sub ParseInterface($)
+{
+	my $if = shift;
+
+	my $uif = uc($if->{NAME});
+
+	pidl_hdr "#ifndef __SRV_$uif\__";
+	pidl_hdr "#define __SRV_$uif\__";
+
+	foreach (@{$if->{FUNCTIONS}}) {
+		next if ($_->{PROPERTIES}{noopnum});
+		ParseFunction($if, $_);
+	}
+
+	pidl "";
+	pidl "/* Tables */";
+	pidl "static struct api_struct api_$if->{NAME}_cmds[] = ";
+	pidl "{";
+	indent;
+
+	foreach (@{$if->{FUNCTIONS}}) {
+		next if ($_->{PROPERTIES}{noopnum});
+		pidl "{\"" . uc($_->{NAME}) . "\", NDR_" . uc($_->{NAME}) . ", api_$_->{NAME}},";
+	}
+
+	deindent;
+	pidl "};";
+
+	pidl "";
+
+	pidl_hdr "void $if->{NAME}_get_pipe_fns(struct api_struct **fns, int *n_fns);";
+	pidl "void $if->{NAME}_get_pipe_fns(struct api_struct **fns, int *n_fns)";
+	pidl "{";
+	indent;
+	pidl "*fns = api_$if->{NAME}_cmds;";
+	pidl "*n_fns = sizeof(api_$if->{NAME}_cmds) / sizeof(struct api_struct);";
+	deindent;
+	pidl "}";
+	pidl "";
+
+	if (not has_property($if, "no_srv_register")) {
+	    pidl_hdr "struct rpc_srv_callbacks;";
+	    pidl_hdr "NTSTATUS rpc_$if->{NAME}_init(const struct rpc_srv_callbacks *rpc_srv_cb);";
+	    pidl "NTSTATUS rpc_$if->{NAME}_init(const struct rpc_srv_callbacks *rpc_srv_cb)";
+	    pidl "{";
+	    pidl "\treturn rpc_srv_register(SMB_RPC_INTERFACE_VERSION, \"$if->{NAME}\", \"$if->{NAME}\", \&ndr_table_$if->{NAME}, api_$if->{NAME}_cmds, sizeof(api_$if->{NAME}_cmds) / sizeof(struct api_struct), rpc_srv_cb);";
+	    pidl "}";
+
+	    pidl "";
+
+	    pidl_hdr "NTSTATUS rpc_$if->{NAME}_shutdown(void);";
+	    pidl "NTSTATUS rpc_$if->{NAME}_shutdown(void)";
+	    pidl "{";
+	    pidl "\treturn rpc_srv_unregister(\&ndr_table_$if->{NAME});";
+	    pidl "}";
+	}
+	pidl_hdr "#endif /* __SRV_$uif\__ */";
+}
+
+sub Parse($$$)
+{
+	my($ndr,$header,$ndr_header) = @_;
+
+	$res = "";
+	$res_hdr = "";
+
+	pidl "/*";
+	pidl " * Unix SMB/CIFS implementation.";
+	pidl " * server auto-generated by pidl. DO NOT MODIFY!";
+	pidl " */";
+	pidl "";
+	pidl "#include \"includes.h\"";
+	pidl "#include \"ntdomain.h\"";
+	pidl "#include \"$header\"";
+	pidl_hdr "#include \"$ndr_header\"";
+	pidl "";
+
+	foreach (@$ndr) {
+		ParseInterface($_) if ($_->{TYPE} eq "INTERFACE");
+	}
+
+	return ($res, $res_hdr);
+}
+
+1;

pidl/lib/Parse/Pidl/Samba4.pm

@@ -0,0 +1,133 @@
+###################################################
+# Common Samba4 functions
+# Copyright jelmer@samba.org 2006
+# released under the GNU GPL
+
+package Parse::Pidl::Samba4;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(is_intree choose_header NumStars ElementStars ArrayBrackets DeclLong ArrayDynamicallyAllocated);
+
+use Parse::Pidl::Util qw(has_property is_constant);
+use Parse::Pidl::NDR qw(GetNextLevel);
+use Parse::Pidl::Typelist qw(mapTypeName scalar_is_reference);
+use Parse::Pidl qw(fatal error);
+use strict;
+
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+
+# return true if we are using pidl within the samba source tree. This changes
+# the names of include files, as some include files (such as ntstatus.h) have
+# different paths when installed to the patch in the source tree
+sub is_intree()
+{
+	my $srcdir = $ENV{srcdir};
+	$srcdir = $srcdir ? "$srcdir/" : "";
+	return 1 if (-f "${srcdir}kdc/kdc.c");
+	return 1 if (-d "${srcdir}source4");
+	return 1 if (-f "${srcdir}include/smb.h");
+	return 0;
+}
+
+# Return an #include line depending on whether this build is an in-tree
+# build or not.
+sub choose_header($$)
+{
+	my ($in,$out) = @_;
+	return "#include \"$in\"" if (is_intree());
+	return "#include <$out>";
+}
+
+sub ArrayDynamicallyAllocated($$)
+{
+	my ($e, $l) = @_;
+	die("Not an array") unless ($l->{TYPE} eq "ARRAY");
+	return 0 if ($l->{IS_FIXED} and not has_property($e, "charset"));
+	return 1;
+}
+
+sub NumStars($;$)
+{
+	my ($e, $d) = @_;
+	$d = 0 unless defined($d);
+	my $n = 0;
+
+	foreach my $l (@{$e->{LEVELS}}) {
+		next unless ($l->{TYPE} eq "POINTER");
+
+		my $nl = GetNextLevel($e, $l);
+		next if (defined($nl) and $nl->{TYPE} eq "ARRAY");
+
+		$n++;
+	}
+
+	if ($n >= 1) {
+		$n-- if (scalar_is_reference($e->{TYPE}));
+	}
+
+	foreach my $l (@{$e->{LEVELS}}) {
+		next unless ($l->{TYPE} eq "ARRAY");
+		next unless (ArrayDynamicallyAllocated($e, $l));
+		$n++;
+	}
+
+	error($e->{ORIGINAL}, "Too few pointers $n < $d") if ($n < $d);
+
+	$n -= $d;
+
+	return $n;
+}
+
+sub ElementStars($;$)
+{
+	my ($e, $d) = @_;
+	my $res = "";
+	my $n = 0;
+
+	$n = NumStars($e, $d);
+	$res .= "*" foreach (1..$n);
+
+	return $res;
+}
+
+sub ArrayBrackets($)
+{
+	my ($e) = @_;
+	my $res = "";
+
+	foreach my $l (@{$e->{LEVELS}}) {
+		next unless ($l->{TYPE} eq "ARRAY");
+		next if ArrayDynamicallyAllocated($e, $l);
+		$res .= "[$l->{SIZE_IS}]";
+	}
+
+	return $res;
+}
+
+sub DeclLong($;$)
+{
+	my ($e, $p) = @_;
+	my $res = "";
+	$p = "" unless defined($p);
+
+	if (has_property($e, "represent_as")) {
+		$res .= mapTypeName($e->{PROPERTIES}->{represent_as})." ";
+	} else {
+		if (has_property($e, "charset")) {
+			$res .= "const char ";
+		} else {
+			$res .= mapTypeName($e->{TYPE})." ";
+		}
+
+		$res .= ElementStars($e);
+	}
+	$res .= $p.$e->{NAME};
+	$res .= ArrayBrackets($e);
+
+	return $res;
+}
+
+1;

pidl/lib/Parse/Pidl/Samba4/COM/Header.pm

@@ -0,0 +1,160 @@
+# COM Header generation
+# (C) 2005 Jelmer Vernooij <jelmer@samba.org>
+
+package Parse::Pidl::Samba4::COM::Header;
+
+use Parse::Pidl::Typelist qw(mapTypeName);
+use Parse::Pidl::Util qw(has_property is_constant);
+
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+use strict;
+
+sub GetArgumentProtoList($)
+{
+	my $f = shift;
+	my $res = "";
+
+	foreach my $a (@{$f->{ELEMENTS}}) {
+
+		$res .= ", " . mapTypeName($a->{TYPE}) . " ";
+
+		my $l = $a->{POINTERS};
+		$l-- if (Parse::Pidl::Typelist::scalar_is_reference($a->{TYPE}));
+		foreach my $i (1..$l) {
+			$res .= "*";
+		}
+
+		if (defined $a->{ARRAY_LEN}[0] && !is_constant($a->{ARRAY_LEN}[0]) &&
+		!$a->{POINTERS}) {
+			$res .= "*";
+		}
+		$res .= $a->{NAME};
+		if (defined $a->{ARRAY_LEN}[0] && is_constant($a->{ARRAY_LEN}[0])) {
+			$res .= "[$a->{ARRAY_LEN}[0]]";
+		}
+	}
+
+	return $res;
+}
+
+sub GetArgumentList($)
+{
+	my $f = shift;
+	my $res = "";
+
+	foreach (@{$f->{ELEMENTS}}) { $res .= ", $_->{NAME}"; }
+
+	return $res;
+}
+
+#####################################################################
+# generate vtable structure for COM interface
+sub HeaderVTable($)
+{
+	my $interface = shift;
+	my $res;
+	$res .= "#define " . uc($interface->{NAME}) . "_METHODS \\\n";
+	if (defined($interface->{BASE})) {
+		$res .= "\t" . uc($interface->{BASE} . "_METHODS") . "\\\n";
+	}
+
+	my $data = $interface->{DATA};
+	foreach my $d (@{$data}) {
+		$res .= "\t" . mapTypeName($d->{RETURN_TYPE}) . " (*$d->{NAME}) (struct $interface->{NAME} *d, TALLOC_CTX *mem_ctx" . GetArgumentProtoList($d) . ");\\\n" if ($d->{TYPE} eq "FUNCTION");
+	}
+	$res .= "\n";
+	$res .= "struct $interface->{NAME}_vtable {\n";
+	$res .= "\tstruct GUID iid;\n";
+	$res .= "\t" . uc($interface->{NAME}) . "_METHODS\n";
+	$res .= "};\n\n";
+
+	return $res;
+}
+
+sub ParseInterface($)
+{
+	my $if = shift;
+	my $res;
+
+	$res .= "\n#ifndef _$if->{NAME}_\n";
+	$res .= "#define _$if->{NAME}_\n";
+
+	$res .="\n\n/* $if->{NAME} */\n";
+
+	$res .="#define COM_" . uc($if->{NAME}) . "_UUID $if->{PROPERTIES}->{uuid}\n\n";
+
+	$res .="struct $if->{NAME}_vtable;\n\n";
+
+	$res .="struct $if->{NAME} {
+	struct OBJREF obj;
+	struct com_context *ctx;
+	struct $if->{NAME}_vtable *vtable;
+	void *object_data;
+};\n\n";
+
+	$res.=HeaderVTable($if);
+
+	foreach my $d (@{$if->{DATA}}) {
+		next if ($d->{TYPE} ne "FUNCTION");
+
+		$res .= "#define $if->{NAME}_$d->{NAME}(interface, mem_ctx" . GetArgumentList($d) . ") ";
+
+		$res .= "((interface)->vtable->$d->{NAME}(interface, mem_ctx" . GetArgumentList($d) . "))";
+
+		$res .="\n";
+	}
+
+	$res .= "#endif\n";
+
+	return $res;
+}
+
+sub ParseCoClass($)
+{
+	my ($c) = @_;
+	my $res = "";
+	$res .= "#define CLSID_" . uc($c->{NAME}) . " $c->{PROPERTIES}->{uuid}\n";
+	if (has_property($c, "progid")) {
+		$res .= "#define PROGID_" . uc($c->{NAME}) . " $c->{PROPERTIES}->{progid}\n";
+	}
+	$res .= "\n";
+	return $res;
+}
+
+sub Parse($$)
+{
+	my ($idl,$ndr_header) = @_;
+	my $res = "";
+	my $has_obj = 0;
+
+	$res .= "#include \"librpc/gen_ndr/orpc.h\"\n" . 
+			"#include \"$ndr_header\"\n\n";
+
+	foreach (@{$idl})
+	{
+		if ($_->{TYPE} eq "INTERFACE" && has_property($_, "object")) {
+			$res .="struct $_->{NAME};\n";
+			$has_obj = 1;
+		}
+	}
+
+	foreach (@{$idl})
+	{
+		if ($_->{TYPE} eq "INTERFACE" && has_property($_, "object")) {
+			$res.=ParseInterface($_);
+			$has_obj = 1;
+		} 
+
+		if ($_->{TYPE} eq "COCLASS") {
+			$res.=ParseCoClass($_);
+			$has_obj = 1;
+		}
+	}
+
+	return $res if ($has_obj);
+	return undef;
+}
+
+1;

pidl/lib/Parse/Pidl/Samba4/COM/Proxy.pm

@@ -0,0 +1,225 @@
+###################################################
+# DCOM parser for Samba
+# Basically the glue between COM and DCE/RPC with NDR
+# Copyright jelmer@samba.org 2003-2005
+# released under the GNU GPL
+
+package Parse::Pidl::Samba4::COM::Proxy;
+
+use Parse::Pidl::Samba4::COM::Header;
+use Parse::Pidl::Typelist qw(mapTypeName);
+use Parse::Pidl::Util qw(has_property);
+
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+use strict;
+
+my($res);
+
+sub ParseVTable($$)
+{
+	my ($interface, $name) = @_;
+
+	# Generate the vtable
+	$res .="\tstruct $interface->{NAME}_vtable $name = {";
+
+	if (defined($interface->{BASE})) {
+		$res .= "\n\t\t{},";
+	}
+
+	my $data = $interface->{DATA};
+
+	foreach my $d (@{$data}) {
+		if ($d->{TYPE} eq "FUNCTION") {
+		    $res .= "\n\t\tdcom_proxy_$interface->{NAME}_$d->{NAME}";
+			$res .= ",";
+		}
+	}
+
+	$res .= "\n\t};\n\n";
+}
+
+sub ParseRegFunc($)
+{
+	my $interface = shift;
+
+	$res .= "static NTSTATUS dcom_proxy_$interface->{NAME}_init(void)
+{
+	struct $interface->{NAME}_vtable *proxy_vtable = talloc(talloc_autofree_context(), struct $interface->{NAME}_vtable);
+";
+
+	if (defined($interface->{BASE})) {
+		$res.= "
+	struct GUID base_iid;
+	const void *base_vtable;
+
+	base_iid = ndr_table_$interface->{BASE}.syntax_id.uuid;
+
+	base_vtable = dcom_proxy_vtable_by_iid(&base_iid);
+	if (base_vtable == NULL) {
+		DEBUG(0, (\"No proxy registered for base interface '$interface->{BASE}'\\n\"));
+		return NT_STATUS_FOOBAR;
+	}
+	
+	memcpy(&proxy_vtable, base_vtable, sizeof(struct $interface->{BASE}_vtable));
+
+";
+	}
+	foreach my $x (@{$interface->{DATA}}) {
+		next unless ($x->{TYPE} eq "FUNCTION");
+
+		$res .= "\tproxy_vtable->$x->{NAME} = dcom_proxy_$interface->{NAME}_$x->{NAME};\n";
+	}
+
+	$res.= "
+	proxy_vtable->iid = ndr_table_$interface->{NAME}.syntax_id.uuid;
+
+	return dcom_register_proxy((struct IUnknown_vtable *)proxy_vtable);
+}\n\n";
+}
+
+#####################################################################
+# parse a function
+sub ParseFunction($$)
+{
+	my ($interface, $fn) = @_;
+	my $name = $fn->{NAME};
+	my $uname = uc $name;
+
+	my $tn = mapTypeName($fn->{RETURN_TYPE});
+
+	$res.="
+static $tn dcom_proxy_$interface->{NAME}_$name(struct $interface->{NAME} *d, TALLOC_CTX *mem_ctx" . Parse::Pidl::Samba4::COM::Header::GetArgumentProtoList($fn) . ")
+{
+	struct dcerpc_pipe *p;
+	NTSTATUS status = dcom_get_pipe(d, &p);
+	struct $name r;
+	struct rpc_request *req;
+
+	if (NT_STATUS_IS_ERR(status)) {
+		return status;
+	}
+
+	ZERO_STRUCT(r.in.ORPCthis);
+	r.in.ORPCthis.version.MajorVersion = COM_MAJOR_VERSION;
+	r.in.ORPCthis.version.MinorVersion = COM_MINOR_VERSION;
+";
+	
+	# Put arguments into r
+	foreach my $a (@{$fn->{ELEMENTS}}) {
+		next unless (has_property($a, "in"));
+		if (Parse::Pidl::Typelist::typeIs($a->{TYPE}, "INTERFACE")) {
+			$res .="\tNDR_CHECK(dcom_OBJREF_from_IUnknown(mem_ctx, &r.in.$a->{NAME}.obj, $a->{NAME}));\n";
+		} else {
+			$res .= "\tr.in.$a->{NAME} = $a->{NAME};\n";
+		}
+	}
+
+	$res .="
+	if (p->conn->flags & DCERPC_DEBUG_PRINT_IN) {
+		NDR_PRINT_IN_DEBUG($name, &r);		
+	}
+
+	status = dcerpc_ndr_request(p, &d->ipid, &ndr_table_$interface->{NAME}, NDR_$uname, mem_ctx, &r);
+
+	if (NT_STATUS_IS_OK(status) && (p->conn->flags & DCERPC_DEBUG_PRINT_OUT)) {
+		NDR_PRINT_OUT_DEBUG($name, r);		
+	}
+
+";
+
+	# Put r info back into arguments
+	foreach my $a (@{$fn->{ELEMENTS}}) {
+		next unless (has_property($a, "out"));
+
+		if (Parse::Pidl::Typelist::typeIs($a->{TYPE}, "INTERFACE")) {
+			$res .="\tNDR_CHECK(dcom_IUnknown_from_OBJREF(d->ctx, &$a->{NAME}, r.out.$a->{NAME}.obj));\n";
+		} else {
+			$res .= "\t*$a->{NAME} = r.out.$a->{NAME};\n";
+		}
+
+	}
+	
+	if ($fn->{RETURN_TYPE} eq "NTSTATUS") {
+		$res .= "\tif (NT_STATUS_IS_OK(status)) status = r.out.result;\n";
+	}
+
+	$res .= 
+	"
+	return r.out.result;
+}\n\n";
+}
+
+#####################################################################
+# parse the interface definitions
+sub ParseInterface($)
+{
+	my($interface) = shift;
+	my($data) = $interface->{DATA};
+	$res = "/* DCOM proxy for $interface->{NAME} generated by pidl */\n\n";
+	foreach my $d (@{$data}) {
+		($d->{TYPE} eq "FUNCTION") && 
+		ParseFunction($interface, $d);
+	}
+
+	ParseRegFunc($interface);
+}
+
+sub RegistrationFunction($$)
+{
+	my $idl = shift;
+	my $basename = shift;
+
+	my $res = "\n\nNTSTATUS dcom_$basename\_init(void)\n";
+	$res .= "{\n";
+	$res .="\tNTSTATUS status = NT_STATUS_OK;\n";
+	foreach my $interface (@{$idl}) {
+		next if $interface->{TYPE} ne "INTERFACE";
+		next if not has_property($interface, "object");
+
+		my $data = $interface->{DATA};
+		my $count = 0;
+		foreach my $d (@{$data}) {
+			if ($d->{TYPE} eq "FUNCTION") { $count++; }
+		}
+
+		next if ($count == 0);
+
+		$res .= "\tstatus = dcom_$interface->{NAME}_init();\n";
+		$res .= "\tif (NT_STATUS_IS_ERR(status)) {\n";
+		$res .= "\t\treturn status;\n";
+		$res .= "\t}\n\n";
+	}
+	$res .= "\treturn status;\n";
+	$res .= "}\n\n";
+
+	return $res;
+}
+
+sub Parse($$)
+{
+	my ($pidl,$comh_filename) = @_;
+	my $res = "";
+	my $has_obj = 0;
+
+	$res .=	"#include \"includes.h\"\n" .
+			"#include \"lib/com/dcom/dcom.h\"\n" .
+			"#include \"$comh_filename\"\n" .
+			"#include \"librpc/rpc/dcerpc.h\"\n";
+
+	foreach (@{$pidl}) {
+		next if ($_->{TYPE} ne "INTERFACE");
+		next if has_property($_, "local");
+		next unless has_property($_, "object");
+
+		$res .= ParseInterface($_);
+
+		$has_obj = 1;
+	}
+
+	return $res if ($has_obj);
+	return undef;
+}
+
+1;

pidl/lib/Parse/Pidl/Samba4/COM/Stub.pm

@@ -0,0 +1,327 @@
+###################################################
+# DCOM stub boilerplate generator
+# Copyright jelmer@samba.org 2004-2005
+# Copyright tridge@samba.org 2003
+# Copyright metze@samba.org 2004
+# released under the GNU GPL
+
+package Parse::Pidl::Samba4::COM::Stub;
+
+use Parse::Pidl::Util qw(has_property);
+use strict;
+
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+my($res);
+
+sub pidl($)
+{
+	$res .= shift;
+}
+
+#####################################################
+# generate the switch statement for function dispatch
+sub gen_dispatch_switch($)
+{
+	my $data = shift;
+
+	my $count = 0;
+	foreach my $d (@{$data}) {
+		next if ($d->{TYPE} ne "FUNCTION");
+
+		pidl "\tcase $count: {\n";
+		if ($d->{RETURN_TYPE} && $d->{RETURN_TYPE} ne "void") {
+			pidl "\t\tNTSTATUS result;\n";
+		}
+		pidl "\t\tstruct $d->{NAME} *r2 = r;\n";
+		pidl "\t\tif (DEBUGLEVEL > 10) {\n";
+		pidl "\t\t\tNDR_PRINT_FUNCTION_DEBUG($d->{NAME}, NDR_IN, r2);\n";
+		pidl "\t\t}\n";
+		if ($d->{RETURN_TYPE} && $d->{RETURN_TYPE} ne "void") {
+			pidl "\t\tresult = vtable->$d->{NAME}(iface, mem_ctx, r2);\n";
+		} else {
+			pidl "\t\tvtable->$d->{NAME}(iface, mem_ctx, r2);\n";
+		}
+		pidl "\t\tif (dce_call->state_flags & DCESRV_CALL_STATE_FLAG_ASYNC) {\n";
+		pidl "\t\t\tDEBUG(5,(\"function $d->{NAME} will reply async\\n\"));\n";
+		pidl "\t\t}\n";
+		pidl "\t\tbreak;\n\t}\n";
+		$count++; 
+	}
+}
+
+#####################################################
+# generate the switch statement for function reply
+sub gen_reply_switch($)
+{
+	my $data = shift;
+
+	my $count = 0;
+	foreach my $d (@{$data}) {
+		next if ($d->{TYPE} ne "FUNCTION");
+
+		pidl "\tcase $count: {\n";
+		pidl "\t\tstruct $d->{NAME} *r2 = r;\n";
+		pidl "\t\tif (dce_call->state_flags & DCESRV_CALL_STATE_FLAG_ASYNC) {\n";
+		pidl "\t\t\tDEBUG(5,(\"function $d->{NAME} replied async\\n\"));\n";
+		pidl "\t\t}\n";
+		pidl "\t\tif (DEBUGLEVEL > 10 && dce_call->fault_code == 0) {\n";
+		pidl "\t\t\tNDR_PRINT_FUNCTION_DEBUG($d->{NAME}, NDR_OUT | NDR_SET_VALUES, r2);\n";
+		pidl "\t\t}\n";
+		pidl "\t\tif (dce_call->fault_code != 0) {\n";
+		pidl "\t\t\tDEBUG(2,(\"dcerpc_fault %s in $d->{NAME}\\n\", dcerpc_errstr(mem_ctx, dce_call->fault_code)));\n";
+		pidl "\t\t}\n";
+		pidl "\t\tbreak;\n\t}\n";
+		$count++; 
+	}
+}
+
+#####################################################################
+# produce boilerplate code for a interface
+sub Boilerplate_Iface($)
+{
+	my($interface) = shift;
+	my($data) = $interface->{DATA};
+	my $name = $interface->{NAME};
+	my $uname = uc $name;
+	my $uuid = Parse::Pidl::Util::make_str($interface->{PROPERTIES}->{uuid});
+	my $if_version = $interface->{PROPERTIES}->{version};
+
+	pidl "
+static NTSTATUS $name\__op_bind(struct dcesrv_call_state *dce_call, const struct dcesrv_interface *iface, uint32_t if_version)
+{
+#ifdef DCESRV_INTERFACE_$uname\_BIND
+	return DCESRV_INTERFACE_$uname\_BIND(dce_call,iface);
+#else
+	return NT_STATUS_OK;
+#endif
+}
+
+static void $name\__op_unbind(struct dcesrv_connection_context *context, const struct dcesrv_interface *iface)
+{
+#ifdef DCESRV_INTERFACE_$uname\_UNBIND
+	DCESRV_INTERFACE_$uname\_UNBIND(context, iface);
+#else
+	return;
+#endif
+}
+
+static NTSTATUS $name\__op_ndr_pull(struct dcesrv_call_state *dce_call, TALLOC_CTX *mem_ctx, struct ndr_pull *pull, void **r)
+{
+	NTSTATUS status;
+	uint16_t opnum = dce_call->pkt.u.request.opnum;
+
+	dce_call->fault_code = 0;
+
+	if (opnum >= dcerpc_table_$name.num_calls) {
+		dce_call->fault_code = DCERPC_FAULT_OP_RNG_ERROR;
+		return NT_STATUS_NET_WRITE_FAULT;
+	}
+
+	*r = talloc_size(mem_ctx, dcerpc_table_$name.calls[opnum].struct_size);
+	NT_STATUS_HAVE_NO_MEMORY(*r);
+
+        /* unravel the NDR for the packet */
+	status = dcerpc_table_$name.calls[opnum].ndr_pull(pull, NDR_IN, *r);
+	if (!NT_STATUS_IS_OK(status)) {
+		dcerpc_log_packet(&dcerpc_table_$name, opnum, NDR_IN,
+				  &dce_call->pkt.u.request.stub_and_verifier);
+		dce_call->fault_code = DCERPC_FAULT_NDR;
+		return NT_STATUS_NET_WRITE_FAULT;
+	}
+
+	return NT_STATUS_OK;
+}
+
+static NTSTATUS $name\__op_dispatch(struct dcesrv_call_state *dce_call, TALLOC_CTX *mem_ctx, void *r)
+{
+	uint16_t opnum = dce_call->pkt.u.request.opnum;
+	struct GUID ipid = dce_call->pkt.u.request.object.object;
+	struct dcom_interface_p *iface = dcom_get_local_iface_p(&ipid);
+	const struct dcom_$name\_vtable *vtable = iface->vtable;
+
+	switch (opnum) {
+";
+	gen_dispatch_switch($data);
+
+pidl "
+	default:
+		dce_call->fault_code = DCERPC_FAULT_OP_RNG_ERROR;
+		break;
+	}
+
+	if (dce_call->fault_code != 0) {
+		dcerpc_log_packet(&dcerpc_table_$name, opnum, NDR_IN,
+				  &dce_call->pkt.u.request.stub_and_verifier);
+		return NT_STATUS_NET_WRITE_FAULT;
+	}
+
+	return NT_STATUS_OK;
+}
+
+static NTSTATUS $name\__op_reply(struct dcesrv_call_state *dce_call, TALLOC_CTX *mem_ctx, void *r)
+{
+	uint16_t opnum = dce_call->pkt.u.request.opnum;
+
+	switch (opnum) {
+";
+	gen_reply_switch($data);
+
+pidl "
+	default:
+		dce_call->fault_code = DCERPC_FAULT_OP_RNG_ERROR;
+		break;
+	}
+
+	if (dce_call->fault_code != 0) {
+		dcerpc_log_packet(&dcerpc_table_$name, opnum, NDR_IN,
+				  &dce_call->pkt.u.request.stub_and_verifier);
+		return NT_STATUS_NET_WRITE_FAULT;
+	}
+
+	return NT_STATUS_OK;
+}
+
+static NTSTATUS $name\__op_ndr_push(struct dcesrv_call_state *dce_call, TALLOC_CTX *mem_ctx, struct ndr_push *push, const void *r)
+{
+	NTSTATUS status;
+	uint16_t opnum = dce_call->pkt.u.request.opnum;
+
+	status = dcerpc_table_$name.calls[opnum].ndr_push(push, NDR_OUT, r);
+	if (!NT_STATUS_IS_OK(status)) {
+		dce_call->fault_code = DCERPC_FAULT_NDR;
+		return NT_STATUS_NET_WRITE_FAULT;
+	}
+
+	return NT_STATUS_OK;
+}
+
+static const struct dcesrv_interface $name\_interface = {
+	.name		= \"$name\",
+	.uuid		= $uuid,
+	.if_version	= $if_version,
+	.bind		= $name\__op_bind,
+	.unbind		= $name\__op_unbind,
+	.ndr_pull	= $name\__op_ndr_pull,
+	.dispatch	= $name\__op_dispatch,
+	.reply		= $name\__op_reply,
+	.ndr_push	= $name\__op_ndr_push
+};
+
+";
+}
+
+#####################################################################
+# produce boilerplate code for an endpoint server
+sub Boilerplate_Ep_Server($)
+{
+	my($interface) = shift;
+	my $name = $interface->{NAME};
+	my $uname = uc $name;
+
+	pidl "
+static NTSTATUS $name\__op_init_server(struct dcesrv_context *dce_ctx, const struct dcesrv_endpoint_server *ep_server)
+{
+	int i;
+
+	for (i=0;i<dcerpc_table_$name.endpoints->count;i++) {
+		NTSTATUS ret;
+		const char *name = dcerpc_table_$name.endpoints->names[i];
+
+		ret = dcesrv_interface_register(dce_ctx, name, &$name\_interface, NULL);
+		if (!NT_STATUS_IS_OK(ret)) {
+			DEBUG(1,(\"$name\_op_init_server: failed to register endpoint \'%s\'\\n\",name));
+			return ret;
+		}
+	}
+
+	return NT_STATUS_OK;
+}
+
+static BOOL $name\__op_interface_by_uuid(struct dcesrv_interface *iface, const char *uuid, uint32_t if_version)
+{
+	if (dcerpc_table_$name.if_version == if_version &&
+		strcmp(dcerpc_table_$name.uuid, uuid)==0) {
+		memcpy(iface,&dcerpc_table_$name, sizeof(*iface));
+		return True;
+	}
+
+	return False;
+}
+
+static BOOL $name\__op_interface_by_name(struct dcesrv_interface *iface, const char *name)
+{
+	if (strcmp(dcerpc_table_$name.name, name)==0) {
+		memcpy(iface,&dcerpc_table_$name, sizeof(*iface));
+		return True;
+	}
+
+	return False;	
+}
+	
+NTSTATUS dcerpc_server_$name\_init(void)
+{
+	NTSTATUS ret;
+	struct dcesrv_endpoint_server ep_server;
+
+	/* fill in our name */
+	ep_server.name = \"$name\";
+
+	/* fill in all the operations */
+	ep_server.init_server = $name\__op_init_server;
+
+	ep_server.interface_by_uuid = $name\__op_interface_by_uuid;
+	ep_server.interface_by_name = $name\__op_interface_by_name;
+
+	/* register ourselves with the DCERPC subsystem. */
+	ret = dcerpc_register_ep_server(&ep_server);
+
+	if (!NT_STATUS_IS_OK(ret)) {
+		DEBUG(0,(\"Failed to register \'$name\' endpoint server!\\n\"));
+		return ret;
+	}
+
+	return ret;
+}
+
+";
+}
+
+#####################################################################
+# dcom interface stub from a parsed IDL structure 
+sub ParseInterface($)
+{
+	my($interface) = shift;
+	
+	return "" if has_property($interface, "local");
+	
+	my($data) = $interface->{DATA};
+	my $count = 0;
+
+	$res = "";
+
+	if (!defined $interface->{PROPERTIES}->{uuid}) {
+		return $res;
+	}
+
+	if (!defined $interface->{PROPERTIES}->{version}) {
+		$interface->{PROPERTIES}->{version} = "0.0";
+	}
+
+	foreach my $d (@{$data}) {
+		if ($d->{TYPE} eq "FUNCTION") { $count++; }
+	}
+
+	if ($count == 0) {
+		return $res;
+	}
+
+	$res = "/* dcom interface stub generated by pidl */\n\n";
+	Boilerplate_Iface($interface);
+	Boilerplate_Ep_Server($interface);
+
+	return $res;
+}
+
+1;

pidl/lib/Parse/Pidl/Samba4/Header.pm

@@ -0,0 +1,537 @@
+###################################################
+# create C header files for an IDL structure
+# Copyright tridge@samba.org 2000
+# Copyright jelmer@samba.org 2005
+# released under the GNU GPL
+
+package Parse::Pidl::Samba4::Header;
+require Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(GenerateFunctionInEnv GenerateFunctionOutEnv EnvSubstituteValue GenerateStructEnv);
+
+use strict;
+use Parse::Pidl qw(fatal);
+use Parse::Pidl::Typelist qw(mapTypeName scalar_is_reference);
+use Parse::Pidl::Util qw(has_property is_constant unmake_str ParseExpr);
+use Parse::Pidl::Samba4 qw(is_intree ElementStars ArrayBrackets choose_header);
+
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+my($res);
+my($tab_depth);
+
+sub pidl($) { $res .= shift; }
+
+sub tabs()
+{
+	my $res = "";
+	$res .="\t" foreach (1..$tab_depth);
+	return $res;
+}
+
+#####################################################################
+# parse a properties list
+sub HeaderProperties($$)
+{
+	my($props,$ignores) = @_;
+	my $ret = "";
+
+	foreach my $d (keys %{$props}) {
+		next if (grep(/^$d$/, @$ignores));
+		if($props->{$d} ne "1") {
+			$ret.= "$d($props->{$d}),";
+		} else {
+			$ret.="$d,";
+		}
+	}
+
+	if ($ret) {
+		pidl "/* [" . substr($ret, 0, -1) . "] */";
+	}
+}
+
+#####################################################################
+# parse a structure element
+sub HeaderElement($)
+{
+	my($element) = shift;
+
+	pidl tabs();
+	if (has_property($element, "represent_as")) {
+		pidl mapTypeName($element->{PROPERTIES}->{represent_as})." ";
+	} else {
+		if (ref($element->{TYPE}) eq "HASH") {
+			HeaderType($element, $element->{TYPE}, $element->{TYPE}->{NAME});
+		} else {
+			HeaderType($element, $element->{TYPE}, "");
+		}
+		pidl " ".ElementStars($element);
+	}
+	pidl $element->{NAME};
+	pidl ArrayBrackets($element);
+
+	pidl ";";
+	if (defined $element->{PROPERTIES}) {
+		HeaderProperties($element->{PROPERTIES}, ["in", "out"]);
+	}
+	pidl "\n";
+}
+
+#####################################################################
+# parse a struct
+sub HeaderStruct($$;$)
+{
+	my($struct,$name,$tail) = @_;
+	pidl "struct $name";
+	pidl $tail if defined($tail) and not defined($struct->{ELEMENTS});
+	return if (not defined($struct->{ELEMENTS}));
+	pidl " {\n";
+	$tab_depth++;
+	my $el_count=0;
+	foreach (@{$struct->{ELEMENTS}}) {
+		HeaderElement($_);
+		$el_count++;
+	}
+	if ($el_count == 0) {
+		# some compilers can't handle empty structures
+		pidl tabs()."char _empty_;\n";
+	}
+	$tab_depth--;
+	pidl tabs()."}";
+	if (defined $struct->{PROPERTIES}) {
+		HeaderProperties($struct->{PROPERTIES}, []);
+	}
+	pidl $tail if defined($tail);
+}
+
+#####################################################################
+# parse a enum
+sub HeaderEnum($$;$)
+{
+	my($enum,$name,$tail) = @_;
+	my $first = 1;
+
+	pidl "enum $name";
+	if (defined($enum->{ELEMENTS})) {
+		pidl "\n#ifndef USE_UINT_ENUMS\n";
+		pidl " {\n";
+		$tab_depth++;
+		foreach my $e (@{$enum->{ELEMENTS}}) {
+			my @enum_els = ();
+			unless ($first) { pidl ",\n"; }
+			$first = 0;
+			pidl tabs();
+			@enum_els = split(/=/, $e);
+			if (@enum_els == 2) {
+				pidl $enum_els[0];
+				pidl "=(int)";
+				pidl "(";
+				pidl $enum_els[1];
+				pidl ")";
+			} else {
+				pidl $e;
+			}
+		}
+		pidl "\n";
+		$tab_depth--;
+		pidl "}";
+		pidl "\n";
+		pidl "#else\n";
+		my $count = 0;
+		my $with_val = 0;
+		my $without_val = 0;
+		pidl " { __donnot_use_enum_$name=0x7FFFFFFF}\n";
+		foreach my $e (@{$enum->{ELEMENTS}}) {
+			my $t = "$e";
+			my $name;
+			my $value;
+			if ($t =~ /(.*)=(.*)/) {
+				$name = $1;
+				$value = $2;
+				$with_val = 1;
+				fatal($e->{ORIGINAL}, "you can't mix enum member with values and without values!")
+					unless ($without_val == 0);
+			} else {
+				$name = $t;
+				$value = $count++;
+				$without_val = 1;
+				fatal($e->{ORIGINAL}, "you can't mix enum member with values and without values!")
+					unless ($with_val == 0);
+			}
+			pidl "#define $name ( $value )\n";
+		}
+		pidl "#endif\n";
+	}
+	pidl $tail if defined($tail);
+}
+
+#####################################################################
+# parse a bitmap
+sub HeaderBitmap($$)
+{
+	my($bitmap,$name) = @_;
+
+	return unless defined($bitmap->{ELEMENTS});
+
+	pidl "/* bitmap $name */\n";
+	pidl "#define $_\n" foreach (@{$bitmap->{ELEMENTS}});
+	pidl "\n";
+}
+
+#####################################################################
+# parse a union
+sub HeaderUnion($$;$)
+{
+	my($union,$name,$tail) = @_;
+	my %done = ();
+
+	pidl "union $name";
+	pidl $tail if defined($tail) and not defined($union->{ELEMENTS});
+	return if (not defined($union->{ELEMENTS}));
+	pidl " {\n";
+	$tab_depth++;
+	my $needed = 0;
+	foreach my $e (@{$union->{ELEMENTS}}) {
+		if ($e->{TYPE} ne "EMPTY") {
+			if (! defined $done{$e->{NAME}}) {
+				HeaderElement($e);
+			}
+			$done{$e->{NAME}} = 1;
+			$needed++;
+		}
+	}
+	if (!$needed) {
+		# sigh - some compilers don't like empty structures
+		pidl tabs()."int _dummy_element;\n";
+	}
+	$tab_depth--;
+	pidl "}";
+
+	if (defined $union->{PROPERTIES}) {
+		HeaderProperties($union->{PROPERTIES}, []);
+	}
+	pidl $tail if defined($tail);
+}
+
+#####################################################################
+# parse a pipe
+sub HeaderPipe($$;$)
+{
+	my($pipe,$name,$tail) = @_;
+
+	my $struct = $pipe->{DATA};
+	my $e = $struct->{ELEMENTS}[1];
+
+	pidl "struct $name;\n";
+	pidl "struct $struct->{NAME} {\n";
+	$tab_depth++;
+	pidl tabs()."uint32_t count;\n";
+	pidl tabs().mapTypeName($e->{TYPE})." *array;\n";
+	$tab_depth--;
+	pidl "}";
+
+	if (defined $struct->{PROPERTIES}) {
+		HeaderProperties($struct->{PROPERTIES}, []);
+	}
+
+	pidl $tail if defined($tail);
+}
+
+#####################################################################
+# parse a type
+sub HeaderType($$$;$)
+{
+	my($e,$data,$name,$tail) = @_;
+	if (ref($data) eq "HASH") {
+		($data->{TYPE} eq "ENUM") && HeaderEnum($data, $name, $tail);
+		($data->{TYPE} eq "BITMAP") && HeaderBitmap($data, $name);
+		($data->{TYPE} eq "STRUCT") && HeaderStruct($data, $name, $tail);
+		($data->{TYPE} eq "UNION") && HeaderUnion($data, $name, $tail);
+		($data->{TYPE} eq "PIPE") && HeaderPipe($data, $name, $tail);
+		return;
+	}
+
+	if (has_property($e, "charset")) {
+		pidl "const char";
+	} else {
+		pidl mapTypeName($e->{TYPE});
+	}
+	pidl $tail if defined($tail);
+}
+
+#####################################################################
+# parse a typedef
+sub HeaderTypedef($;$)
+{
+	my($typedef,$tail) = @_;
+	# Don't print empty "enum foo;", since some compilers don't like it.
+	return if ($typedef->{DATA}->{TYPE} eq "ENUM" and not defined($typedef->{DATA}->{ELEMENTS}));
+	HeaderType($typedef, $typedef->{DATA}, $typedef->{NAME}, $tail) if defined ($typedef->{DATA});
+}
+
+#####################################################################
+# parse a const
+sub HeaderConst($)
+{
+	my($const) = shift;
+	if (!defined($const->{ARRAY_LEN}[0])) {
+		pidl "#define $const->{NAME}\t( $const->{VALUE} )\n";
+	} else {
+		pidl "#define $const->{NAME}\t $const->{VALUE}\n";
+	}
+}
+
+sub ElementDirection($)
+{
+	my ($e) = @_;
+
+	return "inout" if (has_property($e, "in") and has_property($e, "out"));
+	return "in" if (has_property($e, "in"));
+	return "out" if (has_property($e, "out"));
+	return "inout";
+}
+
+#####################################################################
+# parse a function
+sub HeaderFunctionInOut($$)
+{
+	my($fn,$prop) = @_;
+
+	return unless defined($fn->{ELEMENTS});
+
+	foreach my $e (@{$fn->{ELEMENTS}}) {
+		HeaderElement($e) if (ElementDirection($e) eq $prop);
+	}
+}
+
+#####################################################################
+# determine if we need an "in" or "out" section
+sub HeaderFunctionInOut_needed($$)
+{
+	my($fn,$prop) = @_;
+
+	return 1 if ($prop eq "out" && defined($fn->{RETURN_TYPE}));
+
+	return undef unless defined($fn->{ELEMENTS});
+
+	foreach my $e (@{$fn->{ELEMENTS}}) {
+		return 1 if (ElementDirection($e) eq $prop);
+	}
+
+	return undef;
+}
+
+my %headerstructs;
+
+#####################################################################
+# parse a function
+sub HeaderFunction($)
+{
+	my($fn) = shift;
+
+	return if ($headerstructs{$fn->{NAME}});
+
+	$headerstructs{$fn->{NAME}} = 1;
+
+	pidl "\nstruct $fn->{NAME} {\n";
+	$tab_depth++;
+	my $needed = 0;
+
+	if (HeaderFunctionInOut_needed($fn, "in") or
+	    HeaderFunctionInOut_needed($fn, "inout")) {
+		pidl tabs()."struct {\n";
+		$tab_depth++;
+		HeaderFunctionInOut($fn, "in");
+		HeaderFunctionInOut($fn, "inout");
+		$tab_depth--;
+		pidl tabs()."} in;\n\n";
+		$needed++;
+	}
+
+	if (HeaderFunctionInOut_needed($fn, "out") or
+	    HeaderFunctionInOut_needed($fn, "inout")) {
+		pidl tabs()."struct {\n";
+		$tab_depth++;
+		HeaderFunctionInOut($fn, "out");
+		HeaderFunctionInOut($fn, "inout");
+		if (defined($fn->{RETURN_TYPE})) {
+			pidl tabs().mapTypeName($fn->{RETURN_TYPE}) . " result;\n";
+		}
+		$tab_depth--;
+		pidl tabs()."} out;\n\n";
+		$needed++;
+	}
+
+	if (!$needed) {
+		# sigh - some compilers don't like empty structures
+		pidl tabs()."int _dummy_element;\n";
+	}
+
+	$tab_depth--;
+	pidl "};\n\n";
+}
+
+sub HeaderImport
+{
+	my @imports = @_;
+	foreach my $import (@imports) {
+		$import = unmake_str($import);
+		$import =~ s/\.idl$//;
+		pidl choose_header("librpc/gen_ndr/$import\.h", "gen_ndr/$import.h") . "\n";
+	}
+}
+
+sub HeaderInclude
+{
+	my @includes = @_;
+	foreach (@includes) {
+		pidl "#include $_\n";
+	}
+}
+
+#####################################################################
+# parse the interface definitions
+sub HeaderInterface($)
+{
+	my($interface) = shift;
+
+	pidl "#ifndef _HEADER_$interface->{NAME}\n";
+	pidl "#define _HEADER_$interface->{NAME}\n\n";
+
+	foreach my $c (@{$interface->{CONSTS}}) {
+		HeaderConst($c);
+	}
+
+	foreach my $t (@{$interface->{TYPES}}) {
+		HeaderTypedef($t, ";\n\n") if ($t->{TYPE} eq "TYPEDEF");
+		HeaderStruct($t, $t->{NAME}, ";\n\n") if ($t->{TYPE} eq "STRUCT");
+		HeaderUnion($t, $t->{NAME}, ";\n\n") if ($t->{TYPE} eq "UNION");
+		HeaderEnum($t, $t->{NAME}, ";\n\n") if ($t->{TYPE} eq "ENUM");
+		HeaderBitmap($t, $t->{NAME}) if ($t->{TYPE} eq "BITMAP");
+		HeaderPipe($t, $t->{NAME}, "\n\n") if ($t->{TYPE} eq "PIPE");
+	}
+
+	foreach my $fn (@{$interface->{FUNCTIONS}}) {
+		HeaderFunction($fn);
+	}
+
+	pidl "#endif /* _HEADER_$interface->{NAME} */\n";
+}
+
+sub HeaderQuote($)
+{
+	my($quote) = shift;
+
+	pidl unmake_str($quote->{DATA}) . "\n";
+}
+
+#####################################################################
+# parse a parsed IDL into a C header
+sub Parse($)
+{
+	my($ndr) = shift;
+	$tab_depth = 0;
+
+	$res = "";
+	%headerstructs = ();
+	pidl "/* header auto-generated by pidl */\n\n";
+
+	my $ifacename = "";
+
+	# work out a unique interface name
+	foreach (@{$ndr}) {
+		if ($_->{TYPE} eq "INTERFACE") {
+			$ifacename = $_->{NAME};
+			last;
+		}
+	}
+
+	pidl "#ifndef _PIDL_HEADER_$ifacename\n";
+	pidl "#define _PIDL_HEADER_$ifacename\n\n";
+
+	if (!is_intree()) {
+		pidl "#include <util/data_blob.h>\n";
+	}
+	pidl "#include <stdint.h>\n";
+	pidl "\n";
+	# FIXME: Include this only if NTSTATUS was actually used
+	pidl choose_header("libcli/util/ntstatus.h", "core/ntstatus.h") . "\n";
+	pidl "\n";
+
+	foreach (@{$ndr}) {
+		($_->{TYPE} eq "CPP_QUOTE") && HeaderQuote($_);
+		($_->{TYPE} eq "INTERFACE") && HeaderInterface($_);
+		($_->{TYPE} eq "IMPORT") && HeaderImport(@{$_->{PATHS}});
+		($_->{TYPE} eq "INCLUDE") && HeaderInclude(@{$_->{PATHS}});
+	}
+
+	pidl "#endif /* _PIDL_HEADER_$ifacename */\n";
+
+	return $res;
+}
+
+sub GenerateStructEnv($$)
+{
+	my ($x, $v) = @_;
+	my %env;
+
+	foreach my $e (@{$x->{ELEMENTS}}) {
+		$env{$e->{NAME}} = "$v->$e->{NAME}";
+	}
+
+	$env{"this"} = $v;
+
+	return \%env;
+}
+
+sub EnvSubstituteValue($$)
+{
+	my ($env,$s) = @_;
+
+	# Substitute the value() values in the env
+	foreach my $e (@{$s->{ELEMENTS}}) {
+		next unless (defined(my $v = has_property($e, "value")));
+		
+		$env->{$e->{NAME}} = ParseExpr($v, $env, $e);
+	}
+
+	return $env;
+}
+
+sub GenerateFunctionInEnv($;$)
+{
+	my ($fn, $base) = @_;
+	my %env;
+
+	$base = "r->" unless defined($base);
+
+	foreach my $e (@{$fn->{ELEMENTS}}) {
+		if (grep (/in/, @{$e->{DIRECTION}})) {
+			$env{$e->{NAME}} = $base."in.$e->{NAME}";
+		}
+	}
+
+	return \%env;
+}
+
+sub GenerateFunctionOutEnv($;$)
+{
+	my ($fn, $base) = @_;
+	my %env;
+
+	$base = "r->" unless defined($base);
+
+	foreach my $e (@{$fn->{ELEMENTS}}) {
+		if (grep (/out/, @{$e->{DIRECTION}})) {
+			$env{$e->{NAME}} = $base."out.$e->{NAME}";
+		} elsif (grep (/in/, @{$e->{DIRECTION}})) {
+			$env{$e->{NAME}} = $base."in.$e->{NAME}";
+		}
+	}
+
+	return \%env;
+}
+
+1;

pidl/lib/Parse/Pidl/Samba4/NDR/Client.pm

@@ -0,0 +1,875 @@
+###################################################
+# client calls generator
+# Copyright tridge@samba.org 2003
+# Copyright jelmer@samba.org 2005-2006
+# released under the GNU GPL
+
+package Parse::Pidl::Samba4::NDR::Client;
+
+use Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(Parse);
+
+use Parse::Pidl qw(fatal warning error);
+use Parse::Pidl::Util qw(has_property ParseExpr);
+use Parse::Pidl::NDR qw(ContainsPipe);
+use Parse::Pidl::Typelist qw(mapTypeName);
+use Parse::Pidl::Samba4 qw(choose_header is_intree DeclLong);
+use Parse::Pidl::Samba4::Header qw(GenerateFunctionInEnv GenerateFunctionOutEnv);
+
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+use strict;
+
+sub indent($) { my ($self) = @_; $self->{tabs}.="\t"; }
+sub deindent($) { my ($self) = @_; $self->{tabs} = substr($self->{tabs}, 1); }
+sub pidl($$) { my ($self,$txt) = @_; $self->{res} .= $txt ? "$self->{tabs}$txt\n" : "\n"; }
+sub pidl_hdr($$) { my ($self, $txt) = @_; $self->{res_hdr} .= "$txt\n"; }
+sub pidl_both($$) { my ($self, $txt) = @_; $self->{hdr} .= "$txt\n"; $self->{res_hdr} .= "$txt\n"; }
+sub fn_declare($$) { my ($self,$n) = @_; $self->pidl($n); $self->pidl_hdr("$n;"); }
+
+sub genpad($)
+{
+	my ($s) = @_;
+	my $nt = int((length($s)+1)/8);
+	my $lt = ($nt*8)-1;
+	my $ns = (length($s)-$lt);
+	return "\t"x($nt)." "x($ns);
+}
+
+sub new($)
+{
+	my ($class) = shift;
+	my $self = { res => "", res_hdr => "", tabs => "" };
+	bless($self, $class);
+}
+
+sub ParseFunctionHasPipes($$)
+{
+	my ($self, $fn) = @_;
+
+	foreach my $e (@{$fn->{ELEMENTS}}) {
+		return 1 if ContainsPipe($e, $e->{LEVELS}[0]);
+	}
+
+	return 0;
+}
+
+sub ParseFunction_r_State($$$$)
+{
+	my ($self, $if, $fn, $name) = @_;
+	my $uname = uc $name;
+
+	$self->pidl("struct dcerpc_$name\_r_state {");
+	$self->indent;
+	$self->pidl("TALLOC_CTX *out_mem_ctx;");
+	$self->deindent;
+	$self->pidl("};");
+	$self->pidl("");
+	$self->pidl("static void dcerpc_$name\_r_done(struct tevent_req *subreq);");
+	$self->pidl("");
+}
+
+sub ParseFunction_r_Send($$$$)
+{
+	my ($self, $if, $fn, $name) = @_;
+	my $uname = uc $name;
+
+	my $proto = "struct tevent_req *dcerpc_$name\_r_send(TALLOC_CTX *mem_ctx,\n";
+	$proto   .= "\tstruct tevent_context *ev,\n",
+	$proto   .= "\tstruct dcerpc_binding_handle *h,\n",
+	$proto   .= "\tstruct $name *r)";
+
+	$self->fn_declare($proto);
+
+	$self->pidl("{");
+	$self->indent;
+
+	$self->pidl("struct tevent_req *req;");
+	$self->pidl("struct dcerpc_$name\_r_state *state;");
+	$self->pidl("struct tevent_req *subreq;");
+	$self->pidl("");
+
+	$self->pidl("req = tevent_req_create(mem_ctx, &state,");
+	$self->pidl("\t\t\tstruct dcerpc_$name\_r_state);");
+	$self->pidl("if (req == NULL) {");
+	$self->indent;
+	$self->pidl("return NULL;");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+
+	my $out_params = 0;
+	foreach my $e (@{$fn->{ELEMENTS}}) {
+		next unless grep(/out/, @{$e->{DIRECTION}});
+		next if ContainsPipe($e, $e->{LEVELS}[0]);
+		$out_params++;
+
+	}
+
+	my $submem;
+	if ($out_params > 0) {
+		$self->pidl("state->out_mem_ctx = talloc_new(state);");
+		$self->pidl("if (tevent_req_nomem(state->out_mem_ctx, req)) {");
+		$self->indent;
+		$self->pidl("return tevent_req_post(req, ev);");
+		$self->deindent;
+		$self->pidl("}");
+		$submem = "state->out_mem_ctx";
+	} else {
+		$self->pidl("state->out_mem_ctx = NULL;");
+		$submem = "state";
+	}
+	$self->pidl("");
+
+	$self->pidl("subreq = dcerpc_binding_handle_call_send(state, ev, h,");
+	$self->pidl("\t\tNULL, &ndr_table_$if->{NAME},");
+	$self->pidl("\t\tNDR_$uname, $submem, r);");
+	$self->pidl("if (tevent_req_nomem(subreq, req)) {");
+	$self->indent;
+	$self->pidl("return tevent_req_post(req, ev);");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("tevent_req_set_callback(subreq, dcerpc_$name\_r_done, req);");
+	$self->pidl("");
+
+	$self->pidl("return req;");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+}
+
+sub ParseFunction_r_Done($$$$)
+{
+	my ($self, $if, $fn, $name) = @_;
+	my $uname = uc $name;
+
+	my $proto = "static void dcerpc_$name\_r_done(struct tevent_req *subreq)";
+
+	$self->pidl("$proto");
+	$self->pidl("{");
+	$self->indent;
+
+	$self->pidl("struct tevent_req *req =");
+	$self->pidl("\ttevent_req_callback_data(subreq,");
+	$self->pidl("\tstruct tevent_req);");
+	$self->pidl("NTSTATUS status;");
+	$self->pidl("");
+
+	$self->pidl("status = dcerpc_binding_handle_call_recv(subreq);");
+	$self->pidl("if (!NT_STATUS_IS_OK(status)) {");
+	$self->indent;
+	$self->pidl("tevent_req_nterror(req, status);");
+	$self->pidl("return;");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+
+	$self->pidl("tevent_req_done(req);");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+}
+
+sub ParseFunction_r_Recv($$$$)
+{
+	my ($self, $if, $fn, $name) = @_;
+	my $uname = uc $name;
+
+	my $proto = "NTSTATUS dcerpc_$name\_r_recv(struct tevent_req *req, TALLOC_CTX *mem_ctx)";
+
+	$self->fn_declare($proto);
+
+	$self->pidl("{");
+	$self->indent;
+
+	$self->pidl("struct dcerpc_$name\_r_state *state =");
+	$self->pidl("\ttevent_req_data(req,");
+	$self->pidl("\tstruct dcerpc_$name\_r_state);");
+	$self->pidl("NTSTATUS status;");
+	$self->pidl("");
+
+	$self->pidl("if (tevent_req_is_nterror(req, &status)) {");
+	$self->indent;
+	$self->pidl("tevent_req_received(req);");
+	$self->pidl("return status;");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+
+	$self->pidl("talloc_steal(mem_ctx, state->out_mem_ctx);");
+	$self->pidl("");
+
+	$self->pidl("tevent_req_received(req);");
+	$self->pidl("return NT_STATUS_OK;");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+}
+
+sub ParseFunction_r_Sync($$$$)
+{
+	my ($self, $if, $fn, $name) = @_;
+	my $uname = uc $name;
+
+	if ($self->ParseFunctionHasPipes($fn)) {
+		$self->pidl_both("/*");
+		$self->pidl_both(" * The following function is skipped because");
+		$self->pidl_both(" * it uses pipes:");
+		$self->pidl_both(" *");
+		$self->pidl_both(" * dcerpc_$name\_r()");
+		$self->pidl_both(" */");
+		$self->pidl_both("");
+		return;
+	}
+
+	my $proto = "NTSTATUS dcerpc_$name\_r(struct dcerpc_binding_handle *h, TALLOC_CTX *mem_ctx, struct $name *r)";
+
+	$self->fn_declare($proto);
+
+	$self->pidl("{");
+	$self->indent;
+	$self->pidl("NTSTATUS status;");
+	$self->pidl("");
+
+	$self->pidl("status = dcerpc_binding_handle_call(h,");
+	$self->pidl("\t\tNULL, &ndr_table_$if->{NAME},");
+	$self->pidl("\t\tNDR_$uname, mem_ctx, r);");
+	$self->pidl("");
+	$self->pidl("return status;");
+
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+}
+
+sub ElementDirection($)
+{
+	my ($e) = @_;
+
+	return "[in,out]" if (has_property($e, "in") and has_property($e, "out"));
+	return "[in]" if (has_property($e, "in"));
+	return "[out]" if (has_property($e, "out"));
+	return "[in,out]";
+}
+
+sub HeaderProperties($$)
+{
+	my($props,$ignores) = @_;
+	my $ret = "";
+
+	foreach my $d (keys %{$props}) {
+		next if (grep(/^$d$/, @$ignores));
+		if($props->{$d} ne "1") {
+			$ret.= "$d($props->{$d}),";
+		} else {
+			$ret.="$d,";
+		}
+	}
+
+	if ($ret) {
+		return "[" . substr($ret, 0, -1) . "]";
+	}
+}
+
+sub ParseCopyArgument($$$$$)
+{
+	my ($self, $fn, $e, $r, $i) = @_;
+	my $l = $e->{LEVELS}[0];
+
+	if ($l->{TYPE} eq "ARRAY" and $l->{IS_FIXED} == 1) {
+		$self->pidl("memcpy(${r}$e->{NAME}, ${i}$e->{NAME}, sizeof(${r}$e->{NAME}));");
+	} else {
+		$self->pidl("${r}$e->{NAME} = ${i}$e->{NAME};");
+	}
+}
+
+sub ParseInvalidResponse($$)
+{
+	my ($self, $type) = @_;
+
+	if ($type eq "sync") {
+		$self->pidl("return NT_STATUS_INVALID_NETWORK_RESPONSE;");
+	} elsif ($type eq "async") {
+		$self->pidl("tevent_req_nterror(req, NT_STATUS_INVALID_NETWORK_RESPONSE);");
+		$self->pidl("return;");
+	} else {
+		die("ParseInvalidResponse($type)");
+	}
+}
+
+sub ParseOutputArgument($$$$$$)
+{
+	my ($self, $fn, $e, $r, $o, $invalid_response_type) = @_;
+	my $level = 0;
+
+	if ($e->{LEVELS}[0]->{TYPE} ne "POINTER" and $e->{LEVELS}[0]->{TYPE} ne "ARRAY") {
+		fatal($e->{ORIGINAL}, "[out] argument is not a pointer or array");
+		return;
+	}
+
+	if ($e->{LEVELS}[0]->{TYPE} eq "POINTER") {
+		$level = 1;
+		if ($e->{LEVELS}[0]->{POINTER_TYPE} ne "ref") {
+			$self->pidl("if ($o$e->{NAME} && ${r}out.$e->{NAME}) {");
+			$self->indent;
+		}
+	}
+
+	if ($e->{LEVELS}[$level]->{TYPE} eq "ARRAY") {
+		# This is a call to GenerateFunctionInEnv intentionally.
+		# Since the data is being copied into a user-provided data
+		# structure, the user should be able to know the size beforehand
+		# to allocate a structure of the right size.
+		my $in_env = GenerateFunctionInEnv($fn, $r);
+		my $out_env = GenerateFunctionOutEnv($fn, $r);
+		my $l = $e->{LEVELS}[$level];
+
+		my $in_var = undef;
+		if (grep(/in/, @{$e->{DIRECTION}})) {
+			$in_var = ParseExpr($e->{NAME}, $in_env, $e->{ORIGINAL});
+		}
+		my $out_var = ParseExpr($e->{NAME}, $out_env, $e->{ORIGINAL});
+
+		my $in_size_is = undef;
+		my $out_size_is = undef;
+		my $out_length_is = undef;
+
+		my $avail_len = undef;
+		my $needed_len = undef;
+
+		$self->pidl("{");
+		$self->indent;
+		my $copy_len_var = "_copy_len_$e->{NAME}";
+		$self->pidl("size_t $copy_len_var;");
+
+		if (not defined($l->{SIZE_IS})) {
+			if (not $l->{IS_ZERO_TERMINATED}) {
+				fatal($e->{ORIGINAL}, "no size known for [out] array `$e->{NAME}'");
+			}
+			if (has_property($e, "charset")) {
+				$avail_len = "ndr_charset_length($in_var, CH_UNIX)";
+				$needed_len = "ndr_charset_length($out_var, CH_UNIX)";
+			} else {
+				$avail_len = "ndr_string_length($in_var, sizeof(*$in_var))";
+				$needed_len = "ndr_string_length($out_var, sizeof(*$out_var))";
+			}
+			$in_size_is = "";
+			$out_size_is = "";
+			$out_length_is = "";
+		} else {
+			$in_size_is = ParseExpr($l->{SIZE_IS}, $in_env, $e->{ORIGINAL});
+			$out_size_is = ParseExpr($l->{SIZE_IS}, $out_env, $e->{ORIGINAL});
+			$out_length_is = $out_size_is;
+			if (defined($l->{LENGTH_IS})) {
+				$out_length_is = ParseExpr($l->{LENGTH_IS}, $out_env, $e->{ORIGINAL});
+			}
+			if (has_property($e, "charset")) {
+				if (defined($in_var)) {
+					$avail_len = "ndr_charset_length($in_var, CH_UNIX)";
+				} else {
+					$avail_len = $out_length_is;
+				}
+				$needed_len = "ndr_charset_length($out_var, CH_UNIX)";
+			}
+		}
+
+		if ($out_size_is ne $in_size_is) {
+			$self->pidl("if (($out_size_is) > ($in_size_is)) {");
+			$self->indent;
+			$self->ParseInvalidResponse($invalid_response_type);
+			$self->deindent;
+			$self->pidl("}");
+		}
+		if ($out_length_is ne $out_size_is) {
+			$self->pidl("if (($out_length_is) > ($out_size_is)) {");
+			$self->indent;
+			$self->ParseInvalidResponse($invalid_response_type);
+			$self->deindent;
+			$self->pidl("}");
+		}
+		if (defined($needed_len)) {
+			$self->pidl("$copy_len_var = $needed_len;");
+			$self->pidl("if ($copy_len_var > $avail_len) {");
+			$self->indent;
+			$self->ParseInvalidResponse($invalid_response_type);
+			$self->deindent;
+			$self->pidl("}");
+		} else {
+			$self->pidl("$copy_len_var = $out_length_is;");
+		}
+
+		if (has_property($e, "charset")) {
+			$self->pidl("memcpy(discard_const_p(uint8_t *, $o$e->{NAME}), $out_var, $copy_len_var * sizeof(*$o$e->{NAME}));");
+		} else {
+			$self->pidl("memcpy($o$e->{NAME}, $out_var, $copy_len_var * sizeof(*$o$e->{NAME}));");
+		}
+
+		$self->deindent;
+		$self->pidl("}");
+	} else {
+		$self->pidl("*$o$e->{NAME} = *${r}out.$e->{NAME};");
+	}
+
+	if ($e->{LEVELS}[0]->{TYPE} eq "POINTER") {
+		if ($e->{LEVELS}[0]->{POINTER_TYPE} ne "ref") {
+			$self->deindent;
+			$self->pidl("}");
+		}
+	}
+}
+
+sub ParseFunction_State($$$$)
+{
+	my ($self, $if, $fn, $name) = @_;
+
+	my $state_str = "struct dcerpc_$name\_state";
+	my $done_fn = "dcerpc_$name\_done";
+
+	$self->pidl("$state_str {");
+	$self->indent;
+	$self->pidl("struct $name orig;");
+	$self->pidl("struct $name tmp;");
+	$self->pidl("TALLOC_CTX *out_mem_ctx;");
+	$self->deindent;
+	$self->pidl("};");
+	$self->pidl("");
+	$self->pidl("static void $done_fn(struct tevent_req *subreq);");
+	$self->pidl("");
+}
+
+sub ParseFunction_Send($$$$)
+{
+	my ($self, $if, $fn, $name) = @_;
+
+	my $fn_args = "";
+	my $state_str = "struct dcerpc_$name\_state";
+	my $done_fn = "dcerpc_$name\_done";
+	my $out_mem_ctx = "dcerpc_$name\_out_memory";
+	my $fn_str = "struct tevent_req *dcerpc_$name\_send";
+	my $pad = genpad($fn_str);
+
+	$fn_args .= "TALLOC_CTX *mem_ctx";
+	$fn_args .= ",\n" . $pad . "struct tevent_context *ev";
+	$fn_args .= ",\n" . $pad . "struct dcerpc_binding_handle *h";
+
+	foreach (@{$fn->{ELEMENTS}}) {
+		my $dir = ElementDirection($_);
+		my $prop = HeaderProperties($_->{PROPERTIES}, ["in", "out"]);
+		$fn_args .= ",\n" . $pad . DeclLong($_, "_") . " /* $dir $prop */";
+	}
+
+	$self->fn_declare("$fn_str($fn_args)");
+	$self->pidl("{");
+	$self->indent;
+	$self->pidl("struct tevent_req *req;");
+	$self->pidl("$state_str *state;");
+	$self->pidl("struct tevent_req *subreq;");
+	$self->pidl("");
+	$self->pidl("req = tevent_req_create(mem_ctx, &state,");
+	$self->pidl("\t\t\t$state_str);");
+	$self->pidl("if (req == NULL) {");
+	$self->indent;
+	$self->pidl("return NULL;");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("state->out_mem_ctx = NULL;");
+	$self->pidl("");
+
+	$self->pidl("/* In parameters */");
+	foreach my $e (@{$fn->{ELEMENTS}}) {
+		next unless (grep(/in/, @{$e->{DIRECTION}}));
+
+		$self->ParseCopyArgument($fn, $e, "state->orig.in.", "_");
+	}
+	$self->pidl("");
+
+	my $out_params = 0;
+	$self->pidl("/* Out parameters */");
+	foreach my $e (@{$fn->{ELEMENTS}}) {
+		next unless grep(/out/, @{$e->{DIRECTION}});
+
+		$self->ParseCopyArgument($fn, $e, "state->orig.out.", "_");
+
+		next if ContainsPipe($e, $e->{LEVELS}[0]);
+
+		$out_params++;
+	}
+	$self->pidl("");
+
+	if (defined($fn->{RETURN_TYPE})) {
+		$self->pidl("/* Result */");
+		$self->pidl("ZERO_STRUCT(state->orig.out.result);");
+		$self->pidl("");
+	}
+
+	if ($out_params > 0) {
+		$self->pidl("state->out_mem_ctx = talloc_named_const(state, 0,");
+		$self->pidl("\t\t     \"$out_mem_ctx\");");
+		$self->pidl("if (tevent_req_nomem(state->out_mem_ctx, req)) {");
+		$self->indent;
+		$self->pidl("return tevent_req_post(req, ev);");
+		$self->deindent;
+		$self->pidl("}");
+		$self->pidl("");
+	}
+
+	$self->pidl("/* make a temporary copy, that we pass to the dispatch function */");
+	$self->pidl("state->tmp = state->orig;");
+	$self->pidl("");
+
+	$self->pidl("subreq = dcerpc_$name\_r_send(state, ev, h, &state->tmp);");
+	$self->pidl("if (tevent_req_nomem(subreq, req)) {");
+	$self->indent;
+	$self->pidl("return tevent_req_post(req, ev);");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("tevent_req_set_callback(subreq, $done_fn, req);");
+	$self->pidl("return req;");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+}
+
+sub ParseFunction_Done($$$$)
+{
+	my ($self, $if, $fn, $name) = @_;
+
+	my $state_str = "struct dcerpc_$name\_state";
+	my $done_fn = "dcerpc_$name\_done";
+
+	$self->pidl("static void $done_fn(struct tevent_req *subreq)");
+	$self->pidl("{");
+	$self->indent;
+	$self->pidl("struct tevent_req *req = tevent_req_callback_data(");
+	$self->pidl("\tsubreq, struct tevent_req);");
+	$self->pidl("$state_str *state = tevent_req_data(");
+	$self->pidl("\treq, $state_str);");
+	$self->pidl("NTSTATUS status;");
+	$self->pidl("TALLOC_CTX *mem_ctx;");
+	$self->pidl("");
+
+	$self->pidl("if (state->out_mem_ctx) {");
+	$self->indent;
+	$self->pidl("mem_ctx = state->out_mem_ctx;");
+	$self->deindent;
+	$self->pidl("} else {");
+	$self->indent;
+	$self->pidl("mem_ctx = state;");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+
+	$self->pidl("status = dcerpc_$name\_r_recv(subreq, mem_ctx);");
+	$self->pidl("TALLOC_FREE(subreq);");
+	$self->pidl("if (!NT_STATUS_IS_OK(status)) {");
+	$self->indent;
+	$self->pidl("tevent_req_nterror(req, status);");
+	$self->pidl("return;");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+
+	$self->pidl("/* Copy out parameters */");
+	foreach my $e (@{$fn->{ELEMENTS}}) {
+		next if ContainsPipe($e, $e->{LEVELS}[0]);
+		next unless (grep(/out/, @{$e->{DIRECTION}}));
+
+		$self->ParseOutputArgument($fn, $e,
+					   "state->tmp.",
+					   "state->orig.out.",
+					   "async");
+	}
+	$self->pidl("");
+
+	if (defined($fn->{RETURN_TYPE})) {
+		$self->pidl("/* Copy result */");
+		$self->pidl("state->orig.out.result = state->tmp.out.result;");
+		$self->pidl("");
+	}
+
+	$self->pidl("/* Reset temporary structure */");
+	$self->pidl("ZERO_STRUCT(state->tmp);");
+	$self->pidl("");
+
+	$self->pidl("tevent_req_done(req);");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+}
+
+sub ParseFunction_Recv($$$$)
+{
+	my ($self, $if, $fn, $name) = @_;
+
+	my $fn_args = "";
+	my $state_str = "struct dcerpc_$name\_state";
+	my $fn_str = "NTSTATUS dcerpc_$name\_recv";
+	my $pad = genpad($fn_str);
+
+	$fn_args .= "struct tevent_req *req,\n" . $pad . "TALLOC_CTX *mem_ctx";
+
+	if (defined($fn->{RETURN_TYPE})) {
+		$fn_args .= ",\n" . $pad . mapTypeName($fn->{RETURN_TYPE}). " *result";
+	}
+
+	$self->fn_declare("$fn_str($fn_args)");
+	$self->pidl("{");
+	$self->indent;
+	$self->pidl("$state_str *state = tevent_req_data(");
+	$self->pidl("\treq, $state_str);");
+	$self->pidl("NTSTATUS status;");
+	$self->pidl("");
+	$self->pidl("if (tevent_req_is_nterror(req, &status)) {");
+	$self->indent;
+	$self->pidl("tevent_req_received(req);");
+	$self->pidl("return status;");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+
+	$self->pidl("/* Steal possible out parameters to the callers context */");
+	$self->pidl("talloc_steal(mem_ctx, state->out_mem_ctx);");
+	$self->pidl("");
+
+	if (defined($fn->{RETURN_TYPE})) {
+		$self->pidl("/* Return result */");
+		$self->pidl("*result = state->orig.out.result;");
+		$self->pidl("");
+	}
+
+	$self->pidl("tevent_req_received(req);");
+	$self->pidl("return NT_STATUS_OK;");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+}
+
+sub ParseFunction_Sync($$$$)
+{
+	my ($self, $if, $fn, $name) = @_;
+
+	if ($self->ParseFunctionHasPipes($fn)) {
+		$self->pidl_both("/*");
+		$self->pidl_both(" * The following function is skipped because");
+		$self->pidl_both(" * it uses pipes:");
+		$self->pidl_both(" *");
+		$self->pidl_both(" * dcerpc_$name()");
+		$self->pidl_both(" */");
+		$self->pidl_both("");
+		return;
+	}
+
+	my $uname = uc $name;
+	my $fn_args = "";
+	my $fn_str = "NTSTATUS dcerpc_$name";
+	my $pad = genpad($fn_str);
+
+	$fn_args .= "struct dcerpc_binding_handle *h,\n" . $pad . "TALLOC_CTX *mem_ctx";
+
+	foreach (@{$fn->{ELEMENTS}}) {
+		my $dir = ElementDirection($_);
+		my $prop = HeaderProperties($_->{PROPERTIES}, ["in", "out"]);
+		$fn_args .= ",\n" . $pad . DeclLong($_, "_") . " /* $dir $prop */";
+	}
+
+	if (defined($fn->{RETURN_TYPE})) {
+		$fn_args .= ",\n" . $pad . mapTypeName($fn->{RETURN_TYPE}). " *result";
+	}
+
+	$self->fn_declare("$fn_str($fn_args)");
+	$self->pidl("{");
+	$self->indent;
+	$self->pidl("struct $name r;");
+	$self->pidl("NTSTATUS status;");
+	$self->pidl("");
+
+	$self->pidl("/* In parameters */");
+	foreach my $e (@{$fn->{ELEMENTS}}) {
+		next unless (grep(/in/, @{$e->{DIRECTION}}));
+
+		$self->ParseCopyArgument($fn, $e, "r.in.", "_");
+	}
+	$self->pidl("");
+
+	$self->pidl("status = dcerpc_$name\_r(h, mem_ctx, &r);");
+	$self->pidl("if (!NT_STATUS_IS_OK(status)) {");
+	$self->indent;
+	$self->pidl("return status;");
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+
+	$self->pidl("/* Return variables */");
+	foreach my $e (@{$fn->{ELEMENTS}}) {
+		next if ContainsPipe($e, $e->{LEVELS}[0]);
+		next unless (grep(/out/, @{$e->{DIRECTION}}));
+
+		$self->ParseOutputArgument($fn, $e, "r.", "_", "sync");
+	}
+	$self->pidl("");
+
+	$self->pidl("/* Return result */");
+	if ($fn->{RETURN_TYPE}) {
+		$self->pidl("*result = r.out.result;");
+	}
+	$self->pidl("");
+
+	$self->pidl("return NT_STATUS_OK;");
+
+	$self->deindent;
+	$self->pidl("}");
+	$self->pidl("");
+}
+
+#####################################################################
+# parse a function
+sub ParseFunction($$$)
+{
+	my ($self, $if, $fn) = @_;
+
+	if ($self->ParseFunctionHasPipes($fn)) {
+		$self->pidl_both("/*");
+		$self->pidl_both(" * The following function is skipped because");
+		$self->pidl_both(" * it uses pipes:");
+		$self->pidl_both(" *");
+		$self->pidl_both(" * dcerpc_$fn->{NAME}_r_send()");
+		$self->pidl_both(" * dcerpc_$fn->{NAME}_r_recv()");
+		$self->pidl_both(" * dcerpc_$fn->{NAME}_r()");
+		$self->pidl_both(" *");
+		$self->pidl_both(" * dcerpc_$fn->{NAME}_send()");
+		$self->pidl_both(" * dcerpc_$fn->{NAME}_recv()");
+		$self->pidl_both(" * dcerpc_$fn->{NAME}()");
+		$self->pidl_both(" */");
+		$self->pidl_both("");
+		warning($fn->{ORIGINAL}, "$fn->{NAME}: dcerpc client does not support pipe yet");
+		return;
+	}
+
+	$self->ParseFunction_r_State($if, $fn, $fn->{NAME});
+	$self->ParseFunction_r_Send($if, $fn, $fn->{NAME});
+	$self->ParseFunction_r_Done($if, $fn, $fn->{NAME});
+	$self->ParseFunction_r_Recv($if, $fn, $fn->{NAME});
+	$self->ParseFunction_r_Sync($if, $fn, $fn->{NAME});
+
+	foreach my $e (@{$fn->{ELEMENTS}}) {
+		next unless (grep(/out/, @{$e->{DIRECTION}}));
+
+		my $reason = "is not a pointer or array";
+
+		# TODO: make this fatal at NDR level
+		if ($e->{LEVELS}[0]->{TYPE} eq "POINTER") {
+			if ($e->{LEVELS}[1]->{TYPE} eq "DATA" and
+			    $e->{LEVELS}[1]->{DATA_TYPE} eq "string") {
+				$reason = "is a pointer to type 'string'";
+			} elsif ($e->{LEVELS}[1]->{TYPE} eq "ARRAY" and
+				 $e->{LEVELS}[1]->{IS_ZERO_TERMINATED}) {
+				next;
+			} elsif ($e->{LEVELS}[1]->{TYPE} eq "ARRAY" and
+				 not defined($e->{LEVELS}[1]->{SIZE_IS})) {
+				$reason = "is a pointer to an unsized array";
+			} else {
+				next;
+			}
+		}
+		if ($e->{LEVELS}[0]->{TYPE} eq "ARRAY") {
+			if (not defined($e->{LEVELS}[0]->{SIZE_IS})) {
+				$reason = "is an unsized array";
+			} else {
+				next;
+			}
+		}
+
+		$self->pidl_both("/*");
+		$self->pidl_both(" * The following functions are skipped because");
+		$self->pidl_both(" * an [out] argument $e->{NAME} $reason:");
+		$self->pidl_both(" *");
+		$self->pidl_both(" * dcerpc_$fn->{NAME}_send()");
+		$self->pidl_both(" * dcerpc_$fn->{NAME}_recv()");
+		$self->pidl_both(" * dcerpc_$fn->{NAME}()");
+		$self->pidl_both(" */");
+		$self->pidl_both("");
+
+		error($e->{ORIGINAL}, "$fn->{NAME}: [out] argument '$e->{NAME}' $reason, skip client functions");
+		return;
+	}
+
+	$self->ParseFunction_State($if, $fn, $fn->{NAME});
+	$self->ParseFunction_Send($if, $fn, $fn->{NAME});
+	$self->ParseFunction_Done($if, $fn, $fn->{NAME});
+	$self->ParseFunction_Recv($if, $fn, $fn->{NAME});
+	$self->ParseFunction_Sync($if, $fn, $fn->{NAME});
+
+	$self->pidl_hdr("");
+}
+
+my %done;
+
+#####################################################################
+# parse the interface definitions
+sub ParseInterface($$)
+{
+	my ($self, $if) = @_;
+	my $ifu = uc($if->{NAME});
+
+	$self->pidl_hdr("#ifndef _HEADER_RPC_$if->{NAME}");
+	$self->pidl_hdr("#define _HEADER_RPC_$if->{NAME}");
+	$self->pidl_hdr("");
+
+	if (defined $if->{PROPERTIES}->{uuid}) {
+		$self->pidl_hdr("extern const struct ndr_interface_table ndr_table_$if->{NAME};");
+		$self->pidl_hdr("");
+	}
+
+	$self->pidl("/* $if->{NAME} - client functions generated by pidl */");
+	$self->pidl("");
+
+	foreach my $fn (@{$if->{FUNCTIONS}}) {
+		next if defined($done{$fn->{NAME}});
+		next if has_property($fn, "noopnum");
+		next if has_property($fn, "todo");
+		$self->ParseFunction($if, $fn);
+		$done{$fn->{NAME}} = 1;
+	}
+
+	$self->pidl_hdr("#endif /* _HEADER_RPC_$if->{NAME} */");
+}
+
+sub Parse($$$$$$)
+{
+	my($self,$ndr,$header,$ndr_header,$client_header) = @_;
+
+	$self->pidl("/* client functions auto-generated by pidl */");
+	$self->pidl("");
+	if (is_intree()) {
+		$self->pidl("#include \"includes.h\"");
+	} else {
+		$self->pidl("#ifndef _GNU_SOURCE");
+		$self->pidl("#define _GNU_SOURCE");
+		$self->pidl("#endif");
+		$self->pidl("#include <stdio.h>");
+		$self->pidl("#include <stdbool.h>");
+		$self->pidl("#include <stdlib.h>");
+		$self->pidl("#include <stdint.h>");
+		$self->pidl("#include <stdarg.h>");
+		$self->pidl("#include <string.h>");
+		$self->pidl("#include <core/ntstatus.h>");
+	}
+	$self->pidl("#include <tevent.h>");
+	$self->pidl(choose_header("lib/util/tevent_ntstatus.h", "util/tevent_ntstatus.h")."");
+	$self->pidl("#include \"$ndr_header\"");
+	$self->pidl("#include \"$client_header\"");
+	$self->pidl("");
+
+	$self->pidl_hdr(choose_header("librpc/rpc/dcerpc.h", "dcerpc.h")."");
+	$self->pidl_hdr("#include \"$header\"");
+
+	foreach my $x (@{$ndr}) {
+		($x->{TYPE} eq "INTERFACE") && $self->ParseInterface($x);
+	}
+
+	return ($self->{res},$self->{res_hdr});
+}
+
+1;

pidl/lib/Parse/Pidl/Samba4/NDR/Server.pm

@@ -0,0 +1,334 @@
+###################################################
+# server boilerplate generator
+# Copyright tridge@samba.org 2003
+# Copyright metze@samba.org 2004
+# released under the GNU GPL
+
+package Parse::Pidl::Samba4::NDR::Server;
+
+use strict;
+use Parse::Pidl::Util;
+
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+my($res);
+
+sub pidl($)
+{
+	$res .= shift;
+}
+
+
+#####################################################
+# generate the switch statement for function dispatch
+sub gen_dispatch_switch($)
+{
+	my $interface = shift;
+
+	foreach my $fn (@{$interface->{FUNCTIONS}}) {
+		next if not defined($fn->{OPNUM});
+
+		pidl "\tcase $fn->{OPNUM}: {\n";
+		pidl "\t\tstruct $fn->{NAME} *r2 = (struct $fn->{NAME} *)r;\n";
+		pidl "\t\tif (DEBUGLEVEL >= 10) {\n";
+		pidl "\t\t\tNDR_PRINT_FUNCTION_DEBUG($fn->{NAME}, NDR_IN, r2);\n";
+		pidl "\t\t}\n";
+		if ($fn->{RETURN_TYPE} && $fn->{RETURN_TYPE} ne "void") {
+			pidl "\t\tr2->out.result = dcesrv_$fn->{NAME}(dce_call, mem_ctx, r2);\n";
+		} else {
+			pidl "\t\tdcesrv_$fn->{NAME}(dce_call, mem_ctx, r2);\n";
+		}
+		pidl "\t\tif (dce_call->state_flags & DCESRV_CALL_STATE_FLAG_ASYNC) {\n";
+		pidl "\t\t\tDEBUG(5,(\"function $fn->{NAME} will reply async\\n\"));\n";
+		pidl "\t\t}\n";
+		pidl "\t\tbreak;\n\t}\n";
+	}
+}
+
+#####################################################
+# generate the switch statement for function reply
+sub gen_reply_switch($)
+{
+	my $interface = shift;
+
+	foreach my $fn (@{$interface->{FUNCTIONS}}) {
+		next if not defined($fn->{OPNUM});
+
+		pidl "\tcase $fn->{OPNUM}: {\n";
+		pidl "\t\tstruct $fn->{NAME} *r2 = (struct $fn->{NAME} *)r;\n";
+		pidl "\t\tif (dce_call->state_flags & DCESRV_CALL_STATE_FLAG_ASYNC) {\n";
+		pidl "\t\t\tDEBUG(5,(\"function $fn->{NAME} replied async\\n\"));\n";
+		pidl "\t\t}\n";
+		pidl "\t\tif (DEBUGLEVEL >= 10 && dce_call->fault_code == 0) {\n";
+		pidl "\t\t\tNDR_PRINT_FUNCTION_DEBUG($fn->{NAME}, NDR_OUT | NDR_SET_VALUES, r2);\n";
+		pidl "\t\t}\n";
+		pidl "\t\tif (dce_call->fault_code != 0) {\n";
+		pidl "\t\t\tDEBUG(2,(\"dcerpc_fault %s in $fn->{NAME}\\n\", dcerpc_errstr(mem_ctx, dce_call->fault_code)));\n";
+		pidl "\t\t}\n";
+		pidl "\t\tbreak;\n\t}\n";
+	}
+}
+
+#####################################################################
+# produce boilerplate code for a interface
+sub Boilerplate_Iface($)
+{
+	my($interface) = shift;
+	my $name = $interface->{NAME}; 
+	my $uname = uc $name;
+	my $uuid = lc($interface->{UUID});
+	my $if_version = $interface->{VERSION};
+
+	pidl "
+static NTSTATUS $name\__op_bind(struct dcesrv_call_state *dce_call, const struct dcesrv_interface *iface, uint32_t if_version)
+{
+#ifdef DCESRV_INTERFACE_$uname\_BIND
+	return DCESRV_INTERFACE_$uname\_BIND(dce_call,iface);
+#else
+	return NT_STATUS_OK;
+#endif
+}
+
+static void $name\__op_unbind(struct dcesrv_connection_context *context, const struct dcesrv_interface *iface)
+{
+#ifdef DCESRV_INTERFACE_$uname\_UNBIND
+	DCESRV_INTERFACE_$uname\_UNBIND(context, iface);
+#else
+	return;
+#endif
+}
+
+static NTSTATUS $name\__op_ndr_pull(struct dcesrv_call_state *dce_call, TALLOC_CTX *mem_ctx, struct ndr_pull *pull, void **r)
+{
+	enum ndr_err_code ndr_err;
+	uint16_t opnum = dce_call->pkt.u.request.opnum;
+
+	dce_call->fault_code = 0;
+
+	if (opnum >= ndr_table_$name.num_calls) {
+		dce_call->fault_code = DCERPC_FAULT_OP_RNG_ERROR;
+		return NT_STATUS_NET_WRITE_FAULT;
+	}
+
+	*r = talloc_named(mem_ctx,
+			  ndr_table_$name.calls[opnum].struct_size,
+			  \"struct %s\",
+			  ndr_table_$name.calls[opnum].name);
+	NT_STATUS_HAVE_NO_MEMORY(*r);
+
+        /* unravel the NDR for the packet */
+	ndr_err = ndr_table_$name.calls[opnum].ndr_pull(pull, NDR_IN, *r);
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_err)) {
+		dcerpc_log_packet(dce_call->conn->packet_log_dir, 
+				  &ndr_table_$name, opnum, NDR_IN,
+				  &dce_call->pkt.u.request.stub_and_verifier);
+		dce_call->fault_code = DCERPC_FAULT_NDR;
+		return NT_STATUS_NET_WRITE_FAULT;
+	}
+
+	return NT_STATUS_OK;
+}
+
+static NTSTATUS $name\__op_dispatch(struct dcesrv_call_state *dce_call, TALLOC_CTX *mem_ctx, void *r)
+{
+	uint16_t opnum = dce_call->pkt.u.request.opnum;
+
+	switch (opnum) {
+";
+	gen_dispatch_switch($interface);
+
+pidl "
+	default:
+		dce_call->fault_code = DCERPC_FAULT_OP_RNG_ERROR;
+		break;
+	}
+
+	if (dce_call->fault_code != 0) {
+		dcerpc_log_packet(dce_call->conn->packet_log_dir, 
+		          &ndr_table_$name, opnum, NDR_IN,
+				  &dce_call->pkt.u.request.stub_and_verifier);
+		return NT_STATUS_NET_WRITE_FAULT;
+	}
+
+	return NT_STATUS_OK;
+}
+
+static NTSTATUS $name\__op_reply(struct dcesrv_call_state *dce_call, TALLOC_CTX *mem_ctx, void *r)
+{
+	uint16_t opnum = dce_call->pkt.u.request.opnum;
+
+	switch (opnum) {
+";
+	gen_reply_switch($interface);
+
+pidl "
+	default:
+		dce_call->fault_code = DCERPC_FAULT_OP_RNG_ERROR;
+		break;
+	}
+
+	if (dce_call->fault_code != 0) {
+		dcerpc_log_packet(dce_call->conn->packet_log_dir,
+		          &ndr_table_$name, opnum, NDR_IN,
+				  &dce_call->pkt.u.request.stub_and_verifier);
+		return NT_STATUS_NET_WRITE_FAULT;
+	}
+
+	return NT_STATUS_OK;
+}
+
+static NTSTATUS $name\__op_ndr_push(struct dcesrv_call_state *dce_call, TALLOC_CTX *mem_ctx, struct ndr_push *push, const void *r)
+{
+	enum ndr_err_code ndr_err;
+	uint16_t opnum = dce_call->pkt.u.request.opnum;
+
+	ndr_err = ndr_table_$name.calls[opnum].ndr_push(push, NDR_OUT, r);
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_err)) {
+		dce_call->fault_code = DCERPC_FAULT_NDR;
+		return NT_STATUS_NET_WRITE_FAULT;
+	}
+
+	return NT_STATUS_OK;
+}
+
+const struct dcesrv_interface dcesrv\_$name\_interface = {
+	.name		= \"$name\",
+	.syntax_id  = {".print_uuid($uuid).",$if_version},
+	.bind		= $name\__op_bind,
+	.unbind		= $name\__op_unbind,
+	.ndr_pull	= $name\__op_ndr_pull,
+	.dispatch	= $name\__op_dispatch,
+	.reply		= $name\__op_reply,
+	.ndr_push	= $name\__op_ndr_push
+};
+
+";
+}
+
+#####################################################################
+# produce boilerplate code for an endpoint server
+sub Boilerplate_Ep_Server($)
+{
+	my($interface) = shift;
+	my $name = $interface->{NAME};
+	my $uname = uc $name;
+
+	pidl "
+static NTSTATUS $name\__op_init_server(struct dcesrv_context *dce_ctx, const struct dcesrv_endpoint_server *ep_server)
+{
+	int i;
+
+	for (i=0;i<ndr_table_$name.endpoints->count;i++) {
+		NTSTATUS ret;
+		const char *name = ndr_table_$name.endpoints->names[i];
+
+		ret = dcesrv_interface_register(dce_ctx, name, &dcesrv_$name\_interface, NULL);
+		if (!NT_STATUS_IS_OK(ret)) {
+			DEBUG(1,(\"$name\_op_init_server: failed to register endpoint \'%s\'\\n\",name));
+			return ret;
+		}
+	}
+
+	return NT_STATUS_OK;
+}
+
+static bool $name\__op_interface_by_uuid(struct dcesrv_interface *iface, const struct GUID *uuid, uint32_t if_version)
+{
+	if (dcesrv_$name\_interface.syntax_id.if_version == if_version &&
+		GUID_equal(\&dcesrv\_$name\_interface.syntax_id.uuid, uuid)) {
+		memcpy(iface,&dcesrv\_$name\_interface, sizeof(*iface));
+		return true;
+	}
+
+	return false;
+}
+
+static bool $name\__op_interface_by_name(struct dcesrv_interface *iface, const char *name)
+{
+	if (strcmp(dcesrv_$name\_interface.name, name)==0) {
+		memcpy(iface, &dcesrv_$name\_interface, sizeof(*iface));
+		return true;
+	}
+
+	return false;
+}
+
+NTSTATUS dcerpc_server_$name\_init(void)
+{
+	NTSTATUS ret;
+	struct dcesrv_endpoint_server ep_server;
+
+	/* fill in our name */
+	ep_server.name = \"$name\";
+
+	/* fill in all the operations */
+	ep_server.init_server = $name\__op_init_server;
+
+	ep_server.interface_by_uuid = $name\__op_interface_by_uuid;
+	ep_server.interface_by_name = $name\__op_interface_by_name;
+
+	/* register ourselves with the DCERPC subsystem. */
+	ret = dcerpc_register_ep_server(&ep_server);
+
+	if (!NT_STATUS_IS_OK(ret)) {
+		DEBUG(0,(\"Failed to register \'$name\' endpoint server!\\n\"));
+		return ret;
+	}
+
+	return ret;
+}
+
+";
+}
+
+#####################################################################
+# dcerpc server boilerplate from a parsed IDL structure 
+sub ParseInterface($)
+{
+	my($interface) = shift;
+	my $count = 0;
+
+	$res .= "NTSTATUS dcerpc_server_$interface->{NAME}\_init(void);\n";
+	$res .= "\n";
+
+	if (!defined $interface->{PROPERTIES}->{uuid}) {
+		return $res;
+	}
+
+	if (!defined $interface->{PROPERTIES}->{version}) {
+		$interface->{PROPERTIES}->{version} = "0.0";
+	}
+
+	foreach my $fn (@{$interface->{FUNCTIONS}}) {
+		if (defined($fn->{OPNUM})) { $count++; }
+	}
+
+	if ($count == 0) {
+		return $res;
+	}
+
+	$res .= "/* $interface->{NAME} - dcerpc server boilerplate generated by pidl */\n\n";
+	Boilerplate_Iface($interface);
+	Boilerplate_Ep_Server($interface);
+
+	return $res;
+}
+
+sub Parse($$)
+{
+	my($ndr,$header) = @_;
+
+	$res =  "";
+	$res .= "/* server functions auto-generated by pidl */\n";
+	$res .= "#include \"$header\"\n";
+	$res .= "\n";
+
+	foreach my $x (@{$ndr}) {
+		ParseInterface($x) if ($x->{TYPE} eq "INTERFACE" and not defined($x->{PROPERTIES}{object}));
+	}
+
+	return $res;
+}
+
+1;

pidl/lib/Parse/Pidl/Samba4/TDR.pm

@@ -0,0 +1,283 @@
+###################################################
+# Trivial Parser Generator
+# Copyright jelmer@samba.org 2005-2007
+# released under the GNU GPL
+
+package Parse::Pidl::Samba4::TDR;
+use Parse::Pidl qw(fatal);
+use Parse::Pidl::Util qw(has_property ParseExpr is_constant);
+use Parse::Pidl::Samba4 qw(is_intree choose_header);
+use Parse::Pidl::Typelist qw(mapTypeName);
+
+use Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(ParserType $ret $ret_hdr);
+
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+use strict;
+
+sub new($) {
+	my ($class) = shift;
+	my $self = { ret => "", ret_hdr => "", tabs => "" };
+	bless($self, $class);
+}
+
+sub indent($) { my $self = shift; $self->{tabs}.="\t"; }
+sub deindent($) { my $self = shift; $self->{tabs} = substr($self->{tabs}, 1); }
+sub pidl($$) { my $self = shift; $self->{ret} .= $self->{tabs}.(shift)."\n"; }
+sub pidl_hdr($$) { my $self = shift; $self->{ret_hdr} .= (shift)."\n"; }
+sub typearg($) { 
+	my $t = shift; 
+	return(", const char *name") if ($t eq "print");
+	return(", TALLOC_CTX *mem_ctx") if ($t eq "pull");
+	return("");
+}
+
+sub fn_declare($$$)
+{
+	my ($self, $p, $d) = @_;
+	if ($p) { 
+		$self->pidl($d); $self->pidl_hdr("$d;"); 
+	} else { 
+		$self->pidl("static $d"); 
+	}
+}
+
+sub ContainsArray($)
+{
+	my $e = shift;
+	foreach (@{$e->{ELEMENTS}}) {
+		next if (has_property($_, "charset") and
+			scalar(@{$_->{ARRAY_LEN}}) == 1);
+		return 1 if (defined($_->{ARRAY_LEN}) and 
+				scalar(@{$_->{ARRAY_LEN}}) > 0);
+	}
+	return 0;
+}
+
+sub ParserElement($$$$)
+{
+	my ($self, $e,$t,$env) = @_;
+	my $switch = "";
+	my $array = "";
+	my $name = "";
+	my $mem_ctx = "mem_ctx";
+
+	fatal($e,"Pointers not supported in TDR") if ($e->{POINTERS} > 0);
+	fatal($e,"size_is() not supported in TDR") if (has_property($e, "size_is"));
+	fatal($e,"length_is() not supported in TDR") if (has_property($e, "length_is"));
+
+	if ($t eq "print") {
+		$name = ", \"$e->{NAME}\"$array";
+	}
+
+	if (has_property($e, "flag")) {
+		$self->pidl("{");
+		$self->indent;
+		$self->pidl("uint32_t saved_flags = tdr->flags;");
+		$self->pidl("tdr->flags |= $e->{PROPERTIES}->{flag};");
+	}
+
+	if (has_property($e, "charset")) {
+		fatal($e,"charset() on non-array element") unless (defined($e->{ARRAY_LEN}) and scalar(@{$e->{ARRAY_LEN}}) > 0);
+		
+		my $len = ParseExpr(@{$e->{ARRAY_LEN}}[0], $env, $e);
+		if ($len eq "*") { $len = "-1"; }
+		$name = ", mem_ctx" if ($t eq "pull");
+		$self->pidl("TDR_CHECK(tdr_$t\_charset(tdr$name, &v->$e->{NAME}, $len, sizeof($e->{TYPE}_t), CH_$e->{PROPERTIES}->{charset}));");
+		return;
+	}
+
+	if (has_property($e, "switch_is")) {
+		$switch = ", " . ParseExpr($e->{PROPERTIES}->{switch_is}, $env, $e);
+	}
+
+	if (defined($e->{ARRAY_LEN}) and scalar(@{$e->{ARRAY_LEN}}) > 0) {
+		my $len = ParseExpr($e->{ARRAY_LEN}[0], $env, $e);
+
+		if ($t eq "pull" and not is_constant($len)) {
+			$self->pidl("TDR_ALLOC(mem_ctx, v->$e->{NAME}, $len);");
+			$mem_ctx = "v->$e->{NAME}";
+		}
+
+		$self->pidl("for (i = 0; i < $len; i++) {");
+		$self->indent;
+		$array = "[i]";
+	}
+
+	if ($t eq "pull") {
+		$name = ", $mem_ctx";
+	}
+
+	if (has_property($e, "value") && $t eq "push") {
+		$self->pidl("v->$e->{NAME} = ".ParseExpr($e->{PROPERTIES}->{value}, $env, $e).";");
+	}
+
+	$self->pidl("TDR_CHECK(tdr_$t\_$e->{TYPE}(tdr$name$switch, &v->$e->{NAME}$array));");
+
+	if ($array) { $self->deindent; $self->pidl("}"); }
+
+	if (has_property($e, "flag")) {
+		$self->pidl("tdr->flags = saved_flags;");
+		$self->deindent;
+		$self->pidl("}");
+	}
+}
+
+sub ParserStruct($$$$$)
+{
+	my ($self, $e,$t,$p) = @_;
+
+	$self->fn_declare($p,"NTSTATUS tdr_$t\_$e->{NAME} (struct tdr_$t *tdr".typearg($t).", struct $e->{NAME} *v)");
+	$self->pidl("{"); $self->indent;
+	$self->pidl("int i;") if (ContainsArray($e));
+
+	if ($t eq "print") {
+		$self->pidl("tdr->print(tdr, \"\%-25s: struct $e->{NAME}\", name);");
+		$self->pidl("tdr->level++;");
+	}
+
+	my %env = map { $_->{NAME} => "v->$_->{NAME}" } @{$e->{ELEMENTS}};
+	$env{"this"} = "v";
+	$self->ParserElement($_, $t, \%env) foreach (@{$e->{ELEMENTS}});
+	
+	if ($t eq "print") {
+		$self->pidl("tdr->level--;");
+	}
+
+	$self->pidl("return NT_STATUS_OK;");
+
+	$self->deindent; $self->pidl("}");
+}
+
+sub ParserUnion($$$$)
+{
+	my ($self, $e,$t,$p) = @_;
+
+	$self->fn_declare($p,"NTSTATUS tdr_$t\_$e->{NAME}(struct tdr_$t *tdr".typearg($t).", int level, union $e->{NAME} *v)");
+	$self->pidl("{"); $self->indent;
+	$self->pidl("int i;") if (ContainsArray($e));
+
+	if ($t eq "print") {
+		$self->pidl("tdr->print(tdr, \"\%-25s: union $e->{NAME}\", name);");
+		$self->pidl("tdr->level++;");
+	}
+	
+	$self->pidl("switch (level) {"); $self->indent;
+	foreach (@{$e->{ELEMENTS}}) {
+		if (has_property($_, "case")) {
+			$self->pidl("case " . $_->{PROPERTIES}->{case} . ":");
+		} elsif (has_property($_, "default")) {
+			$self->pidl("default:");
+		}
+		$self->indent; $self->ParserElement($_, $t, {}); $self->deindent;
+		$self->pidl("break;");
+	}
+	$self->deindent; $self->pidl("}");
+
+	if ($t eq "print") {
+		$self->pidl("tdr->level--;");
+	}
+	
+	$self->pidl("return NT_STATUS_OK;\n");
+	$self->deindent; $self->pidl("}");
+}
+
+sub ParserBitmap($$$$)
+{
+	my ($self,$e,$t,$p) = @_;
+	return if ($p);
+	$self->pidl("#define tdr_$t\_$e->{NAME} tdr_$t\_" . Parse::Pidl::Typelist::bitmap_type_fn($e));
+}
+
+sub ParserEnum($$$$)
+{
+	my ($self,$e,$t,$p) = @_;
+	my $bt = Parse::Pidl::Typelist::enum_type_fn($e);
+	my $mt = mapTypeName($bt);
+
+	$self->fn_declare($p, "NTSTATUS tdr_$t\_$e->{NAME} (struct tdr_$t *tdr".typearg($t).", enum $e->{NAME} *v)");
+	$self->pidl("{");
+	if ($t eq "pull") {
+		$self->pidl("\t$mt r;");
+		$self->pidl("\tTDR_CHECK(tdr_$t\_$bt(tdr, mem_ctx, \&r));");
+		$self->pidl("\t*v = r;");
+	} elsif ($t eq "push") {
+		$self->pidl("\tTDR_CHECK(tdr_$t\_$bt(tdr, ($mt *)v));");
+	} elsif ($t eq "print") {
+		$self->pidl("\t/* FIXME */");
+	}
+	$self->pidl("\treturn NT_STATUS_OK;");
+	$self->pidl("}");
+}
+
+sub ParserTypedef($$$$)
+{
+	my ($self, $e,$t,$p) = @_;
+
+	$self->ParserType($e->{DATA},$t);
+}
+
+sub ParserType($$$)
+{
+	my ($self, $e,$t) = @_;
+
+	return if (has_property($e, "no$t"));
+
+	my $handlers = { 
+		STRUCT => \&ParserStruct, UNION => \&ParserUnion, 
+		ENUM => \&ParserEnum, BITMAP => \&ParserBitmap,
+		TYPEDEF => \&ParserTypedef
+	};
+	
+	$handlers->{$e->{TYPE}}->($self, $e, $t, has_property($e, "public")) 
+		if (defined($handlers->{$e->{TYPE}}));
+
+	$self->pidl("");
+}
+
+sub ParserInterface($$)
+{
+	my ($self,$x) = @_;
+	
+	$self->pidl_hdr("#ifndef __TDR_$x->{NAME}_HEADER__");
+	$self->pidl_hdr("#define __TDR_$x->{NAME}_HEADER__");
+
+	foreach (@{$x->{DATA}}) {
+		$self->ParserType($_, "pull");
+		$self->ParserType($_, "push");
+		$self->ParserType($_, "print");
+	}
+
+	$self->pidl_hdr("#endif /* __TDR_$x->{NAME}_HEADER__ */");
+}
+
+sub Parser($$$$)
+{
+	my ($self,$idl,$hdrname,$baseheader) = @_;
+	$self->pidl("/* autogenerated by pidl */");
+	if (is_intree()) {
+		$self->pidl("#include \"includes.h\"");
+	} else {
+		$self->pidl("#include <stdio.h>");
+		$self->pidl("#include <stdbool.h>");
+		$self->pidl("#include <stdlib.h>");
+		$self->pidl("#include <stdint.h>");
+		$self->pidl("#include <stdarg.h>");
+		$self->pidl("#include <string.h>");
+		$self->pidl("#include <core/ntstatus.h>");
+	}
+	$self->pidl("#include \"$hdrname\"");
+	$self->pidl("");
+	$self->pidl_hdr("/* autogenerated by pidl */");
+	$self->pidl_hdr("#include \"$baseheader\"");
+	$self->pidl_hdr(choose_header("lib/tdr/tdr.h", "tdr.h"));
+	$self->pidl_hdr("");
+
+	foreach (@$idl) { $self->ParserInterface($_) if ($_->{TYPE} eq "INTERFACE"); }	
+	return ($self->{ret_hdr}, $self->{ret});
+}
+
+1;

pidl/lib/Parse/Pidl/Samba4/Template.pm

@@ -0,0 +1,98 @@
+###################################################
+# server template function generator
+# Copyright tridge@samba.org 2003
+# released under the GNU GPL
+
+package Parse::Pidl::Samba4::Template;
+
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+use strict;
+
+my($res);
+
+#####################################################################
+# produce boilerplate code for a interface
+sub Template($)
+{
+	my($interface) = shift;
+	my($data) = $interface->{DATA};
+	my $name = $interface->{NAME};
+
+	$res .= 
+"/* 
+   Unix SMB/CIFS implementation.
+
+   endpoint server for the $name pipe
+
+   Copyright (C) YOUR NAME HERE YEAR
+   
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+   
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+   
+   You should have received a copy of the GNU General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*/
+
+#include \"includes.h\"
+#include \"rpc_server/dcerpc_server.h\"
+#include \"librpc/gen_ndr/ndr_$name.h\"
+#include \"rpc_server/common/common.h\"
+
+";
+
+	foreach my $d (@{$data}) {
+		if ($d->{TYPE} eq "FUNCTION") {
+			my $fname = $d->{NAME};
+			$res .=
+"
+/* 
+  $fname 
+*/
+static $d->{RETURN_TYPE} dcesrv_$fname(struct dcesrv_call_state *dce_call, TALLOC_CTX *mem_ctx,
+		       struct $fname *r)
+{
+";
+
+	if ($d->{RETURN_TYPE} eq "void") {
+		$res .= "\tDCESRV_FAULT_VOID(DCERPC_FAULT_OP_RNG_ERROR);\n";
+	} else {
+		$res .= "\tDCESRV_FAULT(DCERPC_FAULT_OP_RNG_ERROR);\n";
+	}
+
+	$res .= "}
+
+";
+		}
+	}
+
+	$res .= 
+"
+/* include the generated boilerplate */
+#include \"librpc/gen_ndr/ndr_$name\_s.c\"
+"
+}
+
+
+#####################################################################
+# parse a parsed IDL structure back into an IDL file
+sub Parse($)
+{
+	my($idl) = shift;
+	$res = "";
+	foreach my $x (@{$idl}) {
+		($x->{TYPE} eq "INTERFACE") && 
+		    Template($x);
+	}
+	return $res;
+}
+
+1;

pidl/lib/Parse/Pidl/Typelist.pm

@@ -0,0 +1,353 @@
+###################################################
+# Samba4 parser generator for IDL structures
+# Copyright jelmer@samba.org 2005
+# released under the GNU GPL
+
+package Parse::Pidl::Typelist;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(hasType getType resolveType mapTypeName scalar_is_reference expandAlias
+	mapScalarType addType typeIs is_signed is_scalar enum_type_fn
+	bitmap_type_fn mapType typeHasBody is_fixed_size_scalar
+);
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+use Parse::Pidl::Util qw(has_property);
+use strict;
+
+my %types = ();
+
+my @reference_scalars = (
+	"string", "string_array", "nbt_string", "dns_string",
+	"wrepl_nbt_name", "dnsp_name", "dnsp_string",
+	"ipv4address", "ipv6address"
+);
+
+my @non_fixed_size_scalars = (
+	"string", "string_array", "nbt_string", "dns_string",
+	"wrepl_nbt_name", "dnsp_name", "dnsp_string"
+);
+
+# a list of known scalar types
+my %scalars = (
+	"void"		=> "void",
+	"char"		=> "char",
+	"int8"		=> "int8_t",
+	"uint8"		=> "uint8_t",
+	"int16"		=> "int16_t",
+	"uint16"	=> "uint16_t",
+	"int1632"	=> "int16_t",
+	"uint1632"	=> "uint16_t",
+	"int32"		=> "int32_t",
+	"uint32"	=> "uint32_t",
+	"int3264"	=> "int32_t",
+	"uint3264"	=> "uint32_t",
+	"hyper"		=> "uint64_t",
+	"dlong"		=> "int64_t",
+	"udlong"	=> "uint64_t",
+	"udlongr"	=> "uint64_t",
+	"double"	=> "double",
+	"pointer"	=> "void*",
+	"DATA_BLOB"	=> "DATA_BLOB",
+	"string"	=> "const char *",
+	"string_array"	=> "const char **",
+	"time_t"	=> "time_t",
+	"uid_t"	        => "uid_t",
+	"gid_t"	        => "gid_t",
+	"NTTIME"	=> "NTTIME",
+	"NTTIME_1sec"	=> "NTTIME",
+	"NTTIME_hyper"	=> "NTTIME",
+	"WERROR"	=> "WERROR",
+	"NTSTATUS"	=> "NTSTATUS",
+	"COMRESULT" => "COMRESULT",
+	"dns_string"	=> "const char *",
+	"nbt_string"	=> "const char *",
+	"wrepl_nbt_name"=> "struct nbt_name *",
+	"ipv4address"	=> "const char *",
+	"ipv6address"   => "const char *",
+	"dnsp_name"	=> "const char *",
+	"dnsp_string"	=> "const char *",
+);
+
+my %aliases = (
+	"error_status_t" => "uint32",
+	"boolean8" => "uint8",
+	"boolean32" => "uint32",
+	"DWORD" => "uint32",
+	"uint" => "uint32",
+	"int" => "int32",
+	"WORD" => "uint16",
+	"char" => "uint8",
+	"long" => "int32",
+	"short" => "int16",
+	"HYPER_T" => "hyper",
+	"HRESULT" => "COMRESULT",
+);
+
+sub expandAlias($)
+{
+	my $name = shift;
+
+	return $aliases{$name} if defined($aliases{$name});
+
+	return $name;
+}
+
+# map from a IDL type to a C header type
+sub mapScalarType($)
+{
+	my $name = shift;
+
+	# it's a bug when a type is not in the list
+	# of known scalars or has no mapping
+	return $scalars{$name} if defined($scalars{$name});
+
+	die("Unknown scalar type $name");
+}
+
+sub addType($)
+{
+	my $t = shift;
+	$types{$t->{NAME}} = $t;
+}
+
+sub resolveType($)
+{
+	my ($ctype) = @_;
+
+	if (not hasType($ctype)) {
+		# assume struct typedef
+		return { TYPE => "TYPEDEF", NAME => $ctype, DATA => { TYPE => "STRUCT" } };
+	} else {
+		return getType($ctype);
+	}
+
+	return $ctype;
+}
+
+sub getType($)
+{
+	my $t = shift;
+	return ($t) if (ref($t) eq "HASH" and not defined($t->{NAME}));
+	return undef if not hasType($t);
+	return $types{$t->{NAME}} if (ref($t) eq "HASH");
+	return $types{$t};
+}
+
+sub typeIs($$);
+sub typeIs($$)
+{
+	my ($t,$tt) = @_;
+
+	if (ref($t) eq "HASH") {
+		return 1 if ($t->{TYPE} eq "TYPEDEF" and $t->{DATA}->{TYPE} eq $tt);
+		return 1 if ($t->{TYPE} eq $tt);
+		return 0;
+	}
+	if (hasType($t) and getType($t)->{TYPE} eq "TYPEDEF") {
+		return typeIs(getType($t)->{DATA}, $tt);
+	 }
+	return 0;
+}
+
+sub hasType($)
+{
+	my $t = shift;
+	if (ref($t) eq "HASH") {
+		return 1 if (not defined($t->{NAME}));
+		return 1 if (defined($types{$t->{NAME}}) and 
+			$types{$t->{NAME}}->{TYPE} eq $t->{TYPE});
+		return 0;
+	}
+	return 1 if defined($types{$t});
+	return 0;
+}
+
+sub is_signed($)
+{
+    my $t = shift;
+
+    return ($t eq "int8"
+	    or $t eq "int16"
+	    or $t eq "int32"
+	    or $t eq "dlong"
+	    or $t eq "int"
+	    or $t eq "long"
+	    or $t eq "short");
+}
+
+sub is_scalar($)
+{
+	sub is_scalar($);
+	my $type = shift;
+
+	return 1 if (ref($type) eq "HASH" and 
+		($type->{TYPE} eq "SCALAR" or $type->{TYPE} eq "ENUM" or 
+		 $type->{TYPE} eq "BITMAP"));
+
+	if (my $dt = getType($type)) {
+		return is_scalar($dt->{DATA}) if ($dt->{TYPE} eq "TYPEDEF");
+		return 1 if ($dt->{TYPE} eq "SCALAR" or $dt->{TYPE} eq "ENUM" or 
+			         $dt->{TYPE} eq "BITMAP");
+	}
+
+	return 0;
+}
+
+sub is_fixed_size_scalar($)
+{
+	my $name = shift;
+
+	return 0 unless is_scalar($name);
+	return 0 if (grep(/^$name$/, @non_fixed_size_scalars));
+	return 1;
+}
+
+sub scalar_is_reference($)
+{
+	my $name = shift;
+
+	return 1 if (grep(/^$name$/, @reference_scalars));
+	return 0;
+}
+
+sub RegisterScalars()
+{
+	foreach (keys %scalars) {
+		addType({
+			NAME => $_,
+			TYPE => "TYPEDEF",
+			BASEFILE => "<builtin>",
+			DATA => {
+				TYPE => "SCALAR",
+				NAME => $_
+			}
+		}
+		);
+	}
+}
+
+sub enum_type_fn($)
+{
+	my $enum = shift;
+	$enum->{TYPE} eq "ENUM" or die("not an enum");
+
+	# for typedef enum { } we need to check $enum->{PARENT}
+	if (has_property($enum, "enum8bit")) {
+		return "uint8";
+	} elsif (has_property($enum, "enum16bit")) {
+		return "uint16";
+	} elsif (has_property($enum, "v1_enum")) {
+		return "uint32";
+	} elsif (has_property($enum->{PARENT}, "enum8bit")) {
+		return "uint8";
+	} elsif (has_property($enum->{PARENT}, "enum16bit")) {
+		return "uint16";
+	} elsif (has_property($enum->{PARENT}, "v1_enum")) {
+		return "uint32";
+	}
+	return "uint1632";
+}
+
+sub bitmap_type_fn($)
+{
+	my $bitmap = shift;
+
+	$bitmap->{TYPE} eq "BITMAP" or die("not a bitmap");
+
+	if (has_property($bitmap, "bitmap8bit")) {
+		return "uint8";
+	} elsif (has_property($bitmap, "bitmap16bit")) {
+		return "uint16";
+	} elsif (has_property($bitmap, "bitmap64bit")) {
+		return "hyper";
+	}
+	return "uint32";
+}
+
+sub typeHasBody($)
+{
+	sub typeHasBody($);
+	my ($e) = @_;
+
+	if ($e->{TYPE} eq "TYPEDEF") {
+		return 0 unless(defined($e->{DATA}));
+		return typeHasBody($e->{DATA});
+	}
+
+	return defined($e->{ELEMENTS});
+}
+
+sub mapType($$)
+{
+	sub mapType($$);
+	my ($t, $n) = @_;
+
+	return mapType($t->{DATA}, $n) if ($t->{TYPE} eq "TYPEDEF");
+	return mapScalarType($n) if ($t->{TYPE} eq "SCALAR");
+	return "enum $n" if ($t->{TYPE} eq "ENUM");
+	return "struct $n" if ($t->{TYPE} eq "STRUCT" or $t->{TYPE} eq "INTERFACE");
+	return "union $n" if ($t->{TYPE} eq "UNION");
+	return mapScalarType(bitmap_type_fn($t)) if ($t->{TYPE} eq "BITMAP");
+	return "struct $n" if ($t->{TYPE} eq "PIPE");
+	die("Unknown type $t->{TYPE}");
+}
+
+sub mapTypeName($)
+{
+	my $t = shift;
+	return "void" unless defined($t);
+	my $dt;
+	$t = expandAlias($t);
+
+	if ($dt = getType($t)) {
+		return mapType($dt, $dt->{NAME});
+	} elsif (ref($t) eq "HASH" and defined($t->{NAME})) {
+		return mapType($t, $t->{NAME});
+	} else {
+		# Best guess
+		return "struct $t";
+	}
+
+}
+
+sub LoadIdl($;$)
+{
+	my $idl = shift;
+	my $basename = shift;
+
+	foreach my $x (@{$idl}) {
+		next if $x->{TYPE} ne "INTERFACE";
+
+		# DCOM interfaces can be types as well
+		addType({
+			NAME => $x->{NAME},
+			TYPE => "TYPEDEF",
+			DATA => $x,
+			BASEFILE => $basename,
+			}) if (has_property($x, "object"));
+
+		foreach my $y (@{$x->{DATA}}) {
+			if ($y->{TYPE} eq "TYPEDEF"
+			    or $y->{TYPE} eq "UNION"
+			    or $y->{TYPE} eq "STRUCT"
+			    or $y->{TYPE} eq "ENUM"
+			    or $y->{TYPE} eq "BITMAP"
+			    or $y->{TYPE} eq "PIPE") {
+				$y->{BASEFILE} = $basename;
+				addType($y);
+			}
+		}
+	}
+}
+
+sub GenerateTypeLib()
+{
+	return Parse::Pidl::Util::MyDumper(\%types);
+}
+
+RegisterScalars();
+
+1;

pidl/lib/Parse/Pidl/Util.pm

@@ -0,0 +1,182 @@
+###################################################
+# utility functions to support pidl
+# Copyright tridge@samba.org 2000
+# released under the GNU GPL
+package Parse::Pidl::Util;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(has_property property_matches ParseExpr ParseExprExt is_constant make_str unmake_str print_uuid MyDumper);
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+use strict;
+
+use Parse::Pidl::Expr;
+use Parse::Pidl qw(error);
+
+=head1 NAME
+
+Parse::Pidl::Util - Generic utility functions for pidl
+
+=head1 SYNOPSIS
+
+use Parse::Pidl::Util;
+
+=head1 DESCRIPTION
+
+Simple module that contains a couple of trivial helper functions 
+used throughout the various pidl modules.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=cut
+
+=item B<MyDumper>
+a dumper wrapper to prevent dependence on the Data::Dumper module
+unless we actually need it
+
+=cut
+
+sub MyDumper($)
+{
+	require Data::Dumper;
+	my $s = shift;
+	return Data::Dumper::Dumper($s);
+}
+
+=item B<has_property>
+see if a pidl property list contains a given property
+
+=cut
+sub has_property($$)
+{
+	my($e, $p) = @_;
+
+	return undef if (not defined($e->{PROPERTIES}));
+
+	return $e->{PROPERTIES}->{$p};
+}
+
+=item B<property_matches>
+see if a pidl property matches a value
+
+=cut
+sub property_matches($$$)
+{
+	my($e,$p,$v) = @_;
+
+	if (!defined has_property($e, $p)) {
+		return undef;
+	}
+
+	if ($e->{PROPERTIES}->{$p} =~ /$v/) {
+		return 1;
+	}
+
+	return undef;
+}
+
+=item B<is_constant>
+return 1 if the string is a C constant
+
+=cut
+sub is_constant($)
+{
+	my $s = shift;
+	return 1 if ($s =~ /^\d+$/);
+	return 1 if ($s =~ /^0x[0-9A-Fa-f]+$/);
+	return 0;
+}
+
+=item B<make_str>
+return a "" quoted string, unless already quoted
+
+=cut
+sub make_str($)
+{
+	my $str = shift;
+	if (substr($str, 0, 1) eq "\"") {
+		return $str;
+	}
+	return "\"$str\"";
+}
+
+=item B<unmake_str>
+unquote a "" quoted string
+
+=cut
+sub unmake_str($)
+{
+	my $str = shift;
+	
+	$str =~ s/^\"(.*)\"$/$1/;
+
+	return $str;
+}
+
+=item B<print_uuid>
+Print C representation of a UUID.
+
+=cut
+sub print_uuid($)
+{
+	my ($uuid) = @_;
+	$uuid =~ s/"//g;
+	my ($time_low,$time_mid,$time_hi,$clock_seq,$node) = split /-/, $uuid;
+	return undef if not defined($node);
+
+	my @clock_seq = $clock_seq =~ /(..)/g;
+	my @node = $node =~ /(..)/g;
+
+	return "{0x$time_low,0x$time_mid,0x$time_hi," .
+		"{".join(',', map {"0x$_"} @clock_seq)."}," .
+		"{".join(',', map {"0x$_"} @node)."}}";
+}
+
+=item B<ParseExpr>
+Interpret an IDL expression, substituting particular variables.
+
+=cut
+sub ParseExpr($$$)
+{
+	my($expr, $varlist, $e) = @_;
+
+	my $x = new Parse::Pidl::Expr();
+	
+	return $x->Run($expr, sub { my $x = shift; error($e, $x); },
+		# Lookup fn 
+		sub { my $x = shift; 
+			  return($varlist->{$x}) if (defined($varlist->{$x})); 
+			  return $x;
+		  },
+		undef, undef);
+}
+
+=item B<ParseExprExt>
+Interpret an IDL expression, substituting particular variables. Can call 
+callbacks when pointers are being dereferenced or variables are being used.
+
+=cut
+sub ParseExprExt($$$$$)
+{
+	my($expr, $varlist, $e, $deref, $use) = @_;
+
+	my $x = new Parse::Pidl::Expr();
+	
+	return $x->Run($expr, sub { my $x = shift; error($e, $x); },
+		# Lookup fn 
+		sub { my $x = shift; 
+			  return($varlist->{$x}) if (defined($varlist->{$x})); 
+			  return $x;
+		  },
+		$deref, $use);
+}
+
+=back
+
+=cut
+
+1;

pidl/lib/Parse/Pidl/Wireshark/Conformance.pm

@@ -0,0 +1,451 @@
+###################################################
+# parse an Wireshark conformance file
+# Copyright jelmer@samba.org 2005
+# released under the GNU GPL
+
+=pod
+
+=head1 NAME
+
+Parse::Pidl::Wireshark::Conformance - Conformance file parser for Wireshark
+
+=head1 DESCRIPTION
+
+This module supports parsing Wireshark conformance files (*.cnf).
+
+=head1 FILE FORMAT
+
+Pidl needs additional data for Wireshark output. This data is read from 
+so-called conformance files. This section describes the format of these 
+files.
+
+Conformance files are simple text files with a single command on each line.
+Empty lines and lines starting with a '#' character are ignored.
+Arguments to commands are seperated by spaces.
+
+The following commands are currently supported:
+
+=over 4
+
+=item I<TYPE> name dissector ft_type base_type mask valsstring alignment
+
+Register new data type with specified name, what dissector function to call 
+and what properties to give header fields for elements of this type.
+
+=item I<NOEMIT> type
+
+Suppress emitting a dissect_type function for the specified type
+
+=item I<PARAM_VALUE> type param
+
+Set parameter to specify to dissector function for given type.
+
+=item I<HF_FIELD> hf title filter ft_type base_type valsstring mask description
+
+Generate a custom header field with specified properties.
+
+=item I<HF_RENAME> old_hf_name new_hf_name
+
+Force the use of new_hf_name when the parser generator was going to 
+use old_hf_name.
+
+This can be used in conjunction with HF_FIELD in order to make more than 
+one element use the same filter name.
+
+=item I<ETT_FIELD> ett
+
+Register a custom ett field
+
+=item I<STRIP_PREFIX> prefix
+
+Remove the specified prefix from all function names (if present).
+	
+=item I<PROTOCOL> longname shortname filtername
+
+Change the short-, long- and filter-name for the current interface in
+Wireshark.
+
+=item I<FIELD_DESCRIPTION> field desc
+
+Change description for the specified header field. `field' is the hf name of the field.
+
+=item I<IMPORT> dissector code...
+
+Code to insert when generating the specified dissector. @HF@ and 
+@PARAM@ will be substituted.
+
+=item I<INCLUDE> filename
+
+Include conformance data from the specified filename in the dissector.
+
+=item I<TFS> hf_name "true string" "false string"
+
+Override the text shown when a bitmap boolean value is enabled or disabled.
+
+=item I<MANUAL> fn_name
+
+Force pidl to not generate a particular function but allow the user 
+to write a function manually. This can be used to remove the function 
+for only one level for a particular element rather than all the functions and 
+ett/hf variables for a particular element as the NOEMIT command does.
+
+=back
+
+=head1 EXAMPLE
+
+	INFO_KEY OpenKey.Ke
+
+=cut
+
+package Parse::Pidl::Wireshark::Conformance;
+
+require Exporter;
+use vars qw($VERSION);
+$VERSION = '0.01';
+
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(ReadConformance ReadConformanceFH valid_ft_type valid_base_type);
+
+use strict;
+
+use Parse::Pidl qw(fatal warning error);
+use Parse::Pidl::Util qw(has_property);
+use Parse::Pidl::Typelist qw(addType);
+
+sub handle_type($$$$$$$$$$)
+{
+	my ($pos,$data,$name,$dissectorname,$ft_type,$base_type,$mask,$valsstring,$alignment) = @_;
+
+	unless(defined($alignment)) {
+		error($pos, "incomplete TYPE command");
+		return;
+	}
+
+	unless ($dissectorname =~ /.*dissect_.*/) {
+		warning($pos, "dissector name does not contain `dissect'");
+	}
+
+	unless(valid_ft_type($ft_type)) {
+		warning($pos, "invalid FT_TYPE `$ft_type'");
+	}
+
+	unless (valid_base_type($base_type)) {
+		warning($pos, "invalid BASE_TYPE `$base_type'");
+	}
+
+	$dissectorname =~ s/^\"(.*)\"$/$1/g;
+
+	if (not ($dissectorname =~ /;$/)) {
+		warning($pos, "missing semicolon");
+	}
+
+	$data->{types}->{$name} = {
+		NAME => $name,
+		POS => $pos,
+		USED => 0,
+		DISSECTOR_NAME => $dissectorname,
+		FT_TYPE => $ft_type,
+		BASE_TYPE => $base_type,
+		MASK => $mask,
+		VALSSTRING => $valsstring,
+		ALIGNMENT => $alignment
+	};
+
+	addType({
+		NAME => $name,
+		TYPE => "CONFORMANCE",
+		BASEFILE => "conformance file",
+		DATA => {
+			NAME => $name,
+			TYPE => "CONFORMANCE",
+			ALIGN => $alignment
+		}
+	});
+}
+
+sub handle_tfs($$$$$)
+{
+	my ($pos,$data,$hf,$trues,$falses) = @_;
+
+	unless(defined($falses)) {
+		error($pos, "incomplete TFS command");
+		return;
+	}
+
+	$data->{tfs}->{$hf} = {
+		TRUE_STRING => $trues,
+		FALSE_STRING => $falses
+	};
+}
+
+sub handle_hf_rename($$$$)
+{
+	my ($pos,$data,$old,$new) = @_;
+
+	unless(defined($new)) {
+		warning($pos, "incomplete HF_RENAME command");
+		return;
+	}
+
+	$data->{hf_renames}->{$old} = {
+		OLDNAME => $old,
+		NEWNAME => $new,
+		POS => $pos,
+		USED => 0
+	};
+}
+
+sub handle_param_value($$$$)
+{
+	my ($pos,$data,$dissector_name,$value) = @_;
+
+	unless(defined($value)) {
+		error($pos, "incomplete PARAM_VALUE command");
+		return;
+	}
+
+	$data->{dissectorparams}->{$dissector_name} = {
+		DISSECTOR => $dissector_name,
+		PARAM => $value,
+		POS => $pos,
+		USED => 0
+	};
+}
+
+sub valid_base_type($)
+{
+	my $t = shift;
+	return 0 unless($t =~ /^BASE_.*/);
+	return 1;
+}
+
+sub valid_ft_type($)
+{
+	my $t = shift;
+	return 0 unless($t =~ /^FT_.*/);
+	return 1;
+}
+
+sub handle_hf_field($$$$$$$$$$)
+{
+	my ($pos,$data,$index,$name,$filter,$ft_type,$base_type,$valsstring,$mask,$blurb) = @_;
+
+	unless(defined($blurb)) {
+		error($pos, "incomplete HF_FIELD command");
+		return;
+	}
+
+	unless(valid_ft_type($ft_type)) {
+		warning($pos, "invalid FT_TYPE `$ft_type'");
+	}
+
+	unless(valid_base_type($base_type)) {
+		warning($pos, "invalid BASE_TYPE `$base_type'");
+	}
+
+	$data->{header_fields}->{$index} = {
+		INDEX => $index,
+		POS => $pos,
+		USED => 0,
+		NAME => $name,
+		FILTER => $filter,
+		FT_TYPE => $ft_type,
+		BASE_TYPE => $base_type,
+		VALSSTRING => $valsstring,
+		MASK => $mask,
+		BLURB => $blurb
+	};
+}
+
+sub handle_strip_prefix($$$)
+{
+	my ($pos,$data,$x) = @_;
+
+	push (@{$data->{strip_prefixes}}, $x);
+}
+
+sub handle_noemit($$$)
+{
+	my ($pos,$data,$type) = @_;
+
+	if (defined($type)) {
+	    $data->{noemit}->{$type} = 1;
+	} else {
+	    $data->{noemit_dissector} = 1;
+	}
+}
+
+sub handle_manual($$$)
+{
+	my ($pos,$data,$fn) = @_;
+
+	unless(defined($fn)) {
+		warning($pos, "incomplete MANUAL command");
+		return;
+	}
+
+    $data->{manual}->{$fn} = 1;
+}
+
+sub handle_protocol($$$$$$)
+{
+	my ($pos, $data, $name, $longname, $shortname, $filtername) = @_;
+
+	$data->{protocols}->{$name} = {
+		LONGNAME => $longname,
+		SHORTNAME => $shortname,
+		FILTERNAME => $filtername
+	};
+}
+
+sub handle_fielddescription($$$$)
+{
+	my ($pos,$data,$field,$desc) = @_;
+
+	unless(defined($desc)) {
+		warning($pos, "incomplete FIELD_DESCRIPTION command");
+		return;
+	}
+
+	$data->{fielddescription}->{$field} = {
+		DESCRIPTION => $desc,
+		POS => $pos,
+		USED => 0
+	};
+}
+
+sub handle_import
+{
+	my $pos = shift @_;
+	my $data = shift @_;
+	my $dissectorname = shift @_;
+
+	unless(defined($dissectorname)) {
+		error($pos, "no dissectorname specified");
+		return;
+	}
+
+	$data->{imports}->{$dissectorname} = {
+		NAME => $dissectorname,
+		DATA => join(' ', @_),
+		USED => 0,
+		POS => $pos
+	};
+}
+
+sub handle_ett_field
+{
+	my $pos = shift @_;
+	my $data = shift @_;
+	my $ett = shift @_;
+
+	unless(defined($ett)) {
+		error($pos, "incomplete ETT_FIELD command");
+		return;
+	}
+
+	push (@{$data->{ett}}, $ett);
+}
+
+sub handle_include
+{
+	my $pos = shift @_;
+	my $data = shift @_;
+	my $fn = shift @_;
+
+	unless(defined($fn)) {
+		error($pos, "incomplete INCLUDE command");
+		return;
+	}
+
+	ReadConformance($fn, $data);
+}
+
+my %field_handlers = (
+	TYPE => \&handle_type,
+	NOEMIT => \&handle_noemit, 
+	MANUAL => \&handle_manual,
+	PARAM_VALUE => \&handle_param_value, 
+	HF_FIELD => \&handle_hf_field, 
+	HF_RENAME => \&handle_hf_rename, 
+	ETT_FIELD => \&handle_ett_field,
+	TFS => \&handle_tfs,
+	STRIP_PREFIX => \&handle_strip_prefix,
+	PROTOCOL => \&handle_protocol,
+	FIELD_DESCRIPTION => \&handle_fielddescription,
+	IMPORT => \&handle_import,
+	INCLUDE => \&handle_include
+);
+
+sub ReadConformance($$)
+{
+	my ($f,$data) = @_;
+	my $ret;
+
+	open(IN,"<$f") or return undef;
+
+	$ret = ReadConformanceFH(*IN, $data, $f);
+
+	close(IN);
+
+	return $ret;
+}
+
+sub ReadConformanceFH($$$)
+{
+	my ($fh,$data,$f) = @_;
+
+	my $incodeblock = 0;
+
+	my $ln = 0;
+
+	foreach (<$fh>) {
+		$ln++;
+		next if (/^#.*$/);
+		next if (/^$/);
+
+		s/[\r\n]//g;
+
+		if ($_ eq "CODE START") {
+			$incodeblock = 1;
+			next;
+		} elsif ($incodeblock and $_ eq "CODE END") {
+			$incodeblock = 0;
+			next;
+		} elsif ($incodeblock) {
+			if (exists $data->{override}) {
+				$data->{override}.="$_\n";
+			} else {
+				$data->{override} = "$_\n";
+			}
+			next;
+		}
+
+		my @fields = /([^ "]+|"[^"]+")/g;
+
+		my $cmd = $fields[0];
+
+		shift @fields;
+
+		my $pos = { FILE => $f, LINE => $ln };
+
+		next unless(defined($cmd));
+
+		if (not defined($field_handlers{$cmd})) {
+			warning($pos, "Unknown command `$cmd'");
+			next;
+		}
+		
+		$field_handlers{$cmd}($pos, $data, @fields);
+	}
+
+	if ($incodeblock) {
+		warning({ FILE => $f, LINE => $ln }, 
+			"Expecting CODE END");
+		return undef;
+	}
+
+	return 1;
+}
+
+1;

pidl/lib/Parse/Yapp/Driver.pm

@@ -0,0 +1,471 @@
+#
+# Module Parse::Yapp::Driver
+#
+# This module is part of the Parse::Yapp package available on your
+# nearest CPAN
+#
+# Any use of this module in a standalone parser make the included
+# text under the same copyright as the Parse::Yapp module itself.
+#
+# This notice should remain unchanged.
+#
+# (c) Copyright 1998-2001 Francois Desarmenien, all rights reserved.
+# (see the pod text in Parse::Yapp module for use and distribution rights)
+#
+
+package Parse::Yapp::Driver;
+
+require 5.004;
+
+use strict;
+
+use vars qw ( $VERSION $COMPATIBLE $FILENAME );
+
+$VERSION = '1.05';
+$COMPATIBLE = '0.07';
+$FILENAME=__FILE__;
+
+use Carp;
+
+#Known parameters, all starting with YY (leading YY will be discarded)
+my(%params)=(YYLEX => 'CODE', 'YYERROR' => 'CODE', YYVERSION => '',
+			 YYRULES => 'ARRAY', YYSTATES => 'ARRAY', YYDEBUG => '');
+#Mandatory parameters
+my(@params)=('LEX','RULES','STATES');
+
+sub new {
+    my($class)=shift;
+	my($errst,$nberr,$token,$value,$check,$dotpos);
+    my($self)={ ERROR => \&_Error,
+				ERRST => \$errst,
+                NBERR => \$nberr,
+				TOKEN => \$token,
+				VALUE => \$value,
+				DOTPOS => \$dotpos,
+				STACK => [],
+				DEBUG => 0,
+				CHECK => \$check };
+
+	_CheckParams( [], \%params, \@_, $self );
+
+		exists($$self{VERSION})
+	and	$$self{VERSION} < $COMPATIBLE
+	and	croak "Yapp driver version $VERSION ".
+			  "incompatible with version $$self{VERSION}:\n".
+			  "Please recompile parser module.";
+
+        ref($class)
+    and $class=ref($class);
+
+    bless($self,$class);
+}
+
+sub YYParse {
+    my($self)=shift;
+    my($retval);
+
+	_CheckParams( \@params, \%params, \@_, $self );
+
+	if($$self{DEBUG}) {
+		_DBLoad();
+		$retval = eval '$self->_DBParse()';#Do not create stab entry on compile
+        $@ and die $@;
+	}
+	else {
+		$retval = $self->_Parse();
+	}
+    $retval
+}
+
+sub YYData {
+	my($self)=shift;
+
+		exists($$self{USER})
+	or	$$self{USER}={};
+
+	$$self{USER};
+	
+}
+
+sub YYErrok {
+	my($self)=shift;
+
+	${$$self{ERRST}}=0;
+    undef;
+}
+
+sub YYNberr {
+	my($self)=shift;
+
+	${$$self{NBERR}};
+}
+
+sub YYRecovering {
+	my($self)=shift;
+
+	${$$self{ERRST}} != 0;
+}
+
+sub YYAbort {
+	my($self)=shift;
+
+	${$$self{CHECK}}='ABORT';
+    undef;
+}
+
+sub YYAccept {
+	my($self)=shift;
+
+	${$$self{CHECK}}='ACCEPT';
+    undef;
+}
+
+sub YYError {
+	my($self)=shift;
+
+	${$$self{CHECK}}='ERROR';
+    undef;
+}
+
+sub YYSemval {
+	my($self)=shift;
+	my($index)= $_[0] - ${$$self{DOTPOS}} - 1;
+
+		$index < 0
+	and	-$index <= @{$$self{STACK}}
+	and	return $$self{STACK}[$index][1];
+
+	undef;	#Invalid index
+}
+
+sub YYCurtok {
+	my($self)=shift;
+
+        @_
+    and ${$$self{TOKEN}}=$_[0];
+    ${$$self{TOKEN}};
+}
+
+sub YYCurval {
+	my($self)=shift;
+
+        @_
+    and ${$$self{VALUE}}=$_[0];
+    ${$$self{VALUE}};
+}
+
+sub YYExpect {
+    my($self)=shift;
+
+    keys %{$self->{STATES}[$self->{STACK}[-1][0]]{ACTIONS}}
+}
+
+sub YYLexer {
+    my($self)=shift;
+
+	$$self{LEX};
+}
+
+
+#################
+# Private stuff #
+#################
+
+
+sub _CheckParams {
+	my($mandatory,$checklist,$inarray,$outhash)=@_;
+	my($prm,$value);
+	my($prmlst)={};
+
+	while(($prm,$value)=splice(@$inarray,0,2)) {
+        $prm=uc($prm);
+			exists($$checklist{$prm})
+		or	croak("Unknow parameter '$prm'");
+			ref($value) eq $$checklist{$prm}
+		or	croak("Invalid value for parameter '$prm'");
+        $prm=unpack('@2A*',$prm);
+		$$outhash{$prm}=$value;
+	}
+	for (@$mandatory) {
+			exists($$outhash{$_})
+		or	croak("Missing mandatory parameter '".lc($_)."'");
+	}
+}
+
+sub _Error {
+	print "Parse error.\n";
+}
+
+sub _DBLoad {
+	{
+		no strict 'refs';
+
+			exists(${__PACKAGE__.'::'}{_DBParse})#Already loaded ?
+		and	return;
+	}
+	my($fname)=__FILE__;
+	my(@drv);
+	open(DRV,"<$fname") or die "Report this as a BUG: Cannot open $fname";
+	while(<DRV>) {
+                	/^\s*sub\s+_Parse\s*{\s*$/ .. /^\s*}\s*#\s*_Parse\s*$/
+        	and     do {
+                	s/^#DBG>//;
+                	push(@drv,$_);
+        	}
+	}
+	close(DRV);
+
+	$drv[0]=~s/_P/_DBP/;
+	eval join('',@drv);
+}
+
+#Note that for loading debugging version of the driver,
+#this file will be parsed from 'sub _Parse' up to '}#_Parse' inclusive.
+#So, DO NOT remove comment at end of sub !!!
+sub _Parse {
+    my($self)=shift;
+
+	my($rules,$states,$lex,$error)
+     = @$self{ 'RULES', 'STATES', 'LEX', 'ERROR' };
+	my($errstatus,$nberror,$token,$value,$stack,$check,$dotpos)
+     = @$self{ 'ERRST', 'NBERR', 'TOKEN', 'VALUE', 'STACK', 'CHECK', 'DOTPOS' };
+
+#DBG>	my($debug)=$$self{DEBUG};
+#DBG>	my($dbgerror)=0;
+
+#DBG>	my($ShowCurToken) = sub {
+#DBG>		my($tok)='>';
+#DBG>		for (split('',$$token)) {
+#DBG>			$tok.=		(ord($_) < 32 or ord($_) > 126)
+#DBG>					?	sprintf('<%02X>',ord($_))
+#DBG>					:	$_;
+#DBG>		}
+#DBG>		$tok.='<';
+#DBG>	};
+
+	$$errstatus=0;
+	$$nberror=0;
+	($$token,$$value)=(undef,undef);
+	@$stack=( [ 0, undef ] );
+	$$check='';
+
+    while(1) {
+        my($actions,$act,$stateno);
+
+        $stateno=$$stack[-1][0];
+        $actions=$$states[$stateno];
+
+#DBG>	print STDERR ('-' x 40),"\n";
+#DBG>		$debug & 0x2
+#DBG>	and	print STDERR "In state $stateno:\n";
+#DBG>		$debug & 0x08
+#DBG>	and	print STDERR "Stack:[".
+#DBG>					 join(',',map { $$_[0] } @$stack).
+#DBG>					 "]\n";
+
+
+        if  (exists($$actions{ACTIONS})) {
+
+				defined($$token)
+            or	do {
+				($$token,$$value)=&$lex($self);
+#DBG>				$debug & 0x01
+#DBG>			and	print STDERR "Need token. Got ".&$ShowCurToken."\n";
+			};
+
+            $act=   exists($$actions{ACTIONS}{$$token})
+                    ?   $$actions{ACTIONS}{$$token}
+                    :   exists($$actions{DEFAULT})
+                        ?   $$actions{DEFAULT}
+                        :   undef;
+        }
+        else {
+            $act=$$actions{DEFAULT};
+#DBG>			$debug & 0x01
+#DBG>		and	print STDERR "Don't need token.\n";
+        }
+
+            defined($act)
+        and do {
+
+                $act > 0
+            and do {        #shift
+
+#DBG>				$debug & 0x04
+#DBG>			and	print STDERR "Shift and go to state $act.\n";
+
+					$$errstatus
+				and	do {
+					--$$errstatus;
+
+#DBG>					$debug & 0x10
+#DBG>				and	$dbgerror
+#DBG>				and	$$errstatus == 0
+#DBG>				and	do {
+#DBG>					print STDERR "**End of Error recovery.\n";
+#DBG>					$dbgerror=0;
+#DBG>				};
+				};
+
+
+                push(@$stack,[ $act, $$value ]);
+
+					$$token ne ''	#Don't eat the eof
+				and	$$token=$$value=undef;
+                next;
+            };
+
+            #reduce
+            my($lhs,$len,$code,@sempar,$semval);
+            ($lhs,$len,$code)=@{$$rules[-$act]};
+
+#DBG>			$debug & 0x04
+#DBG>		and	$act
+#DBG>		and	print STDERR "Reduce using rule ".-$act." ($lhs,$len): ";
+
+                $act
+            or  $self->YYAccept();
+
+            $$dotpos=$len;
+
+                unpack('A1',$lhs) eq '@'    #In line rule
+            and do {
+                    $lhs =~ /^\@[0-9]+\-([0-9]+)$/
+                or  die "In line rule name '$lhs' ill formed: ".
+                        "report it as a BUG.\n";
+                $$dotpos = $1;
+            };
+
+            @sempar =       $$dotpos
+                        ?   map { $$_[1] } @$stack[ -$$dotpos .. -1 ]
+                        :   ();
+
+            $semval = $code ? &$code( $self, @sempar )
+                            : @sempar ? $sempar[0] : undef;
+
+            splice(@$stack,-$len,$len);
+
+                $$check eq 'ACCEPT'
+            and do {
+
+#DBG>			$debug & 0x04
+#DBG>		and	print STDERR "Accept.\n";
+
+				return($semval);
+			};
+
+                $$check eq 'ABORT'
+            and	do {
+
+#DBG>			$debug & 0x04
+#DBG>		and	print STDERR "Abort.\n";
+
+				return(undef);
+
+			};
+
+#DBG>			$debug & 0x04
+#DBG>		and	print STDERR "Back to state $$stack[-1][0], then ";
+
+                $$check eq 'ERROR'
+            or  do {
+#DBG>				$debug & 0x04
+#DBG>			and	print STDERR 
+#DBG>				    "go to state $$states[$$stack[-1][0]]{GOTOS}{$lhs}.\n";
+
+#DBG>				$debug & 0x10
+#DBG>			and	$dbgerror
+#DBG>			and	$$errstatus == 0
+#DBG>			and	do {
+#DBG>				print STDERR "**End of Error recovery.\n";
+#DBG>				$dbgerror=0;
+#DBG>			};
+
+			    push(@$stack,
+                     [ $$states[$$stack[-1][0]]{GOTOS}{$lhs}, $semval ]);
+                $$check='';
+                next;
+            };
+
+#DBG>			$debug & 0x04
+#DBG>		and	print STDERR "Forced Error recovery.\n";
+
+            $$check='';
+
+        };
+
+        #Error
+            $$errstatus
+        or   do {
+
+            $$errstatus = 1;
+            &$error($self);
+                $$errstatus # if 0, then YYErrok has been called
+            or  next;       # so continue parsing
+
+#DBG>			$debug & 0x10
+#DBG>		and	do {
+#DBG>			print STDERR "**Entering Error recovery.\n";
+#DBG>			++$dbgerror;
+#DBG>		};
+
+            ++$$nberror;
+
+        };
+
+			$$errstatus == 3	#The next token is not valid: discard it
+		and	do {
+				$$token eq ''	# End of input: no hope
+			and	do {
+#DBG>				$debug & 0x10
+#DBG>			and	print STDERR "**At eof: aborting.\n";
+				return(undef);
+			};
+
+#DBG>			$debug & 0x10
+#DBG>		and	print STDERR "**Dicard invalid token ".&$ShowCurToken.".\n";
+
+			$$token=$$value=undef;
+		};
+
+        $$errstatus=3;
+
+		while(	  @$stack
+			  and (		not exists($$states[$$stack[-1][0]]{ACTIONS})
+			        or  not exists($$states[$$stack[-1][0]]{ACTIONS}{error})
+					or	$$states[$$stack[-1][0]]{ACTIONS}{error} <= 0)) {
+
+#DBG>			$debug & 0x10
+#DBG>		and	print STDERR "**Pop state $$stack[-1][0].\n";
+
+			pop(@$stack);
+		}
+
+			@$stack
+		or	do {
+
+#DBG>			$debug & 0x10
+#DBG>		and	print STDERR "**No state left on stack: aborting.\n";
+
+			return(undef);
+		};
+
+		#shift the error token
+
+#DBG>			$debug & 0x10
+#DBG>		and	print STDERR "**Shift \$error token and go to state ".
+#DBG>						 $$states[$$stack[-1][0]]{ACTIONS}{error}.
+#DBG>						 ".\n";
+
+		push(@$stack, [ $$states[$$stack[-1][0]]{ACTIONS}{error}, undef ]);
+
+    }
+
+    #never reached
+	croak("Error in driver logic. Please, report it as a BUG");
+
+}#_Parse
+#DO NOT remove comment
+
+1;
+

pidl/lib/wscript_build

@@ -0,0 +1,4 @@
+#!/usr/bin/env python
+
+# install the pidl modules
+bld.INSTALL_WILDCARD('${DATAROOTDIR}/perl5', '**/*.pm', flat=False)

pidl/pidl

@@ -0,0 +1,797 @@
+#!/usr/bin/env perl
+
+###################################################
+# package to parse IDL files and generate code for
+# rpc functions in Samba
+# Copyright tridge@samba.org 2000-2003
+# Copyright jelmer@samba.org 2005-2007
+# released under the GNU GPL
+
+=pod
+
+=head1 NAME
+
+pidl - An IDL compiler written in Perl
+
+=head1 SYNOPSIS
+
+pidl --help
+
+pidl [--outputdir[=OUTNAME]] [--includedir DIR...] [--parse-idl-tree] [--dump-idl-tree] [--dump-ndr-tree] [--header[=OUTPUT]] [--python[=OUTPUT]] [--ndr-parser[=OUTPUT]] [--client] [--server] [--warn-compat] [--quiet] [--verbose] [--template] [--ws-parser[=OUTPUT]] [--diff] [--dump-idl] [--tdr-parser[=OUTPUT]] [--samba3-ndr-client[=OUTPUT]] [--samba3-ndr-server[=OUTPUT]] [--typelib=[OUTPUT]] [<idlfile>.idl]...
+
+=head1 DESCRIPTION
+
+pidl is an IDL compiler written in Perl that aims to be somewhat 
+compatible with the midl compiler. IDL is short for 
+"Interface Definition Language".
+
+pidl can generate stubs for DCE/RPC server code, DCE/RPC 
+client code and Wireshark dissectors for DCE/RPC traffic.
+
+IDL compilers like pidl take a description 
+of an interface as their input and use it to generate C 
+(though support for other languages may be added later) code that 
+can use these interfaces, pretty print data sent 
+using these interfaces, or even generate Wireshark 
+dissectors that can parse data sent over the 
+wire by these interfaces. 
+
+pidl takes IDL files in the same format as is used by midl, 
+converts it to a .pidl file (which contains pidl's internal representation of the interface) and can then generate whatever output you need.
+.pidl files should be used for debugging purposes only. Write your 
+interface definitions in .idl format.
+
+The goal of pidl is to implement a IDL compiler that can be used 
+while developing the RPC subsystem in Samba (for 
+both marshalling/unmarshalling and debugging purposes).
+
+=head1 OPTIONS
+
+=over 4
+
+=item I<--help>
+
+Show list of available options.
+
+=item I<--version>
+
+Show pidl version
+		
+=item I<--outputdir OUTNAME>
+
+Write output files to the specified directory.  Defaults to the current 
+directory.
+
+=item I<--includedir DIR>
+
+Add DIR to the search path used by the preprocessor. This option can be 
+specified multiple times.
+		
+=item I<--parse-idl-tree>
+
+Read internal tree structure from input files rather 
+than assuming they contain IDL.
+
+=item I<--dump-idl>
+
+Generate a new IDL file. File will be named OUTNAME.idl.
+
+=item I<--header>
+
+Generate a C header file for the specified interface. Filename defaults to OUTNAME.h.
+
+=item I<--ndr-parser>
+
+Generate a C file and C header containing NDR parsers. The filename for 
+the parser defaults to ndr_OUTNAME.c. The header filename will be the 
+parser filename with the extension changed from .c to .h.
+
+=item I<--tdr-parser>
+
+Generate a C file and C header containing TDR parsers. The filename for 
+the parser defaults to tdr_OUTNAME.c. The header filename will be the 
+parser filename with the extension changed from .c to .h.
+
+=item I<--typelib>
+
+Write type information to the specified file.
+
+=item I<--server>
+
+Generate boilerplate for the RPC server that implements 
+the interface. Filename defaults to ndr_OUTNAME_s.c.
+
+=item I<--template>
+
+Generate stubs for a RPC server that implements the interface. Output will 
+be written to stdout.
+
+=item I<--ws-parser>
+
+Generate an Wireshark dissector (in C) and header file. The dissector filename
+defaults to packet-dcerpc-OUTNAME.c while the header filename defaults to 
+packet-dcerpc-OUTNAME.h.
+	
+Pidl will read additional data from an Wireshark conformance file if present. 
+Such a file should have the same location as the IDL file but with the 
+extension I<cnf> rather than I<idl>. See L<Parse::Pidl::Wireshark::Conformance>
+for details on the format of this file.
+
+=item I<--diff>
+
+Parse an IDL file,  generate a new IDL file based on the internal data 
+structures and see if there are any differences with the original IDL file. 
+Useful for debugging pidl.
+
+=item I<--dump-idl-tree>
+
+Tell pidl to dump the internal tree representation of an IDL 
+file the to disk. Useful for debugging pidl.
+
+=item I<--dump-ndr-tree>
+
+Tell pidl to dump the internal NDR information tree it generated 
+from the IDL file to disk.  Useful for debugging pidl.
+
+=item I<--samba3-ndr-client>
+
+Generate client calls for Samba3, to be placed in rpc_client/. Instead of 
+calling out to the code in Samba3's rpc_parse/, this will call out to 
+Samba4's NDR code instead.
+
+=item I<--samba3-ndr-server>
+
+Generate server calls for Samba3, to be placed in rpc_server/. Instead of 
+calling out to the code in Samba3's rpc_parse/, this will call out to 
+Samba4's NDR code instead.
+
+=back
+
+=head1 IDL SYNTAX
+
+IDL files are always preprocessed using the C preprocessor.
+
+Pretty much everything in an interface (the interface itself, functions, 
+parameters) can have attributes (or properties whatever name you give them). 
+Attributes always prepend the element they apply to and are surrounded 
+by square brackets ([]). Multiple attributes are separated by comma's; 
+arguments to attributes are specified between parentheses. 
+
+See the section COMPATIBILITY for the list of attributes that 
+pidl supports.
+
+C-style comments can be used.
+	
+=head2 CONFORMANT ARRAYS
+
+A conformant array is one with that ends in [*] or []. The strange
+things about conformant arrays are that they can only appear as the last 
+element of a structure (unless there is a pointer to the conformant array, 
+of course) and the array size appears before the structure itself on the wire. 
+
+So, in this example:
+
+	typedef struct {
+		long abc;
+		long count;     
+		long foo;
+		[size_is(count)] long s[*];
+	} Struct1;
+
+it appears like this:
+
+	[size_is] [abc] [count] [foo] [s...]
+
+the first [size_is] field is the allocation size of the array, and
+occurs before the array elements and even before the structure
+alignment.
+
+Note that size_is() can refer to a constant, but that doesn't change
+the wire representation. It does not make the array a fixed array.
+
+midl.exe would write the above array as the following C header:
+
+   typedef struct {
+		long abc;
+		long count;     
+		long foo;
+		long s[1];
+	} Struct1;
+
+pidl takes a different approach, and writes it like this:
+
+    typedef struct {
+		long abc;
+		long count;     
+		long foo;
+		long *s;
+	} Struct1;
+
+=head2 VARYING ARRAYS
+
+A varying array looks like this:
+
+	typedef struct {
+		long abc;
+		long count;     
+		long foo;
+		[size_is(count)] long *s;
+	} Struct1;
+
+This will look like this on the wire:
+
+	[abc] [count] [foo] [PTR_s]    [count] [s...]
+
+=head2 FIXED ARRAYS
+
+A fixed array looks like this:
+
+    typedef struct {
+	    long s[10];
+    } Struct1;
+
+The NDR representation looks just like 10 separate long
+declarations. The array size is not encoded on the wire.
+
+pidl also supports "inline" arrays, which are not part of the IDL/NDR
+standard. These are declared like this:
+
+    typedef struct {
+	    uint32 foo;
+	    uint32 count;
+	    uint32 bar;
+	    long s[count];
+    } Struct1;
+
+This appears like this:
+
+	[foo] [count] [bar] [s...]
+
+Fixed arrays are an extension added to support some of the strange
+embedded structures in security descriptors and spoolss. 
+
+This section is by no means complete. See the OpenGroup and MSDN 
+	documentation for additional information.
+
+=head1 COMPATIBILITY WITH MIDL
+
+=head2 Missing features in pidl
+
+The following MIDL features are not (yet) implemented in pidl 
+or are implemented with an incompatible interface:
+
+=over
+
+=item *
+
+Asynchronous communication
+
+=item * 
+
+Typelibs (.tlb files)
+
+=item *
+
+Datagram support (ncadg_*)
+
+=back
+
+=head2 Supported attributes and statements
+
+in, out, ref, length_is, switch_is, size_is, uuid, case, default, string, 
+unique, ptr, pointer_default, v1_enum, object, helpstring, range, local, 
+call_as, endpoint, switch_type, progid, coclass, iid_is, represent_as, 
+transmit_as, import, include, cpp_quote.
+
+=head2 PIDL Specific properties
+
+=over 4
+
+=item public
+
+The [public] property on a structure or union is a pidl extension that
+forces the generated pull/push functions to be non-static. This allows
+you to declare types that can be used between modules. If you don't
+specify [public] then pull/push functions for other than top-level
+functions are declared static.
+				
+=item noprint
+
+The [noprint] property is a pidl extension that allows you to specify
+that pidl should not generate a ndr_print_*() function for that
+structure or union. This is used when you wish to define your own
+print function that prints a structure in a nicer manner. A good
+example is the use of [noprint] on dom_sid, which allows the
+pretty-printing of SIDs.
+
+=item value
+
+The [value(expression)] property is a pidl extension that allows you
+to specify the value of a field when it is put on the wire. This
+allows fields that always have a well-known value to be automatically
+filled in, thus making the API more programmer friendly. The
+expression can be any C expression.
+
+=item relative
+
+The [relative] property can be supplied on a pointer. When it is used
+it declares the pointer as a spoolss style "relative" pointer, which
+means it appears on the wire as an offset within the current
+encapsulating structure. This is not part of normal IDL/NDR, but it is
+a very useful extension as it avoids the manual encoding of many
+complex structures.
+
+=item subcontext(length)
+
+Specifies that a size of I<length>
+bytes should be read, followed by a blob of that size, 
+which will be parsed as NDR.
+
+subcontext() is deprecated now, and should not be used in new code. 
+Instead, use represent_as() or transmit_as().
+
+=item flag
+
+Specify boolean options, mostly used for 
+low-level NDR options. Several options 
+can be specified using the | character.
+Note that flags are inherited by substructures!
+
+=item nodiscriminant
+
+The [nodiscriminant] property on a union means that the usual uint16
+discriminent field at the start of the union on the wire is
+omitted. This is not normally allowed in IDL/NDR, but is used for some
+spoolss structures.
+
+=item charset(name)
+
+Specify that the array or string uses the specified 
+charset. If this attribute is specified, pidl will 
+take care of converting the character data from this format 
+to the host format. Commonly used values are UCS2, DOS and UTF8.
+
+=back
+
+=head2 Unsupported MIDL properties or statements
+
+aggregatable, appobject, async_uuid, bindable, control, 
+defaultbind, defaultcollelem, defaultvalue, defaultvtable, dispinterface, 
+displaybind, dual, entry, first_is, helpcontext, helpfile, helpstringcontext, 
+helpstringdll, hidden, idl_module, idl_quote, id, immediatebind, importlib, 
+includelib, last_is, lcid, licensed, max_is, module, 
+ms_union, no_injected_text, nonbrowsable, noncreatable, nonextensible, odl, 
+oleautomation, optional, pragma, propget, propputref, propput, readonly, 
+requestedit, restricted, retval, source, uidefault, 
+usesgetlasterror, vararg, vi_progid, wire_marshal. 
+
+=head1 EXAMPLES
+
+	# Generating an Wireshark parser
+	$ ./pidl --ws-parser -- atsvc.idl
+	
+	# Generating a TDR parser and header
+	$ ./pidl --tdr-parser --header -- regf.idl
+
+	# Generating a Samba3 client and server
+	$ ./pidl --samba3-ndr-client --samba3-ndr-server -- dfs.idl
+
+	# Generating a Samba4 NDR parser, client and server
+	$ ./pidl --ndr-parser --ndr-client --ndr-server -- samr.idl
+
+=head1 SEE ALSO
+
+L<http://msdn.microsoft.com/library/en-us/rpc/rpc/field_attributes.asp>,
+L<http://wiki.wireshark.org/DCE/RPC>, 
+L<http://www.samba.org/>,
+L<yapp(1)>
+
+=head1 LICENSE
+
+pidl is licensed under the GNU General Public License L<http://www.gnu.org/licenses/gpl.html>.
+
+=head1 AUTHOR
+
+pidl was written by Andrew Tridgell, Stefan Metzmacher, Tim Potter and Jelmer 
+Vernooij. The current maintainer is Jelmer Vernooij.
+
+This manpage was written by Jelmer Vernooij, partially based on the original 
+pidl README by Andrew Tridgell. 
+	
+=cut
+
+
+use strict;
+use FindBin qw($RealBin $Script);
+use lib "$RealBin/lib";
+use lib "$RealBin/../share/perl5";
+use Getopt::Long;
+use File::Basename;
+use Parse::Pidl qw ( $VERSION );
+use Parse::Pidl::Util;
+use Parse::Pidl::ODL;
+
+#####################################################################
+# save a data structure into a file
+sub SaveStructure($$)
+{
+	my($filename,$v) = @_;
+	FileSave($filename, Parse::Pidl::Util::MyDumper($v));
+}
+
+#####################################################################
+# load a data structure from a file (as saved with SaveStructure)
+sub LoadStructure($)
+{
+	my $f = shift;
+	my $contents = FileLoad($f);
+	defined $contents || return undef;
+	return eval "$contents";
+}
+
+#####################################################################
+# read a file into a string
+sub FileLoad($)
+{
+    my($filename) = shift;
+    local(*INPUTFILE);
+    open(INPUTFILE, $filename) || return undef;
+    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);
+}
+
+my(@opt_incdirs) = (); 
+my($opt_help) = 0;
+my($opt_version) = 0;
+my($opt_parse_idl_tree) = 0;
+my($opt_dump_idl_tree);
+my($opt_dump_ndr_tree);
+my($opt_dump_idl) = 0;
+my($opt_diff) = 0;
+my($opt_header);
+my($opt_samba3_header);
+my($opt_samba3_parser);
+my($opt_samba3_server);
+my($opt_samba3_ndr_client);
+my($opt_samba3_ndr_server);
+my($opt_template) = 0;
+my($opt_client);
+my($opt_typelib);
+my($opt_server);
+my($opt_ndr_parser);
+my($opt_tdr_parser);
+my($opt_ws_parser);
+my($opt_python);
+my($opt_quiet) = 0;
+my($opt_outputdir) = '.';
+my($opt_verbose) = 0;
+my($opt_warn_compat) = 0;
+my($opt_dcom_proxy);
+my($opt_com_header);
+
+#########################################
+# display help text
+sub ShowHelp()
+{
+print "perl IDL parser and code generator\n";
+ShowVersion();
+print"
+Copyright (C) Andrew Tridgell <tridge\@samba.org>
+Copyright (C) Jelmer Vernooij <jelmer\@samba.org>
+
+Usage: $Script [options] [--] <idlfile> [<idlfile>...]
+
+Generic Options:
+ --help                  this help page
+ --version               show pidl version
+ --outputdir=OUTDIR      put output in OUTDIR/ [.]
+ --warn-compat           warn about incompatibility with other compilers
+ --quiet                 be quiet
+ --verbose               be verbose
+ --includedir DIR        search DIR for included files
+
+Debugging:
+ --dump-idl-tree[=FILE]  dump internal representation to file [BASENAME.pidl]
+ --parse-idl-tree        read internal representation instead of IDL
+ --dump-ndr-tree[=FILE]  dump internal NDR data tree to file [BASENAME.ndr]
+ --dump-idl              regenerate IDL file
+ --diff                  run diff on original IDL and dumped output
+ --typelib               print type information
+
+Samba 4 output:
+ --header[=OUTFILE]      create generic header file [BASENAME.h]
+ --ndr-parser[=OUTFILE]  create a C NDR parser [ndr_BASENAME.c]
+ --client[=OUTFILE]      create a C NDR client [ndr_BASENAME_c.c]
+ --tdr-parser[=OUTFILE]  create a C TDR parser [tdr_BASENAME.c]
+ --python[=OUTFILE]      create python wrapper file [py_BASENAME.c]
+ --server[=OUTFILE]      create server boilerplate [ndr_BASENAME_s.c]
+ --template              print a template for a pipe
+ --dcom-proxy[=OUTFILE]  create DCOM proxy [ndr_BASENAME_p.c]
+ --com-header[=OUTFILE]  create header for COM [com_BASENAME.h]
+
+Samba 3 output:
+ --samba3-ndr-client[=OUTF] create client calls for Samba3 
+                            using Samba4's NDR code [cli_BASENAME.c]
+ --samba3-ndr-server[=OUTF] create server call wrapper for Samba3 
+                            using Samba4's NDR code [srv_BASENAME.c]
+
+Wireshark parsers:
+ --ws-parser[=OUTFILE]  create Wireshark parser and header
+\n";
+    exit(0);
+}
+
+#########################################
+# Display version
+sub ShowVersion()
+{
+    print "perl IDL version $VERSION\n";
+}
+
+# main program
+my $result = GetOptions (
+	    'help|h|?' => \$opt_help, 
+            'version' => \$opt_version,
+	    'outputdir=s' => \$opt_outputdir,
+	    'dump-idl' => \$opt_dump_idl,
+		'dump-idl-tree:s' => \$opt_dump_idl_tree,
+		'parse-idl-tree' => \$opt_parse_idl_tree,
+		'dump-ndr-tree:s' => \$opt_dump_ndr_tree,
+		'samba3-ndr-client:s' => \$opt_samba3_ndr_client,
+		'samba3-ndr-server:s' => \$opt_samba3_ndr_server,
+		'header:s' => \$opt_header,
+	    'server:s' => \$opt_server,
+		'typelib:s' => \$opt_typelib,
+	    'tdr-parser:s' => \$opt_tdr_parser,
+	    'template' => \$opt_template,
+	    'ndr-parser:s' => \$opt_ndr_parser,
+	    'client:s' => \$opt_client,
+	    'ws-parser:s' => \$opt_ws_parser,
+		'python' => \$opt_python,
+	    'diff' => \$opt_diff,
+        'dcom-proxy:s' => \$opt_dcom_proxy,
+		'com-header:s' => \$opt_com_header,
+	    'quiet' => \$opt_quiet,
+		'verbose' => \$opt_verbose,
+	    'warn-compat' => \$opt_warn_compat,
+		'includedir=s@' => \@opt_incdirs
+	    );
+
+if (not $result) {
+	exit(1);
+}
+
+if ($opt_help) {
+    ShowHelp();
+    exit(0);
+}
+
+if ($opt_version) {
+    ShowVersion();
+    exit(0);
+}
+
+sub process_file($)
+{
+	my $idl_file = shift;
+	my $outputdir = $opt_outputdir;
+	my $pidl;
+	my $ndr;
+
+	my $basename = basename($idl_file, ".idl");
+
+	unless ($opt_quiet) { print "Compiling $idl_file\n"; }
+
+	if ($opt_parse_idl_tree) {
+		$pidl = LoadStructure($idl_file);
+		defined $pidl || die "Failed to load $idl_file";
+	} else {
+		require Parse::Pidl::IDL;
+
+		$pidl = Parse::Pidl::IDL::parse_file($idl_file, \@opt_incdirs);
+		defined @$pidl || die "Failed to parse $idl_file";
+	}
+
+	require Parse::Pidl::Typelist;
+	Parse::Pidl::Typelist::LoadIdl($pidl, $basename);
+
+	if (defined($opt_dump_idl_tree)) {
+		my($pidl_file) = ($opt_dump_idl_tree or "$outputdir/$basename.pidl");
+		SaveStructure($pidl_file, $pidl) or die "Failed to save $pidl_file\n";
+	}
+
+	if ($opt_dump_idl) {
+		require Parse::Pidl::Dump;
+		print Parse::Pidl::Dump($pidl);
+	}
+
+	if ($opt_diff) {
+		my($tempfile) = "$outputdir/$basename.tmp";
+		FileSave($tempfile, IdlDump::Dump($pidl));
+		system("diff -wu $idl_file $tempfile");
+		unlink($tempfile);
+	}
+
+	my $comh_filename = ($opt_com_header or "$outputdir/com_$basename.h");
+	if (defined($opt_com_header)) {
+		require Parse::Pidl::Samba4::COM::Header;
+		my $res = Parse::Pidl::Samba4::COM::Header::Parse($pidl,"$outputdir/ndr_$basename.h");
+		if ($res) {
+			FileSave($comh_filename, $res);
+		}
+	}
+
+	if (defined($opt_dcom_proxy)) {
+		require Parse::Pidl::Samba4::COM::Proxy;
+		my $res = Parse::Pidl::Samba4::COM::Proxy::Parse($pidl,$comh_filename);
+		if ($res) {
+			my ($client) = ($opt_dcom_proxy or "$outputdir/$basename\_p.c");
+			FileSave($client, $res);
+		}
+	}
+
+	if ($opt_warn_compat) {
+		require Parse::Pidl::Compat;
+		Parse::Pidl::Compat::Check($pidl);
+	}
+
+	$pidl = Parse::Pidl::ODL::ODL2IDL($pidl, dirname($idl_file), \@opt_incdirs);
+
+	if (defined($opt_ws_parser)) {
+	  require Parse::Pidl::Wireshark::NDR;
+
+	  my $cnffile = $idl_file;
+	  $cnffile =~ s/\.idl$/\.cnf/;
+
+	  my $generator = new Parse::Pidl::Wireshark::NDR();
+	  $generator->Initialize($cnffile);
+	}
+
+
+	if (defined($opt_ws_parser) or
+	    defined($opt_client) or
+	    defined($opt_server) or 
+	    defined($opt_header) or
+	    defined($opt_ndr_parser) or
+	    defined($opt_python) or 
+	    defined($opt_dump_ndr_tree) or
+	    defined($opt_samba3_header) or 
+	    defined($opt_samba3_parser) or 
+	    defined($opt_samba3_server) or 
+	    defined($opt_samba3_ndr_client) or
+	    defined($opt_samba3_ndr_server)) {
+		require Parse::Pidl::NDR;
+		$ndr = Parse::Pidl::NDR::Parse($pidl);
+	}
+
+	if (defined($opt_dump_ndr_tree)) {
+		my($ndr_file) = ($opt_dump_ndr_tree or "$outputdir/$basename.ndr");
+		SaveStructure($ndr_file, $ndr) or die "Failed to save $ndr_file\n";
+	}
+
+	my $gen_header = ($opt_header or "$outputdir/$basename.h");
+	if (defined($opt_header)) {
+		require Parse::Pidl::Samba4::Header;
+		FileSave($gen_header, Parse::Pidl::Samba4::Header::Parse($ndr));
+	}
+
+	my $h_filename = "$outputdir/ndr_$basename.h";
+	my $c_header = "$outputdir/ndr_$basename\_c.h";
+	if (defined($opt_client) or defined($opt_samba3_ndr_client)) {
+		require Parse::Pidl::Samba4::NDR::Client;
+		my ($c_client) = ($opt_client or "$outputdir/ndr_$basename\_c.c");
+		$c_header = $c_client;
+		$c_header =~ s/\.c$/.h/;
+
+		my $generator = new Parse::Pidl::Samba4::NDR::Client();
+		my ($srcd,$hdrd) = $generator->Parse(
+			$ndr,$gen_header,$h_filename,$c_header);
+
+		FileSave($c_client, $srcd);
+		FileSave($c_header, $hdrd);
+	}
+
+	if (defined($opt_python)) {
+		require Parse::Pidl::Samba4::Python;
+		my $generator = new Parse::Pidl::Samba4::Python(); 
+		my ($prsr) = $generator->Parse($basename, $ndr, 
+					"$outputdir/ndr_$basename\_c.h", $h_filename);
+		FileSave("$outputdir/py_$basename.c", $prsr);
+	}
+
+	if (defined($opt_server)) {
+		require Parse::Pidl::Samba4::NDR::Server;
+
+		FileSave(($opt_server or "$outputdir/ndr_$basename\_s.c"), Parse::Pidl::Samba4::NDR::Server::Parse($ndr,$h_filename));
+	}
+
+	if (defined($opt_ndr_parser)) {
+		my $parser_fname = ($opt_ndr_parser or "$outputdir/ndr_$basename.c");
+		require Parse::Pidl::Samba4::NDR::Parser;
+		my $generator = new Parse::Pidl::Samba4::NDR::Parser();
+		my ($header,$parser) = $generator->Parse($ndr, $gen_header, $h_filename);
+
+		FileSave($parser_fname, $parser);
+		FileSave($h_filename, $header);
+
+	}
+
+	if (defined($opt_ws_parser)) {
+	  require Parse::Pidl::Wireshark::NDR;
+	  my($eparser) = ($opt_ws_parser or "$outputdir/packet-dcerpc-$basename.c");
+	  my $eheader = $eparser;
+	  $eheader =~ s/\.c$/\.h/;
+	  my $cnffile = $idl_file;
+	  $cnffile =~ s/\.idl$/\.cnf/;
+
+	  my $generator = new Parse::Pidl::Wireshark::NDR();
+	  my ($dp, $dh) = $generator->Parse($ndr, $idl_file, $eheader, $cnffile);
+	  FileSave($eparser, $dp) if defined($dp);
+	  FileSave($eheader, $dh) if defined($dh);
+	}
+
+	if (defined($opt_tdr_parser)) {
+		my $tdr_parser = ($opt_tdr_parser or "$outputdir/tdr_$basename.c");
+		my $tdr_header = $tdr_parser;
+		$tdr_header =~ s/\.c$/\.h/;
+		require Parse::Pidl::Samba4::TDR;
+		my $generator = new Parse::Pidl::Samba4::TDR();
+		my ($hdr,$prsr) = $generator->Parser($pidl, $tdr_header, $gen_header);
+		FileSave($tdr_parser, $prsr);
+		FileSave($tdr_header, $hdr);
+	}
+
+	if (defined($opt_typelib)) {
+		my $typelib = ($opt_typelib or "$outputdir/$basename.tlb");
+		require Parse::Pidl::Typelist;
+		FileSave($typelib, Parse::Pidl::Typelist::GenerateTypeLib());
+	}
+
+	if ($opt_template) {
+		require Parse::Pidl::Samba4::Template;
+		print Parse::Pidl::Samba4::Template::Parse($pidl);
+	}
+
+	if (defined($opt_samba3_ndr_client)) {
+		my $client = ($opt_samba3_ndr_client or "$outputdir/cli_$basename.c");
+		my $header = $client; $header =~ s/\.c$/\.h/;
+		require Parse::Pidl::Samba3::ClientNDR;
+		my $generator = new Parse::Pidl::Samba3::ClientNDR();
+		my ($c_code,$h_code) = $generator->Parse($ndr, $header, $c_header);
+		FileSave($client, $c_code);
+		FileSave($header, $h_code);
+	}
+
+	if (defined($opt_samba3_ndr_server)) {
+		my $server = ($opt_samba3_ndr_server or "$outputdir/srv_$basename.c");
+		my $header = $server; $header =~ s/\.c$/\.h/;
+		require Parse::Pidl::Samba3::ServerNDR;
+		my ($c_code,$h_code) = Parse::Pidl::Samba3::ServerNDR::Parse($ndr, $header, $h_filename);
+		FileSave($server, $c_code);
+		FileSave($header, $h_code);
+	}
+
+}
+
+if (scalar(@ARGV) == 0) {
+	print "$Script: no input files\n";
+	exit(1);
+}
+
+process_file($_) foreach (@ARGV);

pidl/tests/Util.pm

@@ -0,0 +1,181 @@
+# Some simple utility functions for pidl tests
+# Copyright (C) 2005-2006 Jelmer Vernooij
+# Published under the GNU General Public License
+
+package Util;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(test_samba4_ndr test_warnings test_errors);
+
+use strict;
+
+use FindBin qw($RealBin);
+use lib "$RealBin/../lib";
+
+use Parse::Pidl::Samba4 qw(is_intree);
+
+use Parse::Pidl;
+my $warnings = "";
+undef &Parse::Pidl::warning;
+*Parse::Pidl::warning = sub { 
+	my ($e, $l) = @_;
+	if (defined($e)) {
+		$warnings .= "$e->{FILE}:$e->{LINE}: $l\n";
+	} else {
+		$warnings .= "$l\n";
+	}
+};
+
+my $errors = "";
+undef &Parse::Pidl::error;
+*Parse::Pidl::error = sub { 
+	my ($e, $l) = @_;
+	if (defined($e)) {
+		$errors .= "$e->{FILE}:$e->{LINE}: $l\n";
+	} else {
+		$errors .= "$l\n";
+	}
+};
+
+use Test::More;
+use Parse::Pidl::IDL;
+use Parse::Pidl::NDR;
+use Parse::Pidl::Samba4::NDR::Parser;
+use Parse::Pidl::Samba4::Header;
+
+# Generate a Samba4 parser for an IDL fragment and run it with a specified 
+# piece of code to check whether the parser works as expected
+sub test_samba4_ndr
+{
+	my ($name,$idl,$c,$extra) = @_;
+
+	$extra = "" unless defined($extra);
+
+	my $pidl = Parse::Pidl::IDL::parse_string("interface echo { $idl }; ", "<$name>");
+	ok(defined($pidl), "($name) parse idl");
+
+	my $pndr = Parse::Pidl::NDR::Parse($pidl);
+	ok(defined($pndr), "($name) generate NDR tree");
+
+	my $header = Parse::Pidl::Samba4::Header::Parse($pndr);
+	ok(defined($header), "($name) generate generic header");
+
+	my $generator = new Parse::Pidl::Samba4::NDR::Parser();
+	my ($ndrheader,$ndrparser) = $generator->Parse($pndr, undef, undef);
+	ok(defined($ndrparser), "($name) generate NDR parser");
+	ok(defined($ndrheader), "($name) generate NDR header");
+
+SKIP: {
+
+	my $flags;
+	if (system("pkg-config --exists ndr") == 0 and !is_intree()) {
+		$flags = `pkg-config --libs --cflags ndr`;
+	} else {
+		skip "no samba environment available, skipping compilation", 3;
+	}
+
+	my $main = "
+#include <stdint.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <stdbool.h>
+#include <stdarg.h>
+#include <util/data_blob.h>
+
+/* header start */
+$header
+/* header end */
+
+/* ndrheader start */
+$ndrheader
+/* ndrheader end */
+
+/* extra start */
+$extra
+/* extra end */
+
+/* ndrparser start */
+$ndrparser
+/* ndrparser end */
+
+/* main start */
+int main(int argc, const char **argv)
+{
+	TALLOC_CTX *mem_ctx = talloc_init(NULL);
+
+$c
+
+	talloc_free(mem_ctx);
+
+	return 0;
+}
+/* main end */
+\n";
+
+	my $main_debug = "# ".join("\n# ", split("\n", $main));
+
+	my $test_data_prefix = $ENV{TEST_DATA_PREFIX};
+	my $outfile;
+	if (defined($test_data_prefix)) {
+		$outfile = "$test_data_prefix/test-$name";	
+	} else {
+		$outfile = "./test-$name";
+	}
+
+	my $cflags = $ENV{CFLAGS};
+	unless (defined($cflags)) {
+		$cflags = "";
+	}
+
+	my $ldflags = $ENV{LDFLAGS};
+	unless (defined($ldflags)) {
+		$ldflags = "";
+	}
+
+	my $cc = $ENV{CC};
+	unless (defined($cc)) {
+		$cc = "cc";
+	}
+
+	my $cmd = "$cc $cflags -x c - -o $outfile $flags $ldflags";
+	$cmd =~ s/\n//g;
+	open CC, "|$cmd";
+	print CC $main;
+	close CC;
+
+	ok(-f $outfile, "($name) compile");
+
+	my $ret = system($outfile, ()) >> 8;
+	print "# code:\n#\n$main_debug\n" if ($ret != 0);
+	print "# cmd: $cmd\n" if ($ret != 0);
+	print "# return code: $ret\n" if ($ret != 0);
+
+	ok($ret == 0, "($name) run");
+
+	ok(unlink($outfile), "($name) remove");
+
+	}
+}
+
+sub test_warnings($$)
+{
+	my ($exp, $code) = @_;
+
+	$warnings = "";
+
+	$code->();
+
+	is($warnings, $exp);
+}
+
+sub test_errors($$)
+{
+	my ($exp, $code) = @_;
+	$errors = "";
+	$code->();
+
+	is($errors, $exp);
+}
+
+1;

pidl/tests/cutil.pl

@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+# (C) 2007 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU General Public License
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util;
+use Parse::Pidl::Util qw(MyDumper);
+use Parse::Pidl::CUtil qw(get_pointer_to get_value_of);
+
+is("&foo", get_pointer_to("foo"));
+is("&(&foo)", get_pointer_to(get_pointer_to("foo")));
+is("*foo", get_pointer_to("**foo"));
+is("foo", get_pointer_to("*foo"));
+
+is("foo", get_value_of("&foo"));
+is("*foo", get_value_of("foo"));
+is("**foo", get_value_of("*foo"));

pidl/tests/dump.pl

@@ -0,0 +1,15 @@
+#!/usr/bin/perl
+# (C) 2007 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU General Public License
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util;
+use Parse::Pidl::Dump qw(DumpStruct);
+
+is (DumpStruct({ NAME => "foo", ELEMENTS => []}), 
+	"struct foo {\n}");
+

pidl/tests/header.pl

@@ -0,0 +1,108 @@
+#!/usr/bin/perl
+# (C) 2007 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU General Public License
+use strict;
+use warnings;
+
+use Test::More tests => 27;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util;
+use Parse::Pidl::Util qw(MyDumper);
+use Parse::Pidl::Samba4::Header qw(
+	GenerateFunctionInEnv GenerateFunctionOutEnv GenerateStructEnv
+	EnvSubstituteValue);
+use Parse::Pidl::IDL qw(parse_string);
+use Parse::Pidl::NDR;
+
+sub parse_idl($)
+{
+	my $text = shift;
+	my $idl = Parse::Pidl::IDL::parse_string($text, "nofile");
+	my $ndr = Parse::Pidl::NDR::Parse($idl);
+	return Parse::Pidl::Samba4::Header::Parse($ndr);
+}
+
+like(parse_idl(""), qr/\/\* header auto-generated by pidl \*\/\n/sm, "includes work");
+like(parse_idl("interface x {}"), qr/\/\* header auto-generated by pidl \*\/\n/sm,  "simple empty interface doesn't cause overhead");
+like(parse_idl("interface p { typedef struct { int y; } x; };"),
+     qr/.*#ifndef _HEADER_p\n#define _HEADER_p\n.+\n#endif \/\* _HEADER_p \*\/.*/ms, "ifdefs are created");
+like(parse_idl("interface p { typedef struct { int y; } x; };"),
+     qr/struct x.*{.*int32_t y;.*}.*;/sm, "interface member generated properly");
+like(parse_idl("interface x { void foo (void); };"),
+     qr/struct foo.*{\s+int _dummy_element;\s+};/sm, "void fn contains dummy element");
+like(parse_idl("interface x { void foo ([in] uint32 x); };"),
+     qr/struct foo.*{\s+struct\s+{\s+uint32_t x;\s+} in;\s+};/sm, "fn in arg works");
+like(parse_idl("interface x { void foo ([out] uint32 x); };"),
+     qr/struct foo.*{.*struct\s+{\s+uint32_t x;\s+} out;.*};/sm, "fn out arg works");
+like(parse_idl("interface x { void foo ([in,out] uint32 x); };"),
+     qr/struct foo.*{.*struct\s+{\s+uint32_t x;\s+} in;\s+struct\s+{\s+uint32_t x;\s+} out;.*};/sm, "fn in,out arg works");
+like(parse_idl("interface x { void foo (uint32 x); };"), qr/struct foo.*{.*struct\s+{\s+uint32_t x;\s+} in;\s+struct\s+{\s+uint32_t x;\s+} out;.*};/sm, "fn with no props implies in,out");
+like(parse_idl("interface p { struct x { int y; }; };"),
+     qr/struct x.*{.*int32_t y;.*}.*;/sm, "interface member generated properly");
+
+like(parse_idl("interface p { struct x { struct y z; }; };"),
+     qr/struct x.*{.*struct y z;.*}.*;/sm, "tagged type struct member");
+
+like(parse_idl("interface p { struct x { union y z; }; };"),
+     qr/struct x.*{.*union y z;.*}.*;/sm, "tagged type union member");
+
+like(parse_idl("interface p { struct x { }; };"),
+     qr/struct x.*{.*char _empty_;.*}.*;/sm, "empty struct");
+
+like(parse_idl("interface p { struct x; };"),
+     qr/struct x;/sm, "struct declaration");
+
+like(parse_idl("interface p { typedef struct x { int p; } x; };"),
+     qr/struct x.*{.*int32_t p;.*};/sm, "double struct declaration");
+
+like(parse_idl("cpp_quote(\"some-foo\")"),
+	qr/some-foo/sm, "cpp quote");
+
+# Make sure GenerateFunctionInEnv and GenerateFunctionOutEnv work
+my $fn = { ELEMENTS => [ { DIRECTION => ["in"], NAME => "foo" } ] };
+is_deeply({ "foo" => "r->in.foo" }, GenerateFunctionInEnv($fn));
+
+$fn = { ELEMENTS => [ { DIRECTION => ["out"], NAME => "foo" } ] };
+is_deeply({ "foo" => "r->out.foo" }, GenerateFunctionOutEnv($fn));
+
+$fn = { ELEMENTS => [ { DIRECTION => ["out", "in"], NAME => "foo" } ] };
+is_deeply({ "foo" => "r->in.foo" }, GenerateFunctionInEnv($fn));
+
+$fn = { ELEMENTS => [ { DIRECTION => ["out", "in"], NAME => "foo" } ] };
+is_deeply({ "foo" => "r->out.foo" }, GenerateFunctionOutEnv($fn));
+
+$fn = { ELEMENTS => [ { DIRECTION => ["in"], NAME => "foo" } ] };
+is_deeply({ "foo" => "r->in.foo" }, GenerateFunctionOutEnv($fn));
+
+$fn = { ELEMENTS => [ { DIRECTION => ["out"], NAME => "foo" } ] };
+is_deeply({ }, GenerateFunctionInEnv($fn));
+
+$fn = { ELEMENTS => [ { NAME => "foo" }, { NAME => "bar" } ] };
+is_deeply({ foo => "r->foo", bar => "r->bar", this => "r" }, 
+		GenerateStructEnv($fn, "r"));
+
+$fn = { ELEMENTS => [ { NAME => "foo" }, { NAME => "bar" } ] };
+is_deeply({ foo => "some->complex.variable->foo", 
+		    bar => "some->complex.variable->bar", 
+			this => "some->complex.variable" }, 
+		GenerateStructEnv($fn, "some->complex.variable"));
+
+$fn = { ELEMENTS => [ { NAME => "foo", PROPERTIES => { value => 3 }} ] };
+
+my $env = GenerateStructEnv($fn, "r");
+EnvSubstituteValue($env, $fn);
+is_deeply($env, { foo => 3, this => "r" });
+
+$fn = { ELEMENTS => [ { NAME => "foo" }, { NAME => "bar" } ] };
+$env = GenerateStructEnv($fn, "r");
+EnvSubstituteValue($env, $fn);
+is_deeply($env, { foo => 'r->foo', bar => 'r->bar', this => "r" });
+
+$fn = { ELEMENTS => [ { NAME => "foo", PROPERTIES => { value => 0 }} ] };
+
+$env = GenerateStructEnv($fn, "r");
+EnvSubstituteValue($env, $fn);
+is_deeply($env, { foo => 0, this => "r" });
+
+

pidl/tests/ndr.pl

@@ -0,0 +1,561 @@
+#!/usr/bin/perl
+# (C) 2007 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU General Public License
+use strict;
+use warnings;
+
+use Test::More tests => 47;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util;
+use Parse::Pidl::Util qw(MyDumper);
+use Parse::Pidl::NDR qw(GetElementLevelTable ParseElement align_type mapToScalar ParseType can_contain_deferred);
+
+# Case 1
+
+my $e = {
+	'FILE' => 'foo.idl',
+	'NAME' => 'v',
+	'PROPERTIES' => {},
+	'POINTERS' => 0,
+	'TYPE' => 'uint8',
+	'PARENT' => { TYPE => 'STRUCT' },
+	'LINE' => 42 };
+
+is_deeply(GetElementLevelTable($e, "unique", 0), [
+	{
+		'IS_DEFERRED' => 0,
+		'LEVEL_INDEX' => 0,
+		'DATA_TYPE' => 'uint8',
+		'CONTAINS_DEFERRED' => 0,
+		'TYPE' => 'DATA',
+		'IS_SURROUNDING' => 0,
+	}
+]);
+
+my $ne = ParseElement($e, "unique", 0);
+is($ne->{ORIGINAL}, $e);
+is($ne->{NAME}, "v");
+is($ne->{ALIGN}, 1);
+is($ne->{TYPE}, "uint8");
+is_deeply($ne->{LEVELS},  [
+	{
+		'IS_DEFERRED' => 0,
+		'LEVEL_INDEX' => 0,
+		'DATA_TYPE' => 'uint8',
+		'CONTAINS_DEFERRED' => 0,
+		'TYPE' => 'DATA',
+		'IS_SURROUNDING' => 0,
+	}
+]);
+
+# Case 2 : pointers
+#
+$e = {
+	'FILE' => 'foo.idl',
+	'NAME' => 'v',
+	'PROPERTIES' => {"unique" => 1},
+	'POINTERS' => 1,
+	'PARENT' => { TYPE => 'STRUCT' },
+	'TYPE' => 'uint8',
+	'LINE' => 42 };
+
+is_deeply(GetElementLevelTable($e, "unique", 0), [
+	{
+		LEVEL_INDEX => 0,
+		IS_DEFERRED => 0,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "unique",
+		POINTER_INDEX => 0,
+		LEVEL => 'EMBEDDED'
+	},
+	{
+		'IS_DEFERRED' => 1,
+		'LEVEL_INDEX' => 1,
+		'DATA_TYPE' => 'uint8',
+		'CONTAINS_DEFERRED' => 0,
+		'TYPE' => 'DATA',
+		'IS_SURROUNDING' => 0,
+	}
+]);
+
+# Case 3 : double pointers
+#
+$e = {
+	'FILE' => 'foo.idl',
+	'NAME' => 'v',
+	'PROPERTIES' => {"unique" => 1},
+	'POINTERS' => 2,
+	'TYPE' => 'uint8',
+	'PARENT' => { TYPE => 'STRUCT' },
+	'LINE' => 42 };
+
+is_deeply(GetElementLevelTable($e, "unique", 0), [
+	{
+		LEVEL_INDEX => 0,
+		IS_DEFERRED => 0,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "unique",
+		POINTER_INDEX => 0,
+		LEVEL => 'EMBEDDED'
+	},
+	{
+		LEVEL_INDEX => 1,
+		IS_DEFERRED => 1,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "unique",
+		POINTER_INDEX => 1,
+		LEVEL => 'EMBEDDED'
+	},
+	{
+		'IS_DEFERRED' => 1,
+		'LEVEL_INDEX' => 2,
+		'DATA_TYPE' => 'uint8',
+		'CONTAINS_DEFERRED' => 0,
+		'TYPE' => 'DATA',
+		'IS_SURROUNDING' => 0,
+	}
+]);
+
+# Case 3 : ref pointers
+#
+$e = {
+	'FILE' => 'foo.idl',
+	'NAME' => 'v',
+	'PROPERTIES' => {"ref" => 1},
+	'POINTERS' => 1,
+	'TYPE' => 'uint8',
+	'PARENT' => { TYPE => 'STRUCT' },
+	'LINE' => 42 };
+
+is_deeply(GetElementLevelTable($e, "unique", 0), [
+	{
+		LEVEL_INDEX => 0,
+		IS_DEFERRED => 0,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "ref",
+		POINTER_INDEX => 0,
+		LEVEL => 'EMBEDDED'
+	},
+	{
+		'IS_DEFERRED' => 1,
+		'LEVEL_INDEX' => 1,
+		'DATA_TYPE' => 'uint8',
+		'CONTAINS_DEFERRED' => 0,
+		'TYPE' => 'DATA',
+		'IS_SURROUNDING' => 0,
+	}
+]);
+
+# Case 3 : ref pointers
+#
+$e = {
+	'FILE' => 'foo.idl',
+	'NAME' => 'v',
+	'PROPERTIES' => {"ref" => 1},
+	'POINTERS' => 3,
+	'TYPE' => 'uint8',
+	'PARENT' => { TYPE => 'STRUCT' },
+	'LINE' => 42 };
+
+is_deeply(GetElementLevelTable($e, "unique", 0), [
+	{
+		LEVEL_INDEX => 0,
+		IS_DEFERRED => 0,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "ref",
+		POINTER_INDEX => 0,
+		LEVEL => 'EMBEDDED'
+	},
+	{
+		LEVEL_INDEX => 1,
+		IS_DEFERRED => 1,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "unique",
+		POINTER_INDEX => 1,
+		LEVEL => 'EMBEDDED'
+	},
+	{
+		LEVEL_INDEX => 2,
+		IS_DEFERRED => 1,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "unique",
+		POINTER_INDEX => 2,
+		LEVEL => 'EMBEDDED'
+	},
+	{
+		'IS_DEFERRED' => 1,
+		'LEVEL_INDEX' => 3,
+		'DATA_TYPE' => 'uint8',
+		'CONTAINS_DEFERRED' => 0,
+		'TYPE' => 'DATA',
+		'IS_SURROUNDING' => 0,
+	}
+]);
+
+# Case 3 : ref pointers
+#
+$e = {
+	'FILE' => 'foo.idl',
+	'NAME' => 'v',
+	'PROPERTIES' => {"ref" => 1},
+	'POINTERS' => 3,
+	'TYPE' => 'uint8',
+	'PARENT' => { TYPE => 'STRUCT' },
+	'LINE' => 42 };
+
+is_deeply(GetElementLevelTable($e, "ref", 0), [
+	{
+		LEVEL_INDEX => 0,
+		IS_DEFERRED => 0,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "ref",
+		POINTER_INDEX => 0,
+		LEVEL => 'EMBEDDED'
+	},
+	{
+		LEVEL_INDEX => 1,
+		IS_DEFERRED => 1,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "ref",
+		POINTER_INDEX => 1,
+		LEVEL => 'EMBEDDED'
+	},
+	{
+		LEVEL_INDEX => 2,
+		IS_DEFERRED => 1,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "ref",
+		POINTER_INDEX => 2,
+		LEVEL => 'EMBEDDED'
+	},
+	{
+		'IS_DEFERRED' => 1,
+		'LEVEL_INDEX' => 3,
+		'DATA_TYPE' => 'uint8',
+		'CONTAINS_DEFERRED' => 0,
+		'TYPE' => 'DATA',
+		'IS_SURROUNDING' => 0,
+	}
+]);
+
+# Case 4 : top-level ref pointers
+#
+$e = {
+	'FILE' => 'foo.idl',
+	'NAME' => 'v',
+	'PROPERTIES' => {"ref" => 1},
+	'POINTERS' => 1,
+	'TYPE' => 'uint8',
+	'PARENT' => { TYPE => 'FUNCTION' },
+	'LINE' => 42 };
+
+is_deeply(GetElementLevelTable($e, "unique", 0), [
+	{
+		LEVEL_INDEX => 0,
+		IS_DEFERRED => 0,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "ref",
+		POINTER_INDEX => 0,
+		LEVEL => 'TOP'
+	},
+	{
+		'IS_DEFERRED' => 0,
+		'LEVEL_INDEX' => 1,
+		'DATA_TYPE' => 'uint8',
+		'CONTAINS_DEFERRED' => 0,
+		'TYPE' => 'DATA',
+		'IS_SURROUNDING' => 0,
+	}
+]);
+
+# Case 4 : top-level ref pointers, triple with pointer_default("unique")
+#
+$e = {
+	'FILE' => 'foo.idl',
+	'NAME' => 'v',
+	'PROPERTIES' => {"ref" => 1},
+	'POINTERS' => 3,
+	'TYPE' => 'uint8',
+	'PARENT' => { TYPE => 'FUNCTION' },
+	'LINE' => 42 };
+
+is_deeply(GetElementLevelTable($e, "unique", 0), [
+	{
+		LEVEL_INDEX => 0,
+		IS_DEFERRED => 0,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "ref",
+		POINTER_INDEX => 0,
+		LEVEL => 'TOP'
+	},
+	{
+		LEVEL_INDEX => 1,
+		IS_DEFERRED => 0,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "unique",
+		POINTER_INDEX => 1,
+		LEVEL => 'EMBEDDED'
+	},
+	{
+		LEVEL_INDEX => 2,
+		IS_DEFERRED => 1,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "unique",
+		POINTER_INDEX => 2,
+		LEVEL => 'EMBEDDED'
+	},
+	{
+		'IS_DEFERRED' => 1,
+		'LEVEL_INDEX' => 3,
+		'DATA_TYPE' => 'uint8',
+		'CONTAINS_DEFERRED' => 0,
+		'TYPE' => 'DATA',
+		'IS_SURROUNDING' => 0,
+	}
+]);
+
+# Case 4 : top-level unique pointers, triple with pointer_default("unique")
+#
+$e = {
+	'FILE' => 'foo.idl',
+	'NAME' => 'v',
+	'PROPERTIES' => {"unique" => 1, "in" => 1},
+	'POINTERS' => 3,
+	'TYPE' => 'uint8',
+	'PARENT' => { TYPE => 'FUNCTION' },
+	'LINE' => 42 };
+
+is_deeply(GetElementLevelTable($e, "unique", 0), [
+	{
+		LEVEL_INDEX => 0,
+		IS_DEFERRED => 0,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "unique",
+		POINTER_INDEX => 0,
+		LEVEL => 'TOP'
+	},
+	{
+		LEVEL_INDEX => 1,
+		IS_DEFERRED => 1,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "unique",
+		POINTER_INDEX => 1,
+		LEVEL => 'EMBEDDED'
+	},
+	{
+		LEVEL_INDEX => 2,
+		IS_DEFERRED => 1,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "unique",
+		POINTER_INDEX => 2,
+		LEVEL => 'EMBEDDED'
+	},
+	{
+		'IS_DEFERRED' => 1,
+		'LEVEL_INDEX' => 3,
+		'DATA_TYPE' => 'uint8',
+		'CONTAINS_DEFERRED' => 0,
+		'TYPE' => 'DATA',
+		'IS_SURROUNDING' => 0,
+	}
+]);
+
+# Case 4 : top-level unique pointers, triple with pointer_default("ref")
+#
+$e = {
+	'FILE' => 'foo.idl',
+	'NAME' => 'v',
+	'PROPERTIES' => {"unique" => 1, "in" => 1},
+	'POINTERS' => 3,
+	'TYPE' => 'uint8',
+	'PARENT' => { TYPE => 'FUNCTION' },
+	'LINE' => 42 };
+
+is_deeply(GetElementLevelTable($e, "ref", 0), [
+	{
+		LEVEL_INDEX => 0,
+		IS_DEFERRED => 0,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "unique",
+		POINTER_INDEX => 0,
+		LEVEL => 'TOP'
+	},
+	{
+		LEVEL_INDEX => 1,
+		IS_DEFERRED => 1,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "ref",
+		POINTER_INDEX => 1,
+		LEVEL => 'EMBEDDED'
+	},
+	{
+		LEVEL_INDEX => 2,
+		IS_DEFERRED => 1,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "ref",
+		POINTER_INDEX => 2,
+		LEVEL => 'EMBEDDED'
+	},
+	{
+		'IS_DEFERRED' => 1,
+		'LEVEL_INDEX' => 3,
+		'DATA_TYPE' => 'uint8',
+		'CONTAINS_DEFERRED' => 0,
+		'TYPE' => 'DATA',
+		'IS_SURROUNDING' => 0,
+	}
+]);
+
+# Case 4 : top-level ref pointers, triple with pointer_default("ref")
+#
+$e = {
+	'FILE' => 'foo.idl',
+	'NAME' => 'v',
+	'PROPERTIES' => {"ref" => 1},
+	'POINTERS' => 3,
+	'TYPE' => 'uint8',
+	'PARENT' => { TYPE => 'FUNCTION' },
+	'LINE' => 42 };
+
+is_deeply(GetElementLevelTable($e, "ref", 0), [
+	{
+		LEVEL_INDEX => 0,
+		IS_DEFERRED => 0,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "ref",
+		POINTER_INDEX => 0,
+		LEVEL => 'TOP'
+	},
+	{
+		LEVEL_INDEX => 1,
+		IS_DEFERRED => 0,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "ref",
+		POINTER_INDEX => 1,
+		LEVEL => 'EMBEDDED'
+	},
+	{
+		LEVEL_INDEX => 2,
+		IS_DEFERRED => 1,
+		TYPE => 'POINTER',
+		POINTER_TYPE => "ref",
+		POINTER_INDEX => 2,
+		LEVEL => 'EMBEDDED'
+	},
+	{
+		'IS_DEFERRED' => 1,
+		'LEVEL_INDEX' => 3,
+		'DATA_TYPE' => 'uint8',
+		'CONTAINS_DEFERRED' => 0,
+		'TYPE' => 'DATA',
+		'IS_SURROUNDING' => 0,
+	}
+]);
+
+# representation_type
+$e = {
+	'FILE' => 'foo.idl',
+	'NAME' => 'v',
+	'PROPERTIES' => { represent_as => "bar" },
+	'POINTERS' => 0,
+	'TYPE' => 'uint8',
+	'PARENT' => { TYPE => 'STRUCT' },
+	'LINE' => 42 };
+
+$ne = ParseElement($e, undef, 0);
+is($ne->{REPRESENTATION_TYPE}, "bar");
+
+# representation_type
+$e = {
+	'FILE' => 'foo.idl',
+	'NAME' => 'v',
+	'PROPERTIES' => { },
+	'POINTERS' => 0,
+	'TYPE' => 'uint8',
+	'PARENT' => { TYPE => 'STRUCT' },
+	'LINE' => 42 };
+
+$ne = ParseElement($e, undef, 0);
+is($ne->{REPRESENTATION_TYPE}, "uint8");
+
+is(align_type("hyper"), 8);
+is(align_type("double"), 8);
+is(align_type("uint32"), 4);
+is(align_type("uint16"), 2);
+is(align_type("uint8"), 1);
+is(align_type({ TYPE => "STRUCT", "NAME" => "bla", 
+			    ELEMENTS => [ { TYPE => "uint16" } ] }), 4);
+is(align_type({ TYPE => "STRUCT", 
+			    ELEMENTS => [ { TYPE => "hyper" } ] }), 8);
+is(align_type({ TYPE => "TYPEDEF", DATA => { 
+				TYPE => "STRUCT", 
+			    ELEMENTS => [ { TYPE => "hyper" } ] }}), 8);
+# typedef of struct without body
+is(align_type({ TYPE => "TYPEDEF", DATA => { 
+				TYPE => "STRUCT", ELEMENTS => undef }}), 4);
+# struct without body
+is(align_type({ TYPE => "STRUCT", ELEMENTS => undef }), 4);
+# empty struct
+is(align_type({ TYPE => "STRUCT", ELEMENTS => [] }), 1);
+is(align_type({ TYPE => "STRUCT", "NAME" => "bla", 
+			    ELEMENTS => [ { TYPE => "uint8" } ] }), 4);
+
+is(mapToScalar("someverymuchnotexistingtype"), undef);
+is(mapToScalar("uint32"), "uint32");
+is(mapToScalar({TYPE => "ENUM", PARENT => { PROPERTIES => { enum8bit => 1 } } }), "uint8");
+is(mapToScalar({TYPE => "BITMAP", PROPERTIES => { bitmap64bit => 1 } }),
+	"hyper");
+is(mapToScalar({TYPE => "TYPEDEF", DATA => {TYPE => "ENUM", PARENT => { PROPERTIES => { enum8bit => 1 } } }}), "uint8");
+
+my $t;
+$t = {
+	TYPE => "STRUCT",
+	NAME => "foo",
+	SURROUNDING_ELEMENT => undef,
+	ELEMENTS => undef,
+	PROPERTIES => undef,
+	ORIGINAL => {
+		TYPE => "STRUCT",
+		NAME => "foo"
+	},
+	ALIGN => undef
+};
+is_deeply(ParseType($t->{ORIGINAL}, "ref", 0), $t);
+
+$t = {
+	TYPE => "UNION",
+	NAME => "foo",
+	SWITCH_TYPE => "uint32",
+	ELEMENTS => undef,
+	PROPERTIES => undef,
+	HAS_DEFAULT => 0,
+	IS_MS_UNION => 0,
+	ORIGINAL => {
+		TYPE => "UNION",
+		NAME => "foo"
+	},
+	ALIGN => undef
+};
+is_deeply(ParseType($t->{ORIGINAL}, "ref", 0), $t);
+
+ok(not can_contain_deferred("uint32"));
+ok(can_contain_deferred("some_unknown_type"));
+ok(can_contain_deferred({ TYPE => "STRUCT", 
+		ELEMENTS => [ { TYPE => "uint32", POINTERS => 40 } ]}));
+ok(can_contain_deferred({ TYPE => "TYPEDEF", 
+			DATA => { TYPE => "STRUCT", 
+		ELEMENTS => [ { TYPE => "uint32", POINTERS => 40 } ]}}));
+ok(not can_contain_deferred({ TYPE => "STRUCT", 
+		ELEMENTS => [ { TYPE => "uint32" } ]}));
+ok(not can_contain_deferred({ TYPE => "TYPEDEF",
+			DATA => { TYPE => "STRUCT", 
+		ELEMENTS => [ { TYPE => "uint32" } ]}}));
+ok(can_contain_deferred({ TYPE => "STRUCT", 
+		ELEMENTS => [ { TYPE => "someunknowntype" } ]}));
+# Make sure the elements for a enum without body aren't filled in
+ok(not defined(ParseType({TYPE => "ENUM", NAME => "foo" }, "ref", 0)->{ELEMENTS}));
+# Make sure the elements for a bitmap without body aren't filled in
+ok(not defined(ParseType({TYPE => "BITMAP", NAME => "foo" }, "ref", 0)->{ELEMENTS}));
+# Make sure the elements for a union without body aren't filled in
+ok(not defined(ParseType({TYPE => "UNION", NAME => "foo" }, "ref", 0)->{ELEMENTS}));

pidl/tests/ndr_align.pl

@@ -0,0 +1,143 @@
+#!/usr/bin/perl
+# NDR alignment tests
+# (C) 2005 Jelmer Vernooij. Published under the GNU GPL
+use strict;
+
+use Test::More tests => 5 * 8;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util qw(test_samba4_ndr);
+
+test_samba4_ndr('align-uint8-uint16', 
+'
+	typedef [public] struct { 
+		uint8 x;
+		uint16 y;
+	} bla;
+',
+'
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct bla r;
+	uint8_t expected[] = { 0x0D, 0x00, 0xef, 0xbe };
+	DATA_BLOB expected_blob = { expected, 4 };
+	DATA_BLOB result_blob;
+	r.x = 13;
+	r.y = 0xbeef;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_bla(ndr, NDR_SCALARS|NDR_BUFFERS, &r)))
+		return 1;
+
+	result_blob = ndr_push_blob(ndr);
+	
+	if (data_blob_cmp(&result_blob, &expected_blob) != 0) 
+		return 2;
+');
+
+test_samba4_ndr('align-uint8-uint32', 
+'
+	typedef [public] struct { 
+		uint8 x;
+		uint32 y;
+	} bla;
+',
+'
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct bla r;
+	uint8_t expected[] = { 0x0D, 0x00, 0x00, 0x00, 0xef, 0xbe, 0xef, 0xbe };
+	DATA_BLOB expected_blob = { expected, 8 };
+	DATA_BLOB result_blob;
+	r.x = 13;
+	r.y = 0xbeefbeef;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_bla(ndr, NDR_SCALARS|NDR_BUFFERS, &r)))
+		return 1;
+
+	result_blob = ndr_push_blob(ndr);
+	
+	if (data_blob_cmp(&result_blob, &expected_blob) != 0) 
+		return 2;
+');
+
+
+test_samba4_ndr('align-uint8-hyper', 
+'
+	typedef [public] struct { 
+		uint8 x;
+		hyper y;
+	} bla;
+',
+'
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct bla r;
+	uint8_t expected[] = { 0x0D, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 
+			       0xef, 0xbe, 0xef, 0xbe, 0xef, 0xbe, 0xef, 0xbe };
+	DATA_BLOB expected_blob = { expected, 16 };
+	DATA_BLOB result_blob;
+	r.x = 13;
+	r.y = 0xbeefbeefbeefbeefLLU;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_bla(ndr, NDR_SCALARS|NDR_BUFFERS, &r)))
+		return 1;
+
+	result_blob = ndr_push_blob(ndr);
+	
+	if (data_blob_cmp(&result_blob, &expected_blob) != 0) 
+		return 2;
+');
+
+test_samba4_ndr('noalignflag-uint8-uint16', 
+'
+	typedef [public] struct { 
+		uint8 x;
+		uint16 y;
+	} bla;
+',
+'
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct bla r;
+	uint8_t expected[] = { 0x0D, 0xef, 0xbe };
+	DATA_BLOB expected_blob = { expected, 3 };
+	DATA_BLOB result_blob;
+	ndr->flags |= LIBNDR_FLAG_NOALIGN;
+
+	r.x = 13;
+	r.y = 0xbeef;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_bla(ndr, NDR_SCALARS|NDR_BUFFERS, &r)))
+		return 1;
+
+	result_blob = ndr_push_blob(ndr);
+	
+	if (data_blob_cmp(&result_blob, &expected_blob) != 0) 
+		return 2;
+');
+
+test_samba4_ndr('align-blob-align2', 
+'
+	typedef [public] struct { 
+		uint8 x;
+		[flag(LIBNDR_FLAG_ALIGN2)] DATA_BLOB data;
+		uint8 y;
+	} blie;
+',
+'
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct blie r;
+	uint8_t data[] = { 0x01, 0x02 };
+	uint8_t expected[] = { 0x0D, 0x00, 0x0E };
+	DATA_BLOB expected_blob = { expected, 3 };
+	DATA_BLOB result_blob;
+
+	r.x = 13;
+	r.y = 14;
+	r.data.data = data;
+	r.data.length = 2;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_blie(ndr, NDR_SCALARS|NDR_BUFFERS, &r)))
+		return 1;
+
+	result_blob = ndr_push_blob(ndr);
+
+	if (data_blob_cmp(&result_blob, &expected_blob) != 0) 
+		return 2;
+');

pidl/tests/ndr_alloc.pl

@@ -0,0 +1,118 @@
+#!/usr/bin/perl
+# NDR allocation tests
+# (C) 2005 Jelmer Vernooij. Published under the GNU GPL
+use strict;
+
+use Test::More tests => 5 * 8;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util qw(test_samba4_ndr);
+
+# Check that an outgoing scalar pointer is allocated correctly
+
+test_samba4_ndr("alloc-scalar", 
+'	
+	typedef struct {
+		uint8 *x;
+	} bla;
+	
+	[public] void TestAlloc([in] bla foo);
+','
+	uint8_t data[] = { 0xde, 0xad, 0xbe, 0xef, 0x03 };
+	DATA_BLOB b = { data, 5 };
+	struct ndr_pull *ndr = ndr_pull_init_blob(&b, NULL, NULL);
+	struct TestAlloc r;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_pull_TestAlloc(ndr, NDR_IN, &r)))
+		return 1;
+
+	if (r.in.foo.x == NULL)
+		return 2;
+	
+	if (*r.in.foo.x != 0x03)
+		return 3;
+'
+);
+
+# Check that an outgoing buffer pointer is allocated correctly
+test_samba4_ndr("alloc-buffer", 
+'	
+	typedef struct { uint8 data; } blie;
+	typedef struct { blie *x; } bla; 
+
+	[public] void TestAlloc([in] bla foo);
+','
+	uint8_t data[] = { 0xde, 0xad, 0xbe, 0xef, 0x03 };
+	DATA_BLOB b = { data, 5 };
+	struct ndr_pull *ndr = ndr_pull_init_blob(&b, NULL, NULL);
+	struct TestAlloc r;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_pull_TestAlloc(ndr, NDR_IN, &r)))
+		return 1;
+
+	if (r.in.foo.x == NULL)
+		return 2;
+	
+	if (r.in.foo.x->data != 0x03)
+		return 3;
+'
+);
+
+# Check that ref pointers aren't allocated by default
+test_samba4_ndr("ref-noalloc-null", 
+'	
+	[public] void TestAlloc([in,ref] uint8 *t);
+','
+	uint8_t data[] = { 0x03 };
+	DATA_BLOB b = { data, 1 };
+	struct ndr_pull *ndr = ndr_pull_init_blob(&b, NULL, NULL);
+	struct TestAlloc r;
+	r.in.t = NULL;
+
+	if (NDR_ERR_CODE_IS_SUCCESS(ndr_pull_TestAlloc(ndr, NDR_IN, &r)))
+		return 1;
+'
+);
+
+# Check that ref pointers aren't allocated by default
+test_samba4_ndr("ref-noalloc", 
+'	
+	[public] void TestAlloc([in,ref] uint8 *t);
+','
+	uint8_t data[] = { 0x03 };
+	DATA_BLOB b = { data, 1 };
+	struct ndr_pull *ndr = ndr_pull_init_blob(&b, NULL, NULL);
+	struct TestAlloc r;
+	uint8_t x;
+	r.in.t = &x;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_pull_TestAlloc(ndr, NDR_IN, &r)))
+		return 1;
+
+	if (*r.in.t != 0x03)
+		return 2;
+'
+);
+
+# Check that an outgoing ref pointer is allocated correctly
+test_samba4_ndr("ref-alloc", 
+'	
+	[public] void TestAlloc([in,ref] uint8 *t);
+','
+	uint8_t data[] = { 0x03 };
+	DATA_BLOB b = { data, 1 };
+	struct ndr_pull *ndr = ndr_pull_init_blob(&b, NULL, NULL);
+	struct TestAlloc r;
+	ndr->flags |= LIBNDR_FLAG_REF_ALLOC;
+	r.in.t = NULL;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_pull_TestAlloc(ndr, NDR_IN, &r)))
+		return 1;
+
+	if (r.in.t == NULL)
+		return 2;
+
+	if (*r.in.t != 0x03)
+		return 3;
+'
+);

pidl/tests/ndr_array.pl

@@ -0,0 +1,37 @@
+#!/usr/bin/perl
+# Array testing
+# (C) 2005 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU General Public License
+use strict;
+
+use Test::More tests => 8;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util qw(test_samba4_ndr);
+
+test_samba4_ndr(
+	'Fixed-Array',
+	
+	'[public] void Test([in] uint8 x[10]);',
+	
+	'
+	uint8_t data[] = {1,2,3,4,5,6,7,8,9,10};
+	int i;
+	DATA_BLOB b;
+	struct ndr_pull *ndr;
+	struct Test r;
+
+	b.data = data;
+	b.length = 10;
+	ndr = ndr_pull_init_blob(&b, mem_ctx, NULL);
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_pull_Test(ndr, NDR_IN, &r)))
+		return 1;
+
+	if (ndr->offset != 10)
+		return 2;
+	
+	for (i = 0; i < 10; i++) {
+		if (r.in.x[i] != i+1) return 3;
+	}
+');

pidl/tests/ndr_compat.pl

@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+# (C) 2007 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU General Public License
+use strict;
+
+use Test::More tests => 2;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util; 
+use Parse::Pidl;
+use Parse::Pidl::IDL;
+
+sub parse_idl($) 
+{
+	my $idl = shift;
+	my $pidl = Parse::Pidl::IDL::parse_string("interface echo { $idl }; ", "nofile");
+	Parse::Pidl::NDR::Parse($pidl);
+}
+
+test_warnings("", sub {parse_idl("void x();"); });
+test_warnings("nofile:0: top-level [out] pointer `x' is not a [ref] pointer\n", sub {parse_idl("void x([out,unique] int *x);"); });

pidl/tests/ndr_deprecations.pl

@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+# (C) 2007 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU General Public License
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util;
+use Parse::Pidl::Util qw(MyDumper);
+use Parse::Pidl::NDR qw(ValidElement);
+
+# Case 1
+
+my $e = {
+	'FILE' => 'foo.idl',
+	'NAME' => 'v',
+	'PROPERTIES' => {"subcontext" => 1},
+	'POINTERS' => 0,
+	'TYPE' => 'uint8',
+	'PARENT' => { TYPE => 'STRUCT' },
+	'LINE' => 42 };
+
+test_warnings("foo.idl:42: subcontext() is deprecated. Use represent_as() or transmit_as() instead\n", 
+	sub { ValidElement($e); });

pidl/tests/ndr_fullptr.pl

@@ -0,0 +1,44 @@
+#!/usr/bin/perl
+# Simple tests for unique pointers
+# (C) 2006 Jelmer Vernooij <jelmer@samba.org>.
+# Published under the GNU General Public License.
+use strict;
+
+use Test::More tests => 1 * 8;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util qw(test_samba4_ndr);
+
+SKIP: {
+	skip "full pointers not supported yet", 8;
+
+test_samba4_ndr("fullptr-push-dup", 
+'	
+	[public] uint16 echo_TestFull([in,ptr] uint32 *x, [in,ptr] uint32 *y);
+',
+'
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	uint32_t v = 13;
+	struct echo_TestFull r;
+	r.in.x = &v; 
+	r.in.y = &v; 
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_echo_TestFull(ndr, NDR_IN, &r))) {
+		fprintf(stderr, "push failed\n");
+		return 1;
+	}
+
+	if (ndr->offset != 12) {
+		fprintf(stderr, "Offset(%d) != 12\n", ndr->offset);
+		return 2;
+	}
+
+	if (ndr->data[0] != ndr->data[8] || 
+	    ndr->data[1] != ndr->data[9] ||
+		ndr->data[2] != ndr->data[10] ||
+		ndr->data[3] != ndr->data[11]) {
+		fprintf(stderr, "Data incorrect\n");
+		return 3;
+	}
+');
+}

pidl/tests/ndr_refptr.pl

@@ -0,0 +1,526 @@
+#!/usr/bin/perl
+# Simple tests for pidl's handling of ref pointers, based
+# on tridge's ref_notes.txt
+# (C) 2005 Jelmer Vernooij <jelmer@samba.org>.
+# Published under the GNU General Public License.
+use strict;
+
+use Test::More tests => 22 * 8;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util qw(test_samba4_ndr);
+
+test_samba4_ndr("noptr-push", 
+'	typedef struct {
+		uint16 x;
+	} xstruct;
+
+	[public] uint16 echo_TestRef([in] xstruct foo);
+',
+'
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	uint16_t v = 13;
+	struct echo_TestRef r;
+	r.in.foo.x = v; 
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_echo_TestRef(ndr, NDR_IN, &r))) {
+		fprintf(stderr, "push failed\n");
+		return 1;
+	}
+
+	if (ndr->offset != 2) {
+		fprintf(stderr, "Offset(%d) != 2\n", ndr->offset);
+		return 2;
+	}
+
+	if (ndr->data[0] != 13 || ndr->data[1] != 0) {
+		fprintf(stderr, "Data incorrect\n");
+		return 3;
+	}
+');
+
+test_samba4_ndr("ptr-embedded-push", 
+'   typedef struct {
+		uint16 *x;
+	} xstruct;
+
+	[public] uint16 echo_TestRef([in] xstruct foo);
+',
+'
+	uint16_t v = 13;
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct echo_TestRef r;
+	r.in.foo.x = &v; 
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_echo_TestRef(ndr, NDR_IN, &r)))
+		return 1;
+
+	if (ndr->offset != 6)
+		return 2;
+
+	if (ndr->data[0] == 0 && ndr->data[1] == 0 && 
+	    ndr->data[2] == 0 && ndr->data[3] == 0)
+		return 3;
+
+	if (ndr->data[4] != 13 || ndr->data[5] != 0)
+		return 4;
+');
+
+test_samba4_ndr("ptr-embedded-push-null", 
+'   typedef struct {
+		uint16 *x;
+	} xstruct;
+
+	[public] uint16 echo_TestRef([in] xstruct foo);
+',
+'
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct echo_TestRef r;
+	r.in.foo.x = NULL; 
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_echo_TestRef(ndr, NDR_IN, &r)))
+		return 1;
+
+	if (ndr->offset != 4)
+		return 2;
+
+	if (ndr->data[0] != 0 || ndr->data[1] != 0 || 
+	    ndr->data[2] != 0 || ndr->data[3] != 0)
+		return 3;
+');
+
+test_samba4_ndr("refptr-embedded-push", 
+'
+	typedef struct {
+		[ref] uint16 *x;
+	} xstruct;
+
+	[public] uint16 echo_TestRef([in] xstruct foo);
+',
+'
+	uint16_t v = 13;
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct echo_TestRef r;
+	r.in.foo.x = &v; 
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_echo_TestRef(ndr, NDR_IN, &r)))
+		return 1;
+
+	if (ndr->offset != 6)
+		return 2;
+
+	if (ndr->data[0] == 0 && ndr->data[1] == 0 && 
+	    ndr->data[2] == 0 && ndr->data[3] == 0)
+		return 3;
+
+	if (ndr->data[4] != 13 || ndr->data[5] != 0)
+		return 4;
+');
+
+test_samba4_ndr("refptr-embedded-push-null", 
+'
+	typedef struct {
+		[ref] uint16 *x;
+	} xstruct;
+
+	[public] uint16 echo_TestRef([in] xstruct foo);
+',
+'
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct echo_TestRef r;
+	r.in.foo.x = NULL; 
+
+	if (NDR_ERR_CODE_IS_SUCCESS(ndr_push_echo_TestRef(ndr, NDR_IN, &r)))
+		return 1;
+	/* Windows gives [client runtime error 0x6f4] */
+');
+
+test_samba4_ndr("ptr-top-push", 
+'
+	typedef struct {
+		uint16 x;
+	} xstruct;
+
+	[public] uint16 echo_TestRef([in] xstruct *foo);
+',
+'
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct echo_TestRef r;
+	struct xstruct s;
+	s.x = 13;
+	r.in.foo = &s;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_echo_TestRef(ndr, NDR_IN, &r)))
+		return 1;
+
+	if (ndr->offset != 2)
+		return 2;
+
+	if (ndr->data[0] != 13 || ndr->data[1] != 0)
+		return 3;
+');
+
+test_samba4_ndr("ptr-top-push-null", 
+'
+	typedef struct {
+		uint16 x;
+	} xstruct;
+
+	[public] uint16 echo_TestRef([in] xstruct *foo);
+',
+'
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct echo_TestRef r;
+	r.in.foo = NULL;
+
+	if (NDR_ERR_CODE_IS_SUCCESS(ndr_push_echo_TestRef(ndr, NDR_IN, &r)))
+		return 1;
+
+	/* Windows gives [client runtime error 0x6f4] */
+');
+
+
+test_samba4_ndr("refptr-top-push", 
+'
+	typedef struct {
+		uint16 x;
+	} xstruct;
+
+	[public] uint16 echo_TestRef([in,ref] xstruct *foo);
+',
+'
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct echo_TestRef r;
+	struct xstruct s;
+	s.x = 13;
+	r.in.foo = &s;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_echo_TestRef(ndr, NDR_IN, &r)))
+		return 1;
+
+	if (ndr->offset != 2)
+		return 2;
+
+	if (ndr->data[0] != 13 || ndr->data[1] != 0)
+		return 3;
+');
+
+test_samba4_ndr("refptr-top-push-null", 
+'
+	typedef struct {
+		uint16 x;
+	} xstruct;
+
+	[public] uint16 echo_TestRef([in,ref] xstruct *foo);
+',
+'
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct echo_TestRef r;
+	r.in.foo = NULL;
+
+	if (NDR_ERR_CODE_IS_SUCCESS(ndr_push_echo_TestRef(ndr, NDR_IN, &r)))
+		return 1;
+
+	/* Windows gives [client runtime error 0x6f4] */
+');
+
+
+test_samba4_ndr("uniqueptr-top-push", 
+'	typedef struct {
+		uint16 x;
+	} xstruct;
+
+	[public] uint16 echo_TestRef([in,unique] xstruct *foo);
+',
+'
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct echo_TestRef r;
+	struct xstruct s;
+	s.x = 13;
+	r.in.foo = &s;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_echo_TestRef(ndr, NDR_IN, &r)))
+		return 1;
+
+	if (ndr->offset != 6)
+		return 2;
+
+	if (ndr->data[0] == 0 && ndr->data[1] == 0 && 
+	    ndr->data[2] == 0 && ndr->data[3] == 0)
+		return 3;
+
+	if (ndr->data[4] != 13 || ndr->data[5] != 0)
+		return 4;
+');
+
+test_samba4_ndr("uniqueptr-top-push-null", 
+'	typedef struct {
+		uint16 x;
+	} xstruct;
+
+	[public] uint16 echo_TestRef([in,unique] xstruct *foo);
+',
+'
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct echo_TestRef r;
+	r.in.foo = NULL;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_echo_TestRef(ndr, NDR_IN, &r)))
+		return 1;
+
+	if (ndr->offset != 4)
+		return 2;
+
+	if (ndr->data[0] != 0 || ndr->data[1] != 0 || 
+	    ndr->data[2] != 0 || ndr->data[3] != 0)
+		return 3;
+');
+
+
+test_samba4_ndr("ptr-top-out-pull", 
+'
+	typedef struct {
+		uint16 x;
+	} xstruct;
+
+	[public] void echo_TestRef([out] xstruct *foo);
+',
+'
+	uint8_t data[] = { 0x0D, 0x00 };
+	DATA_BLOB b = { data, 2 };
+	struct ndr_pull *ndr = ndr_pull_init_blob(&b, NULL, NULL);
+	struct xstruct s;
+	struct echo_TestRef r;
+
+	r.out.foo = &s;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_pull_echo_TestRef(ndr, NDR_OUT, &r)))
+		return 1;
+
+	if (!r.out.foo)
+		return 2;
+
+	if (r.out.foo->x != 13)
+		return 3;
+');	
+
+test_samba4_ndr("ptr-top-out-pull-null", 
+'
+	typedef struct {
+		uint16 x;
+	} xstruct;
+
+	[public] void echo_TestRef([out] xstruct *foo);
+',
+'
+	uint8_t data[] = { 0x0D, 0x00 };
+	DATA_BLOB b = { data, 2 };
+	struct ndr_pull *ndr = ndr_pull_init_blob(&b, NULL, NULL);
+	struct echo_TestRef r;
+
+	r.out.foo = NULL;
+
+	if (NDR_ERR_CODE_IS_SUCCESS(ndr_pull_echo_TestRef(ndr, NDR_OUT, &r)))
+		return 1;
+	
+	/* Windows gives [client runtime error 0x6f4] */
+');
+
+
+test_samba4_ndr("refptr-top-out-pull", 
+'
+	typedef struct {
+		uint16 x;
+	} xstruct;
+
+	[public] void echo_TestRef([out,ref] xstruct *foo);
+',
+'
+	uint8_t data[] = { 0x0D, 0x00 };
+	DATA_BLOB b = { data, 2 };
+	struct ndr_pull *ndr = ndr_pull_init_blob(&b, NULL, NULL);
+	struct xstruct s;
+	struct echo_TestRef r;
+
+	r.out.foo = &s;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_pull_echo_TestRef(ndr, NDR_OUT, &r)))
+		return 1;
+
+	if (!r.out.foo)
+		return 2;
+
+	if (r.out.foo->x != 13)
+		return 3;
+');	
+
+test_samba4_ndr("refptr-top-out-pull-null", 
+'
+	typedef struct {
+		uint16 x;
+	} xstruct;
+
+	[public] void echo_TestRef([out,ref] xstruct *foo);
+',
+'
+	uint8_t data[] = { 0x0D, 0x00 };
+	DATA_BLOB b = { data, 2 };
+	struct ndr_pull *ndr = ndr_pull_init_blob(&b, NULL, NULL);
+	struct echo_TestRef r;
+
+	r.out.foo = NULL;
+
+	if (NDR_ERR_CODE_IS_SUCCESS(ndr_pull_echo_TestRef(ndr, NDR_OUT, &r)))
+		return 1;
+	
+	/* Windows gives [client runtime error 0x6f4] */
+');
+
+
+test_samba4_ndr("ptr-top-push-double", 
+'
+	[public] void echo_TestRef([in] uint16 **foo);
+',
+'	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct echo_TestRef r;
+	uint16_t v = 13;
+	uint16_t *pv = &v;
+	r.in.foo = &pv;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_echo_TestRef(ndr, NDR_IN, &r)))
+		return 1;
+
+	if (ndr->offset != 6)
+		return 2;
+
+	if (ndr->data[0] == 0 && ndr->data[1] == 0 && 
+	    ndr->data[2] == 0 && ndr->data[3] == 0)
+		return 3;
+
+	if (ndr->data[4] != 0x0D || ndr->data[5] != 0x00)
+		return 4;
+');
+
+SKIP: {
+	skip "ptr-top-push-double-sndnull is known to fail", 8;
+
+test_samba4_ndr("ptr-top-push-double-sndnull", 
+'
+	[public] void echo_TestRef([in] uint16 **foo);
+',
+'	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct echo_TestRef r;
+	uint16_t *pv = NULL;
+	r.in.foo = &pv;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_echo_TestRef(ndr, NDR_IN, &r)))
+		return 1;
+
+	if (ndr->offset != 4)
+		return 2;
+
+	if (ndr->data[0] != 0 || ndr->data[1] != 0 || 
+	    ndr->data[2] != 0 || ndr->data[3] != 0)
+		return 3;
+');
+}
+
+test_samba4_ndr("ptr-top-push-double-fstnull", 
+'
+	[public] void echo_TestRef([in] uint16 **foo);
+',
+'	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct echo_TestRef r;
+	r.in.foo = NULL;
+
+	if (NDR_ERR_CODE_IS_SUCCESS(ndr_push_echo_TestRef(ndr, NDR_IN, &r)))
+		return 1;
+	
+	/* Windows gives [client runtime error 0x6f4] */
+
+');
+
+
+test_samba4_ndr("refptr-top-push-double", 
+'
+	[public] void echo_TestRef([in,ref] uint16 **foo);
+',
+'	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct echo_TestRef r;
+	uint16_t v = 13;
+	uint16_t *pv = &v;
+	r.in.foo = &pv;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_echo_TestRef(ndr, NDR_IN, &r)))
+		return 1;
+
+	if (ndr->offset != 6)
+		return 2;
+
+	if (ndr->data[0] == 0 && ndr->data[1] == 0 && 
+	    ndr->data[2] == 0 && ndr->data[3] == 0)
+		return 3;
+
+	if (ndr->data[4] != 0x0D || ndr->data[5] != 0x00)
+		return 4;
+');
+
+SKIP: {
+
+	skip "refptr-top-push-double-sndnull is known to fail", 8;
+
+test_samba4_ndr("refptr-top-push-double-sndnull", 
+'
+	[public] void echo_TestRef([in,ref] uint16 **foo);
+',
+'	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct echo_TestRef r;
+	uint16_t *pv = NULL;
+	r.in.foo = &pv;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_echo_TestRef(ndr, NDR_IN, &r)))
+		return 1;
+
+	if (ndr->offset != 4)
+		return 2;
+
+	if (ndr->data[0] != 0 || ndr->data[1] != 0 || 
+	    ndr->data[2] != 0 || ndr->data[3] != 0)
+		return 3;
+');
+}
+
+test_samba4_ndr("refptr-top-push-double-fstnull", 
+'
+	[public] void echo_TestRef([in,ref] uint16 **foo);
+',
+'	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct echo_TestRef r;
+	r.in.foo = NULL;
+
+	if (NDR_ERR_CODE_IS_SUCCESS(ndr_push_echo_TestRef(ndr, NDR_IN, &r)))
+		return 1;
+	
+	/* Windows gives [client runtime error 0x6f4] */
+
+');
+
+SKIP: {
+	skip "ignore-ptrs are not supported yet", 8;
+test_samba4_ndr("ignore-ptr", 
+'
+	[public] void echo_TestRef([in,ignore] uint16 *foo, [in] uint16 *bar);
+',
+'	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct echo_TestRef r;
+	uint16_t v = 10;
+	r.in.foo = &v; 
+	r.in.bar = &v;
+
+	if (NDR_ERR_CODE_IS_SUCCESS(ndr_push_echo_TestRef(ndr, NDR_IN, &r)))
+		return 1;
+
+	if (ndr->offset != 4)
+		return 2;
+');
+}

pidl/tests/ndr_represent.pl

@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+# NDR represent_as() / transmit_as() tests
+# (C) 2006 Jelmer Vernooij. Published under the GNU GPL
+use strict;
+
+use Test::More tests => 2 * 8;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util qw(test_samba4_ndr);
+
+test_samba4_ndr('represent_as-simple', 
+'
+	void bla([in,represent_as(uint32)] uint8 x);
+',
+'
+	uint8_t expected[] = { 0x0D };
+	DATA_BLOB in_blob = { expected, 1 };
+	struct ndr_pull *ndr = ndr_pull_init_blob(&in_blob, NULL, NULL);
+	struct bla r;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_pull_bla(ndr, NDR_SCALARS|NDR_BUFFERS, &r)))
+		return 1;
+
+	if (r.in.x != 13)
+		return 2;
+',
+'
+enum ndr_err_code ndr_uint8_to_uint32(uint8_t from, uint32_t *to)
+{
+	*to = from;
+	return NDR_ERR_SUCCESS;
+}
+
+enum ndr_err_code ndr_uint32_to_uint8(uint32_t from, uint8_t *to)
+{
+	*to = from;
+	return NDR_ERR_SUCCESS;
+}
+'
+);
+
+test_samba4_ndr('transmit_as-simple', 
+'
+	void bla([in,transmit_as(uint32)] uint8 x);
+',
+'
+	uint8_t expected[] = { 0x0D };
+	DATA_BLOB in_blob = { expected, 1 };
+	struct ndr_pull *ndr = ndr_pull_init_blob(&in_blob, NULL, NULL);
+	struct bla r;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_pull_bla(ndr, NDR_SCALARS|NDR_BUFFERS, &r)))
+		return 1;
+
+	if (r.in.x != 13)
+		return 2;
+',
+'
+enum ndr_err_code ndr_uint8_to_uint32(uint8_t from, uint32_t *to)
+{
+	*to = from;
+	return NDR_ERR_SUCCESS;
+}
+
+enum ndr_err_code ndr_uint32_to_uint8(uint32_t from, uint8_t *to)
+{
+	*to = from;
+	return NDR_ERR_SUCCESS;
+}
+'
+);

pidl/tests/ndr_simple.pl

@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+# Some simple tests for pidl
+# (C) 2005 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU General Public License
+use strict;
+
+use Test::More tests => 8;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util qw(test_samba4_ndr);
+
+test_samba4_ndr("simple", "void Test(); ",
+"
+	uint8_t data[] = { 0x02 };
+	uint8_t result;
+	DATA_BLOB b;
+	struct ndr_pull *ndr;
+
+	b.data = data;
+	b.length = 1;
+	ndr = ndr_pull_init_blob(&b, mem_ctx, NULL);
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_pull_uint8(ndr, NDR_SCALARS, &result)))
+		return 1;
+
+	if (result != 0x02)
+		return 2;
+");

pidl/tests/ndr_string.pl

@@ -0,0 +1,192 @@
+#!/usr/bin/perl
+# String tests for pidl
+# (C) 2005 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU General Public License
+use strict;
+
+use Test::More tests => 6 * 8;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util qw(test_samba4_ndr);
+
+test_samba4_ndr("string-pull-empty", 
+' [public] void TestString([in,flag(STR_ASCII|LIBNDR_FLAG_STR_SIZE4)] string data);',
+'
+	uint8_t data[] = { 0x00, 0x00, 0x00, 0x00 };
+	DATA_BLOB b = { data, 4 };
+	struct ndr_pull *ndr = ndr_pull_init_blob(&b, NULL);
+	struct TestString r;
+	r.in.data = NULL;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_pull_TestString(ndr, NDR_IN, &r)))
+		return 1;
+	
+	if (r.in.data == NULL)
+		return 2;
+
+	if (r.in.data[0] != 0)
+		return 3;
+');
+
+test_samba4_ndr("string-ascii-pull", 
+'
+	[public] void TestString([in,flag(STR_ASCII|LIBNDR_FLAG_STR_SIZE4)] string data);
+',
+'
+	uint8_t data[] = { 0x03, 0x00, 0x00, 0x00, 
+					   \'f\', \'o\', \'o\', 0 };
+	DATA_BLOB b = { data, 8 };
+	struct ndr_pull *ndr = ndr_pull_init_blob(&b, NULL);
+	struct TestString r;
+	r.in.data = NULL;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_pull_TestString(ndr, NDR_IN, &r)))
+		return 1;
+	
+	if (r.in.data == NULL)
+		return 2;
+
+	if (strncmp(r.in.data, "foo", 3) != 0)
+		return 3;
+
+	if (r.in.data[4] != 0)
+		return 4;
+');
+
+test_samba4_ndr("string-wchar-fixed-array-01",
+'
+	typedef struct {
+		uint32 l1;
+		[string,charset(UTF16)] uint16 str[6];
+		uint32 l2;
+	} TestStringStruct;
+
+	[public] void TestString([in,ref] TestStringStruct *str);
+',
+'
+	uint8_t data[] = { 0x01,  0x00, 0x00,  0x00,
+			   0x00,  0x00, 0x00,  0x00,
+			   0x04,  0x00, 0x00,  0x00,
+			   \'f\', 0x00, \'o\', 0x00,
+			   \'o\', 0x00, 0x00,  0x00,
+			   0x02,  0x00, 0x00,  0x00
+	};
+	DATA_BLOB b = { data, sizeof(data) };
+	struct ndr_pull *ndr = ndr_pull_init_blob(&b, NULL);
+	struct TestString r;
+	struct TestStringStruct str;
+	r.in.str = &str;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_pull_TestString(ndr, NDR_IN, &r)))
+		return 1;
+
+	if (r.in.str == NULL)
+		return 2;
+
+	if (r.in.str->l1 != 0x00000001)
+		return 3;
+
+	if (strncmp(str.str, "foo", 3) != 0)
+		return 4;
+
+	if (r.in.str->str[4] != 0)
+		return 5;
+
+	if (r.in.str->l2 != 0x00000002)
+		return 6;
+');
+
+test_samba4_ndr("string-wchar-fixed-array-02",
+'
+	typedef struct {
+		uint32 l1;
+		[string,charset(UTF16)] uint16 str[6];
+		uint32 l2;
+	} TestStringStruct;
+
+	[public] void TestString([in,ref] TestStringStruct *str);
+',
+'
+	uint8_t data[] = { 0x01,  0x00, 0x00,  0x00,
+			   0x00,  0x00, 0x00,  0x00,
+			   0x06,  0x00, 0x00,  0x00,
+			   \'f\', 0x00, \'o\', 0x00,
+			   \'o\', 0x00, \'b\', 0x00,
+			   \'a\', 0x00, \'r\', 0x00,
+			   0x00,  0x00, 0x00,  0x00,
+			   0x02,  0x00, 0x00,  0x00
+	};
+	DATA_BLOB b = { data, sizeof(data) };
+	struct ndr_pull *ndr = ndr_pull_init_blob(&b, NULL);
+	struct TestString r;
+	struct TestStringStruct str;
+	r.in.str = &str;
+
+	/* the string terminator is wrong */
+	if (NDR_ERR_CODE_IS_SUCCESS(ndr_pull_TestString(ndr, NDR_IN, &r)))
+		return 1;
+');
+
+test_samba4_ndr("string-wchar-fixed-array-03",
+'
+	typedef struct {
+		uint32 l1;
+		[string,charset(UTF16)] uint16 str[6];
+		uint32 l2;
+	} TestStringStruct;
+
+	[public] void TestString([in,ref] TestStringStruct *str);
+',
+'
+	uint8_t data[] = { 0x01,  0x00, 0x00,  0x00,
+			   0x00,  0x00, 0x00,  0x00,
+			   0x07,  0x00, 0x00,  0x00,
+			   \'f\', 0x00, \'o\', 0x00,
+			   \'o\', 0x00, \'b\', 0x00,
+			   \'a\', 0x00, \'r\', 0x00,
+			   0x00,  0x00, 0x00,  0x00,
+			   0x02,  0x00, 0x00,  0x00
+	};
+	DATA_BLOB b = { data, sizeof(data) };
+	struct ndr_pull *ndr = ndr_pull_init_blob(&b, NULL);
+	struct TestString r;
+	struct TestStringStruct str;
+	r.in.str = &str;
+
+	/* the length 0x07 is to large */
+	if (NDR_ERR_CODE_IS_SUCCESS(ndr_pull_TestString(ndr, NDR_IN, &r)))
+		return 1;
+');
+
+SKIP: {
+	skip "doesn't seem to work yet", 8;
+
+test_samba4_ndr("string-out", 
+'
+	[public] void TestString([out,string,charset(UNIX)] uint8 **data);
+',
+'
+	uint8_t data[] = { 0x03, 0x00, 0x00, 0x00, 
+					   \'f\', \'o\', \'o\', 0 };
+	DATA_BLOB b = { data, 8 };
+	struct ndr_pull *ndr = ndr_pull_init_blob(&b, NULL);
+	struct TestString r;
+	char *str = NULL;
+	r.out.data = &str;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_pull_TestString(ndr, NDR_IN, &r)))
+		return 1;
+
+	if (r.out.data == NULL)
+		return 2;
+
+	if (*r.out.data == NULL)
+		return 3;
+
+	if (strncmp(r.out.data, "foo", 3) != 0)
+		return 4;
+
+	if (r.out.data[4] != 0)
+		return 5;
+');
+}

pidl/tests/ndr_tagtype.pl

@@ -0,0 +1,66 @@
+#!/usr/bin/perl
+# Support for tagged types
+# (C) 2005 Jelmer Vernooij. Published under the GNU GPL
+use strict;
+
+use Test::More tests => 3 * 8;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util qw(test_samba4_ndr);
+
+test_samba4_ndr('struct-notypedef', '[public] struct bla { uint8 x; }; ',
+'
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct bla r;
+	uint8_t expected[] = { 0x0D };
+	DATA_BLOB expected_blob = { expected, 1 };
+	DATA_BLOB result_blob;
+	r.x = 13;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_STRUCT_bla(ndr, NDR_SCALARS|NDR_BUFFERS, &r)))
+		return 1;
+
+	result_blob = ndr_push_blob(ndr);
+	
+	if (data_blob_cmp(&result_blob, &expected_blob) != 0) 
+		return 2;
+');
+
+test_samba4_ndr('struct-notypedef-used', '[public] struct bla { uint8 x; };
+	[public] void myfn([in] struct bla r); ',
+'
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct myfn fn;
+	uint8_t expected[] = { 0x0D };
+	DATA_BLOB expected_blob = { expected, 1 };
+	DATA_BLOB result_blob;
+	fn.in.r.x = 13;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_myfn(ndr, NDR_IN, &fn)))
+		return 1;
+
+	result_blob = ndr_push_blob(ndr);
+	
+	if (data_blob_cmp(&result_blob, &expected_blob) != 0) 
+		return 2;
+');
+
+
+test_samba4_ndr('struct-notypedef-embedded', 'struct bla { uint8 x; };
+	[public] struct myst { struct bla r; }; ',
+'
+	struct ndr_push *ndr = ndr_push_init_ctx(NULL, NULL);
+	struct myst st;
+	uint8_t expected[] = { 0x0D };
+	DATA_BLOB expected_blob = { expected, 1 };
+	DATA_BLOB result_blob;
+	st.r.x = 13;
+
+	if (!NDR_ERR_CODE_IS_SUCCESS(ndr_push_STRUCT_myst(ndr, NDR_IN, &st)))
+		return 1;
+
+	result_blob = ndr_push_blob(ndr);
+	
+	if (data_blob_cmp(&result_blob, &expected_blob) != 0) 
+		return 2;
+');

pidl/tests/parse_idl.pl

@@ -0,0 +1,243 @@
+#!/usr/bin/perl
+# Some simple tests for pidls parsing routines
+# (C) 2005 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU General Public License
+use strict;
+
+use Test::More tests => 65 * 2 + 7;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util qw(test_errors);
+use Parse::Pidl::IDL;
+use Parse::Pidl::NDR;
+
+sub testok($$)
+{
+	my ($name, $data) = @_;
+	
+	test_errors("", sub {
+		my $pidl = Parse::Pidl::IDL::parse_string($data, "<$name>");
+		ok (defined($pidl), $name);
+	});
+}
+
+sub testfail($$$)
+{
+	my ($name, $data, $error) = @_;
+	
+	test_errors($error, sub {
+		my $pidl = Parse::Pidl::IDL::parse_string($data, "<$name>");
+	
+		ok ((not defined $pidl), $name);
+	});
+}
+
+testfail "unknowntag", "bla test {};", 
+         "<unknowntag>:0: Syntax error near 'bla'\n";
+testok "test1", "interface test { void Test(); }; ";
+testok "voidtest", "interface test { int Testx(void); }; ";
+testfail "voidtest", "interface test { Test(); }; ", 
+         "<voidtest>:0: Syntax error near '('\n";
+testok "argtest", "interface test { int Test(int a, long b, uint32 c); }; ";
+testok "array1", "interface test { int Test(int a[]); };";
+testok "array2", "interface test { int Test(int a[2]); };";
+testok "array3", "interface test { int Test(int a[b]); };";
+testfail "array4", "interface test { int Test(int[] a); };", 
+         "<array4>:0: Syntax error near '['\n";
+testok "ptr1", "interface test { int Test(int *a); };";
+testok "ptr2", "interface test { int Test(int **a); };";
+testok "ptr3", "interface test { int Test(int ***a); };";
+testfail "empty1", "interface test { };", "<empty1>:0: Syntax error near '}'\n";
+testfail "empty2", "", "";
+testok "attr1", "[uuid(\"myuuid\"),attr] interface test { int Test(int ***a); };";
+testok "attr2", "interface test { [public] int Test(); };";
+testok "attr3", "[attr1] [attr2] interface test { [public] int Test(); };";
+testok "multfn", "interface test { int test1(); int test2(); };";
+testok "multif", "interface test { int test1(); }; interface test2 { int test2(); };";
+testok "tdstruct1", "interface test { typedef struct { } foo; };";
+testok "tdstruct2", "interface test { typedef struct { int a; } foo; };";
+testok "tdstruct3", "interface test { typedef struct { int a; int b; } foo; };";
+testfail "tdstruct4", "interface test { typedef struct { int a, int b; } foo; };", 
+         "<tdstruct4>:0: Syntax error near ','\n";
+testok "struct1", "interface test { struct x { }; };";
+testok "struct2", "interface test { struct x { int a; }; };";
+testok "struct3", "interface test { struct x { int a; int b; }; };";
+testfail "struct4", "interface test { struct x { int a, int b; }; };", 
+         "<struct4>:0: Syntax error near ','\n";
+testfail "struct5", "interface test { struct { int a; } x; };", 
+         "<struct5>:0: Syntax error near 'x'\n";
+testok "tdunion1", "interface test { typedef union { } a; };";
+testok "tdunion2", "interface test { typedef union { int a; } a; };";
+testok "union1", "interface test { union a { }; };";
+testok "union2", "interface test { union x { int a; }; };";
+testfail "union3", "interface test { union { int a; } x; };", 
+       "<union3>:0: Syntax error near 'x'\n";
+testok "typedef1", "interface test { typedef int a; };";
+testfail "typedef2", "interface test { typedef x; };", 
+         "<typedef2>:0: Syntax error near ';'\n";
+testok "tdenum1", "interface test { typedef enum { A=1, B=2, C} a; };";
+testok "enum1", "interface test { enum a { A=1, B=2, C}; };";
+testfail "enum2", "interface test { enum { A=1, B=2, C} a; };", 
+	 "<enum2>:0: Syntax error near 'a'\n";
+testok "nested1", "interface test { struct x { struct { int a; } z; }; };";
+testok "nested2", "interface test { struct x { struct y { int a; } z; }; };";
+testok "bitmap1", "interface test { bitmap x { a=1 }; };";
+testok "unsigned", "interface test { struct x { unsigned short y; }; };";
+testok "struct-property", "interface test { [public] struct x { short y; }; };";
+testok "signed", "interface test { struct x { signed short y; }; };";
+testok "declarg", "interface test { void test(struct { int x; } a); };";
+testok "structarg", "interface test { void test(struct a b); };";
+testfail "structargmissing", "interface test { void test(struct a); };",
+	"<structargmissing>:0: Syntax error near ')'\n";
+testok "structqual", "interface test { struct x { struct y z; }; };";
+testok "unionqual", "interface test { struct x { union y z; }; };";
+testok "enumqual", "interface test { struct x { enum y z; }; };";
+testok "bitmapqual", "interface test { struct x { bitmap y z; }; };";
+testok "emptystructdecl", "interface test { struct x; };";
+testok "emptyenumdecl", "interface test { enum x; };";
+testok "emptytdstructdecl", "interface test { typedef struct x y; };";
+testok "import", "import \"foo.idl\";";
+testok "include", "include \"foo.h\";";
+testfail "import-noquotes", "import foo.idl;", 
+		"<import-noquotes>:0: Syntax error near 'foo'\n";
+testfail "include-noquotes", "include foo.idl;", 
+         "<include-noquotes>:0: Syntax error near 'foo'\n";
+testok "importlib", "importlib \"foo.idl\";";
+testfail "import-nosemicolon", "import \"foo.idl\"", 
+         "<import-nosemicolon>:0: Syntax error near 'foo.idl'\n";
+testok "import-multiple", "import \"foo.idl\", \"bar.idl\";";
+testok "include-multiple", "include \"foo.idl\", \"bar.idl\";";
+testok "empty-struct", "interface test { struct foo { }; }";
+testok "typedef-double", "interface test { typedef struct foo { } foo; }";
+testok "cpp-quote", "cpp_quote(\"bla\")";
+
+my $x = Parse::Pidl::IDL::parse_string("interface foo { struct x {}; }", "<foo>");
+
+is_deeply($x, [ {
+	'TYPE' => 'INTERFACE',
+	'NAME' => 'foo',
+	'DATA' => [ {
+		'TYPE' => 'STRUCT',
+		'NAME' => 'x',
+		'ELEMENTS' => [],
+		'FILE' => '<foo>',
+		'LINE' => 0
+	} ],
+	'FILE' => '<foo>',
+	'LINE' => 0
+}]);
+
+$x = Parse::Pidl::IDL::parse_string("interface foo { struct x; }", "<foo>");
+is_deeply($x, [ {
+	'TYPE' => 'INTERFACE',
+	'NAME' => 'foo',
+	'DATA' => [ {
+		'TYPE' => 'STRUCT',
+		'NAME' => 'x',
+		'FILE' => '<foo>',
+		'LINE' => 0
+	} ],
+	'FILE' => '<foo>',
+	'LINE' => 0
+}]);
+
+$x = Parse::Pidl::IDL::parse_string("cpp_quote(\"foobar\")", "<quote>");
+is_deeply($x, [ {
+	'TYPE' => 'CPP_QUOTE',
+	'DATA' => '"foobar"',
+	'FILE' => '<quote>',
+	'LINE' => 0
+}]);
+
+# A typedef of a struct without body
+$x = Parse::Pidl::IDL::parse_string("interface foo { typedef struct x y; }", "<foo>");
+
+is_deeply($x, [ {
+	'TYPE' => 'INTERFACE',
+	'NAME' => 'foo',
+	'DATA' => [ {
+		'TYPE' => 'TYPEDEF',
+		'NAME' => 'y',
+		'POINTERS' => 0,
+		'DATA' => {
+			'TYPE' => 'STRUCT',
+			'NAME' => 'x',
+			'FILE' => '<foo>',
+			'LINE' => 0,
+		},
+		'FILE' => '<foo>',
+		'LINE' => 0,
+	} ],
+	'FILE' => '<foo>',
+	'LINE' => 0
+}]);
+
+# A typedef of a struct with empty body
+$x = Parse::Pidl::IDL::parse_string("interface foo { typedef struct {} y; }", "<foo>");
+
+is_deeply($x, [ {
+	'TYPE' => 'INTERFACE',
+	'NAME' => 'foo',
+	'DATA' => [ {
+		'TYPE' => 'TYPEDEF',
+		'NAME' => 'y',
+		'POINTERS' => 0,
+		'DATA' => {
+			'TYPE' => 'STRUCT',
+			'ELEMENTS' => [],
+			'FILE' => '<foo>',
+			'LINE' => 0
+		},
+		'FILE' => '<foo>',
+		'LINE' => 0
+	} ],
+	'FILE' => '<foo>',
+	'LINE' => 0
+}]);
+
+# A typedef of a bitmap with no body
+$x = Parse::Pidl::IDL::parse_string("interface foo { typedef bitmap x y; }", "<foo>");
+
+is_deeply($x, [ {
+	'TYPE' => 'INTERFACE',
+	'NAME' => 'foo',
+	'DATA' => [ {
+		'TYPE' => 'TYPEDEF',
+		'NAME' => 'y',
+		'POINTERS' => 0,
+		'DATA' => {
+			'TYPE' => 'BITMAP',
+			'NAME' => 'x',
+			'FILE' => '<foo>',
+			'LINE' => 0
+		},
+		'FILE' => '<foo>',
+		'LINE' => 0
+	} ],
+	'FILE' => '<foo>',
+	'LINE' => 0
+}]);
+
+
+# A typedef of a union with no body
+$x = Parse::Pidl::IDL::parse_string("interface foo { typedef union x y; }", "<foo>");
+
+is_deeply($x, [ {
+	'TYPE' => 'INTERFACE',
+	'NAME' => 'foo',
+	'DATA' => [ {
+		'TYPE' => 'TYPEDEF',
+		'NAME' => 'y',
+		'POINTERS' => 0,
+		'DATA' => {
+			'TYPE' => 'UNION',
+			'NAME' => 'x',
+			'FILE' => '<foo>',
+			'LINE' => 0
+		},
+		'FILE' => '<foo>',
+		'LINE' => 0
+	} ],
+	'FILE' => '<foo>',
+	'LINE' => 0
+}]);

pidl/tests/samba-ndr.pl

@@ -0,0 +1,300 @@
+#!/usr/bin/perl
+# (C) 2007 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU General Public License
+use strict;
+use warnings;
+
+use Test::More tests => 31;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util;
+use strict;
+use Parse::Pidl::Util qw(MyDumper);
+use Parse::Pidl::Samba4::NDR::Parser qw(check_null_pointer 
+	NeededFunction NeededElement NeededType
+	NeededInterface TypeFunctionName ParseElementPrint); 
+
+my $output;
+sub print_fn($) { my $x = shift; $output.=$x; }
+
+# Test case 1: Simple unique pointer dereference
+
+$output = "";
+my $fn = check_null_pointer({ 
+	PARENT => {
+		ELEMENTS => [
+			{ 
+				NAME => "bla",
+				LEVELS => [
+					{ TYPE => "POINTER",
+					  POINTER_INDEX => 0,
+					  POINTER_TYPE => "unique" },
+					{ TYPE => "DATA" }
+				],
+			},
+		]
+	}
+}, { bla => "r->in.bla" }, \&print_fn, "return;"); 
+
+
+test_warnings("", sub { $fn->("r->in.bla"); });
+
+is($output, "if (r->in.bla == NULL) return;");
+
+# Test case 2: Simple ref pointer dereference
+
+$output = "";
+$fn = check_null_pointer({ 
+	PARENT => {
+		ELEMENTS => [
+			{ 
+				NAME => "bla",
+				LEVELS => [
+					{ TYPE => "POINTER",
+					  POINTER_INDEX => 0,
+					  POINTER_TYPE => "ref" },
+					{ TYPE => "DATA" }
+				],
+			},
+		]
+	}
+}, { bla => "r->in.bla" }, \&print_fn, undef); 
+
+test_warnings("", sub { $fn->("r->in.bla"); });
+
+is($output, "");
+
+# Test case 3: Illegal dereference
+
+$output = "";
+$fn = check_null_pointer({ 
+	FILE => "nofile",
+	LINE => 1,
+	PARENT => {
+		ELEMENTS => [
+			{ 
+				NAME => "bla",
+				LEVELS => [
+					{ TYPE => "DATA" }
+				],
+			},
+		]
+	}
+}, { bla => "r->in.bla" }, \&print_fn, undef); 
+
+test_warnings("nofile:1: too much dereferences for `bla'\n", 
+	          sub { $fn->("r->in.bla"); });
+
+is($output, "");
+
+# Test case 4: Double pointer dereference
+
+$output = "";
+$fn = check_null_pointer({ 
+	PARENT => {
+		ELEMENTS => [
+			{ 
+				NAME => "bla",
+				LEVELS => [
+					{ TYPE => "POINTER",
+					  POINTER_INDEX => 0,
+					  POINTER_TYPE => "unique" },
+					{ TYPE => "POINTER",
+					  POINTER_INDEX => 1,
+					  POINTER_TYPE => "unique" },
+					{ TYPE => "DATA" }
+				],
+			},
+		]
+	}
+}, { bla => "r->in.bla" }, \&print_fn, "return;"); 
+
+test_warnings("",
+	          sub { $fn->("*r->in.bla"); });
+
+is($output, "if (*r->in.bla == NULL) return;");
+
+# Test case 5: Unknown variable
+
+$output = "";
+$fn = check_null_pointer({ 
+	FILE => "nofile",
+	LINE => 2,
+	PARENT => {
+		ELEMENTS => [
+			{ 
+				NAME => "bla",
+				LEVELS => [
+					{ TYPE => "DATA" }
+				],
+			},
+		]
+	}
+}, { }, \&print_fn, "return;"); 
+
+test_warnings("nofile:2: unknown dereferenced expression `r->in.bla'\n",
+	          sub { $fn->("r->in.bla"); });
+
+is($output, "if (r->in.bla == NULL) return;");
+
+my $needed = {};
+NeededElement({ TYPE => "foo", REPRESENTATION_TYPE => "foo" }, "pull", $needed); 
+is_deeply($needed, { ndr_pull_foo => 1 });
+
+# old settings should be kept
+$needed = { ndr_pull_foo => 0 };
+NeededElement({ TYPE => "foo", REPRESENTATION_TYPE => "foo" }, "pull", $needed); 
+is_deeply($needed, { ndr_pull_foo => 0 });
+
+# print/pull/push are independent of each other
+$needed = { ndr_pull_foo => 0 };
+NeededElement({ TYPE => "foo", REPRESENTATION_TYPE => "foo" }, "print", $needed); 
+is_deeply($needed, { ndr_pull_foo => 0, ndr_print_foo => 1 });
+
+$needed = { };
+NeededFunction({ NAME => "foo", ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] }, $needed); 
+is_deeply($needed, { ndr_pull_foo => 1, ndr_print_foo => 1, ndr_push_foo => 1,
+	                 ndr_pull_bar => 1, ndr_print_bar => 1, ndr_push_bar => 1});
+
+# push/pull/print are always set for functions
+$needed = { ndr_pull_foo => 0 };
+NeededFunction({ NAME => "foo", ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] }, $needed); 
+is_deeply($needed, { ndr_pull_foo => 1, ndr_print_foo => 1, ndr_push_foo => 1,
+	                 ndr_pull_bar => 1, ndr_push_bar => 1, ndr_print_bar => 1});
+
+# public structs are always needed
+$needed = {};
+NeededType({ NAME => "bla", TYPE => "TYPEDEF",
+		DATA => { TYPE => "STRUCT", ELEMENTS => [] } },
+			  $needed, "pull");
+is_deeply($needed, { });
+
+$needed = {};
+NeededInterface({ TYPES => [ { PROPERTIES => { public => 1 }, NAME => "bla", 
+				TYPE => "TYPEDEF",
+	            DATA => { TYPE => "STRUCT", ELEMENTS => [] } } ] },
+			  $needed);
+is_deeply($needed, { ndr_pull_bla => 1, ndr_push_bla => 1, ndr_print_bla => 1 });
+
+# make sure types for elements are set too
+$needed = {};
+NeededInterface({ TYPES => [ { PROPERTIES => { public => 1 }, NAME => "bla", 
+				TYPE => "TYPEDEF",
+	            DATA => { TYPE => "STRUCT", 
+						  ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] } } ] },
+			  $needed);
+is_deeply($needed, { ndr_pull_bla => 1, ndr_pull_bar => 1, ndr_push_bla => 1, ndr_push_bar => 1,
+					 ndr_print_bla => 1, ndr_print_bar => 1});
+
+$needed = {};
+NeededInterface({ TYPES => [ { PROPERTIES => { gensize => 1}, NAME => "bla", 
+				TYPE => "TYPEDEF",
+	            DATA => { TYPE => "STRUCT", 
+						  ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] } } ] },
+			  $needed);
+is_deeply($needed, { ndr_size_bla => 1 });
+	                 
+# make sure types for elements are set too
+$needed = { ndr_pull_bla => 1 };
+NeededType({ NAME => "bla", 
+				TYPE => "TYPEDEF",
+	            DATA => { TYPE => "STRUCT", 
+						  ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "bar" } ] } },
+			  $needed, "pull");
+is_deeply($needed, { ndr_pull_bla => 1, ndr_pull_bar => 1 });
+
+$needed = {};
+NeededInterface({ TYPES => [ { PROPERTIES => { public => 1}, 
+				NAME => "bla", 
+				TYPE => "TYPEDEF",
+	            DATA => { TYPE => "STRUCT", 
+						  ELEMENTS => [ { TYPE => "bar", REPRESENTATION_TYPE => "rep" } ] } } ] }, $needed);
+is_deeply($needed, { ndr_pull_bla => 1, ndr_push_bla => 1, ndr_print_bla => 1, 
+					 ndr_print_rep => 1,
+	                 ndr_pull_bar => 1, ndr_push_bar => 1, 
+				     ndr_bar_to_rep => 1, ndr_rep_to_bar => 1});
+	
+my $generator = new Parse::Pidl::Samba4::NDR::Parser();
+$generator->ParseStructPush({
+			NAME => "mystruct",
+			TYPE => "STRUCT",
+			PROPERTIES => {},
+			ALIGN => 4,
+			ELEMENTS => [ ]}, "ndr", "x");
+is($generator->{res}, "NDR_PUSH_CHECK_FLAGS(ndr, ndr_flags);
+if (ndr_flags & NDR_SCALARS) {
+	NDR_CHECK(ndr_push_align(ndr, 4));
+	NDR_CHECK(ndr_push_trailer_align(ndr, 4));
+}
+if (ndr_flags & NDR_BUFFERS) {
+}
+");
+
+$generator = new Parse::Pidl::Samba4::NDR::Parser();
+my $e = { 
+	NAME => "el1", 
+	TYPE => "mytype",
+	REPRESENTATION_TYPE => "mytype",
+	PROPERTIES => {},
+	LEVELS => [ 
+		{ LEVEL_INDEX => 0, TYPE => "DATA", DATA_TYPE => "mytype" } 
+] };
+$generator->ParseStructPush({
+			NAME => "mystruct",
+			TYPE => "STRUCT",
+			PROPERTIES => {},
+			ALIGN => 4,
+			SURROUNDING_ELEMENT => $e,
+			ELEMENTS => [ $e ]}, "ndr", "x");
+is($generator->{res}, "NDR_PUSH_CHECK_FLAGS(ndr, ndr_flags);
+if (ndr_flags & NDR_SCALARS) {
+	NDR_CHECK(ndr_push_uint3264(ndr, NDR_SCALARS, ndr_string_array_size(ndr, x->el1)));
+	NDR_CHECK(ndr_push_align(ndr, 4));
+	NDR_CHECK(ndr_push_mytype(ndr, NDR_SCALARS, &x->el1));
+	NDR_CHECK(ndr_push_trailer_align(ndr, 4));
+}
+if (ndr_flags & NDR_BUFFERS) {
+}
+");
+
+is(TypeFunctionName("ndr_pull", "uint32"), "ndr_pull_uint32");
+is(TypeFunctionName("ndr_pull", {TYPE => "ENUM", NAME => "bar"}), "ndr_pull_ENUM_bar");
+is(TypeFunctionName("ndr_pull", {TYPE => "TYPEDEF", NAME => "bar", DATA => undef}), "ndr_pull_bar");
+is(TypeFunctionName("ndr_push", {TYPE => "STRUCT", NAME => "bar"}), "ndr_push_STRUCT_bar");
+
+# check noprint works
+$generator = new Parse::Pidl::Samba4::NDR::Parser();
+$generator->ParseElementPrint({ NAME => "x", TYPE => "rt", REPRESENTATION_TYPE => "rt", 
+				    PROPERTIES => { noprint => 1},
+				    LEVELS => [ { TYPE => "DATA", DATA_TYPE => "rt"} ]},
+				    "ndr", "var", { "x" => "r->foobar" } );
+is($generator->{res}, "");
+
+$generator = new Parse::Pidl::Samba4::NDR::Parser();
+$generator->ParseElementPrint({ NAME => "x", TYPE => "rt", REPRESENTATION_TYPE => "rt", 
+				    PROPERTIES => {},
+				    LEVELS => [ { TYPE => "DATA", DATA_TYPE => "rt" }]},
+				    "ndr", "var", { "x" => "r->foobar" } );
+is($generator->{res}, "ndr_print_rt(ndr, \"x\", &var);\n");
+
+# make sure that a print function for an element with value() set works
+$generator = new Parse::Pidl::Samba4::NDR::Parser();
+$generator->ParseElementPrint({ NAME => "x", TYPE => "uint32", REPRESENTATION_TYPE => "uint32", 
+				    PROPERTIES => { value => "23" },
+				    LEVELS => [ { TYPE => "DATA", DATA_TYPE => "uint32"} ]},
+				    "ndr", "var", { "x" => "r->foobar" } );
+is($generator->{res}, "ndr_print_uint32(ndr, \"x\", (ndr->flags & LIBNDR_PRINT_SET_VALUES)?23:var);\n");
+
+$generator = new Parse::Pidl::Samba4::NDR::Parser();
+$generator->AuthServiceStruct("bridge", "\"rot13\",\"onetimepad\"");
+is($generator->{res}, "static const char * const bridge_authservice_strings[] = {
+	\"rot13\", 
+	\"onetimepad\", 
+};
+
+static const struct ndr_interface_string_array bridge_authservices = {
+	.count	= 2,
+	.names	= bridge_authservice_strings
+};
+
+");

pidl/tests/samba3-cli.pl

@@ -0,0 +1,236 @@
+#!/usr/bin/perl
+# (C) 2007 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU General Public License
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util;
+use Parse::Pidl::Util qw(MyDumper);
+use Parse::Pidl::Samba3::ClientNDR qw(ParseFunction);
+use Parse::Pidl::Samba4::Header qw(GenerateFunctionInEnv GenerateFunctionOutEnv);
+
+# Make sure GenerateFunctionInEnv and GenerateFunctionOutEnv work
+my $fn = { ELEMENTS => [ { DIRECTION => ["in"], NAME => "foo" } ] };
+is_deeply({ "foo" => "r.in.foo" }, GenerateFunctionInEnv($fn, "r."));
+is_deeply({ "foo" => "r.in.foo" }, GenerateFunctionOutEnv($fn, "r."));
+
+$fn = { ELEMENTS => [ { DIRECTION => ["out", "in"], NAME => "foo" } ] };
+is_deeply({ "foo" => "r.in.foo" }, GenerateFunctionInEnv($fn, "r."));
+is_deeply({ "foo" => "r.out.foo" }, GenerateFunctionOutEnv($fn, "r."));
+
+$fn = { ELEMENTS => [ { DIRECTION => ["out"], NAME => "foo" } ] };
+is_deeply({ }, GenerateFunctionInEnv($fn, "r."));
+is_deeply({ "foo" => "r.out.foo" }, GenerateFunctionOutEnv($fn, "r."));
+
+my $x = new Parse::Pidl::Samba3::ClientNDR();
+
+$fn = { NAME => "bar", ELEMENTS => [ ] };
+$x->ParseFunction("foo", $fn);
+is($x->{res}, 
+"struct rpccli_bar_state {
+	TALLOC_CTX *out_mem_ctx;
+};
+
+static void rpccli_bar_done(struct tevent_req *subreq);
+
+struct tevent_req *rpccli_bar_send(TALLOC_CTX *mem_ctx,
+				   struct tevent_context *ev,
+				   struct rpc_pipe_client *cli)
+{
+	struct tevent_req *req;
+	struct rpccli_bar_state *state;
+	struct tevent_req *subreq;
+
+	req = tevent_req_create(mem_ctx, &state,
+				struct rpccli_bar_state);
+	if (req == NULL) {
+		return NULL;
+	}
+	state->out_mem_ctx = NULL;
+
+	subreq = dcerpc_bar_send(state,
+				 ev,
+				 cli->binding_handle);
+	if (tevent_req_nomem(subreq, req)) {
+		return tevent_req_post(req, ev);
+	}
+	tevent_req_set_callback(subreq, rpccli_bar_done, req);
+	return req;
+}
+
+static void rpccli_bar_done(struct tevent_req *subreq)
+{
+	struct tevent_req *req = tevent_req_callback_data(
+		subreq, struct tevent_req);
+	struct rpccli_bar_state *state = tevent_req_data(
+		req, struct rpccli_bar_state);
+	NTSTATUS status;
+	TALLOC_CTX *mem_ctx;
+
+	if (state->out_mem_ctx) {
+		mem_ctx = state->out_mem_ctx;
+	} else {
+		mem_ctx = state;
+	}
+
+	status = dcerpc_bar_recv(subreq,
+				 mem_ctx);
+	TALLOC_FREE(subreq);
+	if (!NT_STATUS_IS_OK(status)) {
+		tevent_req_nterror(req, status);
+		return;
+	}
+
+	tevent_req_done(req);
+}
+
+NTSTATUS rpccli_bar_recv(struct tevent_req *req,
+			 TALLOC_CTX *mem_ctx)
+{
+	struct rpccli_bar_state *state = tevent_req_data(
+		req, struct rpccli_bar_state);
+	NTSTATUS status;
+
+	if (tevent_req_is_nterror(req, &status)) {
+		tevent_req_received(req);
+		return status;
+	}
+
+	/* Steal possible out parameters to the callers context */
+	talloc_steal(mem_ctx, state->out_mem_ctx);
+
+	tevent_req_received(req);
+	return NT_STATUS_OK;
+}
+
+NTSTATUS rpccli_bar(struct rpc_pipe_client *cli,
+		    TALLOC_CTX *mem_ctx)
+{
+	NTSTATUS status;
+
+	status = dcerpc_bar(cli->binding_handle,
+			    mem_ctx);
+	if (!NT_STATUS_IS_OK(status)) {
+		return status;
+	}
+
+	/* Return result */
+	return NT_STATUS_OK;
+}
+
+");
+
+$x = new Parse::Pidl::Samba3::ClientNDR();
+
+$fn = { NAME => "bar", ELEMENTS => [ ], RETURN_TYPE => "WERROR" };
+$x->ParseFunction("foo", $fn);
+is($x->{res}, 
+"struct rpccli_bar_state {
+	TALLOC_CTX *out_mem_ctx;
+	WERROR result;
+};
+
+static void rpccli_bar_done(struct tevent_req *subreq);
+
+struct tevent_req *rpccli_bar_send(TALLOC_CTX *mem_ctx,
+				   struct tevent_context *ev,
+				   struct rpc_pipe_client *cli)
+{
+	struct tevent_req *req;
+	struct rpccli_bar_state *state;
+	struct tevent_req *subreq;
+
+	req = tevent_req_create(mem_ctx, &state,
+				struct rpccli_bar_state);
+	if (req == NULL) {
+		return NULL;
+	}
+	state->out_mem_ctx = NULL;
+
+	subreq = dcerpc_bar_send(state,
+				 ev,
+				 cli->binding_handle);
+	if (tevent_req_nomem(subreq, req)) {
+		return tevent_req_post(req, ev);
+	}
+	tevent_req_set_callback(subreq, rpccli_bar_done, req);
+	return req;
+}
+
+static void rpccli_bar_done(struct tevent_req *subreq)
+{
+	struct tevent_req *req = tevent_req_callback_data(
+		subreq, struct tevent_req);
+	struct rpccli_bar_state *state = tevent_req_data(
+		req, struct rpccli_bar_state);
+	NTSTATUS status;
+	TALLOC_CTX *mem_ctx;
+
+	if (state->out_mem_ctx) {
+		mem_ctx = state->out_mem_ctx;
+	} else {
+		mem_ctx = state;
+	}
+
+	status = dcerpc_bar_recv(subreq,
+				 mem_ctx,
+				 &state->result);
+	TALLOC_FREE(subreq);
+	if (!NT_STATUS_IS_OK(status)) {
+		tevent_req_nterror(req, status);
+		return;
+	}
+
+	tevent_req_done(req);
+}
+
+NTSTATUS rpccli_bar_recv(struct tevent_req *req,
+			 TALLOC_CTX *mem_ctx,
+			 WERROR *result)
+{
+	struct rpccli_bar_state *state = tevent_req_data(
+		req, struct rpccli_bar_state);
+	NTSTATUS status;
+
+	if (tevent_req_is_nterror(req, &status)) {
+		tevent_req_received(req);
+		return status;
+	}
+
+	/* Steal possible out parameters to the callers context */
+	talloc_steal(mem_ctx, state->out_mem_ctx);
+
+	/* Return result */
+	*result = state->result;
+
+	tevent_req_received(req);
+	return NT_STATUS_OK;
+}
+
+NTSTATUS rpccli_bar(struct rpc_pipe_client *cli,
+		    TALLOC_CTX *mem_ctx,
+		    WERROR *werror)
+{
+	WERROR result;
+	NTSTATUS status;
+
+	status = dcerpc_bar(cli->binding_handle,
+			    mem_ctx,
+			    &result);
+	if (!NT_STATUS_IS_OK(status)) {
+		return status;
+	}
+
+	/* Return result */
+	if (werror) {
+		*werror = result;
+	}
+
+	return werror_to_ntstatus(result);
+}
+
+");
+

pidl/tests/samba3-srv.pl

@@ -0,0 +1,18 @@
+#!/usr/bin/perl
+# (C) 2008 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU General Public License
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util;
+use Parse::Pidl::Util qw(MyDumper has_property);
+use Parse::Pidl::Samba3::ServerNDR qw(DeclLevel);
+
+my $l = { TYPE => "DATA", DATA_TYPE => "uint32" }; 
+my $e = { FILE => "foo", LINE => 0, PROPERTIES => { }, TYPE => "uint32",
+          LEVELS => [ $l ] };
+
+is("uint32_t", DeclLevel($e, 0));

pidl/tests/tdr.pl

@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+# (C) 2007 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU General Public License
+use strict;
+use warnings;
+
+use Test::More tests => 6;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util;
+use Parse::Pidl::Samba4::TDR qw(ParserType);
+
+my $tdr = new Parse::Pidl::Samba4::TDR();
+
+$tdr->ParserType({TYPE => "STRUCT", NAME => "foo", PROPERTIES => {public => 1}}, "pull");
+is($tdr->{ret}, "NTSTATUS tdr_pull_foo (struct tdr_pull *tdr, TALLOC_CTX *mem_ctx, struct foo *v)
+{
+	return NT_STATUS_OK;
+}
+
+");
+is($tdr->{ret_hdr}, "NTSTATUS tdr_pull_foo (struct tdr_pull *tdr, TALLOC_CTX *mem_ctx, struct foo *v);\n");
+
+
+$tdr = new Parse::Pidl::Samba4::TDR();
+$tdr->ParserType({TYPE => "UNION", NAME => "bar", PROPERTIES => {public => 1}}, "pull");
+is($tdr->{ret}, "NTSTATUS tdr_pull_bar(struct tdr_pull *tdr, TALLOC_CTX *mem_ctx, int level, union bar *v)
+{
+	switch (level) {
+	}
+	return NT_STATUS_OK;
+
+}
+
+");
+is($tdr->{ret_hdr}, "NTSTATUS tdr_pull_bar(struct tdr_pull *tdr, TALLOC_CTX *mem_ctx, int level, union bar *v);\n");
+
+$tdr = new Parse::Pidl::Samba4::TDR();
+$tdr->ParserType({TYPE => "UNION", NAME => "bar", PROPERTIES => {}}, "pull");
+is($tdr->{ret}, "static NTSTATUS tdr_pull_bar(struct tdr_pull *tdr, TALLOC_CTX *mem_ctx, int level, union bar *v)
+{
+	switch (level) {
+	}
+	return NT_STATUS_OK;
+
+}
+
+"); 
+is($tdr->{ret_hdr}, "");

pidl/tests/test_util.pl

@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+# (C) 2007 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU General Public License
+use strict;
+
+use Test::More tests => 6;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util qw(test_warnings test_errors);
+use Parse::Pidl qw(warning error);
+
+test_warnings("", sub {});
+
+test_warnings("x:1: msg\n", sub { warning({FILE => "x", LINE => 1}, "msg"); });
+test_warnings("", sub {});
+
+test_errors("", sub {});
+
+test_errors("x:1: msg\n", sub { error({FILE => "x", LINE => 1}, "msg"); });
+test_errors("", sub {});
+

pidl/tests/typelist.pl

@@ -0,0 +1,93 @@
+#!/usr/bin/perl
+# (C) 2007 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU General Public License
+use strict;
+use warnings;
+
+use Test::More tests => 56;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util;
+use Parse::Pidl::Typelist qw(hasType typeHasBody getType mapTypeName expandAlias
+	mapScalarType addType typeIs is_scalar scalar_is_reference
+	enum_type_fn bitmap_type_fn mapType);
+
+is("foo", expandAlias("foo"));
+is("uint32", expandAlias("DWORD"));
+is("int32", expandAlias("int"));
+is("", expandAlias(""));
+is("int32", expandAlias("int32"));
+
+is("uint32_t", mapScalarType("uint32"));
+is("void", mapScalarType("void"));
+is("uint64_t", mapScalarType("hyper"));
+is("double", mapScalarType("double"));
+
+my $x = { TYPE => "ENUM", NAME => "foo", EXTRADATA => 1 };
+addType($x);
+is_deeply($x, getType("foo"));
+is(undef, getType("bloebla"));
+is_deeply(getType({ TYPE => "STRUCT" }), { TYPE => "STRUCT" });
+is_deeply(getType({ TYPE => "ENUM", NAME => "foo" }), $x);
+is_deeply(getType("uint16"), {
+		NAME => "uint16",
+		BASEFILE => "<builtin>",
+		TYPE => "TYPEDEF",
+		DATA => { NAME => "uint16", TYPE => "SCALAR" }});
+
+is_deeply(getType("double"), {
+		NAME => "double",
+		BASEFILE => "<builtin>",
+		TYPE => "TYPEDEF",
+		DATA => { NAME => "double", TYPE => "SCALAR" }});
+
+is(0, typeIs("someUnknownType", "ENUM"));
+is(0, typeIs("foo", "ENUM"));
+addType({NAME => "mytypedef", TYPE => "TYPEDEF", DATA => { TYPE => "ENUM" }});
+is(1, typeIs("mytypedef", "ENUM"));
+is(0, typeIs("mytypedef", "BITMAP"));
+is(1, typeIs({ TYPE => "ENUM"}, "ENUM"));
+is(0, typeIs({ TYPE => "BITMAP"}, "ENUM"));
+is(1, typeIs("uint32", "SCALAR"));
+is(0, typeIs("uint32", "ENUM"));
+
+is(1, hasType("foo"));
+is(0, hasType("nonexistant"));
+is(0, hasType({TYPE => "ENUM", NAME => "someUnknownType"}));
+is(1, hasType({TYPE => "ENUM", NAME => "foo"}));
+is(1, hasType({TYPE => "ENUM"}));
+is(1, hasType({TYPE => "STRUCT"}));
+
+is(1, is_scalar("uint32"));
+is(0, is_scalar("nonexistant"));
+is(1, is_scalar({TYPE => "ENUM"}));
+is(0, is_scalar({TYPE => "STRUCT"}));
+is(1, is_scalar({TYPE => "TYPEDEF", DATA => {TYPE => "ENUM" }}));
+is(1, is_scalar("mytypedef"));
+
+is(1, scalar_is_reference("string"));
+is(0, scalar_is_reference("uint32"));
+is(0, scalar_is_reference({TYPE => "STRUCT", NAME => "echo_foobar"}));
+
+is("uint8", enum_type_fn({TYPE => "ENUM", PARENT=>{PROPERTIES => {enum8bit => 1}}}));
+is("uint32", enum_type_fn({TYPE => "ENUM", PARENT=>{PROPERTIES => {v1_enum => 1}}}));
+is("uint1632", enum_type_fn({TYPE => "ENUM", PARENT=>{PROPERTIES => {}}}));
+
+is("uint8", bitmap_type_fn({TYPE => "BITMAP", PROPERTIES => {bitmap8bit => 1}}));
+is("uint16", bitmap_type_fn({TYPE => "BITMAP", PROPERTIES => {bitmap16bit => 1}}));
+is("hyper", bitmap_type_fn({TYPE => "BITMAP", PROPERTIES => {bitmap64bit => 1}}));
+is("uint32", bitmap_type_fn({TYPE => "BITMAP", PROPERTIES => {}}));
+
+is("enum foo", mapType({TYPE => "ENUM"}, "foo"));
+is("union foo", mapType({TYPE => "UNION"}, "foo"));
+is("struct foo", mapType({TYPE => "STRUCT"}, "foo"));
+is("uint8_t", mapType({TYPE => "BITMAP", PROPERTIES => {bitmap8bit => 1}}, "foo"));
+is("uint8_t", mapType({TYPE => "SCALAR"}, "uint8"));
+is("uint32_t", mapType({TYPE => "TYPEDEF", DATA => {TYPE => "SCALAR"}}, "uint32"));
+
+is("void", mapTypeName(undef));
+is("uint32_t", mapTypeName("uint32"));
+is("int32_t", mapTypeName("int"));
+
+ok(not typeHasBody({TYPE => "TYPEDEF", DATA => { TYPE => "STRUCT" }}));
+ok(typeHasBody({TYPE => "TYPEDEF", DATA => { TYPE => "STRUCT", ELEMENTS => [] }}));

pidl/tests/util.pl

@@ -0,0 +1,115 @@
+#!/usr/bin/perl
+# (C) 2007 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU General Public License
+use strict;
+use warnings;
+
+use Test::More tests => 72;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util;
+use Parse::Pidl qw(error);
+use Parse::Pidl::Util;
+
+# has_property()
+is(undef, has_property({}, "foo"));
+is(undef, has_property({PROPERTIES => {}}, "foo"));
+is("data", has_property({PROPERTIES => {foo => "data"}}, "foo"));
+is(undef, has_property({PROPERTIES => {foo => undef}}, "foo"));
+
+# is_constant()
+ok(is_constant("2"));
+ok(is_constant("256"));
+ok(is_constant("0x400"));
+ok(is_constant("0x4BC"));
+ok(not is_constant("0x4BGC"));
+ok(not is_constant("str"));
+ok(not is_constant("2 * expr"));
+
+# make_str()
+is("\"bla\"", make_str("bla"));
+is("\"bla\"", make_str("\"bla\""));
+is("\"\"bla\"\"", make_str("\"\"bla\"\""));
+is("\"bla\"\"", make_str("bla\""));
+is("\"foo\"bar\"", make_str("foo\"bar"));
+
+is("bla", unmake_str("\"bla\""));
+is("\"bla\"", unmake_str("\"\"bla\"\""));
+
+# print_uuid()
+is(undef, print_uuid("invalid"));
+is("{0x12345778,0x1234,0xabcd,{0xef,0x00},{0x01,0x23,0x45,0x67,0x89,0xac}}", 
+   print_uuid("12345778-1234-abcd-ef00-0123456789ac"));
+is("{0x12345778,0x1234,0xabcd,{0xef,0x00},{0x01,0x23,0x45,0x67,0x89,0xac}}", 
+   print_uuid("\"12345778-1234-abcd-ef00-0123456789ac\""));
+
+# property_matches()
+# missing property
+ok(not property_matches({PROPERTIES => {}}, "x", "data"));
+# data not matching
+ok(not property_matches({PROPERTIES => {x => "bar"}}, "x", "data"));
+# data matching exactly
+ok(property_matches({PROPERTIES => {x => "data"}}, "x", "data"));
+# regex matching
+ok(property_matches({PROPERTIES => {x => "data"}}, "x", "^([dat]+)\$"));
+
+# ParseExpr()
+is(undef, ParseExpr("", {}, undef));
+is("a", ParseExpr("a", {"b" => "2"}, undef));
+is("2", ParseExpr("a", {"a" => "2"}, undef));
+is("2 * 2", ParseExpr("a*a", {"a" => "2"}, undef));
+is("r->length + r->length", 
+   ParseExpr("length+length", {"length" => "r->length"}, undef));
+is("2 / 2 * (r->length)", 
+	ParseExpr("constant/constant*(len)", {"constant" => "2", 
+			                              "len" => "r->length"}, undef));
+is("2 + 2 - r->length", 
+	ParseExpr("constant+constant-len", {"constant" => "2", 
+			                              "len" => "r->length"}, undef));
+is("*r->length", ParseExpr("*len", { "len" => "r->length"}, undef));
+is("**r->length", ParseExpr("**len", { "len" => "r->length"}, undef));
+is("r->length & 2", ParseExpr("len&2", { "len" => "r->length"}, undef));
+is("&r->length", ParseExpr("&len", { "len" => "r->length"}, undef));
+is("calc()", ParseExpr("calc()", { "foo" => "2"}, undef));
+is("calc(2 * 2)", ParseExpr("calc(foo * 2)", { "foo" => "2"}, undef));
+is("strlen(\"data\")", ParseExpr("strlen(foo)", { "foo" => "\"data\""}, undef));
+is("strlen(\"data\", 4)", ParseExpr("strlen(foo, 4)", { "foo" => "\"data\""}, undef));
+is("foo / bar", ParseExpr("foo / bar", { "bla" => "\"data\""}, undef));
+is("r->length % 2", ParseExpr("len%2", { "len" => "r->length"}, undef));
+is("r->length == 2", ParseExpr("len==2", { "len" => "r->length"}, undef));
+is("r->length != 2", ParseExpr("len!=2", { "len" => "r->length"}, undef));
+is("pr->length", ParseExpr("pr->length", { "p" => "r"}, undef));
+is("r->length", ParseExpr("p->length", { "p" => "r"}, undef));
+is("_foo / bla32", ParseExpr("_foo / bla32", { "bla" => "\"data\""}, undef));
+is("foo.bar.blah", ParseExpr("foo.blah", { "foo" => "foo.bar"}, undef));
+is("\"bla\"", ParseExpr("\"bla\"", {}, undef));
+is("1 << 2", ParseExpr("1 << 2", {}, undef));
+is("1 >> 2", ParseExpr("1 >> 2", {}, undef));
+is("0x200", ParseExpr("0x200", {}, undef));
+is("2?3:0", ParseExpr("2?3:0", {}, undef));
+is("~0", ParseExpr("~0", {}, undef));
+is("b->a->a", ParseExpr("a->a->a", {"a" => "b"}, undef));
+is("b.a.a", ParseExpr("a.a.a", {"a" => "b"}, undef));
+
+test_errors("nofile:0: Parse error in `~' near `~'\n", sub {
+	is(undef, ParseExpr("~", {}, {FILE => "nofile", LINE => 0})); });
+
+test_errors("nofile:0: Got pointer, expected integer\n", sub {
+		is(undef, ParseExprExt("foo", {}, {FILE => "nofile", LINE => 0},
+				         undef, sub { my $x = shift; 
+							 error({FILE => "nofile", LINE => 0}, 
+									 "Got pointer, expected integer");
+							 return undef; }))});
+
+is("b.a.a", ParseExpr("b.a.a", {"a" => "b"}, undef));
+is("((rr_type) == NBT_QTYPE_NETBIOS)", ParseExpr("((rr_type)==NBT_QTYPE_NETBIOS)", {}, undef));
+is("talloc_check_name", ParseExpr("talloc_check_name", {}, undef));
+is("talloc_check_name()", ParseExpr("talloc_check_name()", {}, undef));
+is("talloc_check_name(ndr)", ParseExpr("talloc_check_name(ndr)", {}, undef));
+is("talloc_check_name(ndr, 1)", ParseExpr("talloc_check_name(ndr,1)", {}, undef));
+is("talloc_check_name(ndr, \"struct ndr_push\")", ParseExpr("talloc_check_name(ndr,\"struct ndr_push\")", {}, undef));
+is("((rr_type) == NBT_QTYPE_NETBIOS) && talloc_check_name(ndr, \"struct ndr_push\")", ParseExpr("((rr_type)==NBT_QTYPE_NETBIOS)&&talloc_check_name(ndr,\"struct ndr_push\")", {}, undef));
+is("(rdata).data.length", ParseExpr("(rdata).data.length", {}, undef));
+is("((rdata).data.length == 2)", ParseExpr("((rdata).data.length==2)", {}, undef));
+is("((rdata).data.length == 2)?0:rr_type", ParseExpr("((rdata).data.length==2)?0:rr_type", {}, undef));
+is("((((rr_type) == NBT_QTYPE_NETBIOS) && talloc_check_name(ndr, \"struct ndr_push\") && ((rdata).data.length == 2))?0:rr_type)", ParseExpr("((((rr_type)==NBT_QTYPE_NETBIOS)&&talloc_check_name(ndr,\"struct ndr_push\")&&((rdata).data.length==2))?0:rr_type)", {}, undef));

pidl/tests/wireshark-conf.pl

@@ -0,0 +1,205 @@
+#!/usr/bin/perl
+# (C) 2007 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU General Public License
+# test parsing wireshark conformance files
+use strict;
+use warnings;
+
+use Test::More tests => 49;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util;
+use Parse::Pidl::Util qw(MyDumper);
+use Parse::Pidl::Wireshark::Conformance qw(ReadConformanceFH valid_ft_type valid_base_type);
+
+sub parse_conf($)
+{
+	my $str = shift;
+    open(TMP, "+>", undef) or die("unable to open temp file");
+	print TMP $str;
+	seek(TMP, 0, 0);
+	my $data = {};
+	ReadConformanceFH(*TMP, $data, "nofile") or return undef;
+	close(TMP);
+	return $data;
+}
+
+ok(parse_conf("\n"), undef);
+ok(parse_conf(" \n"), undef);
+ok(parse_conf("CODE START\nCODE END\n"));
+test_warnings("nofile:1: Expecting CODE END\n", sub { is(parse_conf("CODE START\n"), undef); });
+ok(parse_conf("#foobar\n"), undef);
+test_warnings("nofile:1: Unknown command `foobar'\n",
+	sub { ok(parse_conf("foobar\n"), undef); });
+
+test_warnings("nofile:1: incomplete HF_RENAME command\n",
+	sub { parse_conf("HF_RENAME\n"); });
+
+is_deeply(parse_conf("HF_RENAME foo bar\n")->{hf_renames}->{foo}, 
+	{ OLDNAME => "foo", NEWNAME => "bar", POS => {FILE => "nofile", LINE => 1}, USED => 0});
+
+is_deeply(parse_conf("NOEMIT\n"), { "noemit_dissector" => 1 });
+is_deeply(parse_conf("NOEMIT foo\n"), { "noemit" => { "foo" => 1 } });
+
+test_warnings("nofile:1: incomplete MANUAL command\n",
+	sub { parse_conf("MANUAL\n"); } );
+
+is_deeply(parse_conf("MANUAL foo\n"), { manual => {foo => 1}});
+
+test_errors("nofile:1: incomplete INCLUDE command\n",
+	sub { parse_conf("INCLUDE\n"); } );
+
+test_warnings("nofile:1: incomplete FIELD_DESCRIPTION command\n",
+	sub { parse_conf("FIELD_DESCRIPTION foo\n"); });
+
+is_deeply(parse_conf("FIELD_DESCRIPTION foo \"my description\"\n"),
+	{ fielddescription => { foo => { DESCRIPTION => "\"my description\"", POS => { FILE => "nofile", LINE => 1}, USED => 0 }}});
+
+is_deeply(parse_conf("FIELD_DESCRIPTION foo my description\n"),
+	{ fielddescription => { foo => { DESCRIPTION => "my", POS => { FILE => "nofile", LINE => 1}, USED => 0 }}});
+
+is_deeply(parse_conf("CODE START\ndata\nCODE END\n"), { override => "data\n" });
+is_deeply(parse_conf("CODE START\ndata\nmore data\nCODE END\n"), { override => "data\nmore data\n" });
+test_warnings("nofile:1: Unknown command `CODE'\n",
+	sub { parse_conf("CODE END\n"); } );
+
+is_deeply(parse_conf("TYPE winreg_String dissect_myminregstring(); FT_STRING BASE_DEC 0 0 2\n"), { types => { winreg_String => { 
+				NAME => "winreg_String",
+				POS => { FILE => "nofile", LINE => 1 },
+				USED => 0,
+				DISSECTOR_NAME => "dissect_myminregstring();",
+				FT_TYPE => "FT_STRING",
+				BASE_TYPE => "BASE_DEC",
+				MASK => 0,
+				VALSSTRING => 0,
+				ALIGNMENT => 2}}});
+
+ok(valid_ft_type("FT_UINT32"));
+ok(not valid_ft_type("BLA"));
+ok(not valid_ft_type("ft_uint32"));
+ok(valid_ft_type("FT_BLA"));
+
+ok(valid_base_type("BASE_DEC"));
+ok(valid_base_type("BASE_HEX"));
+ok(not valid_base_type("base_dec"));
+ok(not valid_base_type("BLA"));
+ok(not valid_base_type("BASEDEC"));
+
+test_errors("nofile:1: incomplete TYPE command\n",
+	sub { parse_conf("TYPE mytype dissector\n"); });
+
+test_warnings("nofile:1: dissector name does not contain `dissect'\n",
+	sub { parse_conf("TYPE winreg_String myminregstring; FT_STRING BASE_DEC 0 0 2\n"); });
+
+test_warnings("nofile:1: invalid FT_TYPE `BLA'\n",
+	sub { parse_conf("TYPE winreg_String dissect_myminregstring; BLA BASE_DEC 0 0 2\n"); });
+
+test_warnings("nofile:1: invalid BASE_TYPE `BLOE'\n",
+	sub { parse_conf("TYPE winreg_String dissect_myminregstring; FT_UINT32 BLOE 0 0 2\n"); });
+
+is_deeply(parse_conf("TFS hf_bla \"True string\" \"False String\"\n"),
+		{ tfs => { hf_bla => {
+					TRUE_STRING => "\"True string\"",
+				   FALSE_STRING => "\"False String\"" } } });
+
+test_errors("nofile:1: incomplete TFS command\n",
+	sub { parse_conf("TFS hf_bla \"Trues\""); } );
+
+test_errors("nofile:1: incomplete PARAM_VALUE command\n",
+	sub { parse_conf("PARAM_VALUE\n"); });
+
+is_deeply(parse_conf("PARAM_VALUE Life 42\n"),
+	{ dissectorparams => {
+			Life => {
+				DISSECTOR => "Life",
+				POS => { FILE => "nofile", LINE => 1 },
+				PARAM => 42,
+				USED => 0
+			}
+		}
+	});
+
+is_deeply(parse_conf("STRIP_PREFIX bla_\n"),
+	{ strip_prefixes => [ "bla_" ] });
+
+is_deeply(parse_conf("STRIP_PREFIX bla_\nSTRIP_PREFIX bloe\n"),
+	{ strip_prefixes => [ "bla_", "bloe" ] });
+
+is_deeply(parse_conf("PROTOCOL atsvc \"Scheduling jobs on remote machines\" \"at\" \"atsvc\"\n"), 
+	{ protocols => {
+			atsvc => {
+				LONGNAME => "\"Scheduling jobs on remote machines\"",
+				SHORTNAME => "\"at\"",
+				FILTERNAME => "\"atsvc\""
+			}
+		}
+	}
+);
+
+is_deeply(parse_conf("IMPORT bla\n"), {
+		imports => {
+			bla => {
+				NAME => "bla",
+				DATA => "",
+				USED => 0,
+				POS => { FILE => "nofile", LINE => 1 }
+			}
+		}
+	}
+);
+
+is_deeply(parse_conf("IMPORT bla fn1 fn2 fn3\n"), {
+		imports => {
+			bla => {
+				NAME => "bla",
+				DATA => "fn1 fn2 fn3",
+				USED => 0,
+				POS => { FILE => "nofile", LINE => 1 }
+			}
+		}
+	}
+);
+
+test_errors("nofile:1: no dissectorname specified\n",
+	sub { parse_conf("IMPORT\n"); } );
+
+test_errors("nofile:1: incomplete HF_FIELD command\n",
+	sub { parse_conf("HF_FIELD hf_idx\n"); });
+
+test_errors("nofile:1: incomplete ETT_FIELD command\n",
+	sub { parse_conf("ETT_FIELD\n"); });
+
+is_deeply(parse_conf("TYPE winreg_String dissect_myminregstring(); FT_STRING BASE_DEC 0 0 0 2\n"), {
+		types => {
+			winreg_String => {
+				NAME => "winreg_String",
+				POS => { FILE => "nofile", LINE => 1 },
+				USED => 0,
+				DISSECTOR_NAME => "dissect_myminregstring();",
+				FT_TYPE => "FT_STRING",
+				BASE_TYPE => "BASE_DEC",
+				MASK => 0,
+				VALSSTRING => 0,
+				ALIGNMENT => 0
+			}
+		}
+	}
+);
+
+
+is_deeply(parse_conf("TYPE winreg_String \"offset = dissect_myminregstring(\@HF\@);\" FT_STRING BASE_DEC 0 0 0 2\n"), {
+		types => {
+			winreg_String => {
+				NAME => "winreg_String",
+				POS => { FILE => "nofile", LINE => 1 },
+				USED => 0,
+				DISSECTOR_NAME => "offset = dissect_myminregstring(\@HF\@);",
+				FT_TYPE => "FT_STRING",
+				BASE_TYPE => "BASE_DEC",
+				MASK => 0,
+				VALSSTRING => 0,
+				ALIGNMENT => 0
+			}
+		}
+	}
+);

pidl/tests/wireshark-ndr.pl

@@ -0,0 +1,274 @@
+#!/usr/bin/perl
+# (C) 2007 Jelmer Vernooij <jelmer@samba.org>
+# Published under the GNU General Public License
+# test parsing wireshark conformance files
+use strict;
+use warnings;
+
+use Test::More tests => 40;
+use FindBin qw($RealBin);
+use lib "$RealBin";
+use Util;
+use Parse::Pidl::Util qw(MyDumper);
+use strict;
+use Parse::Pidl::Wireshark::NDR qw(field2name %res PrintIdl StripPrefixes RegisterInterfaceHandoff register_hf_field ProcessImport ProcessInclude find_type DumpEttList DumpEttDeclaration DumpHfList DumpHfDeclaration DumpFunctionTable register_type register_ett);
+
+is("Access Mask", field2name("access_mask"));
+is("Accessmask", field2name("AccessMask"));
+
+my $x = new Parse::Pidl::Wireshark::NDR();
+$x->PrintIdl("foo\nbar\n");
+is("/* IDL: foo */
+/* IDL: bar */
+
+", $x->{res}->{code});
+
+is("bla_foo", StripPrefixes("bla_foo", []));
+is("foo", StripPrefixes("bla_foo", ["bla"]));
+is("foo_bla", StripPrefixes("foo_bla", ["bla"]));
+
+$x = new Parse::Pidl::Wireshark::NDR();
+$x->RegisterInterfaceHandoff({});
+is($x->{res}->{code}, "");
+ok(not defined($x->{hf_used}->{hf_bla_opnum}));
+
+$x = new Parse::Pidl::Wireshark::NDR();
+$x->{res}->{code} = "";
+$x->RegisterInterfaceHandoff({UUID => "uuid", NAME => "bla"});
+is($x->{res}->{code}, 'void proto_reg_handoff_dcerpc_bla(void)
+{
+	dcerpc_init_uuid(proto_dcerpc_bla, ett_dcerpc_bla,
+		&uuid_dcerpc_bla, ver_dcerpc_bla,
+		bla_dissectors, hf_bla_opnum);
+}
+');
+is($x->{hf_used}->{hf_bla_opnum}, 1);
+
+$x->{conformance} = {};
+is("hf_bla_idx", 
+	$x->register_hf_field("hf_bla_idx", "bla", "my.filter", "FT_UINT32", "BASE_HEX", "NULL", 0xF, undef));
+is_deeply($x->{conformance}, {
+		header_fields => {
+			"hf_bla_idx" => {
+				INDEX => "hf_bla_idx",
+				NAME => "bla",
+				FILTER => "my.filter",
+				BASE_TYPE => "BASE_HEX",
+				FT_TYPE => "FT_UINT32",
+				VALSSTRING => "NULL",
+				BLURB => undef,
+				MASK => 0xF
+			}
+		},
+		hf_renames => {},
+		fielddescription => {}
+});
+
+$x->{conformance} = { fielddescription => { hf_bla_idx => { DESCRIPTION => "Some Description" }}};
+is("hf_bla_idx",
+	$x->register_hf_field("hf_bla_idx", "bla", "my.filter", "FT_UINT32", "BASE_HEX", "NULL", 0xF, undef));
+is_deeply($x->{conformance}, {
+		fielddescription => { 
+			hf_bla_idx => {
+				DESCRIPTION => "Some Description",
+				USED => 1
+			}
+		},
+		header_fields => {
+			"hf_bla_idx" => {
+				INDEX => "hf_bla_idx",
+				NAME => "bla",
+				FILTER => "my.filter",
+				BASE_TYPE => "BASE_HEX",
+				FT_TYPE => "FT_UINT32",
+				VALSSTRING => "NULL",
+				BLURB => "Some Description",
+				MASK => 0xF
+			}
+		},
+		hf_renames => {},
+});
+
+$x->{conformance} = { fielddescription => { hf_bla_idx => { DESCRIPTION => "Some Description" }}};
+is("hf_bla_idx",
+	$x->register_hf_field("hf_bla_idx", "bla", "my.filter", "FT_UINT32", "BASE_HEX", "NULL", 0xF, 
+		"Actual Description"));
+is_deeply($x->{conformance}, {
+		fielddescription => { 
+			hf_bla_idx => { DESCRIPTION => "Some Description" }
+		},
+		header_fields => {
+			"hf_bla_idx" => {
+				INDEX => "hf_bla_idx",
+				NAME => "bla",
+				FILTER => "my.filter",
+				BASE_TYPE => "BASE_HEX",
+				FT_TYPE => "FT_UINT32",
+				VALSSTRING => "NULL",
+				BLURB => "Actual Description",
+				MASK => 0xF
+			}
+		},
+		hf_renames => {},
+});
+
+
+
+$x->{conformance} = { hf_renames => { "hf_bla_idx" => { NEWNAME => "hf_bloe_idx" } } };
+$x->register_hf_field("hf_bla_idx", "bla", "my.filter", "FT_UINT32", "BASE_HEX", "NULL", 0xF, undef);
+is_deeply($x->{conformance}, {
+		hf_renames => { hf_bla_idx => { USED => 1, NEWNAME => "hf_bloe_idx" } } });
+
+$x->{hf_used} = { hf_bla => 1 };
+test_warnings("", sub { 
+		$x->CheckUsed({ header_fields => { foo => { INDEX => "hf_bla" }}})});
+
+$x->{hf_used} = { };
+test_warnings("hf field `hf_bla' not used\n", sub { 
+		$x->CheckUsed({ header_fields => { foo => { INDEX => "hf_bla" }}})});
+
+test_warnings("hf field `hf_id' not used\n", 
+	sub { $x->CheckUsed({
+	hf_renames => {
+		hf_id => {
+			OLDNAME => "hf_id",
+			NEWNAME => "hf_newid",
+			USED => 0
+		}
+	}
+}); } );
+
+test_warnings("dissector param never used\n",
+	sub { $x->CheckUsed({
+	dissectorparams => {
+		dissect_foo => {
+			PARAM => 42,
+			USED => 0
+		}
+	}
+}); } );
+
+test_warnings("description never used\n",
+	sub { $x->CheckUsed({
+	fielddescription => {
+		hf_bla => {
+			USED => 0
+		}
+	}
+}); } );
+
+test_warnings("import never used\n",
+	sub { $x->CheckUsed({
+	imports => {
+		bla => {
+			USED => 0
+		}
+	}
+}); } );
+
+test_warnings("nofile:1: type never used\n",
+	sub { $x->CheckUsed({
+	types => {
+		bla => {
+			USED => 0,
+			POS => { FILE => "nofile", LINE => 1 } 
+		}
+	}
+}); } );
+
+test_warnings("True/False description never used\n",
+	sub { $x->CheckUsed({
+	tfs => {
+		hf_bloe => {
+			USED => 0
+		}
+	}
+}); } );
+
+$x = new Parse::Pidl::Wireshark::NDR();
+$x->ProcessImport("security", "bla");
+is($x->{res}->{hdr}, "#include \"packet-dcerpc-bla.h\"\n\n");
+
+$x = new Parse::Pidl::Wireshark::NDR();
+$x->ProcessImport("\"bla.idl\"", "\"foo.idl\"");
+is($x->{res}->{hdr}, "#include \"packet-dcerpc-bla.h\"\n" . 
+              "#include \"packet-dcerpc-foo.h\"\n\n");
+
+$x = new Parse::Pidl::Wireshark::NDR();
+$x->ProcessInclude("foo.h", "bla.h", "bar.h");
+is($x->{res}->{hdr}, "#include \"foo.h\"\n" . 
+	          "#include \"bla.h\"\n" . 
+			  "#include \"bar.h\"\n\n");
+	
+$x->{conformance} = {types => { bla => "brainslug" } };
+is("brainslug", $x->find_type("bla"));
+
+is(DumpEttList(["ett_t1", "ett_bla"]), 
+	"\tstatic gint *ett[] = {\n" . 
+	"\t\t&ett_t1,\n" .
+	"\t\t&ett_bla,\n" .
+	"\t};\n");
+
+is(DumpEttList(), "\tstatic gint *ett[] = {\n\t};\n");
+is(DumpEttList(["bla"]), "\tstatic gint *ett[] = {\n\t\t&bla,\n\t};\n");
+
+is(DumpEttDeclaration(["void", "zoid"]), 
+	"\n/* Ett declarations */\n" . 
+	"static gint void = -1;\n" .
+	"static gint zoid = -1;\n" .
+	"\n");
+
+is(DumpEttDeclaration(), "\n/* Ett declarations */\n\n");
+
+$x->{conformance} = {
+	header_fields => {
+		hf_bla => { INDEX => "hf_bla", NAME => "Bla", FILTER => "bla.field", FT_TYPE => "FT_UINT32", BASE_TYPE => "BASE_DEC", VALSSTRING => "NULL", MASK => 0xFF, BLURB => "NULL" } 
+	} 
+};
+
+is($x->DumpHfList(), "\tstatic hf_register_info hf[] = {
+	{ &hf_bla, 
+	  { \"Bla\", \"bla.field\", FT_UINT32, BASE_DEC, NULL, 255, \"NULL\", HFILL }},
+	};
+");
+
+is($x->DumpHfDeclaration(), "
+/* Header field declarations */
+static gint hf_bla = -1;
+
+");
+
+is(DumpFunctionTable({
+			NAME => "someif",
+			FUNCTIONS => [ { NAME => "fn1", OPNUM => 3 }, { NAME => "someif_fn2", OPNUM => 2 } ] }),
+'static dcerpc_sub_dissector someif_dissectors[] = {
+	{ 3, "fn1",
+	   someif_dissect_fn1_request, someif_dissect_fn1_response},
+	{ 2, "fn2",
+	   someif_dissect_fn2_request, someif_dissect_fn2_response},
+	{ 0, NULL, NULL, NULL }
+};
+');
+
+$x->{conformance} = {};
+$x->register_type("bla_type", "dissect_bla", "FT_UINT32", "BASE_HEX", 0xFF, "NULL", 4);
+is_deeply($x->{conformance}, {
+		types => {
+			bla_type => {
+				NAME => "bla_type",
+				DISSECTOR_NAME => "dissect_bla",
+				FT_TYPE => "FT_UINT32",
+				BASE_TYPE => "BASE_HEX",
+				MASK => 255,
+				VALSSTRING => "NULL",
+				ALIGNMENT => 4
+			}
+		}
+	}
+);
+
+$x->{ett} = [];
+$x->register_ett("name");
+is_deeply($x->{ett}, ["name"]);
+$x->register_ett("leela");
+is_deeply($x->{ett}, ["name", "leela"]);

pidl/wscript

@@ -0,0 +1,85 @@
+#!/usr/bin/env python
+
+import os, sys, Logs
+from samba_utils import MODE_755
+
+def set_options(opt):
+    opt.tool_options('perl')
+
+def configure(conf):
+    conf.check_tool('perl')
+    # we need a recent version of MakeMaker to get the right man page names
+    if conf.CHECK_PERL_MANPAGE():
+        conf.env.PERLMAN1EXT = conf.CHECK_PERL_MANPAGE(section='1')
+        conf.env.PERLMAN3EXT = conf.CHECK_PERL_MANPAGE(section='3')
+        conf.DEFINE('HAVE_PERL_MAKEMAKER', 1)
+
+    # yapp is used for building the parser
+    conf.find_program('yapp', var='YAPP')
+    conf.find_program('pod2man', var='POD2MAN')
+
+def build(bld):
+    bld.INSTALL_FILES('${BINDIR}', 'pidl', chmod=MODE_755)
+
+    bld.RECURSE('lib')
+
+    if not bld.CONFIG_SET('HAVE_PERL_MAKEMAKER'):
+        return
+
+    pidl_src = ['pidl']
+    pidl_src.extend(bld.path.ant_glob('lib/**/*.pm').split())
+
+    pidl_manpages = {
+        'pidl': 'man1/pidl.${PERLMAN1EXT}',
+        'lib/Parse/Pidl/NDR.pm': 'man3/Parse::Pidl::NDR.${PERLMAN3EXT}',
+        'lib/Parse/Pidl/Wireshark/Conformance.pm': 'man3/Parse::Pidl::Wireshark::Conformance.${PERLMAN3EXT}',
+        'lib/Parse/Pidl/Dump.pm': 'man3/Parse::Pidl::Dump.${PERLMAN3EXT}',
+        'lib/Parse/Pidl/Util.pm': 'man3/Parse::Pidl::Util.${PERLMAN3EXT}',
+        'lib/Parse/Pidl/Wireshark/NDR.pm': 'man3/Parse::Pidl::Wireshark::NDR.${PERLMAN3EXT}'
+    }
+
+    for k, v in pidl_manpages.iteritems():
+        pidl_manpages[k] = bld.EXPAND_VARIABLES(v)
+
+    # use perl to build the manpages
+    bld.env.pidl_srcdir = os.path.join(bld.srcnode.abspath(), 'pidl')
+
+    blib_bld = os.path.join(bld.srcnode.abspath(bld.env), 'pidl/blib')
+
+    bld.SET_BUILD_GROUP('final')
+    if 'POD2MAN' in bld.env and bld.env['POD2MAN'] != '':
+        for src, manpage in pidl_manpages.iteritems():
+            bld(rule='${PERL} ${POD2MAN} -c "Samba Documentation" ${SRC} ${TGT}',
+                shell=True,
+                source=src,
+                install_path=os.path.dirname(bld.EXPAND_VARIABLES('${MANDIR}/'+manpage)),
+                target=os.path.basename(manpage))
+
+    # we want to prefer the git version of the parsers if we can.
+    # Only if the source has changed do we want to re-run yapp
+    # But we force the developer to use the pidl standalone build
+    # to regenerate the files.
+    # TODO: only warn in developer mode and if 'git diff HEAD'
+    #       shows a difference
+    warn_about_grammar_changes = ('PIDL_BUILD_WARNINGS' in bld.env and (
+        bld.IS_NEWER('idl.yp', 'lib/Parse/Pidl/IDL.pm') or
+        bld.IS_NEWER('expr.yp', 'lib/Parse/Pidl/Expr.pm')))
+
+    if warn_about_grammar_changes:
+        Logs.warn('''
+Pidl grammar files have changed. Please use the pidl standalone build
+to regenerate them with yapp.
+
+$ cd ../pidl
+$ perl Makefile.PL
+$ make lib/Parse/Pidl/IDL.pm lib/Parse/Pidl/Expr.pm
+$ git add lib/Parse/Pidl/IDL.pm lib/Parse/Pidl/Expr.pm
+$ git commit
+$ cd -
+
+If your 100% sure you haven't changed idl.yp and expr.yp
+try this to avoid this message:
+
+$ touch ../pidl/lib/Parse/Pidl/IDL.pm ../pidl/lib/Parse/Pidl/Expr.pm
+''')
+

secip.idl

@@ -0,0 +1,88 @@
+
+
+interface secip
+{
+	typedef [public,enum8bit] enum {
+		SECIP_ERR_SUCCESS                          = 0x00,
+		SECIP_ERR_ACKNOWLEDGE                      = 0x01,
+		SECIP_ERR_NEGATIVE_ACKNOWLEDGE             = 0x02,
+		SECIP_ERR_ARC_COULD_NOT_PROCESS_MESSAGE    = 0x03,
+		SECIP_ERR_PROTOCOL_ID_NOT_SUPPORTED        = 0x04,
+		SECIP_ERR_PROTOCOL_VERSION_NOT_SUPPORTED   = 0x05,
+		SECIP_ERR_PPK_BLOCK_VERSION_NOT_SUPPORTED  = 0x06,
+		SECIP_ERR_CRC_MODE_NOT_SUPPORTED           = 0x07,
+		SECIP_ERR_ACCOUNT_CODE_NOT_ALLOWED         = 0x08,
+		SECIP_ERR_CONNECTION_NOT_ALLOWED           = 0x0D,
+		SECIP_ERR_SUPERVISION_NOT_SUPPORTED        = 0x09,
+		SECIP_ERR_SUPERVISION_REQUEST_TOO_FAST     = 0x0A,
+		SECIP_ERR_SUPERVISION_REQUEST_TOO_SLOW     = 0x0B,
+		SECIP_ERR_PATHCHECK_NOT_SUPPORTED          = 0x0C,
+		SECIP_ERR_REESTABLISH_CONNECTION           = 0x80,
+		SECIP_ERR_UNKNOWN_ERROR                    = 0xFF
+	} secip_error;
+
+	typedef [public,enum8bit] enum {
+		SECIP_MSG_ATE_ENC                      = 0x01,
+		SECIP_MSG_ARC_ENC                      = 0x81,
+		SECIP_MSG_PPK_COM                      = 0x02,
+		SECIP_MSG_PPK_REP                      = 0x82,
+		SECIP_MSG_PATH_SUPERVISION_REQUEST     = 0x10,
+		SECIP_MSG_PATH_SUPERVISION_RESPONSE    = 0x90,
+		SECIP_MSG_POLL_MESSAGE                 = 0x11,
+		SECIP_MSG_POLL_ACKNOWLEDGE             = 0x91
+	} secip_message;
+
+	typedef [public,flag(LIBNDR_FLAG_NOALIGN)] struct {
+		[value(0)] uint16 session_id;
+		uint8 padding[202];
+	} secip_ate_enc;
+
+	typedef [public,flag(LIBNDR_FLAG_NOALIGN)] struct {
+		[value(0)] uint16 session_id;
+		uint8 rsa_key[128];
+		uint8 padding[74];
+	} secip_ppk_com;
+
+	typedef [public,flag(LIBNDR_FLAG_NOALIGN)] struct {
+		[value(1)] uint8 version;
+		uint8 aes_key[16];
+	} secip_key_message_block;
+
+	typedef [public,flag(LIBNDR_FLAG_NOALIGN)] struct {
+		[value(1)] uint8 protocol_version;
+		uint8 manufacturer[8];
+		uint8 panel_type[12];
+		uint8 panel_version[8];
+		uint8 account_code[6];
+		uint8 crc_mode;
+		uint16 session_id;
+		secip_key_message_block key_block;
+		uint8 padding[137];
+	} secip_ppk_rep;
+
+	typedef [public,flag(LIBNDR_FLAG_NOALIGN)] struct {
+		secip_error error_code;
+		uint16 session_id;
+		uint8 padding[232];
+	} secip_arc_enc;
+
+
+	typedef [nodiscriminant,public,flag(LIBNDR_FLAG_NOALIGN)] union {
+		[case(SECIP_MSG_ATE_ENC)] secip_ate_enc ate_enc;
+		[case(SECIP_MSG_PPK_COM)] secip_ppk_com ppk_com;
+		[case(SECIP_MSG_PPK_REP)] secip_ppk_rep ppk_rep;
+		[case(SECIP_MSG_ARC_ENC)] secip_arc_enc arc_enc;
+	} secip_msg_union;
+
+	typedef [public,flag(LIBNDR_FLAG_NOALIGN)] struct {
+		uint16 connection_id; /* 0xffff is unassigned */
+		uint8 pad; /* This is pretty weird actually */
+		secip_message message_id;
+		uint16 sequence_number;
+		char device_id[16];
+		[switch_is(message_id)] secip_msg_union msg;
+		uint8 padding[30]; /* random */
+		uint16 crc;
+	} secip_packet;
+
+};

secipd.c

@@ -0,0 +1,154 @@
+/*
+   Vebon Sec-IP Alarm Monitoring Service
+   Copyright (C) Wilco Baan Hofman <wilco@baanhofman.nl> 2012
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.
+*/
+#include "includes.h"
+#include "ndr_secip.h"
+
+uint16_t calculate_crc (char *ptr, uint16_t count)
+{
+	#define CRC16_SEED 0x1021
+	uint16_t crc;
+	uint8_t i;
+	crc = 0;
+
+	while (count-- > 0) {
+		crc = crc ^ ((uint16_t) *ptr++ << 8);
+		for (i = 0; i < 8; i++) {
+			if (crc & 0x8000) {
+				crc = crc << 1 ^ CRC16_SEED;
+			} else {
+				crc = crc << 1;
+			}
+		}
+	}
+	return crc;
+}
+
+
+int main (int argc, char **argv) {
+	int sock, n;
+	socklen_t fromlen;
+	struct sockaddr_in server;
+	struct sockaddr_in from;
+	TALLOC_CTX *mem_ctx;
+	dbi_conn conn;
+	STATUS rv;
+	FILE *pidfile;
+	pid_t pid;
+	configuration *conf;
+
+	set_process_name(argv[0]);
+
+	/* Initialize a memory context */
+	mem_ctx = talloc_init("secipd");
+
+
+	/* Read the configuration file */
+	rv = read_configuration_file(mem_ctx);
+	if (rv != ST_OK)
+		return rv;
+
+	conf = get_conf();
+
+	/* Daemonize if we're not supposed to run in foreground mode */
+	if (!conf->foreground) {
+		fclose(stdin);
+		fclose(stdout);
+		fclose(stderr);
+		if ((pid = fork())) {
+			/* Write PID file */
+			pidfile = fopen(conf->pid_file, "w");
+			if (pidfile < 0)
+				return ST_LOG_ERR;
+
+			n = fprintf(pidfile, "%d\n", pid);
+			fclose(pidfile);
+			return ST_OK;
+		}
+	}
+
+	/*
+	 * Open up a UDP socket the configured port
+	 */
+	sock = socket(AF_INET, SOCK_DGRAM, 0);
+	if (sock < 0) {
+		DEBUG(0, "Could not create socket in server");
+		return ST_SOCKET_FAILURE;
+	}
+
+	memset(&server, 0, sizeof(server));
+	server.sin_family = AF_INET;
+	server.sin_port = htons(conf->secip_port);
+	server.sin_addr.s_addr = INADDR_ANY;
+
+	if (bind(sock, (struct sockaddr *)&server, sizeof(server)) < 0) {
+		DEBUG(0, "Could not bind to socket during startup (socket in use?)!");
+		return ST_BIND_FAILURE;
+	}
+
+
+	DEBUG(0, "Started %s and waiting for SecIP packets on port %d", 
+	         get_process_name(), conf->secip_port);
+
+	/* Open a connection to the database */
+	rv = connect_to_database(&conn);
+	if (rv != ST_OK)
+		return rv;
+	
+	/*
+	 * Wait for packets
+	 */
+
+	fromlen = sizeof(struct sockaddr_in);
+	while (1) {
+		uint16_t src_port;
+		struct secip_packet *pkt;
+		char buf[1024]; /* Purposefully static length */
+		enum ndr_err_code ndr_err;
+		DATA_BLOB data;
+
+		pkt = talloc(mem_ctx, struct secip_packet);
+
+		n = recvfrom(sock, &buf, sizeof(buf), 0, (struct sockaddr *) &from, &fromlen);
+		if (n < 0) {
+			DEBUG( 0, "Error when storing packet in buffer!");
+			continue;
+		} else if (n == sizeof(buf)) {
+			DEBUG(0, "Maximum packet size exceeded!");
+			continue;
+		}
+		src_port = ntohs(from.sin_port);
+
+		/* Copy to data blob */
+		data.length = n;
+		data.data = talloc_memdup(pkt, buf, n);
+		
+		/* Parse the header */
+		ndr_err = ndr_pull_struct_blob_all(&data, pkt, pkt, (ndr_pull_flags_fn_t)ndr_pull_secip_packet);
+
+		if (ndr_err != NDR_ERR_SUCCESS) {
+			DEBUG(0, "Could not parse this packet");
+		}
+		printf("%s\n", ndr_print_struct_string(pkt,(ndr_print_fn_t)ndr_print_secip_packet, "packet", pkt));
+
+		DEBUG(0, "%x %x %x %x", pkt->connection_id, pkt->message_id, pkt->sequence_number, pkt->crc);
+		if (pkt->message_id == SECIP_MSG_ATE_ENC && pkt->msg.ate_enc.session_id == 0x0000) {
+			send_ppk_com(sock, from, pkt);
+		}
+		DEBUG(3, "Received packet with len %d from %u", n, src_port);
+	}
+}