/* Copyright (c) 2010-2014 A. Sinan Unur <nanis@cpan.org>
* Copyright (c) 2006-2007 David Landgren
* Copyright (c) 1999-2003 Joshua Chamas
* Copyright (c) 1998 Gisle Aas
*
* This library is free software. You can use, and distribute it under the
* terms of Artistic License version 2.0:
* http://www.perlfoundation.org/artistic_license_2_0
*
*/
#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
/* build problem under openssl 0.9.6 and some builds of perl 5.8.x */
#ifndef PERL5
#define PERL5 1
#endif
#include <openssl/bio.h>
#include <openssl/crypto.h>
#include <openssl/err.h>
#include <openssl/pkcs12.h>
#include <openssl/rand.h>
#include <openssl/ssl.h>
#define CRYPT_SSLEAY_free OPENSSL_free
#undef Free /* undo namespace pollution from crypto.h */
#ifdef __cplusplus
}
#endif
/* See https://www.openssl.org/docs/ssl/SSL_CTX_new.html
* The list of protocols available can later be limited using the
* SSL_OP_NO_SSLv2, SSL_OP_NO_SSLv3, SSL_OP_NO_TLSv1, SSL_OP_NO_TLSv1_1 and
* SSL_OP_NO_TLSv1_2 options of the SSL_CTX_set_options() or
* SSL_set_options() functions.
*/
#define CRYPT_SSL_CLIENT_METHOD SSLv23_client_method()
/* https://www.openssl.org/docs/ssl/SSL_CTX_set_msg_callback.html */
static void
msg_callback(
int write_p,
int version,
int content_type,
const void *buf,
size_t len,
SSL *ssl,
void *arg
) {
size_t i = 0;
BIO *bio_err = BIO_new_fp(stderr, BIO_NOCLOSE);
const char *rw = write_p ? "Sent" : "Received";
const char *vstr = (version == TLS1_2_VERSION) ? "TLSv1.2"
: (version == TLS1_1_VERSION) ? "TLSv1.1"
: (version == TLS1_VERSION) ? "TLSv1"
: (version == SSL3_VERSION) ? "SSLv3"
: (version == SSL2_VERSION) ? "SSLv2"
: "unknown protocol"
;
const char *ctstr = (content_type == 20) ? "change_cipher_spec"
: (content_type == 21) ? "alert"
: (content_type == 22) ? "handshake"
: "unknown content type"
;
BIO_printf(bio_err,
"%s %s %d (%s):",
vstr, rw, content_type, ctstr
);
for (i = 0; i < len; i += 1) {
BIO_printf(bio_err, " %02x", ((unsigned char *) buf)[i]);
}
BIO_puts(bio_err, "\n");
if (content_type == 20) {
char buf[256];
const SSL_CIPHER *cipher = SSL_get_current_cipher(ssl);
if (cipher) {
if (SSL_CIPHER_description(cipher, buf, 256)) {
buf[255] = 0;
BIO_puts(bio_err, buf);
BIO_puts(bio_err, "\n");
}
}
}
BIO_free(bio_err);
return;
}
static void
info_callback(const SSL *s, int where, int ret) {
BIO *bio_err = BIO_new_fp(stderr, BIO_NOCLOSE);
int w = where & ~SSL_ST_MASK;
const char *mode = (w & SSL_ST_CONNECT) ? "SSL_connect"
: (w & SSL_ST_ACCEPT) ? "SSL_accept"
: "unknown"
;
if (where & SSL_CB_LOOP) {
BIO_printf(bio_err, "%s: %s\n", mode, SSL_state_string_long(s));
goto LAST;
}
if (where & SSL_CB_ALERT) {
BIO_printf(
bio_err, "SSL/TLS alert %s: %s: %s\n",
(where & SSL_CB_READ) ? "read" : "write",
SSL_alert_type_string_long(ret),
SSL_alert_desc_string_long(ret)
);
goto LAST;
}
if (where & SSL_CB_EXIT) {
if (ret == 0) {
BIO_printf(
bio_err, "%s: failed in %s\n",
mode, SSL_state_string_long(s)
);
goto LAST;
}
if (ret < 0) {
BIO_printf(
bio_err, "%s:error in %s\n",
mode, SSL_state_string_long(s)
);
goto LAST;
}
}
LAST:
BIO_free(bio_err);
return;
}
MODULE = Crypt::SSLeay PACKAGE = Crypt::SSLeay
PROTOTYPES: DISABLE
MODULE = Crypt::SSLeay PACKAGE = Crypt::SSLeay::Err PREFIX = ERR_
#define CRYPT_SSLEAY_ERR_BUFSIZE 1024
const char *
ERR_get_error_string()
PREINIT:
unsigned long code;
char buf[ CRYPT_SSLEAY_ERR_BUFSIZE ];
CODE:
if ((code = ERR_get_error()) == 0) {
RETVAL = NULL;
}
else {
/* www.openssl.org/docs/crypto/ERR_error_string.html */
ERR_error_string_n(code, buf, CRYPT_SSLEAY_ERR_BUFSIZE);
RETVAL = buf;
}
OUTPUT:
RETVAL
MODULE = Crypt::SSLeay PACKAGE = Crypt::SSLeay::CTX PREFIX = SSL_CTX_
#define CRYPT_SSLEAY_RAND_BUFSIZE 1024
SSL_CTX *
SSL_CTX_new(package, allow_sslv3)
SV *package
int allow_sslv3
CODE:
SSL_CTX *ctx;
static int bNotFirstTime;
if(!bNotFirstTime) {
OpenSSL_add_all_algorithms();
SSL_load_error_strings();
ERR_load_crypto_strings();
SSL_library_init();
bNotFirstTime = 1;
}
/* Add to entropy using Bytes::Random::Secure::random_bytes
* See also http://security.stackexchange.com/questions/56469/
*/
do {
dSP;
int count;
SV *random_bytes;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(sv_2mortal(newSViv(CRYPT_SSLEAY_RAND_BUFSIZE)));
PUTBACK;
count = call_pv("Bytes::Random::Secure::random_bytes", G_SCALAR);
SPAGAIN;
if (count != 1) {
croak("Failed to get random bytes\n");
}
random_bytes = POPs;
RAND_seed(
SvPVbyte_nolen(random_bytes),
CRYPT_SSLEAY_RAND_BUFSIZE
);
PUTBACK;
FREETMPS;
LEAVE;
} while (0);
ctx = SSL_CTX_new(CRYPT_SSL_CLIENT_METHOD);
if (allow_sslv3) {
SSL_CTX_set_options(ctx,
SSL_OP_ALL |
SSL_OP_NO_SSLv2
);
}
else {
SSL_CTX_set_options(ctx,
SSL_OP_ALL |
SSL_OP_NO_SSLv2 |
SSL_OP_NO_SSLv3
);
}
SSL_CTX_set_default_verify_paths(ctx);
SSL_CTX_set_verify(ctx, SSL_VERIFY_NONE, NULL);
RETVAL = ctx;
OUTPUT:
RETVAL
void
SSL_CTX_free(ctx)
SSL_CTX *ctx
int
SSL_CTX_set_cipher_list(ctx, ciphers)
SSL_CTX *ctx
char *ciphers
int
SSL_CTX_use_certificate_file(ctx, filename, mode)
SSL_CTX *ctx
char *filename
int mode
int
SSL_CTX_use_PrivateKey_file(ctx, filename ,mode)
SSL_CTX *ctx
char *filename
int mode
int
SSL_CTX_use_pkcs12_file(ctx, filename, password)
SSL_CTX *ctx
const char *filename
const char *password
PREINIT:
FILE *fp;
EVP_PKEY *pkey;
X509 *cert;
STACK_OF(X509) *ca = NULL;
PKCS12 *p12;
CODE:
if ((fp = fopen(filename, "rb"))) {
p12 = d2i_PKCS12_fp(fp, NULL);
fclose (fp);
if (p12) {
if(PKCS12_parse(p12, password, &pkey, &cert, &ca)) {
if (pkey) {
RETVAL = SSL_CTX_use_PrivateKey(ctx, pkey);
EVP_PKEY_free(pkey);
}
if (cert) {
RETVAL = SSL_CTX_use_certificate(ctx, cert);
X509_free(cert);
}
}
PKCS12_free(p12);
}
}
OUTPUT:
RETVAL
int
SSL_CTX_check_private_key(ctx)
SSL_CTX *ctx
SV *
SSL_CTX_set_verify(ctx)
SSL_CTX *ctx
PREINIT:
char *CAfile;
char *CAdir;
CODE:
CAfile=getenv("HTTPS_CA_FILE");
CAdir =getenv("HTTPS_CA_DIR");
if(!CAfile && !CAdir) {
SSL_CTX_set_verify(ctx, SSL_VERIFY_NONE, NULL);
RETVAL = newSViv(0);
}
else {
SSL_CTX_load_verify_locations(ctx,CAfile,CAdir);
SSL_CTX_set_verify(ctx, SSL_VERIFY_PEER, NULL);
RETVAL = newSViv(1);
}
OUTPUT:
RETVAL
MODULE = Crypt::SSLeay PACKAGE = Crypt::SSLeay::Conn PREFIX = SSL_
SSL *
SSL_new(package, ctx, debug, ...)
SV *package
SSL_CTX *ctx
SV *debug
PREINIT:
SSL *ssl;
CODE:
ssl = SSL_new(ctx);
SSL_set_connect_state(ssl);
SSL_set_mode(ssl, SSL_MODE_AUTO_RETRY);
if (SvTRUE(debug)) {
SSL_set_info_callback(ssl, info_callback);
SSL_set_msg_callback(ssl, msg_callback);
}
if (items > 2) {
PerlIO *io = IoIFP(sv_2io(ST(3)));
#ifdef _WIN32
/* PROBLEM:
* _get_osfhandle returns intptr_t but the OpenSSL set_fd
* takes an int as the fd argument. see
* https://www.openssl.org/docs/manmaster/man3/SSL_set_fd.html
* https://msdn.microsoft.com/en-us/library/ks2530z6.aspx
*/
int fd = _get_osfhandle(PerlIO_fileno(io));
#else
int fd = PerlIO_fileno(io);
#endif
SSL_set_fd(ssl, fd);
}
RETVAL = ssl;
OUTPUT:
RETVAL
void
SSL_free(ssl)
SSL *ssl
int
SSL_pending(ssl)
SSL *ssl
int
SSL_set_fd(ssl,fd)
SSL *ssl
int fd
int
SSL_connect(ssl)
SSL *ssl
int
SSL_accept(ssl)
SSL *ssl
SV *
SSL_write(ssl, buf, ...)
SSL *ssl
PREINIT:
STRLEN blen;
int len;
int offset = 0;
int keep_trying_to_write = 1;
INPUT:
char *buf = SvPV(ST(1), blen);
CODE:
if (items > 2) {
len = SvOK(ST(2)) ? SvIV(ST(2)) : blen;
if (items > 3) {
offset = SvIV(ST(3));
if (offset < 0) {
if (-offset > blen)
croak("Offset outside string");
offset += blen;
}
else if (offset >= blen && blen > 0)
croak("Offset outside string");
}
if (len > blen - offset)
len = blen - offset;
}
else {
len = blen;
}
/* try to handle incomplete writes properly
* see RT bug #64054 and RT bug #78695
* 2012/08/02: Stop trying to distinguish between good & bad
* zero returns from underlying SSL_read/SSL_write
*/
while (keep_trying_to_write)
{
int n = SSL_write(ssl, buf+offset, len);
int x = SSL_get_error(ssl, n);
if ( n >= 0 )
{
keep_trying_to_write = 0;
RETVAL = newSViv(n);
}
else
{
if
(
(x != SSL_ERROR_WANT_READ) &&
(x != SSL_ERROR_WANT_WRITE)
)
{
keep_trying_to_write = 0;
RETVAL = &PL_sv_undef;
}
}
}
OUTPUT:
RETVAL
SV *
SSL_read(ssl, buf, len,...)
SSL *ssl
int len
PREINIT:
char *buf;
STRLEN blen;
int offset = 0;
int keep_trying_to_read = 1;
INPUT:
SV *sv = ST(1);
CODE:
buf = SvPV_force(sv, blen);
if (items > 3) {
offset = SvIV(ST(3));
if (offset < 0) {
if (-offset > blen)
croak("Offset outside string");
offset += blen;
}
/* this is not a very efficient method of appending
* (offset - blen) NUL bytes, but it will probably
* seldom happen.
*/
while (offset > blen) {
sv_catpvn(sv, "\0", 1);
blen++;
}
}
if (len < 0)
croak("Negative length");
SvGROW(sv, offset + len + 1);
buf = SvPVX(sv); /* it might have been relocated */
/* try to handle incomplete writes properly
* see RT bug #64054 and RT bug #78695
* 2012/08/02: Stop trying to distinguish between good & bad
* zero returns from underlying SSL_read/SSL_write
*/
while (keep_trying_to_read) {
int n = SSL_read(ssl, buf+offset, len);
int x = SSL_get_error(ssl, n);
if ( n >= 0 )
{
SvCUR_set(sv, offset + n);
buf[offset + n] = '\0';
keep_trying_to_read = 0;
RETVAL = newSViv(n);
}
else
{
if
(
(x != SSL_ERROR_WANT_READ) &&
(x != SSL_ERROR_WANT_WRITE)
)
{
keep_trying_to_read = 0;
RETVAL = &PL_sv_undef;
}
}
}
OUTPUT:
RETVAL
X509 *
SSL_get_peer_certificate(ssl)
SSL *ssl
SV *
SSL_get_verify_result(ssl)
SSL *ssl
CODE:
RETVAL = newSViv((SSL_get_verify_result(ssl) == X509_V_OK) ? 1 : 0);
OUTPUT:
RETVAL
#define CRYPT_SSLEAY_SHARED_CIPHERS_BUFSIZE 512
char *
SSL_get_shared_ciphers(ssl)
SSL *ssl
PREINIT:
char buf[ CRYPT_SSLEAY_SHARED_CIPHERS_BUFSIZE ];
CODE:
RETVAL = SSL_get_shared_ciphers(
ssl, buf, CRYPT_SSLEAY_SHARED_CIPHERS_BUFSIZE
);
OUTPUT:
RETVAL
char *
SSL_get_cipher(ssl)
SSL *ssl
CODE:
RETVAL = (char *) SSL_get_cipher(ssl);
OUTPUT:
RETVAL
#if OPENSSL_VERSION_NUMBER >= 0x0090806fL && !defined(OPENSSL_NO_TLSEXT)
void
SSL_set_tlsext_host_name(ssl, name)
SSL *ssl
const char *name
#endif
MODULE = Crypt::SSLeay PACKAGE = Crypt::SSLeay::X509 PREFIX = X509_
void
X509_free(cert)
X509 *cert
SV *
subject_name(cert)
X509 *cert
PREINIT:
char *str;
CODE:
str = X509_NAME_oneline(X509_get_subject_name(cert), NULL, 0);
RETVAL = newSVpv(str, 0);
CRYPT_SSLEAY_free(str);
OUTPUT:
RETVAL
SV *
issuer_name(cert)
X509 *cert
PREINIT:
char *str;
CODE:
str = X509_NAME_oneline(X509_get_issuer_name(cert), NULL, 0);
RETVAL = newSVpv(str, 0);
CRYPT_SSLEAY_free(str);
OUTPUT:
RETVAL
char *
get_notBeforeString(cert)
X509 *cert
CODE:
RETVAL = (char *)X509_get_notBefore(cert)->data;
OUTPUT:
RETVAL
char *
get_notAfterString(cert)
X509 *cert
CODE:
RETVAL = (char *)X509_get_notAfter(cert)->data;
OUTPUT:
RETVAL
MODULE = Crypt::SSLeay PACKAGE = Crypt::SSLeay::Version PREFIX = VERSION_
const char *
VERSION_openssl_version()
CODE:
RETVAL = SSLeay_version(SSLEAY_VERSION);
OUTPUT:
RETVAL
long
VERSION_openssl_version_number()
CODE:
RETVAL = OPENSSL_VERSION_NUMBER;
OUTPUT:
RETVAL
const char *
VERSION_openssl_cflags()
CODE:
RETVAL = SSLeay_version(SSLEAY_CFLAGS);
OUTPUT:
RETVAL
const char *
VERSION_openssl_platform()
CODE:
RETVAL = SSLeay_version(SSLEAY_PLATFORM);
OUTPUT:
RETVAL
const char *
VERSION_openssl_built_on()
CODE:
RETVAL = SSLeay_version(SSLEAY_BUILT_ON);
OUTPUT:
RETVAL
const char *
VERSION_openssl_dir()
CODE:
RETVAL = SSLeay_version(SSLEAY_DIR);
OUTPUT:
RETVAL