Sync with samba tree

svn path=/trunk/; revision=16152
This commit is contained in:
Jörg Mayer 2005-10-07 07:50:59 +00:00
parent 984850153d
commit 9c38623b5a
12 changed files with 1718 additions and 82 deletions

View File

@ -10,3 +10,7 @@
a (regular) remote error occurs
- support nested elements
- Don't output [ref] pointers for Samba 4?
- alternative to subcontext()

View File

@ -9,7 +9,7 @@
package Parse::Pidl::Ethereal::NDR;
use strict;
use Parse::Pidl::Typelist;
use Parse::Pidl::Typelist qw(getType);
use Parse::Pidl::Util qw(has_property ParseExpr property_matches make_str);
use Parse::Pidl::NDR;
use Parse::Pidl::Dump qw(DumpTypedef DumpFunction);
@ -31,24 +31,6 @@ my %ptrtype_mappings = (
"ptr" => "NDR_POINTER_PTR"
);
sub type2ft($)
{
my($t) = shift;
return "FT_UINT$1" if $t =~ /uint(8|16|32|64)/;
return "FT_INT$1" if $t =~ /int(8|16|32|64)/;
return "FT_UINT64", if $t eq "HYPER_T" or $t eq "NTTIME_hyper"
or $t eq "hyper";
# TODO: should NTTIME_hyper be a FT_ABSOLUTE_TIME as well?
return "FT_ABSOLUTE_TIME" if $t eq "NTTIME" or $t eq "NTTIME_1sec";
return "FT_STRING" if ($t eq "string");
return "FT_NONE";
}
sub StripPrefixes($)
{
my ($s) = @_;
@ -156,7 +138,7 @@ sub Enum($$$)
my $enum_size = $e->{BASE_TYPE};
$enum_size =~ s/uint//g;
register_type($name, "offset = $dissectorname(tvb, offset, pinfo, tree, drep, \@HF\@, \@PARAM\@);", type2ft($e->{BASE_TYPE}), "BASE_DEC", "0", "VALS($valsstring)", $enum_size / 8);
register_type($name, "offset = $dissectorname(tvb, offset, pinfo, tree, drep, \@HF\@, \@PARAM\@);", "FT_UINT$enum_size", "BASE_DEC", "0", "VALS($valsstring)", $enum_size / 8);
}
sub Bitmap($$$)
@ -230,7 +212,7 @@ sub Bitmap($$$)
my $size = $e->{BASE_TYPE};
$size =~ s/uint//g;
register_type($name, "offset = $dissectorname(tvb, offset, pinfo, tree, drep, \@HF\@, \@PARAM\@);", type2ft($e->{BASE_TYPE}), "BASE_DEC", "0", "NULL", $size/8);
register_type($name, "offset = $dissectorname(tvb, offset, pinfo, tree, drep, \@HF\@, \@PARAM\@);", "FT_UINT$size", "BASE_DEC", "0", "NULL", $size/8);
}
sub ElementLevel($$$$$)
@ -330,7 +312,19 @@ sub Element($$$)
my $call_code = "offset = $dissectorname(tvb, offset, pinfo, tree, drep);";
my $hf = register_hf_field("hf_$ifname\_$pn\_$e->{NAME}", field2name($e->{NAME}), "$ifname.$pn.$e->{NAME}", type2ft($e->{TYPE}), "BASE_HEX", "NULL", 0, "");
my $type = find_type($e->{TYPE});
if (not defined($type)) {
# default settings
$type = {
MASK => 0,
VALSSTRING => "NULL",
FT_TYPE => "FT_NONE",
BASE_TYPE => "BASE_HEX"
};
}
my $hf = register_hf_field("hf_$ifname\_$pn\_$e->{NAME}", field2name($e->{NAME}), "$ifname.$pn.$e->{NAME}", $type->{FT_TYPE}, $type->{BASE_TYPE}, $type->{VALSSTRING}, $type->{MASK}, "");
$hf_used{$hf} = 1;
my $eltname = StripPrefixes($pn) . ".$e->{NAME}";
@ -485,6 +479,17 @@ sub Union($$$)
$res.="\t\tbreak;\n";
}
my $switch_type;
my $switch_dissect;
my $switch_dt = getType($e->{SWITCH_TYPE});
if ($switch_dt->{DATA}->{TYPE} eq "ENUM") {
$switch_type = "g".Parse::Pidl::Typelist::enum_type_fn($switch_dt);
$switch_dissect = "dissect_ndr_" .Parse::Pidl::Typelist::enum_type_fn($switch_dt);
} elsif ($switch_dt->{DATA}->{TYPE} eq "SCALAR") {
$switch_type = "g$e->{SWITCH_TYPE}";
$switch_dissect = "dissect_ndr_$e->{SWITCH_TYPE}";
}
pidl_code "static int";
pidl_code "$dissectorname(tvbuff_t *tvb, int offset, packet_info *pinfo, proto_tree *parent_tree, guint8 *drep, int hf_index, guint32 param _U_)";
pidl_code "{";
@ -492,7 +497,7 @@ sub Union($$$)
pidl_code "proto_item *item = NULL;";
pidl_code "proto_tree *tree = NULL;";
pidl_code "int old_offset;";
pidl_code "g$e->{SWITCH_TYPE} level;";
pidl_code "$switch_type level;";
pidl_code "";
if ($e->{ALIGN} > 1) {
@ -511,7 +516,7 @@ sub Union($$$)
pidl_code "";
pidl_code "offset = dissect_ndr_$e->{SWITCH_TYPE}(tvb, offset, pinfo, tree, drep, hf_index, &level);";
pidl_code "offset = $switch_dissect(tvb, offset, pinfo, tree, drep, hf_index, &level);";
pidl_code "switch(level) {$res\t}";
pidl_code "proto_item_set_len(item, offset-old_offset);\n";
@ -674,6 +679,12 @@ sub ProcessInterface($)
pidl_hdr "#endif /* $define */";
}
sub find_type($)
{
my $n = shift;
return $conformance->{types}->{$n};
}
sub register_type($$$$$$$)
{

View File

@ -17,6 +17,37 @@ use strict;
use Parse::Pidl::Typelist qw(hasType getType);
use Parse::Pidl::Util qw(has_property property_matches);
# Alignment of the built-in scalar types
my $scalar_alignment = {
'void' => 0,
'char' => 1,
'int8' => 1,
'uint8' => 1,
'int16' => 2,
'uint16' => 2,
'int32' => 4,
'uint32' => 4,
'hyper' => 8,
'dlong' => 4,
'udlong' => 4,
'udlongr' => 4,
'DATA_BLOB' => 4,
'string' => 4,
'string_array' => 4, #???
'time_t' => 4,
'NTTIME' => 4,
'NTTIME_1sec' => 4,
'NTTIME_hyper' => 8,
'WERROR' => 4,
'NTSTATUS' => 4,
'COMRESULT' => 4,
'nbt_string' => 4,
'wrepl_nbt_name' => 4,
'ipv4address' => 4
};
sub nonfatal($$)
{
my ($e,$s) = @_;
@ -49,6 +80,7 @@ sub GetElementLevelTable($)
my @bracket_array = ();
my @length_is = ();
my @size_is = ();
my $pointer_idx = 0;
if (has_property($e, "size_is")) {
@size_is = split /,/, has_property($e, "size_is");
@ -122,9 +154,12 @@ sub GetElementLevelTable($)
TYPE => "POINTER",
# for now, there can only be one pointer type per element
POINTER_TYPE => pointer_type($e),
POINTER_INDEX => $pointer_idx,
IS_DEFERRED => "$is_deferred",
LEVEL => $level
});
$pointer_idx++;
# everything that follows will be deferred
$is_deferred = 1 if ($e->{PARENT}->{TYPE} ne "FUNCTION");
@ -299,7 +334,7 @@ sub align_type
} elsif (($dt->{TYPE} eq "STRUCT") or ($dt->{TYPE} eq "UNION")) {
return find_largest_alignment($dt);
} elsif ($dt->{TYPE} eq "SCALAR") {
return Parse::Pidl::Typelist::getScalarAlignment($dt->{NAME});
return $scalar_alignment->{$dt->{NAME}};
}
die("Unknown data type type $dt->{TYPE}");

View File

