1 ###################################################
2 # DCOM parser for Samba
3 # Basically the glue between COM and DCE/RPC with NDR
4 # Copyright jelmer@samba.org 2003-2005
5 # released under the GNU GPL
17 my $interface = shift;
21 $res .="\tstruct $interface->{NAME}_vtable $name = {";
23 if (defined($interface->{BASE})) {
27 my $data = $interface->{DATA};
29 foreach my $d (@{$data}) {
30 if ($d->{TYPE} eq "FUNCTION") {
31 $res .= "\n\t\tdcom_proxy_$interface->{NAME}_$d->{NAME}";
41 my $interface = shift;
43 $res .= "static NTSTATUS dcom_proxy_$interface->{NAME}_init(void)
46 struct $interface->{NAME}_vtable *proxy_vtable = talloc(talloc_autofree_context(), struct $interface->{NAME}_vtable);
49 if (defined($interface->{BASE})) {
51 const void *base_vtable;
53 GUID_from_string(DCERPC_" . (uc $interface->{BASE}) . "_UUID, &base_iid);
55 base_vtable = dcom_proxy_vtable_by_iid(&base_iid);
56 if (base_vtable == NULL) {
57 DEBUG(0, (\"No proxy registered for base interface '$interface->{BASE}'\\n\"));
58 return NT_STATUS_FOOBAR;
61 memcpy(&proxy_vtable, base_vtable, sizeof(struct $interface->{BASE}_vtable));
65 foreach my $x (@{$interface->{DATA}}) {
66 next unless ($x->{TYPE} eq "FUNCTION");
68 $res .= "\tproxy_vtable.$x->{NAME} = dcom_proxy_$interface->{NAME}_$x->{NAME};\n";
72 GUID_from_string(DCERPC_" . (uc $interface->{NAME}) . "_UUID, &proxy_vtable.iid);
74 return dcom_register_proxy(&proxy_vtable);
78 #####################################################################
82 my $interface = shift;
84 my $name = $fn->{NAME};
88 static $fn->{RETURN_TYPE} dcom_proxy_$interface->{NAME}_$name(struct $interface->{NAME} *d, TALLOC_CTX *mem_ctx" . COMHeader::GetArgumentProtoList($fn) . ")
90 struct dcerpc_pipe *p;
91 NTSTATUS status = dcom_get_pipe(d, &p);
93 struct rpc_request *req;
95 if (NT_STATUS_IS_ERR(status)) {
99 ZERO_STRUCT(r.in.ORPCthis);
100 r.in.ORPCthis.version.MajorVersion = COM_MAJOR_VERSION;
101 r.in.ORPCthis.version.MinorVersion = COM_MINOR_VERSION;
104 # Put arguments into r
105 foreach my $a (@{$fn->{ELEMENTS}}) {
106 next unless (util::has_property($a, "in"));
107 if (typelist::typeIs($a->{TYPE}, "INTERFACE")) {
108 $res .="\tNDR_CHECK(dcom_OBJREF_from_IUnknown(&r.in.$a->{NAME}.obj, $a->{NAME}));\n";
110 $res .= "\tr.in.$a->{NAME} = $a->{NAME};\n";
115 if (p->conn->flags & DCERPC_DEBUG_PRINT_IN) {
116 NDR_PRINT_IN_DEBUG($name, &r);
119 status = dcerpc_ndr_request(p, &d->ipid, &dcerpc_table_$interface->{NAME}, DCERPC_$uname, mem_ctx, &r);
121 if (NT_STATUS_IS_OK(status) && (p->conn->flags & DCERPC_DEBUG_PRINT_OUT)) {
122 NDR_PRINT_OUT_DEBUG($name, r);
127 # Put r info back into arguments
128 foreach my $a (@{$fn->{ELEMENTS}}) {
129 next unless (util::has_property($a, "out"));
131 if (typelist::typeIs($a->{TYPE}, "INTERFACE")) {
132 $res .="\tNDR_CHECK(dcom_IUnknown_from_OBJREF(d->ctx, &$a->{NAME}, r.out.$a->{NAME}.obj));\n";
134 $res .= "\t*$a->{NAME} = r.out.$a->{NAME};\n";
139 if ($fn->{RETURN_TYPE} eq "NTSTATUS") {
140 $res .= "\tif (NT_STATUS_IS_OK(status)) status = r.out.result;\n";
149 #####################################################################
150 # parse the interface definitions
151 sub ParseInterface($)
153 my($interface) = shift;
154 my($data) = $interface->{DATA};
155 $res = "/* DCOM proxy for $interface->{NAME} generated by pidl */\n\n";
156 foreach my $d (@{$data}) {
157 ($d->{TYPE} eq "FUNCTION") &&
158 ParseFunction($interface, $d);
161 ParseRegFunc($interface);
164 sub RegistrationFunction($$)
167 my $basename = shift;
169 my $res = "\n\nNTSTATUS dcom_$basename\_init(void)\n";
171 $res .="\tNTSTATUS status = NT_STATUS_OK;\n";
172 foreach my $interface (@{$idl}) {
173 next if $interface->{TYPE} ne "INTERFACE";
174 next if not util::has_property($interface, "object");
176 my $data = $interface->{INHERITED_DATA};
178 foreach my $d (@{$data}) {
179 if ($d->{TYPE} eq "FUNCTION") { $count++; }
182 next if ($count == 0);
184 $res .= "\tstatus = dcom_$interface->{NAME}_init();\n";
185 $res .= "\tif (NT_STATUS_IS_ERR(status)) {\n";
186 $res .= "\t\treturn status;\n";
189 $res .= "\treturn status;\n";
200 foreach my $x (@{$pidl}) {
201 next if ($x->{TYPE} ne "INTERFACE");
202 next if util::has_property($x, "local");
203 next unless util::has_property($x, "object");
205 $res .= ParseInterface($x);