Annotation of embedaddon/axTLS/bindings/generate_SWIG_interface.pl, revision 1.1.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>