summaryrefslogtreecommitdiffstats
path: root/pidl/lib/Parse/Pidl/Samba4/COM/Proxy.pm
diff options
context:
space:
mode:
Diffstat (limited to 'pidl/lib/Parse/Pidl/Samba4/COM/Proxy.pm')
-rw-r--r--pidl/lib/Parse/Pidl/Samba4/COM/Proxy.pm226
1 files changed, 226 insertions, 0 deletions
diff --git a/pidl/lib/Parse/Pidl/Samba4/COM/Proxy.pm b/pidl/lib/Parse/Pidl/Samba4/COM/Proxy.pm
new file mode 100644
index 0000000..1630cf2
--- /dev/null
+++ b/pidl/lib/Parse/Pidl/Samba4/COM/Proxy.pm
@@ -0,0 +1,226 @@
+###################################################
+# 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;
+use warnings;
+
+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(TALLOC_CTX *ctx)
+{
+ struct $interface->{NAME}_vtable *proxy_vtable = talloc(ctx, 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(ctx, (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;
+ }
+
+ NDR_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;