bitlair/siahsd
8
0
Fork 0
Code Issues Pull requests Activity Actions

New version of pidl

Browse source
This commit is contained in:
Wilco Baan Hofman 2016-11-15 22:10:08 +01:00
parent d595112e01
commit 2186300bd2
74 changed files with 23043 additions and 988 deletions
Download patch file Download diff file Expand all files Collapse all files

40
bin/pidl/MYMETA.json Normal file
View file

@ -0,0 +1,40 @@
{
"abstract" : "unknown",
"author" : [
"unknown"
],
"dynamic_config" : 0,
"generated_by" : "ExtUtils::MakeMaker version 7.1002, CPAN::Meta::Converter version 2.150005",
"license" : [
"unknown"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "Parse-Pidl",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {}
}
},
"release_status" : "stable",
"version" : "0.02",
"x_serialization_backend" : "JSON::PP version 2.27300_01"
}

17
bin/pidl/MYMETA.yml
View file

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

454
bin/pidl/Makefile
View file

@ -1,7 +1,7 @@
# 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
# 7.1002 (Revision: 71002) from the contents of
# Makefile.PL. Don't edit this file, edit Makefile.PL instead.
#
# ANY CHANGES MADE HERE WILL BE LOST!
@ -12,9 +12,11 @@
# MakeMaker Parameters:
# BUILD_REQUIRES => { }
# CONFIGURE_REQUIRES => { }
# EXE_FILES => [q[pidl]]
# NAME => q[Parse::Pidl]
# PREREQ_PM => { }
# TEST_REQUIRES => { }
# VERSION_FROM => q[lib/Parse/Pidl.pm]
# test => { TESTS=>q[tests/*.pl] }
@ -23,29 +25,29 @@
# --- MakeMaker const_config section:
# These definitions are from config.sh (via /usr/lib/perl/5.14/Config.pm).
# These definitions are from config.sh (via /usr/lib/x86_64-linux-gnu/perl/5.24/Config.pm).
# They may have been overridden via Makefile.PL or on the command line.
AR = ar
CC = cc
CC = x86_64-linux-gnu-gcc
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 =
LD = x86_64-linux-gnu-gcc
LDDLFLAGS = -shared -L/usr/local/lib -fstack-protector-strong
LDFLAGS = -fstack-protector-strong -L/usr/local/lib
LIBC = libc-2.24.so
LIB_EXT = .a
OBJ_EXT = .o
OSNAME = linux
OSVERS = 2.6.32-5-amd64
OSVERS = 3.16.0
RANLIB = :
SITELIBEXP = /usr/local/share/perl/5.14.2
SITEARCHEXP = /usr/local/lib/perl/5.14.2
SITELIBEXP = /usr/local/share/perl/5.24.1
SITEARCHEXP = /usr/local/lib/x86_64-linux-gnu/perl/5.24.1
SO = so
VENDORARCHEXP = /usr/lib/perl5
VENDORARCHEXP = /usr/lib/x86_64-linux-gnu/perl5/5.24
VENDORLIBEXP = /usr/share/perl5
@ -72,56 +74,58 @@ MAN1EXT = 1p
MAN3EXT = 3pm
INSTALLDIRS = site
DESTDIR =
PREFIX = /usr
PERLPREFIX = $(PREFIX)
SITEPREFIX = $(PREFIX)/local
VENDORPREFIX = $(PREFIX)
INSTALLPRIVLIB = $(PERLPREFIX)/share/perl/5.14
PREFIX = $(SITEPREFIX)
PERLPREFIX = /usr
SITEPREFIX = /usr/local
VENDORPREFIX = /usr
INSTALLPRIVLIB = /usr/share/perl/5.24
DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB)
INSTALLSITELIB = $(SITEPREFIX)/share/perl/5.14.2
INSTALLSITELIB = /usr/local/share/perl/5.24.1
DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB)
INSTALLVENDORLIB = $(VENDORPREFIX)/share/perl5
INSTALLVENDORLIB = /usr/share/perl5
DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB)
INSTALLARCHLIB = $(PERLPREFIX)/lib/perl/5.14
INSTALLARCHLIB = /usr/lib/x86_64-linux-gnu/perl/5.24
DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB)
INSTALLSITEARCH = $(SITEPREFIX)/lib/perl/5.14.2
INSTALLSITEARCH = /usr/local/lib/x86_64-linux-gnu/perl/5.24.1
DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH)
INSTALLVENDORARCH = $(VENDORPREFIX)/lib/perl5
INSTALLVENDORARCH = /usr/lib/x86_64-linux-gnu/perl5/5.24
DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH)
INSTALLBIN = $(PERLPREFIX)/bin
INSTALLBIN = /usr/bin
DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN)
INSTALLSITEBIN = $(SITEPREFIX)/bin
INSTALLSITEBIN = /usr/local/bin
DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN)
INSTALLVENDORBIN = $(VENDORPREFIX)/bin
INSTALLVENDORBIN = /usr/bin
DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN)
INSTALLSCRIPT = $(PERLPREFIX)/bin
INSTALLSCRIPT = /usr/bin
DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT)
INSTALLSITESCRIPT = $(SITEPREFIX)/bin
INSTALLSITESCRIPT = /usr/local/bin
DESTINSTALLSITESCRIPT = $(DESTDIR)$(INSTALLSITESCRIPT)
INSTALLVENDORSCRIPT = $(VENDORPREFIX)/bin
INSTALLVENDORSCRIPT = /usr/bin
DESTINSTALLVENDORSCRIPT = $(DESTDIR)$(INSTALLVENDORSCRIPT)
INSTALLMAN1DIR = $(PERLPREFIX)/share/man/man1
INSTALLMAN1DIR = /usr/share/man/man1
DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR)
INSTALLSITEMAN1DIR = $(SITEPREFIX)/man/man1
INSTALLSITEMAN1DIR = /usr/local/man/man1
DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR)
INSTALLVENDORMAN1DIR = $(VENDORPREFIX)/share/man/man1
INSTALLVENDORMAN1DIR = /usr/share/man/man1
DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR)
INSTALLMAN3DIR = $(PERLPREFIX)/share/man/man3
INSTALLMAN3DIR = /usr/share/man/man3
DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR)
INSTALLSITEMAN3DIR = $(SITEPREFIX)/man/man3
INSTALLSITEMAN3DIR = /usr/local/man/man3
DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR)
INSTALLVENDORMAN3DIR = $(VENDORPREFIX)/share/man/man3
INSTALLVENDORMAN3DIR = /usr/share/man/man3
DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR)
PERL_LIB = /usr/share/perl/5.14
PERL_ARCHLIB = /usr/lib/perl/5.14
PERL_LIB = /usr/share/perl/5.24
PERL_ARCHLIB = /usr/lib/x86_64-linux-gnu/perl/5.24
PERL_ARCHLIBDEP = /usr/lib/x86_64-linux-gnu/perl/5.24
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
PERL_INC = /usr/lib/x86_64-linux-gnu/perl/5.24/CORE
PERL_INCDEP = /usr/lib/x86_64-linux-gnu/perl/5.24/CORE
PERL = "/usr/bin/perl"
FULLPERL = "/usr/bin/perl"
ABSPERL = $(PERL)
PERLRUN = $(PERL)
FULLPERLRUN = $(FULLPERL)
@ -134,9 +138,9 @@ 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
MAKEMAKER = /usr/share/perl/5.24/ExtUtils/MakeMaker.pm
MM_VERSION = 7.1002
MM_REVISION = 71002
# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).
# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)
@ -166,7 +170,7 @@ MAN3PODS = lib/Parse/Pidl/Dump.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
CONFIGDEP = $(PERL_ARCHLIBDEP)$(DFSEP)Config.pm $(PERL_INCDEP)$(DFSEP)config.h
# Where to build things
INST_LIBDIR = $(INST_LIB)/Parse
@ -182,6 +186,7 @@ INST_BOOT =
# Extra linker info
EXPORT_LIST =
PERL_ARCHIVE =
PERL_ARCHIVEDEP =
PERL_ARCHIVE_AFTER =
@ -195,6 +200,7 @@ TO_INST_PM = lib/Parse/Pidl.pm \
lib/Parse/Pidl/ODL.pm \
lib/Parse/Pidl/Samba3/ClientNDR.pm \
lib/Parse/Pidl/Samba3/ServerNDR.pm \
lib/Parse/Pidl/Samba3/Template.pm \
lib/Parse/Pidl/Samba4.pm \
lib/Parse/Pidl/Samba4/COM/Header.pm \
lib/Parse/Pidl/Samba4/COM/Proxy.pm \
@ -213,70 +219,72 @@ TO_INST_PM = lib/Parse/Pidl.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 \
PM_TO_BLIB = lib/Parse/Pidl.pm \
blib/lib/Parse/Pidl.pm \
lib/Parse/Pidl/CUtil.pm \
blib/lib/Parse/Pidl/CUtil.pm \
lib/Parse/Pidl/Compat.pm \
blib/lib/Parse/Pidl/Compat.pm \
lib/Parse/Pidl/Dump.pm \
blib/lib/Parse/Pidl/Dump.pm \
lib/Parse/Pidl/Expr.pm \
blib/lib/Parse/Pidl/Expr.pm \
lib/Parse/Pidl/IDL.pm \
blib/lib/Parse/Pidl/IDL.pm \
lib/Parse/Pidl/NDR.pm \
blib/lib/Parse/Pidl/NDR.pm \
lib/Parse/Pidl/ODL.pm \
blib/lib/Parse/Pidl/ODL.pm \
lib/Parse/Pidl/Samba3/ClientNDR.pm \
blib/lib/Parse/Pidl/Samba3/ClientNDR.pm \
lib/Parse/Pidl/Samba3/ServerNDR.pm \
blib/lib/Parse/Pidl/Samba3/ServerNDR.pm \
lib/Parse/Pidl/Samba3/Template.pm \
blib/lib/Parse/Pidl/Samba3/Template.pm \
lib/Parse/Pidl/Samba4.pm \
blib/lib/Parse/Pidl/Samba4.pm \
lib/Parse/Pidl/Samba4/COM/Header.pm \
blib/lib/Parse/Pidl/Samba4/COM/Header.pm \
lib/Parse/Pidl/Samba4/COM/Proxy.pm \
blib/lib/Parse/Pidl/Samba4/COM/Proxy.pm \
lib/Parse/Pidl/Samba4/COM/Stub.pm \
blib/lib/Parse/Pidl/Samba4/COM/Stub.pm \
lib/Parse/Pidl/Samba4/Header.pm \
blib/lib/Parse/Pidl/Samba4/Header.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/NDR/Server.pm \
blib/lib/Parse/Pidl/Samba4/NDR/Server.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/Samba4/TDR.pm \
blib/lib/Parse/Pidl/Samba4/TDR.pm \
lib/Parse/Pidl/Samba4/Template.pm \
blib/lib/Parse/Pidl/Samba4/Template.pm \
lib/Parse/Pidl/Typelist.pm \
blib/lib/Parse/Pidl/Typelist.pm \
lib/Parse/Pidl/Util.pm \
blib/lib/Parse/Pidl/Util.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
lib/Parse/Yapp/Driver.pm \
blib/lib/Parse/Yapp/Driver.pm \
lib/wscript_build \
blib/lib/wscript_build
# --- MakeMaker platform_constants section:
MM_Unix_VERSION = 6.57_05
MM_Unix_VERSION = 7.1002
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)' --
AUTOSPLITFILE = $(ABSPERLRUN) -e 'use AutoSplit; autosplit($$$$ARGV[0], $$$$ARGV[1], 0, 1, 1)' --
@ -312,6 +320,7 @@ MACROSTART =
MACROEND =
USEMAKEFILE = -f
FIXIN = $(ABSPERLRUN) -MExtUtils::MY -e 'MY->fixin(shift)' --
CP_NONEMPTY = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'cp_nonempty' --
# --- MakeMaker makemakerdflt section:
@ -457,17 +466,17 @@ linkext :: $(LINKTYPE)
# --- MakeMaker dlsyms section:
# --- MakeMaker dynamic section:
dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT)
$(NOECHO) $(NOOP)
# --- MakeMaker dynamic_bs section:
BOOTSTRAP =
# --- MakeMaker dynamic section:
dynamic :: $(FIRST_MAKEFILE) $(BOOTSTRAP) $(INST_DYNAMIC)
$(NOECHO) $(NOOP)
# --- MakeMaker dynamic_lib section:
@ -489,20 +498,20 @@ POD2MAN = $(POD2MAN_EXE)
manifypods : pure_all \
pidl \
lib/Parse/Pidl/Util.pm \
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 \
lib/Parse/Pidl/Dump.pm
$(NOECHO) $(POD2MAN) --section=$(MAN1EXT) --perm_rw=$(PERM_RW) \
pidl
$(NOECHO) $(POD2MAN) --section=$(MAN1EXT) --perm_rw=$(PERM_RW) -u \
pidl $(INST_MAN1DIR)/pidl.$(MAN1EXT)
$(NOECHO) $(POD2MAN) --section=$(MAN3EXT) --perm_rw=$(PERM_RW) \
lib/Parse/Pidl/Util.pm $(INST_MAN3DIR)/Parse::Pidl::Util.$(MAN3EXT) \
$(NOECHO) $(POD2MAN) --section=$(MAN3EXT) --perm_rw=$(PERM_RW) -u \
lib/Parse/Pidl/Dump.pm $(INST_MAN3DIR)/Parse::Pidl::Dump.$(MAN3EXT) \
lib/Parse/Pidl/NDR.pm $(INST_MAN3DIR)/Parse::Pidl::NDR.$(MAN3EXT) \
lib/Parse/Pidl/Util.pm $(INST_MAN3DIR)/Parse::Pidl::Util.$(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)
lib/Parse/Pidl/Wireshark/NDR.pm $(INST_MAN3DIR)/Parse::Pidl::Wireshark::NDR.$(MAN3EXT)
@ -545,23 +554,25 @@ clean_subdirs :
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
$(BASEEXT).bso $(BASEEXT).def \
$(BASEEXT).exp $(BASEEXT).x \
$(BOOTSTRAP) $(INST_ARCHAUTODIR)/extralibs.all \
$(INST_ARCHAUTODIR)/extralibs.ld $(MAKE_APERL_FILE) \
*$(LIB_EXT) *$(OBJ_EXT) \
*perl.core MYMETA.json \
MYMETA.yml blibdirs.ts \
core core.*perl.*.? \
core.[0-9] core.[0-9][0-9] \
core.[0-9][0-9][0-9] core.[0-9][0-9][0-9][0-9] \
core.[0-9][0-9][0-9][0-9][0-9] lib$(BASEEXT).def \
mon.out perl \
perl$(EXE_EXT) perl.exe \
perlmain.c pm_to_blib \
pm_to_blib.ts so_locations \
tmon.out
- $(RM_RF) \
blib
$(NOECHO) $(RM_F) $(MAKEFILE_OLD)
- $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL)
@ -582,27 +593,71 @@ realclean purge :: clean realclean_subdirs
# --- 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) '---' > META_new.yml
$(NOECHO) $(ECHO) 'abstract: unknown' >> META_new.yml
$(NOECHO) $(ECHO) 'author:' >> META_new.yml
$(NOECHO) $(ECHO) ' - unknown' >> 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) ' ExtUtils::MakeMaker: '\''0'\''' >> META_new.yml
$(NOECHO) $(ECHO) 'configure_requires:' >> META_new.yml
$(NOECHO) $(ECHO) ' ExtUtils::MakeMaker: '\''0'\''' >> META_new.yml
$(NOECHO) $(ECHO) 'dynamic_config: 1' >> META_new.yml
$(NOECHO) $(ECHO) 'generated_by: '\''ExtUtils::MakeMaker version 7.1002, CPAN::Meta::Converter version 2.150005'\''' >> META_new.yml
$(NOECHO) $(ECHO) 'license: unknown' >> 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) $(ECHO) ' url: http://module-build.sourceforge.net/META-spec-v1.4.html' >> META_new.yml
$(NOECHO) $(ECHO) ' version: '\''1.4'\''' >> META_new.yml
$(NOECHO) $(ECHO) 'name: Parse-Pidl' >> 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) 'requires: {}' >> META_new.yml
$(NOECHO) $(ECHO) 'version: '\''0.02'\''' >> META_new.yml
$(NOECHO) $(ECHO) 'x_serialization_backend: '\''CPAN::Meta::YAML version 0.018'\''' >> META_new.yml
-$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml
$(NOECHO) $(ECHO) Generating META.json
$(NOECHO) $(ECHO) '{' > META_new.json
$(NOECHO) $(ECHO) ' "abstract" : "unknown",' >> META_new.json
$(NOECHO) $(ECHO) ' "author" : [' >> META_new.json
$(NOECHO) $(ECHO) ' "unknown"' >> META_new.json
$(NOECHO) $(ECHO) ' ],' >> META_new.json
$(NOECHO) $(ECHO) ' "dynamic_config" : 1,' >> META_new.json
$(NOECHO) $(ECHO) ' "generated_by" : "ExtUtils::MakeMaker version 7.1002, CPAN::Meta::Converter version 2.150005",' >> META_new.json
$(NOECHO) $(ECHO) ' "license" : [' >> META_new.json
$(NOECHO) $(ECHO) ' "unknown"' >> META_new.json
$(NOECHO) $(ECHO) ' ],' >> META_new.json
$(NOECHO) $(ECHO) ' "meta-spec" : {' >> META_new.json
$(NOECHO) $(ECHO) ' "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",' >> META_new.json
$(NOECHO) $(ECHO) ' "version" : "2"' >> META_new.json
$(NOECHO) $(ECHO) ' },' >> META_new.json
$(NOECHO) $(ECHO) ' "name" : "Parse-Pidl",' >> META_new.json
$(NOECHO) $(ECHO) ' "no_index" : {' >> META_new.json
$(NOECHO) $(ECHO) ' "directory" : [' >> META_new.json
$(NOECHO) $(ECHO) ' "t",' >> META_new.json
$(NOECHO) $(ECHO) ' "inc"' >> META_new.json
$(NOECHO) $(ECHO) ' ]' >> META_new.json
$(NOECHO) $(ECHO) ' },' >> META_new.json
$(NOECHO) $(ECHO) ' "prereqs" : {' >> META_new.json
$(NOECHO) $(ECHO) ' "build" : {' >> META_new.json
$(NOECHO) $(ECHO) ' "requires" : {' >> META_new.json
$(NOECHO) $(ECHO) ' "ExtUtils::MakeMaker" : "0"' >> META_new.json
$(NOECHO) $(ECHO) ' }' >> META_new.json
$(NOECHO) $(ECHO) ' },' >> META_new.json
$(NOECHO) $(ECHO) ' "configure" : {' >> META_new.json
$(NOECHO) $(ECHO) ' "requires" : {' >> META_new.json
$(NOECHO) $(ECHO) ' "ExtUtils::MakeMaker" : "0"' >> META_new.json
$(NOECHO) $(ECHO) ' }' >> META_new.json
$(NOECHO) $(ECHO) ' },' >> META_new.json
$(NOECHO) $(ECHO) ' "runtime" : {' >> META_new.json
$(NOECHO) $(ECHO) ' "requires" : {}' >> META_new.json
$(NOECHO) $(ECHO) ' }' >> META_new.json
$(NOECHO) $(ECHO) ' },' >> META_new.json
$(NOECHO) $(ECHO) ' "release_status" : "stable",' >> META_new.json
$(NOECHO) $(ECHO) ' "version" : "0.02",' >> META_new.json
$(NOECHO) $(ECHO) ' "x_serialization_backend" : "JSON::PP version 2.27300_01"' >> META_new.json
$(NOECHO) $(ECHO) '}' >> META_new.json
-$(NOECHO) $(MV) META_new.json $(DISTVNAME)/META.json
# --- MakeMaker signature section:
@ -639,6 +694,7 @@ tardist : $(DISTVNAME).tar$(SUFFIX)
uutardist : $(DISTVNAME).tar$(SUFFIX)
uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu
$(NOECHO) $(ECHO) 'Created $(DISTVNAME).tar$(SUFFIX)_uu'
$(DISTVNAME).tar$(SUFFIX) : distdir
$(PREOP)
@ -646,6 +702,7 @@ $(DISTVNAME).tar$(SUFFIX) : distdir
$(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
$(RM_RF) $(DISTVNAME)
$(COMPRESS) $(DISTVNAME).tar
$(NOECHO) $(ECHO) 'Created $(DISTVNAME).tar$(SUFFIX)'
$(POSTOP)
zipdist : $(DISTVNAME).zip
@ -655,12 +712,14 @@ $(DISTVNAME).zip : distdir
$(PREOP)
$(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
$(RM_RF) $(DISTVNAME)
$(NOECHO) $(ECHO) 'Created $(DISTVNAME).zip'
$(POSTOP)
shdist : distdir
$(PREOP)
$(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
$(RM_RF) $(DISTVNAME)
$(NOECHO) $(ECHO) 'Created $(DISTVNAME).shar'
$(POSTOP)
@ -684,25 +743,29 @@ disttest : distdir
# --- 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});"
$(ABSPERLRUN) -MExtUtils::Manifest=maniread -e '@all = sort keys %{ maniread() };' \
-e 'print(qq{Executing $(CI) @all\n});' \
-e 'system(qq{$(CI) @all}) == 0 or die $$!;' \
-e 'print(qq{Executing $(RCS_LABEL) ...\n});' \
-e 'system(qq{$(RCS_LABEL) @all}) == 0 or die $$!;' --
# --- 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"' --
$(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'exit unless -e q{META.yml};' \
-e 'eval { maniadd({q{META.yml} => q{Module YAML meta-data (added by MakeMaker)}}) }' \
-e ' or print "Could not add META.yml to MANIFEST: $$$${'\''@'\''}\n"' --
$(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'exit unless -f q{META.json};' \
-e 'eval { maniadd({q{META.json} => q{Module JSON meta-data (added by MakeMaker)}}) }' \
-e ' or print "Could not add META.json 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"' --
distsignature : distmeta
$(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
@ -736,50 +799,51 @@ doc__install : doc_site_install
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)
"$(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)
"$(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)
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)
"$(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)
"$(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) $(ECHO) Appending installation info to "$(DESTINSTALLSITEARCH)/perllocal.pod"
-$(NOECHO) umask 02; $(MKPATH) "$(DESTINSTALLSITEARCH)"
-$(NOECHO) umask 02; $(DOC_INSTALL) \
"Module" "$(NAME)" \
"installed into" "$(INSTALLSITELIB)" \
"installed into" $(INSTALLSITELIB) \
LINKTYPE "$(LINKTYPE)" \
VERSION "$(VERSION)" \
EXE_FILES "$(EXE_FILES)" \
>> $(DESTINSTALLSITEARCH)/perllocal.pod
>> "$(DESTINSTALLSITEARCH)/perllocal.pod"
doc_vendor_install :: all
@ -790,12 +854,11 @@ uninstall :: uninstall_from_$(INSTALLDIRS)dirs
uninstall_from_perldirs ::
uninstall_from_sitedirs ::
$(NOECHO) $(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist
$(NOECHO) $(UNINSTALL) "$(SITEARCHEXP)/auto/$(FULLEXT)/.packlist"
uninstall_from_vendordirs ::
# --- MakeMaker force section:
# Phony target to force checking subdirectories.
FORCE :
@ -825,7 +888,7 @@ $(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP)
# --- MakeMaker makeaperl section ---
MAP_TARGET = perl
FULLPERL = /usr/bin/perl
FULLPERL = "/usr/bin/perl"
$(MAP_TARGET) :: static $(MAKE_APERL_FILE)
$(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@
@ -833,7 +896,7 @@ $(MAP_TARGET) :: static $(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.PL DIR="" \
MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=
@ -855,10 +918,10 @@ subdirs-test ::
test_dynamic :: pure_all
PERL_DL_NONLAZY=1 $(FULLPERLRUN) "-MExtUtils::Command::MM" "-e" "test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES)
PERL_DL_NONLAZY=1 PERL_USE_UNSAFE_INC=1 $(FULLPERLRUN) "-MExtUtils::Command::MM" "-MTest::Harness" "-e" "undef *Test::Harness::Switches; 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)
PERL_DL_NONLAZY=1 PERL_USE_UNSAFE_INC=1 $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE)
test_ : test_dynamic
@ -869,11 +932,11 @@ 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) '<SOFTPKG NAME="$(DISTNAME)" VERSION="$(VERSION)">' > $(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) ' <ARCHITECTURE NAME="x86_64-linux-gnu-thread-multi-5.24" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' <CODEBASE HREF="" />' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) ' </IMPLEMENTATION>' >> $(DISTNAME).ppd
$(NOECHO) $(ECHO) '</SOFTPKG>' >> $(DISTNAME).ppd
@ -883,33 +946,34 @@ ppd :
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.pm blib/lib/Parse/Pidl.pm \
lib/Parse/Pidl/CUtil.pm blib/lib/Parse/Pidl/CUtil.pm \
lib/Parse/Pidl/Compat.pm blib/lib/Parse/Pidl/Compat.pm \
lib/Parse/Pidl/Dump.pm blib/lib/Parse/Pidl/Dump.pm \
lib/Parse/Pidl/Expr.pm blib/lib/Parse/Pidl/Expr.pm \
lib/Parse/Pidl/IDL.pm blib/lib/Parse/Pidl/IDL.pm \
lib/Parse/Pidl/NDR.pm blib/lib/Parse/Pidl/NDR.pm \
lib/Parse/Pidl/ODL.pm blib/lib/Parse/Pidl/ODL.pm \
lib/Parse/Pidl/Samba3/ClientNDR.pm blib/lib/Parse/Pidl/Samba3/ClientNDR.pm \
lib/Parse/Pidl/Samba3/ServerNDR.pm blib/lib/Parse/Pidl/Samba3/ServerNDR.pm \
lib/Parse/Pidl/Samba3/Template.pm blib/lib/Parse/Pidl/Samba3/Template.pm \
lib/Parse/Pidl/Samba4.pm blib/lib/Parse/Pidl/Samba4.pm \
lib/Parse/Pidl/Samba4/COM/Header.pm blib/lib/Parse/Pidl/Samba4/COM/Header.pm \
lib/Parse/Pidl/Samba4/COM/Proxy.pm blib/lib/Parse/Pidl/Samba4/COM/Proxy.pm \
lib/Parse/Pidl/Samba4/COM/Stub.pm blib/lib/Parse/Pidl/Samba4/COM/Stub.pm \
lib/Parse/Pidl/Samba4/Header.pm blib/lib/Parse/Pidl/Samba4/Header.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/NDR/Server.pm blib/lib/Parse/Pidl/Samba4/NDR/Server.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/Samba4/TDR.pm blib/lib/Parse/Pidl/Samba4/TDR.pm \
lib/Parse/Pidl/Samba4/Template.pm blib/lib/Parse/Pidl/Samba4/Template.pm \
lib/Parse/Pidl/Typelist.pm blib/lib/Parse/Pidl/Typelist.pm \
lib/Parse/Pidl/Util.pm blib/lib/Parse/Pidl/Util.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
lib/Parse/Yapp/Driver.pm blib/lib/Parse/Yapp/Driver.pm \
lib/wscript_build blib/lib/wscript_build
$(NOECHO) $(TOUCH) pm_to_blib

17
bin/pidl/README
View file

@ -4,7 +4,7 @@ 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:
the Samba source tree. Use:
git clone git://git.samba.org/samba.git
Pidl works by building a parse tree from a .pidl file (a simple
@ -13,10 +13,6 @@ dump of it's internal parse tree) or a .idl file
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.
@ -26,6 +22,10 @@ Then run "make install" (as root) to install.
Internals overview:
===================
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:
-- 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
@ -55,9 +55,10 @@ 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.
- Inspect 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
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
- Run the tests (all in tests/)

2
bin/pidl/TODO
View file

@ -14,7 +14,7 @@
- --explain-ndr option that dumps out parse tree ?
- seperate tables for NDR and DCE/RPC
- separate tables for NDR and DCE/RPC
- maybe no tables for NDR at all? we only need them for ndrdump
and that can use dlsym()

0
bin/pidl/blib/arch/.exists Normal file
View file

0
bin/pidl/blib/arch/auto/Parse/Pidl/.exists Normal file
View file

0
bin/pidl/blib/bin/.exists Normal file
View file

0
bin/pidl/blib/lib/Parse/.exists Normal file
View file

44
bin/pidl/blib/lib/Parse/Pidl.pm Normal file
View file

@ -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;

52
bin/pidl/blib/lib/Parse/Pidl/CUtil.pm Normal file
View file

@ -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;

168
bin/pidl/blib/lib/Parse/Pidl/Compat.pm Normal file
View file

@ -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;

294
bin/pidl/blib/lib/Parse/Pidl/Dump.pm Normal file
View file

@ -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 (sort(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 (sort(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;

1444
bin/pidl/blib/lib/Parse/Pidl/Expr.pm Normal file
View file

File diff suppressed because it is too large Load diff

2664
bin/pidl/blib/lib/Parse/Pidl/IDL.pm Normal file
View file

File diff suppressed because it is too large Load diff

1471
bin/pidl/blib/lib/Parse/Pidl/NDR.pm Normal file
View file

File diff suppressed because it is too large Load diff

130
bin/pidl/blib/lib/Parse/Pidl/ODL.pm Normal file
View file

@ -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;

409
bin/pidl/blib/lib/Parse/Pidl/Samba3/ClientNDR.pm Normal file
View file

@ -0,0 +1,409 @@
###################################################
# 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 genpad);
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 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 (sort(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;

322
bin/pidl/blib/lib/Parse/Pidl/Samba3/ServerNDR.pm Normal file
View file

@ -0,0 +1,322 @@
###################################################
# 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 ContainsPipe);
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 pidl_reset() { $res=""; $res_hdr="", $tabs=""; }
sub pidl_return() { my $s = $res; my $h = $res_hdr; pidl_reset(); return ($s, $h) }
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, $check, $cleanup, $return) = @_;
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 (" . $check->($name) . ") {";
indent;
pidl $cleanup->($name) if defined($cleanup);
pidl $return->($name) if defined($return);
deindent;
pidl "}";
pidl "";
}
sub CallWithStruct($$$$$$)
{
my ($pipes_struct, $mem_ctx, $fn, $check, $cleanup, $return) = @_;
my $env = GenerateFunctionOutEnv($fn);
my $hasout = 0;
foreach (@{$fn->{ELEMENTS}}) {
if (grep(/out/, @{$_->{DIRECTION}})) { $hasout = 1; }
}
pidl "ZERO_STRUCT(r->out);" if ($hasout);
foreach (@{$fn->{ELEMENTS}}) {
my @dir = @{$_->{DIRECTION}};
if (grep(/in/, @dir) and grep(/out/, @dir)) {
pidl "r->out.$_->{NAME} = r->in.$_->{NAME};";
}
}
foreach (@{$fn->{ELEMENTS}}) {
next if ContainsPipe($_, $_->{LEVELS}[0]);
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,
$check, $cleanup, $return);
}
}
my $proto = "_$fn->{NAME}(struct pipes_struct *p, struct $fn->{NAME} *r)";
my $ret = "_$fn->{NAME}($pipes_struct, r)";
if ($fn->{RETURN_TYPE}) {
$ret = "r->out.result = $ret";
$proto = mapTypeName($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 ($) {
my ($name) = @_;
return "${name} == NULL";
},
sub ($) {
my ($name) = @_;
return "talloc_free(r);";
},
sub ($) {
my ($name) = @_;
return "return false;";
}
);
pidl "";
pidl "if (p->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) = @_;
pidl_reset();
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 pidl_return();
}
1;

98
bin/pidl/blib/lib/Parse/Pidl/Samba3/Template.pm Normal file
View file

@ -0,0 +1,98 @@
###################################################
# server template function generator
# Copyright tridge@samba.org 2003
# released under the GNU GPL
package Parse::Pidl::Samba3::Template;
use vars qw($VERSION);
$VERSION = '0.01';
use Parse::Pidl::Util qw(genpad);
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 \"ntdomain.h\"
#include \"../librpc/gen_ndr/srv_$name.h\"
";
foreach my $d (@{$data}) {
if ($d->{TYPE} eq "FUNCTION") {
my $fname = $d->{NAME};
my $pad = genpad("$d->{RETURN_TYPE} _$fname");
$res .=
"
/****************************************************************
_$fname
****************************************************************/
$d->{RETURN_TYPE} _$fname(struct pipes_struct *p,
$pad"."struct $fname *r)
{
";
$res .= "\tp->fault_state = DCERPC_FAULT_OP_RNG_ERROR;\n";
if ($d->{RETURN_TYPE} eq "NTSTATUS") {
$res .= "\treturn NT_STATUS_NOT_IMPLEMENTED;\n";
} elsif ($d->{RETURN_TYPE} eq "WERROR") {
$res .= "\treturn WERR_NOT_SUPPORTED;\n";
} elsif ($d->{RETURN_TYPE} eq "HRESULT") {
$res .= "\treturn HRES_ERROR_NOT_SUPPORTED;\n";
}
$res .= "}
";
}
}
}
#####################################################################
# 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;

133
bin/pidl/blib/lib/Parse/Pidl/Samba4.pm Normal file
View file

@ -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;

160
bin/pidl/blib/lib/Parse/Pidl/Samba4/COM/Header.pm Normal file
View file

@ -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;

225
bin/pidl/blib/lib/Parse/Pidl/Samba4/COM/Proxy.pm Normal file
View file

@ -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;

327
bin/pidl/blib/lib/Parse/Pidl/Samba4/COM/Stub.pm Normal file
View file

@ -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;

537
bin/pidl/blib/lib/Parse/Pidl/Samba4/Header.pm Normal file
View file

@ -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 (sort(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 " { __do_not_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;

884
bin/pidl/blib/lib/Parse/Pidl/Samba4/NDR/Client.pm Normal file
View file

@ -0,0 +1,884 @@
###################################################
# 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 genpad);
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 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("TALLOC_FREE(subreq);");
$self->pidl("if (tevent_req_nterror(req, status)) {");
$self->indent;
$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 (sort(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;");
}
my $dest_ptr = "$o$e->{NAME}";
my $elem_size = "sizeof(*$dest_ptr)";
$self->pidl("if ($dest_ptr != $out_var) {");
$self->indent;
if (has_property($e, "charset")) {
$dest_ptr = "discard_const_p(uint8_t *, $dest_ptr)";
}
$self->pidl("memcpy($dest_ptr, $out_var, $copy_len_var * $elem_size);");
$self->deindent;
$self->pidl("}");
$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 (tevent_req_nterror(req, status)) {");
$self->indent;
$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("/* Out parameters */");
foreach my $e (@{$fn->{ELEMENTS}}) {
next unless grep(/out/, @{$e->{DIRECTION}});
$self->ParseCopyArgument($fn, $e, "r.out.", "_");
}
$self->pidl("");
if (defined($fn->{RETURN_TYPE})) {
$self->pidl("/* Result */");
$self->pidl("ZERO_STRUCT(r.out.result);");
$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;

3192
bin/pidl/blib/lib/Parse/Pidl/Samba4/NDR/Parser.pm Normal file
View file

File diff suppressed because it is too large Load diff

335
bin/pidl/blib/lib/Parse/Pidl/Samba4/NDR/Server.pm Normal file
View file

@ -0,0 +1,335 @@
###################################################
# 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 .= "#include <util/debug.h>\n";
$res .= "\n";
foreach my $x (@{$ndr}) {
ParseInterface($x) if ($x->{TYPE} eq "INTERFACE" and not defined($x->{PROPERTIES}{object}));
}
return $res;
}
1;

2461
bin/pidl/blib/lib/Parse/Pidl/Samba4/Python.pm Normal file
View file

File diff suppressed because it is too large Load diff

283
bin/pidl/blib/lib/Parse/Pidl/Samba4/TDR.pm Normal file
View file

@ -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;

103
bin/pidl/blib/lib/Parse/Pidl/Samba4/Template.pm Normal file
View file

@ -0,0 +1,103 @@
###################################################
# 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 Parse::Pidl::Util qw(genpad);
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};
my $pad = genpad("static $d->{RETURN_TYPE} dcesrv_$fname");
$res .=
"
/*
$fname
*/
static $d->{RETURN_TYPE} dcesrv_$fname(struct dcesrv_call_state *dce_call,
$pad"."TALLOC_CTX *mem_ctx,
$pad"."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;

354
bin/pidl/blib/lib/Parse/Pidl/Typelist.pm Normal file
View file

@ -0,0 +1,354 @@
###################################################
# 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",
"HRESULT" => "HRESULT",
"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",
"mode_t" => "uint32",
);
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;

197
bin/pidl/blib/lib/Parse/Pidl/Util.pm Normal file
View file

@ -0,0 +1,197 @@
###################################################
# 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 genpad);
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;
$Data::Dumper::Sortkeys = 1;
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);
}
=item B<genpad>
return an empty string consisting of tabs and spaces suitable for proper indent
of C-functions.
=cut
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);
}
=back
=cut
1;

509
bin/pidl/blib/lib/Parse/Pidl/Wireshark/Conformance.pm Normal file
View file

@ -0,0 +1,509 @@
###################################################
# 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 separated 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.
=item I<CODE START>/I<CODE END>
Begin and end a section of code to be put directly into the generated
source file for the dissector.
=item I<HEADER START>/I<HEADER END>
Begin and end a section of code to be put directly into the generated
header file for the dissector.
=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 $inheaderblock = 0;
my $ln = 0;
foreach (<$fh>) {
$ln++;
next if (/^#.*$/);
next if (/^$/);
s/[\r\n]//g;
if ($_ eq "CODE START") {
if ($incodeblock) {
warning({ FILE => $f, LINE => $ln },
"CODE START inside CODE section");
}
if ($inheaderblock) {
error({ FILE => $f, LINE => $ln },
"CODE START inside HEADER section");
return undef;
}
$incodeblock = 1;
next;
} elsif ($_ eq "CODE END") {
if (!$incodeblock) {
warning({ FILE => $f, LINE => $ln },
"CODE END outside CODE section");
}
if ($inheaderblock) {
error({ FILE => $f, LINE => $ln },
"CODE END inside HEADER section");
return undef;
}
$incodeblock = 0;
next;
} elsif ($incodeblock) {
if (exists $data->{override}) {
$data->{override}.="$_\n";
} else {
$data->{override} = "$_\n";
}
next;
} elsif ($_ eq "HEADER START") {
if ($inheaderblock) {
warning({ FILE => $f, LINE => $ln },
"HEADER START inside HEADER section");
}
if ($incodeblock) {
error({ FILE => $f, LINE => $ln },
"HEADER START inside CODE section");
return undef;
}
$inheaderblock = 1;
next;
} elsif ($_ eq "HEADER END") {
if (!$inheaderblock) {
warning({ FILE => $f, LINE => $ln },
"HEADER END outside HEADER section");
}
if ($incodeblock) {
error({ FILE => $f, LINE => $ln },
"CODE END inside HEADER section");
return undef;
}
$inheaderblock = 0;
next;
} elsif ($inheaderblock) {
if (exists $data->{header}) {
$data->{header}.="$_\n";
} else {
$data->{header} = "$_\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;

1381
bin/pidl/blib/lib/Parse/Pidl/Wireshark/NDR.pm Normal file
View file

File diff suppressed because it is too large Load diff

471
bin/pidl/blib/lib/Parse/Yapp/Driver.pm Normal file
View file

@ -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;

0
bin/pidl/blib/lib/auto/Parse/Pidl/.exists Normal file
View file

37
bin/pidl/blib/lib/wscript_build Normal file
View file

@ -0,0 +1,37 @@
#!/usr/bin/env python
# install the pidl modules
bld.INSTALL_FILES(bld.env.PERL_LIB_INSTALL_DIR,
'''
Parse/Pidl.pm
Parse/Pidl/Samba4.pm
Parse/Pidl/CUtil.pm
Parse/Pidl/Expr.pm
Parse/Pidl/Wireshark/Conformance.pm
Parse/Pidl/Wireshark/NDR.pm
Parse/Pidl/ODL.pm
Parse/Pidl/Dump.pm
Parse/Pidl/Util.pm
Parse/Pidl/Samba4/Header.pm
Parse/Pidl/Samba4/COM/Header.pm
Parse/Pidl/Samba4/COM/Proxy.pm
Parse/Pidl/Samba4/COM/Stub.pm
Parse/Pidl/Samba4/TDR.pm
Parse/Pidl/Samba4/NDR/Server.pm
Parse/Pidl/Samba4/NDR/Client.pm
Parse/Pidl/Samba4/NDR/Parser.pm
Parse/Pidl/Samba4/Python.pm
Parse/Pidl/Samba4/Template.pm
Parse/Pidl/IDL.pm
Parse/Pidl/Typelist.pm
Parse/Pidl/Samba3/ClientNDR.pm
Parse/Pidl/Samba3/ServerNDR.pm
Parse/Pidl/Compat.pm
Parse/Pidl/NDR.pm
''',
flat=False)
if not bld.CONFIG_SET('USING_SYSTEM_PARSE_YAPP_DRIVER'):
bld.INSTALL_FILES(bld.env.PERL_LIB_INSTALL_DIR,
'Parse/Yapp/Driver.pm',
flat=False)

0
bin/pidl/blib/man1/.exists Normal file
View file

424
bin/pidl/blib/man1/pidl.1p Normal file
View file

@ -0,0 +1,424 @@
.\" Automatically generated by Pod::Man 4.07 (Pod::Simple 3.32)
.\"
.\" Standard preamble:
.\" ========================================================================
.de Sp \" Vertical space (when we can't use .PP)
.if t .sp .5v
.if n .sp
..
.de Vb \" Begin verbatim text
.ft CW
.nf
.ne \\$1
..
.de Ve \" End verbatim text
.ft R
.fi
..
.\" Set up some character translations and predefined strings. \*(-- will
.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
.\" double quote, and \*(R" will give a right double quote. \*(C+ will
.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
.\" nothing in troff, for use with C<>.
.tr \(*W-
.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
.ie n \{\
. ds -- \(*W-
. ds PI pi
. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
. ds L" ""
. ds R" ""
. ds C` ""
. ds C' ""
'br\}
.el\{\
. ds -- \|\(em\|
. ds PI \(*p
. ds L" ``
. ds R" ''
. ds C`
. ds C'
'br\}
.\"
.\" Escape single quotes in literal strings from groff's Unicode transform.
.ie \n(.g .ds Aq \(aq
.el .ds Aq '
.\"
.\" If the F register is >0, we'll generate index entries on stderr for
.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
.\" entries marked with X<> in POD. Of course, you'll have to process the
.\" output yourself in some meaningful fashion.
.\"
.\" Avoid warning from groff about undefined register 'F'.
.de IX
..
.if !\nF .nr F 0
.if \nF>0 \{\
. de IX
. tm Index:\\$1\t\\n%\t"\\$2"
..
. if !\nF==2 \{\
. nr % 0
. nr F 2
. \}
.\}
.\" ========================================================================
.\"
.IX Title "PIDL 1p"
.TH PIDL 1p "2016-11-15" "perl v5.24.1" "User Contributed Perl Documentation"
.\" For nroff, turn off justification. Always turn off hyphenation; it makes
.\" way too many mistakes in technical documents.
.if n .ad l
.nh
.SH "NAME"
pidl \- An IDL compiler written in Perl
.SH "SYNOPSIS"
.IX Header "SYNOPSIS"
pidl \-\-help
.PP
pidl [\-\-outputdir[=OUTNAME]] [\-\-includedir \s-1DIR...\s0] [\-\-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=[\s-1OUTPUT\s0]] [<idlfile>.idl]...
.SH "DESCRIPTION"
.IX Header "DESCRIPTION"
pidl is an \s-1IDL\s0 compiler written in Perl that aims to be somewhat
compatible with the midl compiler. \s-1IDL\s0 is short for
\&\*(L"Interface Definition Language\*(R".
.PP
pidl can generate stubs for \s-1DCE/RPC\s0 server code, \s-1DCE/RPC\s0
client code and Wireshark dissectors for \s-1DCE/RPC\s0 traffic.
.PP
\&\s-1IDL\s0 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.
.PP
pidl takes \s-1IDL\s0 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.
.PP
The goal of pidl is to implement a \s-1IDL\s0 compiler that can be used
while developing the \s-1RPC\s0 subsystem in Samba (for
both marshalling/unmarshalling and debugging purposes).
.SH "OPTIONS"
.IX Header "OPTIONS"
.IP "\fI\-\-help\fR" 4
.IX Item "--help"
Show list of available options.
.IP "\fI\-\-version\fR" 4
.IX Item "--version"
Show pidl version
.IP "\fI\-\-outputdir \s-1OUTNAME\s0\fR" 4
.IX Item "--outputdir OUTNAME"
Write output files to the specified directory. Defaults to the current
directory.
.IP "\fI\-\-includedir \s-1DIR\s0\fR" 4
.IX Item "--includedir DIR"
Add \s-1DIR\s0 to the search path used by the preprocessor. This option can be
specified multiple times.
.IP "\fI\-\-parse\-idl\-tree\fR" 4
.IX Item "--parse-idl-tree"
Read internal tree structure from input files rather
than assuming they contain \s-1IDL.\s0
.IP "\fI\-\-dump\-idl\fR" 4
.IX Item "--dump-idl"
Generate a new \s-1IDL\s0 file. File will be named \s-1OUTNAME\s0.idl.
.IP "\fI\-\-header\fR" 4
.IX Item "--header"
Generate a C header file for the specified interface. Filename defaults to \s-1OUTNAME\s0.h.
.IP "\fI\-\-ndr\-parser\fR" 4
.IX Item "--ndr-parser"
Generate a C file and C header containing \s-1NDR\s0 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.
.IP "\fI\-\-tdr\-parser\fR" 4
.IX Item "--tdr-parser"
Generate a C file and C header containing \s-1TDR\s0 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.
.IP "\fI\-\-typelib\fR" 4
.IX Item "--typelib"
Write type information to the specified file.
.IP "\fI\-\-server\fR" 4
.IX Item "--server"
Generate boilerplate for the \s-1RPC\s0 server that implements
the interface. Filename defaults to ndr_OUTNAME_s.c.
.IP "\fI\-\-template\fR" 4
.IX Item "--template"
Generate stubs for a \s-1RPC\s0 server that implements the interface. Output will
be written to stdout.
.IP "\fI\-\-ws\-parser\fR" 4
.IX Item "--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.
.Sp
Pidl will read additional data from an Wireshark conformance file if present.
Such a file should have the same location as the \s-1IDL\s0 file but with the
extension \fIcnf\fR rather than \fIidl\fR. See Parse::Pidl::Wireshark::Conformance
for details on the format of this file.
.IP "\fI\-\-diff\fR" 4
.IX Item "--diff"
Parse an \s-1IDL\s0 file, generate a new \s-1IDL\s0 file based on the internal data
structures and see if there are any differences with the original \s-1IDL\s0 file.
Useful for debugging pidl.
.IP "\fI\-\-dump\-idl\-tree\fR" 4
.IX Item "--dump-idl-tree"
Tell pidl to dump the internal tree representation of an \s-1IDL\s0
file the to disk. Useful for debugging pidl.
.IP "\fI\-\-dump\-ndr\-tree\fR" 4
.IX Item "--dump-ndr-tree"
Tell pidl to dump the internal \s-1NDR\s0 information tree it generated
from the \s-1IDL\s0 file to disk. Useful for debugging pidl.
.IP "\fI\-\-samba3\-ndr\-client\fR" 4
.IX Item "--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 \s-1NDR\s0 code instead.
.IP "\fI\-\-samba3\-ndr\-server\fR" 4
.IX Item "--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 \s-1NDR\s0 code instead.
.SH "IDL SYNTAX"
.IX Header "IDL SYNTAX"
\&\s-1IDL\s0 files are always preprocessed using the C preprocessor.
.PP
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.
.PP
See the section \s-1COMPATIBILITY\s0 for the list of attributes that
pidl supports.
.PP
C\-style comments can be used.
.SS "\s-1CONFORMANT ARRAYS\s0"
.IX Subsection "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.
.PP
So, in this example:
.PP
.Vb 6
\& typedef struct {
\& long abc;
\& long count;
\& long foo;
\& [size_is(count)] long s[*];
\& } Struct1;
.Ve
.PP
it appears like this:
.PP
.Vb 1
\& [size_is] [abc] [count] [foo] [s...]
.Ve
.PP
the first [size_is] field is the allocation size of the array, and
occurs before the array elements and even before the structure
alignment.
.PP
Note that \fIsize_is()\fR can refer to a constant, but that doesn't change
the wire representation. It does not make the array a fixed array.
.PP
midl.exe would write the above array as the following C header:
.PP
.Vb 6
\& typedef struct {
\& long abc;
\& long count;
\& long foo;
\& long s[1];
\& } Struct1;
.Ve
.PP
pidl takes a different approach, and writes it like this:
.PP
.Vb 6
\& typedef struct {
\& long abc;
\& long count;
\& long foo;
\& long *s;
\& } Struct1;
.Ve
.SS "\s-1VARYING ARRAYS\s0"
.IX Subsection "VARYING ARRAYS"
A varying array looks like this:
.PP
.Vb 6
\& typedef struct {
\& long abc;
\& long count;
\& long foo;
\& [size_is(count)] long *s;
\& } Struct1;
.Ve
.PP
This will look like this on the wire:
.PP
.Vb 1
\& [abc] [count] [foo] [PTR_s] [count] [s...]
.Ve
.SS "\s-1FIXED ARRAYS\s0"
.IX Subsection "FIXED ARRAYS"
A fixed array looks like this:
.PP
.Vb 3
\& typedef struct {
\& long s[10];
\& } Struct1;
.Ve
.PP
The \s-1NDR\s0 representation looks just like 10 separate long
declarations. The array size is not encoded on the wire.
.PP
pidl also supports \*(L"inline\*(R" arrays, which are not part of the \s-1IDL/NDR\s0
standard. These are declared like this:
.PP
.Vb 6
\& typedef struct {
\& uint32 foo;
\& uint32 count;
\& uint32 bar;
\& long s[count];
\& } Struct1;
.Ve
.PP
This appears like this:
.PP
.Vb 1
\& [foo] [count] [bar] [s...]
.Ve
.PP
Fixed arrays are an extension added to support some of the strange
embedded structures in security descriptors and spoolss.
.PP
This section is by no means complete. See the OpenGroup and \s-1MSDN
\&\s0 documentation for additional information.
.SH "COMPATIBILITY WITH MIDL"
.IX Header "COMPATIBILITY WITH MIDL"
.SS "Missing features in pidl"
.IX Subsection "Missing features in pidl"
The following \s-1MIDL\s0 features are not (yet) implemented in pidl
or are implemented with an incompatible interface:
.IP "\(bu" 4
Asynchronous communication
.IP "\(bu" 4
Typelibs (.tlb files)
.IP "\(bu" 4
Datagram support (ncadg_*)
.SS "Supported attributes and statements"
.IX Subsection "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.
.SS "\s-1PIDL\s0 Specific properties"
.IX Subsection "PIDL Specific properties"
.IP "public" 4
.IX 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.
.IP "noprint" 4
.IX 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.
.IP "value" 4
.IX 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 \s-1API\s0 more programmer friendly. The
expression can be any C expression.
.IP "relative" 4
.IX Item "relative"
The [relative] property can be supplied on a pointer. When it is used
it declares the pointer as a spoolss style \*(L"relative\*(R" pointer, which
means it appears on the wire as an offset within the current
encapsulating structure. This is not part of normal \s-1IDL/NDR,\s0 but it is
a very useful extension as it avoids the manual encoding of many
complex structures.
.IP "subcontext(length)" 4
.IX Item "subcontext(length)"
Specifies that a size of \fIlength\fR
bytes should be read, followed by a blob of that size,
which will be parsed as \s-1NDR.\s0
.Sp
\&\fIsubcontext()\fR is deprecated now, and should not be used in new code.
Instead, use \fIrepresent_as()\fR or \fItransmit_as()\fR.
.IP "flag" 4
.IX Item "flag"
Specify boolean options, mostly used for
low-level \s-1NDR\s0 options. Several options
can be specified using the | character.
Note that flags are inherited by substructures!
.IP "nodiscriminant" 4
.IX 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 \s-1IDL/NDR,\s0 but is used for some
spoolss structures.
.IP "charset(name)" 4
.IX 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 \s-1UCS2, DOS\s0 and \s-1UTF8.\s0
.SS "Unsupported \s-1MIDL\s0 properties or statements"
.IX Subsection "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.
.SH "EXAMPLES"
.IX Header "EXAMPLES"
.Vb 2
\& # 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
.Ve
.SH "SEE ALSO"
.IX Header "SEE ALSO"
<https://msdn.microsoft.com/en\-us/library/windows/desktop/aa373864%28v=vs.85%29.aspx>
<https://wiki.wireshark.org/DCE/RPC>,
<https://www.samba.org/>,
\&\fIyapp\fR\|(1)
.SH "LICENSE"
.IX Header "LICENSE"
pidl is licensed under the \s-1GNU\s0 General Public License <https://www.gnu.org/licenses/gpl.html>.
.SH "AUTHOR"
.IX Header "AUTHOR"
pidl was written by Andrew Tridgell, Stefan Metzmacher, Tim Potter and Jelmer
Vernooij. The current maintainer is Jelmer Vernooij.
.PP
This manpage was written by Jelmer Vernooij, partially based on the original
pidl \s-1README\s0 by Andrew Tridgell.

0
bin/pidl/blib/man3/.exists Normal file
View file

80
bin/pidl/blib/man3/Parse::Pidl::Dump.3pm Normal file
View file

@ -0,0 +1,80 @@
.\" Automatically generated by Pod::Man 4.07 (Pod::Simple 3.32)
.\"
.\" Standard preamble:
.\" ========================================================================
.de Sp \" Vertical space (when we can't use .PP)
.if t .sp .5v
.if n .sp
..
.de Vb \" Begin verbatim text
.ft CW
.nf
.ne \\$1
..
.de Ve \" End verbatim text
.ft R
.fi
..
.\" Set up some character translations and predefined strings. \*(-- will
.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
.\" double quote, and \*(R" will give a right double quote. \*(C+ will
.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
.\" nothing in troff, for use with C<>.
.tr \(*W-
.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
.ie n \{\
. ds -- \(*W-
. ds PI pi
. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
. ds L" ""
. ds R" ""
. ds C` ""
. ds C' ""
'br\}
.el\{\
. ds -- \|\(em\|
. ds PI \(*p
. ds L" ``
. ds R" ''
. ds C`
. ds C'
'br\}
.\"
.\" Escape single quotes in literal strings from groff's Unicode transform.
.ie \n(.g .ds Aq \(aq
.el .ds Aq '
.\"
.\" If the F register is >0, we'll generate index entries on stderr for
.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
.\" entries marked with X<> in POD. Of course, you'll have to process the
.\" output yourself in some meaningful fashion.
.\"
.\" Avoid warning from groff about undefined register 'F'.
.de IX
..
.if !\nF .nr F 0
.if \nF>0 \{\
. de IX
. tm Index:\\$1\t\\n%\t"\\$2"
..
. if !\nF==2 \{\
. nr % 0
. nr F 2
. \}
.\}
.\" ========================================================================
.\"
.IX Title "Parse::Pidl::Dump 3pm"
.TH Parse::Pidl::Dump 3pm "2016-11-15" "perl v5.24.1" "User Contributed Perl Documentation"
.\" For nroff, turn off justification. Always turn off hyphenation; it makes
.\" way too many mistakes in technical documents.
.if n .ad l
.nh
.SH "NAME"
Parse::Pidl::Dump \- Dump support
.SH "DESCRIPTION"
.IX Header "DESCRIPTION"
This module provides functions that can generate \s-1IDL\s0 code from
internal pidl data structures.

89
bin/pidl/blib/man3/Parse::Pidl::NDR.3pm Normal file
View file

@ -0,0 +1,89 @@
.\" Automatically generated by Pod::Man 4.07 (Pod::Simple 3.32)
.\"
.\" Standard preamble:
.\" ========================================================================
.de Sp \" Vertical space (when we can't use .PP)
.if t .sp .5v
.if n .sp
..
.de Vb \" Begin verbatim text
.ft CW
.nf
.ne \\$1
..
.de Ve \" End verbatim text
.ft R
.fi
..
.\" Set up some character translations and predefined strings. \*(-- will
.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
.\" double quote, and \*(R" will give a right double quote. \*(C+ will
.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
.\" nothing in troff, for use with C<>.
.tr \(*W-
.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
.ie n \{\
. ds -- \(*W-
. ds PI pi
. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
. ds L" ""
. ds R" ""
. ds C` ""
. ds C' ""
'br\}
.el\{\
. ds -- \|\(em\|
. ds PI \(*p
. ds L" ``
. ds R" ''
. ds C`
. ds C'
'br\}
.\"
.\" Escape single quotes in literal strings from groff's Unicode transform.
.ie \n(.g .ds Aq \(aq
.el .ds Aq '
.\"
.\" If the F register is >0, we'll generate index entries on stderr for
.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
.\" entries marked with X<> in POD. Of course, you'll have to process the
.\" output yourself in some meaningful fashion.
.\"
.\" Avoid warning from groff about undefined register 'F'.
.de IX
..
.if !\nF .nr F 0
.if \nF>0 \{\
. de IX
. tm Index:\\$1\t\\n%\t"\\$2"
..
. if !\nF==2 \{\
. nr % 0
. nr F 2
. \}
.\}
.\" ========================================================================
.\"
.IX Title "Parse::Pidl::NDR 3pm"
.TH Parse::Pidl::NDR 3pm "2016-11-15" "perl v5.24.1" "User Contributed Perl Documentation"
.\" For nroff, turn off justification. Always turn off hyphenation; it makes
.\" way too many mistakes in technical documents.
.if n .ad l
.nh
.SH "NAME"
Parse::Pidl::NDR \- NDR parsing information generator
.SH "DESCRIPTION"
.IX Header "DESCRIPTION"
Return a table describing the order in which the parts of an element
should be parsed
Possible level types:
\- \s-1POINTER
\- ARRAY
\- SUBCONTEXT
\- SWITCH
\- DATA\s0
.SH "AUTHOR"
.IX Header "AUTHOR"
Jelmer Vernooij <jelmer@samba.org>

108
bin/pidl/blib/man3/Parse::Pidl::Util.3pm Normal file
View file

@ -0,0 +1,108 @@
.\" Automatically generated by Pod::Man 4.07 (Pod::Simple 3.32)
.\"
.\" Standard preamble:
.\" ========================================================================
.de Sp \" Vertical space (when we can't use .PP)
.if t .sp .5v
.if n .sp
..
.de Vb \" Begin verbatim text
.ft CW
.nf
.ne \\$1
..
.de Ve \" End verbatim text
.ft R
.fi
..
.\" Set up some character translations and predefined strings. \*(-- will
.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
.\" double quote, and \*(R" will give a right double quote. \*(C+ will
.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
.\" nothing in troff, for use with C<>.
.tr \(*W-
.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
.ie n \{\
. ds -- \(*W-
. ds PI pi
. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
. ds L" ""
. ds R" ""
. ds C` ""
. ds C' ""
'br\}
.el\{\
. ds -- \|\(em\|
. ds PI \(*p
. ds L" ``
. ds R" ''
. ds C`
. ds C'
'br\}
.\"
.\" Escape single quotes in literal strings from groff's Unicode transform.
.ie \n(.g .ds Aq \(aq
.el .ds Aq '
.\"
.\" If the F register is >0, we'll generate index entries on stderr for
.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
.\" entries marked with X<> in POD. Of course, you'll have to process the
.\" output yourself in some meaningful fashion.
.\"
.\" Avoid warning from groff about undefined register 'F'.
.de IX
..
.if !\nF .nr F 0
.if \nF>0 \{\
. de IX
. tm Index:\\$1\t\\n%\t"\\$2"
..
. if !\nF==2 \{\
. nr % 0
. nr F 2
. \}
.\}
.\" ========================================================================
.\"
.IX Title "Parse::Pidl::Util 3pm"
.TH Parse::Pidl::Util 3pm "2016-11-15" "perl v5.24.1" "User Contributed Perl Documentation"
.\" For nroff, turn off justification. Always turn off hyphenation; it makes
.\" way too many mistakes in technical documents.
.if n .ad l
.nh
.SH "NAME"
Parse::Pidl::Util \- Generic utility functions for pidl
.SH "SYNOPSIS"
.IX Header "SYNOPSIS"
use Parse::Pidl::Util;
.SH "DESCRIPTION"
.IX Header "DESCRIPTION"
Simple module that contains a couple of trivial helper functions
used throughout the various pidl modules.
.SH "FUNCTIONS"
.IX Header "FUNCTIONS"
.IP "\fBMyDumper\fR a dumper wrapper to prevent dependence on the Data::Dumper module unless we actually need it" 4
.IX Item "MyDumper a dumper wrapper to prevent dependence on the Data::Dumper module unless we actually need it"
.PD 0
.IP "\fBhas_property\fR see if a pidl property list contains a given property" 4
.IX Item "has_property see if a pidl property list contains a given property"
.IP "\fBproperty_matches\fR see if a pidl property matches a value" 4
.IX Item "property_matches see if a pidl property matches a value"
.IP "\fBis_constant\fR return 1 if the string is a C constant" 4
.IX Item "is_constant return 1 if the string is a C constant"
.ie n .IP "\fBmake_str\fR return a """" quoted string, unless already quoted" 4
.el .IP "\fBmake_str\fR return a ``'' quoted string, unless already quoted" 4
.IX Item "make_str return a """" quoted string, unless already quoted"
.ie n .IP "\fBunmake_str\fR unquote a """" quoted string" 4
.el .IP "\fBunmake_str\fR unquote a ``'' quoted string" 4
.IX Item "unmake_str unquote a """" quoted string"
.IP "\fBprint_uuid\fR Print C representation of a \s-1UUID.\s0" 4
.IX Item "print_uuid Print C representation of a UUID."
.IP "\fBParseExpr\fR Interpret an \s-1IDL\s0 expression, substituting particular variables." 4
.IX Item "ParseExpr Interpret an IDL expression, substituting particular variables."
.IP "\fBParseExprExt\fR Interpret an \s-1IDL\s0 expression, substituting particular variables. Can call callbacks when pointers are being dereferenced or variables are being used." 4
.IX Item "ParseExprExt Interpret an IDL expression, substituting particular variables. Can call callbacks when pointers are being dereferenced or variables are being used."
.IP "\fBgenpad\fR return an empty string consisting of tabs and spaces suitable for proper indent of C\-functions." 4
.IX Item "genpad return an empty string consisting of tabs and spaces suitable for proper indent of C-functions."

151
bin/pidl/blib/man3/Parse::Pidl::Wireshark::Conformance.3pm Normal file
View file

@ -0,0 +1,151 @@
.\" Automatically generated by Pod::Man 4.07 (Pod::Simple 3.32)
.\"
.\" Standard preamble:
.\" ========================================================================
.de Sp \" Vertical space (when we can't use .PP)
.if t .sp .5v
.if n .sp
..
.de Vb \" Begin verbatim text
.ft CW
.nf
.ne \\$1
..
.de Ve \" End verbatim text
.ft R
.fi
..
.\" Set up some character translations and predefined strings. \*(-- will
.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
.\" double quote, and \*(R" will give a right double quote. \*(C+ will
.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
.\" nothing in troff, for use with C<>.
.tr \(*W-
.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
.ie n \{\
. ds -- \(*W-
. ds PI pi
. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
. ds L" ""
. ds R" ""
. ds C` ""
. ds C' ""
'br\}
.el\{\
. ds -- \|\(em\|
. ds PI \(*p
. ds L" ``
. ds R" ''
. ds C`
. ds C'
'br\}
.\"
.\" Escape single quotes in literal strings from groff's Unicode transform.
.ie \n(.g .ds Aq \(aq
.el .ds Aq '
.\"
.\" If the F register is >0, we'll generate index entries on stderr for
.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
.\" entries marked with X<> in POD. Of course, you'll have to process the
.\" output yourself in some meaningful fashion.
.\"
.\" Avoid warning from groff about undefined register 'F'.
.de IX
..
.if !\nF .nr F 0
.if \nF>0 \{\
. de IX
. tm Index:\\$1\t\\n%\t"\\$2"
..
. if !\nF==2 \{\
. nr % 0
. nr F 2
. \}
.\}
.\" ========================================================================
.\"
.IX Title "Parse::Pidl::Wireshark::Conformance 3pm"
.TH Parse::Pidl::Wireshark::Conformance 3pm "2016-11-15" "perl v5.24.1" "User Contributed Perl Documentation"
.\" For nroff, turn off justification. Always turn off hyphenation; it makes
.\" way too many mistakes in technical documents.
.if n .ad l
.nh
.SH "NAME"
Parse::Pidl::Wireshark::Conformance \- Conformance file parser for Wireshark
.SH "DESCRIPTION"
.IX Header "DESCRIPTION"
This module supports parsing Wireshark conformance files (*.cnf).
.SH "FILE FORMAT"
.IX Header "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.
.PP
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 separated by spaces.
.PP
The following commands are currently supported:
.IP "\fI\s-1TYPE\s0\fR name dissector ft_type base_type mask valsstring alignment" 4
.IX Item "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.
.IP "\fI\s-1NOEMIT\s0\fR type" 4
.IX Item "NOEMIT type"
Suppress emitting a dissect_type function for the specified type
.IP "\fI\s-1PARAM_VALUE\s0\fR type param" 4
.IX Item "PARAM_VALUE type param"
Set parameter to specify to dissector function for given type.
.IP "\fI\s-1HF_FIELD\s0\fR hf title filter ft_type base_type valsstring mask description" 4
.IX Item "HF_FIELD hf title filter ft_type base_type valsstring mask description"
Generate a custom header field with specified properties.
.IP "\fI\s-1HF_RENAME\s0\fR old_hf_name new_hf_name" 4
.IX Item "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.
.Sp
This can be used in conjunction with \s-1HF_FIELD\s0 in order to make more than
one element use the same filter name.
.IP "\fI\s-1ETT_FIELD\s0\fR ett" 4
.IX Item "ETT_FIELD ett"
Register a custom ett field
.IP "\fI\s-1STRIP_PREFIX\s0\fR prefix" 4
.IX Item "STRIP_PREFIX prefix"
Remove the specified prefix from all function names (if present).
.IP "\fI\s-1PROTOCOL\s0\fR longname shortname filtername" 4
.IX Item "PROTOCOL longname shortname filtername"
Change the short\-, long\- and filter-name for the current interface in
Wireshark.
.IP "\fI\s-1FIELD_DESCRIPTION\s0\fR field desc" 4
.IX Item "FIELD_DESCRIPTION field desc"
Change description for the specified header field. `field' is the hf name of the field.
.IP "\fI\s-1IMPORT\s0\fR dissector code..." 4
.IX Item "IMPORT dissector code..."
Code to insert when generating the specified dissector. \f(CW@HF\fR@ and
\&\f(CW@PARAM\fR@ will be substituted.
.IP "\fI\s-1INCLUDE\s0\fR filename" 4
.IX Item "INCLUDE filename"
Include conformance data from the specified filename in the dissector.
.ie n .IP "\fI\s-1TFS\s0\fR hf_name ""true string"" ""false string""" 4
.el .IP "\fI\s-1TFS\s0\fR hf_name ``true string'' ``false string''" 4
.IX Item "TFS hf_name true string false string"
Override the text shown when a bitmap boolean value is enabled or disabled.
.IP "\fI\s-1MANUAL\s0\fR fn_name" 4
.IX Item "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 \s-1NOEMIT\s0 command does.
.IP "\fI\s-1CODE START\s0\fR/\fI\s-1CODE END\s0\fR Begin and end a section of code to be put directly into the generated source file for the dissector." 4
.IX Item "CODE START/CODE END Begin and end a section of code to be put directly into the generated source file for the dissector."
.PD 0
.IP "\fI\s-1HEADER START\s0\fR/\fI\s-1HEADER END\s0\fR Begin and end a section of code to be put directly into the generated header file for the dissector." 4
.IX Item "HEADER START/HEADER END Begin and end a section of code to be put directly into the generated header file for the dissector."
.PD
.SH "EXAMPLE"
.IX Header "EXAMPLE"
.Vb 1
\& INFO_KEY OpenKey.Ke
.Ve

76
bin/pidl/blib/man3/Parse::Pidl::Wireshark::NDR.3pm Normal file
View file

@ -0,0 +1,76 @@
.\" Automatically generated by Pod::Man 4.07 (Pod::Simple 3.32)
.\"
.\" Standard preamble:
.\" ========================================================================
.de Sp \" Vertical space (when we can't use .PP)
.if t .sp .5v
.if n .sp
..
.de Vb \" Begin verbatim text
.ft CW
.nf
.ne \\$1
..
.de Ve \" End verbatim text
.ft R
.fi
..
.\" Set up some character translations and predefined strings. \*(-- will
.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
.\" double quote, and \*(R" will give a right double quote. \*(C+ will
.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
.\" nothing in troff, for use with C<>.
.tr \(*W-
.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
.ie n \{\
. ds -- \(*W-
. ds PI pi
. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
. ds L" ""
. ds R" ""
. ds C` ""
. ds C' ""
'br\}
.el\{\
. ds -- \|\(em\|
. ds PI \(*p
. ds L" ``
. ds R" ''
. ds C`
. ds C'
'br\}
.\"
.\" Escape single quotes in literal strings from groff's Unicode transform.
.ie \n(.g .ds Aq \(aq
.el .ds Aq '
.\"
.\" If the F register is >0, we'll generate index entries on stderr for
.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
.\" entries marked with X<> in POD. Of course, you'll have to process the
.\" output yourself in some meaningful fashion.
.\"
.\" Avoid warning from groff about undefined register 'F'.
.de IX
..
.if !\nF .nr F 0
.if \nF>0 \{\
. de IX
. tm Index:\\$1\t\\n%\t"\\$2"
..
. if !\nF==2 \{\
. nr % 0
. nr F 2
. \}
.\}
.\" ========================================================================
.\"
.IX Title "Parse::Pidl::Wireshark::NDR 3pm"
.TH Parse::Pidl::Wireshark::NDR 3pm "2016-11-15" "perl v5.24.1" "User Contributed Perl Documentation"
.\" For nroff, turn off justification. Always turn off hyphenation; it makes
.\" way too many mistakes in technical documents.
.if n .ad l
.nh
.SH "NAME"
Parse::Pidl::Wireshark::NDR \- Parser generator for Wireshark

0
bin/pidl/blib/script/.exists Normal file
View file

804
bin/pidl/blib/script/pidl Executable file
View file

@ -0,0 +1,804 @@
#!/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<https://msdn.microsoft.com/en-us/library/windows/desktop/aa373864%28v=vs.85%29.aspx>
L<https://wiki.wireshark.org/DCE/RPC>,
L<https://www.samba.org/>,
L<yapp(1)>
=head1 LICENSE
pidl is licensed under the GNU General Public License L<https://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 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_samba3_template) = 0;
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]
--samba3-template print a template for a pipe
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,
'samba3-template' => \$opt_samba3_template,
'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 ($opt_samba3_template) {
require Parse::Pidl::Samba3::Template;
print Parse::Pidl::Samba3::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);

4
bin/pidl/idl.yp
View file

@ -610,7 +610,9 @@ again:
for ($parser->YYData->{INPUT}) {
if (/^\#/) {
if (s/^\# (\d+) \"(.*?)\"( \d+|)//) {
# Linemarker format is described at
# http://gcc.gnu.org/onlinedocs/cpp/Preprocessor-Output.html
if (s/^\# (\d+) \"(.*?)\"(( \d+){1,4}|)//) {
$parser->YYData->{LINE} = $1-1;
$parser->YYData->{FILE} = $2;
goto again;

4
bin/pidl/lib/Parse/Pidl/Dump.pm
View file

@ -39,7 +39,7 @@ sub DumpProperties($)
my $res = "";
foreach my $d ($props) {
foreach my $k (keys %{$d}) {
foreach my $k (sort(keys %{$d})) {
if ($k eq "in") {
$res .= "[in] ";
next;
@ -244,7 +244,7 @@ sub DumpInterfaceProperties($)
my($res);
$res .= "[\n";
foreach my $k (keys %{$data}) {
foreach my $k (sort(keys %{$data})) {
$first || ($res .= ",\n"); $first = 0;
$res .= "$k($data->{$k})";
}

4
bin/pidl/lib/Parse/Pidl/IDL.pm
View file

@ -2576,7 +2576,9 @@ again:
for ($parser->YYData->{INPUT}) {
if (/^\#/) {
if (s/^\# (\d+) \"(.*?)\"( \d+|)//) {
# Linemarker format is described at
# http://gcc.gnu.org/onlinedocs/cpp/Preprocessor-Output.html
if (s/^\# (\d+) \"(.*?)\"(( \d+){1,4}|)//) {
$parser->YYData->{LINE} = $1-1;
$parser->YYData->{FILE} = $2;
goto again;

35
bin/pidl/lib/Parse/Pidl/NDR.pm
View file

@ -35,7 +35,7 @@ use vars qw($VERSION);
$VERSION = '0.01';
@ISA = qw(Exporter);
@EXPORT = qw(GetPrevLevel GetNextLevel ContainsDeferred ContainsPipe ContainsString);
@EXPORT_OK = qw(GetElementLevelTable ParseElement ValidElement align_type mapToScalar ParseType can_contain_deferred is_charset_array);
@EXPORT_OK = qw(GetElementLevelTable ParseElement ReturnTypeElement ValidElement align_type mapToScalar ParseType can_contain_deferred is_charset_array);
use strict;
use Parse::Pidl qw(warning fatal);
@ -805,6 +805,25 @@ sub ParseFunction($$$$)
};
}
sub ReturnTypeElement($)
{
my ($fn) = @_;
return undef unless defined($fn->{RETURN_TYPE});
my $e = {
"NAME" => "result",
"TYPE" => $fn->{RETURN_TYPE},
"PROPERTIES" => undef,
"POINTERS" => 0,
"ARRAY_LEN" => [],
"FILE" => $fn->{FILE},
"LINE" => $fn->{LINE},
};
return ParseElement($e, 0, 0);
}
sub CheckPointerTypes($$)
{
my ($s,$default) = @_;
@ -891,7 +910,8 @@ sub ParseInterface($)
FUNCTIONS => \@functions,
CONSTS => \@consts,
TYPES => \@types,
ENDPOINTS => \@endpoints
ENDPOINTS => \@endpoints,
ORIGINAL => $idl
};
}
@ -952,9 +972,19 @@ sub ContainsString($)
if (property_matches($e, "flag", ".*STR_NULLTERM.*")) {
return 1;
}
if (exists($e->{LEVELS}) and $e->{LEVELS}->[0]->{TYPE} eq "ARRAY" and
($e->{LEVELS}->[0]->{IS_FIXED} or $e->{LEVELS}->[0]->{IS_INLINE}) and
has_property($e, "charset"))
{
return 1;
}
foreach my $l (@{$e->{LEVELS}}) {
return 1 if ($l->{TYPE} eq "ARRAY" and $l->{IS_ZERO_TERMINATED});
}
if (property_matches($e, "charset", ".*DOS.*")) {
return 1;
}
return 0;
}
@ -1073,6 +1103,7 @@ my %property_list = (
"noprint" => ["FUNCTION", "TYPEDEF", "STRUCT", "UNION", "ENUM", "BITMAP", "ELEMENT", "PIPE"],
"nopython" => ["FUNCTION", "TYPEDEF", "STRUCT", "UNION", "ENUM", "BITMAP"],
"todo" => ["FUNCTION"],
"skip" => ["ELEMENT"],
# union
"switch_is" => ["ELEMENT"],

2
bin/pidl/lib/Parse/Pidl/ODL.pm
View file

@ -70,7 +70,7 @@ sub ODL2IDL
next;
}
my $podl = Parse::Pidl::IDL::parse_file($idl_path, $opt_incdirs);
if (defined(@$podl)) {
if (defined($podl)) {
require Parse::Pidl::Typelist;
my $basename = basename($idl_path, ".idl");

13
bin/pidl/lib/Parse/Pidl/Samba3/ClientNDR.pm
View file

@ -13,7 +13,7 @@ use Exporter;
use strict;
use Parse::Pidl qw(fatal warning error);
use Parse::Pidl::Util qw(has_property ParseExpr);
use Parse::Pidl::Util qw(has_property ParseExpr genpad);
use Parse::Pidl::NDR qw(ContainsPipe);
use Parse::Pidl::Typelist qw(mapTypeName);
use Parse::Pidl::Samba4 qw(DeclLong);
@ -28,15 +28,6 @@ sub pidl($$) { my ($self,$txt) = @_; $self->{res} .= $txt ? "$self->{tabs}$txt\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;
@ -59,7 +50,7 @@ sub HeaderProperties($$)
my($props,$ignores) = @_;
my $ret = "";
foreach my $d (keys %{$props}) {
foreach my $d (sort(keys %{$props})) {
next if (grep(/^$d$/, @$ignores));
if($props->{$d} ne "1") {
$ret.= "$d($props->{$d}),";

55
bin/pidl/lib/Parse/Pidl/Samba3/ServerNDR.pm
View file

@ -14,7 +14,7 @@ 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::NDR qw(GetNextLevel ContainsPipe);
use Parse::Pidl::Samba4 qw(ElementStars DeclLong);
use Parse::Pidl::Samba4::Header qw(GenerateFunctionOutEnv);
@ -24,6 +24,8 @@ $VERSION = '0.01';
my $res;
my $res_hdr;
my $tabs = "";
sub pidl_reset() { $res=""; $res_hdr="", $tabs=""; }
sub pidl_return() { my $s = $res; my $h = $res_hdr; pidl_reset(); return ($s, $h) }
sub indent() { $tabs.="\t"; }
sub deindent() { $tabs = substr($tabs, 1); }
sub pidl($) { my ($txt) = @_; $res .= $txt?$tabs.(shift)."\n":"\n"; }
@ -48,9 +50,9 @@ sub DeclLevel($$)
return $res;
}
sub AllocOutVar($$$$$)
sub AllocOutVar($$$$$$$)
{
my ($e, $mem_ctx, $name, $env, $fail) = @_;
my ($e, $mem_ctx, $name, $env, $check, $cleanup, $return) = @_;
my $l = $e->{LEVELS}[0];
@ -83,15 +85,18 @@ sub AllocOutVar($$$$$)
pidl "$name = talloc_zero($mem_ctx, " . DeclLevel($e, 1) . ");";
}
pidl "if ($name == NULL) {";
$fail->();
pidl "if (" . $check->($name) . ") {";
indent;
pidl $cleanup->($name) if defined($cleanup);
pidl $return->($name) if defined($return);
deindent;
pidl "}";
pidl "";
}
sub CallWithStruct($$$$)
sub CallWithStruct($$$$$$)
{
my ($pipes_struct, $mem_ctx, $fn, $fail) = @_;
my ($pipes_struct, $mem_ctx, $fn, $check, $cleanup, $return) = @_;
my $env = GenerateFunctionOutEnv($fn);
my $hasout = 0;
foreach (@{$fn->{ELEMENTS}}) {
@ -100,8 +105,6 @@ sub CallWithStruct($$$$)
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)) {
@ -110,25 +113,28 @@ sub CallWithStruct($$$$)
}
foreach (@{$fn->{ELEMENTS}}) {
next if ContainsPipe($_, $_->{LEVELS}[0]);
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);
AllocOutVar($_, $mem_ctx, "r->out.$_->{NAME}", $env,
$check, $cleanup, $return);
}
}
$ret .= ")";
$proto .= ");";
my $proto = "_$fn->{NAME}(struct pipes_struct *p, struct $fn->{NAME} *r)";
my $ret = "_$fn->{NAME}($pipes_struct, r)";
if ($fn->{RETURN_TYPE}) {
$ret = "r->out.result = $ret";
$proto = "$fn->{RETURN_TYPE} $proto";
$proto = mapTypeName($fn->{RETURN_TYPE})." $proto";
} else {
$proto = "void $proto";
}
pidl_hdr "$proto";
pidl_hdr "$proto;";
pidl "$ret;";
}
@ -176,14 +182,22 @@ sub ParseFunction($$)
pidl "";
CallWithStruct("p", "r", $fn,
sub {
pidl "\ttalloc_free(r);";
pidl "\treturn false;";
sub ($) {
my ($name) = @_;
return "${name} == NULL";
},
sub ($) {
my ($name) = @_;
return "talloc_free(r);";
},
sub ($) {
my ($name) = @_;
return "return false;";
}
);
pidl "";
pidl "if (p->rng_fault_state) {";
pidl "if (p->fault_state) {";
pidl "\ttalloc_free(r);";
pidl "\t/* Return true here, srv_pipe_hnd.c will take care */";
pidl "\treturn true;";
@ -285,8 +299,7 @@ sub Parse($$$)
{
my($ndr,$header,$ndr_header) = @_;
$res = "";
$res_hdr = "";
pidl_reset();
pidl "/*";
pidl " * Unix SMB/CIFS implementation.";
@ -303,7 +316,7 @@ sub Parse($$$)
ParseInterface($_) if ($_->{TYPE} eq "INTERFACE");
}
return ($res, $res_hdr);
return pidl_return();
}
1;

98
bin/pidl/lib/Parse/Pidl/Samba3/Template.pm Normal file
View file

@ -0,0 +1,98 @@
###################################################
# server template function generator
# Copyright tridge@samba.org 2003
# released under the GNU GPL
package Parse::Pidl::Samba3::Template;
use vars qw($VERSION);
$VERSION = '0.01';
use Parse::Pidl::Util qw(genpad);
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 \"ntdomain.h\"
#include \"../librpc/gen_ndr/srv_$name.h\"
";
foreach my $d (@{$data}) {
if ($d->{TYPE} eq "FUNCTION") {
my $fname = $d->{NAME};
my $pad = genpad("$d->{RETURN_TYPE} _$fname");
$res .=
"
/****************************************************************
_$fname
****************************************************************/
$d->{RETURN_TYPE} _$fname(struct pipes_struct *p,
$pad"."struct $fname *r)
{
";
$res .= "\tp->fault_state = DCERPC_FAULT_OP_RNG_ERROR;\n";
if ($d->{RETURN_TYPE} eq "NTSTATUS") {
$res .= "\treturn NT_STATUS_NOT_IMPLEMENTED;\n";
} elsif ($d->{RETURN_TYPE} eq "WERROR") {
$res .= "\treturn WERR_NOT_SUPPORTED;\n";
} elsif ($d->{RETURN_TYPE} eq "HRESULT") {
$res .= "\treturn HRES_ERROR_NOT_SUPPORTED;\n";
}
$res .= "}
";
}
}
}
#####################################################################
# 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;

4
bin/pidl/lib/Parse/Pidl/Samba4/Header.pm
View file

@ -38,7 +38,7 @@ sub HeaderProperties($$)
my($props,$ignores) = @_;
my $ret = "";
foreach my $d (keys %{$props}) {
foreach my $d (sort(keys %{$props})) {
next if (grep(/^$d$/, @$ignores));
if($props->{$d} ne "1") {
$ret.= "$d($props->{$d}),";
@ -142,7 +142,7 @@ sub HeaderEnum($$;$)
my $count = 0;
my $with_val = 0;
my $without_val = 0;
pidl " { __donnot_use_enum_$name=0x7FFFFFFF}\n";
pidl " { __do_not_use_enum_$name=0x7FFFFFFF}\n";
foreach my $e (@{$enum->{ELEMENTS}}) {
my $t = "$e";
my $name;

45
bin/pidl/lib/Parse/Pidl/Samba4/NDR/Client.pm
View file

@ -11,7 +11,7 @@ use Exporter;
@EXPORT_OK = qw(Parse);
use Parse::Pidl qw(fatal warning error);
use Parse::Pidl::Util qw(has_property ParseExpr);
use Parse::Pidl::Util qw(has_property ParseExpr genpad);
use Parse::Pidl::NDR qw(ContainsPipe);
use Parse::Pidl::Typelist qw(mapTypeName);
use Parse::Pidl::Samba4 qw(choose_header is_intree DeclLong);
@ -29,15 +29,6 @@ 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;
@ -158,9 +149,9 @@ sub ParseFunction_r_Done($$$$)
$self->pidl("");
$self->pidl("status = dcerpc_binding_handle_call_recv(subreq);");
$self->pidl("if (!NT_STATUS_IS_OK(status)) {");
$self->pidl("TALLOC_FREE(subreq);");
$self->pidl("if (tevent_req_nterror(req, status)) {");
$self->indent;
$self->pidl("tevent_req_nterror(req, status);");
$self->pidl("return;");
$self->deindent;
$self->pidl("}");
@ -259,7 +250,7 @@ sub HeaderProperties($$)
my($props,$ignores) = @_;
my $ret = "";
foreach my $d (keys %{$props}) {
foreach my $d (sort(keys %{$props})) {
next if (grep(/^$d$/, @$ignores));
if($props->{$d} ne "1") {
$ret.= "$d($props->{$d}),";
@ -400,11 +391,16 @@ sub ParseOutputArgument($$$$$$)
$self->pidl("$copy_len_var = $out_length_is;");
}
my $dest_ptr = "$o$e->{NAME}";
my $elem_size = "sizeof(*$dest_ptr)";
$self->pidl("if ($dest_ptr != $out_var) {");
$self->indent;
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}));");
$dest_ptr = "discard_const_p(uint8_t *, $dest_ptr)";
}
$self->pidl("memcpy($dest_ptr, $out_var, $copy_len_var * $elem_size);");
$self->deindent;
$self->pidl("}");
$self->deindent;
$self->pidl("}");
@ -563,9 +559,8 @@ sub ParseFunction_Done($$$$)
$self->pidl("status = dcerpc_$name\_r_recv(subreq, mem_ctx);");
$self->pidl("TALLOC_FREE(subreq);");
$self->pidl("if (!NT_STATUS_IS_OK(status)) {");
$self->pidl("if (tevent_req_nterror(req, status)) {");
$self->indent;
$self->pidl("tevent_req_nterror(req, status);");
$self->pidl("return;");
$self->deindent;
$self->pidl("}");
@ -693,6 +688,20 @@ sub ParseFunction_Sync($$$$)
}
$self->pidl("");
$self->pidl("/* Out parameters */");
foreach my $e (@{$fn->{ELEMENTS}}) {
next unless grep(/out/, @{$e->{DIRECTION}});
$self->ParseCopyArgument($fn, $e, "r.out.", "_");
}
$self->pidl("");
if (defined($fn->{RETURN_TYPE})) {
$self->pidl("/* Result */");
$self->pidl("ZERO_STRUCT(r.out.result);");
$self->pidl("");
}
$self->pidl("status = dcerpc_$name\_r(h, mem_ctx, &r);");
$self->pidl("if (!NT_STATUS_IS_OK(status)) {");
$self->indent;

305
bin/pidl/lib/Parse/Pidl/Samba4/NDR/Parser.pm
View file

@ -261,7 +261,7 @@ sub check_fully_dereferenced($$)
$nump = $_->{POINTER_INDEX}+1;
}
}
warning($element->{ORIGINAL}, "Got pointer for `$e->{NAME}', expected fully derefenced variable") if ($nump > length($ptr));
warning($element->{ORIGINAL}, "Got pointer for `$e->{NAME}', expected fully dereferenced variable") if ($nump > length($ptr));
return ($origvar);
}
}
@ -321,39 +321,118 @@ sub check_null_pointer($$$$)
}
}
sub is_deferred_switch_non_empty($)
{
# 1 if there needs to be a deferred branch in an ndr_pull/push,
# 0 otherwise.
my ($e) = @_;
my $have_default = 0;
foreach my $el (@{$e->{ELEMENTS}}) {
if ($el->{CASE} eq "default") {
$have_default = 1;
}
if ($el->{TYPE} ne "EMPTY") {
if (ContainsDeferred($el, $el->{LEVELS}[0])) {
return 1;
}
}
}
return ! $have_default;
}
sub ParseArrayPullGetSize($$$$$$)
{
my ($self,$e,$l,$ndr,$var_name,$env) = @_;
my $size;
if ($l->{IS_CONFORMANT}) {
$size = "ndr_get_array_size($ndr, " . get_pointer_to($var_name) . ")";
} elsif ($l->{IS_ZERO_TERMINATED} and $l->{SIZE_IS} == 0 and $l->{LENGTH_IS} == 0) { # Noheader arrays
$size = "ndr_get_string_size($ndr, sizeof(*$var_name))";
} else {
$size = ParseExprExt($l->{SIZE_IS}, $env, $e->{ORIGINAL},
check_null_pointer($e, $env, sub { $self->pidl(shift); },
"return ndr_pull_error($ndr, NDR_ERR_INVALID_POINTER, \"NULL Pointer for size_is()\");"),
check_fully_dereferenced($e, $env));
}
$self->pidl("size_$e->{NAME}_$l->{LEVEL_INDEX} = $size;");
my $array_size = "size_$e->{NAME}_$l->{LEVEL_INDEX}";
if (my $range = has_property($e, "range")) {
my ($low, $high) = split(/,/, $range, 2);
if ($low < 0) {
warning(0, "$low is invalid for the range of an array size");
}
if ($low == 0) {
$self->pidl("if ($array_size > $high) {");
} else {
$self->pidl("if ($array_size < $low || $array_size > $high) {");
}
$self->pidl("\treturn ndr_pull_error($ndr, NDR_ERR_RANGE, \"value out of range\");");
$self->pidl("}");
}
return $array_size;
}
#####################################################################
# parse an array - pull side
sub ParseArrayPullGetLength($$$$$$;$)
{
my ($self,$e,$l,$ndr,$var_name,$env,$array_size) = @_;
if (not defined($array_size)) {
$array_size = $self->ParseArrayPullGetSize($e, $l, $ndr, $var_name, $env);
}
if (not $l->{IS_VARYING}) {
return $array_size;
}
my $length = "ndr_get_array_length($ndr, " . get_pointer_to($var_name) .")";
$self->pidl("length_$e->{NAME}_$l->{LEVEL_INDEX} = $length;");
my $array_length = "length_$e->{NAME}_$l->{LEVEL_INDEX}";
if (my $range = has_property($e, "range")) {
my ($low, $high) = split(/,/, $range, 2);
if ($low < 0) {
warning(0, "$low is invalid for the range of an array size");
}
if ($low == 0) {
$self->pidl("if ($array_length > $high) {");
} else {
$self->pidl("if ($array_length < $low || $array_length > $high) {");
}
$self->pidl("\treturn ndr_pull_error($ndr, NDR_ERR_RANGE, \"value out of range\");");
$self->pidl("}");
}
return $array_length;
}
#####################################################################
# parse an array - pull side
sub ParseArrayPullHeader($$$$$$)
{
my ($self,$e,$l,$ndr,$var_name,$env) = @_;
my $length;
my $size;
if ($l->{IS_CONFORMANT}) {
$length = $size = "ndr_get_array_size($ndr, " . get_pointer_to($var_name) . ")";
} elsif ($l->{IS_ZERO_TERMINATED} and $l->{SIZE_IS} == 0 and $l->{LENGTH_IS} == 0) { # Noheader arrays
$length = $size = "ndr_get_string_size($ndr, sizeof(*$var_name))";
} else {
$length = $size = ParseExprExt($l->{SIZE_IS}, $env, $e->{ORIGINAL},
check_null_pointer($e, $env, sub { $self->pidl(shift); },
"return ndr_pull_error($ndr, NDR_ERR_INVALID_POINTER, \"NULL Pointer for size_is()\");"),
check_fully_dereferenced($e, $env));
}
if ((!$l->{IS_SURROUNDING}) and $l->{IS_CONFORMANT}) {
$self->pidl("NDR_CHECK(ndr_pull_array_size($ndr, " . get_pointer_to($var_name) . "));");
}
if ($l->{IS_VARYING}) {
$self->pidl("NDR_CHECK(ndr_pull_array_length($ndr, " . get_pointer_to($var_name) . "));");
$length = "ndr_get_array_length($ndr, " . get_pointer_to($var_name) .")";
}
if ($length ne $size) {
$self->pidl("if ($length > $size) {");
my $array_size = $self->ParseArrayPullGetSize($e, $l, $ndr, $var_name, $env);
my $array_length = $self->ParseArrayPullGetLength($e, $l, $ndr, $var_name, $env, $array_size);
if ($array_length ne $array_size) {
$self->pidl("if ($array_length > $array_size) {");
$self->indent;
$self->pidl("return ndr_pull_error($ndr, NDR_ERR_ARRAY_SIZE, \"Bad array size %u should exceed array length %u\", $size, $length);");
$self->pidl("return ndr_pull_error($ndr, NDR_ERR_ARRAY_SIZE, \"Bad array size %u should exceed array length %u\", $array_size, $array_length);");
$self->deindent;
$self->pidl("}");
}
@ -383,10 +462,10 @@ sub ParseArrayPullHeader($$$$$$)
}
if (ArrayDynamicallyAllocated($e,$l) and not is_charset_array($e,$l)) {
$self->AllocateArrayLevel($e,$l,$ndr,$var_name,$size);
$self->AllocateArrayLevel($e,$l,$ndr,$var_name,$array_size);
}
return $length;
return $array_length;
}
sub compression_alg($$)
@ -610,7 +689,7 @@ sub ParseElementPushLevel
$var_name = get_array_element($var_name, $counter);
if ((($primitives and not $l->{IS_DEFERRED}) or ($deferred and $l->{IS_DEFERRED})) and not $array_pointless) {
$self->pidl("for ($counter = 0; $counter < $length; $counter++) {");
$self->pidl("for ($counter = 0; $counter < ($length); $counter++) {");
$self->indent;
$self->ParseElementPushLevel($e, GetNextLevel($e, $l), $ndr, $var_name, $env, 1, 0);
$self->deindent;
@ -618,7 +697,7 @@ sub ParseElementPushLevel
}
if ($deferred and ContainsDeferred($e, $l) and not $array_pointless) {
$self->pidl("for ($counter = 0; $counter < $length; $counter++) {");
$self->pidl("for ($counter = 0; $counter < ($length); $counter++) {");
$self->indent;
$self->ParseElementPushLevel($e, GetNextLevel($e, $l), $ndr, $var_name, $env, 0, 1);
$self->deindent;
@ -677,13 +756,15 @@ sub ParsePtrPush($$$$$)
my ($self,$e,$l,$ndr,$var_name) = @_;
if ($l->{POINTER_TYPE} eq "ref") {
$self->pidl("if ($var_name == NULL) {");
$self->indent;
$self->pidl("return ndr_push_error($ndr, NDR_ERR_INVALID_POINTER, \"NULL [ref] pointer\");");
$self->deindent;
$self->pidl("}");
if ($l->{LEVEL_INDEX} > 0) {
$self->pidl("if ($var_name == NULL) {");
$self->indent;
$self->pidl("return ndr_push_error($ndr, NDR_ERR_INVALID_POINTER, \"NULL [ref] pointer\");");
$self->deindent;
$self->pidl("}");
}
if ($l->{LEVEL} eq "EMBEDDED") {
$self->pidl("NDR_CHECK(ndr_push_ref_ptr(ndr));");
$self->pidl("NDR_CHECK(ndr_push_ref_ptr(ndr)); /* $var_name */");
}
} elsif ($l->{POINTER_TYPE} eq "relative") {
$self->pidl("NDR_CHECK(ndr_push_relative_ptr1($ndr, $var_name));");
@ -815,7 +896,7 @@ sub ParseElementPrint($$$$$)
$self->pidl("$ndr->print($ndr, \"\%s: ARRAY(\%d)\", \"$e->{NAME}\", (int)$length);");
$self->pidl("$ndr->depth++;");
$self->pidl("for ($counter=0;$counter<$length;$counter++) {");
$self->pidl("for ($counter = 0; $counter < ($length); $counter++) {");
$self->indent;
$var_name = get_array_element($var_name, $counter);
@ -898,7 +979,11 @@ sub ParseDataPull($$$$$$$)
$var_name = get_pointer_to($var_name);
$self->pidl("NDR_CHECK(".TypeFunctionName("ndr_pull", $l->{DATA_TYPE})."($ndr, $ndr_flags, $var_name));");
if (has_property($e, "skip")) {
$self->pidl("/* [skip] '$var_name' */");
} else {
$self->pidl("NDR_CHECK(".TypeFunctionName("ndr_pull", $l->{DATA_TYPE})."($ndr, $ndr_flags, $var_name));");
}
my $pl = GetPrevLevel($e, $l);
@ -936,7 +1021,11 @@ sub ParseDataPush($$$$$$$)
$var_name = get_pointer_to($var_name);
}
$self->pidl("NDR_CHECK(".TypeFunctionName("ndr_push", $l->{DATA_TYPE})."($ndr, $ndr_flags, $var_name));");
if (has_property($e, "skip")) {
$self->pidl("/* [skip] '$var_name' */");
} else {
$self->pidl("NDR_CHECK(".TypeFunctionName("ndr_push", $l->{DATA_TYPE})."($ndr, $ndr_flags, $var_name));");
}
} else {
$self->ParseTypePush($l->{DATA_TYPE}, $ndr, $var_name, $primitives, $deferred);
}
@ -1034,6 +1123,7 @@ sub ParseElementPullLevel
my($self,$e,$l,$ndr,$var_name,$env,$primitives,$deferred) = @_;
my $ndr_flags = CalcNdrFlags($l, $primitives, $deferred);
my $array_length = undef;
if ($l->{TYPE} eq "ARRAY" and ($l->{IS_VARYING} or $l->{IS_CONFORMANT})) {
$var_name = get_pointer_to($var_name);
@ -1047,20 +1137,7 @@ sub ParseElementPullLevel
$self->ParseSubcontextPullEnd($e, $l, $ndr, $env);
} elsif ($l->{TYPE} eq "ARRAY") {
my $length = $self->ParseArrayPullHeader($e, $l, $ndr, $var_name, $env);
if (my $range = has_property($e, "range")) {
my ($low, $high) = split(/,/, $range, 2);
if ($low < 0) {
warning(0, "$low is invalid for the range of an array size");
}
if ($low == 0) {
$self->pidl("if ($length > $high) {");
} else {
$self->pidl("if ($length < $low || $length > $high) {");
}
$self->pidl("\treturn ndr_pull_error($ndr, NDR_ERR_RANGE, \"value out of range\");");
$self->pidl("}");
}
$array_length = $length;
my $nl = GetNextLevel($e, $l);
@ -1115,7 +1192,7 @@ sub ParseElementPullLevel
$self->ParseMemCtxPullEnd($e, $l, $ndr);
if ($l->{POINTER_TYPE} ne "ref") {
if ($l->{POINTER_TYPE} eq "relative") {
if ($l->{POINTER_TYPE} eq "relative" or $l->{POINTER_TYPE} eq "relative_short") {
$self->pidl("if ($ndr->offset > $ndr->relative_highest_offset) {");
$self->indent;
$self->pidl("$ndr->relative_highest_offset = $ndr->offset;");
@ -1128,26 +1205,12 @@ sub ParseElementPullLevel
}
} elsif ($l->{TYPE} eq "ARRAY" and
not has_fast_array($e,$l) and not is_charset_array($e, $l)) {
my $length = ParseExpr($l->{LENGTH_IS}, $env, $e->{ORIGINAL});
my $length = $array_length;
my $counter = "cntr_$e->{NAME}_$l->{LEVEL_INDEX}";
my $array_name = $var_name;
if ($l->{IS_VARYING}) {
$length = "ndr_get_array_length($ndr, " . get_pointer_to($var_name) .")";
}
if (my $range = has_property($e, "range")) {
my ($low, $high) = split(/,/, $range, 2);
if ($low < 0) {
warning(0, "$low is invalid for the range of an array size");
}
if ($low == 0) {
$self->pidl("if ($length > $high) {");
} else {
$self->pidl("if ($length < $low || $length > $high) {");
}
$self->pidl("\treturn ndr_pull_error($ndr, NDR_ERR_RANGE, \"value out of range\");");
$self->pidl("}");
if (not defined($length)) {
$length = $self->ParseArrayPullGetLength($e, $l, $ndr, $var_name, $env);
}
$var_name = get_array_element($var_name, $counter);
@ -1161,7 +1224,7 @@ sub ParseElementPullLevel
$self->CheckStringTerminator($ndr,$e,$l,$length);
}
$self->pidl("for ($counter = 0; $counter < $length; $counter++) {");
$self->pidl("for ($counter = 0; $counter < ($length); $counter++) {");
$self->indent;
$self->ParseElementPullLevel($e, $nl, $ndr, $var_name, $env, 1, 0);
$self->deindent;
@ -1169,7 +1232,7 @@ sub ParseElementPullLevel
}
if ($deferred and ContainsDeferred($e, $l)) {
$self->pidl("for ($counter = 0; $counter < $length; $counter++) {");
$self->pidl("for ($counter = 0; $counter < ($length); $counter++) {");
$self->indent;
$self->ParseElementPullLevel($e,GetNextLevel($e,$l), $ndr, $var_name, $env, 0, 1);
$self->deindent;
@ -1289,10 +1352,30 @@ sub ParsePtrPull($$$$$)
$self->pidl("}");
}
sub CheckRefPtrs($$$$)
{
my ($self,$e,$ndr,$env) = @_;
return if ContainsPipe($e, $e->{LEVELS}[0]);
return if ($e->{LEVELS}[0]->{TYPE} ne "POINTER");
return if ($e->{LEVELS}[0]->{POINTER_TYPE} ne "ref");
my $var_name = $env->{$e->{NAME}};
$var_name = append_prefix($e, $var_name);
$self->pidl("if ($var_name == NULL) {");
$self->indent;
$self->pidl("return ndr_push_error($ndr, NDR_ERR_INVALID_POINTER, \"NULL [ref] pointer\");");
$self->deindent;
$self->pidl("}");
}
sub ParseStructPushPrimitives($$$$$)
{
my ($self, $struct, $ndr, $varname, $env) = @_;
$self->CheckRefPtrs($_, $ndr, $env) foreach (@{$struct->{ELEMENTS}});
# see if the structure contains a conformant array. If it
# does, then it must be the last element of the structure, and
# we need to push the conformant length early, as it fits on
@ -1578,16 +1661,21 @@ sub DeclarePtrVariables($$)
}
}
sub DeclareArrayVariables($$)
sub DeclareArrayVariables($$;$)
{
my ($self,$e) = @_;
my ($self,$e,$pull) = @_;
foreach my $l (@{$e->{LEVELS}}) {
next if ($l->{TYPE} ne "ARRAY");
if (defined($pull)) {
$self->pidl("uint32_t size_$e->{NAME}_$l->{LEVEL_INDEX} = 0;");
if ($l->{IS_VARYING}) {
$self->pidl("uint32_t length_$e->{NAME}_$l->{LEVEL_INDEX} = 0;");
}
}
next if has_fast_array($e,$l);
next if is_charset_array($e,$l);
if ($l->{TYPE} eq "ARRAY") {
$self->pidl("uint32_t cntr_$e->{NAME}_$l->{LEVEL_INDEX};");
}
$self->pidl("uint32_t cntr_$e->{NAME}_$l->{LEVEL_INDEX};");
}
}
@ -1596,15 +1684,14 @@ sub DeclareArrayVariablesNoZero($$$)
my ($self,$e,$env) = @_;
foreach my $l (@{$e->{LEVELS}}) {
next if ($l->{TYPE} ne "ARRAY");
next if has_fast_array($e,$l);
next if is_charset_array($e,$l);
if ($l->{TYPE} eq "ARRAY") {
my $length = ParseExpr($l->{LENGTH_IS}, $env, $e->{ORIGINAL});
if ($length eq "0") {
my $length = ParseExpr($l->{LENGTH_IS}, $env, $e->{ORIGINAL});
if ($length eq "0") {
warning($e->{ORIGINAL}, "pointless array cntr: 'cntr_$e->{NAME}_$l->{LEVEL_INDEX}': length=$length");
} else {
} else {
$self->pidl("uint32_t cntr_$e->{NAME}_$l->{LEVEL_INDEX};");
}
}
}
}
@ -1620,7 +1707,7 @@ sub DeclareMemCtxVariables($$)
}
if (defined($mem_flags)) {
$self->pidl("TALLOC_CTX *_mem_save_$e->{NAME}_$l->{LEVEL_INDEX};");
$self->pidl("TALLOC_CTX *_mem_save_$e->{NAME}_$l->{LEVEL_INDEX} = NULL;");
}
}
}
@ -1675,7 +1762,7 @@ sub ParseStructPull($$$$)
# declare any internal pointers we need
foreach my $e (@{$struct->{ELEMENTS}}) {
$self->DeclarePtrVariables($e);
$self->DeclareArrayVariables($e);
$self->DeclareArrayVariables($e, "pull");
$self->DeclareMemCtxVariables($e);
}
@ -1788,7 +1875,9 @@ sub ParseUnionPushPrimitives($$$$)
$self->pidl("NDR_CHECK(ndr_push_setup_relative_base_offset1($ndr, $varname, $ndr->offset));");
}
$self->DeclareArrayVariables($el);
$self->ParseElementPush($el, $ndr, {$el->{NAME} => "$varname->$el->{NAME}"}, 1, 0);
my $el_env = {$el->{NAME} => "$varname->$el->{NAME}"};
$self->CheckRefPtrs($el, $ndr, $el_env);
$self->ParseElementPush($el, $ndr, $el_env, 1, 0);
$self->deindent;
}
$self->pidl("break; }");
@ -1853,11 +1942,13 @@ sub ParseUnionPush($$$$)
$self->ParseUnionPushPrimitives($e, $ndr, $varname);
$self->deindent;
$self->pidl("}");
$self->pidl("if (ndr_flags & NDR_BUFFERS) {");
$self->indent;
$self->ParseUnionPushDeferred($e, $ndr, $varname);
$self->deindent;
$self->pidl("}");
if (is_deferred_switch_non_empty($e)) {
$self->pidl("if (ndr_flags & NDR_BUFFERS) {");
$self->indent;
$self->ParseUnionPushDeferred($e, $ndr, $varname);
$self->deindent;
$self->pidl("}");
}
$self->end_flags($e, $ndr);
}
@ -1940,8 +2031,6 @@ sub ParseUnionPullPrimitives($$$$$)
if ($el->{TYPE} ne "EMPTY") {
$self->indent;
$self->DeclarePtrVariables($el);
$self->DeclareArrayVariables($el);
if (defined($e->{PROPERTIES}{relative_base})) {
$self->pidl("NDR_CHECK(ndr_pull_align($ndr, $el->{ALIGN}));");
# set the current offset as base for relative pointers
@ -2004,7 +2093,7 @@ sub ParseUnionPull($$$$)
{
my ($self,$e,$ndr,$varname) = @_;
my $switch_type = $e->{SWITCH_TYPE};
my $needs_deferred_switch = is_deferred_switch_non_empty($e);
$self->pidl("uint32_t level;");
if (defined($switch_type)) {
if (Parse::Pidl::Typelist::typeIs($switch_type, "ENUM")) {
@ -2018,26 +2107,34 @@ sub ParseUnionPull($$$$)
next if ($el->{TYPE} eq "EMPTY");
next if ($double_cases{"$el->{NAME}"});
$self->DeclareMemCtxVariables($el);
$self->DeclarePtrVariables($el);
$self->DeclareArrayVariables($el, "pull");
$double_cases{"$el->{NAME}"} = 1;
}
$self->start_flags($e, $ndr);
$self->pidl("level = ndr_pull_get_switch_value($ndr, $varname);");
$self->pidl("NDR_PULL_CHECK_FLAGS(ndr, ndr_flags);");
$self->pidl("if (ndr_flags & NDR_SCALARS) {");
$self->indent;
if (! $needs_deferred_switch) {
$self->pidl("/* This token is not used again */");
$self->pidl("level = ndr_pull_steal_switch_value($ndr, $varname);");
} else {
$self->pidl("level = ndr_pull_get_switch_value($ndr, $varname);");
}
$self->ParseUnionPullPrimitives($e,$ndr,$varname,$switch_type);
$self->deindent;
$self->pidl("}");
$self->pidl("if (ndr_flags & NDR_BUFFERS) {");
$self->indent;
$self->ParseUnionPullDeferred($e,$ndr,$varname);
$self->deindent;
$self->pidl("}");
if ($needs_deferred_switch) {
$self->pidl("if (ndr_flags & NDR_BUFFERS) {");
$self->indent;
$self->pidl("/* The token is not needed after this. */");
$self->pidl("level = ndr_pull_steal_switch_value($ndr, $varname);");
$self->ParseUnionPullDeferred($e,$ndr,$varname);
$self->deindent;
$self->pidl("}");
}
$self->add_deferred();
$self->end_flags($e, $ndr);
@ -2317,6 +2414,12 @@ sub ParseFunctionPush($$)
EnvSubstituteValue($env, $fn);
foreach my $e (@{$fn->{ELEMENTS}}) {
if (grep(/in/,@{$e->{DIRECTION}})) {
$self->CheckRefPtrs($e, $ndr, $env);
}
}
foreach my $e (@{$fn->{ELEMENTS}}) {
if (grep(/in/,@{$e->{DIRECTION}})) {
$self->ParseElementPush($e, $ndr, $env, 1, 1);
@ -2330,6 +2433,14 @@ sub ParseFunctionPush($$)
$self->indent;
$env = GenerateFunctionOutEnv($fn);
EnvSubstituteValue($env, $fn);
foreach my $e (@{$fn->{ELEMENTS}}) {
if (grep(/out/,@{$e->{DIRECTION}})) {
$self->CheckRefPtrs($e, $ndr, $env);
}
}
foreach my $e (@{$fn->{ELEMENTS}}) {
if (grep(/out/,@{$e->{DIRECTION}})) {
$self->ParseElementPush($e, $ndr, $env, 1, 1);
@ -2386,7 +2497,7 @@ sub ParseFunctionPull($$)
# declare any internal pointers we need
foreach my $e (@{$fn->{ELEMENTS}}) {
$self->DeclarePtrVariables($e);
$self->DeclareArrayVariables($e);
$self->DeclareArrayVariables($e, "pull");
}
my %double_cases = ();

1
bin/pidl/lib/Parse/Pidl/Samba4/NDR/Server.pm
View file

@ -322,6 +322,7 @@ sub Parse($$)
$res = "";
$res .= "/* server functions auto-generated by pidl */\n";
$res .= "#include \"$header\"\n";
$res .= "#include <util/debug.h>\n";
$res .= "\n";
foreach my $x (@{$ndr}) {

1331
bin/pidl/lib/Parse/Pidl/Samba4/Python.pm
View file

File diff suppressed because it is too large Load diff

9
bin/pidl/lib/Parse/Pidl/Samba4/Template.pm
View file

@ -8,6 +8,8 @@ package Parse::Pidl::Samba4::Template;
use vars qw($VERSION);
$VERSION = '0.01';
use Parse::Pidl::Util qw(genpad);
use strict;
my($res);
@ -52,13 +54,16 @@ sub Template($)
foreach my $d (@{$data}) {
if ($d->{TYPE} eq "FUNCTION") {
my $fname = $d->{NAME};
my $pad = genpad("static $d->{RETURN_TYPE} dcesrv_$fname");
$res .=
"
/*
$fname
*/
static $d->{RETURN_TYPE} dcesrv_$fname(struct dcesrv_call_state *dce_call, TALLOC_CTX *mem_ctx,
struct $fname *r)
static $d->{RETURN_TYPE} dcesrv_$fname(struct dcesrv_call_state *dce_call,
$pad"."TALLOC_CTX *mem_ctx,
$pad"."struct $fname *r)
{
";

3
bin/pidl/lib/Parse/Pidl/Typelist.pm
View file

@ -60,6 +60,7 @@ my %scalars = (
"NTTIME_1sec" => "NTTIME",
"NTTIME_hyper" => "NTTIME",
"WERROR" => "WERROR",
"HRESULT" => "HRESULT",
"NTSTATUS" => "NTSTATUS",
"COMRESULT" => "COMRESULT",
"dns_string" => "const char *",
@ -83,7 +84,7 @@ my %aliases = (
"long" => "int32",
"short" => "int16",
"HYPER_T" => "hyper",
"HRESULT" => "COMRESULT",
"mode_t" => "uint32",
);
sub expandAlias($)

17
bin/pidl/lib/Parse/Pidl/Util.pm
View file

@ -6,7 +6,7 @@ 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);
@EXPORT = qw(has_property property_matches ParseExpr ParseExprExt is_constant make_str unmake_str print_uuid MyDumper genpad);
use vars qw($VERSION);
$VERSION = '0.01';
@ -43,6 +43,7 @@ unless we actually need it
sub MyDumper($)
{
require Data::Dumper;
$Data::Dumper::Sortkeys = 1;
my $s = shift;
return Data::Dumper::Dumper($s);
}
@ -175,6 +176,20 @@ sub ParseExprExt($$$$$)
$deref, $use);
}
=item B<genpad>
return an empty string consisting of tabs and spaces suitable for proper indent
of C-functions.
=cut
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);
}
=back
=cut

68
bin/pidl/lib/Parse/Pidl/Wireshark/Conformance.pm
View file

@ -21,7 +21,7 @@ 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.
Arguments to commands are separated by spaces.
The following commands are currently supported:
@ -89,6 +89,14 @@ 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.
=item I<CODE START>/I<CODE END>
Begin and end a section of code to be put directly into the generated
source file for the dissector.
=item I<HEADER START>/I<HEADER END>
Begin and end a section of code to be put directly into the generated
header file for the dissector.
=back
=head1 EXAMPLE
@ -269,9 +277,9 @@ sub handle_noemit($$$)
my ($pos,$data,$type) = @_;
if (defined($type)) {
$data->{noemit}->{$type} = 1;
$data->{noemit}->{$type} = 1;
} else {
$data->{noemit_dissector} = 1;
$data->{noemit_dissector} = 1;
}
}
@ -284,7 +292,7 @@ sub handle_manual($$$)
return;
}
$data->{manual}->{$fn} = 1;
$data->{manual}->{$fn} = 1;
}
sub handle_protocol($$$$$$)
@ -396,6 +404,7 @@ sub ReadConformanceFH($$$)
my ($fh,$data,$f) = @_;
my $incodeblock = 0;
my $inheaderblock = 0;
my $ln = 0;
@ -407,9 +416,27 @@ sub ReadConformanceFH($$$)
s/[\r\n]//g;
if ($_ eq "CODE START") {
if ($incodeblock) {
warning({ FILE => $f, LINE => $ln },
"CODE START inside CODE section");
}
if ($inheaderblock) {
error({ FILE => $f, LINE => $ln },
"CODE START inside HEADER section");
return undef;
}
$incodeblock = 1;
next;
} elsif ($incodeblock and $_ eq "CODE END") {
} elsif ($_ eq "CODE END") {
if (!$incodeblock) {
warning({ FILE => $f, LINE => $ln },
"CODE END outside CODE section");
}
if ($inheaderblock) {
error({ FILE => $f, LINE => $ln },
"CODE END inside HEADER section");
return undef;
}
$incodeblock = 0;
next;
} elsif ($incodeblock) {
@ -419,6 +446,37 @@ sub ReadConformanceFH($$$)
$data->{override} = "$_\n";
}
next;
} elsif ($_ eq "HEADER START") {
if ($inheaderblock) {
warning({ FILE => $f, LINE => $ln },
"HEADER START inside HEADER section");
}
if ($incodeblock) {
error({ FILE => $f, LINE => $ln },
"HEADER START inside CODE section");
return undef;
}
$inheaderblock = 1;
next;
} elsif ($_ eq "HEADER END") {
if (!$inheaderblock) {
warning({ FILE => $f, LINE => $ln },
"HEADER END outside HEADER section");
}
if ($incodeblock) {
error({ FILE => $f, LINE => $ln },
"CODE END inside HEADER section");
return undef;
}
$inheaderblock = 0;
next;
} elsif ($inheaderblock) {
if (exists $data->{header}) {
$data->{header}.="$_\n";
} else {
$data->{header} = "$_\n";
}
next;
}
my @fields = /([^ "]+|"[^"]+")/g;

522
bin/pidl/lib/Parse/Pidl/Wireshark/NDR.pm
View file

@ -57,12 +57,13 @@ sub StripPrefixes($$)
sub field2name($)
{
my($field) = shift;
my($field) = shift;
$field =~ s/_/ /g; # Replace underscores with spaces
$field =~ s/(\w+)/\u\L$1/g; # Capitalise each word
$field =~ s/^(_)*//g; # Remove any starting underscores
$field =~ s/_/ /g; # Replace underscores with spaces
$field =~ s/(\w+)/\u$1/g; # Capitalise each word
return $field;
return $field;
}
sub new($)
@ -143,17 +144,17 @@ sub Enum($$$$)
return if (defined($self->{conformance}->{noemit}->{StripPrefixes($name, $self->{conformance}->{strip_prefixes})}));
foreach (@{$e->{ELEMENTS}}) {
foreach (@{$e->{ELEMENTS}}) {
if (/([^=]*)=(.*)/) {
$self->pidl_hdr("#define $1 ($2)");
}
}
$self->pidl_hdr("extern const value_string $valsstring\[];");
$self->pidl_hdr("int $dissectorname(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *tree _U_, guint8 *drep _U_, int hf_index _U_, guint32 *param _U_);");
$self->pidl_hdr("int $dissectorname(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *tree _U_, dcerpc_info* di _U_, guint8 *drep _U_, int hf_index _U_, g$e->{BASE_TYPE} *param _U_);");
$self->pidl_def("const value_string ".$valsstring."[] = {");
foreach (@{$e->{ELEMENTS}}) {
foreach (@{$e->{ELEMENTS}}) {
next unless (/([^=]*)=(.*)/);
$self->pidl_def("\t{ $1, \"$1\" },");
}
@ -163,19 +164,19 @@ sub Enum($$$$)
$self->pidl_fn_start($dissectorname);
$self->pidl_code("int");
$self->pidl_code("$dissectorname(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *tree _U_, guint8 *drep _U_, int hf_index _U_, guint32 *param _U_)");
$self->pidl_code("$dissectorname(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *tree _U_, dcerpc_info* di _U_, guint8 *drep _U_, int hf_index _U_, g$e->{BASE_TYPE} *param _U_)");
$self->pidl_code("{");
$self->indent;
$self->pidl_code("g$e->{BASE_TYPE} parameter=0;");
$self->pidl_code("if(param){");
$self->pidl_code("if (param) {");
$self->indent;
$self->pidl_code("parameter=(g$e->{BASE_TYPE})*param;");
$self->pidl_code("parameter = *param;");
$self->deindent;
$self->pidl_code("}");
$self->pidl_code("offset = dissect_ndr_$e->{BASE_TYPE}(tvb, offset, pinfo, tree, drep, hf_index, &parameter);");
$self->pidl_code("if(param){");
$self->pidl_code("offset = dissect_ndr_$e->{BASE_TYPE}(tvb, offset, pinfo, tree, di, drep, hf_index, &parameter);");
$self->pidl_code("if (param) {");
$self->indent;
$self->pidl_code("*param=(guint32)parameter;");
$self->pidl_code("*param = parameter;");
$self->deindent;
$self->pidl_code("}");
$self->pidl_code("return offset;");
@ -185,7 +186,14 @@ sub Enum($$$$)
my $enum_size = $e->{BASE_TYPE};
$enum_size =~ s/uint//g;
$self->register_type($name, "offset = $dissectorname(tvb, offset, pinfo, tree, drep, \@HF\@, \@PARAM\@);", "FT_UINT$enum_size", "BASE_DEC", "0", "VALS($valsstring)", $enum_size / 8);
$self->register_type($name, "offset = $dissectorname(tvb, offset, pinfo, tree, di, drep, \@HF\@, \@PARAM\@);", "FT_UINT$enum_size", "BASE_DEC", "0", "VALS($valsstring)", $enum_size / 8);
}
sub Pipe($$$$)
{
my ($self,$e,$name,$ifname) = @_;
error($e->{ORIGINAL}, "Pipe not yet supported");
return;
}
sub Bitmap($$$$)
@ -195,11 +203,11 @@ sub Bitmap($$$$)
$self->register_ett("ett_$ifname\_$name");
$self->pidl_hdr("int $dissectorname(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *tree _U_, guint8 *drep _U_, int hf_index _U_, guint32 param _U_);");
$self->pidl_hdr("int $dissectorname(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *tree _U_, dcerpc_info* di _U_, guint8 *drep _U_, int hf_index _U_, guint32 param _U_);");
$self->pidl_fn_start($dissectorname);
$self->pidl_code("int");
$self->pidl_code("$dissectorname(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *parent_tree _U_, guint8 *drep _U_, int hf_index _U_, guint32 param _U_)");
$self->pidl_code("$dissectorname(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *parent_tree _U_, dcerpc_info* di _U_, guint8 *drep _U_, int hf_index _U_, guint32 param _U_)");
$self->pidl_code("{");
$self->indent;
$self->pidl_code("proto_item *item = NULL;");
@ -215,12 +223,12 @@ sub Bitmap($$$$)
$self->pidl_code("if (parent_tree) {");
$self->indent;
$self->pidl_code("item = proto_tree_add_item(parent_tree, hf_index, tvb, offset, $e->{ALIGN}, TRUE);");
$self->pidl_code("item = proto_tree_add_item(parent_tree, hf_index, tvb, offset, $e->{ALIGN}, DREP_ENC_INTEGER(drep));");
$self->pidl_code("tree = proto_item_add_subtree(item,ett_$ifname\_$name);");
$self->deindent;
$self->pidl_code("}\n");
$self->pidl_code("offset = dissect_ndr_$e->{BASE_TYPE}(tvb, offset, pinfo, NULL, drep, -1, &flags);");
$self->pidl_code("offset = dissect_ndr_$e->{BASE_TYPE}(tvb, offset, pinfo, tree, di, drep, -1, &flags);");
$self->pidl_code("proto_item_append_text(item, \": \");\n");
$self->pidl_code("if (!flags)");
@ -267,7 +275,7 @@ sub Bitmap($$$$)
my $size = $e->{BASE_TYPE};
$size =~ s/uint//g;
$self->register_type($name, "offset = $dissectorname(tvb, offset, pinfo, tree, drep, \@HF\@, \@PARAM\@);", "FT_UINT$size", "BASE_HEX", "0", "NULL", $size/8);
$self->register_type($name, "offset = $dissectorname(tvb, offset, pinfo, tree, di, drep, \@HF\@, \@PARAM\@);", "FT_UINT$size", "BASE_HEX", "0", "NULL", $size/8);
}
sub ElementLevel($$$$$$$$)
@ -285,26 +293,26 @@ sub ElementLevel($$$$$$$$)
} elsif ($l->{LEVEL} eq "EMBEDDED") {
$type = "embedded";
}
$self->pidl_code("offset = dissect_ndr_$type\_pointer(tvb, offset, pinfo, tree, drep, $myname\_, $ptrtype_mappings{$l->{POINTER_TYPE}}, \"Pointer to ".field2name(StripPrefixes($e->{NAME}, $self->{conformance}->{strip_prefixes})) . " ($e->{TYPE})\",$hf);");
$self->pidl_code("offset = dissect_ndr_$type\_pointer(tvb, offset, pinfo, tree, di, drep, $myname\_, $ptrtype_mappings{$l->{POINTER_TYPE}}, \"Pointer to ".field2name(StripPrefixes($e->{NAME}, $self->{conformance}->{strip_prefixes})) . " ($e->{TYPE})\",$hf);");
} elsif ($l->{TYPE} eq "ARRAY") {
if ($l->{IS_INLINE}) {
error($e->{ORIGINAL}, "Inline arrays not supported");
} elsif ($l->{IS_FIXED}) {
$self->pidl_code("int i;");
$self->pidl_code("for (i = 0; i < $l->{SIZE_IS}; i++)");
$self->pidl_code("\toffset = $myname\_(tvb, offset, pinfo, tree, drep);");
$self->pidl_code("\toffset = $myname\_(tvb, offset, pinfo, tree, di, drep);");
} else {
my $type = "";
$type .= "c" if ($l->{IS_CONFORMANT});
$type .= "v" if ($l->{IS_VARYING});
unless ($l->{IS_ZERO_TERMINATED}) {
$self->pidl_code("offset = dissect_ndr_u" . $type . "array(tvb, offset, pinfo, tree, drep, $myname\_);");
$self->pidl_code("offset = dissect_ndr_u" . $type . "array(tvb, offset, pinfo, tree, di, drep, $myname\_);");
} else {
my $nl = GetNextLevel($e,$l);
$self->pidl_code("char *data;");
$self->pidl_code("");
$self->pidl_code("offset = dissect_ndr_$type" . "string(tvb, offset, pinfo, tree, drep, sizeof(g$nl->{DATA_TYPE}), $hf, FALSE, &data);");
$self->pidl_code("offset = dissect_ndr_$type" . "string(tvb, offset, pinfo, tree, di, drep, sizeof(g$nl->{DATA_TYPE}), $hf, FALSE, &data);");
$self->pidl_code("proto_item_append_text(tree, \": %s\", data);");
}
}
@ -317,10 +325,10 @@ sub ElementLevel($$$$$$$$)
if (property_matches($e, "flag", ".*LIBNDR_FLAG_STR_SIZE4.*") and property_matches($e, "flag", ".*LIBNDR_FLAG_STR_LEN4.*")) {
$self->pidl_code("char *data;\n");
$self->pidl_code("offset = dissect_ndr_cvstring(tvb, offset, pinfo, tree, drep, $bs, $hf, FALSE, &data);");
$self->pidl_code("offset = dissect_ndr_cvstring(tvb, offset, pinfo, tree, di, drep, $bs, $hf, FALSE, &data);");
$self->pidl_code("proto_item_append_text(tree, \": %s\", data);");
} elsif (property_matches($e, "flag", ".*LIBNDR_FLAG_STR_SIZE4.*")) {
$self->pidl_code("offset = dissect_ndr_vstring(tvb, offset, pinfo, tree, drep, $bs, $hf, FALSE, NULL);");
$self->pidl_code("offset = dissect_ndr_vstring(tvb, offset, pinfo, tree, di, drep, $bs, $hf, FALSE, NULL);");
} elsif (property_matches($e, "flag", ".*STR_NULLTERM.*")) {
if ($bs == 2) {
$self->pidl_code("offset = dissect_null_term_wstring(tvb, offset, pinfo, tree, drep, $hf , 0);")
@ -333,22 +341,28 @@ sub ElementLevel($$$$$$$$)
} elsif ($l->{DATA_TYPE} eq "DATA_BLOB") {
my $remain = 0;
$remain = 1 if (property_matches($e->{ORIGINAL}, "flag", ".*LIBNDR_FLAG_REMAINING.*"));
$self->pidl_code("offset = dissect_ndr_datablob(tvb, offset, pinfo, tree, drep, $hf, $remain);");
$self->pidl_code("offset = dissect_ndr_datablob(tvb, offset, pinfo, tree, di, drep, $hf, $remain);");
} else {
my $call;
if ($self->{conformance}->{imports}->{$l->{DATA_TYPE}}) {
$call = $self->{conformance}->{imports}->{$l->{DATA_TYPE}}->{DATA};
$self->{conformance}->{imports}->{$l->{DATA_TYPE}}->{USED} = 1;
} elsif (defined($self->{conformance}->{imports}->{"$pn.$e->{NAME}"})) {
$call = $self->{conformance}->{imports}->{"$pn.$e->{NAME}"}->{DATA};
} elsif (defined($self->{conformance}->{imports}->{"$pn.$e->{NAME}"})) {
$call = $self->{conformance}->{imports}->{"$pn.$e->{NAME}"}->{DATA};
$self->{conformance}->{imports}->{"$pn.$e->{NAME}"}->{USED} = 1;
} elsif (defined($self->{conformance}->{types}->{$l->{DATA_TYPE}})) {
$call= $self->{conformance}->{types}->{$l->{DATA_TYPE}}->{DISSECTOR_NAME};
$self->{conformance}->{types}->{$l->{DATA_TYPE}}->{USED} = 1;
} else {
$self->pidl_code("offset = $ifname\_dissect_struct_" . $l->{DATA_TYPE} . "(tvb,offset,pinfo,tree,drep,$hf,$param);");
my $t;
if (ref($l->{DATA_TYPE}) eq "HASH" ) {
$t = "$l->{DATA_TYPE}->{TYPE}_$l->{DATA_TYPE}->{NAME}";
} else {
$t = $l->{DATA_TYPE};
}
$self->pidl_code("offset = $ifname\_dissect_struct_" . $t . "(tvb,offset,pinfo,tree,di,drep,$hf,$param);");
return;
}
@ -364,8 +378,8 @@ sub ElementLevel($$$$$$$$)
}
my $num_bits = ($l->{HEADER_SIZE}*8);
my $hf2 = $self->register_hf_field($hf."_", "Subcontext length", "$ifname.$pn.$_->{NAME}subcontext", "FT_UINT$num_bits", "BASE_HEX", "NULL", 0, "");
$num_bits = 3264 if ($num_bits == 32);
$self->{hf_used}->{$hf2} = 1;
$self->pidl_code("dcerpc_info *di = pinfo->private_data;");
$self->pidl_code("guint$num_bits size;");
$self->pidl_code("int conformant = di->conformant_run;");
$self->pidl_code("tvbuff_t *subtvb;");
@ -374,25 +388,56 @@ sub ElementLevel($$$$$$$$)
# and conformant run skips the dissections of scalars ...
$self->pidl_code("if (!conformant) {");
$self->indent;
$self->pidl_code("offset = dissect_ndr_uint$num_bits(tvb, offset, pinfo, tree, drep, $hf2, &size);");
$self->pidl_code("guint32 saved_flags = di->call_data->flags;");
$self->pidl_code("offset = dissect_ndr_uint$num_bits(tvb, offset, pinfo, tree, di, drep, $hf2, &size);");
# This is a subcontext, there is normally no such thing as
# 64 bit NDR is subcontext so we clear the flag so that we can
# continue to dissect handmarshalled stuff with pidl
$self->pidl_code("di->call_data->flags &= ~DCERPC_IS_NDR64;");
$self->pidl_code("subtvb = tvb_new_subset(tvb, offset, size, -1);");
$self->pidl_code("subtvb = tvb_new_subset(tvb, offset, (const gint)size, -1);");
if ($param ne 0) {
$self->pidl_code("$myname\_(subtvb, 0, pinfo, tree, drep, $param);");
$self->pidl_code("$myname\_(subtvb, 0, pinfo, tree, di, drep, $param);");
} else {
$self->pidl_code("$myname\_(subtvb, 0, pinfo, tree, drep);");
$self->pidl_code("$myname\_(subtvb, 0, pinfo, tree, di, drep);");
}
$self->pidl_code("offset += size;");
$self->pidl_code("offset += (int)size;");
$self->pidl_code("di->call_data->flags = saved_flags;");
$self->deindent;
$self->pidl_code("}");
} elsif ($_->{TYPE} eq "PIPE") {
error($e->{ORIGINAL}, "Type PIPE not yet supported");
} else {
die("Unknown type `$_->{TYPE}'");
}
}
sub Element($$$$$)
sub SwitchType($$;$)
{
my ($self,$e,$pn,$ifname,$isoruseswitch) = @_;
my ($e, $type, $nodiscriminant) = @_;
my $switch_dt = getType($type);
my $switch_type = undef;
if ($switch_dt->{DATA}->{TYPE} eq "ENUM") {
$switch_type = Parse::Pidl::Typelist::enum_type_fn($switch_dt->{DATA});
} elsif ($switch_dt->{DATA}->{TYPE} eq "BITMAP") {
$switch_type = Parse::Pidl::Typelist::bitmap_type_fn($switch_dt->{DATA});
} elsif ($switch_dt->{DATA}->{TYPE} eq "SCALAR") {
if (defined $e->{SWITCH_TYPE}) {
$switch_type = "$e->{SWITCH_TYPE}";
} else {
$switch_type = "$switch_dt->{DATA}->{NAME}";
}
} elsif (not defined $e->{SWITCH_TYPE}) {
$switch_type = $nodiscriminant;
}
return $switch_type
}
sub Element($$$$$$)
{
my ($self,$e,$pn,$ifname,$isoruseswitch,%switchvars) = @_;
my $dissectorname = "$ifname\_dissect\_element\_".StripPrefixes($pn, $self->{conformance}->{strip_prefixes})."\_".StripPrefixes($e->{NAME}, $self->{conformance}->{strip_prefixes});
@ -403,18 +448,35 @@ sub Element($$$$$)
my $name = $isoruseswitch->[1];
my $switch_dt = getType($type);
my $switch_type;
if ($switch_dt->{DATA}->{TYPE} eq "ENUM") {
$switch_type = "g".Parse::Pidl::Typelist::enum_type_fn($switch_dt->{DATA});
} elsif ($switch_dt->{DATA}->{TYPE} eq "SCALAR") {
$switch_type = "g$e->{SWITCH_TYPE}";
my $switch_raw_type = SwitchType($e, $type, "uint32");
if (not defined($switch_raw_type)) {
die("Unknown type[$type]\n");
}
my $switch_type = "g${switch_raw_type}";
if ($name ne "") {
$moreparam = ", $switch_type *".$name;
} else {
$moreparam = "";
}
if (($e->{PROPERTIES}->{switch_is} eq "") && ($switchvars{$name}) &&
#not a "native" type
(!($type =~ /^uint(8|16|1632|32|3264|64)/))) {
$param = $name;
} elsif ( $switch_dt->{DATA}->{TYPE} eq "ENUM") {
$param = $name;
} elsif ($name ne "") {
$param = "*".$name;
}
if ($name ne "") {
$call_code = "offset = $dissectorname(tvb, offset, pinfo, tree, di, drep, &$name);";
} else {
$call_code = "offset = $dissectorname(tvb, offset, pinfo, tree, di, drep);";
}
$moreparam = ", $switch_type *".$name;
$param = $name;
$call_code = "offset = $dissectorname(tvb, offset, pinfo, tree, drep, &$name);";
} else {
$moreparam = "";
$call_code = "offset = $dissectorname(tvb, offset, pinfo, tree, drep);";
$call_code = "offset = $dissectorname(tvb, offset, pinfo, tree, di, drep);";
}
@ -438,6 +500,12 @@ sub Element($$$$$)
BASE_TYPE => "BASE_NONE"
};
}
if (property_matches($e, "flag", ".*LIBNDR_FLAG_ALIGN.*")) {
my $align_flag = $e->{PROPERTIES}->{flag};
if ($align_flag =~ m/LIBNDR_FLAG_ALIGN(\d+)/) {
$call_code = "ALIGN_TO_$1_BYTES; ".$call_code;
}
}
my $hf = $self->register_hf_field("hf_$ifname\_$pn\_$e->{NAME}", field2name($e->{NAME}), "$ifname.$pn.$e->{NAME}", $type->{FT_TYPE}, $type->{BASE_TYPE}, $type->{VALSSTRING}, $type->{MASK}, "");
$self->{hf_used}->{$hf} = 1;
@ -453,13 +521,16 @@ sub Element($$$$$)
foreach (@{$e->{LEVELS}}) {
if (defined $_->{SWITCH_IS}) {
$oldparam = $param;
$param = "*$param";
if (($param ne "0") && (!($param =~ /\*/))) {
$param = "*$param";
}
}
next if ($_->{TYPE} eq "SWITCH");
$self->pidl_def("static int $dissectorname$add(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *tree _U_, guint8 *drep _U_$moreparam);");
next if (defined($self->{conformance}->{noemit}->{"$dissectorname$add"}));
$self->pidl_def("static int $dissectorname$add(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *tree _U_, dcerpc_info* di _U_, guint8 *drep _U_$moreparam);");
$self->pidl_fn_start("$dissectorname$add");
$self->pidl_code("static int");
$self->pidl_code("$dissectorname$add(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *tree _U_, guint8 *drep _U_$moreparam)");
$self->pidl_code("$dissectorname$add(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *tree _U_, dcerpc_info* di _U_, guint8 *drep _U_$moreparam)");
$self->pidl_code("{");
$self->indent;
@ -487,7 +558,7 @@ sub Function($$$)
my %dissectornames;
foreach (@{$fn->{ELEMENTS}}) {
$dissectornames{$_->{NAME}} = $self->Element($_, $fn->{NAME}, $ifname, undef) if not defined($dissectornames{$_->{NAME}});
$dissectornames{$_->{NAME}} = $self->Element($_, $fn->{NAME}, $ifname, undef, undef) if not defined($dissectornames{$_->{NAME}});
}
my $fn_name = $_->{NAME};
@ -496,11 +567,11 @@ sub Function($$$)
$self->PrintIdl(DumpFunction($fn->{ORIGINAL}));
$self->pidl_fn_start("$ifname\_dissect\_$fn_name\_response");
$self->pidl_code("static int");
$self->pidl_code("$ifname\_dissect\_${fn_name}_response(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *tree _U_, guint8 *drep _U_)");
$self->pidl_code("$ifname\_dissect\_${fn_name}_response(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *tree _U_, dcerpc_info* di _U_, guint8 *drep _U_)");
$self->pidl_code("{");
$self->indent;
if ( not defined($fn->{RETURN_TYPE})) {
} elsif ($fn->{RETURN_TYPE} eq "NTSTATUS" or $fn->{RETURN_TYPE} eq "WERROR")
} elsif ($fn->{RETURN_TYPE} eq "NTSTATUS" or $fn->{RETURN_TYPE} eq "WERROR" or $fn->{RETURN_TYPE} eq "HRESULT")
{
$self->pidl_code("guint32 status;\n");
} elsif (my $type = getType($fn->{RETURN_TYPE})) {
@ -509,45 +580,50 @@ sub Function($$$)
} elsif ($type->{DATA}->{TYPE} eq "SCALAR") {
$self->pidl_code("g$fn->{RETURN_TYPE} status;\n");
} else {
error($fn, "return type `$fn->{RETURN_TYPE}' not yet supported");
error($fn, "return type `$fn->{RETURN_TYPE}' not yet supported");
}
} else {
error($fn, "unknown return type `$fn->{RETURN_TYPE}'");
}
$self->pidl_code("pinfo->dcerpc_procedure_name=\"${fn_name}\";");
$self->pidl_code("di->dcerpc_procedure_name=\"${fn_name}\";");
foreach (@{$fn->{ELEMENTS}}) {
if (grep(/out/,@{$_->{DIRECTION}})) {
$self->pidl_code("$dissectornames{$_->{NAME}}");
$self->pidl_code("offset = dissect_deferred_pointers(pinfo, tvb, offset, drep);");
$self->pidl_code("offset = dissect_deferred_pointers(pinfo, tvb, offset, di, drep);");
$self->pidl_code("");
}
}
if (not defined($fn->{RETURN_TYPE})) {
} elsif ($fn->{RETURN_TYPE} eq "NTSTATUS") {
$self->pidl_code("offset = dissect_ntstatus(tvb, offset, pinfo, tree, drep, hf\_$ifname\_status, &status);\n");
$self->pidl_code("if (status != 0 && check_col(pinfo->cinfo, COL_INFO))");
$self->pidl_code("offset = dissect_ntstatus(tvb, offset, pinfo, tree, di, drep, hf\_$ifname\_status, &status);\n");
$self->pidl_code("if (status != 0)");
$self->pidl_code("\tcol_append_fstr(pinfo->cinfo, COL_INFO, \", Error: %s\", val_to_str(status, NT_errors, \"Unknown NT status 0x%08x\"));\n");
$return_types{$ifname}->{"status"} = ["NTSTATUS", "NT Error"];
} elsif ($fn->{RETURN_TYPE} eq "WERROR") {
$self->pidl_code("offset = dissect_ndr_uint32(tvb, offset, pinfo, tree, drep, hf\_$ifname\_werror, &status);\n");
$self->pidl_code("if (status != 0 && check_col(pinfo->cinfo, COL_INFO))");
$self->pidl_code("offset = dissect_ndr_uint32(tvb, offset, pinfo, tree, di, drep, hf\_$ifname\_werror, &status);\n");
$self->pidl_code("if (status != 0)");
$self->pidl_code("\tcol_append_fstr(pinfo->cinfo, COL_INFO, \", Error: %s\", val_to_str(status, WERR_errors, \"Unknown DOS error 0x%08x\"));\n");
$return_types{$ifname}->{"werror"} = ["WERROR", "Windows Error"];
} elsif ($fn->{RETURN_TYPE} eq "HRESULT") {
$self->pidl_code("offset = dissect_ndr_uint32(tvb, offset, pinfo, tree, di, drep, hf\_$ifname\_hresult, &status);\n");
$self->pidl_code("if (status != 0)");
$self->pidl_code("\tcol_append_fstr(pinfo->cinfo, COL_INFO, \", Error: %s\", val_to_str(status, HRES_errors, \"Unknown HRES error 0x%08x\"));\n");
$return_types{$ifname}->{"hresult"} = ["HRESULT", "HRES Windows Error"];
} elsif (my $type = getType($fn->{RETURN_TYPE})) {
if ($type->{DATA}->{TYPE} eq "ENUM") {
my $return_type = "g".Parse::Pidl::Typelist::enum_type_fn($type->{DATA});
my $return_dissect = "dissect_ndr_" .Parse::Pidl::Typelist::enum_type_fn($type->{DATA});
$self->pidl_code("offset = $return_dissect(tvb, offset, pinfo, tree, drep, hf\_$ifname\_$fn->{RETURN_TYPE}_status, &status);");
$self->pidl_code("if (status != 0 && check_col(pinfo->cinfo, COL_INFO))");
$self->pidl_code("offset = $return_dissect(tvb, offset, pinfo, tree, di, drep, hf\_$ifname\_$fn->{RETURN_TYPE}_status, &status);");
$self->pidl_code("if (status != 0)");
$self->pidl_code("\tcol_append_fstr(pinfo->cinfo, COL_INFO, \", Status: %s\", val_to_str(status, $ifname\_$fn->{RETURN_TYPE}\_vals, \"Unknown " . $fn->{RETURN_TYPE} . " error 0x%08x\"));\n");
$return_types{$ifname}->{$fn->{RETURN_TYPE}."_status"} = [$fn->{RETURN_TYPE}, $fn->{RETURN_TYPE}];
} elsif ($type->{DATA}->{TYPE} eq "SCALAR") {
$self->pidl_code("offset = dissect_ndr_$fn->{RETURN_TYPE}(tvb, offset, pinfo, tree, drep, hf\_$ifname\_$fn->{RETURN_TYPE}_status, &status);");
$self->pidl_code("if (status != 0 && check_col(pinfo->cinfo, COL_INFO))");
$self->pidl_code("offset = dissect_ndr_$fn->{RETURN_TYPE}(tvb, offset, pinfo, tree, di, drep, hf\_$ifname\_$fn->{RETURN_TYPE}_status, &status);");
$self->pidl_code("if (status != 0)");
$self->pidl_code("\tcol_append_fstr(pinfo->cinfo, COL_INFO, \", Status: %d\", status);\n");
$return_types{$ifname}->{$fn->{RETURN_TYPE}."_status"} = [$fn->{RETURN_TYPE}, $fn->{RETURN_TYPE}];
}
@ -560,14 +636,14 @@ sub Function($$$)
$self->pidl_fn_start("$ifname\_dissect\_$fn_name\_request");
$self->pidl_code("static int");
$self->pidl_code("$ifname\_dissect\_${fn_name}_request(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *tree _U_, guint8 *drep _U_)");
$self->pidl_code("$ifname\_dissect\_${fn_name}_request(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *tree _U_, dcerpc_info* di _U_, guint8 *drep _U_)");
$self->pidl_code("{");
$self->indent;
$self->pidl_code("pinfo->dcerpc_procedure_name=\"${fn_name}\";");
$self->pidl_code("di->dcerpc_procedure_name=\"${fn_name}\";");
foreach (@{$fn->{ELEMENTS}}) {
if (grep(/in/,@{$_->{DIRECTION}})) {
$self->pidl_code("$dissectornames{$_->{NAME}}");
$self->pidl_code("offset = dissect_deferred_pointers(pinfo, tvb, offset, drep);");
$self->pidl_code("offset = dissect_deferred_pointers(pinfo, tvb, offset, di, drep);");
}
}
@ -591,26 +667,28 @@ sub Struct($$$$)
my $varswitchs = {};
# will contain the switch var declaration;
my $vars = [];
my %switch_hash;
foreach (@{$e->{ELEMENTS}}) {
if (has_property($_, "switch_is")) {
$varswitchs->{$_->{PROPERTIES}->{switch_is}} = [];
$switch_hash{ $_->{PROPERTIES}->{switch_is}} = $_->{PROPERTIES}->{switch_is};
}
}
foreach (@{$e->{ELEMENTS}}) {
my $switch_info = undef;
my $v = $_->{NAME};
if (scalar(grep {/$v/} keys(%$varswitchs)) == 1) {
if (scalar(grep {/^$v$/} keys(%$varswitchs)) == 1) {
# This element is one of the switch attribute
my $switch_dt = getType($_->{TYPE});
my $switch_type;
if ($switch_dt->{DATA}->{TYPE} eq "ENUM") {
$switch_type = "g".Parse::Pidl::Typelist::enum_type_fn($switch_dt->{DATA});
} elsif ($switch_dt->{DATA}->{TYPE} eq "SCALAR") {
$switch_type = "g$e->{SWITCH_TYPE}";
my $switch_raw_type = SwitchType($e, $_->{TYPE}, "uint32");
if (not defined($switch_raw_type)) {
die("Unknown type[$_->{TYPE}]\n");
}
my $switch_type = "g${switch_raw_type}";
push @$vars, "$switch_type $v;";
if ($switch_type ne "") {
push @$vars, "$switch_type $v = 0;";
}
$switch_info = [ $_->{TYPE}, $v ];
$varswitchs->{$v} = $switch_info;
}
@ -620,43 +698,62 @@ sub Struct($$$$)
$switch_info = $varswitchs->{$varswitch};
}
$res.="\t".$self->Element($_, $name, $ifname, $switch_info)."\n\n";
$res.="\t".$self->Element($_, $name, $ifname, $switch_info, %switch_hash)."\n\n";
}
$self->pidl_hdr("int $dissectorname(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *parent_tree _U_, guint8 *drep _U_, int hf_index _U_, guint32 param _U_);");
my $doalign = undef;
if ($e->{ALIGN} > 1 and not property_matches($e, "flag", ".*LIBNDR_FLAG_NOALIGN.*")) {
$doalign = 1;
} elsif (property_matches($e, "flag", ".*LIBNDR_FLAG_NOALIGN.*")) {
$doalign = 0;
}
$self->pidl_hdr("int $dissectorname(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *parent_tree _U_, dcerpc_info* di _U_, guint8 *drep _U_, int hf_index _U_, guint32 param _U_);");
$self->pidl_fn_start($dissectorname);
$self->pidl_code("int");
$self->pidl_code("$dissectorname(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *parent_tree _U_, guint8 *drep _U_, int hf_index _U_, guint32 param _U_)");
$self->pidl_code("$dissectorname(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *parent_tree _U_, dcerpc_info* di _U_, guint8 *drep _U_, int hf_index _U_, guint32 param _U_)");
$self->pidl_code("{");
$self->indent;
$self->pidl_code($_) foreach (@$vars);
$self->pidl_code("proto_item *item = NULL;");
$self->pidl_code("proto_tree *tree = NULL;");
if ($e->{ALIGN} > 1) {
$self->pidl_code("dcerpc_info *di = pinfo->private_data;");
if($res) {
$self->pidl_code("proto_tree *tree = NULL;");
}
if (defined($doalign) and $doalign == 0) {
$self->pidl_code("gboolean oldalign = di->no_align;");
}
$self->pidl_code("int old_offset;");
$self->pidl_code("");
if ($e->{ALIGN} > 1 and not property_matches($e, "flag", ".*LIBNDR_FLAG_NOALIGN.*")) {
$self->pidl_code("ALIGN_TO_$e->{ALIGN}_BYTES;");
if (defined($doalign)) {
if ($doalign == 1) {
$self->pidl_code("ALIGN_TO_$e->{ALIGN}_BYTES;");
}
if ($doalign == 0) {
$self->pidl_code("di->no_align = TRUE;");
}
$self->pidl_code("");
}
$self->pidl_code("");
$self->pidl_code("old_offset = offset;");
$self->pidl_code("");
$self->pidl_code("if (parent_tree) {");
$self->indent;
$self->pidl_code("item = proto_tree_add_item(parent_tree, hf_index, tvb, offset, -1, TRUE);");
$self->pidl_code("tree = proto_item_add_subtree(item, ett_$ifname\_$name);");
$self->pidl_code("item = proto_tree_add_item(parent_tree, hf_index, tvb, offset, -1, ENC_NA);");
if($res) {
$self->pidl_code("tree = proto_item_add_subtree(item, ett_$ifname\_$name);");
}
$self->deindent;
$self->pidl_code("}");
$self->pidl_code("");
$self->pidl_code("\n$res");
$self->deindent;
$self->pidl_code("$res");
$self->indent;
$self->pidl_code("proto_item_set_len(item, offset-old_offset);\n");
if ($e->{ALIGN} > 1) {
if (defined($doalign) and $doalign == 1) {
$self->pidl_code("");
$self->pidl_code("if (di->call_data->flags & DCERPC_IS_NDR64) {");
$self->indent;
@ -664,13 +761,17 @@ sub Struct($$$$)
$self->deindent;
$self->pidl_code("}");
}
if (defined($doalign) and $doalign == 0) {
$self->pidl_code("");
$self->pidl_code("di->no_align = oldalign;");
}
$self->pidl_code("");
$self->pidl_code("return offset;");
$self->deindent;
$self->pidl_code("}\n");
$self->pidl_fn_end($dissectorname);
$self->register_type($name, "offset = $dissectorname(tvb,offset,pinfo,tree,drep,\@HF\@,\@PARAM\@);", "FT_NONE", "BASE_NONE", 0, "NULL", 0);
$self->register_type($name, "offset = $dissectorname(tvb,offset,pinfo,tree,di,drep,\@HF\@,\@PARAM\@);", "FT_NONE", "BASE_NONE", 0, "NULL", 0);
}
sub Union($$$$)
@ -687,25 +788,22 @@ sub Union($$$$)
foreach (@{$e->{ELEMENTS}}) {
$res.="\n\t\t$_->{CASE}:\n";
if ($_->{TYPE} ne "EMPTY") {
$res.="\t\t\t".$self->Element($_, $name, $ifname, undef)."\n";
$res.="\t\t\t".$self->Element($_, $name, $ifname, undef, undef)."\n";
}
$res.="\t\tbreak;\n";
}
my $switch_type;
my $switch_dissect;
my $switch_dt = getType($e->{SWITCH_TYPE});
if ($switch_dt->{DATA}->{TYPE} eq "ENUM") {
$switch_type = "g".Parse::Pidl::Typelist::enum_type_fn($switch_dt->{DATA});
$switch_dissect = "dissect_ndr_" .Parse::Pidl::Typelist::enum_type_fn($switch_dt->{DATA});
} elsif ($switch_dt->{DATA}->{TYPE} eq "SCALAR") {
$switch_type = "g$e->{SWITCH_TYPE}";
$switch_dissect = "dissect_ndr_$e->{SWITCH_TYPE}";
my $switch_type = undef;
my $switch_dissect = undef;
my $switch_raw_type = SwitchType($e, $e->{SWITCH_TYPE});
if (defined($switch_raw_type)) {
$switch_type = "g${switch_raw_type}";
$switch_dissect = "dissect_ndr_${switch_raw_type}";
}
$self->pidl_fn_start($dissectorname);
$self->pidl_code("static int");
$self->pidl_code("$dissectorname(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *parent_tree _U_, guint8 *drep _U_, int hf_index _U_, guint32 param _U_)");
$self->pidl_code("$dissectorname(tvbuff_t *tvb _U_, int offset _U_, packet_info *pinfo _U_, proto_tree *parent_tree _U_, dcerpc_info* di _U_, guint8 *drep _U_, int hf_index _U_, guint32 param _U_)");
$self->pidl_code("{");
$self->indent;
$self->pidl_code("proto_item *item = NULL;");
@ -721,15 +819,14 @@ sub Union($$$$)
$self->pidl_code("old_offset = offset;");
$self->pidl_code("if (parent_tree) {");
$self->indent;
$self->pidl_code("item = proto_tree_add_text(parent_tree, tvb, offset, -1, \"$name\");");
$self->pidl_code("tree = proto_item_add_subtree(item, ett_$ifname\_$name);");
$self->pidl_code("tree = proto_tree_add_subtree(parent_tree, tvb, offset, -1, ett_$ifname\_$name, &item, \"$name\");");
$self->deindent;
$self->pidl_code("}");
$self->pidl_code("");
if (defined $switch_type) {
$self->pidl_code("offset = $switch_dissect(tvb, offset, pinfo, tree, drep, hf_index, &level);");
$self->pidl_code("offset = $switch_dissect(tvb, offset, pinfo, tree, di, drep, hf_index, &level);");
if ($e->{ALIGN} > 1) {
$self->pidl_code("ALIGN_TO_$e->{ALIGN}_BYTES;");
@ -747,7 +844,7 @@ sub Union($$$$)
$self->pidl_code("}");
$self->pidl_fn_end($dissectorname);
$self->register_type($name, "offset = $dissectorname(tvb, offset, pinfo, tree, drep, \@HF\@, \@PARAM\@);", "FT_NONE", "BASE_NONE", 0, "NULL", 0);
$self->register_type($name, "offset = $dissectorname(tvb, offset, pinfo, tree, di, drep, \@HF\@, \@PARAM\@);", "FT_NONE", "BASE_NONE", 0, "NULL", 0);
}
sub Const($$$)
@ -755,10 +852,10 @@ sub Const($$$)
my ($self,$const,$ifname) = @_;
if (!defined($const->{ARRAY_LEN}[0])) {
$self->pidl_hdr("#define $const->{NAME}\t( $const->{VALUE} )\n");
} else {
$self->pidl_hdr("#define $const->{NAME}\t $const->{VALUE}\n");
}
$self->pidl_hdr("#define $const->{NAME}\t( $const->{VALUE} )\n");
} else {
$self->pidl_hdr("#define $const->{NAME}\t $const->{VALUE}\n");
}
}
sub Typedef($$$$)
@ -773,13 +870,13 @@ sub Type($$$$)
my ($self, $e, $name, $ifname) = @_;
$self->PrintIdl(DumpType($e->{ORIGINAL}));
{
ENUM => \&Enum,
STRUCT => \&Struct,
UNION => \&Union,
BITMAP => \&Bitmap,
TYPEDEF => \&Typedef
TYPEDEF => \&Typedef,
PIPE => \&Pipe
}->{$e->{TYPE}}->($self, $e, $name, $ifname);
}
@ -792,35 +889,37 @@ sub RegisterInterface($$)
$self->pidl_code("{");
$self->indent;
$self->{res}->{headers} .= "void proto_register_dcerpc_$x->{NAME}(void);\n";
$self->{res}->{code}.=$self->DumpHfList()."\n";
$self->{res}->{code}.="\n".DumpEttList($self->{ett})."\n";
if (defined($x->{UUID})) {
# These can be changed to non-pidl_code names if the old dissectors
# in epan/dissctors are deleted.
# These can be changed to non-pidl_code names if the old
# dissectors in epan/dissectors are deleted.
my $name = uc($x->{NAME}) . " (pidl)";
my $short_name = uc($x->{NAME});
my $filter_name = $x->{NAME};
my $name = uc($x->{NAME}) . " (pidl)";
my $short_name = uc($x->{NAME});
my $filter_name = $x->{NAME};
if (has_property($x, "helpstring")) {
$name = $x->{PROPERTIES}->{helpstring};
}
if (has_property($x, "helpstring")) {
$name = $x->{PROPERTIES}->{helpstring};
}
if (defined($self->{conformance}->{protocols}->{$x->{NAME}})) {
if (defined($self->{conformance}->{protocols}->{$x->{NAME}})) {
$short_name = $self->{conformance}->{protocols}->{$x->{NAME}}->{SHORTNAME};
$name = $self->{conformance}->{protocols}->{$x->{NAME}}->{LONGNAME};
$filter_name = $self->{conformance}->{protocols}->{$x->{NAME}}->{FILTERNAME};
}
}
$self->pidl_code("proto_dcerpc_$x->{NAME} = proto_register_protocol(".make_str($name).", ".make_str($short_name).", ".make_str($filter_name).");");
$self->pidl_code("proto_dcerpc_$x->{NAME} = proto_register_protocol(".make_str($name).", ".make_str($short_name).", ".make_str($filter_name).");");
$self->pidl_code("proto_register_field_array(proto_dcerpc_$x->{NAME}, hf, array_length (hf));");
$self->pidl_code("proto_register_subtree_array(ett, array_length(ett));");
$self->pidl_code("proto_register_field_array(proto_dcerpc_$x->{NAME}, hf, array_length (hf));");
$self->pidl_code("proto_register_subtree_array(ett, array_length(ett));");
} else {
$self->pidl_code("proto_dcerpc = proto_get_id_by_filter_name(\"dcerpc\");");
$self->pidl_code("proto_register_field_array(proto_dcerpc, hf, array_length(hf));");
$self->pidl_code("proto_register_subtree_array(ett, array_length(ett));");
$self->pidl_code("proto_dcerpc = proto_get_id_by_filter_name(\"dcerpc\");");
$self->pidl_code("proto_register_field_array(proto_dcerpc, hf, array_length(hf));");
$self->pidl_code("proto_register_subtree_array(ett, array_length(ett));");
}
$self->deindent;
@ -834,16 +933,18 @@ sub RegisterInterfaceHandoff($$)
if (defined($x->{UUID})) {
$self->pidl_fn_start("proto_reg_handoff_dcerpc_$x->{NAME}");
$self->pidl_code("void proto_reg_handoff_dcerpc_$x->{NAME}(void)");
$self->pidl_code("{");
$self->indent;
$self->pidl_code("dcerpc_init_uuid(proto_dcerpc_$x->{NAME}, ett_dcerpc_$x->{NAME},");
$self->pidl_code("\t&uuid_dcerpc_$x->{NAME}, ver_dcerpc_$x->{NAME},");
$self->pidl_code("\t$x->{NAME}_dissectors, hf_$x->{NAME}_opnum);");
$self->deindent;
$self->pidl_code("}");
$self->pidl_code("void proto_reg_handoff_dcerpc_$x->{NAME}(void)");
$self->pidl_code("{");
$self->indent;
$self->pidl_code("dcerpc_init_uuid(proto_dcerpc_$x->{NAME}, ett_dcerpc_$x->{NAME},");
$self->pidl_code("\t&uuid_dcerpc_$x->{NAME}, ver_dcerpc_$x->{NAME},");
$self->pidl_code("\t$x->{NAME}_dissectors, hf_$x->{NAME}_opnum);");
$self->deindent;
$self->pidl_code("}");
$self->pidl_fn_end("proto_reg_handoff_dcerpc_$x->{NAME}");
$self->{res}->{headers} .= "void proto_reg_handoff_dcerpc_$x->{NAME}(void);\n";
$self->{hf_used}->{"hf_$x->{NAME}_opnum"} = 1;
}
}
@ -889,26 +990,26 @@ sub ProcessInterface($$)
if (defined($x->{UUID})) {
my $if_uuid = $x->{UUID};
$self->pidl_def("/* Version information */\n\n");
$self->pidl_def("/* Version information */\n\n");
$self->pidl_def("static e_uuid_t uuid_dcerpc_$x->{NAME} = {");
$self->pidl_def("\t0x" . substr($if_uuid, 1, 8)
. ", 0x" . substr($if_uuid, 10, 4)
. ", 0x" . substr($if_uuid, 15, 4) . ",");
$self->pidl_def("\t{ 0x" . substr($if_uuid, 20, 2)
$self->pidl_def("static e_guid_t uuid_dcerpc_$x->{NAME} = {");
$self->pidl_def("\t0x" . substr($if_uuid, 1, 8)
. ", 0x" . substr($if_uuid, 10, 4)
. ", 0x" . substr($if_uuid, 15, 4) . ",");
$self->pidl_def("\t{ 0x" . substr($if_uuid, 20, 2)
. ", 0x" . substr($if_uuid, 22, 2)
. ", 0x" . substr($if_uuid, 25, 2)
. ", 0x" . substr($if_uuid, 27, 2)
. ", 0x" . substr($if_uuid, 29, 2)
. ", 0x" . substr($if_uuid, 31, 2)
. ", 0x" . substr($if_uuid, 33, 2)
. ", 0x" . substr($if_uuid, 35, 2) . " }");
$self->pidl_def("};");
. ", 0x" . substr($if_uuid, 25, 2)
. ", 0x" . substr($if_uuid, 27, 2)
. ", 0x" . substr($if_uuid, 29, 2)
. ", 0x" . substr($if_uuid, 31, 2)
. ", 0x" . substr($if_uuid, 33, 2)
. ", 0x" . substr($if_uuid, 35, 2) . " }");
$self->pidl_def("};");
my $maj = 0x0000FFFF & $x->{VERSION};
$maj =~ s/\.(.*)$//g;
$self->pidl_def("static guint16 ver_dcerpc_$x->{NAME} = $maj;");
$self->pidl_def("");
my $maj = 0x0000FFFF & $x->{VERSION};
$maj =~ s/\.(.*)$//g;
$self->pidl_def("static guint16 ver_dcerpc_$x->{NAME} = $maj;");
$self->pidl_def("");
}
$return_types{$x->{NAME}} = {};
@ -916,7 +1017,7 @@ sub ProcessInterface($$)
$self->Interface($x);
$self->pidl_code("\n".DumpFunctionTable($x));
foreach (keys %{$return_types{$x->{NAME}}}) {
foreach (sort(keys %{$return_types{$x->{NAME}}})) {
my ($type, $desc) = @{$return_types{$x->{NAME}}->{$_}};
my $dt = $self->find_type($type);
$dt or die("Unable to find information about return type `$type'");
@ -927,6 +1028,10 @@ sub ProcessInterface($$)
$self->RegisterInterface($x);
$self->RegisterInterfaceHandoff($x);
if (exists ($self->{conformance}->{header})) {
$self->pidl_hdr($self->{conformance}->{header});
}
$self->pidl_hdr("#endif /* $define */");
}
@ -968,33 +1073,41 @@ sub Initialize($$)
foreach my $bytes (qw(1 2 4 8)) {
my $bits = $bytes * 8;
$self->register_type("uint$bits", "offset = PIDL_dissect_uint$bits(tvb, offset, pinfo, tree, drep, \@HF\@, \@PARAM\@);", "FT_UINT$bits", "BASE_DEC", 0, "NULL", $bytes);
$self->register_type("int$bits", "offset = PIDL_dissect_uint$bits(tvb, offset, pinfo, tree, drep, \@HF\@, \@PARAM\@);", "FT_INT$bits", "BASE_DEC", 0, "NULL", $bytes);
$self->register_type("uint$bits", "offset = PIDL_dissect_uint$bits(tvb, offset, pinfo, tree, di, drep, \@HF\@, \@PARAM\@);", "FT_UINT$bits", "BASE_DEC", 0, "NULL", $bytes);
$self->register_type("int$bits", "offset = PIDL_dissect_uint$bits(tvb, offset, pinfo, tree, di, drep, \@HF\@, \@PARAM\@);", "FT_INT$bits", "BASE_DEC", 0, "NULL", $bytes);
}
$self->register_type("hyper", "offset = dissect_ndr_uint64(tvb, offset, pinfo, tree, drep, \@HF\@, NULL);", "FT_UINT64", "BASE_DEC", 0, "NULL", 8);
$self->register_type("udlong", "offset = dissect_ndr_duint32(tvb, offset, pinfo, tree, drep, \@HF\@, NULL);", "FT_UINT64", "BASE_DEC", 0, "NULL", 4);
$self->register_type("bool8", "offset = PIDL_dissect_uint8(tvb, offset, pinfo, tree, drep, \@HF\@, \@PARAM\@);","FT_INT8", "BASE_DEC", 0, "NULL", 1);
$self->register_type("char", "offset = PIDL_dissect_uint8(tvb, offset, pinfo, tree, drep, \@HF\@, \@PARAM\@);","FT_INT8", "BASE_DEC", 0, "NULL", 1);
$self->register_type("long", "offset = PIDL_dissect_uint32(tvb, offset, pinfo, tree, drep, \@HF\@, \@PARAM\@);","FT_INT32", "BASE_DEC", 0, "NULL", 4);
$self->register_type("dlong", "offset = dissect_ndr_duint32(tvb, offset, pinfo, tree, drep, \@HF\@, NULL);","FT_INT64", "BASE_DEC", 0, "NULL", 8);
$self->register_type("GUID", "offset = dissect_ndr_uuid_t(tvb, offset, pinfo, tree, drep, \@HF\@, NULL);","FT_GUID", "BASE_NONE", 0, "NULL", 4);
$self->register_type("policy_handle", "offset = PIDL_dissect_policy_hnd(tvb, offset, pinfo, tree, drep, \@HF\@, \@PARAM\@);","FT_BYTES", "BASE_NONE", 0, "NULL", 4);
$self->register_type("NTTIME", "offset = dissect_ndr_nt_NTTIME(tvb, offset, pinfo, tree, drep, \@HF\@);","FT_ABSOLUTE_TIME", "ABSOLUTE_TIME_LOCAL", 0, "NULL", 4);
$self->register_type("NTTIME_hyper", "offset = dissect_ndr_nt_NTTIME(tvb, offset, pinfo, tree, drep, \@HF\@);","FT_ABSOLUTE_TIME", "ABSOLUTE_TIME_LOCAL", 0, "NULL", 4);
$self->register_type("time_t", "offset = dissect_ndr_time_t(tvb, offset, pinfo,tree, drep, \@HF\@, NULL);","FT_ABSOLUTE_TIME", "ABSOLUTE_TIME_LOCAL", 0, "NULL", 4);
$self->register_type("NTTIME_1sec", "offset = dissect_ndr_nt_NTTIME(tvb, offset, pinfo, tree, drep, \@HF\@);", "FT_ABSOLUTE_TIME", "ABSOLUTE_TIME_LOCAL", 0, "NULL", 4);
$self->register_type("SID", "
dcerpc_info *di = (dcerpc_info *)pinfo->private_data;
$self->register_type("uint3264", "offset = dissect_ndr_uint3264(tvb, offset, pinfo, tree, di, drep, \@HF\@, NULL);", "FT_UINT32", "BASE_DEC", 0, "NULL", 8);
$self->register_type("hyper", "offset = dissect_ndr_uint64(tvb, offset, pinfo, tree, di, drep, \@HF\@, NULL);", "FT_UINT64", "BASE_DEC", 0, "NULL", 8);
$self->register_type("udlong", "offset = dissect_ndr_duint32(tvb, offset, pinfo, tree, di, drep, \@HF\@, NULL);", "FT_UINT64", "BASE_DEC", 0, "NULL", 4);
$self->register_type("bool8", "offset = PIDL_dissect_uint8(tvb, offset, pinfo, tree, di, drep, \@HF\@, \@PARAM\@);","FT_INT8", "BASE_DEC", 0, "NULL", 1);
$self->register_type("char", "offset = PIDL_dissect_uint8(tvb, offset, pinfo, tree, di, drep, \@HF\@, \@PARAM\@);","FT_INT8", "BASE_DEC", 0, "NULL", 1);
$self->register_type("long", "offset = PIDL_dissect_uint32(tvb, offset, pinfo, tree, di, drep, \@HF\@, \@PARAM\@);","FT_INT32", "BASE_DEC", 0, "NULL", 4);
$self->register_type("dlong", "offset = dissect_ndr_duint32(tvb, offset, pinfo, tree, di, drep, \@HF\@, NULL);","FT_INT64", "BASE_DEC", 0, "NULL", 8);
$self->register_type("GUID", "offset = dissect_ndr_uuid_t(tvb, offset, pinfo, tree, di, drep, \@HF\@, NULL);","FT_GUID", "BASE_NONE", 0, "NULL", 4);
$self->register_type("policy_handle", "offset = PIDL_dissect_policy_hnd(tvb, offset, pinfo, tree, di, drep, \@HF\@, \@PARAM\@);","FT_BYTES", "BASE_NONE", 0, "NULL", 4);
$self->register_type("NTTIME", "offset = dissect_ndr_nt_NTTIME(tvb, offset, pinfo, tree, di, drep, \@HF\@);","FT_ABSOLUTE_TIME", "ABSOLUTE_TIME_LOCAL", 0, "NULL", 4);
$self->register_type("NTTIME_hyper", "offset = dissect_ndr_nt_NTTIME(tvb, offset, pinfo, tree, di, drep, \@HF\@);","FT_ABSOLUTE_TIME", "ABSOLUTE_TIME_LOCAL", 0, "NULL", 4);
$self->register_type("time_t", "offset = dissect_ndr_time_t(tvb, offset, pinfo,tree, di, drep, \@HF\@, NULL);","FT_ABSOLUTE_TIME", "ABSOLUTE_TIME_LOCAL", 0, "NULL", 4);
$self->register_type("NTTIME_1sec", "offset = dissect_ndr_nt_NTTIME(tvb, offset, pinfo, tree, di, drep, \@HF\@);", "FT_ABSOLUTE_TIME", "ABSOLUTE_TIME_LOCAL", 0, "NULL", 4);
$self->register_type("dom_sid28", "
di->hf_index = \@HF\@;
offset = dissect_ndr_nt_SID_with_options(tvb, offset, pinfo, tree, drep, param);
offset = dissect_ndr_nt_SID28(tvb, offset, pinfo, tree, di, drep);
", "FT_STRING", "BASE_NONE", 0, "NULL", 4);
$self->register_type("SID", "
di->hf_index = \@HF\@;
offset = dissect_ndr_nt_SID_with_options(tvb, offset, pinfo, tree, di, drep, param);
","FT_STRING", "BASE_NONE", 0, "NULL", 4);
$self->register_type("WERROR",
"offset = PIDL_dissect_uint32(tvb, offset, pinfo, tree, drep, \@HF\@, \@PARAM\@);","FT_UINT32", "BASE_DEC", 0, "VALS(WERR_errors)", 4);
"offset = PIDL_dissect_uint32(tvb, offset, pinfo, tree, di, drep, \@HF\@, \@PARAM\@);","FT_UINT32", "BASE_DEC", 0, "VALS(WERR_errors)", 4);
$self->register_type("NTSTATUS",
"offset = PIDL_dissect_uint32(tvb, offset, pinfo, tree, drep, \@HF\@, \@PARAM\@);","FT_UINT32", "BASE_DEC", 0, "VALS(NT_errors)", 4);
"offset = PIDL_dissect_uint32(tvb, offset, pinfo, tree, di, drep, \@HF\@, \@PARAM\@);","FT_UINT32", "BASE_DEC", 0, "VALS(NT_errors)", 4);
$self->register_type("HRESULT",
"offset = PIDL_dissect_uint32(tvb, offset, pinfo, tree, di, drep, \@HF\@, \@PARAM\@);","FT_UINT32", "BASE_DEC", 0, "VALS(HRES_errors)", 4);
$self->register_type("ipv6address", "proto_tree_add_item(tree, \@HF\@, tvb, offset, 16, ENC_NA); offset += 16;", "FT_IPv6", "BASE_NONE", 0, "NULL", 16);
$self->register_type("ipv4address", "proto_tree_add_item(tree, \@HF\@, tvb, offset, 4, ENC_BIG_ENDIAN); offset += 4;", "FT_IPv4", "BASE_NONE", 0, "NULL", 4);
}
@ -1010,30 +1123,19 @@ sub Parse($$$$$)
my $notice =
"/* DO NOT EDIT
This filter was automatically generated
This file was automatically generated by Pidl
from $idl_file and $cnf_file.
Pidl is a perl based IDL compiler for DCE/RPC idl files.
It is maintained by the Samba team, not the Wireshark team.
Instructions on how to download and install Pidl can be
found at http://wiki.wireshark.org/Pidl
found at https://wiki.wireshark.org/Pidl
*/
";
$self->pidl_hdr($notice);
$self->{res}->{headers} = "\n";
$self->{res}->{headers} .= "#ifdef HAVE_CONFIG_H\n";
$self->{res}->{headers} .= "#include \"config.h\"\n";
$self->{res}->{headers} .= "#endif\n\n";
$self->{res}->{headers} .= "#ifdef _MSC_VER\n";
$self->{res}->{headers} .= "#pragma warning(disable:4005)\n";
$self->{res}->{headers} .= "#pragma warning(disable:4013)\n";
$self->{res}->{headers} .= "#pragma warning(disable:4018)\n";
$self->{res}->{headers} .= "#pragma warning(disable:4101)\n";
$self->{res}->{headers} .= "#endif\n\n";
$self->{res}->{headers} .= "#include <glib.h>\n";
$self->{res}->{headers} .= "#include <string.h>\n";
@ -1073,7 +1175,7 @@ sub Parse($$$$$)
}
$parser.=$self->{res}->{code};
my $header = "/* autogenerated by pidl */\n\n";
my $header = $notice;
$header.=$self->{res}->{hdr};
$self->CheckUsed($self->{conformance});
@ -1148,6 +1250,23 @@ sub register_hf_field($$$$$$$$$)
return $index;
}
sub change_hf_field_type($$$$)
{
my ($self,$index,$ft_type,$base_type) = @_;
if (defined ($self->{conformance}->{hf_renames}->{$index})) {
print "Field $index has been renamed to ".$self->{conformance}->{hf_renames}->{$index}->{NEWNAME}." you can't change it's type";
return 0;
}
if (!defined ($self->{conformance}->{header_fields}->{$index})) {
print "Field $index doesn't exists";
return 0;
}
$self->{conformance}->{header_fields}->{$index}->{FT_TYPE} = $ft_type;
$self->{conformance}->{header_fields}->{$index}->{BASE_TYPE} = $base_type;
return 1;
}
sub DumpHfDeclaration($)
{
my ($self) = @_;
@ -1155,7 +1274,7 @@ sub DumpHfDeclaration($)
$res = "\n/* Header field declarations */\n";
foreach (keys %{$self->{conformance}->{header_fields}})
foreach (sort(keys %{$self->{conformance}->{header_fields}}))
{
$res .= "static gint $_ = -1;\n";
}
@ -1165,16 +1284,16 @@ sub DumpHfDeclaration($)
sub make_str_or_null($)
{
my $str = shift;
if (substr($str, 0, 1) eq "\"") {
$str = substr($str, 1, length($str)-2);
}
$str =~ s/^\s*//;
$str =~ s/\s*$//;
if ($str eq "") {
return "NULL";
}
return make_str($str);
my $str = shift;
if (substr($str, 0, 1) eq "\"") {
$str = substr($str, 1, length($str)-2);
}
$str =~ s/^\s*//;
$str =~ s/\s*$//;
if ($str eq "") {
return "NULL";
}
return make_str($str);
}
sub DumpHfList($)
@ -1182,11 +1301,10 @@ sub DumpHfList($)
my ($self) = @_;
my $res = "\tstatic hf_register_info hf[] = {\n";
foreach (values %{$self->{conformance}->{header_fields}})
foreach (sort {$a->{INDEX} cmp $b->{INDEX}} values %{$self->{conformance}->{header_fields}})
{
$res .= "\t{ &$_->{INDEX},
{ ".make_str($_->{NAME}).", ".make_str($_->{FILTER}).", $_->{FT_TYPE}, $_->{BASE_TYPE}, $_->{VALSSTRING}, $_->{MASK}, ".make_str_or_null($_->{BLURB}).", HFILL }},
";
$res .= "\t{ &$_->{INDEX},\n".
"\t { ".make_str($_->{NAME}).", ".make_str($_->{FILTER}).", $_->{FT_TYPE}, $_->{BASE_TYPE}, $_->{VALSSTRING}, $_->{MASK}, ".make_str_or_null($_->{BLURB}).", HFILL }},\n";
}
return $res."\t};\n";
@ -1203,7 +1321,7 @@ sub DumpFunctionTable($)
my $res = "static dcerpc_sub_dissector $if->{NAME}\_dissectors[] = {\n";
foreach (@{$if->{FUNCTIONS}}) {
my $fn_name = $_->{NAME};
my $fn_name = $_->{NAME};
$fn_name =~ s/^$if->{NAME}_//;
$res.= "\t{ $_->{OPNUM}, \"$fn_name\",\n";
$res.= "\t $if->{NAME}_dissect_${fn_name}_request, $if->{NAME}_dissect_${fn_name}_response},\n";

35
bin/pidl/lib/wscript_build
View file

@ -1,4 +1,37 @@
#!/usr/bin/env python
# install the pidl modules
bld.INSTALL_WILDCARD('${DATAROOTDIR}/perl5', '**/*.pm', flat=False)
bld.INSTALL_FILES(bld.env.PERL_LIB_INSTALL_DIR,
'''
Parse/Pidl.pm
Parse/Pidl/Samba4.pm
Parse/Pidl/CUtil.pm
Parse/Pidl/Expr.pm
Parse/Pidl/Wireshark/Conformance.pm
Parse/Pidl/Wireshark/NDR.pm
Parse/Pidl/ODL.pm
Parse/Pidl/Dump.pm
Parse/Pidl/Util.pm
Parse/Pidl/Samba4/Header.pm
Parse/Pidl/Samba4/COM/Header.pm
Parse/Pidl/Samba4/COM/Proxy.pm
Parse/Pidl/Samba4/COM/Stub.pm
Parse/Pidl/Samba4/TDR.pm
Parse/Pidl/Samba4/NDR/Server.pm
Parse/Pidl/Samba4/NDR/Client.pm
Parse/Pidl/Samba4/NDR/Parser.pm
Parse/Pidl/Samba4/Python.pm
Parse/Pidl/Samba4/Template.pm
Parse/Pidl/IDL.pm
Parse/Pidl/Typelist.pm
Parse/Pidl/Samba3/ClientNDR.pm
Parse/Pidl/Samba3/ServerNDR.pm
Parse/Pidl/Compat.pm
Parse/Pidl/NDR.pm
''',
flat=False)
if not bld.CONFIG_SET('USING_SYSTEM_PARSE_YAPP_DRIVER'):
bld.INSTALL_FILES(bld.env.PERL_LIB_INSTALL_DIR,
'Parse/Yapp/Driver.pm',
flat=False)

163
bin/pidl/pidl
View file

@ -200,7 +200,7 @@ midl.exe would write the above array as the following C header:
pidl takes a different approach, and writes it like this:
typedef struct {
typedef struct {
long abc;
long count;
long foo;
@ -226,9 +226,9 @@ This will look like this on the wire:
A fixed array looks like this:
typedef struct {
long s[10];
} Struct1;
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.
@ -236,12 +236,12 @@ 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;
typedef struct {
uint32 foo;
uint32 count;
uint32 bar;
long s[count];
} Struct1;
This appears like this:
@ -381,14 +381,14 @@ usesgetlasterror, vararg, vi_progid, wire_marshal.
=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<https://msdn.microsoft.com/en-us/library/windows/desktop/aa373864%28v=vs.85%29.aspx>
L<https://wiki.wireshark.org/DCE/RPC>,
L<https://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>.
pidl is licensed under the GNU General Public License L<https://www.gnu.org/licenses/gpl.html>.
=head1 AUTHOR
@ -404,7 +404,6 @@ pidl README by Andrew Tridgell.
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 );
@ -433,27 +432,27 @@ sub LoadStructure($)
# 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;
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($filename) = shift;
my($v) = shift;
local(*FILE);
open(FILE, ">$filename") || die "can't open $filename";
print FILE $v;
close(FILE);
}
my(@opt_incdirs) = ();
@ -470,6 +469,7 @@ my($opt_samba3_parser);
my($opt_samba3_server);
my($opt_samba3_ndr_client);
my($opt_samba3_ndr_server);
my($opt_samba3_template) = 0;
my($opt_template) = 0;
my($opt_client);
my($opt_typelib);
@ -530,61 +530,63 @@ Samba 3 output:
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]
--samba3-template print a template for a pipe
Wireshark parsers:
--ws-parser[=OUTFILE] create Wireshark parser and header
\n";
exit(0);
exit(0);
}
#########################################
# Display version
sub ShowVersion()
{
print "perl IDL version $VERSION\n";
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,
'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,
'samba3-template' => \$opt_samba3_template,
'header:s' => \$opt_header,
'server:s' => \$opt_server,
'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,
'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,
'diff' => \$opt_diff,
'dcom-proxy:s' => \$opt_dcom_proxy,
'com-header:s' => \$opt_com_header,
'quiet' => \$opt_quiet,
'quiet' => \$opt_quiet,
'verbose' => \$opt_verbose,
'warn-compat' => \$opt_warn_compat,
'warn-compat' => \$opt_warn_compat,
'includedir=s@' => \@opt_incdirs
);
);
if (not $result) {
exit(1);
}
if ($opt_help) {
ShowHelp();
exit(0);
ShowHelp();
exit(0);
}
if ($opt_version) {
ShowVersion();
exit(0);
ShowVersion();
exit(0);
}
sub process_file($)
@ -605,7 +607,7 @@ sub process_file($)
require Parse::Pidl::IDL;
$pidl = Parse::Pidl::IDL::parse_file($idl_file, \@opt_incdirs);
defined @$pidl || die "Failed to parse $idl_file";
defined $pidl || die "Failed to parse $idl_file";
}
require Parse::Pidl::Typelist;
@ -654,28 +656,28 @@ sub process_file($)
$pidl = Parse::Pidl::ODL::ODL2IDL($pidl, dirname($idl_file), \@opt_incdirs);
if (defined($opt_ws_parser)) {
require Parse::Pidl::Wireshark::NDR;
require Parse::Pidl::Wireshark::NDR;
my $cnffile = $idl_file;
$cnffile =~ s/\.idl$/\.cnf/;
my $cnffile = $idl_file;
$cnffile =~ s/\.idl$/\.cnf/;
my $generator = new Parse::Pidl::Wireshark::NDR();
$generator->Initialize($cnffile);
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)) {
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);
}
@ -733,17 +735,17 @@ sub process_file($)
}
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/;
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);
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)) {
@ -768,6 +770,11 @@ sub process_file($)
print Parse::Pidl::Samba4::Template::Parse($pidl);
}
if ($opt_samba3_template) {
require Parse::Pidl::Samba3::Template;
print Parse::Pidl::Samba3::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/;

0
bin/pidl/pm_to_blib Normal file
View file

4
bin/pidl/tests/typelist.pl
View file

@ -52,14 +52,14 @@ is(1, typeIs("uint32", "SCALAR"));
is(0, typeIs("uint32", "ENUM"));
is(1, hasType("foo"));
is(0, hasType("nonexistant"));
is(0, hasType("nonexistent"));
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(0, is_scalar("nonexistent"));
is(1, is_scalar({TYPE => "ENUM"}));
is(0, is_scalar({TYPE => "STRUCT"}));
is(1, is_scalar({TYPE => "TYPEDEF", DATA => {TYPE => "ENUM" }}));

4
bin/pidl/tests/wireshark-conf.pl
View file

@ -15,7 +15,7 @@ use Parse::Pidl::Wireshark::Conformance qw(ReadConformanceFH valid_ft_type valid
sub parse_conf($)
{
my $str = shift;
open(TMP, "+>", undef) or die("unable to open temp file");
open(TMP, "+>", undef) or die("unable to open temp file");
print TMP $str;
seek(TMP, 0, 0);
my $data = {};
@ -60,7 +60,7 @@ is_deeply(parse_conf("FIELD_DESCRIPTION foo my description\n"),
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",
test_warnings("nofile:1: CODE END outside CODE section\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 => {

2
bin/pidl/tests/wireshark-ndr.pl
View file

@ -14,7 +14,7 @@ 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"));
is("AccessMask", field2name("AccessMask"));
my $x = new Parse::Pidl::Wireshark::NDR();
$x->PrintIdl("foo\nbar\n");

38
bin/pidl/wscript
View file

@ -1,13 +1,36 @@
#!/usr/bin/env python
import os, sys, Logs
import os, Logs
from samba_utils import MODE_755
# This function checks if a perl module is installed on the system.
def check_system_perl_module(conf, module, version=None):
bundle_name = module.replace('::', '_')
module_check = module
# Create module string with version
if version:
module_check = module + ' ' + str(version)
# Check if we have to bundle it.
if conf.LIB_MUST_BE_BUNDLED(bundle_name.lower()):
return False
# Check for system perl module
if not conf.check_perl_module(module_check):
return False
conf.define('USING_SYSTEM_%s' % bundle_name.upper(), 1)
return True
def set_options(opt):
opt.tool_options('perl')
return
def configure(conf):
conf.check_tool('perl')
# Check if perl(Parse::Yapp::Driver) is available.
check_system_perl_module(conf, "Parse::Yapp::Driver", 1.05)
# 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')
@ -19,16 +42,13 @@ def configure(conf):
conf.find_program('pod2man', var='POD2MAN')
def build(bld):
bld.INSTALL_FILES('${BINDIR}', 'pidl', chmod=MODE_755)
bld.INSTALL_FILES('${BINDIR}', 'pidl', chmod=MODE_755, perl_fixup=True)
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}',
@ -44,12 +64,10 @@ def build(bld):
# 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}',
bld(rule='${POD2MAN} -c "Samba Documentation" ${SRC} ${TGT}',
shell=True,
source=src,
install_path=os.path.dirname(bld.EXPAND_VARIABLES('${MANDIR}/'+manpage)),