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.="  "; }
  27 sub deindent() { $tabs = substr($tabs,0,-2); }
  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 GenerateResultTypemap($)
  40 {
  41         my $name = shift;
  42         pidl "%typemap(in,numinputs=0) $name*result ($name tmp) {";
  43         indent;
  44         pidl "\$1 = &tmp;";
  45         deindent;
  46         pidl "}";
  47         pidl "";
  48         pidl "%typemap(argout) $name*result {";
  49         indent;
  50         pidl "\$result = SWIG_NewPointerObj(*\$1, \$1_descriptor, 0);";
  51         deindent;
  52         pidl "}";
  53 }
  54
  55 sub ParseInterface($$)
  56 {
  57         my ($basename,$if) = @_;
  58
  59         pidl "\%inline {";
  60         pidl "typedef struct $if->{NAME} { struct dcerpc_pipe *pipe; } $if->{NAME};";
  61         pidl "}";
  62         pidl "";
  63         pidl "%talloctype($if->{NAME});";
  64         pidl "";
  65         pidl "\%extend $if->{NAME} {";
  66         indent();
  67         pidl "$if->{NAME} () {";
  68         indent;
  69         pidl "return talloc(NULL, struct $if->{NAME});";
  70         deindent;
  71         pidl "}";
  72         pidl "";
  73         pidl "NTSTATUS connect (const char *binding, struct cli_credentials *cred, struct event_context *event)";
  74         pidl "{";
  75         indent;
  76         pidl "return dcerpc_pipe_connect(\$self, &\$self->pipe, binding, &ndr_table_$if->{NAME}, cred, event);";
  77         deindent;
  78         pidl "}";
  79         pidl "";
  80
  81         foreach my $fn (@{$if->{FUNCTIONS}}) {
  82                 pidl "/* $fn->{NAME} */";
  83                 my $args = "";
  84                 foreach (@{$fn->{ELEMENTS}}) {
  85                         $args .= DeclLong($_) . ", ";
  86                 }
  87                 my $name = $fn->{NAME};
  88                 $name =~ s/^$if->{NAME}_//g;
  89                 $name =~ s/^$basename\_//g;
  90                 $args .= "TALLOC_CTX *mem_ctx, " . mapTypeName($fn->{RETURN_TYPE}) . " *result";
  91                 pidl "NTSTATUS $name($args)";
  92                 pidl "{";
  93                 indent;
  94                 pidl "struct $fn->{NAME} r;";
  95                 pidl "NTSTATUS status;";
  96                 pidl "";
  97                 pidl "/* Fill r structure */";
  98
  99                 foreach (@{$fn->{ELEMENTS}}) {
 100                         if (grep(/in/, @{$_->{DIRECTION}})) {
 101                                 pidl "r.in.$_->{NAME} = $_->{NAME};";
 102                         }
 103                 }
 104
 105                 pidl "";
 106                 pidl "status = dcerpc_$fn->{NAME}(\$self->pipe, mem_ctx, &r);";
 107                 pidl "if (NT_STATUS_IS_ERR(status)) {";
 108                 indent; pidl "return status;"; deindent;
 109                 pidl "}";
 110                 pidl "";
 111                 pidl "/* Set out arguments */";
 112                 foreach (@{$fn->{ELEMENTS}}) {
 113                         next unless (grep(/out/, @{$_->{DIRECTION}}));
 114
 115                         pidl ("/* FIXME: $_->{NAME} [out] argument is not a pointer */") if ($_->{LEVELS}[0]->{TYPE} ne "POINTER");
 116
 117                         pidl "*$_->{NAME} = *r.out.$_->{NAME};";
 118                 }
 119
 120                 if (defined($fn->{RETURN_TYPE})) {
 121                         pidl "*result = r.out.result;";
 122                 }
 123                 pidl "return NT_STATUS_OK;";
 124                 deindent;
 125                 pidl "}";
 126                 pidl "";
 127         }
 128
 129         deindent();
 130         pidl "};";
 131         pidl "";
 132
 133         foreach (@{$if->{TYPES}}) {
 134                 pidl "/* $_->{NAME} */";
 135         }
 136
 137         pidl "";
 138 }
 139
 140 sub Parse($$$$)
 141 {
 142     my($ndr,$basename,$header,$gen_header) = @_;
 143
 144         $ret = "";
 145
 146         pidl "/* This file is autogenerated by pidl. DO NOT EDIT */";
 147
 148         pidl "\%module $basename";
 149
 150         pidl "";
 151
 152         pidl "\%{";
 153         pidl "#include \"includes.h\"";
 154         pidl "#include \"$header\"";
 155         pidl "#include \"$gen_header\"";
 156         pidl "%}";
 157         pidl "\%import \"../rpc/dcerpc.i\"";
 158         pidl "\%import \"../../libcli/util/errors.i\"";
 159         pidl "\%import \"../../lib/talloc/talloc.i\"";
 160         pidl "";
 161         foreach (@$ndr) {
 162                 IgnoreInterface($basename, $_) if ($_->{TYPE} eq "INTERFACE");
 163         }
 164         pidl "";
 165
 166         pidl "";
 167
 168         foreach (@$ndr) {
 169                 ParseInterface($basename, $_) if ($_->{TYPE} eq "INTERFACE");
 170         }
 171         #FIXME: Foreach ref pointer, set NONNULL
 172         #FIXME: Foreach unique/full pointer, set MAYBENULL
 173         #FIXME: Foreach [out] parameter, set OUTPARAM
 174         return $ret;
 175 }
 176
 177 1;