]>
Commit | Line | Data |
---|---|---|
58964a49 RE |
1 | #include "p5SSLeay.h" |
2 | ||
3 | static int p5_ssl_ex_ssl_ptr=0; | |
4 | static int p5_ssl_ex_ssl_info_callback=0; | |
5 | static int p5_ssl_ex_ssl_ctx_ptr=0; | |
6 | static int p5_ssl_ctx_ex_ssl_info_callback=0; | |
7 | ||
8 | typedef struct ssl_ic_args_st { | |
9 | SV *cb; | |
10 | SV *arg; | |
11 | } SSL_IC_ARGS; | |
12 | ||
13 | static void p5_ssl_info_callback(ssl,mode,ret) | |
14 | SSL *ssl; | |
15 | int mode; | |
16 | int ret; | |
17 | { | |
18 | int i; | |
19 | SV *me,*cb; | |
20 | ||
21 | me=(SV *)SSL_get_ex_data(ssl,p5_ssl_ex_ssl_ptr); | |
22 | cb=(SV *)SSL_get_ex_data(ssl,p5_ssl_ex_ssl_info_callback); | |
23 | if (cb == NULL) | |
24 | cb=(SV *)SSL_CTX_get_ex_data( | |
25 | SSL_get_SSL_CTX(ssl),p5_ssl_ctx_ex_ssl_info_callback); | |
26 | if (cb != NULL) | |
27 | { | |
28 | dSP; | |
29 | ||
30 | PUSHMARK(sp); | |
31 | XPUSHs(me); | |
32 | XPUSHs(sv_2mortal(newSViv(mode))); | |
33 | XPUSHs(sv_2mortal(newSViv(ret))); | |
34 | PUTBACK; | |
35 | ||
36 | i=perl_call_sv(cb,G_DISCARD); | |
37 | } | |
38 | else | |
39 | { | |
40 | croak("Internal error in SSL p5_ssl_info_callback"); | |
41 | } | |
42 | } | |
43 | ||
44 | int boot_ssl() | |
45 | { | |
46 | p5_ssl_ex_ssl_ptr= | |
47 | SSL_get_ex_new_index(0,"SSLeay::SSL",ex_new,NULL,ex_cleanup); | |
48 | p5_ssl_ex_ssl_info_callback= | |
49 | SSL_get_ex_new_index(0,"ssl_info_callback",NULL,NULL, | |
50 | ex_cleanup); | |
51 | p5_ssl_ex_ssl_ctx_ptr= | |
52 | SSL_get_ex_new_index(0,"ssl_ctx_ptr",NULL,NULL, | |
53 | ex_cleanup); | |
54 | p5_ssl_ctx_ex_ssl_info_callback= | |
55 | SSL_CTX_get_ex_new_index(0,"ssl_ctx_info_callback",NULL,NULL, | |
56 | ex_cleanup); | |
57 | return(1); | |
58 | } | |
59 | ||
60 | MODULE = SSLeay::SSL PACKAGE = SSLeay::SSL::CTX PREFIX = p5_SSL_CTX_ | |
61 | ||
62 | VERSIONCHECK: DISABLE | |
63 | ||
64 | void | |
65 | p5_SSL_CTX_new(...) | |
66 | PREINIT: | |
67 | SSL_METHOD *meth; | |
68 | SSL_CTX *ctx; | |
69 | char *method; | |
70 | PPCODE: | |
71 | pr_name("p5_SSL_CTX_new"); | |
72 | if ((items == 1) && SvPOK(ST(0))) | |
73 | method=SvPV(ST(0),na); | |
74 | else if ((items == 2) && SvPOK(ST(1))) | |
75 | method=SvPV(ST(1),na); | |
76 | else | |
77 | croak("Usage: SSLeay::SSL_CTX::new(type)"); | |
78 | ||
79 | if (strcmp(method,"SSLv3") == 0) | |
80 | meth=SSLv3_method(); | |
81 | else if (strcmp(method,"SSLv3_client") == 0) | |
82 | meth=SSLv3_client_method(); | |
83 | else if (strcmp(method,"SSLv3_server") == 0) | |
84 | meth=SSLv3_server_method(); | |
85 | else if (strcmp(method,"SSLv23") == 0) | |
86 | meth=SSLv23_method(); | |
87 | else if (strcmp(method,"SSLv23_client") == 0) | |
88 | meth=SSLv23_client_method(); | |
89 | else if (strcmp(method,"SSLv23_server") == 0) | |
90 | meth=SSLv23_server_method(); | |
91 | else if (strcmp(method,"SSLv2") == 0) | |
92 | meth=SSLv2_method(); | |
93 | else if (strcmp(method,"SSLv2_client") == 0) | |
94 | meth=SSLv2_client_method(); | |
95 | else if (strcmp(method,"SSLv2_server") == 0) | |
96 | meth=SSLv2_server_method(); | |
97 | else | |
98 | { | |
99 | croak("Not passed a valid SSL method name, should be 'SSLv[23] [client|server]'"); | |
100 | } | |
101 | EXTEND(sp,1); | |
102 | PUSHs(sv_newmortal()); | |
103 | ctx=SSL_CTX_new(meth); | |
104 | sv_setref_pv(ST(0), "SSLeay::SSL::CTX", (void*)ctx); | |
105 | ||
106 | int | |
107 | p5_SSL_CTX_use_PrivateKey_file(ctx,file,...) | |
108 | SSL_CTX *ctx; | |
109 | char *file; | |
110 | PREINIT: | |
111 | int i=SSL_FILETYPE_PEM; | |
112 | char *ptr; | |
113 | CODE: | |
114 | pr_name("p5_SSL_CTX_use_PrivateKey_file"); | |
115 | if (items > 3) | |
116 | croak("SSLeay::SSL::CTX::use_PrivateKey_file(ssl_ctx,file[,type])"); | |
117 | if (items == 3) | |
118 | { | |
119 | ptr=SvPV(ST(2),na); | |
120 | if (strcmp(ptr,"der") == 0) | |
121 | i=SSL_FILETYPE_ASN1; | |
122 | else | |
123 | i=SSL_FILETYPE_PEM; | |
124 | } | |
125 | RETVAL=SSL_CTX_use_RSAPrivateKey_file(ctx,file,i); | |
126 | OUTPUT: | |
127 | RETVAL | |
128 | ||
129 | int | |
130 | p5_SSL_CTX_set_options(ctx,...) | |
131 | SSL_CTX *ctx; | |
132 | PREINIT: | |
133 | int i; | |
134 | char *ptr; | |
135 | SV *sv; | |
136 | CODE: | |
137 | pr_name("p5_SSL_CTX_set_options"); | |
138 | ||
139 | for (i=1; i<items; i++) | |
140 | { | |
141 | if (!SvPOK(ST(i))) | |
142 | croak("Usage: SSLeay::SSL_CTX::set_options(ssl_ctx[,option,value]+)"); | |
143 | ptr=SvPV(ST(i),na); | |
144 | if (strcmp(ptr,"-info_callback") == 0) | |
145 | { | |
146 | SSL_CTX_set_info_callback(ctx, | |
147 | p5_ssl_info_callback); | |
148 | sv=sv_mortalcopy(ST(i+1)); | |
149 | SvREFCNT_inc(sv); | |
150 | SSL_CTX_set_ex_data(ctx, | |
151 | p5_ssl_ctx_ex_ssl_info_callback, | |
152 | (char *)sv); | |
153 | i++; | |
154 | } | |
155 | else | |
156 | { | |
157 | croak("SSLeay::SSL_CTX::set_options(): unknown option"); | |
158 | } | |
159 | } | |
160 | ||
161 | void | |
162 | p5_SSL_CTX_DESTROY(ctx) | |
163 | SSL_CTX *ctx | |
164 | PREINIT: | |
165 | SV *sv; | |
166 | PPCODE: | |
167 | pr_name_d("p5_SSL_CTX_DESTROY",ctx->references); | |
168 | SSL_CTX_free(ctx); | |
169 | ||
170 | MODULE = SSLeay::SSL PACKAGE = SSLeay::SSL PREFIX = p5_SSL_ | |
171 | ||
172 | void | |
173 | p5_SSL_new(...) | |
174 | PREINIT: | |
175 | SV *sv_ctx; | |
176 | SSL_CTX *ctx; | |
177 | SSL *ssl; | |
178 | int i; | |
179 | SV *arg; | |
180 | PPCODE: | |
181 | pr_name("p5_SSL_new"); | |
182 | if ((items != 1) && (items != 2)) | |
183 | croak("Usage: SSLeay::SSL::new(ssl_ctx)"); | |
184 | if (sv_derived_from(ST(items-1),"SSLeay::SSL::CTX")) | |
185 | { | |
186 | IV tmp = SvIV((SV*)SvRV(ST(items-1))); | |
187 | ctx=(SSL_CTX *)tmp; | |
188 | sv_ctx=ST(items-1); | |
189 | } | |
190 | else | |
191 | croak("ssl_ctx is not of type SSLeay::SSL::CTX"); | |
192 | ||
193 | EXTEND(sp,1); | |
194 | PUSHs(sv_newmortal()); | |
195 | ssl=SSL_new(ctx); | |
196 | sv_setref_pv(ST(0), "SSLeay::SSL", (void*)ssl); | |
197 | ||
198 | /* Now this is being a little hairy, we keep a pointer to | |
199 | * our perl reference. We need to do a different one | |
200 | * to the one we return because it will have it's reference | |
201 | * count droped to 0 apon return and if we up its reference | |
202 | * count, it will never be DESTROYED */ | |
203 | arg=newSVsv(ST(0)); | |
204 | SSL_set_ex_data(ssl,p5_ssl_ex_ssl_ptr,(char *)arg); | |
205 | SvREFCNT_inc(sv_ctx); | |
206 | SSL_set_ex_data(ssl,p5_ssl_ex_ssl_ctx_ptr,(char *)sv_ctx); | |
207 | ||
208 | int | |
209 | p5_SSL_connect(ssl) | |
210 | SSL *ssl; | |
211 | CODE: | |
212 | RETVAL=SSL_connect(ssl); | |
213 | OUTPUT: | |
214 | RETVAL | |
215 | ||
216 | int | |
217 | p5_SSL_accept(ssl) | |
218 | SSL *ssl; | |
219 | CODE: | |
220 | RETVAL=SSL_connect(ssl); | |
221 | OUTPUT: | |
222 | RETVAL | |
223 | ||
224 | int | |
225 | p5_SSL_sysread(ssl,in,num, ...) | |
226 | SSL *ssl; | |
227 | SV *in; | |
228 | int num; | |
229 | PREINIT: | |
230 | int i,n,olen; | |
231 | int offset; | |
232 | char *p; | |
233 | CODE: | |
234 | offset=0; | |
235 | if (!SvPOK(in)) | |
236 | sv_setpvn(in,"",0); | |
237 | SvPV(in,olen); | |
238 | if (items > 3) | |
239 | { | |
240 | offset=SvIV(ST(3)); | |
241 | if (offset < 0) | |
242 | { | |
243 | if (-offset > olen) | |
244 | croad("Offset outside string"); | |
245 | offset+=olen; | |
246 | } | |
247 | } | |
248 | if ((num+offset) > olen) | |
249 | { | |
250 | SvGROW(in,num+offset+1); | |
251 | p=SvPV(in,i); | |
252 | memset(&(p[olen]),0,(num+offset)-olen+1); | |
253 | } | |
254 | p=SvPV(in,n); | |
255 | ||
256 | i=SSL_read(ssl,p+offset,num); | |
257 | RETVAL=i; | |
258 | if (i <= 0) i=0; | |
259 | SvCUR_set(in,offset+i); | |
260 | OUTPUT: | |
261 | RETVAL | |
262 | ||
263 | int | |
264 | p5_SSL_syswrite(ssl,in, ...) | |
265 | SSL *ssl; | |
266 | SV *in; | |
267 | PREINIT: | |
268 | char *ptr; | |
269 | int len,in_len; | |
270 | int offset=0; | |
271 | int n; | |
272 | CODE: | |
273 | ptr=SvPV(in,in_len); | |
274 | if (items > 2) | |
275 | { | |
276 | len=SvOK(ST(2))?SvIV(ST(2)):in_len; | |
277 | if (items > 3) | |
278 | { | |
279 | offset=SvIV(ST(3)); | |
280 | if (offset < 0) | |
281 | { | |
282 | if (-offset > in_len) | |
283 | croak("Offset outside string"); | |
284 | offset+=in_len; | |
285 | } | |
286 | else if ((offset >= in_len) && (in_len > 0)) | |
287 | croak("Offset outside string"); | |
288 | } | |
289 | if (len >= (in_len-offset)) | |
290 | len=in_len-offset; | |
291 | } | |
292 | else | |
293 | len=in_len; | |
294 | ||
295 | RETVAL=SSL_write(ssl,ptr+offset,len); | |
296 | OUTPUT: | |
297 | RETVAL | |
298 | ||
299 | void | |
300 | p5_SSL_set_bio(ssl,bio) | |
301 | SSL *ssl; | |
302 | BIO *bio; | |
303 | CODE: | |
304 | bio->references++; | |
305 | SSL_set_bio(ssl,bio,bio); | |
306 | ||
307 | int | |
308 | p5_SSL_set_options(ssl,...) | |
309 | SSL *ssl; | |
310 | PREINIT: | |
311 | int i; | |
312 | char *ptr; | |
313 | SV *sv; | |
314 | CODE: | |
315 | pr_name("p5_SSL_set_options"); | |
316 | ||
317 | for (i=1; i<items; i++) | |
318 | { | |
319 | if (!SvPOK(ST(i))) | |
320 | croak("Usage: SSLeay::SSL::set_options(ssl[,option,value]+)"); | |
321 | ptr=SvPV(ST(i),na); | |
322 | if (strcmp(ptr,"-info_callback") == 0) | |
323 | { | |
324 | SSL_set_info_callback(ssl, | |
325 | p5_ssl_info_callback); | |
326 | sv=sv_mortalcopy(ST(i+1)); | |
327 | SvREFCNT_inc(sv); | |
328 | SSL_set_ex_data(ssl, | |
329 | p5_ssl_ex_ssl_info_callback,(char *)sv); | |
330 | i++; | |
331 | } | |
332 | else if (strcmp(ptr,"-connect_state") == 0) | |
333 | { | |
334 | SSL_set_connect_state(ssl); | |
335 | } | |
336 | else if (strcmp(ptr,"-accept_state") == 0) | |
337 | { | |
338 | SSL_set_accept_state(ssl); | |
339 | } | |
340 | else | |
341 | { | |
342 | croak("SSLeay::SSL::set_options(): unknown option"); | |
343 | } | |
344 | } | |
345 | ||
346 | void | |
347 | p5_SSL_state(ssl) | |
348 | SSL *ssl; | |
349 | PREINIT: | |
350 | int state; | |
351 | PPCODE: | |
352 | pr_name("p5_SSL_state"); | |
353 | EXTEND(sp,1); | |
354 | PUSHs(sv_newmortal()); | |
355 | state=SSL_state(ssl); | |
356 | sv_setpv(ST(0),SSL_state_string_long(ssl)); | |
357 | sv_setiv(ST(0),state); | |
358 | SvPOK_on(ST(0)); | |
359 | ||
360 | void | |
361 | p5_SSL_DESTROY(ssl) | |
362 | SSL *ssl; | |
363 | CODE: | |
364 | pr_name_dd("p5_SSL_DESTROY",ssl->references,ssl->ctx->references); | |
365 | fprintf(stderr,"SSL_DESTROY %d\n",ssl->references); | |
366 | SSL_free(ssl); | |
367 | ||
368 | int | |
369 | p5_SSL_references(ssl) | |
370 | SSL *ssl; | |
371 | CODE: | |
372 | RETVAL=ssl->references; | |
373 | OUTPUT: | |
374 | RETVAL | |
375 | ||
376 | int | |
377 | p5_SSL_do_handshake(ssl) | |
378 | SSL *ssl; | |
379 | CODE: | |
380 | RETVAL=SSL_do_handshake(ssl); | |
381 | OUTPUT: | |
382 | RETVAL | |
383 | ||
384 | int | |
385 | p5_SSL_renegotiate(ssl) | |
386 | SSL *ssl; | |
387 | CODE: | |
388 | RETVAL=SSL_renegotiate(ssl); | |
389 | OUTPUT: | |
390 | RETVAL | |
391 | ||
392 | int | |
393 | p5_SSL_shutdown(ssl) | |
394 | SSL *ssl; | |
395 | CODE: | |
396 | RETVAL=SSL_shutdown(ssl); | |
397 | OUTPUT: | |
398 | RETVAL | |
399 | ||
400 | char * | |
401 | p5_SSL_get_version(ssl) | |
402 | SSL *ssl; | |
403 | CODE: | |
404 | RETVAL=SSL_get_version(ssl); | |
405 | OUTPUT: | |
406 | RETVAL | |
407 | ||
408 | SSL_CIPHER * | |
409 | p5_SSL_get_current_cipher(ssl) | |
410 | SSL *ssl; | |
411 | CODE: | |
412 | RETVAL=SSL_get_current_cipher(ssl); | |
413 | OUTPUT: | |
414 | RETVAL | |
415 | ||
416 | X509 * | |
417 | p5_SSL_get_peer_certificate(ssl) | |
418 | SSL *ssl | |
419 | CODE: | |
420 | RETVAL=SSL_get_peer_certificate(ssl); | |
421 | OUTPUT: | |
422 | RETVAL | |
423 | ||
424 | MODULE = SSLeay::SSL PACKAGE = SSLeay::SSL::CIPHER PREFIX = p5_SSL_CIPHER_ | |
425 | ||
426 | int | |
427 | p5_SSL_CIPHER_get_bits(sc) | |
428 | SSL_CIPHER *sc | |
429 | PREINIT: | |
430 | int i,ret; | |
431 | PPCODE: | |
432 | EXTEND(sp,2); | |
433 | PUSHs(sv_newmortal()); | |
434 | PUSHs(sv_newmortal()); | |
435 | ret=SSL_CIPHER_get_bits(sc,&i); | |
436 | sv_setiv(ST(0),(IV)ret); | |
437 | sv_setiv(ST(1),(IV)i); | |
438 | ||
439 | char * | |
440 | p5_SSL_CIPHER_get_version(sc) | |
441 | SSL_CIPHER *sc | |
442 | CODE: | |
443 | RETVAL=SSL_CIPHER_get_version(sc); | |
444 | OUTPUT: | |
445 | RETVAL | |
446 | ||
447 | char * | |
448 | p5_SSL_CIPHER_get_name(sc) | |
449 | SSL_CIPHER *sc | |
450 | CODE: | |
451 | RETVAL=SSL_CIPHER_get_name(sc); | |
452 | OUTPUT: | |
453 | RETVAL | |
454 | ||
455 | MODULE = SSLeay::SSL PACKAGE = SSLeay::BIO PREFIX = p5_BIO_ | |
456 | ||
457 | void | |
458 | p5_BIO_get_ssl(bio) | |
459 | BIO *bio; | |
460 | PREINIT: | |
461 | SSL *ssl; | |
462 | SV *ret; | |
463 | int i; | |
464 | PPCODE: | |
465 | if ((i=BIO_get_ssl(bio,&ssl)) > 0) | |
466 | { | |
467 | ret=(SV *)SSL_get_ex_data(ssl,p5_ssl_ex_ssl_ptr); | |
468 | ret=sv_mortalcopy(ret); | |
469 | } | |
470 | else | |
471 | ret= &sv_undef; | |
472 | EXTEND(sp,1); | |
473 | PUSHs(ret); | |
474 |