@ -60,13 +60,15 @@ sub HeaderElement($)
HeaderType($element, $element->{TYPE}, "");
pidl " ";
my $numstar = $element->{POINTERS};
if ($numstar >= 1) {
$numstar-- if Parse::Pidl::Typelist::scalar_is_reference($element->{TYPE});
}
foreach (@{$element->{ARRAY_LEN}})
{
next if is_constant($_) and
not has_property($element, "charset");
$numstar++;
}
$numstar-- if Parse::Pidl::Typelist::scalar_is_reference($element->{TYPE});
pidl "*" foreach (1..$numstar);
pidl $element->{NAME};
foreach (@{$element->{ARRAY_LEN}}) {

View File

@ -0,0 +1,141 @@
###################################################
# Samba3 NDR client generator for IDL structures
# Copyright jelmer@samba.org 2005
# released under the GNU GPL
package Parse::Pidl::Samba3::Client;
use strict;
use Parse::Pidl::Typelist qw(hasType getType mapType);
use Parse::Pidl::Util qw(has_property ParseExpr);
use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred);
use Parse::Pidl::Samba3::Types qw(DeclLong);
use vars qw($VERSION);
$VERSION = '0.01';
my $res = "";
my $tabs = "";
sub indent() { $tabs.="\t"; }
sub deindent() { $tabs = substr($tabs, 1); }
sub pidl($) { $res .= $tabs.(shift)."\n"; }
sub fatal($$) { my ($e,$s) = @_; die("$e->{FILE}:$e->{LINE}: $s\n"); }
sub warning($$) { my ($e,$s) = @_; warn("$e->{FILE}:$e->{LINE}: $s\n"); }
sub CopyLevel($$$$)
{
sub CopyLevel($$$$);
my ($e,$l,$argument,$member) = @_;
if ($l->{TYPE} eq "DATA") {
pidl "*$argument = $member;";
} elsif ($l->{TYPE} eq "POINTER") {
pidl "if (r.ptr$l->{POINTER_INDEX}_$e->{NAME}) {";
indent;
pidl "*$argument = talloc_size(mem_ctx, sizeof(void *));";
CopyLevel($e,GetNextLevel($e,$l),"*$argument", $member);
deindent;
pidl "}";
} elsif ($l->{TYPE} eq "SWITCH") {
CopyLevel($e,GetNextLevel($e,$l),$argument,$member);
} elsif ($l->{TYPE} eq "ARRAY") {
pidl "*$argument = $member;";
}
}
sub ParseFunction($$)
{
my ($if,$fn) = @_;
my $inargs = "";
my $defargs = "";
foreach (@{$fn->{ELEMENTS}}) {
$defargs .= ", " . DeclLong($_);
if (grep(/in/, @{$_->{DIRECTION}})) {
$inargs .= ", $_->{NAME}";
}
}
my $uif = uc($if->{NAME});
my $ufn = uc($fn->{NAME});
pidl "NTSTATUS rpccli_$fn->{NAME}(struct rpc_pipe_client *cli, TALLOC_CTX *mem_ctx$defargs)";
pidl "{";
indent;
pidl "prs_struct qbuf, rbuf;";
pidl "$uif\_Q_$ufn q;";
pidl "$uif\_R_$ufn r;";
pidl "";
pidl "ZERO_STRUCT(q);";
pidl "ZERO_STRUCT(r);";
pidl "";
pidl "/* Marshall data and send request */";
pidl "";
pidl "if (!init_$if->{NAME}_q_$fn->{NAME}(&q$inargs))";
pidl "\treturn NT_STATUS_INVALID_PARAMETER;";
pidl "";
pidl "CLI_DO_RPC(cli, mem_ctx, PI_$uif, $ufn,";
pidl "\tq, r,";
pidl "\tqbuf, rbuf, ";
pidl "\t$if->{NAME}_io_q_$fn->{NAME},";
pidl "\t$if->{NAME}_io_r_$fn->{NAME},";
pidl "\tNT_STATUS_UNSUCCESSFUL);";
pidl "";
pidl "/* Return variables */";
foreach my $e (@{$fn->{ELEMENTS}}) {
next unless (grep(/out/, @{$e->{DIRECTION}}));
if ($e->{LEVELS}[0]->{TYPE} ne "POINTER") {
warning($e->{ORIGINAL}, "First element not a pointer for [out] argument");
next;
}
CopyLevel($e, $e->{LEVELS}[1], $e->{NAME}, "r.$e->{NAME}");
}
pidl"";
pidl "/* Return result */";
if (not $fn->{RETURN_TYPE}) {
pidl "return NT_STATUS_OK;";
} elsif ($fn->{RETURN_TYPE} eq "NTSTATUS") {
pidl "return r.status;";
} elsif ($fn->{RETURN_TYPE} eq "WERROR") {
pidl "return werror_to_ntstatus(r.status);";
} else {
pidl "/* Sorry, don't know how to convert $fn->{RETURN_TYPE} to NTSTATUS */";
pidl "return NT_STATUS_OK;";
}
deindent;
pidl "}";
pidl "";
}
sub ParseInterface($)
{
my $if = shift;
ParseFunction($if, $_) foreach (@{$if->{FUNCTIONS}});
}
sub Parse($$)
{
my($ndr,$filename) = @_;
$res = "";
pidl "/*";
pidl " * Unix SMB/CIFS implementation.";
pidl " * client auto-generated by pidl. DO NOT MODIFY!";
pidl " */";
pidl "";
pidl "#include \"includes.h\"";
pidl "";
foreach (@$ndr) {
ParseInterface($_) if ($_->{TYPE} eq "INTERFACE");
}
return $res;
}
1;

View File

