Initial checkin of COMROGUE source after having gotten initial memory map right

This commit is contained in:
Eric J. Bowersox
2013-04-11 02:10:10 -06:00
commit 5b93e58fb3
110 changed files with 29045 additions and 0 deletions
@@ -0,0 +1,319 @@
# COM Header generation
# (C) 2005 Jelmer Vernooij <jelmer@samba.org>
# Modifications (C) 2013 Eric J. Bowersox <erbo@erbosoft.com>
package Parse::Pidl::COMROGUE::Header;
use Parse::Pidl::Typelist qw(mapTypeName maybeMapScalarType is_struct);
use Parse::Pidl::Util qw(has_property is_constant);
use vars qw($VERSION);
$VERSION = '0.01';
use strict;
sub stripquotes($)
{
my $str = shift;
$str =~ s/^\"//;
$str =~ s/\"$//;
return $str;
}
sub GetArgumentProtoList($)
{
my $f = shift;
my $res = "";
my $first = 1;
foreach my $a (@{$f->{ELEMENTS}}) {
$res .= ", " unless $first;
$first = 0;
$res .= maybeMapScalarType($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 undef if $first;
return $res;
}
sub GetArgumentList($)
{
my $f = shift;
my $res = "";
my $first = 1;
foreach (@{$f->{ELEMENTS}}) {
$res .= ", " unless $first;
$first = 0;
$res .= "$_->{NAME}";
}
return undef if $first;
return $res;
}
sub MethodsDefinition($)
{
my $interface = shift;
my $res = "";
$res .= "#define METHODS_" . $interface->{NAME} . " \\\n";
if (defined($interface->{BASE})) {
$res .= "\tINHERIT_METHODS(METHODS_" . $interface->{BASE} . ") \\\n";
}
my $data = $interface->{DATA};
foreach my $d (@{$data}) {
next unless ($d->{TYPE} eq "FUNCTION");
if ($d->{RETURN_TYPE} eq "HRESULT") {
$res .= "\tSTDMETHOD($d->{NAME})";
} else {
$res .= "\tSTDMETHOD_($d->{NAME}," . $d->{RETURN_TYPE} . ")";
}
my $args = GetArgumentProtoList($d);
if (defined($args)) {
$res .= "(THIS_($interface->{NAME}) $args) PURE;\\\n";
} else {
$res .= "(THIS($interface->{NAME})) PURE;\\\n";
}
}
$res .= "\tEND_METHODS\n\n";
return $res;
}
sub MakeGUIDDef($$$)
{
my $t = shift;
my $name = shift;
my $uuid = shift;
my @uuidparts = split(/-/, $uuid);
my $b1 = substr($uuidparts[3], 0, 2);
my $b2 = substr($uuidparts[3], 2, 2);
my $b3 = substr($uuidparts[4], 0, 2);
my $b4 = substr($uuidparts[4], 2, 2);
my $b5 = substr($uuidparts[4], 4, 2);
my $b6 = substr($uuidparts[4], 6, 2);
my $b7 = substr($uuidparts[4], 8, 2);
my $b8 = substr($uuidparts[4], 10, 2);
return "DEFINE_$t(${t}_$name, 0x$uuidparts[0], 0x$uuidparts[1], 0x$uuidparts[2], " .
"0x$b1, 0x$b2, 0x$b3, 0x$b4, 0x$b5, 0x$b6, 0x$b7, 0x$b8);\n\n";
}
sub ParseImports($)
{
my $imp = shift;
my $res = "";
my $seen = 0;
foreach my $p (@{$imp->{PATHS}}) {
my $header = $p;
$header =~ s/\.idl/\.h/;
$header =~ s/^\"/</;
$header =~ s/\"$/>/;
$res .= "#include $header\n";
$seen = 1;
}
$res .= "\n" if $seen;
return $res;
}
sub ParseElement($$)
{
my $prefix = shift;
my $element = shift;
my $res = "";
$res .= $prefix . maybeMapScalarType($element->{TYPE}) . " " . $element->{NAME};
if (defined($element->{ARRAY_LEN})) {
foreach my $l (@{$element->{ARRAY_LEN}}) {
$res .= "[" . $l . "]";
}
}
$res .= ";\n";
return $res;
}
sub ParseTypedef($)
{
my $def = shift;
my $res = "";
$res .= "typedef ";
$res .= "const " if ($def->{CONST});
if (ref($def->{DATA}) ne "HASH") {
$res .= maybeMapScalarType($def->{DATA}) . " ";
} else {
if (is_struct($def->{DATA})) {
$res .= mapTypeName($def->{DATA}) . " {\n";
foreach my $elt (@{$def->{DATA}->{ELEMENTS}}) {
$res .= ParseElement("\t", $elt);
}
$res .= "} ";
} else {
$res .= mapTypeName($def->{DATA}) . " ";
}
}
my $l = $def->{POINTERS};
$l-- if (Parse::Pidl::Typelist::scalar_is_reference($def->{TYPE}));
foreach my $i (1..$l) {
$res .= "*";
}
$res .= $def->{NAME} . ";\n";
return $res;
}
sub ParseTypedefs($)
{
my $if = shift;
my $res = "";
my $count = 0;
foreach my $d (@{$if->{DATA}}) {
$res .= stripquotes($d->{DATA}) . "\n" if ($d->{TYPE} eq "CPP_QUOTE");
next unless ($d->{TYPE} eq "TYPEDEF");
++$count;
$res .= ParseTypedef($d);
}
$res .= "\n";
return "" if ($count == 0);
return $res;
}
sub ParseInterface($)
{
my $if = shift;
my $res;
my $d;
$res .= "/*---------------------------------------------------------------\n";
$res .= " * Interface $if->{NAME}\n";
$res .= " *---------------------------------------------------------------\n";
$res .= " */\n\n";
$res .= MakeGUIDDef("IID", $if->{NAME}, $if->{PROPERTIES}->{uuid});
$res .= MethodsDefinition($if);
if (defined($if->{BASE})) {
$res .= "BEGIN_INTERFACE_(" . $if->{NAME} . ", " . $if->{BASE} . ")\n";
} else {
$res .= "BEGIN_INTERFACE(" . $if->{NAME} . ")\n";
}
$res .= "\tMETHODS_" . $if->{NAME} . "\n";
$res .= "END_INTERFACE(" . $if->{NAME} . ")\n\n";
foreach $d (@{$if->{DATA}}) {
$res .= stripquotes($d->{DATA}) . "\n" if ($d->{TYPE} eq "CPP_QUOTE");
$res .= ParseTypedef($d) if ($d->{TYPE} eq "TYPEDEF");
}
$res .= "\n#ifdef CINTERFACE\n\n";
foreach $d (@{$if->{DATA}}) {
next unless ($d->{TYPE} eq "FUNCTION");
my $args = GetArgumentList($d);
if (defined($args)) {
$res .= "#define $if->{NAME}_$d->{NAME}(pInterface, $args) \\\n";
$res .= "\t(*((pInterface)->pVTable->$d->{NAME}))(pInterface, $args)\n";
} else {
$res .= "#define $if->{NAME}_$d->{NAME}(pInterface) \\\n";
$res .= "\t(*((pInterface)->pVTable->$d->{NAME}))(pInterface)\n";
}
}
$res .= "\n#endif /* CINTERFACE */\n\n";
return $res;
}
sub ParseCoClass($)
{
my ($c) = @_;
my $res = "";
$res .= "/*---------------------------------------------------------------\n";
$res .= " * Class $c->{NAME}\n";
$res .= " *---------------------------------------------------------------\n";
$res .= " */\n\n";
$res .= MakeGUIDDef("CLSID", $c->{NAME}, $c->{PROPERTIES}->{uuid});
if (has_property($c, "progid")) {
$res .= "#define PROGID_" . $c->{NAME} . " \"$c->{PROPERTIES}->{progid}\"\n";
}
$res .= "\n";
return $res;
}
sub Parse($$$)
{
my ($idl,$basename, $srcfile) = @_;
my $res = "";
my $has_obj = 0;
$res .= "/* COMROGUE: Autogenerated from IDL file $srcfile */\n\n";
my $include_sym = "__" . uc($basename) . "_H_INCLUDED";
$res .= "#ifndef $include_sym\n" .
"#define $include_sym\n\n" .
"#ifndef __ASM__\n\n";
my $want_macro_headers = 1;
foreach (@{$idl})
{
if ($_->{TYPE} eq "CPP_QUOTE") {
$res .= stripquotes($_->{DATA}) . "\n";
}
if ($_->{TYPE} eq "IMPORT") {
$res .= ParseImports($_);
}
if ($_->{TYPE} eq "INTERFACE") {
if (has_property($_, "object")) {
if ($want_macro_headers) {
$res .= "#include <comrogue/object_definition_macros.h>\n\n";
$want_macro_headers = 0;
}
$res .= ParseInterface($_);
} else {
$res .= ParseTypedefs($_);
}
$has_obj = 1;
}
if ($_->{TYPE} eq "COCLASS") {
if ($want_macro_headers) {
$res .= "#include <comrogue/object_definition_macros.h>\n\n";
$want_macro_headers = 0;
}
$res.=ParseCoClass($_);
$has_obj = 1;
}
}
$res .= "#endif /* __ASM__ */\n\n";
$res .= "#endif /* $include_sym */\n";
return $res if ($has_obj);
return undef;
}
1;
+52
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
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
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 (keys %{$d}) {
if ($k eq "in") {
$res .= "[in] ";
next;
}
if ($k eq "out") {
$res .= "[out] ";
next;
}
if ($k eq "ref") {
$res .= "[ref] ";
next;
}
$res .= "[$k($d->{$k})] ";
}
}
return $res;
}
#####################################################################
# dump a structure element
sub DumpElement($)
{
my($element) = shift;
my $res = "";
(defined $element->{PROPERTIES}) &&
($res .= DumpProperties($element->{PROPERTIES}));
$res .= DumpType($element->{TYPE});
$res .= " ";
for my $i (1..$element->{POINTERS}) {
$res .= "*";
}
$res .= "$element->{NAME}";
foreach (@{$element->{ARRAY_LEN}}) {
$res .= "[$_]";
}
return $res;
}
#####################################################################
# dump a struct
sub DumpStruct($)
{
my($struct) = shift;
my($res);
$res .= "struct ";
if ($struct->{NAME}) {
$res.="$struct->{NAME} ";
}
$res.="{\n";
if (defined $struct->{ELEMENTS}) {
foreach (@{$struct->{ELEMENTS}}) {
$res .= "\t" . DumpElement($_) . ";\n";
}
}
$res .= "}";
return $res;
}
#####################################################################
# dump a struct
sub DumpEnum($)
{
my($enum) = shift;
my($res);
$res .= "enum {\n";
foreach (@{$enum->{ELEMENTS}}) {
if (/^([A-Za-z0-9_]+)[ \t]*\((.*)\)$/) {
$res .= "\t$1 = $2,\n";
} else {
$res .= "\t$_,\n";
}
}
$res.= "}";
return $res;
}
#####################################################################
# dump a struct
sub DumpBitmap($)
{
my($bitmap) = shift;
my($res);
$res .= "bitmap {\n";
foreach (@{$bitmap->{ELEMENTS}}) {
if (/^([A-Za-z0-9_]+)[ \t]*\((.*)\)$/) {
$res .= "\t$1 = $2,\n";
} else {
die ("Bitmap $bitmap->{NAME} has field $_ without proper value");
}
}
$res.= "}";
return $res;
}
#####################################################################
# dump a union element
sub DumpUnionElement($)
{
my($element) = shift;
my($res);
if (has_property($element, "default")) {
$res .= "[default] ;\n";
} else {
$res .= "[case($element->{PROPERTIES}->{case})] ";
$res .= DumpElement($element), if defined($element);
$res .= ";\n";
}
return $res;
}
#####################################################################
# dump a union
sub DumpUnion($)
{
my($union) = shift;
my($res);
(defined $union->{PROPERTIES}) &&
($res .= DumpProperties($union->{PROPERTIES}));
$res .= "union {\n";
foreach my $e (@{$union->{ELEMENTS}}) {
$res .= DumpUnionElement($e);
}
$res .= "}";
return $res;
}
#####################################################################
# dump a type
sub DumpType($)
{
my($data) = shift;
if (ref($data) eq "HASH") {
return DumpStruct($data) if ($data->{TYPE} eq "STRUCT");
return DumpUnion($data) if ($data->{TYPE} eq "UNION");
return DumpEnum($data) if ($data->{TYPE} eq "ENUM");
return DumpBitmap($data) if ($data->{TYPE} eq "BITMAP");
} else {
return $data;
}
}
#####################################################################
# dump a typedef
sub DumpTypedef($)
{
my($typedef) = shift;
my($res);
$res .= "typedef ";
$res .= DumpType($typedef->{DATA});
$res .= " $typedef->{NAME};\n\n";
return $res;
}
#####################################################################
# dump a typedef
sub DumpFunction($)
{
my($function) = shift;
my($first) = 1;
my($res);
$res .= DumpType($function->{RETURN_TYPE});
$res .= " $function->{NAME}(\n";
for my $d (@{$function->{ELEMENTS}}) {
unless ($first) { $res .= ",\n"; } $first = 0;
$res .= DumpElement($d);
}
$res .= "\n);\n\n";
return $res;
}
#####################################################################
# dump a module header
sub DumpInterfaceProperties($)
{
my($header) = shift;
my($data) = $header->{DATA};
my($first) = 1;
my($res);
$res .= "[\n";
foreach my $k (keys %{$data}) {
$first || ($res .= ",\n"); $first = 0;
$res .= "$k($data->{$k})";
}
$res .= "\n]\n";
return $res;
}
#####################################################################
# dump the interface definitions
sub DumpInterface($)
{
my($interface) = shift;
my($data) = $interface->{DATA};
my($res);
$res .= DumpInterfaceProperties($interface->{PROPERTIES});
$res .= "interface $interface->{NAME}\n{\n";
foreach my $d (@{$data}) {
($d->{TYPE} eq "TYPEDEF") &&
($res .= DumpTypedef($d));
($d->{TYPE} eq "FUNCTION") &&
($res .= DumpFunction($d));
}
$res .= "}\n";
return $res;
}
#####################################################################
# dump a parsed IDL structure back into an IDL file
sub Dump($)
{
my($idl) = shift;
my($res);
$res = "/* Dumped by pidl */\n\n";
foreach my $x (@{$idl}) {
($x->{TYPE} eq "INTERFACE") &&
($res .= DumpInterface($x));
}
return $res;
}
1;
File diff suppressed because it is too large Load Diff
File diff suppressed because it is too large Load Diff
File diff suppressed because it is too large Load Diff
+131
View File
@@ -0,0 +1,131 @@
##########################################
# 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 ref(getType($x->{TYPE})->{DATA}) eq "HASH";
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;
@@ -0,0 +1,418 @@
###################################################
# Samba3 client generator for IDL structures
# on top of Samba4 style NDR functions
# Copyright jelmer@samba.org 2005-2006
# Copyright gd@samba.org 2008
# released under the GNU GPL
package Parse::Pidl::Samba3::ClientNDR;
use Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(ParseFunction $res $res_hdr);
use strict;
use Parse::Pidl qw(fatal warning error);
use Parse::Pidl::Util qw(has_property ParseExpr);
use Parse::Pidl::NDR qw(ContainsPipe);
use Parse::Pidl::Typelist qw(mapTypeName);
use Parse::Pidl::Samba4 qw(DeclLong);
use Parse::Pidl::Samba4::Header qw(GenerateFunctionInEnv GenerateFunctionOutEnv);
use vars qw($VERSION);
$VERSION = '0.01';
sub indent($) { my ($self) = @_; $self->{tabs}.="\t"; }
sub deindent($) { my ($self) = @_; $self->{tabs} = substr($self->{tabs}, 1); }
sub pidl($$) { my ($self,$txt) = @_; $self->{res} .= $txt ? "$self->{tabs}$txt\n" : "\n"; }
sub pidl_hdr($$) { my ($self, $txt) = @_; $self->{res_hdr} .= "$txt\n"; }
sub fn_declare($$) { my ($self,$n) = @_; $self->pidl($n); $self->pidl_hdr("$n;"); }
sub genpad($)
{
my ($s) = @_;
my $nt = int((length($s)+1)/8);
my $lt = ($nt*8)-1;
my $ns = (length($s)-$lt);
return "\t"x($nt)." "x($ns);
}
sub new($)
{
my ($class) = shift;
my $self = { res => "", res_hdr => "", tabs => "" };
bless($self, $class);
}
sub ElementDirection($)
{
my ($e) = @_;
return "[in,out]" if (has_property($e, "in") and has_property($e, "out"));
return "[in]" if (has_property($e, "in"));
return "[out]" if (has_property($e, "out"));
return "[in,out]";
}
sub HeaderProperties($$)
{
my($props,$ignores) = @_;
my $ret = "";
foreach my $d (keys %{$props}) {
next if (grep(/^$d$/, @$ignores));
if($props->{$d} ne "1") {
$ret.= "$d($props->{$d}),";
} else {
$ret.="$d,";
}
}
if ($ret) {
return "[" . substr($ret, 0, -1) . "]";
}
}
sub ParseInvalidResponse($$)
{
my ($self, $type) = @_;
if ($type eq "sync") {
$self->pidl("return NT_STATUS_INVALID_NETWORK_RESPONSE;");
} elsif ($type eq "async") {
$self->pidl("tevent_req_nterror(req, NT_STATUS_INVALID_NETWORK_RESPONSE);");
$self->pidl("return;");
} else {
die("ParseInvalidResponse($type)");
}
}
sub ParseFunctionAsyncState($$$)
{
my ($self, $if, $fn) = @_;
my $state_str = "struct rpccli_$fn->{NAME}_state";
my $done_fn = "rpccli_$fn->{NAME}_done";
$self->pidl("$state_str {");
$self->indent;
$self->pidl("TALLOC_CTX *out_mem_ctx;");
if (defined($fn->{RETURN_TYPE})) {
$self->pidl(mapTypeName($fn->{RETURN_TYPE}). " result;");
}
$self->deindent;
$self->pidl("};");
$self->pidl("");
$self->pidl("static void $done_fn(struct tevent_req *subreq);");
$self->pidl("");
}
sub ParseFunctionAsyncSend($$$)
{
my ($self, $if, $fn) = @_;
my $fn_args = "";
my $uif = uc($if);
my $ufn = "NDR_".uc($fn->{NAME});
my $state_str = "struct rpccli_$fn->{NAME}_state";
my $done_fn = "rpccli_$fn->{NAME}_done";
my $out_mem_ctx = "rpccli_$fn->{NAME}_out_memory";
my $fn_str = "struct tevent_req *rpccli_$fn->{NAME}_send";
my $pad = genpad($fn_str);
$fn_args .= "TALLOC_CTX *mem_ctx";
$fn_args .= ",\n" . $pad . "struct tevent_context *ev";
$fn_args .= ",\n" . $pad . "struct rpc_pipe_client *cli";
foreach (@{$fn->{ELEMENTS}}) {
my $dir = ElementDirection($_);
my $prop = HeaderProperties($_->{PROPERTIES}, ["in", "out"]);
$fn_args .= ",\n" . $pad . DeclLong($_, "_") . " /* $dir $prop */";
}
$self->fn_declare("$fn_str($fn_args)");
$self->pidl("{");
$self->indent;
$self->pidl("struct tevent_req *req;");
$self->pidl("$state_str *state;");
$self->pidl("struct tevent_req *subreq;");
$self->pidl("");
$self->pidl("req = tevent_req_create(mem_ctx, &state,");
$self->pidl("\t\t\t$state_str);");
$self->pidl("if (req == NULL) {");
$self->indent;
$self->pidl("return NULL;");
$self->deindent;
$self->pidl("}");
$self->pidl("state->out_mem_ctx = NULL;");
$self->pidl("");
my $out_params = 0;
foreach (@{$fn->{ELEMENTS}}) {
if (grep(/out/, @{$_->{DIRECTION}})) {
$out_params++;
}
}
if ($out_params > 0) {
$self->pidl("state->out_mem_ctx = talloc_named_const(state, 0,");
$self->pidl("\t\t \"$out_mem_ctx\");");
$self->pidl("if (tevent_req_nomem(state->out_mem_ctx, req)) {");
$self->indent;
$self->pidl("return tevent_req_post(req, ev);");
$self->deindent;
$self->pidl("}");
$self->pidl("");
}
$fn_str = "subreq = dcerpc_$fn->{NAME}_send";
$pad = "\t" . genpad($fn_str);
$fn_args = "state,\n" . $pad . "ev,\n" . $pad . "cli->binding_handle";
foreach (@{$fn->{ELEMENTS}}) {
$fn_args .= ",\n" . $pad . "_". $_->{NAME};
}
$self->pidl("$fn_str($fn_args);");
$self->pidl("if (tevent_req_nomem(subreq, req)) {");
$self->indent;
$self->pidl("return tevent_req_post(req, ev);");
$self->deindent;
$self->pidl("}");
$self->pidl("tevent_req_set_callback(subreq, $done_fn, req);");
$self->pidl("return req;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
}
sub ParseFunctionAsyncDone($$$)
{
my ($self, $if, $fn) = @_;
my $state_str = "struct rpccli_$fn->{NAME}_state";
my $done_fn = "rpccli_$fn->{NAME}_done";
$self->pidl("static void $done_fn(struct tevent_req *subreq)");
$self->pidl("{");
$self->indent;
$self->pidl("struct tevent_req *req = tevent_req_callback_data(");
$self->pidl("\tsubreq, struct tevent_req);");
$self->pidl("$state_str *state = tevent_req_data(");
$self->pidl("\treq, $state_str);");
$self->pidl("NTSTATUS status;");
$self->pidl("TALLOC_CTX *mem_ctx;");
$self->pidl("");
$self->pidl("if (state->out_mem_ctx) {");
$self->indent;
$self->pidl("mem_ctx = state->out_mem_ctx;");
$self->deindent;
$self->pidl("} else {");
$self->indent;
$self->pidl("mem_ctx = state;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
my $fn_str = "status = dcerpc_$fn->{NAME}_recv";
my $pad = "\t" . genpad($fn_str);
my $fn_args = "subreq,\n" . $pad . "mem_ctx";
if (defined($fn->{RETURN_TYPE})) {
$fn_args .= ",\n" . $pad . "&state->result";
}
$self->pidl("$fn_str($fn_args);");
$self->pidl("TALLOC_FREE(subreq);");
$self->pidl("if (!NT_STATUS_IS_OK(status)) {");
$self->indent;
$self->pidl("tevent_req_nterror(req, status);");
$self->pidl("return;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
$self->pidl("tevent_req_done(req);");
$self->deindent;
$self->pidl("}");
$self->pidl("");
}
sub ParseFunctionAsyncRecv($$$)
{
my ($self, $if, $fn) = @_;
my $fn_args = "";
my $state_str = "struct rpccli_$fn->{NAME}_state";
my $fn_str = "NTSTATUS rpccli_$fn->{NAME}_recv";
my $pad = genpad($fn_str);
$fn_args .= "struct tevent_req *req,\n" . $pad . "TALLOC_CTX *mem_ctx";
if (defined($fn->{RETURN_TYPE})) {
$fn_args .= ",\n" . $pad . "$fn->{RETURN_TYPE} *result";
}
$self->fn_declare("$fn_str($fn_args)");
$self->pidl("{");
$self->indent;
$self->pidl("$state_str *state = tevent_req_data(");
$self->pidl("\treq, $state_str);");
$self->pidl("NTSTATUS status;");
$self->pidl("");
$self->pidl("if (tevent_req_is_nterror(req, &status)) {");
$self->indent;
$self->pidl("tevent_req_received(req);");
$self->pidl("return status;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
$self->pidl("/* Steal possible out parameters to the callers context */");
$self->pidl("talloc_steal(mem_ctx, state->out_mem_ctx);");
$self->pidl("");
if (defined($fn->{RETURN_TYPE})) {
$self->pidl("/* Return result */");
$self->pidl("*result = state->result;");
$self->pidl("");
}
$self->pidl("tevent_req_received(req);");
$self->pidl("return NT_STATUS_OK;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
}
sub ParseFunctionSync($$$)
{
my ($self, $if, $fn) = @_;
my $fn_args = "";
my $uif = uc($if);
my $ufn = "NDR_".uc($fn->{NAME});
my $fn_str = "NTSTATUS rpccli_$fn->{NAME}";
my $pad = genpad($fn_str);
$fn_args .= "struct rpc_pipe_client *cli,\n" . $pad . "TALLOC_CTX *mem_ctx";
foreach (@{$fn->{ELEMENTS}}) {
my $dir = ElementDirection($_);
my $prop = HeaderProperties($_->{PROPERTIES}, ["in", "out"]);
$fn_args .= ",\n" . $pad . DeclLong($_, "_") . " /* $dir $prop */";
}
if (defined($fn->{RETURN_TYPE}) && ($fn->{RETURN_TYPE} eq "WERROR")) {
$fn_args .= ",\n" . $pad . "WERROR *werror";
}
$self->fn_declare("$fn_str($fn_args)");
$self->pidl("{");
$self->indent;
if (defined($fn->{RETURN_TYPE})) {
$self->pidl(mapTypeName($fn->{RETURN_TYPE})." result;");
}
$self->pidl("NTSTATUS status;");
$self->pidl("");
$fn_str = "status = dcerpc_$fn->{NAME}";
$pad = "\t" . genpad($fn_str);
$fn_args = "cli->binding_handle,\n" . $pad . "mem_ctx";
foreach (@{$fn->{ELEMENTS}}) {
$fn_args .= ",\n" . $pad . "_". $_->{NAME};
}
if (defined($fn->{RETURN_TYPE})) {
$fn_args .= ",\n" . $pad . "&result";
}
$self->pidl("$fn_str($fn_args);");
$self->pidl("if (!NT_STATUS_IS_OK(status)) {");
$self->indent;
$self->pidl("return status;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
$self->pidl("/* Return result */");
if (not $fn->{RETURN_TYPE}) {
$self->pidl("return NT_STATUS_OK;");
} elsif ($fn->{RETURN_TYPE} eq "NTSTATUS") {
$self->pidl("return result;");
} elsif ($fn->{RETURN_TYPE} eq "WERROR") {
$self->pidl("if (werror) {");
$self->indent;
$self->pidl("*werror = result;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
$self->pidl("return werror_to_ntstatus(result);");
} else {
warning($fn->{ORIGINAL}, "Unable to convert $fn->{RETURN_TYPE} to NTSTATUS");
$self->pidl("return NT_STATUS_OK;");
}
$self->deindent;
$self->pidl("}");
$self->pidl("");
}
sub ParseFunction($$$)
{
my ($self, $if, $fn) = @_;
$self->ParseFunctionAsyncState($if, $fn);
$self->ParseFunctionAsyncSend($if, $fn);
$self->ParseFunctionAsyncDone($if, $fn);
$self->ParseFunctionAsyncRecv($if, $fn);
$self->ParseFunctionSync($if, $fn);
}
sub ParseInterface($$)
{
my ($self, $if) = @_;
my $uif = uc($if->{NAME});
$self->pidl_hdr("#ifndef __CLI_$uif\__");
$self->pidl_hdr("#define __CLI_$uif\__");
foreach my $fn (@{$if->{FUNCTIONS}}) {
next if has_property($fn, "noopnum");
next if has_property($fn, "todo");
my $skip = 0;
foreach my $e (@{$fn->{ELEMENTS}}) {
if (ContainsPipe($e, $e->{LEVELS}[0])) {
$skip = 1;
last;
}
}
next if $skip;
$self->ParseFunction($if->{NAME}, $fn);
}
$self->pidl_hdr("#endif /* __CLI_$uif\__ */");
}
sub Parse($$$$)
{
my($self,$ndr,$header,$c_header) = @_;
$self->pidl("/*");
$self->pidl(" * Unix SMB/CIFS implementation.");
$self->pidl(" * client auto-generated by pidl. DO NOT MODIFY!");
$self->pidl(" */");
$self->pidl("");
$self->pidl("#include \"includes.h\"");
$self->pidl("#include \"$header\"");
$self->pidl_hdr("#include \"$c_header\"");
$self->pidl("");
foreach (@$ndr) {
$self->ParseInterface($_) if ($_->{TYPE} eq "INTERFACE");
}
return ($self->{res}, $self->{res_hdr});
}
1;
@@ -0,0 +1,309 @@
###################################################
# Samba3 server generator for IDL structures
# on top of Samba4 style NDR functions
# Copyright jelmer@samba.org 2005-2006
# released under the GNU GPL
package Parse::Pidl::Samba3::ServerNDR;
use Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(DeclLevel);
use strict;
use Parse::Pidl qw(warning error fatal);
use Parse::Pidl::Typelist qw(mapTypeName scalar_is_reference);
use Parse::Pidl::Util qw(ParseExpr has_property is_constant);
use Parse::Pidl::NDR qw(GetNextLevel);
use Parse::Pidl::Samba4 qw(ElementStars DeclLong);
use Parse::Pidl::Samba4::Header qw(GenerateFunctionOutEnv);
use vars qw($VERSION);
$VERSION = '0.01';
my $res;
my $res_hdr;
my $tabs = "";
sub indent() { $tabs.="\t"; }
sub deindent() { $tabs = substr($tabs, 1); }
sub pidl($) { my ($txt) = @_; $res .= $txt?$tabs.(shift)."\n":"\n"; }
sub pidl_hdr($) { $res_hdr .= (shift)."\n"; }
sub fn_declare($) { my ($n) = @_; pidl $n; pidl_hdr "$n;"; }
sub DeclLevel($$)
{
my ($e, $l) = @_;
my $res = "";
if (has_property($e, "charset")) {
$res .= "const char";
} else {
$res .= mapTypeName($e->{TYPE});
}
my $stars = ElementStars($e, $l);
$res .= " ".$stars unless ($stars eq "");
return $res;
}
sub AllocOutVar($$$$$)
{
my ($e, $mem_ctx, $name, $env, $fail) = @_;
my $l = $e->{LEVELS}[0];
# we skip pointer to arrays
if ($l->{TYPE} eq "POINTER") {
my $nl = GetNextLevel($e, $l);
$l = $nl if ($nl->{TYPE} eq "ARRAY");
} elsif
# we don't support multi-dimentional arrays yet
($l->{TYPE} eq "ARRAY") {
my $nl = GetNextLevel($e, $l);
if ($nl->{TYPE} eq "ARRAY") {
fatal($e->{ORIGINAL},"multi-dimentional [out] arrays are not supported!");
}
} else {
# neither pointer nor array, no need to alloc something.
return;
}
if ($l->{TYPE} eq "ARRAY") {
unless(defined($l->{SIZE_IS})) {
error($e->{ORIGINAL}, "No size known for array `$e->{NAME}'");
pidl "#error No size known for array `$e->{NAME}'";
} else {
my $size = ParseExpr($l->{SIZE_IS}, $env, $e);
pidl "$name = talloc_zero_array($mem_ctx, " . DeclLevel($e, 1) . ", $size);";
}
} else {
pidl "$name = talloc_zero($mem_ctx, " . DeclLevel($e, 1) . ");";
}
pidl "if ($name == NULL) {";
$fail->();
pidl "}";
pidl "";
}
sub CallWithStruct($$$$)
{
my ($pipes_struct, $mem_ctx, $fn, $fail) = @_;
my $env = GenerateFunctionOutEnv($fn);
my $hasout = 0;
foreach (@{$fn->{ELEMENTS}}) {
if (grep(/out/, @{$_->{DIRECTION}})) { $hasout = 1; }
}
pidl "ZERO_STRUCT(r->out);" if ($hasout);
my $proto = "_$fn->{NAME}(struct pipes_struct *p, struct $fn->{NAME} *r";
my $ret = "_$fn->{NAME}($pipes_struct, r";
foreach (@{$fn->{ELEMENTS}}) {
my @dir = @{$_->{DIRECTION}};
if (grep(/in/, @dir) and grep(/out/, @dir)) {
pidl "r->out.$_->{NAME} = r->in.$_->{NAME};";
}
}
foreach (@{$fn->{ELEMENTS}}) {
my @dir = @{$_->{DIRECTION}};
if (grep(/in/, @dir) and grep(/out/, @dir)) {
# noop
} elsif (grep(/out/, @dir) and not
has_property($_, "represent_as")) {
AllocOutVar($_, $mem_ctx, "r->out.$_->{NAME}", $env, $fail);
}
}
$ret .= ")";
$proto .= ");";
if ($fn->{RETURN_TYPE}) {
$ret = "r->out.result = $ret";
$proto = "$fn->{RETURN_TYPE} $proto";
} else {
$proto = "void $proto";
}
pidl_hdr "$proto";
pidl "$ret;";
}
sub ParseFunction($$)
{
my ($if,$fn) = @_;
my $op = "NDR_".uc($fn->{NAME});
pidl "static bool api_$fn->{NAME}(struct pipes_struct *p)";
pidl "{";
indent;
pidl "const struct ndr_interface_call *call;";
pidl "struct ndr_pull *pull;";
pidl "struct ndr_push *push;";
pidl "enum ndr_err_code ndr_err;";
pidl "struct $fn->{NAME} *r;";
pidl "";
pidl "call = &ndr_table_$if->{NAME}.calls[$op];";
pidl "";
pidl "r = talloc(talloc_tos(), struct $fn->{NAME});";
pidl "if (r == NULL) {";
pidl "\treturn false;";
pidl "}";
pidl "";
pidl "pull = ndr_pull_init_blob(&p->in_data.data, r);";
pidl "if (pull == NULL) {";
pidl "\ttalloc_free(r);";
pidl "\treturn false;";
pidl "}";
pidl "";
pidl "pull->flags |= LIBNDR_FLAG_REF_ALLOC;";
pidl "if (p->endian) {";
pidl "\tpull->flags |= LIBNDR_FLAG_BIGENDIAN;";
pidl "}";
pidl "ndr_err = call->ndr_pull(pull, NDR_IN, r);";
pidl "if (!NDR_ERR_CODE_IS_SUCCESS(ndr_err)) {";
pidl "\ttalloc_free(r);";
pidl "\treturn false;";
pidl "}";
pidl "";
pidl "if (DEBUGLEVEL >= 10) {";
pidl "\tNDR_PRINT_FUNCTION_DEBUG($fn->{NAME}, NDR_IN, r);";
pidl "}";
pidl "";
CallWithStruct("p", "r", $fn,
sub {
pidl "\ttalloc_free(r);";
pidl "\treturn false;";
}
);
pidl "";
pidl "if (p->fault_state) {";
pidl "\ttalloc_free(r);";
pidl "\t/* Return true here, srv_pipe_hnd.c will take care */";
pidl "\treturn true;";
pidl "}";
pidl "";
pidl "if (DEBUGLEVEL >= 10) {";
pidl "\tNDR_PRINT_FUNCTION_DEBUG($fn->{NAME}, NDR_OUT | NDR_SET_VALUES, r);";
pidl "}";
pidl "";
pidl "push = ndr_push_init_ctx(r);";
pidl "if (push == NULL) {";
pidl "\ttalloc_free(r);";
pidl "\treturn false;";
pidl "}";
pidl "";
pidl "/*";
pidl " * carry over the pointer count to the reply in case we are";
pidl " * using full pointer. See NDR specification for full pointers";
pidl " */";
pidl "push->ptr_count = pull->ptr_count;";
pidl "";
pidl "ndr_err = call->ndr_push(push, NDR_OUT, r);";
pidl "if (!NDR_ERR_CODE_IS_SUCCESS(ndr_err)) {";
pidl "\ttalloc_free(r);";
pidl "\treturn false;";
pidl "}";
pidl "";
pidl "p->out_data.rdata = ndr_push_blob(push);";
pidl "talloc_steal(p->mem_ctx, p->out_data.rdata.data);";
pidl "";
pidl "talloc_free(r);";
pidl "";
pidl "return true;";
deindent;
pidl "}";
pidl "";
}
sub ParseInterface($)
{
my $if = shift;
my $uif = uc($if->{NAME});
pidl_hdr "#ifndef __SRV_$uif\__";
pidl_hdr "#define __SRV_$uif\__";
foreach (@{$if->{FUNCTIONS}}) {
next if ($_->{PROPERTIES}{noopnum});
ParseFunction($if, $_);
}
pidl "";
pidl "/* Tables */";
pidl "static struct api_struct api_$if->{NAME}_cmds[] = ";
pidl "{";
indent;
foreach (@{$if->{FUNCTIONS}}) {
next if ($_->{PROPERTIES}{noopnum});
pidl "{\"" . uc($_->{NAME}) . "\", NDR_" . uc($_->{NAME}) . ", api_$_->{NAME}},";
}
deindent;
pidl "};";
pidl "";
pidl_hdr "void $if->{NAME}_get_pipe_fns(struct api_struct **fns, int *n_fns);";
pidl "void $if->{NAME}_get_pipe_fns(struct api_struct **fns, int *n_fns)";
pidl "{";
indent;
pidl "*fns = api_$if->{NAME}_cmds;";
pidl "*n_fns = sizeof(api_$if->{NAME}_cmds) / sizeof(struct api_struct);";
deindent;
pidl "}";
pidl "";
if (not has_property($if, "no_srv_register")) {
pidl_hdr "struct rpc_srv_callbacks;";
pidl_hdr "NTSTATUS rpc_$if->{NAME}_init(const struct rpc_srv_callbacks *rpc_srv_cb);";
pidl "NTSTATUS rpc_$if->{NAME}_init(const struct rpc_srv_callbacks *rpc_srv_cb)";
pidl "{";
pidl "\treturn rpc_srv_register(SMB_RPC_INTERFACE_VERSION, \"$if->{NAME}\", \"$if->{NAME}\", \&ndr_table_$if->{NAME}, api_$if->{NAME}_cmds, sizeof(api_$if->{NAME}_cmds) / sizeof(struct api_struct), rpc_srv_cb);";
pidl "}";
pidl "";
pidl_hdr "NTSTATUS rpc_$if->{NAME}_shutdown(void);";
pidl "NTSTATUS rpc_$if->{NAME}_shutdown(void)";
pidl "{";
pidl "\treturn rpc_srv_unregister(\&ndr_table_$if->{NAME});";
pidl "}";
}
pidl_hdr "#endif /* __SRV_$uif\__ */";
}
sub Parse($$$)
{
my($ndr,$header,$ndr_header) = @_;
$res = "";
$res_hdr = "";
pidl "/*";
pidl " * Unix SMB/CIFS implementation.";
pidl " * server auto-generated by pidl. DO NOT MODIFY!";
pidl " */";
pidl "";
pidl "#include \"includes.h\"";
pidl "#include \"ntdomain.h\"";
pidl "#include \"$header\"";
pidl_hdr "#include \"$ndr_header\"";
pidl "";
foreach (@$ndr) {
ParseInterface($_) if ($_->{TYPE} eq "INTERFACE");
}
return ($res, $res_hdr);
}
1;
+133
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;
@@ -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;
@@ -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;
@@ -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
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 (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;
@@ -0,0 +1,875 @@
###################################################
# client calls generator
# Copyright tridge@samba.org 2003
# Copyright jelmer@samba.org 2005-2006
# released under the GNU GPL
package Parse::Pidl::Samba4::NDR::Client;
use Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(Parse);
use Parse::Pidl qw(fatal warning error);
use Parse::Pidl::Util qw(has_property ParseExpr);
use Parse::Pidl::NDR qw(ContainsPipe);
use Parse::Pidl::Typelist qw(mapTypeName);
use Parse::Pidl::Samba4 qw(choose_header is_intree DeclLong);
use Parse::Pidl::Samba4::Header qw(GenerateFunctionInEnv GenerateFunctionOutEnv);
use vars qw($VERSION);
$VERSION = '0.01';
use strict;
sub indent($) { my ($self) = @_; $self->{tabs}.="\t"; }
sub deindent($) { my ($self) = @_; $self->{tabs} = substr($self->{tabs}, 1); }
sub pidl($$) { my ($self,$txt) = @_; $self->{res} .= $txt ? "$self->{tabs}$txt\n" : "\n"; }
sub pidl_hdr($$) { my ($self, $txt) = @_; $self->{res_hdr} .= "$txt\n"; }
sub pidl_both($$) { my ($self, $txt) = @_; $self->{hdr} .= "$txt\n"; $self->{res_hdr} .= "$txt\n"; }
sub fn_declare($$) { my ($self,$n) = @_; $self->pidl($n); $self->pidl_hdr("$n;"); }
sub genpad($)
{
my ($s) = @_;
my $nt = int((length($s)+1)/8);
my $lt = ($nt*8)-1;
my $ns = (length($s)-$lt);
return "\t"x($nt)." "x($ns);
}
sub new($)
{
my ($class) = shift;
my $self = { res => "", res_hdr => "", tabs => "" };
bless($self, $class);
}
sub ParseFunctionHasPipes($$)
{
my ($self, $fn) = @_;
foreach my $e (@{$fn->{ELEMENTS}}) {
return 1 if ContainsPipe($e, $e->{LEVELS}[0]);
}
return 0;
}
sub ParseFunction_r_State($$$$)
{
my ($self, $if, $fn, $name) = @_;
my $uname = uc $name;
$self->pidl("struct dcerpc_$name\_r_state {");
$self->indent;
$self->pidl("TALLOC_CTX *out_mem_ctx;");
$self->deindent;
$self->pidl("};");
$self->pidl("");
$self->pidl("static void dcerpc_$name\_r_done(struct tevent_req *subreq);");
$self->pidl("");
}
sub ParseFunction_r_Send($$$$)
{
my ($self, $if, $fn, $name) = @_;
my $uname = uc $name;
my $proto = "struct tevent_req *dcerpc_$name\_r_send(TALLOC_CTX *mem_ctx,\n";
$proto .= "\tstruct tevent_context *ev,\n",
$proto .= "\tstruct dcerpc_binding_handle *h,\n",
$proto .= "\tstruct $name *r)";
$self->fn_declare($proto);
$self->pidl("{");
$self->indent;
$self->pidl("struct tevent_req *req;");
$self->pidl("struct dcerpc_$name\_r_state *state;");
$self->pidl("struct tevent_req *subreq;");
$self->pidl("");
$self->pidl("req = tevent_req_create(mem_ctx, &state,");
$self->pidl("\t\t\tstruct dcerpc_$name\_r_state);");
$self->pidl("if (req == NULL) {");
$self->indent;
$self->pidl("return NULL;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
my $out_params = 0;
foreach my $e (@{$fn->{ELEMENTS}}) {
next unless grep(/out/, @{$e->{DIRECTION}});
next if ContainsPipe($e, $e->{LEVELS}[0]);
$out_params++;
}
my $submem;
if ($out_params > 0) {
$self->pidl("state->out_mem_ctx = talloc_new(state);");
$self->pidl("if (tevent_req_nomem(state->out_mem_ctx, req)) {");
$self->indent;
$self->pidl("return tevent_req_post(req, ev);");
$self->deindent;
$self->pidl("}");
$submem = "state->out_mem_ctx";
} else {
$self->pidl("state->out_mem_ctx = NULL;");
$submem = "state";
}
$self->pidl("");
$self->pidl("subreq = dcerpc_binding_handle_call_send(state, ev, h,");
$self->pidl("\t\tNULL, &ndr_table_$if->{NAME},");
$self->pidl("\t\tNDR_$uname, $submem, r);");
$self->pidl("if (tevent_req_nomem(subreq, req)) {");
$self->indent;
$self->pidl("return tevent_req_post(req, ev);");
$self->deindent;
$self->pidl("}");
$self->pidl("tevent_req_set_callback(subreq, dcerpc_$name\_r_done, req);");
$self->pidl("");
$self->pidl("return req;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
}
sub ParseFunction_r_Done($$$$)
{
my ($self, $if, $fn, $name) = @_;
my $uname = uc $name;
my $proto = "static void dcerpc_$name\_r_done(struct tevent_req *subreq)";
$self->pidl("$proto");
$self->pidl("{");
$self->indent;
$self->pidl("struct tevent_req *req =");
$self->pidl("\ttevent_req_callback_data(subreq,");
$self->pidl("\tstruct tevent_req);");
$self->pidl("NTSTATUS status;");
$self->pidl("");
$self->pidl("status = dcerpc_binding_handle_call_recv(subreq);");
$self->pidl("if (!NT_STATUS_IS_OK(status)) {");
$self->indent;
$self->pidl("tevent_req_nterror(req, status);");
$self->pidl("return;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
$self->pidl("tevent_req_done(req);");
$self->deindent;
$self->pidl("}");
$self->pidl("");
}
sub ParseFunction_r_Recv($$$$)
{
my ($self, $if, $fn, $name) = @_;
my $uname = uc $name;
my $proto = "NTSTATUS dcerpc_$name\_r_recv(struct tevent_req *req, TALLOC_CTX *mem_ctx)";
$self->fn_declare($proto);
$self->pidl("{");
$self->indent;
$self->pidl("struct dcerpc_$name\_r_state *state =");
$self->pidl("\ttevent_req_data(req,");
$self->pidl("\tstruct dcerpc_$name\_r_state);");
$self->pidl("NTSTATUS status;");
$self->pidl("");
$self->pidl("if (tevent_req_is_nterror(req, &status)) {");
$self->indent;
$self->pidl("tevent_req_received(req);");
$self->pidl("return status;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
$self->pidl("talloc_steal(mem_ctx, state->out_mem_ctx);");
$self->pidl("");
$self->pidl("tevent_req_received(req);");
$self->pidl("return NT_STATUS_OK;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
}
sub ParseFunction_r_Sync($$$$)
{
my ($self, $if, $fn, $name) = @_;
my $uname = uc $name;
if ($self->ParseFunctionHasPipes($fn)) {
$self->pidl_both("/*");
$self->pidl_both(" * The following function is skipped because");
$self->pidl_both(" * it uses pipes:");
$self->pidl_both(" *");
$self->pidl_both(" * dcerpc_$name\_r()");
$self->pidl_both(" */");
$self->pidl_both("");
return;
}
my $proto = "NTSTATUS dcerpc_$name\_r(struct dcerpc_binding_handle *h, TALLOC_CTX *mem_ctx, struct $name *r)";
$self->fn_declare($proto);
$self->pidl("{");
$self->indent;
$self->pidl("NTSTATUS status;");
$self->pidl("");
$self->pidl("status = dcerpc_binding_handle_call(h,");
$self->pidl("\t\tNULL, &ndr_table_$if->{NAME},");
$self->pidl("\t\tNDR_$uname, mem_ctx, r);");
$self->pidl("");
$self->pidl("return status;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
}
sub ElementDirection($)
{
my ($e) = @_;
return "[in,out]" if (has_property($e, "in") and has_property($e, "out"));
return "[in]" if (has_property($e, "in"));
return "[out]" if (has_property($e, "out"));
return "[in,out]";
}
sub HeaderProperties($$)
{
my($props,$ignores) = @_;
my $ret = "";
foreach my $d (keys %{$props}) {
next if (grep(/^$d$/, @$ignores));
if($props->{$d} ne "1") {
$ret.= "$d($props->{$d}),";
} else {
$ret.="$d,";
}
}
if ($ret) {
return "[" . substr($ret, 0, -1) . "]";
}
}
sub ParseCopyArgument($$$$$)
{
my ($self, $fn, $e, $r, $i) = @_;
my $l = $e->{LEVELS}[0];
if ($l->{TYPE} eq "ARRAY" and $l->{IS_FIXED} == 1) {
$self->pidl("memcpy(${r}$e->{NAME}, ${i}$e->{NAME}, sizeof(${r}$e->{NAME}));");
} else {
$self->pidl("${r}$e->{NAME} = ${i}$e->{NAME};");
}
}
sub ParseInvalidResponse($$)
{
my ($self, $type) = @_;
if ($type eq "sync") {
$self->pidl("return NT_STATUS_INVALID_NETWORK_RESPONSE;");
} elsif ($type eq "async") {
$self->pidl("tevent_req_nterror(req, NT_STATUS_INVALID_NETWORK_RESPONSE);");
$self->pidl("return;");
} else {
die("ParseInvalidResponse($type)");
}
}
sub ParseOutputArgument($$$$$$)
{
my ($self, $fn, $e, $r, $o, $invalid_response_type) = @_;
my $level = 0;
if ($e->{LEVELS}[0]->{TYPE} ne "POINTER" and $e->{LEVELS}[0]->{TYPE} ne "ARRAY") {
fatal($e->{ORIGINAL}, "[out] argument is not a pointer or array");
return;
}
if ($e->{LEVELS}[0]->{TYPE} eq "POINTER") {
$level = 1;
if ($e->{LEVELS}[0]->{POINTER_TYPE} ne "ref") {
$self->pidl("if ($o$e->{NAME} && ${r}out.$e->{NAME}) {");
$self->indent;
}
}
if ($e->{LEVELS}[$level]->{TYPE} eq "ARRAY") {
# This is a call to GenerateFunctionInEnv intentionally.
# Since the data is being copied into a user-provided data
# structure, the user should be able to know the size beforehand
# to allocate a structure of the right size.
my $in_env = GenerateFunctionInEnv($fn, $r);
my $out_env = GenerateFunctionOutEnv($fn, $r);
my $l = $e->{LEVELS}[$level];
my $in_var = undef;
if (grep(/in/, @{$e->{DIRECTION}})) {
$in_var = ParseExpr($e->{NAME}, $in_env, $e->{ORIGINAL});
}
my $out_var = ParseExpr($e->{NAME}, $out_env, $e->{ORIGINAL});
my $in_size_is = undef;
my $out_size_is = undef;
my $out_length_is = undef;
my $avail_len = undef;
my $needed_len = undef;
$self->pidl("{");
$self->indent;
my $copy_len_var = "_copy_len_$e->{NAME}";
$self->pidl("size_t $copy_len_var;");
if (not defined($l->{SIZE_IS})) {
if (not $l->{IS_ZERO_TERMINATED}) {
fatal($e->{ORIGINAL}, "no size known for [out] array `$e->{NAME}'");
}
if (has_property($e, "charset")) {
$avail_len = "ndr_charset_length($in_var, CH_UNIX)";
$needed_len = "ndr_charset_length($out_var, CH_UNIX)";
} else {
$avail_len = "ndr_string_length($in_var, sizeof(*$in_var))";
$needed_len = "ndr_string_length($out_var, sizeof(*$out_var))";
}
$in_size_is = "";
$out_size_is = "";
$out_length_is = "";
} else {
$in_size_is = ParseExpr($l->{SIZE_IS}, $in_env, $e->{ORIGINAL});
$out_size_is = ParseExpr($l->{SIZE_IS}, $out_env, $e->{ORIGINAL});
$out_length_is = $out_size_is;
if (defined($l->{LENGTH_IS})) {
$out_length_is = ParseExpr($l->{LENGTH_IS}, $out_env, $e->{ORIGINAL});
}
if (has_property($e, "charset")) {
if (defined($in_var)) {
$avail_len = "ndr_charset_length($in_var, CH_UNIX)";
} else {
$avail_len = $out_length_is;
}
$needed_len = "ndr_charset_length($out_var, CH_UNIX)";
}
}
if ($out_size_is ne $in_size_is) {
$self->pidl("if (($out_size_is) > ($in_size_is)) {");
$self->indent;
$self->ParseInvalidResponse($invalid_response_type);
$self->deindent;
$self->pidl("}");
}
if ($out_length_is ne $out_size_is) {
$self->pidl("if (($out_length_is) > ($out_size_is)) {");
$self->indent;
$self->ParseInvalidResponse($invalid_response_type);
$self->deindent;
$self->pidl("}");
}
if (defined($needed_len)) {
$self->pidl("$copy_len_var = $needed_len;");
$self->pidl("if ($copy_len_var > $avail_len) {");
$self->indent;
$self->ParseInvalidResponse($invalid_response_type);
$self->deindent;
$self->pidl("}");
} else {
$self->pidl("$copy_len_var = $out_length_is;");
}
if (has_property($e, "charset")) {
$self->pidl("memcpy(discard_const_p(uint8_t *, $o$e->{NAME}), $out_var, $copy_len_var * sizeof(*$o$e->{NAME}));");
} else {
$self->pidl("memcpy($o$e->{NAME}, $out_var, $copy_len_var * sizeof(*$o$e->{NAME}));");
}
$self->deindent;
$self->pidl("}");
} else {
$self->pidl("*$o$e->{NAME} = *${r}out.$e->{NAME};");
}
if ($e->{LEVELS}[0]->{TYPE} eq "POINTER") {
if ($e->{LEVELS}[0]->{POINTER_TYPE} ne "ref") {
$self->deindent;
$self->pidl("}");
}
}
}
sub ParseFunction_State($$$$)
{
my ($self, $if, $fn, $name) = @_;
my $state_str = "struct dcerpc_$name\_state";
my $done_fn = "dcerpc_$name\_done";
$self->pidl("$state_str {");
$self->indent;
$self->pidl("struct $name orig;");
$self->pidl("struct $name tmp;");
$self->pidl("TALLOC_CTX *out_mem_ctx;");
$self->deindent;
$self->pidl("};");
$self->pidl("");
$self->pidl("static void $done_fn(struct tevent_req *subreq);");
$self->pidl("");
}
sub ParseFunction_Send($$$$)
{
my ($self, $if, $fn, $name) = @_;
my $fn_args = "";
my $state_str = "struct dcerpc_$name\_state";
my $done_fn = "dcerpc_$name\_done";
my $out_mem_ctx = "dcerpc_$name\_out_memory";
my $fn_str = "struct tevent_req *dcerpc_$name\_send";
my $pad = genpad($fn_str);
$fn_args .= "TALLOC_CTX *mem_ctx";
$fn_args .= ",\n" . $pad . "struct tevent_context *ev";
$fn_args .= ",\n" . $pad . "struct dcerpc_binding_handle *h";
foreach (@{$fn->{ELEMENTS}}) {
my $dir = ElementDirection($_);
my $prop = HeaderProperties($_->{PROPERTIES}, ["in", "out"]);
$fn_args .= ",\n" . $pad . DeclLong($_, "_") . " /* $dir $prop */";
}
$self->fn_declare("$fn_str($fn_args)");
$self->pidl("{");
$self->indent;
$self->pidl("struct tevent_req *req;");
$self->pidl("$state_str *state;");
$self->pidl("struct tevent_req *subreq;");
$self->pidl("");
$self->pidl("req = tevent_req_create(mem_ctx, &state,");
$self->pidl("\t\t\t$state_str);");
$self->pidl("if (req == NULL) {");
$self->indent;
$self->pidl("return NULL;");
$self->deindent;
$self->pidl("}");
$self->pidl("state->out_mem_ctx = NULL;");
$self->pidl("");
$self->pidl("/* In parameters */");
foreach my $e (@{$fn->{ELEMENTS}}) {
next unless (grep(/in/, @{$e->{DIRECTION}}));
$self->ParseCopyArgument($fn, $e, "state->orig.in.", "_");
}
$self->pidl("");
my $out_params = 0;
$self->pidl("/* Out parameters */");
foreach my $e (@{$fn->{ELEMENTS}}) {
next unless grep(/out/, @{$e->{DIRECTION}});
$self->ParseCopyArgument($fn, $e, "state->orig.out.", "_");
next if ContainsPipe($e, $e->{LEVELS}[0]);
$out_params++;
}
$self->pidl("");
if (defined($fn->{RETURN_TYPE})) {
$self->pidl("/* Result */");
$self->pidl("ZERO_STRUCT(state->orig.out.result);");
$self->pidl("");
}
if ($out_params > 0) {
$self->pidl("state->out_mem_ctx = talloc_named_const(state, 0,");
$self->pidl("\t\t \"$out_mem_ctx\");");
$self->pidl("if (tevent_req_nomem(state->out_mem_ctx, req)) {");
$self->indent;
$self->pidl("return tevent_req_post(req, ev);");
$self->deindent;
$self->pidl("}");
$self->pidl("");
}
$self->pidl("/* make a temporary copy, that we pass to the dispatch function */");
$self->pidl("state->tmp = state->orig;");
$self->pidl("");
$self->pidl("subreq = dcerpc_$name\_r_send(state, ev, h, &state->tmp);");
$self->pidl("if (tevent_req_nomem(subreq, req)) {");
$self->indent;
$self->pidl("return tevent_req_post(req, ev);");
$self->deindent;
$self->pidl("}");
$self->pidl("tevent_req_set_callback(subreq, $done_fn, req);");
$self->pidl("return req;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
}
sub ParseFunction_Done($$$$)
{
my ($self, $if, $fn, $name) = @_;
my $state_str = "struct dcerpc_$name\_state";
my $done_fn = "dcerpc_$name\_done";
$self->pidl("static void $done_fn(struct tevent_req *subreq)");
$self->pidl("{");
$self->indent;
$self->pidl("struct tevent_req *req = tevent_req_callback_data(");
$self->pidl("\tsubreq, struct tevent_req);");
$self->pidl("$state_str *state = tevent_req_data(");
$self->pidl("\treq, $state_str);");
$self->pidl("NTSTATUS status;");
$self->pidl("TALLOC_CTX *mem_ctx;");
$self->pidl("");
$self->pidl("if (state->out_mem_ctx) {");
$self->indent;
$self->pidl("mem_ctx = state->out_mem_ctx;");
$self->deindent;
$self->pidl("} else {");
$self->indent;
$self->pidl("mem_ctx = state;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
$self->pidl("status = dcerpc_$name\_r_recv(subreq, mem_ctx);");
$self->pidl("TALLOC_FREE(subreq);");
$self->pidl("if (!NT_STATUS_IS_OK(status)) {");
$self->indent;
$self->pidl("tevent_req_nterror(req, status);");
$self->pidl("return;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
$self->pidl("/* Copy out parameters */");
foreach my $e (@{$fn->{ELEMENTS}}) {
next if ContainsPipe($e, $e->{LEVELS}[0]);
next unless (grep(/out/, @{$e->{DIRECTION}}));
$self->ParseOutputArgument($fn, $e,
"state->tmp.",
"state->orig.out.",
"async");
}
$self->pidl("");
if (defined($fn->{RETURN_TYPE})) {
$self->pidl("/* Copy result */");
$self->pidl("state->orig.out.result = state->tmp.out.result;");
$self->pidl("");
}
$self->pidl("/* Reset temporary structure */");
$self->pidl("ZERO_STRUCT(state->tmp);");
$self->pidl("");
$self->pidl("tevent_req_done(req);");
$self->deindent;
$self->pidl("}");
$self->pidl("");
}
sub ParseFunction_Recv($$$$)
{
my ($self, $if, $fn, $name) = @_;
my $fn_args = "";
my $state_str = "struct dcerpc_$name\_state";
my $fn_str = "NTSTATUS dcerpc_$name\_recv";
my $pad = genpad($fn_str);
$fn_args .= "struct tevent_req *req,\n" . $pad . "TALLOC_CTX *mem_ctx";
if (defined($fn->{RETURN_TYPE})) {
$fn_args .= ",\n" . $pad . mapTypeName($fn->{RETURN_TYPE}). " *result";
}
$self->fn_declare("$fn_str($fn_args)");
$self->pidl("{");
$self->indent;
$self->pidl("$state_str *state = tevent_req_data(");
$self->pidl("\treq, $state_str);");
$self->pidl("NTSTATUS status;");
$self->pidl("");
$self->pidl("if (tevent_req_is_nterror(req, &status)) {");
$self->indent;
$self->pidl("tevent_req_received(req);");
$self->pidl("return status;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
$self->pidl("/* Steal possible out parameters to the callers context */");
$self->pidl("talloc_steal(mem_ctx, state->out_mem_ctx);");
$self->pidl("");
if (defined($fn->{RETURN_TYPE})) {
$self->pidl("/* Return result */");
$self->pidl("*result = state->orig.out.result;");
$self->pidl("");
}
$self->pidl("tevent_req_received(req);");
$self->pidl("return NT_STATUS_OK;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
}
sub ParseFunction_Sync($$$$)
{
my ($self, $if, $fn, $name) = @_;
if ($self->ParseFunctionHasPipes($fn)) {
$self->pidl_both("/*");
$self->pidl_both(" * The following function is skipped because");
$self->pidl_both(" * it uses pipes:");
$self->pidl_both(" *");
$self->pidl_both(" * dcerpc_$name()");
$self->pidl_both(" */");
$self->pidl_both("");
return;
}
my $uname = uc $name;
my $fn_args = "";
my $fn_str = "NTSTATUS dcerpc_$name";
my $pad = genpad($fn_str);
$fn_args .= "struct dcerpc_binding_handle *h,\n" . $pad . "TALLOC_CTX *mem_ctx";
foreach (@{$fn->{ELEMENTS}}) {
my $dir = ElementDirection($_);
my $prop = HeaderProperties($_->{PROPERTIES}, ["in", "out"]);
$fn_args .= ",\n" . $pad . DeclLong($_, "_") . " /* $dir $prop */";
}
if (defined($fn->{RETURN_TYPE})) {
$fn_args .= ",\n" . $pad . mapTypeName($fn->{RETURN_TYPE}). " *result";
}
$self->fn_declare("$fn_str($fn_args)");
$self->pidl("{");
$self->indent;
$self->pidl("struct $name r;");
$self->pidl("NTSTATUS status;");
$self->pidl("");
$self->pidl("/* In parameters */");
foreach my $e (@{$fn->{ELEMENTS}}) {
next unless (grep(/in/, @{$e->{DIRECTION}}));
$self->ParseCopyArgument($fn, $e, "r.in.", "_");
}
$self->pidl("");
$self->pidl("status = dcerpc_$name\_r(h, mem_ctx, &r);");
$self->pidl("if (!NT_STATUS_IS_OK(status)) {");
$self->indent;
$self->pidl("return status;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
$self->pidl("/* Return variables */");
foreach my $e (@{$fn->{ELEMENTS}}) {
next if ContainsPipe($e, $e->{LEVELS}[0]);
next unless (grep(/out/, @{$e->{DIRECTION}}));
$self->ParseOutputArgument($fn, $e, "r.", "_", "sync");
}
$self->pidl("");
$self->pidl("/* Return result */");
if ($fn->{RETURN_TYPE}) {
$self->pidl("*result = r.out.result;");
}
$self->pidl("");
$self->pidl("return NT_STATUS_OK;");
$self->deindent;
$self->pidl("}");
$self->pidl("");
}
#####################################################################
# parse a function
sub ParseFunction($$$)
{
my ($self, $if, $fn) = @_;
if ($self->ParseFunctionHasPipes($fn)) {
$self->pidl_both("/*");
$self->pidl_both(" * The following function is skipped because");
$self->pidl_both(" * it uses pipes:");
$self->pidl_both(" *");
$self->pidl_both(" * dcerpc_$fn->{NAME}_r_send()");
$self->pidl_both(" * dcerpc_$fn->{NAME}_r_recv()");
$self->pidl_both(" * dcerpc_$fn->{NAME}_r()");
$self->pidl_both(" *");
$self->pidl_both(" * dcerpc_$fn->{NAME}_send()");
$self->pidl_both(" * dcerpc_$fn->{NAME}_recv()");
$self->pidl_both(" * dcerpc_$fn->{NAME}()");
$self->pidl_both(" */");
$self->pidl_both("");
warning($fn->{ORIGINAL}, "$fn->{NAME}: dcerpc client does not support pipe yet");
return;
}
$self->ParseFunction_r_State($if, $fn, $fn->{NAME});
$self->ParseFunction_r_Send($if, $fn, $fn->{NAME});
$self->ParseFunction_r_Done($if, $fn, $fn->{NAME});
$self->ParseFunction_r_Recv($if, $fn, $fn->{NAME});
$self->ParseFunction_r_Sync($if, $fn, $fn->{NAME});
foreach my $e (@{$fn->{ELEMENTS}}) {
next unless (grep(/out/, @{$e->{DIRECTION}}));
my $reason = "is not a pointer or array";
# TODO: make this fatal at NDR level
if ($e->{LEVELS}[0]->{TYPE} eq "POINTER") {
if ($e->{LEVELS}[1]->{TYPE} eq "DATA" and
$e->{LEVELS}[1]->{DATA_TYPE} eq "string") {
$reason = "is a pointer to type 'string'";
} elsif ($e->{LEVELS}[1]->{TYPE} eq "ARRAY" and
$e->{LEVELS}[1]->{IS_ZERO_TERMINATED}) {
next;
} elsif ($e->{LEVELS}[1]->{TYPE} eq "ARRAY" and
not defined($e->{LEVELS}[1]->{SIZE_IS})) {
$reason = "is a pointer to an unsized array";
} else {
next;
}
}
if ($e->{LEVELS}[0]->{TYPE} eq "ARRAY") {
if (not defined($e->{LEVELS}[0]->{SIZE_IS})) {
$reason = "is an unsized array";
} else {
next;
}
}
$self->pidl_both("/*");
$self->pidl_both(" * The following functions are skipped because");
$self->pidl_both(" * an [out] argument $e->{NAME} $reason:");
$self->pidl_both(" *");
$self->pidl_both(" * dcerpc_$fn->{NAME}_send()");
$self->pidl_both(" * dcerpc_$fn->{NAME}_recv()");
$self->pidl_both(" * dcerpc_$fn->{NAME}()");
$self->pidl_both(" */");
$self->pidl_both("");
error($e->{ORIGINAL}, "$fn->{NAME}: [out] argument '$e->{NAME}' $reason, skip client functions");
return;
}
$self->ParseFunction_State($if, $fn, $fn->{NAME});
$self->ParseFunction_Send($if, $fn, $fn->{NAME});
$self->ParseFunction_Done($if, $fn, $fn->{NAME});
$self->ParseFunction_Recv($if, $fn, $fn->{NAME});
$self->ParseFunction_Sync($if, $fn, $fn->{NAME});
$self->pidl_hdr("");
}
my %done;
#####################################################################
# parse the interface definitions
sub ParseInterface($$)
{
my ($self, $if) = @_;
my $ifu = uc($if->{NAME});
$self->pidl_hdr("#ifndef _HEADER_RPC_$if->{NAME}");
$self->pidl_hdr("#define _HEADER_RPC_$if->{NAME}");
$self->pidl_hdr("");
if (defined $if->{PROPERTIES}->{uuid}) {
$self->pidl_hdr("extern const struct ndr_interface_table ndr_table_$if->{NAME};");
$self->pidl_hdr("");
}
$self->pidl("/* $if->{NAME} - client functions generated by pidl */");
$self->pidl("");
foreach my $fn (@{$if->{FUNCTIONS}}) {
next if defined($done{$fn->{NAME}});
next if has_property($fn, "noopnum");
next if has_property($fn, "todo");
$self->ParseFunction($if, $fn);
$done{$fn->{NAME}} = 1;
}
$self->pidl_hdr("#endif /* _HEADER_RPC_$if->{NAME} */");
}
sub Parse($$$$$$)
{
my($self,$ndr,$header,$ndr_header,$client_header) = @_;
$self->pidl("/* client functions auto-generated by pidl */");
$self->pidl("");
if (is_intree()) {
$self->pidl("#include \"includes.h\"");
} else {
$self->pidl("#ifndef _GNU_SOURCE");
$self->pidl("#define _GNU_SOURCE");
$self->pidl("#endif");
$self->pidl("#include <stdio.h>");
$self->pidl("#include <stdbool.h>");
$self->pidl("#include <stdlib.h>");
$self->pidl("#include <stdint.h>");
$self->pidl("#include <stdarg.h>");
$self->pidl("#include <string.h>");
$self->pidl("#include <core/ntstatus.h>");
}
$self->pidl("#include <tevent.h>");
$self->pidl(choose_header("lib/util/tevent_ntstatus.h", "util/tevent_ntstatus.h")."");
$self->pidl("#include \"$ndr_header\"");
$self->pidl("#include \"$client_header\"");
$self->pidl("");
$self->pidl_hdr(choose_header("librpc/rpc/dcerpc.h", "dcerpc.h")."");
$self->pidl_hdr("#include \"$header\"");
foreach my $x (@{$ndr}) {
($x->{TYPE} eq "INTERFACE") && $self->ParseInterface($x);
}
return ($self->{res},$self->{res_hdr});
}
1;
File diff suppressed because it is too large Load Diff
@@ -0,0 +1,334 @@
###################################################
# server boilerplate generator
# Copyright tridge@samba.org 2003
# Copyright metze@samba.org 2004
# released under the GNU GPL
package Parse::Pidl::Samba4::NDR::Server;
use strict;
use Parse::Pidl::Util;
use vars qw($VERSION);
$VERSION = '0.01';
my($res);
sub pidl($)
{
$res .= shift;
}
#####################################################
# generate the switch statement for function dispatch
sub gen_dispatch_switch($)
{
my $interface = shift;
foreach my $fn (@{$interface->{FUNCTIONS}}) {
next if not defined($fn->{OPNUM});
pidl "\tcase $fn->{OPNUM}: {\n";
pidl "\t\tstruct $fn->{NAME} *r2 = (struct $fn->{NAME} *)r;\n";
pidl "\t\tif (DEBUGLEVEL >= 10) {\n";
pidl "\t\t\tNDR_PRINT_FUNCTION_DEBUG($fn->{NAME}, NDR_IN, r2);\n";
pidl "\t\t}\n";
if ($fn->{RETURN_TYPE} && $fn->{RETURN_TYPE} ne "void") {
pidl "\t\tr2->out.result = dcesrv_$fn->{NAME}(dce_call, mem_ctx, r2);\n";
} else {
pidl "\t\tdcesrv_$fn->{NAME}(dce_call, mem_ctx, r2);\n";
}
pidl "\t\tif (dce_call->state_flags & DCESRV_CALL_STATE_FLAG_ASYNC) {\n";
pidl "\t\t\tDEBUG(5,(\"function $fn->{NAME} will reply async\\n\"));\n";
pidl "\t\t}\n";
pidl "\t\tbreak;\n\t}\n";
}
}
#####################################################
# generate the switch statement for function reply
sub gen_reply_switch($)
{
my $interface = shift;
foreach my $fn (@{$interface->{FUNCTIONS}}) {
next if not defined($fn->{OPNUM});
pidl "\tcase $fn->{OPNUM}: {\n";
pidl "\t\tstruct $fn->{NAME} *r2 = (struct $fn->{NAME} *)r;\n";
pidl "\t\tif (dce_call->state_flags & DCESRV_CALL_STATE_FLAG_ASYNC) {\n";
pidl "\t\t\tDEBUG(5,(\"function $fn->{NAME} replied async\\n\"));\n";
pidl "\t\t}\n";
pidl "\t\tif (DEBUGLEVEL >= 10 && dce_call->fault_code == 0) {\n";
pidl "\t\t\tNDR_PRINT_FUNCTION_DEBUG($fn->{NAME}, NDR_OUT | NDR_SET_VALUES, r2);\n";
pidl "\t\t}\n";
pidl "\t\tif (dce_call->fault_code != 0) {\n";
pidl "\t\t\tDEBUG(2,(\"dcerpc_fault %s in $fn->{NAME}\\n\", dcerpc_errstr(mem_ctx, dce_call->fault_code)));\n";
pidl "\t\t}\n";
pidl "\t\tbreak;\n\t}\n";
}
}
#####################################################################
# produce boilerplate code for a interface
sub Boilerplate_Iface($)
{
my($interface) = shift;
my $name = $interface->{NAME};
my $uname = uc $name;
my $uuid = lc($interface->{UUID});
my $if_version = $interface->{VERSION};
pidl "
static NTSTATUS $name\__op_bind(struct dcesrv_call_state *dce_call, const struct dcesrv_interface *iface, uint32_t if_version)
{
#ifdef DCESRV_INTERFACE_$uname\_BIND
return DCESRV_INTERFACE_$uname\_BIND(dce_call,iface);
#else
return NT_STATUS_OK;
#endif
}
static void $name\__op_unbind(struct dcesrv_connection_context *context, const struct dcesrv_interface *iface)
{
#ifdef DCESRV_INTERFACE_$uname\_UNBIND
DCESRV_INTERFACE_$uname\_UNBIND(context, iface);
#else
return;
#endif
}
static NTSTATUS $name\__op_ndr_pull(struct dcesrv_call_state *dce_call, TALLOC_CTX *mem_ctx, struct ndr_pull *pull, void **r)
{
enum ndr_err_code ndr_err;
uint16_t opnum = dce_call->pkt.u.request.opnum;
dce_call->fault_code = 0;
if (opnum >= ndr_table_$name.num_calls) {
dce_call->fault_code = DCERPC_FAULT_OP_RNG_ERROR;
return NT_STATUS_NET_WRITE_FAULT;
}
*r = talloc_named(mem_ctx,
ndr_table_$name.calls[opnum].struct_size,
\"struct %s\",
ndr_table_$name.calls[opnum].name);
NT_STATUS_HAVE_NO_MEMORY(*r);
/* unravel the NDR for the packet */
ndr_err = ndr_table_$name.calls[opnum].ndr_pull(pull, NDR_IN, *r);
if (!NDR_ERR_CODE_IS_SUCCESS(ndr_err)) {
dcerpc_log_packet(dce_call->conn->packet_log_dir,
&ndr_table_$name, opnum, NDR_IN,
&dce_call->pkt.u.request.stub_and_verifier);
dce_call->fault_code = DCERPC_FAULT_NDR;
return NT_STATUS_NET_WRITE_FAULT;
}
return NT_STATUS_OK;
}
static NTSTATUS $name\__op_dispatch(struct dcesrv_call_state *dce_call, TALLOC_CTX *mem_ctx, void *r)
{
uint16_t opnum = dce_call->pkt.u.request.opnum;
switch (opnum) {
";
gen_dispatch_switch($interface);
pidl "
default:
dce_call->fault_code = DCERPC_FAULT_OP_RNG_ERROR;
break;
}
if (dce_call->fault_code != 0) {
dcerpc_log_packet(dce_call->conn->packet_log_dir,
&ndr_table_$name, opnum, NDR_IN,
&dce_call->pkt.u.request.stub_and_verifier);
return NT_STATUS_NET_WRITE_FAULT;
}
return NT_STATUS_OK;
}
static NTSTATUS $name\__op_reply(struct dcesrv_call_state *dce_call, TALLOC_CTX *mem_ctx, void *r)
{
uint16_t opnum = dce_call->pkt.u.request.opnum;
switch (opnum) {
";
gen_reply_switch($interface);
pidl "
default:
dce_call->fault_code = DCERPC_FAULT_OP_RNG_ERROR;
break;
}
if (dce_call->fault_code != 0) {
dcerpc_log_packet(dce_call->conn->packet_log_dir,
&ndr_table_$name, opnum, NDR_IN,
&dce_call->pkt.u.request.stub_and_verifier);
return NT_STATUS_NET_WRITE_FAULT;
}
return NT_STATUS_OK;
}
static NTSTATUS $name\__op_ndr_push(struct dcesrv_call_state *dce_call, TALLOC_CTX *mem_ctx, struct ndr_push *push, const void *r)
{
enum ndr_err_code ndr_err;
uint16_t opnum = dce_call->pkt.u.request.opnum;
ndr_err = ndr_table_$name.calls[opnum].ndr_push(push, NDR_OUT, r);
if (!NDR_ERR_CODE_IS_SUCCESS(ndr_err)) {
dce_call->fault_code = DCERPC_FAULT_NDR;
return NT_STATUS_NET_WRITE_FAULT;
}
return NT_STATUS_OK;
}
const struct dcesrv_interface dcesrv\_$name\_interface = {
.name = \"$name\",
.syntax_id = {".print_uuid($uuid).",$if_version},
.bind = $name\__op_bind,
.unbind = $name\__op_unbind,
.ndr_pull = $name\__op_ndr_pull,
.dispatch = $name\__op_dispatch,
.reply = $name\__op_reply,
.ndr_push = $name\__op_ndr_push
};
";
}
#####################################################################
# produce boilerplate code for an endpoint server
sub Boilerplate_Ep_Server($)
{
my($interface) = shift;
my $name = $interface->{NAME};
my $uname = uc $name;
pidl "
static NTSTATUS $name\__op_init_server(struct dcesrv_context *dce_ctx, const struct dcesrv_endpoint_server *ep_server)
{
int i;
for (i=0;i<ndr_table_$name.endpoints->count;i++) {
NTSTATUS ret;
const char *name = ndr_table_$name.endpoints->names[i];
ret = dcesrv_interface_register(dce_ctx, name, &dcesrv_$name\_interface, NULL);
if (!NT_STATUS_IS_OK(ret)) {
DEBUG(1,(\"$name\_op_init_server: failed to register endpoint \'%s\'\\n\",name));
return ret;
}
}
return NT_STATUS_OK;
}
static bool $name\__op_interface_by_uuid(struct dcesrv_interface *iface, const struct GUID *uuid, uint32_t if_version)
{
if (dcesrv_$name\_interface.syntax_id.if_version == if_version &&
GUID_equal(\&dcesrv\_$name\_interface.syntax_id.uuid, uuid)) {
memcpy(iface,&dcesrv\_$name\_interface, sizeof(*iface));
return true;
}
return false;
}
static bool $name\__op_interface_by_name(struct dcesrv_interface *iface, const char *name)
{
if (strcmp(dcesrv_$name\_interface.name, name)==0) {
memcpy(iface, &dcesrv_$name\_interface, sizeof(*iface));
return true;
}
return false;
}
NTSTATUS dcerpc_server_$name\_init(void)
{
NTSTATUS ret;
struct dcesrv_endpoint_server ep_server;
/* fill in our name */
ep_server.name = \"$name\";
/* fill in all the operations */
ep_server.init_server = $name\__op_init_server;
ep_server.interface_by_uuid = $name\__op_interface_by_uuid;
ep_server.interface_by_name = $name\__op_interface_by_name;
/* register ourselves with the DCERPC subsystem. */
ret = dcerpc_register_ep_server(&ep_server);
if (!NT_STATUS_IS_OK(ret)) {
DEBUG(0,(\"Failed to register \'$name\' endpoint server!\\n\"));
return ret;
}
return ret;
}
";
}
#####################################################################
# dcerpc server boilerplate from a parsed IDL structure
sub ParseInterface($)
{
my($interface) = shift;
my $count = 0;
$res .= "NTSTATUS dcerpc_server_$interface->{NAME}\_init(void);\n";
$res .= "\n";
if (!defined $interface->{PROPERTIES}->{uuid}) {
return $res;
}
if (!defined $interface->{PROPERTIES}->{version}) {
$interface->{PROPERTIES}->{version} = "0.0";
}
foreach my $fn (@{$interface->{FUNCTIONS}}) {
if (defined($fn->{OPNUM})) { $count++; }
}
if ($count == 0) {
return $res;
}
$res .= "/* $interface->{NAME} - dcerpc server boilerplate generated by pidl */\n\n";
Boilerplate_Iface($interface);
Boilerplate_Ep_Server($interface);
return $res;
}
sub Parse($$)
{
my($ndr,$header) = @_;
$res = "";
$res .= "/* server functions auto-generated by pidl */\n";
$res .= "#include \"$header\"\n";
$res .= "\n";
foreach my $x (@{$ndr}) {
ParseInterface($x) if ($x->{TYPE} eq "INTERFACE" and not defined($x->{PROPERTIES}{object}));
}
return $res;
}
1;
File diff suppressed because it is too large Load Diff
+283
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;
@@ -0,0 +1,98 @@
###################################################
# server template function generator
# Copyright tridge@samba.org 2003
# released under the GNU GPL
package Parse::Pidl::Samba4::Template;
use vars qw($VERSION);
$VERSION = '0.01';
use strict;
my($res);
#####################################################################
# produce boilerplate code for a interface
sub Template($)
{
my($interface) = shift;
my($data) = $interface->{DATA};
my $name = $interface->{NAME};
$res .=
"/*
Unix SMB/CIFS implementation.
endpoint server for the $name pipe
Copyright (C) YOUR NAME HERE YEAR
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
*/
#include \"includes.h\"
#include \"rpc_server/dcerpc_server.h\"
#include \"librpc/gen_ndr/ndr_$name.h\"
#include \"rpc_server/common/common.h\"
";
foreach my $d (@{$data}) {
if ($d->{TYPE} eq "FUNCTION") {
my $fname = $d->{NAME};
$res .=
"
/*
$fname
*/
static $d->{RETURN_TYPE} dcesrv_$fname(struct dcesrv_call_state *dce_call, TALLOC_CTX *mem_ctx,
struct $fname *r)
{
";
if ($d->{RETURN_TYPE} eq "void") {
$res .= "\tDCESRV_FAULT_VOID(DCERPC_FAULT_OP_RNG_ERROR);\n";
} else {
$res .= "\tDCESRV_FAULT(DCERPC_FAULT_OP_RNG_ERROR);\n";
}
$res .= "}
";
}
}
$res .=
"
/* include the generated boilerplate */
#include \"librpc/gen_ndr/ndr_$name\_s.c\"
"
}
#####################################################################
# parse a parsed IDL structure back into an IDL file
sub Parse($)
{
my($idl) = shift;
$res = "";
foreach my $x (@{$idl}) {
($x->{TYPE} eq "INTERFACE") &&
Template($x);
}
return $res;
}
1;
+372
View File
@@ -0,0 +1,372 @@
###################################################
# 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 maybeMapScalarType addType typeIs is_signed is_scalar is_struct enum_type_fn
bitmap_type_fn mapType typeHasBody is_fixed_size_scalar
);
use vars qw($VERSION);
$VERSION = '0.01';
use Parse::Pidl::Util qw(has_property);
use strict;
my %types = ();
my @reference_scalars = (
"string", "string_array", "nbt_string", "dns_string",
"wrepl_nbt_name", "dnsp_name", "dnsp_string",
"ipv4address", "ipv6address"
);
my @non_fixed_size_scalars = (
"string", "string_array", "nbt_string", "dns_string",
"wrepl_nbt_name", "dnsp_name", "dnsp_string"
);
# a list of known scalar types
my %scalars = (
"void" => "void",
"char" => "char",
"int8" => "int8_t",
"uint8" => "uint8_t",
"int16" => "int16_t",
"uint16" => "uint16_t",
"int1632" => "int16_t",
"uint1632" => "uint16_t",
"int32" => "int32_t",
"uint32" => "uint32_t",
"int3264" => "int32_t",
"uint3264" => "uint32_t",
"hyper" => "uint64_t",
"dlong" => "int64_t",
"udlong" => "uint64_t",
"udlongr" => "uint64_t",
"double" => "double",
"pointer" => "void*",
"DATA_BLOB" => "DATA_BLOB",
"string" => "const char *",
"string_array" => "const char **",
"time_t" => "time_t",
"uid_t" => "uid_t",
"gid_t" => "gid_t",
"NTTIME" => "NTTIME",
"NTTIME_1sec" => "NTTIME",
"NTTIME_hyper" => "NTTIME",
"WERROR" => "WERROR",
"NTSTATUS" => "NTSTATUS",
"HRESULT" => "HRESULT",
"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 maybeMapScalarType($)
{
my $name = shift;
return $scalars{$name} if defined($scalars{$name});
return $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_struct($)
{
my $type = shift;
return 1 if (ref($type) eq "HASH" and $type->{TYPE} eq "STRUCT");
if (my $dt = getType($type)) {
return is_struct($dt->{DATA}) if ($dt->{TYPE} eq "TYPEDEF");
return 1 if ($dt->{TYPE} eq "STRUCT");
}
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 mapTypeName($t->{DATA}) 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;
+182
View File
@@ -0,0 +1,182 @@
###################################################
# utility functions to support pidl
# Copyright tridge@samba.org 2000
# released under the GNU GPL
package Parse::Pidl::Util;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(has_property property_matches ParseExpr ParseExprExt is_constant make_str unmake_str print_uuid MyDumper);
use vars qw($VERSION);
$VERSION = '0.01';
use strict;
use Parse::Pidl::Expr;
use Parse::Pidl qw(error);
=head1 NAME
Parse::Pidl::Util - Generic utility functions for pidl
=head1 SYNOPSIS
use Parse::Pidl::Util;
=head1 DESCRIPTION
Simple module that contains a couple of trivial helper functions
used throughout the various pidl modules.
=head1 FUNCTIONS
=over 4
=cut
=item B<MyDumper>
a dumper wrapper to prevent dependence on the Data::Dumper module
unless we actually need it
=cut
sub MyDumper($)
{
require Data::Dumper;
my $s = shift;
return Data::Dumper::Dumper($s);
}
=item B<has_property>
see if a pidl property list contains a given property
=cut
sub has_property($$)
{
my($e, $p) = @_;
return undef if (not defined($e->{PROPERTIES}));
return $e->{PROPERTIES}->{$p};
}
=item B<property_matches>
see if a pidl property matches a value
=cut
sub property_matches($$$)
{
my($e,$p,$v) = @_;
if (!defined has_property($e, $p)) {
return undef;
}
if ($e->{PROPERTIES}->{$p} =~ /$v/) {
return 1;
}
return undef;
}
=item B<is_constant>
return 1 if the string is a C constant
=cut
sub is_constant($)
{
my $s = shift;
return 1 if ($s =~ /^\d+$/);
return 1 if ($s =~ /^0x[0-9A-Fa-f]+$/);
return 0;
}
=item B<make_str>
return a "" quoted string, unless already quoted
=cut
sub make_str($)
{
my $str = shift;
if (substr($str, 0, 1) eq "\"") {
return $str;
}
return "\"$str\"";
}
=item B<unmake_str>
unquote a "" quoted string
=cut
sub unmake_str($)
{
my $str = shift;
$str =~ s/^\"(.*)\"$/$1/;
return $str;
}
=item B<print_uuid>
Print C representation of a UUID.
=cut
sub print_uuid($)
{
my ($uuid) = @_;
$uuid =~ s/"//g;
my ($time_low,$time_mid,$time_hi,$clock_seq,$node) = split /-/, $uuid;
return undef if not defined($node);
my @clock_seq = $clock_seq =~ /(..)/g;
my @node = $node =~ /(..)/g;
return "{0x$time_low,0x$time_mid,0x$time_hi," .
"{".join(',', map {"0x$_"} @clock_seq)."}," .
"{".join(',', map {"0x$_"} @node)."}}";
}
=item B<ParseExpr>
Interpret an IDL expression, substituting particular variables.
=cut
sub ParseExpr($$$)
{
my($expr, $varlist, $e) = @_;
my $x = new Parse::Pidl::Expr();
return $x->Run($expr, sub { my $x = shift; error($e, $x); },
# Lookup fn
sub { my $x = shift;
return($varlist->{$x}) if (defined($varlist->{$x}));
return $x;
},
undef, undef);
}
=item B<ParseExprExt>
Interpret an IDL expression, substituting particular variables. Can call
callbacks when pointers are being dereferenced or variables are being used.
=cut
sub ParseExprExt($$$$$)
{
my($expr, $varlist, $e, $deref, $use) = @_;
my $x = new Parse::Pidl::Expr();
return $x->Run($expr, sub { my $x = shift; error($e, $x); },
# Lookup fn
sub { my $x = shift;
return($varlist->{$x}) if (defined($varlist->{$x}));
return $x;
},
$deref, $use);
}
=back
=cut
1;
@@ -0,0 +1,451 @@
###################################################
# parse an Wireshark conformance file
# Copyright jelmer@samba.org 2005
# released under the GNU GPL
=pod
=head1 NAME
Parse::Pidl::Wireshark::Conformance - Conformance file parser for Wireshark
=head1 DESCRIPTION
This module supports parsing Wireshark conformance files (*.cnf).
=head1 FILE FORMAT
Pidl needs additional data for Wireshark output. This data is read from
so-called conformance files. This section describes the format of these
files.
Conformance files are simple text files with a single command on each line.
Empty lines and lines starting with a '#' character are ignored.
Arguments to commands are seperated by spaces.
The following commands are currently supported:
=over 4
=item I<TYPE> name dissector ft_type base_type mask valsstring alignment
Register new data type with specified name, what dissector function to call
and what properties to give header fields for elements of this type.
=item I<NOEMIT> type
Suppress emitting a dissect_type function for the specified type
=item I<PARAM_VALUE> type param
Set parameter to specify to dissector function for given type.
=item I<HF_FIELD> hf title filter ft_type base_type valsstring mask description
Generate a custom header field with specified properties.
=item I<HF_RENAME> old_hf_name new_hf_name
Force the use of new_hf_name when the parser generator was going to
use old_hf_name.
This can be used in conjunction with HF_FIELD in order to make more than
one element use the same filter name.
=item I<ETT_FIELD> ett
Register a custom ett field
=item I<STRIP_PREFIX> prefix
Remove the specified prefix from all function names (if present).
=item I<PROTOCOL> longname shortname filtername
Change the short-, long- and filter-name for the current interface in
Wireshark.
=item I<FIELD_DESCRIPTION> field desc
Change description for the specified header field. `field' is the hf name of the field.
=item I<IMPORT> dissector code...
Code to insert when generating the specified dissector. @HF@ and
@PARAM@ will be substituted.
=item I<INCLUDE> filename
Include conformance data from the specified filename in the dissector.
=item I<TFS> hf_name "true string" "false string"
Override the text shown when a bitmap boolean value is enabled or disabled.
=item I<MANUAL> fn_name
Force pidl to not generate a particular function but allow the user
to write a function manually. This can be used to remove the function
for only one level for a particular element rather than all the functions and
ett/hf variables for a particular element as the NOEMIT command does.
=back
=head1 EXAMPLE
INFO_KEY OpenKey.Ke
=cut
package Parse::Pidl::Wireshark::Conformance;
require Exporter;
use vars qw($VERSION);
$VERSION = '0.01';
@ISA = qw(Exporter);
@EXPORT_OK = qw(ReadConformance ReadConformanceFH valid_ft_type valid_base_type);
use strict;
use Parse::Pidl qw(fatal warning error);
use Parse::Pidl::Util qw(has_property);
use Parse::Pidl::Typelist qw(addType);
sub handle_type($$$$$$$$$$)
{
my ($pos,$data,$name,$dissectorname,$ft_type,$base_type,$mask,$valsstring,$alignment) = @_;
unless(defined($alignment)) {
error($pos, "incomplete TYPE command");
return;
}
unless ($dissectorname =~ /.*dissect_.*/) {
warning($pos, "dissector name does not contain `dissect'");
}
unless(valid_ft_type($ft_type)) {
warning($pos, "invalid FT_TYPE `$ft_type'");
}
unless (valid_base_type($base_type)) {
warning($pos, "invalid BASE_TYPE `$base_type'");
}
$dissectorname =~ s/^\"(.*)\"$/$1/g;
if (not ($dissectorname =~ /;$/)) {
warning($pos, "missing semicolon");
}
$data->{types}->{$name} = {
NAME => $name,
POS => $pos,
USED => 0,
DISSECTOR_NAME => $dissectorname,
FT_TYPE => $ft_type,
BASE_TYPE => $base_type,
MASK => $mask,
VALSSTRING => $valsstring,
ALIGNMENT => $alignment
};
addType({
NAME => $name,
TYPE => "CONFORMANCE",
BASEFILE => "conformance file",
DATA => {
NAME => $name,
TYPE => "CONFORMANCE",
ALIGN => $alignment
}
});
}
sub handle_tfs($$$$$)
{
my ($pos,$data,$hf,$trues,$falses) = @_;
unless(defined($falses)) {
error($pos, "incomplete TFS command");
return;
}
$data->{tfs}->{$hf} = {
TRUE_STRING => $trues,
FALSE_STRING => $falses
};
}
sub handle_hf_rename($$$$)
{
my ($pos,$data,$old,$new) = @_;
unless(defined($new)) {
warning($pos, "incomplete HF_RENAME command");
return;
}
$data->{hf_renames}->{$old} = {
OLDNAME => $old,
NEWNAME => $new,
POS => $pos,
USED => 0
};
}
sub handle_param_value($$$$)
{
my ($pos,$data,$dissector_name,$value) = @_;
unless(defined($value)) {
error($pos, "incomplete PARAM_VALUE command");
return;
}
$data->{dissectorparams}->{$dissector_name} = {
DISSECTOR => $dissector_name,
PARAM => $value,
POS => $pos,
USED => 0
};
}
sub valid_base_type($)
{
my $t = shift;
return 0 unless($t =~ /^BASE_.*/);
return 1;
}
sub valid_ft_type($)
{
my $t = shift;
return 0 unless($t =~ /^FT_.*/);
return 1;
}
sub handle_hf_field($$$$$$$$$$)
{
my ($pos,$data,$index,$name,$filter,$ft_type,$base_type,$valsstring,$mask,$blurb) = @_;
unless(defined($blurb)) {
error($pos, "incomplete HF_FIELD command");
return;
}
unless(valid_ft_type($ft_type)) {
warning($pos, "invalid FT_TYPE `$ft_type'");
}
unless(valid_base_type($base_type)) {
warning($pos, "invalid BASE_TYPE `$base_type'");
}
$data->{header_fields}->{$index} = {
INDEX => $index,
POS => $pos,
USED => 0,
NAME => $name,
FILTER => $filter,
FT_TYPE => $ft_type,
BASE_TYPE => $base_type,
VALSSTRING => $valsstring,
MASK => $mask,
BLURB => $blurb
};
}
sub handle_strip_prefix($$$)
{
my ($pos,$data,$x) = @_;
push (@{$data->{strip_prefixes}}, $x);
}
sub handle_noemit($$$)
{
my ($pos,$data,$type) = @_;
if (defined($type)) {
$data->{noemit}->{$type} = 1;
} else {
$data->{noemit_dissector} = 1;
}
}
sub handle_manual($$$)
{
my ($pos,$data,$fn) = @_;
unless(defined($fn)) {
warning($pos, "incomplete MANUAL command");
return;
}
$data->{manual}->{$fn} = 1;
}
sub handle_protocol($$$$$$)
{
my ($pos, $data, $name, $longname, $shortname, $filtername) = @_;
$data->{protocols}->{$name} = {
LONGNAME => $longname,
SHORTNAME => $shortname,
FILTERNAME => $filtername
};
}
sub handle_fielddescription($$$$)
{
my ($pos,$data,$field,$desc) = @_;
unless(defined($desc)) {
warning($pos, "incomplete FIELD_DESCRIPTION command");
return;
}
$data->{fielddescription}->{$field} = {
DESCRIPTION => $desc,
POS => $pos,
USED => 0
};
}
sub handle_import
{
my $pos = shift @_;
my $data = shift @_;
my $dissectorname = shift @_;
unless(defined($dissectorname)) {
error($pos, "no dissectorname specified");
return;
}
$data->{imports}->{$dissectorname} = {
NAME => $dissectorname,
DATA => join(' ', @_),
USED => 0,
POS => $pos
};
}
sub handle_ett_field
{
my $pos = shift @_;
my $data = shift @_;
my $ett = shift @_;
unless(defined($ett)) {
error($pos, "incomplete ETT_FIELD command");
return;
}
push (@{$data->{ett}}, $ett);
}
sub handle_include
{
my $pos = shift @_;
my $data = shift @_;
my $fn = shift @_;
unless(defined($fn)) {
error($pos, "incomplete INCLUDE command");
return;
}
ReadConformance($fn, $data);
}
my %field_handlers = (
TYPE => \&handle_type,
NOEMIT => \&handle_noemit,
MANUAL => \&handle_manual,
PARAM_VALUE => \&handle_param_value,
HF_FIELD => \&handle_hf_field,
HF_RENAME => \&handle_hf_rename,
ETT_FIELD => \&handle_ett_field,
TFS => \&handle_tfs,
STRIP_PREFIX => \&handle_strip_prefix,
PROTOCOL => \&handle_protocol,
FIELD_DESCRIPTION => \&handle_fielddescription,
IMPORT => \&handle_import,
INCLUDE => \&handle_include
);
sub ReadConformance($$)
{
my ($f,$data) = @_;
my $ret;
open(IN,"<$f") or return undef;
$ret = ReadConformanceFH(*IN, $data, $f);
close(IN);
return $ret;
}
sub ReadConformanceFH($$$)
{
my ($fh,$data,$f) = @_;
my $incodeblock = 0;
my $ln = 0;
foreach (<$fh>) {
$ln++;
next if (/^#.*$/);
next if (/^$/);
s/[\r\n]//g;
if ($_ eq "CODE START") {
$incodeblock = 1;
next;
} elsif ($incodeblock and $_ eq "CODE END") {
$incodeblock = 0;
next;
} elsif ($incodeblock) {
if (exists $data->{override}) {
$data->{override}.="$_\n";
} else {
$data->{override} = "$_\n";
}
next;
}
my @fields = /([^ "]+|"[^"]+")/g;
my $cmd = $fields[0];
shift @fields;
my $pos = { FILE => $f, LINE => $ln };
next unless(defined($cmd));
if (not defined($field_handlers{$cmd})) {
warning($pos, "Unknown command `$cmd'");
next;
}
$field_handlers{$cmd}($pos, $data, @fields);
}
if ($incodeblock) {
warning({ FILE => $f, LINE => $ln },
"Expecting CODE END");
return undef;
}
return 1;
}
1;
File diff suppressed because it is too large Load Diff