###################################################
# 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::Samba::COM::Proxy;

use Parse::Pidl::Samba::COM::Header;
use Parse::Pidl::Util qw(has_property);

use vars qw($VERSION);
$VERSION = '0.01';

use strict;

my($res);

sub ParseVTable($$)
{
	my $interface = shift;
	my $name = shift;

	# 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 GUID base_iid;
	struct $interface->{NAME}_vtable *proxy_vtable = talloc(talloc_autofree_context(), struct $interface->{NAME}_vtable);
";

	if (defined($interface->{BASE})) {
		$res.= "
	const void *base_vtable;

	GUID_from_string(DCERPC_" . (uc $interface->{BASE}) . "_UUID, &base_iid);

	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.= "
	GUID_from_string(DCERPC_" . (uc $interface->{NAME}) . "_UUID, &proxy_vtable.iid);

	return dcom_register_proxy(&proxy_vtable);
}\n\n";
}

#####################################################################
# parse a function
sub ParseFunction($$)
{
	my $interface = shift;
	my $fn = shift;
	my $name = $fn->{NAME};
	my $uname = uc $name;

	$res.="
static $fn->{RETURN_TYPE} dcom_proxy_$interface->{NAME}_$name(struct $interface->{NAME} *d, TALLOC_CTX *mem_ctx" . Parse::Pidl::Samba::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(&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, &dcerpc_table_$interface->{NAME}, DCERPC_$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 = shift;
	my $res = "";

	foreach my $x (@{$pidl}) {
		next if ($x->{TYPE} ne "INTERFACE");
		next if has_property($x, "local");
		next unless has_property($x, "object");

		$res .= ParseInterface($x);
	}

	return $res;
}

1;