@ -0,0 +1,217 @@
###################################################
# Samba3 NDR header generator for IDL structures
# Copyright jelmer@samba.org 2005
# released under the GNU GPL
package Parse::Pidl::Samba3::Header;
use strict;
use Parse::Pidl::Typelist qw(hasType getType);
use Parse::Pidl::Util qw(has_property ParseExpr);
use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred);
use Parse::Pidl::Samba3::Types qw(DeclShort);
use vars qw($VERSION);
$VERSION = '0.01';
my $res = "";
my $tabs = "";
sub indent() { $tabs.="\t"; }
sub deindent() { $tabs = substr($tabs, 1); }
sub pidl($) { $res .= $tabs.(shift)."\n"; }
sub fatal($$) { my ($e,$s) = @_; die("$e->{FILE}:$e->{LINE}: $s\n"); }
sub warning($$) { my ($e,$s) = @_; warn("$e->{FILE}:$e->{LINE}: $s\n"); }
sub ParseElement($)
{
my $e = shift;
foreach my $l (@{$e->{LEVELS}}) {
if ($l->{TYPE} eq "POINTER") {
return if ($l->{POINTER_TYPE} eq "ref" and $l->{LEVEL} eq "top");
pidl "\tuint32 ptr$l->{POINTER_INDEX}_$e->{NAME};";
} elsif ($l->{TYPE} eq "SWITCH") {
pidl "\tuint32 level_$e->{NAME};";
} elsif ($l->{TYPE} eq "DATA") {
pidl "\t" . DeclShort($e) . ";";
} elsif ($l->{TYPE} eq "ARRAY") {
if ($l->{IS_CONFORMANT}) {
pidl "\tuint32 size_$e->{NAME};";
}
if ($l->{IS_VARYING}) {
pidl "\tuint32 length_$e->{NAME};";
pidl "\tuint32 offset_$e->{NAME};";
}
}
}
}
sub CreateStruct($$$$)
{
my ($if,$fn,$n,$t) = @_;
pidl "typedef struct $n {";
ParseElement($_) foreach (@$t);
if (not @$t) {
# Some compilers don't like empty structs
pidl "\tuint32 dummy;";
}
pidl "} " . uc($n) . ";";
pidl "";
}
sub ParseFunction($$)
{
my ($if,$fn) = @_;
my @in = ();
my @out = ();
foreach (@{$fn->{ELEMENTS}}) {
push (@in, $_) if (grep(/in/, @{$_->{DIRECTION}}));
push (@out, $_) if (grep(/out/, @{$_->{DIRECTION}}));
}
if (defined($fn->{RETURN_TYPE})) {
push (@out, {
NAME => "status",
TYPE => $fn->{RETURN_TYPE},
LEVELS => [
{
TYPE => "DATA",
DATA_TYPE => $fn->{RETURN_TYPE}
}
]
} );
}
# define Q + R structures for functions
CreateStruct($if, $fn, "$if->{NAME}_q_$fn->{NAME}", \@in);
CreateStruct($if, $fn, "$if->{NAME}_r_$fn->{NAME}", \@out);
}
sub ParseStruct($$$)
{
my ($if,$s,$n) = @_;
CreateStruct($if, $s, "$if->{NAME}_$n", $s->{ELEMENTS});
}
sub ParseUnion($$$)
{
my ($if,$u,$n) = @_;
my $extra = {};
unless (has_property($u, "nodiscriminant")) {
$extra->{switch_value} = 1;
}
foreach my $e (@{$u->{ELEMENTS}}) {
foreach my $l (@{$e->{LEVELS}}) {
if ($l->{TYPE} eq "ARRAY") {
if ($l->{IS_CONFORMANT}) {
$extra->{"size"} = 1;
}
if ($l->{IS_VARYING}) {
$extra->{"length"} = $extra->{"offset"} = 1;
}
} elsif ($l->{TYPE} eq "POINTER") {
$extra->{"ptr$l->{POINTER_INDEX}"} = 1;
} elsif ($l->{TYPE} eq "SWITCH") {
$extra->{"level"} = 1;
}
}
}
pidl "typedef struct $if->{NAME}_$n\_ctr {";
indent;
pidl "uint32 $_;" foreach (keys %$extra);
pidl "union $if->{NAME}_$n {";
indent;
foreach (@{$u->{ELEMENTS}}) {
next if ($_->{TYPE} eq "EMPTY");
pidl "\t" . DeclShort($_) . ";";
}
deindent;
pidl "} u;";
deindent;
pidl "} ".uc("$if->{NAME}_$n\_ctr") .";";
pidl "";
}
sub ParseEnum($$$)
{
my ($if,$s,$n) = @_;
pidl "typedef enum {";
pidl "$_," foreach (@{$s->{ELEMENTS}});
pidl "} $n;";
}
sub ParseBitmap($$$)
{
my ($if,$s,$n) = @_;
pidl "#define $_" foreach (@{$s->{ELEMENTS}});
}
sub ParseInterface($)
{
my $if = shift;
my $def = "_RPC_" . uc($if->{NAME}) . "_H";
pidl "";
pidl "\#ifndef $def";
pidl "\#define $def";
pidl "";
foreach (@{$if->{FUNCTIONS}}) {
pidl "\#define " . uc($_->{NAME}) . " $_->{OPNUM}" ;
}
pidl "";
foreach (@{$if->{TYPEDEFS}}) {
ParseStruct($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "STRUCT");
ParseEnum($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "ENUM");
ParseBitmap($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "BITMAP");
ParseUnion($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "UNION");
}
ParseFunction($if, $_) foreach (@{$if->{FUNCTIONS}});
foreach (@{$if->{CONSTS}}) {
pidl "$_->{NAME} ($_->{VALUE})";
}
pidl "\#endif /* $def */";
}
sub Parse($$)
{
my($ndr,$filename) = @_;
$res = "";
$tabs = "";
pidl "/*";
pidl " * Unix SMB/CIFS implementation.";
pidl " * header auto-generated by pidl. DO NOT MODIFY!";
pidl " */";
pidl "";
# Loop over interfaces
foreach (@{$ndr}) {
ParseInterface($_) if ($_->{TYPE} eq "INTERFACE");
}
return $res;
}
1;

View File

