Remove more hand-written marshallers.
[kai/samba-autobuild/.git] / source4 / pidl / lib / Parse / Pidl / Samba4 / COM / Proxy.pm
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
6
7 package Parse::Pidl::Samba4::COM::Proxy;
8
9 use Parse::Pidl::Samba4::COM::Header;
10 use Parse::Pidl::Typelist qw(mapTypeName);
11 use Parse::Pidl::Util qw(has_property);
12
13 use vars qw($VERSION);
14 $VERSION = '0.01';
15
16 use strict;
17
18 my($res);
19
20 sub ParseVTable($$)
21 {
22         my ($interface, $name) = @_;
23
24         # Generate the vtable
25         $res .="\tstruct $interface->{NAME}_vtable $name = {";
26
27         if (defined($interface->{BASE})) {
28                 $res .= "\n\t\t{},";
29         }
30
31         my $data = $interface->{DATA};
32
33         foreach my $d (@{$data}) {
34                 if ($d->{TYPE} eq "FUNCTION") {
35                     $res .= "\n\t\tdcom_proxy_$interface->{NAME}_$d->{NAME}";
36                         $res .= ",";
37                 }
38         }
39
40         $res .= "\n\t};\n\n";
41 }
42
43 sub ParseRegFunc($)
44 {
45         my $interface = shift;
46
47         $res .= "static NTSTATUS dcom_proxy_$interface->{NAME}_init(void)
48 {
49         struct $interface->{NAME}_vtable *proxy_vtable = talloc(talloc_autofree_context(), struct $interface->{NAME}_vtable);
50 ";
51
52         if (defined($interface->{BASE})) {
53                 $res.= "
54         struct GUID base_iid;
55         const void *base_vtable;
56
57         base_iid = ndr_table_$interface->{BASE}.syntax_id.uuid;
58
59         base_vtable = dcom_proxy_vtable_by_iid(&base_iid);
60         if (base_vtable == NULL) {
61                 DEBUG(0, (\"No proxy registered for base interface '$interface->{BASE}'\\n\"));
62                 return NT_STATUS_FOOBAR;
63         }
64         
65         memcpy(&proxy_vtable, base_vtable, sizeof(struct $interface->{BASE}_vtable));
66
67 ";
68         }
69         foreach my $x (@{$interface->{DATA}}) {
70                 next unless ($x->{TYPE} eq "FUNCTION");
71
72                 $res .= "\tproxy_vtable->$x->{NAME} = dcom_proxy_$interface->{NAME}_$x->{NAME};\n";
73         }
74
75         $res.= "
76         proxy_vtable->iid = ndr_table_$interface->{NAME}.syntax_id.uuid;
77
78         return dcom_register_proxy((struct IUnknown_vtable *)proxy_vtable);
79 }\n\n";
80 }
81
82 #####################################################################
83 # parse a function
84 sub ParseFunction($$)
85 {
86         my ($interface, $fn) = @_;
87         my $name = $fn->{NAME};
88         my $uname = uc $name;
89
90         my $tn = mapTypeName($fn->{RETURN_TYPE});
91
92         $res.="
93 static $tn dcom_proxy_$interface->{NAME}_$name(struct $interface->{NAME} *d, TALLOC_CTX *mem_ctx" . Parse::Pidl::Samba4::COM::Header::GetArgumentProtoList($fn) . ")
94 {
95         struct dcerpc_pipe *p;
96         NTSTATUS status = dcom_get_pipe(d, &p);
97         struct $name r;
98         struct rpc_request *req;
99
100         if (NT_STATUS_IS_ERR(status)) {
101                 return status;
102         }
103
104         ZERO_STRUCT(r.in.ORPCthis);
105         r.in.ORPCthis.version.MajorVersion = COM_MAJOR_VERSION;
106         r.in.ORPCthis.version.MinorVersion = COM_MINOR_VERSION;
107 ";
108         
109         # Put arguments into r
110         foreach my $a (@{$fn->{ELEMENTS}}) {
111                 next unless (has_property($a, "in"));
112                 if (Parse::Pidl::Typelist::typeIs($a->{TYPE}, "INTERFACE")) {
113                         $res .="\tNDR_CHECK(dcom_OBJREF_from_IUnknown(mem_ctx, &r.in.$a->{NAME}.obj, $a->{NAME}));\n";
114                 } else {
115                         $res .= "\tr.in.$a->{NAME} = $a->{NAME};\n";
116                 }
117         }
118
119         $res .="
120         if (p->conn->flags & DCERPC_DEBUG_PRINT_IN) {
121                 NDR_PRINT_IN_DEBUG($name, &r);          
122         }
123
124         status = dcerpc_ndr_request(p, &d->ipid, &ndr_table_$interface->{NAME}, NDR_$uname, mem_ctx, &r);
125
126         if (NT_STATUS_IS_OK(status) && (p->conn->flags & DCERPC_DEBUG_PRINT_OUT)) {
127                 NDR_PRINT_OUT_DEBUG($name, r);          
128         }
129
130 ";
131
132         # Put r info back into arguments
133         foreach my $a (@{$fn->{ELEMENTS}}) {
134                 next unless (has_property($a, "out"));
135
136                 if (Parse::Pidl::Typelist::typeIs($a->{TYPE}, "INTERFACE")) {
137                         $res .="\tNDR_CHECK(dcom_IUnknown_from_OBJREF(d->ctx, &$a->{NAME}, r.out.$a->{NAME}.obj));\n";
138                 } else {
139                         $res .= "\t*$a->{NAME} = r.out.$a->{NAME};\n";
140                 }
141
142         }
143         
144         if ($fn->{RETURN_TYPE} eq "NTSTATUS") {
145                 $res .= "\tif (NT_STATUS_IS_OK(status)) status = r.out.result;\n";
146         }
147
148         $res .= 
149         "
150         return r.out.result;
151 }\n\n";
152 }
153
154 #####################################################################
155 # parse the interface definitions
156 sub ParseInterface($)
157 {
158         my($interface) = shift;
159         my($data) = $interface->{DATA};
160         $res = "/* DCOM proxy for $interface->{NAME} generated by pidl */\n\n";
161         foreach my $d (@{$data}) {
162                 ($d->{TYPE} eq "FUNCTION") && 
163                 ParseFunction($interface, $d);
164         }
165
166         ParseRegFunc($interface);
167 }
168
169 sub RegistrationFunction($$)
170 {
171         my $idl = shift;
172         my $basename = shift;
173
174         my $res = "\n\nNTSTATUS dcom_$basename\_init(void)\n";
175         $res .= "{\n";
176         $res .="\tNTSTATUS status = NT_STATUS_OK;\n";
177         foreach my $interface (@{$idl}) {
178                 next if $interface->{TYPE} ne "INTERFACE";
179                 next if not has_property($interface, "object");
180
181                 my $data = $interface->{DATA};
182                 my $count = 0;
183                 foreach my $d (@{$data}) {
184                         if ($d->{TYPE} eq "FUNCTION") { $count++; }
185                 }
186
187                 next if ($count == 0);
188
189                 $res .= "\tstatus = dcom_$interface->{NAME}_init();\n";
190                 $res .= "\tif (NT_STATUS_IS_ERR(status)) {\n";
191                 $res .= "\t\treturn status;\n";
192                 $res .= "\t}\n\n";
193         }
194         $res .= "\treturn status;\n";
195         $res .= "}\n\n";
196
197         return $res;
198 }
199
200 sub Parse($$)
201 {
202         my ($pidl,$comh_filename) = @_;
203         my $res = "";
204
205         $res .= "#include \"includes.h\"\n" .
206                         "#include \"lib/com/dcom/dcom.h\"\n" .
207                         "#include \"$comh_filename\"\n" .
208                         "#include \"librpc/rpc/dcerpc.h\"\n";
209
210         foreach (@{$pidl}) {
211                 next if ($_->{TYPE} ne "INTERFACE");
212                 next if has_property($_, "local");
213                 next unless has_property($_, "object");
214
215                 $res .= ParseInterface($_);
216         }
217
218         return $res;
219 }
220
221 1;