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