@ -0,0 +1,587 @@
###################################################
# Samba3 NDR parser generator for IDL structures
# Copyright jelmer@samba.org 2005
# released under the GNU GPL
package Parse::Pidl::Samba3::Parser;
use strict;
use Parse::Pidl::Typelist qw(hasType getType mapType);
use Parse::Pidl::Util qw(has_property ParseExpr);
use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred);
use Parse::Pidl::Samba3::Types qw(DeclShort DeclLong InitType DissectType);
use vars qw($VERSION);
$VERSION = '0.01';
use constant PRIMITIVES => 1;
use constant DEFERRED => 2;
my $res = "";
my $tabs = "";
sub indent() { $tabs.="\t"; }
sub deindent() { $tabs = substr($tabs, 1); }
sub pidl($) { $res .= $tabs.(shift)."\n"; }
sub fatal($$) { my ($e,$s) = @_; die("$e->{FILE}:$e->{LINE}: $s\n"); }
#TODO:
# - Add some security checks (array sizes, memory alloc == NULL, etc)
# - Don't add seperate _p and _d functions if there is no deferred data
# - [string]
# - subcontext()
# - DATA_BLOB
sub Align($$)
{
my ($a,$b) = @_;
# Only align if previous element was smaller then current one
if ($$a < $b) {
pidl "if (!prs_align_custom(ps, $b))";
pidl "\treturn False;";
pidl "";
}
$$a = $b;
}
sub DeclareArrayVariables
{
my $es = shift;
my $what = shift;
my $output = 0;
foreach my $e (@$es) {
foreach my $l (@{$e->{LEVELS}}) {
if ($what) {
next if ($l->{IS_DEFERRED} and $what == PRIMITIVES);
next if (not $l->{IS_DEFERRED} and $what == DEFERRED);
}
if ($l->{TYPE} eq "ARRAY") {
pidl "uint32 i_$e->{NAME}_$l->{LEVEL_INDEX};";
$output = 1;
}
}
}
pidl "" if $output;
}
sub ParseElementLevelData($$$$$$$)
{
my ($e,$l,$nl,$env,$varname,$what,$align) = @_;
my @args = ($e,$l,$varname,$what,$align);
# See if we need to add a level argument because we're parsing a union
foreach (@{$e->{LEVELS}}) {
push (@args, ParseExpr("level_$e->{NAME}", $env))
if ($_->{TYPE} eq "SWITCH");
}
my $c = DissectType(@args);
return if not $c;
if (defined($e->{ALIGN})) {
Align($align, $e->{ALIGN});
} else {
# Default to 4
Align($align, 4);
}
pidl "if (!$c)";
pidl "\treturn False;";
}
sub ParseElementLevelArray($$$$$$$)
{
my ($e,$l,$nl,$env,$varname,$what,$align) = @_;
if ($l->{IS_ZERO_TERMINATED}) {
fatal($e, "[string] attribute not supported for Samba3 yet");
#FIXME
}
my $len = ParseExpr($l->{LENGTH_IS}, $env);
my $size = ParseExpr($l->{SIZE_IS}, $env);
if ($what == PRIMITIVES) {
# Fetch headers
if ($l->{IS_CONFORMANT} and not $l->{IS_SURROUNDING}) {
Align($align, 4);
pidl "if (!prs_uint32(\"size_$e->{NAME}\", ps, depth, &" . ParseExpr("size_$e->{NAME}", $env) . "))";
pidl "\treturn False;";
pidl "";
}
if ($l->{IS_VARYING}) {
Align($align, 4);
pidl "if (!prs_uint32(\"offset_$e->{NAME}\", ps, depth, &" . ParseExpr("offset_$e->{NAME}", $env) . "))";
pidl "\treturn False;";
pidl "";
pidl "if (!prs_uint32(\"length_$e->{NAME}\", ps, depth, &" . ParseExpr("length_$e->{NAME}", $env) . "))";
pidl "\treturn False;";
pidl "";
}
}
# Everything but fixed arrays have to be allocated
if (!$l->{IS_FIXED} and $what == PRIMITIVES) {
pidl "if (UNMARSHALLING(ps)) {";
indent;
pidl "$varname = (void *)PRS_ALLOC_MEM_VOID(ps,sizeof(*$varname)*$size);";
deindent;
pidl "}";
}
return if ($what == DEFERRED and not ContainsDeferred($e,$l));
my $i = "i_$e->{NAME}_$l->{LEVEL_INDEX}";
pidl "for ($i=0; $i<$len;$i++) {";
indent;
ParseElementLevel($e,$nl,$env,$varname."[$i]",$what,$align);
deindent;
pidl "}";
}
sub ParseElementLevelSwitch($$$$$$$)
{
my ($e,$l,$nl,$env,$varname,$what,$align) = @_;
ParseElementLevel($e,$nl,$env,$varname,$what,$align);
}
sub ParseElementLevelPtr($$$$$$$)
{
my ($e,$l,$nl,$env,$varname,$what,$align) = @_;
if ($what == PRIMITIVES) {
if (($l->{POINTER_TYPE} eq "ref") and ($l->{LEVEL} eq "EMBEDDED")) {
# Ref pointers always have to be non-NULL
pidl "if (MARSHALLING(ps) && !" . ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . ")";
pidl "\treturn False;";
pidl "";
}
unless ($l->{POINTER_TYPE} eq "ref" and $l->{LEVEL} eq "TOP") {
Align($align, 4);
pidl "if (!prs_uint32(\"ptr$l->{POINTER_INDEX}_$e->{NAME}\", ps, depth, &" . ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . "))";
pidl "\treturn False;";
pidl "";
}
}
if ($l->{POINTER_TYPE} eq "relative") {
fatal($e, "relative pointers not supported for Samba 3");
#FIXME
}
if ($what == DEFERRED) {
if ($l->{POINTER_TYPE} ne "ref") {
pidl "if (" . ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . ") {";
indent;
}
ParseElementLevel($e,$nl,$env,$varname,PRIMITIVES,$align);
ParseElementLevel($e,$nl,$env,$varname,DEFERRED,$align);
if ($l->{POINTER_TYPE} ne "ref") {
deindent;
pidl "}";
}
$$align = 0;
}
}
sub ParseElementLevelSubcontext($$$$$$$)
{
my ($e,$l,$nl,$env,$varname,$what,$align) = @_;
fatal($e, "subcontext() not supported for Samba 3");
#FIXME
}
sub ParseElementLevel($$$$$$)
{
my ($e,$l,$env,$varname,$what,$align) = @_;
{
DATA => \&ParseElementLevelData,
SUBCONTEXT => \&ParseElementLevelSubcontext,
POINTER => \&ParseElementLevelPtr,
SWITCH => \&ParseElementLevelSwitch,
ARRAY => \&ParseElementLevelArray
}->{$l->{TYPE}}->($e,$l,GetNextLevel($e,$l),$env,$varname,$what,$align);
}
sub ParseElement($$$$)
{
my ($e,$env,$what,$align) = @_;
ParseElementLevel($e, $e->{LEVELS}[0], $env, ParseExpr($e->{NAME}, $env), $what, $align);
}
sub InitLevel($$$$)
{
sub InitLevel($$$$);
my ($e,$l,$varname,$env) = @_;
if ($l->{TYPE} eq "POINTER") {
if ($l->{POINTER_TYPE} eq "ref") {
pidl "if (!$varname)";
pidl "\treturn False;";
pidl "";
} else {
pidl "if ($varname) {";
indent;
}
pidl ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . " = 1;";
InitLevel($e, GetNextLevel($e,$l), "*$varname", $env);
if ($l->{POINTER_TYPE} ne "ref") {
deindent;
pidl "} else {";
pidl "\t" . ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . " = 0;";
pidl "}";
}
} elsif ($l->{TYPE} eq "ARRAY") {
pidl ParseExpr($e->{NAME}, $env) . " = $varname;";
} elsif ($l->{TYPE} eq "DATA") {
pidl InitType($e, $l, ParseExpr($e->{NAME}, $env), $varname);
} elsif ($l->{TYPE} eq "SWITCH") {
InitLevel($e, GetNextLevel($e,$l), $varname, $env);
}
}
sub GenerateEnvElement($$)
{
my ($e,$env) = @_;
foreach my $l (@{$e->{LEVELS}}) {
if ($l->{TYPE} eq "DATA") {
$env->{$e->{NAME}} = "v->$e->{NAME}";
} elsif ($l->{TYPE} eq "POINTER") {
$env->{"ptr$l->{POINTER_INDEX}_$e->{NAME}"} = "v->ptr$l->{POINTER_INDEX}_$e->{NAME}";
} elsif ($l->{TYPE} eq "SWITCH") {
$env->{"level_$e->{NAME}"} = "v->level_$e->{NAME}";
} elsif ($l->{TYPE} eq "ARRAY") {
$env->{"length_$e->{NAME}"} = "v->length_$e->{NAME}";
$env->{"size_$e->{NAME}"} = "v->size_$e->{NAME}";
$env->{"offset_$e->{NAME}"} = "v->offset_$e->{NAME}";
}
}
}
sub ParseStruct($$$)
{
my ($if,$s,$n) = @_;
my $fn = "$if->{NAME}_io_$n";
my $sn = uc("$if->{NAME}_$n");
my $ifn = "init_$if->{NAME}_$n";
my $args = "";
foreach (@{$s->{ELEMENTS}}) {
$args .= ", " . DeclLong($_);
}
my $env = { "this" => "v" };
GenerateEnvElement($_, $env) foreach (@{$s->{ELEMENTS}});
pidl "BOOL $ifn($sn *v$args)";
pidl "{";
indent;
pidl "DEBUG(5,(\"$ifn\\n\"));";
pidl "";
# Call init for all arguments
foreach (@{$s->{ELEMENTS}}) {
InitLevel($_, $_->{LEVELS}[0], $_->{NAME}, $env);
pidl "";
}
pidl "return True;";
deindent;
pidl "}";
pidl "";
my $pfn = "$fn\_p";
my $dfn = "$fn\_d";
pidl "BOOL $pfn(const char *desc, $sn *v, prs_struct *ps, int depth)";
pidl "{";
indent;
DeclareArrayVariables($s->{ELEMENTS}, PRIMITIVES);
pidl "if (v == NULL)";
pidl "\treturn False;";
pidl "";
pidl "prs_debug(ps, depth, desc, \"$pfn\");";
pidl "depth++;";
my $align = 8;
if ($s->{SURROUNDING_ELEMENT}) {
pidl "if (!prs_uint32(\"size_$s->{SURROUNDING_ELEMENT}->{NAME}\", ps, depth, &" . ParseExpr("size_$s->{SURROUNDING_ELEMENT}->{NAME}", $env) . "))";
pidl "\treturn False;";
pidl "";
$align = 4;
}
foreach (@{$s->{ELEMENTS}}) {
ParseElement($_, $env, PRIMITIVES, \$align);
pidl "";
}
pidl "return True;";
deindent;
pidl "}";
pidl "";
pidl "BOOL $dfn(const char *desc, $sn *v, prs_struct *ps, int depth)";
pidl "{";
indent;
DeclareArrayVariables($s->{ELEMENTS}, DEFERRED);
pidl "if (v == NULL)";
pidl "\treturn False;";
pidl "";
pidl "prs_debug(ps, depth, desc, \"$dfn\");";
pidl "depth++;";
$align = 0;
foreach (@{$s->{ELEMENTS}}) {
ParseElement($_, $env, DEFERRED, \$align);
pidl "";
}
pidl "return True;";
deindent;
pidl "}";
pidl "";
}
sub UnionGenerateEnvElement($)
{
my $e = shift;
my $env = {};
foreach my $l (@{$e->{LEVELS}}) {
if ($l->{TYPE} eq "DATA") {
$env->{$e->{NAME}} = "v->u.$e->{NAME}";
} elsif ($l->{TYPE} eq "POINTER") {
$env->{"ptr$l->{POINTER_INDEX}_$e->{NAME}"} = "v->ptr$l->{POINTER_INDEX}";
} elsif ($l->{TYPE} eq "SWITCH") {
$env->{"level_$e->{NAME}"} = "v->level";
} elsif ($l->{TYPE} eq "ARRAY") {
$env->{"length_$e->{NAME}"} = "v->length";
$env->{"size_$e->{NAME}"} = "v->size";
$env->{"offset_$e->{NAME}"} = "v->offset";
}
}
return $env;
}
sub ParseUnion($$$)
{
my ($if,$u,$n) = @_;
my $fn = "$if->{NAME}_io_$n";
my $sn = uc("$if->{NAME}_$n\_ctr");
my $pfn = "$fn\_p";
my $dfn = "$fn\_d";
pidl "BOOL $pfn(const char *desc, $sn* v, uint32 level, prs_struct *ps, int depth)";
pidl "{";
indent;
DeclareArrayVariables($u->{ELEMENTS});
unless (has_property($u, "nodiscriminant")) {
pidl "if (!prs_uint32(\"switch_value\", ps, depth, &v->switch_value))";
pidl "\treturn False;";
pidl "";
}
# Maybe check here that level and v->switch_value are equal?
pidl "switch (level) {";
indent;
foreach (@{$u->{ELEMENTS}}) {
pidl "$_->{CASE}:";
indent;
if ($_->{TYPE} ne "EMPTY") {
pidl "depth++;";
my $env = UnionGenerateEnvElement($_);
my $align = 8;
ParseElement($_, $env, PRIMITIVES, \$align);
pidl "depth--;";
}
pidl "break;";
deindent;
pidl "";
}
deindent;
pidl "}";
pidl "";
pidl "return True;";
deindent;
pidl "}";
pidl "BOOL $dfn(const char *desc, $sn* v, uint32 level, prs_struct *ps, int depth)";
pidl "{";
indent;
DeclareArrayVariables($u->{ELEMENTS});
pidl "switch (level) {";
indent;
foreach (@{$u->{ELEMENTS}}) {
pidl "$_->{CASE}:";
indent;
if ($_->{TYPE} ne "EMPTY") {
pidl "depth++;";
my $env = UnionGenerateEnvElement($_);
my $align = 0;
ParseElement($_, $env, DEFERRED, \$align);
pidl "depth--;";
}
pidl "break;";
deindent;
pidl "";
}
deindent;
pidl "}";
pidl "";
pidl "return True;";
deindent;
pidl "}";
}
sub CreateFnDirection($$$$)
{
my ($fn,$ifn, $s,$es) = @_;
my $args = "";
foreach (@$es) {
$args .= ", " . DeclLong($_);
}
my $env = { "this" => "v" };
GenerateEnvElement($_, $env) foreach (@$es);
pidl "BOOL $ifn($s *v$args)";
pidl "{";
indent;
pidl "DEBUG(5,(\"$ifn\\n\"));";
pidl "";
# Call init for all arguments
foreach (@$es) {
InitLevel($_, $_->{LEVELS}[0], $_->{NAME}, $env);
pidl "";
}
pidl "return True;";
deindent;
pidl "}";
pidl "";
pidl "BOOL $fn(const char *desc, $s *v, prs_struct *ps, int depth)";
pidl "{";
indent;
DeclareArrayVariables($es);
pidl "if (v == NULL)";
pidl "\treturn False;";
pidl "";
pidl "prs_debug(ps, depth, desc, \"$fn\");";
pidl "depth++;";
my $align = 8;
foreach (@$es) {
ParseElement($_, $env, PRIMITIVES, \$align);
ParseElement($_, $env, DEFERRED, \$align);
pidl "";
}
pidl "return True;";
deindent;
pidl "}";
pidl "";
}
sub ParseFunction($$)
{
my ($if,$fn) = @_;
my @in = ();
my @out = ();
foreach (@{$fn->{ELEMENTS}}) {
push (@in, $_) if (grep(/in/, @{$_->{DIRECTION}}));
push (@out, $_) if (grep(/out/, @{$_->{DIRECTION}}));
}
if (defined($fn->{RETURN_TYPE})) {
push (@out, {
NAME => "status",
TYPE => $fn->{RETURN_TYPE},
LEVELS => [
{
TYPE => "DATA",
DATA_TYPE => $fn->{RETURN_TYPE}
}
]
} );
}
CreateFnDirection("$if->{NAME}_io_q_$fn->{NAME}",
"init_$if->{NAME}_q_$fn->{NAME}",
uc("$if->{NAME}_q_$fn->{NAME}"),
\@in);
CreateFnDirection("$if->{NAME}_io_r_$fn->{NAME}",
"init_$if->{NAME}_r_$fn->{NAME}",
uc("$if->{NAME}_r_$fn->{NAME}"),
\@out);
}
sub ParseInterface($)
{
my $if = shift;
# Structures first
pidl "/* $if->{NAME} structures */";
foreach (@{$if->{TYPEDEFS}}) {
ParseStruct($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "STRUCT");
ParseUnion($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "UNION");
}
pidl "/* $if->{NAME} functions */";
ParseFunction($if, $_) foreach (@{$if->{FUNCTIONS}});
}
sub Parse($$)
{
my($ndr,$filename) = @_;
$tabs = "";
$res = "";
pidl "/*";
pidl " * Unix SMB/CIFS implementation.";
pidl " * parser auto-generated by pidl. DO NOT MODIFY!";
pidl " */";
pidl "";
pidl "#include \"includes.h\"";
pidl "";
pidl "#undef DBGC_CLASS";
pidl "#define DBGC_CLASS DBGC_RPC_PARSE";
pidl "";
foreach (@$ndr) {
ParseInterface($_) if ($_->{TYPE} eq "INTERFACE");
}
return $res;
}
1;

