#!/usr/bin/perl # # Copyright (c) 2007, Cameron Rich # # All rights reserved. # # Redistribution and use in source and binary forms, with or without # modification, are permitted provided that the following conditions are met: # # * Redistributions of source code must retain the above copyright notice, # this list of conditions and the following disclaimer. # * Redistributions in binary form must reproduce the above copyright # notice, this list of conditions and the following disclaimer in the # documentation and/or other materials provided with the distribution. # * Neither the name of the axTLS project nor the names of its # contributors may be used to endorse or promote products derived # from this software without specific prior written permission. # # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR # A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR # CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED # TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY # OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING # NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. # #=============================================================== # Transforms function signature into SWIG format sub transformSignature { foreach $item (@_) { $line =~ s/STDCALL //g; $line =~ s/EXP_FUNC/extern/g; # make API Java more 'byte' friendly $line =~ s/uint32_t/int/g; $line =~ s/const uint8_t \* /const unsigned char \* /g; $line =~ s/\(void\)/()/g; if ($ARGV[0] eq "-java") { $line =~ s/.*ssl_read.*//g; $line =~ s/const uint8_t \*(\w+)/const signed char $1\[\]/g; $line =~ s/uint8_t/signed char/g; } elsif ($ARGV[0] eq "-perl") { $line =~ s/const uint8_t \*(\w+)/const unsigned char $1\[\]/g; $line =~ s/uint8_t/unsigned char/g; } else # lua { $line =~ s/const uint8_t \*session_id/const unsigned char session_id\[\]/g; $line =~ s/const uint8_t \*\w+/unsigned char *INPUT/g; $line =~ s/uint8_t/unsigned char/g; } } return $line; } # Parse input file sub parseFile { foreach $line (@_) { next if $line =~ /ssl_x509_create/; # ignore for now # test for a #define if (!$skip && $line =~ m/^#define/) { $splitDefine = 1 if $line =~ m/\\$/; print DATA_OUT $line; # check line is not split next if $splitDefine == 1; } # pick up second line of #define statement if ($splitDefine) { print DATA_OUT $line; # check line is not split $splitDefine = ($line =~ m/\\$/); next; } # test for function declaration if (!$skip && $line =~ /EXP_FUNC/ && $line !~/\/\*/) { $line = transformSignature($line); $splitFunctionDeclaration = $line !~ /;/; print DATA_OUT $line; next; } if ($splitFunctionDeclaration) { $line = transformSignature($line); $splitFunctionDeclaration = $line !~ /;/; print DATA_OUT $line; next; } } } #=============================================================== # Determine which module to build from cammand-line options use strict; use Getopt::Std; my $module; my $interfaceFile; my $data_file; my $skip; my $splitLine; my @raw_data; if (not defined $ARGV[0]) { goto ouch; } if ($ARGV[0] eq "-java") { print "Generating Java interface file\n"; $module = "axtlsj"; $interfaceFile = "java/axTLSj.i"; } elsif ($ARGV[0] eq "-perl") { print "Generating Perl interface file\n"; $module = "axtlsp"; $interfaceFile = "perl/axTLSp.i"; } elsif ($ARGV[0] eq "-lua") { print "Generating lua interface file\n"; $module = "axtlsl"; $interfaceFile = "lua/axTLSl.i"; } else { ouch: die "Usage: $0 [-java | -perl | -lua]\n"; } # Input file required to generate SWIG interface file. $data_file = "../ssl/ssl.h"; # Open input files open(DATA_IN, $data_file) || die("Could not open file ($data_file)!"); @raw_data = ; # Open output file open(DATA_OUT, ">$interfaceFile") || die("Cannot Open File"); # # I wish I could say it was easy to generate the Perl/Java/Lua bindings, # but each had their own set of challenges... :-(. # print DATA_OUT << "END"; %module $module\n /* include our own header */ %inline %{ #include "ssl.h" %} %include "typemaps.i" /* Some SWIG magic to make the API a bit more Java friendly */ #ifdef SWIGJAVA %apply long { SSL * }; %apply long { SSL_CTX * }; %apply long { SSLObjLoader * }; /* allow "unsigned char []" to become "byte[]" */ %include "arrays_java.i" /* convert these pointers to use long */ %apply signed char[] {unsigned char *}; %apply signed char[] {signed char *}; /* allow ssl_get_session_id() to return "byte[]" */ %typemap(out) unsigned char * ssl_get_session_id \"if (result) jresult = SWIG_JavaArrayOutSchar(jenv, result, ssl_get_session_id_size((SSL const *)arg1));\" /* allow ssl_client_new() to have a null session_id input */ %typemap(in) const signed char session_id[] (jbyte *jarr) { if (jarg3 == NULL) { jresult = (jint)ssl_client_new(arg1,arg2,NULL,0); return jresult; } if (!SWIG_JavaArrayInSchar(jenv, &jarr, &arg3, jarg3)) return 0; } /* Lot's of work required for an ssl_read() due to its various custom * requirements. */ %native (ssl_read) int ssl_read(SSL *ssl, jobject in_data); %{ JNIEXPORT jint JNICALL Java_axTLSj_axtlsjJNI_ssl_1read(JNIEnv *jenv, jclass jcls, jint jarg1, jobject jarg2) { jint jresult = 0 ; SSL *arg1; unsigned char *arg2; jbyte *jarr; int result; JNIEnv e = *jenv; jclass holder_class; jfieldID fid; arg1 = (SSL *)jarg1; result = (int)ssl_read(arg1, &arg2); /* find the "m_buf" entry in the SSLReadHolder class */ if (!(holder_class = e->GetObjectClass(jenv,jarg2)) || !(fid = e->GetFieldID(jenv,holder_class, "m_buf", "[B"))) return SSL_NOT_OK; if (result > SSL_OK) { int i; /* create a new byte array to hold the read data */ jbyteArray jarray = e->NewByteArray(jenv, result); /* copy the bytes across to the java byte array */ jarr = e->GetByteArrayElements(jenv, jarray, 0); for (i = 0; i < result; i++) jarr[i] = (jbyte)arg2[i]; /* clean up and set the new m_buf object */ e->ReleaseByteArrayElements(jenv, jarray, jarr, 0); e->SetObjectField(jenv, jarg2, fid, jarray); } else /* set to null */ e->SetObjectField(jenv, jarg2, fid, NULL); jresult = (jint)result; return jresult; } %} /* Big hack to get hold of a socket's file descriptor */ %typemap (jtype) long "Object" %typemap (jstype) long "Object" %native (getFd) int getFd(long sock); %{ JNIEXPORT jint JNICALL Java_axTLSj_axtlsjJNI_getFd(JNIEnv *env, jclass jcls, jobject sock) { JNIEnv e = *env; jfieldID fid; jobject impl; jobject fdesc; /* get the SocketImpl from the Socket */ if (!(jcls = e->GetObjectClass(env,sock)) || !(fid = e->GetFieldID(env,jcls,"impl","Ljava/net/SocketImpl;")) || !(impl = e->GetObjectField(env,sock,fid))) return -1; /* get the FileDescriptor from the SocketImpl */ if (!(jcls = e->GetObjectClass(env,impl)) || !(fid = e->GetFieldID(env,jcls,"fd","Ljava/io/FileDescriptor;")) || !(fdesc = e->GetObjectField(env,impl,fid))) return -1; /* get the fd from the FileDescriptor */ if (!(jcls = e->GetObjectClass(env,fdesc)) || !(fid = e->GetFieldID(env,jcls,"fd","I"))) return -1; /* return the descriptor */ return e->GetIntField(env,fdesc,fid); } %} #endif /* Some SWIG magic to make the API a bit more Perl friendly */ #ifdef SWIGPERL /* for ssl_session_id() */ %typemap(out) const unsigned char * { SV *svs = newSVpv((unsigned char *)\$1, ssl_get_session_id_size((SSL const *)arg1)); \$result = newRV(svs); sv_2mortal(\$result); argvi++; } /* for ssl_write() */ %typemap(in) const unsigned char out_data[] { SV* tempsv; if (!SvROK(\$input)) croak("Argument \$argnum is not a reference."); tempsv = SvRV(\$input); if (SvTYPE(tempsv) != SVt_PV) croak("Argument \$argnum is not an string."); \$1 = (unsigned char *)SvPV(tempsv, PL_na); } /* for ssl_read() */ %typemap(in) unsigned char **in_data (unsigned char *buf) { \$1 = &buf; } %typemap(argout) unsigned char **in_data { if (result > SSL_OK) { SV *svs = newSVpv(*\$1, result); \$result = newRV(svs); sv_2mortal(\$result); argvi++; } } /* for ssl_client_new() */ %typemap(in) const unsigned char session_id[] { /* check for a reference */ if (SvOK(\$input) && SvROK(\$input)) { SV* tempsv = SvRV(\$input); if (SvTYPE(tempsv) != SVt_PV) croak("Argument \$argnum is not an string."); \$1 = (unsigned char *)SvPV(tempsv, PL_na); } else \$1 = NULL; } #endif /* Some SWIG magic to make the API a bit more Lua friendly */ #ifdef SWIGLUA SWIG_NUMBER_TYPEMAP(unsigned char); SWIG_TYPEMAP_NUM_ARR(uchar,unsigned char); /* for ssl_session_id() */ %typemap(out) const unsigned char * { int i; lua_newtable(L); for (i = 0; i < ssl_get_session_id_size((SSL const *)arg1); i++){ lua_pushnumber(L,(lua_Number)result[i]); lua_rawseti(L,-2,i+1); /* -1 is the number, -2 is the table */ } SWIG_arg++; } /* for ssl_read() */ %typemap(in) unsigned char **in_data (unsigned char *buf) { \$1 = &buf; } %typemap(argout) unsigned char **in_data { if (result > SSL_OK) { int i; lua_newtable(L); for (i = 0; i < result; i++){ lua_pushnumber(L,(lua_Number)buf2[i]); lua_rawseti(L,-2,i+1); /* -1 is the number, -2 is the table */ } SWIG_arg++; } } /* for ssl_client_new() */ %typemap(in) const unsigned char session_id[] { if (lua_isnil(L,\$input)) \$1 = NULL; else \$1 = SWIG_get_uchar_num_array_fixed(L,\$input, ssl_get_session_id((SSL const *)\$1)); } #endif END # Initialise loop variables $skip = 1; $splitLine = 0; parseFile(@raw_data); close(DATA_IN); close(DATA_OUT); #===============================================================