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(TALLOC_CTX *ctx)
  48 {
  49         struct $interface->{NAME}_vtable *proxy_vtable = talloc(ctx, 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(ctx, (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         NDR_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         my $has_obj = 0;
 205
 206         $res .= "#include \"includes.h\"\n" .
 207                         "#include \"lib/com/dcom/dcom.h\"\n" .
 208                         "#include \"$comh_filename\"\n" .
 209                         "#include \"librpc/rpc/dcerpc.h\"\n";
 210
 211         foreach (@{$pidl}) {
 212                 next if ($_->{TYPE} ne "INTERFACE");
 213                 next if has_property($_, "local");
 214                 next unless has_property($_, "object");
 215
 216                 $res .= ParseInterface($_);
 217
 218                 $has_obj = 1;
 219         }
 220
 221         return $res if ($has_obj);
 222         return undef;
 223 }
 224
 225 1;