View File

@ -0,0 +1,119 @@
###################################################
# Samba3 NDR server generator for IDL structures
# Copyright jelmer@samba.org 2005
# released under the GNU GPL
package Parse::Pidl::Samba3::Server;
use strict;
use Parse::Pidl::Typelist qw(hasType getType mapType);
use Parse::Pidl::Util qw(has_property ParseExpr);
use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred);
my $res = "";
my $tabs = "";
sub indent() { $tabs.="\t"; }
sub deindent() { $tabs = substr($tabs, 1); }
sub pidl($) { $res .= $tabs.(shift)."\n"; }
use vars qw($VERSION);
$VERSION = '0.01';
sub ParseFunction($$)
{
my ($if,$fn) = @_;
pidl "/******************************************************************";
pidl " api_$fn->{NAME}";
pidl " *****************************************************************/";
pidl "";
pidl "static BOOL api_$fn->{NAME}(pipes_struct *p)";
pidl "{";
indent;
pidl uc("$if->{NAME}_q_$fn->{NAME}") . " q_u;";
pidl uc("$if->{NAME}_r_$fn->{NAME}") . " r_u;";
pidl "prs_struct *data = &p->in_data.data;";
pidl "prs_struct *rdata = &p->out_data.rdata;";
pidl "";
pidl "if (!$if->{NAME}_io_q_$fn->{NAME}(\"\", &q_u, data, 0))";
pidl "\treturn False;";
pidl "";
if ($fn->{RETURN_TYPE}) {
pidl "r_u.status = _$fn->{NAME}(p, &q_u, &r_u);";
} else {
pidl "_$fn->{NAME}(p, &q_u, &r_u);";
}
pidl "";
pidl "if (!$if->{NAME}_io_r_$fn->{NAME}(\"\", &r_u, rdata, 0))";
pidl "\treturn False;";
pidl "";
pidl "return True;";
deindent;
pidl "}";
}
sub ParseInterface($)
{
my $if = shift;
ParseFunction($if, $_) foreach (@{$if->{FUNCTIONS}});
pidl "";
pidl "/* Tables */";
pidl "static struct api_struct api_$if->{NAME}_cmds[] = ";
pidl "{";
indent;
foreach (@{$if->{FUNCTIONS}}) {
pidl "{\"" . uc($_->{NAME}) . "\", " . uc($_->{NAME}) . ", api_$_->{NAME}},";
}
deindent;
pidl "};";
pidl "";
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 "";
pidl "NTSTATUS rpc_$if->{NAME}_init(void)";
pidl "{";
indent;
pidl "return rpc_pipe_register_commands(SMB_RPC_INTERFACE_VERSION, \"$if->{NAME}\", \"$if->{NAME}\", api_$if->{NAME}_cmds, sizeof(api_$if->{NAME}_cmds) / sizeof(struct api_struct));";
deindent;
pidl "}";
}
sub Parse($$)
{
my($ndr,$filename) = @_;
$tabs = "";
$res = "";
pidl "/*";
pidl " * Unix SMB/CIFS implementation.";
pidl " * server auto-generated by pidl. DO NOT MODIFY!";
pidl " */";
pidl "";
pidl "#include \"includes.h\"";
pidl "#include \"nterr.h\"";
pidl "";
pidl "#undef DBGC_CLASS";
pidl "#define DBGC_CLASS DBGC_RPC";
pidl "";
foreach (@$ndr) {
ParseInterface($_) if ($_->{TYPE} eq "INTERFACE");
}
return $res;
}
1;

View File

