this is a basically a question regarding OpenSSL
on Win32, but it has some implications with
ActivePerl; maybe someone could hint me on how
to debug this sort of thing.
i wrote a Perl module which sends XML messages
over a SSL connection to a remote server. i need to
authenticate the server, so i thought of using
SSL_CTX_set_verify with my own callback.
getting Net::SSLeay to work on Win32 appeared to be quite
painful, so after browsing the ActiveState mailing list
archives i decided to roll my own by writing a few functions
in XS.
then i compiled openssl-0.9.6 with VC++ 6.0 and NASM. it compiled
fine, but i had to disable /WX in ms\ntdll.mak, because
there were hundreds of warnings.
then, after some Makefile-tweaking i managed to compile
the Perl module, which uses XS for some SSL-related
stuff; i attached the relevant functions.
The problem function is init_ssl, it says
SSL_get_peer_cert_chain: error:00000000:lib(0):func(0):reason(0)
debug: freed SSL_CTX
or
SSL_get_peer_certificate: error:00000000:lib(0):func(0):reason(0)
at c:/Perl/site/lib/Netpay.pm line 178.
both functions return NULL on Win32, but
ERR_error_string_n(ERR_get_error, ...) doesn't show
anything. On UNIX, everything works fine,
and when there is an error, ERR_error_string_n will
get it.
disabling certificate verification entirely causes
ActivePerl to segfault/crash/or whatever you call it on Win32 :)
On UNIX, everything works fine.
cu,
--
Toni Andjelkovic
<[EMAIL PROTECTED]>
/*
* "This product includes software developed by the OpenSSL Project
* for use in the OpenSSL Toolkit. (http://www.openssl.org/)"
* This product includes cryptographic software written by Eric Young
* ([EMAIL PROTECTED]). This product includes software written by Tim
* Hudson ([EMAIL PROTECTED]).
*/
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <stdio.h>
#include <string.h>
#include <openssl/err.h>
#include <openssl/ssl.h>
#include <openssl/rand.h>
#include <openssl/pem.h>
#include <openssl/x509.h>
/*
* cert verify callback
*/
static int
verify_callback(int ok, X509_STORE_CTX *ctx)
{
char buf[512];
X509 *err_cert;
int err, depth;
err_cert = X509_STORE_CTX_get_current_cert(ctx);
err = X509_STORE_CTX_get_error(ctx);
depth = X509_STORE_CTX_get_error_depth(ctx);
X509_NAME_oneline(X509_get_subject_name(err_cert), buf, 512);
if (!ok) {
warn("verify error:num=%d:%s:depth=%d:%s\n", err,
X509_verify_cert_error_string(err), depth, buf);
}
if (!ok && (err == X509_V_ERR_UNABLE_TO_GET_ISSUER_CERT)) {
X509_NAME_oneline(X509_get_issuer_name(ctx->current_cert), buf, 512);
warn("issuer= %s\n", buf);
}
return(ok);
}
/* see typemap */
MODULE = Netpay PACKAGE = Netpay
PROTOTYPES: ENABLE
SSL_CTX *
init_ctx(ca_cert, ca_cert_path, verify_depth)
SV *ca_cert
SV *ca_cert_path
SV *verify_depth
PREINIT:
int _verify_depth = 0;
char *_ca_cert = NULL;
char *_ca_cert_path = NULL;
SSL_CTX *ctx = NULL;
STRLEN len = 0;
int rc = 0;
CODE:
{
#ifdef URANDOM
RAND_load_file("/dev/urandom", 16384);
#else
RAND_seed("foobar", 16384);
#endif
if (SvOK(verify_depth)) {
_verify_depth = (int) SvIV(verify_depth);
}
if (SvOK(ca_cert)) {
_ca_cert = SvPV(ca_cert, len);
}
if (SvOK(ca_cert_path)) {
_ca_cert_path = SvPV(ca_cert_path, len);
}
/* init SSL stuff */
SSL_library_init();
SSL_load_error_strings();
/* alloc SSL_CTX */
/* ctx = SSL_CTX_new(SSLv3_client_method()); */
ctx = SSL_CTX_new(TLSv1_client_method());
if (!ctx) {
warn("SSL_CTX_new: NULL");
ERR_print_errors_fp(stderr);
XSRETURN_UNDEF;
}
/* various bug workarounds */
SSL_CTX_set_options(ctx, SSL_OP_ALL);
/* don't verify if neither certificate path is defined */
if ((_ca_cert != NULL) || (_ca_cert_path != NULL)) {
/* load CA certificate file (PEM-encoded) */
rc = SSL_CTX_load_verify_locations(ctx, _ca_cert, _ca_cert_path);
if (!rc) {
warn("SSL_CTX_load_verify_locations: %d", rc);
ERR_print_errors_fp(stderr);
SSL_CTX_free(ctx); /* free it! */
XSRETURN_UNDEF;
}
SSL_CTX_set_verify_depth(ctx, _verify_depth);
/* set verify callback */
SSL_CTX_set_verify(
ctx,
SSL_VERIFY_PEER | SSL_VERIFY_FAIL_IF_NO_PEER_CERT,
verify_callback
);
}
RETVAL = ctx;
}
OUTPUT:
RETVAL
SSL *
init_ssl(ctx, fd, tmout)
SSL_CTX *ctx
int fd
int tmout
PREINIT:
SSL *ssl = NULL;
SSL_SESSION *ses = NULL;
int rc = 0;
STACK_OF(X509) *sk = NULL;
char err[512];
char buf[512];
X509 *peer_crt = NULL;
CODE:
{
/* alloc SSL */
ssl = SSL_new(ctx);
if (!ssl) {
ERR_error_string_n(ERR_get_error(), err, 512);
warn("SSL_new: %s", err);
XSRETURN_UNDEF;
}
rc = SSL_set_fd(ssl, fd);
if (!rc) {
ERR_error_string_n(ERR_get_error(), err, 512);
warn("SSL_set_fd: %s", err);
SSL_free(ssl);
XSRETURN_UNDEF;
}
/* go */
rc = SSL_connect(ssl);
if (!rc) {
ERR_error_string_n(ERR_get_error(), err, 512);
warn("SSL_connect: %s", err);
SSL_free(ssl);
XSRETURN_UNDEF;
}
sk = SSL_get_peer_cert_chain(ssl); /* verifies via SSL_CTX callback */
if (!sk) {
ERR_error_string_n(ERR_get_error(), err, 512);
warn("SSL_get_peer_cert_chain: %s\n", err);
SSL_free(ssl);
XSRETURN_UNDEF;
}
peer_crt = SSL_get_peer_certificate(ssl);
if (!peer_crt) {
ERR_error_string_n(ERR_get_error(), err, 512);
warn("SSL_get_peer_certificate: %s", err);
SSL_free(ssl);
XSRETURN_UNDEF;
}
/* print it */
if (SvOK(perl_get_sv("Netpay::VERBOSE", FALSE))) {
warn("debug: Peer : %s\n", X509_NAME_oneline(X509_get_subject_name(peer_crt),
buf, 512));
warn("debug: Issuer: %s\n", X509_NAME_oneline(X509_get_issuer_name(peer_crt),
buf, 512));
}
if (SSL_get_verify_result(ssl) != X509_V_OK) {
ERR_error_string_n(SSL_get_verify_result(ssl), err, 512);
warn("SSL_get_verify_result: %s\n", err);
X509_free(peer_crt);
SSL_free(ssl);
XSRETURN_UNDEF;
}
/* we're authenticated, let's retrieve the session
and set some timeouts */
ses = SSL_get_session(ssl);
if (!ses) {
ERR_error_string_n(ERR_get_error(), err, 512);
warn("SSL_get_session: %s", err);
X509_free(peer_crt);
SSL_free(ssl);
XSRETURN_UNDEF;
}
rc = SSL_SESSION_set_timeout(ses, (long) tmout);
if (!rc) {
ERR_error_string_n(ERR_get_error(), err, 512);
warn("SSL_SESSION_set_timeout: %s", ssl);
X509_free(peer_crt);
SSL_free(ssl);
XSRETURN_UNDEF;
}
X509_free(peer_crt);
RETVAL = ssl;
}
OUTPUT:
RETVAL
void
ctx_free(ctx)
SSL_CTX *ctx;
PPCODE:
{
/* clean up */
SSL_CTX_free(ctx);
if (SvOK(perl_get_sv("Netpay::VERBOSE", FALSE))) {
warn("debug: freed SSL_CTX\n");
}
XSRETURN_YES; /* return true */
}
void
ssl_free(ssl)
SSL *ssl
PPCODE:
{
/* clean up */
SSL_shutdown(ssl); /* don't care about the retcode :) */
SSL_free(ssl);
if (SvOK(perl_get_sv("Netpay::VERBOSE", FALSE))) {
warn("debug: freed SSL\n");
}
XSRETURN_YES; /* return true */
}
