File Coverage

SSLeay.xs

Criterion	Covered	Total	%
statement	18	103	17.5
branch			n/a
condition			n/a
subroutine			n/a
pod			n/a
total	18	103	17.5

line	stmt	code
1		/*
2		* $Id: SSLeay.xs,v 1.2 2000/05/10 16:37:25 ben Exp $
3		* Copyright 1998 Gisle Aas.
4		*
5		* This library is free software; you can redistribute it and/or
6		* modify it under the same terms as Perl itself.
7		*/
8
9		#ifdef __cplusplus
10		extern "C" {
11		#endif
12		#include "EXTERN.h"
13		#include "perl.h"
14		#include "XSUB.h"
15
16		/* build problem under openssl 0.9.6 and some builds of perl 5.8.x */
17		#ifndef PERL5
18		#define PERL5 1
19		#endif
20
21		/* ssl.h or openssl/ssl.h is included from the crypt_ssleay_version
22		* file which is written when building with perl Makefile.PL
23		* #include "ssl.h"
24		*/
25		#include "crypt_ssleay_version.h"
26
27		#undef Free /* undo namespace pollution from crypto.h */
28		#ifdef __cplusplus
29		}
30		#endif
31
32
33		/* moved this out to Makefile.PL so user can
34		* see value being used printed during build
35		* #if SSLEAY_VERSION_NUMBER >= 0x0900
36		* #define CRYPT_SSL_CLIENT_METHOD SSLv3_client_method()
37		* #else
38		* #define CRYPT_SSL_CLIENT_METHOD SSLv2_client_method()
39		* #endif
40		*/
41
42
43		static void InfoCallback(const SSL *s,int where,int ret)
44	0	{
45		char *str;
46		int w;
47
48		w = where & ~SSL_ST_MASK;
49
50	0	if(w & SSL_ST_CONNECT)
51		str="SSL_connect";
52	0	else if(w & SSL_ST_ACCEPT)
53		str="SSL_accept";
54		else
55		str="undefined";
56
57	0	if(where & SSL_CB_LOOP)
58	0	fprintf(stderr,"%s:%s\n",str,SSL_state_string_long(s));
59	0	else if(where & SSL_CB_ALERT)
60		{
61	0	str=(where & SSL_CB_READ)?"read":"write";
62	0	fprintf(stderr,"SSL3 alert %s:%s:%s\n",str,
63		SSL_alert_type_string_long(ret),
64		SSL_alert_desc_string_long(ret));
65		}
66	0	else if(where & SSL_CB_EXIT)
67		{
68	0	if(ret == 0)
69	0	fprintf(stderr,"%s:failed in %s\n",str,SSL_state_string_long(s));
70	0	else if (ret < 0)
71	0	fprintf(stderr,"%s:error in %s\n",str,SSL_state_string_long(s));
72		}
73		}
74
75		MODULE = Crypt::SSLeay PACKAGE = Crypt::SSLeay
76
77		PROTOTYPES: DISABLE
78
79		MODULE = Crypt::SSLeay PACKAGE = Crypt::SSLeay::Err PREFIX = ERR_
80
81		char*
82		ERR_get_error_string()
83		CODE:
84		unsigned long l;
85		char buf[1024];
86
87	0	if(!(l=ERR_get_error()))
88		RETVAL=NULL;
89		else
90		{
91	0	ERR_error_string(l,buf);
92		RETVAL=buf;
93		}
94		OUTPUT:
95		RETVAL
96
97		MODULE = Crypt::SSLeay PACKAGE = Crypt::SSLeay::CTX PREFIX = SSL_CTX_
98
99		SSL_CTX*
100		SSL_CTX_new(packname, ssl_version)
101		SV* packname
102		int ssl_version
103		CODE:
104		SSL_CTX* ctx;
105		static int bNotFirstTime;
106		char buf[1024];
107		int rand_bytes_read;
108
109	4	if(!bNotFirstTime) {
110	2	SSLeay_add_all_algorithms();
111	2	SSL_load_error_strings();
112	2	ERR_load_crypto_strings();
113	2	SSL_library_init();
114	2	bNotFirstTime = 1;
115		}
116
117		/** Code from Devin Heitmueller, 10/3/2002 **/
118		/** Use /dev/urandom to seed if available **/
119	4	rand_bytes_read = RAND_load_file("/dev/urandom", 1024);
120	4	if (rand_bytes_read <= 0) {
121		/* Couldn't read /dev/urandom, just seed off
122		of the stack variable (the old way) */
123	0	RAND_seed(buf,sizeof buf);
124		}
125
126	4	if(ssl_version == 23) {
127	4	ctx = SSL_CTX_new(SSLv23_client_method());
128	0	} else if(ssl_version == 3) {
129	0	ctx = SSL_CTX_new(SSLv3_client_method());
130		} else {
131		/* v2 is the default */
132	0	ctx = SSL_CTX_new(SSLv2_client_method());
133		}
134	4	SSL_CTX_set_options(ctx,SSL_OP_ALL\|0);
135
136	4	SSL_CTX_set_default_verify_paths(ctx);
137	4	SSL_CTX_set_verify(ctx, SSL_VERIFY_NONE, NULL);
138
139		RETVAL = ctx;
140
141		OUTPUT:
142		RETVAL
143
144		void
145		SSL_CTX_free(ctx)
146		SSL_CTX* ctx
147
148		int
149		SSL_CTX_set_cipher_list(ctx, ciphers)
150		SSL_CTX* ctx
151		char* ciphers
152
153		int
154		SSL_CTX_use_certificate_file(ctx, filename, mode)
155		SSL_CTX* ctx
156		char* filename
157		int mode
158
159		int
160		SSL_CTX_use_PrivateKey_file(ctx, filename ,mode)
161		SSL_CTX* ctx
162		char* filename
163		int mode
164
165
166		int
167		SSL_CTX_use_pkcs12_file(ctx, filename, password)
168		SSL_CTX* ctx
169		char* filename
170		char* password
171		PREINIT:
172		FILE *fp;
173		EVP_PKEY *pkey;
174		X509 *cert;
175	0	STACK_OF(X509) *ca = NULL;
176		PKCS12 *p12;
177		CODE:
178	0	if (fp = fopen(filename, "rb")) {
179	0	p12 = d2i_PKCS12_fp(fp, NULL);
180	0	fclose (fp);
181
182	0	if (p12) {
183	0	if(PKCS12_parse(p12, password, &pkey, &cert, &ca)) {
184	0	if (pkey) {
185	0	RETVAL = SSL_CTX_use_PrivateKey(ctx, pkey);
186	0	EVP_PKEY_free(pkey);
187		}
188	0	if (cert) {
189	0	RETVAL = SSL_CTX_use_certificate(ctx, cert);
190	0	X509_free(cert);
191		}
192		}
193	0	PKCS12_free(p12);
194		}
195
196		}
197
198
199		OUTPUT:
200		RETVAL
201
202
203		int
204		SSL_CTX_check_private_key(ctx)
205		SSL_CTX* ctx
206
207		SV*
208		SSL_CTX_set_verify(ctx)
209		SSL_CTX* ctx
210		PREINIT:
211		char* CAfile;
212		char* CAdir;
213		CODE:
214	1	CAfile=getenv("HTTPS_CA_FILE");
215	1	CAdir =getenv("HTTPS_CA_DIR");
216
217	1	if(!CAfile && !CAdir) {
218	1	SSL_CTX_set_verify(ctx, SSL_VERIFY_NONE, NULL);
219	1	RETVAL = newSViv(0);
220		} else {
221	0	SSL_CTX_load_verify_locations(ctx,CAfile,CAdir);
222	0	SSL_CTX_set_verify(ctx, SSL_VERIFY_PEER, NULL);
223	0	RETVAL = newSViv(1);
224		}
225		OUTPUT:
226		RETVAL
227
228		MODULE = Crypt::SSLeay PACKAGE = Crypt::SSLeay::Conn PREFIX = SSL_
229
230		SSL*
231		SSL_new(packname, ctx, debug, ...)
232		SV* packname
233		SSL_CTX* ctx
234		SV* debug
235		PREINIT:
236		SSL* ssl;
237		CODE:
238	0	ssl = SSL_new(ctx);
239	0	SSL_set_connect_state(ssl);
240		/* The set mode is necessary so the SSL connection can
241		* survive a renegotiated cipher that results from
242		* modssl VerifyClient config changing between
243		* VirtualHost & some other config block. At modssl
244		* this would be a [trace] ssl message:
245		* "Changed client verification type will force renegotiation"
246		* -- jc 6/28/2001
247		*/
248		#ifdef SSL_MODE_AUTO_RETRY
249	0	SSL_set_mode(ssl, SSL_MODE_AUTO_RETRY);
250		#endif
251		RETVAL = ssl;
252	0	if(SvTRUE(debug)) {
253	0	SSL_set_info_callback(RETVAL,InfoCallback);
254		}
255		if (items > 2) {
256	0	PerlIO* io = IoIFP(sv_2io(ST(3)));
257		#ifdef _WIN32
258		SSL_set_fd(RETVAL, _get_osfhandle(PerlIO_fileno(io)));
259		#else
260	0	SSL_set_fd(RETVAL, PerlIO_fileno(io));
261		#endif
262		}
263		OUTPUT:
264		RETVAL
265
266
267		void
268		SSL_free(ssl)
269		SSL* ssl
270
271		int
272		SSL_set_fd(ssl,fd)
273		SSL* ssl
274		int fd
275
276		int
277		SSL_connect(ssl)
278		SSL* ssl
279
280		int
281		SSL_accept(ssl)
282		SSL* ssl
283
284		SV*
285		SSL_write(ssl, buf, ...)
286		SSL* ssl
287		PREINIT:
288		STRLEN blen;
289		int len;
290		int offset = 0;
291		int n;
292		INPUT:
293		char* buf = SvPV(ST(1), blen);
294		CODE:
295	0	if (items > 2) {
296	0	len = SvOK(ST(2)) ? SvIV(ST(2)) : blen;
297	0	if (items > 3) {
298	0	offset = SvIV(ST(3));
299	0	if (offset < 0) {
300	0	if (-offset > blen)
301	0	croak("Offset outside string");
302		offset += blen;
303	0	} else if (offset >= blen && blen > 0)
304	0	croak("Offset outside string");
305		}
306	0	if (len > blen - offset)
307	0	len = blen - offset;
308		} else {
309	0	len = blen;
310		}
311	0	n = SSL_write(ssl, buf+offset, len);
312	0	if (n >= 0) {
313	0	RETVAL = newSViv(n);
314		} else {
315		RETVAL = &PL_sv_undef;
316		}
317		OUTPUT:
318		RETVAL
319
320
321		SV*
322		SSL_read(ssl, buf, len,...)
323		SSL* ssl
324		int len
325		PREINIT:
326		char *buf;
327		STRLEN blen;
328		int offset = 0;
329		int n;
330		INPUT:
331		SV* sv = ST(1);
332		CODE:
333	0	buf = SvPV_force(sv, blen);
334	0	if (items > 3) {
335	0	offset = SvIV(ST(3));
336	0	if (offset < 0) {
337	0	if (-offset > blen)
338	0	croak("Offset outside string");
339	0	offset += blen;
340		}
341		/* this is not a very efficient method of appending
342		* (offset - blen) NUL bytes, but it will probably
343		* seldom happen.
344		*/
345	0	while (offset > blen) {
346	0	sv_catpvn(sv, "\0", 1);
347	0	blen++;
348		}
349		}
350	0	if (len < 0)
351	0	croak("Negative length");
352
353	0	SvGROW(sv, offset + len + 1);
354	0	buf = SvPVX(sv); /* it might have been relocated */
355
356	0	n = SSL_read(ssl, buf+offset, len);
357
358	0	if (n >= 0) {
359	0	SvCUR_set(sv, offset + n);
360	0	buf[offset + n] = '\0';
361	0	RETVAL = newSViv(n);
362		} else {
363		RETVAL = &PL_sv_undef;
364		}
365
366		OUTPUT:
367		RETVAL
368
369		X509*
370		SSL_get_peer_certificate(ssl)
371		SSL* ssl
372
373
374		SV*
375		SSL_get_verify_result(ssl)
376		SSL* ssl
377		CODE:
378	0	RETVAL = newSViv((SSL_get_verify_result(ssl) == X509_V_OK) ? 1 : 0);
379		OUTPUT:
380		RETVAL
381
382
383		char*
384		SSL_get_shared_ciphers(ssl)
385		SSL* ssl
386		PREINIT:
387		char buf[512];
388		CODE:
389	0	RETVAL = SSL_get_shared_ciphers(ssl, buf, sizeof(buf));
390		OUTPUT:
391		RETVAL
392
393		char*
394		SSL_get_cipher(ssl)
395		SSL* ssl
396		CODE:
397	0	RETVAL = (char*) SSL_get_cipher(ssl);
398		OUTPUT:
399		RETVAL
400
401		MODULE = Crypt::SSLeay PACKAGE = Crypt::SSLeay::X509 PREFIX = X509_
402
403		void
404		X509_free(cert)
405		X509* cert
406
407		SV*
408		subject_name(cert)
409		X509* cert
410		PREINIT:
411		char* str;
412		CODE:
413	0	str = X509_NAME_oneline(X509_get_subject_name(cert), NULL, 0);
414	0	RETVAL = newSVpv(str, 0);
415	0	CRYPT_SSLEAY_free(str);
416		OUTPUT:
417		RETVAL
418
419		SV*
420		issuer_name(cert)
421		X509* cert
422		PREINIT:
423		char* str;
424		CODE:
425	0	str = X509_NAME_oneline(X509_get_issuer_name(cert), NULL, 0);
426	0	RETVAL = newSVpv(str, 0);
427	0	CRYPT_SSLEAY_free(str);
428		OUTPUT:
429		RETVAL
430
431		char*
432		get_notBeforeString(cert)
433		X509* cert
434		CODE:
435		RETVAL = (char*) X509_get_notBefore(cert)->data;
436		OUTPUT:
437		RETVAL
438
439		char*
440		get_notAfterString(cert)
441		X509* cert
442		CODE:
443		RETVAL = (char*) X509_get_notAfter(cert)->data;
444		OUTPUT:
445		RETVAL
446
447
448