source4/pidl/lib/Parse/Pidl/Samba4/SWIG.pm

   1 ###################################################
   2 # Samba4 parser generator for swig wrappers
   3 # Copyright tpot@samba.org 2004,2005
   4 # Copyright jelmer@samba.org 2006
   5 # released under the GNU GPL
   6
   7 package Parse::Pidl::Samba4::SWIG;
   8
   9 use vars qw($VERSION);
  10 use Parse::Pidl::Samba4 qw(DeclLong);
  11 use Parse::Pidl::Typelist qw(mapTypeName);
  12 use Parse::Pidl::Util qw(has_property);
  13 $VERSION = '0.01';
  14
  15 use strict;
  16
  17 my $ret = "";
  18 my $tabs = "";
  19
  20 sub pidl($)
  21 {
  22         my $p = shift;
  23         $ret .= $tabs. $p . "\n";
  24 }
  25
  26 sub indent() { $tabs.="\t"; }
  27 sub deindent() { $tabs = substr($tabs,0,-1); }
  28
  29 sub IgnoreInterface($$)
  30 {
  31         my ($basename,$if) = @_;
  32
  33         foreach (@{$if->{TYPES}}) {
  34                 next unless (has_property($_, "public"));
  35                 pidl "\%types($_->{NAME});";
  36         }
  37 }
  38
  39 sub ParseInterface($$)
  40 {
  41         my ($basename,$if) = @_;
  42
  43         pidl "\%inline {";
  44         pidl "struct $if->{NAME} { struct dcerpc_pipe *pipe; };";
  45         pidl "}";
  46         pidl "";
  47         pidl "\%extend $if->{NAME} {";
  48         indent();
  49         pidl "$if->{NAME} (const char *binding, struct cli_credentials *cred = NULL, TALLOC_CTX *mem_ctx = NULL, struct event_context *event = NULL)";
  50         pidl "{";
  51         indent;
  52         pidl "struct $if->{NAME} *ret = talloc(mem_ctx, struct $if->{NAME});";
  53         pidl "NTSTATUS status;";
  54         pidl "";
  55         pidl "status = dcerpc_pipe_connect(mem_ctx, &ret->pipe, binding, &dcerpc_table_$if->{NAME}, cred, event);";
  56         pidl "if (NT_STATUS_IS_ERR(status)) {";
  57         pidl "\tntstatus_exception(status);";
  58         pidl "\treturn NULL;";
  59         pidl "}";
  60         pidl "";
  61         pidl "return ret;";
  62         deindent;
  63         pidl "}";
  64         pidl "";
  65         pidl "~$if->{NAME}() {";
  66         pidl "\ttalloc_free(self);";
  67         pidl "}";
  68         pidl "";
  69
  70         foreach my $fn (@{$if->{FUNCTIONS}}) {
  71                 pidl "/* $fn->{NAME} */";
  72                 my $args = "";
  73                 foreach (@{$fn->{ELEMENTS}}) {
  74                         $args .= DeclLong($_) . ", ";
  75                 }
  76                 my $name = $fn->{NAME};
  77                 $name =~ s/^$if->{NAME}_//g;
  78                 $name =~ s/^$basename\_//g;
  79                 $args .= "TALLOC_CTX *mem_ctx = NULL";
  80                 pidl mapTypeName($fn->{RETURN_TYPE}) . " $name($args)";
  81                 pidl "{";
  82                 indent;
  83                 pidl "struct $fn->{NAME} r;";
  84                 pidl "NTSTATUS status;";
  85                 pidl "";
  86                 pidl "/* Fill r structure */";
  87
  88                 foreach (@{$fn->{ELEMENTS}}) {
  89                         if (grep(/in/, @{$_->{DIRECTION}})) {
  90                                 pidl "r.in.$_->{NAME} = $_->{NAME};";
  91                         }
  92                 }
  93
  94                 pidl "";
  95                 pidl "status = dcerpc_$fn->{NAME}(self->pipe, mem_ctx, &r);";
  96                 pidl "if (NT_STATUS_IS_ERR(status)) {";
  97                 pidl "\tntstatus_exception(status);";
  98                 if (defined($fn->{RETURN_TYPE})) {
  99                         pidl "\treturn r.out.result;";
 100                 } else {
 101                         pidl "\treturn;";
 102                 }
 103                 pidl "}";
 104                 pidl "";
 105                 pidl "/* Set out arguments */";
 106                 foreach (@{$fn->{ELEMENTS}}) {
 107                         next unless (grep(/out/, @{$_->{DIRECTION}}));
 108
 109                         pidl ("/* FIXME: $_->{NAME} [out] argument is not a pointer */") if ($_->{LEVELS}[0]->{TYPE} ne "POINTER");
 110
 111                         pidl "*$_->{NAME} = *r.out.$_->{NAME};";
 112                 }
 113
 114                 if (defined($fn->{RETURN_TYPE})) {
 115                         pidl "return r.out.result;";
 116                 }
 117                 deindent;
 118                 pidl "}";
 119                 pidl "";
 120         }
 121
 122         deindent();
 123         pidl "};";
 124         pidl "";
 125
 126         foreach (@{$if->{TYPES}}) {
 127                 pidl "/* $_->{NAME} */";
 128         }
 129
 130         pidl "";
 131 }
 132
 133 sub Parse($$$$)
 134 {
 135     my($ndr,$basename,$header,$gen_header) = @_;
 136
 137         $ret = "";
 138
 139         pidl "/* This file is autogenerated by pidl. DO NOT EDIT */";
 140
 141         pidl "\%module $basename";
 142
 143         pidl "";
 144
 145         pidl "\%{";
 146         pidl "#include \"includes.h\"";
 147         pidl "#include \"auth/credentials/credentials.h\"";
 148         pidl "#include \"$header\"";
 149         pidl "#include \"$gen_header\"";
 150         pidl "%}";
 151         pidl "\%import \"samba.i\"";
 152         pidl "";
 153         pidl "\%inline {";
 154         pidl "void ntstatus_exception(NTSTATUS status)";
 155         pidl "{";
 156         pidl "\t/* FIXME */";
 157         pidl "}";
 158         pidl "}";
 159         pidl "";
 160         foreach (@$ndr) {
 161                 IgnoreInterface($basename, $_) if ($_->{TYPE} eq "INTERFACE");
 162         }
 163         pidl "";
 164
 165         pidl "";
 166
 167         foreach (@$ndr) {
 168                 ParseInterface($basename, $_) if ($_->{TYPE} eq "INTERFACE");
 169         }
 170         #FIXME: Foreach ref pointer, set NONNULL
 171         #FIXME: Foreach unique/full pointer, set MAYBENULL
 172         #FIXME: Foreach [out] parameter, set OUTPARAM
 173         return $ret;
 174 }
 175
 176 1;