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>