1
0

generate_SWIG_interface.pl 11 KB

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