diff options
Diffstat (limited to 'source4/build/pidl/Parse/Pidl/Samba/COM/Proxy.pm')
-rw-r--r-- | source4/build/pidl/Parse/Pidl/Samba/COM/Proxy.pm | 212 |
1 files changed, 0 insertions, 212 deletions
diff --git a/source4/build/pidl/Parse/Pidl/Samba/COM/Proxy.pm b/source4/build/pidl/Parse/Pidl/Samba/COM/Proxy.pm deleted file mode 100644 index c94ef59ae9..0000000000 --- a/source4/build/pidl/Parse/Pidl/Samba/COM/Proxy.pm +++ /dev/null @@ -1,212 +0,0 @@ -################################################### -# 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 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; |