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