@ -0,0 +1,66 @@
###################################################
# Samba3 NDR client generator for IDL structures
# Copyright jelmer@samba.org 2005
# released under the GNU GPL
package Parse::Pidl::Samba3::Template;
use strict;
use Parse::Pidl::Typelist qw(hasType getType mapType);
use Parse::Pidl::Util qw(has_property ParseExpr);
use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred);
use vars qw($VERSION);
$VERSION = '0.01';
my $res;
sub pidl($) { my $x = shift; $res.="$x\n"; }
sub ParseInterface($)
{
my $if = shift;
foreach (@{$if->{FUNCTIONS}}) {
my $ret = $_->{RETURN_TYPE};
if (not $ret) { $ret = "void"; }
pidl "$ret _$_->{NAME}(pipes_struct *p, " . uc($if->{NAME}) . "_Q_" . uc($_->{NAME}) . " *q_u, " . uc($if->{NAME}) . "_R_" . uc($_->{NAME}) . " *r_u)";
pidl "{";
pidl "\t/* FIXME: Implement your code here */";
if (not defined($_->{RETURN_TYPE})) {
} elsif ($_->{RETURN_TYPE} eq "WERROR") {
pidl "\treturn WERR_NOT_SUPPORTED;";
} elsif ($_->{RETURN_TYPE} eq "NTSTATUS") {
pidl "\treturn NT_STATUS_NOT_IMPLEMENTED;";
} elsif ($_->{RETURN_TYPE} eq "uint32") {
pidl "\treturn 0;";
}
pidl "}";
pidl "";
}
}
sub Parse($$)
{
my($ndr,$filename) = @_;
$res = "";
pidl "/*";
pidl " * Unix SMB/CIFS implementation.";
pidl " * template auto-generated by pidl. Modify to your needs";
pidl " */";
pidl "";
pidl "#include \"includes.h\"";
pidl "";
pidl "#undef DBGC_CLASS";
pidl "#define DBGC_CLASS DBGC_MSRPC";
pidl "";
foreach (@$ndr) {
ParseInterface($_) if ($_->{TYPE} eq "INTERFACE");
}
return $res;
}
1;

View File

@ -0,0 +1,395 @@
###################################################
# Samba3 type-specific declarations / initialization / marshalling
# Copyright jelmer@samba.org 2005
# released under the GNU GPL
package Parse::Pidl::Samba3::Types;
require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(DeclShort DeclLong InitType DissectType AddType);
use strict;
use Parse::Pidl::Util qw(has_property ParseExpr property_matches);
use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred);
use vars qw($VERSION);
$VERSION = '0.01';
# TODO: Find external types somehow?
sub warning($$) { my ($e,$s) = @_; print STDERR "$e->{FILE}:$e->{LINE}: $s\n"; }
sub init_scalar($$$$)
{
my ($e,$l,$n,$v) = @_;
return "$n = $v;";
}
sub dissect_scalar($$$$$)
{
my ($e,$l,$n,$w,$a) = @_;
my $t = lc($e->{TYPE});
return "prs_$t(\"$e->{NAME}\", ps, depth, &$n)";
}
sub decl_string($)
{
my $e = shift;
my $is_conformant = property_matches($e, "flag", ".*STR_SIZE4.*");
my $is_varying = property_matches($e, "flag", ".*STR_LEN4.*");
my $is_ascii = property_matches($e, "flag", ".*STR_ASCII.*");
return "STRING2" if ($is_conformant and $is_varying and $is_ascii);
return "UNISTR2" if ($is_conformant and $is_varying);
return "UNISTR3" if ($is_varying);
# We don't do UNISTR4, as we have lsa_String for that in Samba4's IDL
die("Don't know what string type to use");
}
sub contains_pointer($)
{
my $e = shift;
foreach my $l (@{$e->{LEVELS}}) {
return 1 if ($l->{TYPE} eq "POINTER");
}
return 0;
}
sub ext_decl_string($)
{
my $e = shift;
# One pointer is sufficient..
return "const char" if (contains_pointer($e));
return "const char *";
}
sub init_string($$$$)
{
my ($e,$l,$n,$v) = @_;
my $t = lc(decl_string($e));
my $flags;
if (property_matches($e, "flag", ".*STR_NULLTERM.*")) {
$flags = "UNI_STR_TERMINATE";
} elsif (property_matches($e, "flag", ".*STR_NOTERM.*")) {
$flags = "UNI_STR_NOTERM";
} else {
$flags = "UNI_FLAGS_NONE";
}
# One pointer is sufficient
if (substr($v, 0, 1) eq "*") { $v = substr($v, 1); }
return "init_$t(&$n, $v, $flags);";
}
sub dissect_string($$$$$)
{
my ($e,$l,$n,$w,$a) = @_;
my $t = lc(decl_string($e));
$$a = 1;
return "smb_io_$t(\"$e->{NAME}\", &$n, 1, ps, depth)";
}
my $known_types =
{
uint8 =>
{
DECL => "uint8",
INIT => \&init_scalar,
DISSECT_P => \&dissect_scalar,
},
uint16 =>
{
DECL => "uint16",
INIT => \&init_scalar,
DISSECT_P => \&dissect_scalar,
},
uint32 =>
{
DECL => "uint32",
INIT => \&init_scalar,
DISSECT_P => \&dissect_scalar,
},
uint64 =>
{
DECL => "uint64",
INIT => \&init_scalar,
DISSECT_P => \&dissect_scalar,
},
string =>
{
DECL => \&decl_string,
EXT_DECL => \&ext_decl_string,
INIT => \&init_string,
DISSECT_P => \&dissect_string,
},
NTSTATUS =>
{
DECL => "NTSTATUS",
INIT => \&init_scalar,
DISSECT_P => \&dissect_scalar,
},
WERROR =>
{
DECL => "WERROR",
INIT => \&init_scalar,
DISSECT_P => \&dissect_scalar,
},
GUID =>
{
DECL => "struct uuid",
INIT => "",
DISSECT_P => sub {
my ($e,$l,$n) = @_;
return "smb_io_uuid(\"$e->{NAME}\", &$n, ps, depth)";
}
},
NTTIME =>
{
DECL => "NTTIME",
INIT => "",
DISSECT_P => sub {
my ($e,$l,$n,$w,$a) = @_;
return "smb_io_nttime(\"$e->{NAME}\", &n, ps, depth)";
}
},
dom_sid =>
{
DECL => "DOM_SID",
INIT => "",
DISSECT_P => sub {
my ($e,$l,$n,$w,$a) = @_;
return "smb_io_dom_sid(\"$e->{NAME}\", &n, ps, depth)";
}
},
policy_handle =>
{
DECL => "POLICY_HND",
INIT => "",
DISSECT_P => sub {
my ($e,$l,$n,$w,$a) = @_;
return "smb_io_pol_hnd(\"$e->{NAME}\", &n, ps, depth)";
}
},
hyper =>
{
DECL => "uint64",
INIT => "",
DISSECT_P => sub {
my ($e,$l,$n,$w,$a) = @_;
return "prs_uint64(\"$e->{NAME}\", ps, depth, &$n)";
}
},
};
sub AddType($$)
{
my ($t,$d) = @_;
warn("Reregistering type $t") if (defined($known_types->{$t}));
$known_types->{$t} = $d;
}
sub GetType($)
{
my $e = shift;
}
# Return type without special stuff, as used in
# declarations for internal structs
sub DeclShort($)
{
my $e = shift;
my $t = $known_types->{$e->{TYPE}};
if (not $t) {
warning($e, "Can't declare unknown type $e->{TYPE}");
return undef;
}
my $p;
# DECL can be a function
if (ref($t->{DECL}) eq "CODE") {
$p = $t->{DECL}->($e);
} else {
$p = $t->{DECL};
}
my $prefixes = "";
my $suffixes = "";
foreach my $l (@{$e->{LEVELS}}) {
if ($l->{TYPE} eq "ARRAY" and not $l->{IS_FIXED}) {
$prefixes = "*$prefixes";
} elsif ($l->{TYPE} eq "ARRAY" and $l->{IS_FIXED}) {
$suffixes.="[$l->{SIZE_IS}]";
}
}
return "$p $prefixes$e->{NAME}$suffixes";
}
# Return type including special stuff (pointers, etc).
sub DeclLong($)
{
my $e = shift;
my $t = $known_types->{$e->{TYPE}};
if (not $t) {
warning($e, "Can't declare unknown type $e->{TYPE}");
return undef;
}
my $p;
if (defined($t->{EXT_DECL})) {
$p = $t->{EXT_DECL}
} else {
$p = $t->{DECL};
}
if (ref($p) eq "CODE") {
$p = $p->($e);
}
my $prefixes = "";
my $suffixes = "";
foreach my $l (@{$e->{LEVELS}}) {
if ($l->{TYPE} eq "ARRAY" and not $l->{IS_FIXED}) {
$prefixes = "*$prefixes";
} elsif ($l->{TYPE} eq "ARRAY" and $l->{IS_FIXED}) {
$suffixes.="[$l->{SIZE_IS}]";
} elsif ($l->{TYPE} eq "POINTER") {
$prefixes = "*$prefixes";
}
}
return "$p $prefixes$e->{NAME}$suffixes";
}
sub InitType($$$$)
{
my ($e, $l, $varname, $value) = @_;
my $t = $known_types->{$l->{DATA_TYPE}};
if (not $t) {
warning($e, "Don't know how to initialize type $l->{DATA_TYPE}");
return undef;
}
# INIT can be a function
if (ref($t->{INIT}) eq "CODE") {
return $t->{INIT}->($e, $l, $varname, $value);
} else {
return $t->{INIT};
}
}
sub DissectType
{
my @args = @_;
my $e = shift @_;
my $l = shift @_;
my $varname = shift @_;
my $what = shift @_;
my $align = shift @_;
my $t = $known_types->{$l->{DATA_TYPE}};
if (not $t) {
warning($e, "Don't know how to dissect type $l->{DATA_TYPE}");
return undef;
}
my $dissect;
if ($what == 1) { #primitives
$dissect = $t->{DISSECT_P};
} elsif ($what == 2) {
$dissect = $t->{DISSECT_D};
}
return "" if not defined($dissect);
# DISSECT can be a function
if (ref($dissect) eq "CODE") {
return $dissect->(@args);
} else {
return $dissect;
}
}
sub LoadTypes($)
{
my $ndr = shift;
foreach my $if (@{$ndr}) {
next unless ($if->{TYPE} eq "INTERFACE");
foreach my $td (@{$if->{TYPEDEFS}}) {
my $decl = uc("$if->{NAME}_$td->{NAME}");
my $init = sub {
my ($e,$l,$n,$v) = @_;
return "$n = $v;";
};
my $dissect_d;
my $dissect_p;
if ($td->{DATA}->{TYPE} eq "UNION") {
$decl.="_CTR";
$dissect_p = sub {
my ($e,$l,$n,$w,$a,$s) = @_;
return "$if->{NAME}_io_$td->{NAME}_p(\"$e->{NAME}\", &$n, $s, ps, depth)";
};
$dissect_d = sub {
my ($e,$l,$n,$w,$a,$s) = @_;
return "$if->{NAME}_io_$td->{NAME}_d(\"$e->{NAME}\", &$n, $s, ps, depth)";
};
} else {
$dissect_p = sub {
my ($e,$l,$n,$w,$a) = @_;
return "$if->{NAME}_io_$td->{NAME}_p(\"$e->{NAME}\", &$n, ps, depth)";
};
$dissect_d = sub {
my ($e,$l,$n,$w,$a) = @_;
return "$if->{NAME}_io_$td->{NAME}_d(\"$e->{NAME}\", &$n, ps, depth)";
};
}
AddType($td->{NAME}, {
DECL => $decl,
INIT => $init,
DISSECT_D => $dissect_d,
DISSECT_P => $dissect_p
});
}
}
}
1;

