Annotation of embedaddon/axTLS/bindings/generate_SWIG_interface.pl, revision 1.1
1.1 ! misho 1: #!/usr/bin/perl
! 2:
! 3: #
! 4: # Copyright (c) 2007, Cameron Rich
! 5: #
! 6: # All rights reserved.
! 7: #
! 8: # Redistribution and use in source and binary forms, with or without
! 9: # modification, are permitted provided that the following conditions are met:
! 10: #
! 11: # * Redistributions of source code must retain the above copyright notice,
! 12: # this list of conditions and the following disclaimer.
! 13: # * Redistributions in binary form must reproduce the above copyright
! 14: # notice, this list of conditions and the following disclaimer in the
! 15: # documentation and/or other materials provided with the distribution.
! 16: # * Neither the name of the axTLS project nor the names of its
! 17: # contributors may be used to endorse or promote products derived
! 18: # from this software without specific prior written permission.
! 19: #
! 20: # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! 21: # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
! 22: # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
! 23: # A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
! 24: # CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
! 25: # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
! 26: # TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
! 27: # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY
! 28: # OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
! 29: # NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
! 30: # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
! 31: #
! 32:
! 33: #===============================================================
! 34: # Transforms function signature into SWIG format
! 35: sub transformSignature
! 36: {
! 37: foreach $item (@_)
! 38: {
! 39: $line =~ s/STDCALL //g;
! 40: $line =~ s/EXP_FUNC/extern/g;
! 41:
! 42: # make API Java more 'byte' friendly
! 43: $line =~ s/uint32_t/int/g;
! 44: $line =~ s/const uint8_t \* /const unsigned char \* /g;
! 45: $line =~ s/\(void\)/()/g;
! 46: if ($ARGV[0] eq "-java")
! 47: {
! 48: $line =~ s/.*ssl_read.*//g;
! 49: $line =~ s/const uint8_t \*(\w+)/const signed char $1\[\]/g;
! 50: $line =~ s/uint8_t/signed char/g;
! 51: }
! 52: elsif ($ARGV[0] eq "-perl")
! 53: {
! 54: $line =~ s/const uint8_t \*(\w+)/const unsigned char $1\[\]/g;
! 55: $line =~ s/uint8_t/unsigned char/g;
! 56: }
! 57: else # lua
! 58: {
! 59: $line =~ s/const uint8_t \*session_id/const unsigned char session_id\[\]/g;
! 60: $line =~ s/const uint8_t \*\w+/unsigned char *INPUT/g;
! 61: $line =~ s/uint8_t/unsigned char/g;
! 62: }
! 63: }
! 64:
! 65: return $line;
! 66: }
! 67:
! 68: # Parse input file
! 69: sub parseFile
! 70: {
! 71: foreach $line (@_)
! 72: {
! 73: next if $line =~ /ssl_x509_create/; # ignore for now
! 74:
! 75: # test for a #define
! 76: if (!$skip && $line =~ m/^#define/)
! 77: {
! 78: $splitDefine = 1 if $line =~ m/\\$/;
! 79: print DATA_OUT $line;
! 80:
! 81: # check line is not split
! 82: next if $splitDefine == 1;
! 83: }
! 84:
! 85: # pick up second line of #define statement
! 86: if ($splitDefine)
! 87: {
! 88: print DATA_OUT $line;
! 89:
! 90: # check line is not split
! 91: $splitDefine = ($line =~ m/\\$/);
! 92: next;
! 93: }
! 94:
! 95: # test for function declaration
! 96: if (!$skip && $line =~ /EXP_FUNC/ && $line !~/\/\*/)
! 97: {
! 98: $line = transformSignature($line);
! 99: $splitFunctionDeclaration = $line !~ /;/;
! 100: print DATA_OUT $line;
! 101: next;
! 102: }
! 103:
! 104: if ($splitFunctionDeclaration)
! 105: {
! 106: $line = transformSignature($line);
! 107: $splitFunctionDeclaration = $line !~ /;/;
! 108: print DATA_OUT $line;
! 109: next;
! 110: }
! 111: }
! 112: }
! 113:
! 114: #===============================================================
! 115:
! 116: # Determine which module to build from cammand-line options
! 117: use strict;
! 118: use Getopt::Std;
! 119:
! 120: my $module;
! 121: my $interfaceFile;
! 122: my $data_file;
! 123: my $skip;
! 124: my $splitLine;
! 125: my @raw_data;
! 126:
! 127: if (not defined $ARGV[0])
! 128: {
! 129: goto ouch;
! 130: }
! 131:
! 132: if ($ARGV[0] eq "-java")
! 133: {
! 134: print "Generating Java interface file\n";
! 135: $module = "axtlsj";
! 136: $interfaceFile = "java/axTLSj.i";
! 137: }
! 138: elsif ($ARGV[0] eq "-perl")
! 139: {
! 140: print "Generating Perl interface file\n";
! 141: $module = "axtlsp";
! 142: $interfaceFile = "perl/axTLSp.i";
! 143: }
! 144: elsif ($ARGV[0] eq "-lua")
! 145: {
! 146: print "Generating lua interface file\n";
! 147: $module = "axtlsl";
! 148: $interfaceFile = "lua/axTLSl.i";
! 149: }
! 150: else
! 151: {
! 152: ouch:
! 153: die "Usage: $0 [-java | -perl | -lua]\n";
! 154: }
! 155:
! 156: # Input file required to generate SWIG interface file.
! 157: $data_file = "../ssl/ssl.h";
! 158:
! 159: # Open input files
! 160: open(DATA_IN, $data_file) || die("Could not open file ($data_file)!");
! 161: @raw_data = <DATA_IN>;
! 162:
! 163: # Open output file
! 164: open(DATA_OUT, ">$interfaceFile") || die("Cannot Open File");
! 165:
! 166: #
! 167: # I wish I could say it was easy to generate the Perl/Java/Lua bindings,
! 168: # but each had their own set of challenges... :-(.
! 169: #
! 170: print DATA_OUT << "END";
! 171: %module $module\n
! 172:
! 173: /* include our own header */
! 174: %inline %{
! 175: #include "ssl.h"
! 176: %}
! 177:
! 178: %include "typemaps.i"
! 179: /* Some SWIG magic to make the API a bit more Java friendly */
! 180: #ifdef SWIGJAVA
! 181:
! 182: %apply long { SSL * };
! 183: %apply long { SSL_CTX * };
! 184: %apply long { SSLObjLoader * };
! 185:
! 186: /* allow "unsigned char []" to become "byte[]" */
! 187: %include "arrays_java.i"
! 188:
! 189: /* convert these pointers to use long */
! 190: %apply signed char[] {unsigned char *};
! 191: %apply signed char[] {signed char *};
! 192:
! 193: /* allow ssl_get_session_id() to return "byte[]" */
! 194: %typemap(out) unsigned char * ssl_get_session_id \"if (result) jresult = SWIG_JavaArrayOutSchar(jenv, result, ssl_get_session_id_size((SSL const *)arg1));\"
! 195:
! 196: /* allow ssl_client_new() to have a null session_id input */
! 197: %typemap(in) const signed char session_id[] (jbyte *jarr) {
! 198: if (jarg3 == NULL)
! 199: {
! 200: jresult = (jint)ssl_client_new(arg1,arg2,NULL,0);
! 201: return jresult;
! 202: }
! 203:
! 204: if (!SWIG_JavaArrayInSchar(jenv, &jarr, &arg3, jarg3)) return 0;
! 205: }
! 206:
! 207: /* Lot's of work required for an ssl_read() due to its various custom
! 208: * requirements.
! 209: */
! 210: %native (ssl_read) int ssl_read(SSL *ssl, jobject in_data);
! 211: %{
! 212: JNIEXPORT jint JNICALL Java_axTLSj_axtlsjJNI_ssl_1read(JNIEnv *jenv, jclass jcls, jint jarg1, jobject jarg2) {
! 213: jint jresult = 0 ;
! 214: SSL *arg1;
! 215: unsigned char *arg2;
! 216: jbyte *jarr;
! 217: int result;
! 218: JNIEnv e = *jenv;
! 219: jclass holder_class;
! 220: jfieldID fid;
! 221:
! 222: arg1 = (SSL *)jarg1;
! 223: result = (int)ssl_read(arg1, &arg2);
! 224:
! 225: /* find the "m_buf" entry in the SSLReadHolder class */
! 226: if (!(holder_class = e->GetObjectClass(jenv,jarg2)) ||
! 227: !(fid = e->GetFieldID(jenv,holder_class, "m_buf", "[B")))
! 228: return SSL_NOT_OK;
! 229:
! 230: if (result > SSL_OK)
! 231: {
! 232: int i;
! 233:
! 234: /* create a new byte array to hold the read data */
! 235: jbyteArray jarray = e->NewByteArray(jenv, result);
! 236:
! 237: /* copy the bytes across to the java byte array */
! 238: jarr = e->GetByteArrayElements(jenv, jarray, 0);
! 239: for (i = 0; i < result; i++)
! 240: jarr[i] = (jbyte)arg2[i];
! 241:
! 242: /* clean up and set the new m_buf object */
! 243: e->ReleaseByteArrayElements(jenv, jarray, jarr, 0);
! 244: e->SetObjectField(jenv, jarg2, fid, jarray);
! 245: }
! 246: else /* set to null */
! 247: e->SetObjectField(jenv, jarg2, fid, NULL);
! 248:
! 249: jresult = (jint)result;
! 250: return jresult;
! 251: }
! 252: %}
! 253:
! 254: /* Big hack to get hold of a socket's file descriptor */
! 255: %typemap (jtype) long "Object"
! 256: %typemap (jstype) long "Object"
! 257: %native (getFd) int getFd(long sock);
! 258: %{
! 259: JNIEXPORT jint JNICALL Java_axTLSj_axtlsjJNI_getFd(JNIEnv *env, jclass jcls, jobject sock)
! 260: {
! 261: JNIEnv e = *env;
! 262: jfieldID fid;
! 263: jobject impl;
! 264: jobject fdesc;
! 265:
! 266: /* get the SocketImpl from the Socket */
! 267: if (!(jcls = e->GetObjectClass(env,sock)) ||
! 268: !(fid = e->GetFieldID(env,jcls,"impl","Ljava/net/SocketImpl;")) ||
! 269: !(impl = e->GetObjectField(env,sock,fid))) return -1;
! 270:
! 271: /* get the FileDescriptor from the SocketImpl */
! 272: if (!(jcls = e->GetObjectClass(env,impl)) ||
! 273: !(fid = e->GetFieldID(env,jcls,"fd","Ljava/io/FileDescriptor;")) ||
! 274: !(fdesc = e->GetObjectField(env,impl,fid))) return -1;
! 275:
! 276: /* get the fd from the FileDescriptor */
! 277: if (!(jcls = e->GetObjectClass(env,fdesc)) ||
! 278: !(fid = e->GetFieldID(env,jcls,"fd","I"))) return -1;
! 279:
! 280: /* return the descriptor */
! 281: return e->GetIntField(env,fdesc,fid);
! 282: }
! 283: %}
! 284:
! 285: #endif
! 286:
! 287: /* Some SWIG magic to make the API a bit more Perl friendly */
! 288: #ifdef SWIGPERL
! 289:
! 290: /* for ssl_session_id() */
! 291: %typemap(out) const unsigned char * {
! 292: SV *svs = newSVpv((unsigned char *)\$1, ssl_get_session_id_size((SSL const *)arg1));
! 293: \$result = newRV(svs);
! 294: sv_2mortal(\$result);
! 295: argvi++;
! 296: }
! 297:
! 298: /* for ssl_write() */
! 299: %typemap(in) const unsigned char out_data[] {
! 300: SV* tempsv;
! 301: if (!SvROK(\$input))
! 302: croak("Argument \$argnum is not a reference.");
! 303: tempsv = SvRV(\$input);
! 304: if (SvTYPE(tempsv) != SVt_PV)
! 305: croak("Argument \$argnum is not an string.");
! 306: \$1 = (unsigned char *)SvPV(tempsv, PL_na);
! 307: }
! 308:
! 309: /* for ssl_read() */
! 310: %typemap(in) unsigned char **in_data (unsigned char *buf) {
! 311: \$1 = &buf;
! 312: }
! 313:
! 314: %typemap(argout) unsigned char **in_data {
! 315: if (result > SSL_OK) {
! 316: SV *svs = newSVpv(*\$1, result);
! 317: \$result = newRV(svs);
! 318: sv_2mortal(\$result);
! 319: argvi++;
! 320: }
! 321: }
! 322:
! 323: /* for ssl_client_new() */
! 324: %typemap(in) const unsigned char session_id[] {
! 325: /* check for a reference */
! 326: if (SvOK(\$input) && SvROK(\$input)) {
! 327: SV* tempsv = SvRV(\$input);
! 328: if (SvTYPE(tempsv) != SVt_PV)
! 329: croak("Argument \$argnum is not an string.");
! 330: \$1 = (unsigned char *)SvPV(tempsv, PL_na);
! 331: }
! 332: else
! 333: \$1 = NULL;
! 334: }
! 335:
! 336: #endif
! 337:
! 338: /* Some SWIG magic to make the API a bit more Lua friendly */
! 339: #ifdef SWIGLUA
! 340: SWIG_NUMBER_TYPEMAP(unsigned char);
! 341: SWIG_TYPEMAP_NUM_ARR(uchar,unsigned char);
! 342:
! 343: /* for ssl_session_id() */
! 344: %typemap(out) const unsigned char * {
! 345: int i;
! 346: lua_newtable(L);
! 347: for (i = 0; i < ssl_get_session_id_size((SSL const *)arg1); i++){
! 348: lua_pushnumber(L,(lua_Number)result[i]);
! 349: lua_rawseti(L,-2,i+1); /* -1 is the number, -2 is the table */
! 350: }
! 351: SWIG_arg++;
! 352: }
! 353:
! 354: /* for ssl_read() */
! 355: %typemap(in) unsigned char **in_data (unsigned char *buf) {
! 356: \$1 = &buf;
! 357: }
! 358:
! 359: %typemap(argout) unsigned char **in_data {
! 360: if (result > SSL_OK) {
! 361: int i;
! 362: lua_newtable(L);
! 363: for (i = 0; i < result; i++){
! 364: lua_pushnumber(L,(lua_Number)buf2[i]);
! 365: lua_rawseti(L,-2,i+1); /* -1 is the number, -2 is the table */
! 366: }
! 367: SWIG_arg++;
! 368: }
! 369: }
! 370:
! 371: /* for ssl_client_new() */
! 372: %typemap(in) const unsigned char session_id[] {
! 373: if (lua_isnil(L,\$input))
! 374: \$1 = NULL;
! 375: else
! 376: \$1 = SWIG_get_uchar_num_array_fixed(L,\$input, ssl_get_session_id((SSL const *)\$1));
! 377: }
! 378:
! 379: #endif
! 380:
! 381: END
! 382:
! 383: # Initialise loop variables
! 384: $skip = 1;
! 385: $splitLine = 0;
! 386:
! 387: parseFile(@raw_data);
! 388:
! 389: close(DATA_IN);
! 390: close(DATA_OUT);
! 391:
! 392: #===============================================================
! 393:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>