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