View File

@ -7,7 +7,7 @@ package Parse::Pidl::Typelist;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(hasType getType mapType);
@EXPORT_OK = qw(hasType getType mapType);
use vars qw($VERSION);
$VERSION = '0.01';
@ -22,109 +22,90 @@ my $scalars = {
"void" => {
C_TYPE => "void",
IS_REFERENCE => 0,
NDR_ALIGN => 0
},
# 1 byte types
"char" => {
C_TYPE => "char",
IS_REFERENCE => 0,
NDR_ALIGN => 1
},
"int8" => {
C_TYPE => "int8_t",
IS_REFERENCE => 0,
NDR_ALIGN => 1
},
"uint8" => {
C_TYPE => "uint8_t",
IS_REFERENCE => 0,
NDR_ALIGN => 1
},
# 2 byte types
"int16" => {
C_TYPE => "int16_t",
IS_REFERENCE => 0,
NDR_ALIGN => 2
},
"uint16" => { C_TYPE => "uint16_t",
IS_REFERENCE => 0,
NDR_ALIGN => 2
},
# 4 byte types
"int32" => {
C_TYPE => "int32_t",
IS_REFERENCE => 0,
NDR_ALIGN => 4
},
"uint32" => { C_TYPE => "uint32_t",
IS_REFERENCE => 0,
NDR_ALIGN => 4
},
# 8 byte types
"hyper" => {
C_TYPE => "uint64_t",
IS_REFERENCE => 0,
NDR_ALIGN => 8
},
"dlong" => {
C_TYPE => "int64_t",
IS_REFERENCE => 0,
NDR_ALIGN => 4
},
"udlong" => {
C_TYPE => "uint64_t",
IS_REFERENCE => 0,
NDR_ALIGN => 4
},
"udlongr" => {
C_TYPE => "uint64_t",
IS_REFERENCE => 0,
NDR_ALIGN => 4
},
# DATA_BLOB types
"DATA_BLOB" => {
C_TYPE => "DATA_BLOB",
IS_REFERENCE => 0,
NDR_ALIGN => 4
},
# string types
"string" => {
C_TYPE => "const char *",
IS_REFERENCE => 1,
NDR_ALIGN => 4 #???
},
"string_array" => {
C_TYPE => "const char **",
IS_REFERENCE => 1,
NDR_ALIGN => 4 #???
},
# time types
"time_t" => {
C_TYPE => "time_t",
IS_REFERENCE => 0,
NDR_ALIGN => 4
},
"NTTIME" => {
C_TYPE => "NTTIME",
IS_REFERENCE => 0,
NDR_ALIGN => 4
},
"NTTIME_1sec" => {
C_TYPE => "NTTIME",
IS_REFERENCE => 0,
NDR_ALIGN => 4
},
"NTTIME_hyper" => {
C_TYPE => "NTTIME",
IS_REFERENCE => 0,
NDR_ALIGN => 8
},
@ -132,29 +113,28 @@ my $scalars = {
"WERROR" => {
C_TYPE => "WERROR",
IS_REFERENCE => 0,
NDR_ALIGN => 4
},
"NTSTATUS" => {
C_TYPE => "NTSTATUS",
IS_REFERENCE => 0,
NDR_ALIGN => 4
},
"COMRESULT" => {
"C_TYPE" => "COMRESULT",
IS_REFERENCE => 0,
NDR_ALIGN => 4
C_TYPE => "COMRESULT",
IS_REFERENCE => 0,
},
# special types
"nbt_string" => {
C_TYPE => "const char *",
IS_REFERENCE => 1,
NDR_ALIGN => 4 #???
},
"wrepl_nbt_name"=> {
C_TYPE => "struct nbt_name *",
IS_REFERENCE => 1,
},
"ipv4address" => {
C_TYPE => "const char *",
IS_REFERENCE => 1,
NDR_ALIGN => 4
}
};
@ -170,17 +150,6 @@ sub mapScalarType($)
die("Unknown scalar type $name");
}
sub getScalarAlignment($)
{
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}{NDR_ALIGN} if defined($scalars->{$name}) and defined($scalars->{$name}{NDR_ALIGN});
die("Unknown scalar type $name");
}
sub addType($)
{
my $t = shift;

View File

@ -15,12 +15,12 @@ pidl - IDL Compiler written in Perl
=head1 SYNOPSIS
pidl --help
pidl [--outputdir[=OUTNAME]] [--parse-idl-tree] [--dump-idl-tree] [--dump-ndr-tree] [--ndr-header[=OUTPUT]] [--header[=OUTPUT]] [--ejs[=OUTPUT]] [--swig[=OUTPUT]] [--uint-enums] [--ndr-parser[=OUTPUT]] [--client] [--server] [--dcom-proxy] [--com-header] [--warn-compat] [--quiet] [--verbose] [--template] [--eth-parser[=OUTPUT]] [--diff] [--dump-idl] [<idlfile>.idl]...
pidl [--outputdir[=OUTNAME]] [--parse-idl-tree] [--dump-idl-tree] [--dump-ndr-tree] [--ndr-header[=OUTPUT]] [--header[=OUTPUT]] [--ejs[=OUTPUT]] [--swig[=OUTPUT]] [--uint-enums] [--ndr-parser[=OUTPUT]] [--client] [--server] [--dcom-proxy] [--com-header] [--warn-compat] [--quiet] [--verbose] [--template] [--eth-parser[=OUTPUT]] [--diff] [--dump-idl] [--tdr-header=[OUTPUT]] [--tdr-parser[=OUTPUT]] [--samba3-header[=OUTPUT]] [--samba3-parser=[OUTPUT]] [--samba3-server=[OUTPUT]] [--samba3-template[=OUTPUT]] [--samba3-client[=OUTPUT]] [<idlfile>.idl]...
=head1 DESCRIPTION
pidl is an IDL compiler written in Perl that aims to be somewhat
compatible with the midl compiler. IDL stands for
compatible with the midl compiler. IDL is short for
"Interface Definition Language".
pidl can generate stubs for DCE/RPC server code, DCE/RPC
@ -89,8 +89,9 @@ be written to stdout.
=item I<--eth-parser>
Generate an Ethereal dissector (in C) for the interface. Filename
defaults to packet-dcerpc-OUTNAME.c.
Generate an Ethereal dissector (in C) and header file. The dissector filename
defaults to packet-dcerpc-OUTNAME.c while the header filename defaults to
packet-dcerpc-OUTNAME.h.
Pidl will read additional data from an ethereal conformance file if present.
Such a file should have the same location as the IDL file but with the
@ -113,6 +114,30 @@ file the to disk. Useful for debugging pidl.
Tell pidl to dump the internal NDR information tree it generated
from the IDL file to disk. Useful for debugging pidl.
=item I<--samba3-header>
Generate Samba3-style RPC header file. Filename defaults to rpc_BASENAME.h.
=item I<--samba3-parser>
Generate parser file for Samba3, to be placed in rpc_parse/. Filename defaults
to parse_BASENAME.c.
=item I<--samba3-server>
Generate server file for Samba3, to be placed in rpc_server/. Filename defaults
to srv_BASENAME.c.
=item I<--samba3-template>
Generate template for server-side implementation in Samba3, to be placed in
rpc_server/. Filename defaults to srv_BASENAME_nt.c
=item I<--samba3-client>
Generate client calls for Samba 3, to be placed in rpc_client/. Filename
defaults to cli_BASENAME.c.
=back
=head1 IDL SYNTAX
@ -343,24 +368,24 @@ The following commands are currently supported:
=over 4
=item TYPE name dissector ft_type base_type mask valsstring alignment
=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 NOEMIT type
=item I<NOEMIT> type
Suppress emitting a dissect_type function for the specified type
=item PARAM_VALUE type param
=item I<PARAM_VALUE> type param
Set parameter to specify to dissector function for given type.
=item HF_FIELD hf title filter ft_type base_type valsstring mask description
=item I<HF_FIELD> hf title filter ft_type base_type valsstring mask description
Generate a custom header field with specified properties.
=item HF_RENAME old_hf_name new_hf_name
=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.
@ -368,20 +393,20 @@ use old_hf_name.
This can be used in conjunction with HF_FIELD in order to make more then
one element use the same filter name.
=item STRIP_PREFIX prefix
=item I<STRIP_PREFIX> prefix
Remove the specified prefix from all function names (if present).
=item PROTOCOL longname shortname filtername
=item I<PROTOCOL> longname shortname filtername
Change the short-, long- and filter-name for the current interface in
Ethereal.
=item FIELD_DESCRIPTION field desc
=item I<FIELD_DESCRIPTION> field desc
Change description for the specified header field. `field' is the hf name of the field.
=item IMPORT dissector code...
=item I<IMPORT> dissector code...
Code to insert when generating the specified dissector. @HF@ and
@PARAM@ will be substituted.
@ -402,10 +427,14 @@ This man page is correct for version 4.0 of the Samba suite. L<http://www.samba.
=head1 SEE ALSO
L<http://msdn.microsoft.com/library/en-us/rpc/rpc/field_attributes.asp>
L<http://wiki.ethereal.com/DCE/RPC>
L<http://msdn.microsoft.com/library/en-us/rpc/rpc/field_attributes.asp>,
L<http://wiki.ethereal.com/DCE/RPC>,
yapp(1)
=head1 LICENSE
pidl is licensed under the GNU General Public License L<http://www.gnu.org/licenses/gpl.html>.
=head1 AUTHOR
pidl was written by Andrew Tridgell, Stefan Metzmacher, Tim Potter and Jelmer
@ -481,6 +510,11 @@ my($opt_uint_enums) = 0;
my($opt_diff) = 0;
my($opt_header);
my($opt_ndr_header);
my($opt_samba3_header);
my($opt_samba3_parser);
my($opt_samba3_server);
my($opt_samba3_template);
my($opt_samba3_client);
my($opt_template) = 0;
my($opt_client);
my($opt_server);
@ -535,6 +569,13 @@ Samba 4 output:
--dcom-proxy[=OUTFILE] create DCOM proxy [ndr_BASENAME_p.c]
--com-header[=OUTFILE] create header for COM [com_BASENAME.h]
Samba 3 output:
--samba3-header[=OUTF] create Samba3-style header [rpc_BASENAME.h]
--samba3-parser[=OUTF] create parser for Samba3 [parse_BASENAME.c]
--samba3-template[=OUTF]create template implementation [srv_BASENAME_nt.c]
--samba3-server[=OUTF] create server side wrappers for Samba3 [srv_BASENAME.c]
--samba3-client[=OUTF] create client calls for Samba3 [cli_BASENAME.c]
Ethereal parsers:
--eth-parser[=OUTFILE] create ethereal parser and header
\n";
@ -542,7 +583,7 @@ Ethereal parsers:
}
# main program
GetOptions (
my $result = GetOptions (
'help|h|?' => \$opt_help,
'outputdir=s' => \$opt_outputdir,
'dump-idl' => \$opt_dump_idl,
@ -551,6 +592,11 @@ GetOptions (
'dump-ndr-tree:s' => \$opt_dump_ndr_tree,
'uint-enums' => \$opt_uint_enums,
'ndr-header:s' => \$opt_ndr_header,
'samba3-header:s' => \$opt_samba3_header,
'samba3-parser:s' => \$opt_samba3_parser,
'samba3-server:s' => \$opt_samba3_server,
'samba3-template:s' => \$opt_samba3_template,
'samba3-client:s' => \$opt_samba3_client,
'header:s' => \$opt_header,
'server:s' => \$opt_server,
'tdr-header:s' => \$opt_tdr_header,
@ -569,6 +615,10 @@ GetOptions (
'warn-compat' => \$opt_warn_compat
);
if (not $result) {
exit(1);
}
if ($opt_help) {
ShowHelp();
exit(0);
@ -653,7 +703,9 @@ sub process_file($)
if (defined($opt_ndr_header) or defined($opt_eth_parser) or
defined($opt_client) or defined($opt_server) or
defined($opt_ndr_parser) or defined($opt_ejs) or
defined($opt_dump_ndr_tree)) {
defined($opt_dump_ndr_tree) or defined($opt_samba3_header) or
defined($opt_samba3_header) or defined($opt_samba3_server) or
defined($opt_samba3_template) or defined($opt_samba3_client)) {
require Parse::Pidl::NDR;
Parse::Pidl::NDR::Validate($pidl);
$ndr = Parse::Pidl::NDR::Parse($pidl);
@ -760,11 +812,49 @@ $dcom
require Parse::Pidl::Samba::Template;
print Parse::Pidl::Samba::Template::Parse($pidl);
}
if (defined($opt_samba3_header) or defined($opt_samba3_parser) or
defined($opt_samba3_server) or defined($opt_samba3_client) or
defined($opt_samba3_template)) {
require Parse::Pidl::Samba3::Types;
Parse::Pidl::Samba3::Types::LoadTypes($ndr);
}
if (defined($opt_samba3_header)) {
my $header = ($opt_samba3_header or "$outputdir/rpc_$basename.h");
require Parse::Pidl::Samba3::Header;
FileSave($header, Parse::Pidl::Samba3::Header::Parse($ndr, $basename));
}
if (defined($opt_samba3_parser)) {
my $header = ($opt_samba3_parser or "$outputdir/parse_$basename.c");
require Parse::Pidl::Samba3::Parser;
FileSave($header, Parse::Pidl::Samba3::Parser::Parse($ndr, $basename));
}
if (defined($opt_samba3_server)) {
my $header = ($opt_samba3_server or "$outputdir/srv_$basename.c");
require Parse::Pidl::Samba3::Server;
FileSave($header, Parse::Pidl::Samba3::Server::Parse($ndr, $basename));
}
if (defined($opt_samba3_template)) {
my $header = ($opt_samba3_template or "$outputdir/srv_$basename\_nt.c");
require Parse::Pidl::Samba3::Template;
FileSave($header, Parse::Pidl::Samba3::Template::Parse($ndr, $basename));
}
if (defined($opt_samba3_client)) {
my $header = ($opt_samba3_client or "$outputdir/cli_$basename.c");
require Parse::Pidl::Samba3::Client;
FileSave($header, Parse::Pidl::Samba3::Client::Parse($ndr, $basename));
}
}
if (scalar(@ARGV) == 0) {
print "pidl: no input files\n";
exit(0);
exit(1);
}
process_file($_) foreach (@ARGV);