New version of pidl

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

@@ -13,7 +13,7 @@ use Exporter;
 
 use strict;
 use Parse::Pidl qw(fatal warning error);
-use Parse::Pidl::Util qw(has_property ParseExpr);
+use Parse::Pidl::Util qw(has_property ParseExpr genpad);
 use Parse::Pidl::NDR qw(ContainsPipe);
 use Parse::Pidl::Typelist qw(mapTypeName);
 use Parse::Pidl::Samba4 qw(DeclLong);
@@ -25,18 +25,9 @@ $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 pidl_hdr($$) { my ($self, $txt) = @_; $self->{res_hdr} .= "$txt\n"; }
 sub fn_declare($$) { my ($self,$n) = @_; $self->pidl($n); $self->pidl_hdr("$n;"); }
 
-sub genpad($)
-{
-	my ($s) = @_;
-	my $nt = int((length($s)+1)/8);
-	my $lt = ($nt*8)-1;
-	my $ns = (length($s)-$lt);
-	return "\t"x($nt)." "x($ns);
-}
-
 sub new($)
 {
 	my ($class) = shift;
@@ -59,7 +50,7 @@ sub HeaderProperties($$)
 	my($props,$ignores) = @_;
 	my $ret = "";
 
-	foreach my $d (keys %{$props}) {
+	foreach my $d (sort(keys %{$props})) {
 		next if (grep(/^$d$/, @$ignores));
 		if($props->{$d} ne "1") {
 			$ret.= "$d($props->{$d}),";

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

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

bin/pidl/lib/Parse/Pidl/Samba3/Template.pm

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