95ffe86dbc
His own words are: The patch adds no new functionality (other than a simple test package) to the libraries, but it allows them to be compiled with Perl5.6.0. It has only been tested under "Red Hat Linux release 7.0 (Guinness)" with the unpatched verion of OpenSSL 0.9.6 released last September.
484 lines
9.2 KiB
Plaintext
484 lines
9.2 KiB
Plaintext
|
|
#include "openssl.h"
|
|
|
|
static int p5_ssl_ex_ssl_ptr=0;
|
|
static int p5_ssl_ex_ssl_info_callback=0;
|
|
static int p5_ssl_ex_ssl_ctx_ptr=0;
|
|
static int p5_ssl_ctx_ex_ssl_info_callback=0;
|
|
|
|
typedef struct ssl_ic_args_st {
|
|
SV *cb;
|
|
SV *arg;
|
|
} SSL_IC_ARGS;
|
|
|
|
static void p5_ssl_info_callback(ssl,mode,ret)
|
|
SSL *ssl;
|
|
int mode;
|
|
int ret;
|
|
{
|
|
int i;
|
|
SV *me,*cb;
|
|
|
|
me=(SV *)SSL_get_ex_data(ssl,p5_ssl_ex_ssl_ptr);
|
|
cb=(SV *)SSL_get_ex_data(ssl,p5_ssl_ex_ssl_info_callback);
|
|
if (cb == NULL)
|
|
cb=(SV *)SSL_CTX_get_ex_data(
|
|
SSL_get_SSL_CTX(ssl),p5_ssl_ctx_ex_ssl_info_callback);
|
|
if (cb != NULL)
|
|
{
|
|
dSP;
|
|
|
|
PUSHMARK(sp);
|
|
XPUSHs(me);
|
|
XPUSHs(sv_2mortal(newSViv(mode)));
|
|
XPUSHs(sv_2mortal(newSViv(ret)));
|
|
PUTBACK;
|
|
|
|
i=perl_call_sv(cb,G_DISCARD);
|
|
}
|
|
else
|
|
{
|
|
croak("Internal error in SSL p5_ssl_info_callback");
|
|
}
|
|
}
|
|
|
|
int boot_ssl()
|
|
{
|
|
p5_ssl_ex_ssl_ptr=
|
|
SSL_get_ex_new_index(0,"OpenSSL::SSL",ex_new,NULL,ex_cleanup);
|
|
p5_ssl_ex_ssl_info_callback=
|
|
SSL_get_ex_new_index(0,"ssl_info_callback",NULL,NULL,
|
|
ex_cleanup);
|
|
p5_ssl_ex_ssl_ctx_ptr=
|
|
SSL_get_ex_new_index(0,"ssl_ctx_ptr",NULL,NULL,
|
|
ex_cleanup);
|
|
p5_ssl_ctx_ex_ssl_info_callback=
|
|
SSL_CTX_get_ex_new_index(0,"ssl_ctx_info_callback",NULL,NULL,
|
|
ex_cleanup);
|
|
return(1);
|
|
}
|
|
|
|
MODULE = OpenSSL::SSL PACKAGE = OpenSSL::SSL::CTX PREFIX = p5_SSL_CTX_
|
|
|
|
PROTOTYPES: ENABLE
|
|
VERSIONCHECK: DISABLE
|
|
|
|
void
|
|
p5_SSL_CTX_new(...)
|
|
PREINIT:
|
|
SSL_METHOD *meth;
|
|
SSL_CTX *ctx;
|
|
char *method;
|
|
PPCODE:
|
|
pr_name("p5_SSL_CTX_new");
|
|
if ((items == 1) && SvPOK(ST(0)))
|
|
method=SvPV_nolen(ST(0));
|
|
else if ((items == 2) && SvPOK(ST(1)))
|
|
method=SvPV_nolen(ST(1));
|
|
else
|
|
croak("Usage: OpenSSL::SSL::CTX::new(type)");
|
|
|
|
if (strcmp(method,"SSLv3") == 0)
|
|
meth=SSLv3_method();
|
|
else if (strcmp(method,"SSLv3_client") == 0)
|
|
meth=SSLv3_client_method();
|
|
else if (strcmp(method,"SSLv3_server") == 0)
|
|
meth=SSLv3_server_method();
|
|
else if (strcmp(method,"SSLv23") == 0)
|
|
meth=SSLv23_method();
|
|
else if (strcmp(method,"SSLv23_client") == 0)
|
|
meth=SSLv23_client_method();
|
|
else if (strcmp(method,"SSLv23_server") == 0)
|
|
meth=SSLv23_server_method();
|
|
else if (strcmp(method,"SSLv2") == 0)
|
|
meth=SSLv2_method();
|
|
else if (strcmp(method,"SSLv2_client") == 0)
|
|
meth=SSLv2_client_method();
|
|
else if (strcmp(method,"SSLv2_server") == 0)
|
|
meth=SSLv2_server_method();
|
|
else if (strcmp(method,"TLSv1") == 0)
|
|
meth=TLSv1_method();
|
|
else if (strcmp(method,"TLSv1_client") == 0)
|
|
meth=TLSv1_client_method();
|
|
else if (strcmp(method,"TLSv1_server") == 0)
|
|
meth=TLSv1_server_method();
|
|
else
|
|
{
|
|
croak("Not a valid SSL method name, should be 'SSLv[23] [client|server]'");
|
|
}
|
|
EXTEND(sp,1);
|
|
PUSHs(sv_newmortal());
|
|
ctx=SSL_CTX_new(meth);
|
|
sv_setref_pv(ST(0), "OpenSSL::SSL::CTX", (void*)ctx);
|
|
|
|
int
|
|
p5_SSL_CTX_use_PrivateKey_file(ctx,file,...)
|
|
SSL_CTX *ctx;
|
|
char *file;
|
|
PREINIT:
|
|
int i=SSL_FILETYPE_PEM;
|
|
char *ptr;
|
|
CODE:
|
|
pr_name("p5_SSL_CTX_use_PrivateKey_file");
|
|
if (items > 3)
|
|
croak("OpenSSL::SSL::CTX::use_PrivateKey_file(ssl_ctx,file[,type])");
|
|
if (items == 3)
|
|
{
|
|
ptr=SvPV_nolen(ST(2));
|
|
if (strcmp(ptr,"der") == 0)
|
|
i=SSL_FILETYPE_ASN1;
|
|
else
|
|
i=SSL_FILETYPE_PEM;
|
|
}
|
|
RETVAL=SSL_CTX_use_RSAPrivateKey_file(ctx,file,i);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
int
|
|
p5_SSL_CTX_set_options(ctx,...)
|
|
SSL_CTX *ctx;
|
|
PREINIT:
|
|
int i;
|
|
char *ptr;
|
|
SV *sv;
|
|
CODE:
|
|
pr_name("p5_SSL_CTX_set_options");
|
|
|
|
for (i=1; i<items; i++)
|
|
{
|
|
if (!SvPOK(ST(i)))
|
|
croak("Usage: OpenSSL::SSL_CTX::set_options(ssl_ctx[,option,value]+)");
|
|
ptr=SvPV_nolen(ST(i));
|
|
if (strcmp(ptr,"-info_callback") == 0)
|
|
{
|
|
SSL_CTX_set_info_callback(ctx,
|
|
p5_ssl_info_callback);
|
|
sv=sv_mortalcopy(ST(i+1));
|
|
SvREFCNT_inc(sv);
|
|
SSL_CTX_set_ex_data(ctx,
|
|
p5_ssl_ctx_ex_ssl_info_callback,
|
|
(char *)sv);
|
|
i++;
|
|
}
|
|
else
|
|
{
|
|
croak("OpenSSL::SSL_CTX::set_options(): unknown option");
|
|
}
|
|
}
|
|
|
|
void
|
|
p5_SSL_CTX_DESTROY(ctx)
|
|
SSL_CTX *ctx
|
|
PREINIT:
|
|
SV *sv;
|
|
PPCODE:
|
|
pr_name_d("p5_SSL_CTX_DESTROY",ctx->references);
|
|
SSL_CTX_free(ctx);
|
|
|
|
MODULE = OpenSSL::SSL PACKAGE = OpenSSL::SSL PREFIX = p5_SSL_
|
|
|
|
void
|
|
p5_SSL_new(...)
|
|
PREINIT:
|
|
SV *sv_ctx;
|
|
SSL_CTX *ctx;
|
|
SSL *ssl;
|
|
SV *arg;
|
|
PPCODE:
|
|
pr_name("p5_SSL_new");
|
|
if ((items != 1) && (items != 2))
|
|
croak("Usage: OpenSSL::SSL::new(ssl_ctx)");
|
|
if (sv_derived_from(ST(items-1),"OpenSSL::SSL::CTX"))
|
|
{
|
|
IV tmp = SvIV((SV*)SvRV(ST(items-1)));
|
|
ctx=(SSL_CTX *)tmp;
|
|
sv_ctx=ST(items-1);
|
|
}
|
|
else
|
|
croak("ssl_ctx is not of type OpenSSL::SSL::CTX");
|
|
|
|
EXTEND(sp,1);
|
|
PUSHs(sv_newmortal());
|
|
ssl=SSL_new(ctx);
|
|
sv_setref_pv(ST(0), "OpenSSL::SSL", (void*)ssl);
|
|
|
|
/* Now this is being a little hairy, we keep a pointer to
|
|
* our perl reference. We need to do a different one
|
|
* to the one we return because it will have its reference
|
|
* count dropped to 0 upon return and if we up its reference
|
|
* count, it will never be DESTROYED */
|
|
arg=newSVsv(ST(0));
|
|
SSL_set_ex_data(ssl,p5_ssl_ex_ssl_ptr,(char *)arg);
|
|
SvREFCNT_inc(sv_ctx);
|
|
SSL_set_ex_data(ssl,p5_ssl_ex_ssl_ctx_ptr,(char *)sv_ctx);
|
|
|
|
int
|
|
p5_SSL_connect(ssl)
|
|
SSL *ssl;
|
|
CODE:
|
|
RETVAL=SSL_connect(ssl);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
int
|
|
p5_SSL_accept(ssl)
|
|
SSL *ssl;
|
|
CODE:
|
|
RETVAL=SSL_connect(ssl);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
int
|
|
p5_SSL_sysread(ssl,in,num, ...)
|
|
SSL *ssl;
|
|
SV *in;
|
|
int num;
|
|
PREINIT:
|
|
int i,n,olen;
|
|
int offset;
|
|
char *p;
|
|
CODE:
|
|
offset=0;
|
|
if (!SvPOK(in))
|
|
sv_setpvn(in,"",0);
|
|
SvPV(in,olen);
|
|
if (items > 3)
|
|
{
|
|
offset=SvIV(ST(3));
|
|
if (offset < 0)
|
|
{
|
|
if (-offset > olen)
|
|
croak("Offset outside string");
|
|
offset+=olen;
|
|
}
|
|
}
|
|
if ((num+offset) > olen)
|
|
{
|
|
SvGROW(in,num+offset+1);
|
|
p=SvPV(in,i);
|
|
memset(&(p[olen]),0,(num+offset)-olen+1);
|
|
}
|
|
p=SvPV(in,n);
|
|
|
|
i=SSL_read(ssl,p+offset,num);
|
|
RETVAL=i;
|
|
if (i <= 0) i=0;
|
|
SvCUR_set(in,offset+i);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
int
|
|
p5_SSL_syswrite(ssl,in, ...)
|
|
SSL *ssl;
|
|
SV *in;
|
|
PREINIT:
|
|
char *ptr;
|
|
int len,in_len;
|
|
int offset=0;
|
|
int n;
|
|
CODE:
|
|
ptr=SvPV(in,in_len);
|
|
if (items > 2)
|
|
{
|
|
len=SvOK(ST(2))?SvIV(ST(2)):in_len;
|
|
if (items > 3)
|
|
{
|
|
offset=SvIV(ST(3));
|
|
if (offset < 0)
|
|
{
|
|
if (-offset > in_len)
|
|
croak("Offset outside string");
|
|
offset+=in_len;
|
|
}
|
|
else if ((offset >= in_len) && (in_len > 0))
|
|
croak("Offset outside string");
|
|
}
|
|
if (len >= (in_len-offset))
|
|
len=in_len-offset;
|
|
}
|
|
else
|
|
len=in_len;
|
|
|
|
RETVAL=SSL_write(ssl,ptr+offset,len);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
void
|
|
p5_SSL_set_bio(ssl,bio)
|
|
SSL *ssl;
|
|
BIO *bio;
|
|
CODE:
|
|
bio->references++;
|
|
SSL_set_bio(ssl,bio,bio);
|
|
|
|
int
|
|
p5_SSL_set_options(ssl,...)
|
|
SSL *ssl;
|
|
PREINIT:
|
|
int i;
|
|
char *ptr;
|
|
SV *sv;
|
|
CODE:
|
|
pr_name("p5_SSL_set_options");
|
|
|
|
for (i=1; i<items; i++)
|
|
{
|
|
if (!SvPOK(ST(i)))
|
|
croak("Usage: OpenSSL::SSL::set_options(ssl[,option,value]+)");
|
|
ptr=SvPV_nolen(ST(i));
|
|
if (strcmp(ptr,"-info_callback") == 0)
|
|
{
|
|
SSL_set_info_callback(ssl,
|
|
p5_ssl_info_callback);
|
|
sv=sv_mortalcopy(ST(i+1));
|
|
SvREFCNT_inc(sv);
|
|
SSL_set_ex_data(ssl,
|
|
p5_ssl_ex_ssl_info_callback,(char *)sv);
|
|
i++;
|
|
}
|
|
else if (strcmp(ptr,"-connect_state") == 0)
|
|
{
|
|
SSL_set_connect_state(ssl);
|
|
}
|
|
else if (strcmp(ptr,"-accept_state") == 0)
|
|
{
|
|
SSL_set_accept_state(ssl);
|
|
}
|
|
else
|
|
{
|
|
croak("OpenSSL::SSL::set_options(): unknown option");
|
|
}
|
|
}
|
|
|
|
void
|
|
p5_SSL_state(ssl)
|
|
SSL *ssl;
|
|
PREINIT:
|
|
int state;
|
|
PPCODE:
|
|
pr_name("p5_SSL_state");
|
|
EXTEND(sp,1);
|
|
PUSHs(sv_newmortal());
|
|
state=SSL_state(ssl);
|
|
sv_setpv(ST(0),SSL_state_string_long(ssl));
|
|
sv_setiv(ST(0),state);
|
|
SvPOK_on(ST(0));
|
|
|
|
void
|
|
p5_SSL_DESTROY(ssl)
|
|
SSL *ssl;
|
|
CODE:
|
|
pr_name_dd("p5_SSL_DESTROY",ssl->references,ssl->ctx->references);
|
|
#ifdef DEBUG
|
|
fprintf(stderr,"SSL_DESTROY %d\n",ssl->references);
|
|
#endif
|
|
SSL_free(ssl);
|
|
|
|
int
|
|
p5_SSL_references(ssl)
|
|
SSL *ssl;
|
|
CODE:
|
|
RETVAL=ssl->references;
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
int
|
|
p5_SSL_do_handshake(ssl)
|
|
SSL *ssl;
|
|
CODE:
|
|
RETVAL=SSL_do_handshake(ssl);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
int
|
|
p5_SSL_renegotiate(ssl)
|
|
SSL *ssl;
|
|
CODE:
|
|
RETVAL=SSL_renegotiate(ssl);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
int
|
|
p5_SSL_shutdown(ssl)
|
|
SSL *ssl;
|
|
CODE:
|
|
RETVAL=SSL_shutdown(ssl);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
char *
|
|
p5_SSL_get_version(ssl)
|
|
SSL *ssl;
|
|
CODE:
|
|
RETVAL=SSL_get_version(ssl);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
SSL_CIPHER *
|
|
p5_SSL_get_current_cipher(ssl)
|
|
SSL *ssl;
|
|
CODE:
|
|
RETVAL=SSL_get_current_cipher(ssl);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
X509 *
|
|
p5_SSL_get_peer_certificate(ssl)
|
|
SSL *ssl
|
|
CODE:
|
|
RETVAL=SSL_get_peer_certificate(ssl);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
MODULE = OpenSSL::SSL PACKAGE = OpenSSL::SSL::CIPHER PREFIX = p5_SSL_CIPHER_
|
|
|
|
int
|
|
p5_SSL_CIPHER_get_bits(sc)
|
|
SSL_CIPHER *sc
|
|
PREINIT:
|
|
int i,ret;
|
|
PPCODE:
|
|
EXTEND(sp,2);
|
|
PUSHs(sv_newmortal());
|
|
PUSHs(sv_newmortal());
|
|
ret=SSL_CIPHER_get_bits(sc,&i);
|
|
sv_setiv(ST(0),(IV)ret);
|
|
sv_setiv(ST(1),(IV)i);
|
|
|
|
char *
|
|
p5_SSL_CIPHER_get_version(sc)
|
|
SSL_CIPHER *sc
|
|
CODE:
|
|
RETVAL=SSL_CIPHER_get_version(sc);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
char *
|
|
p5_SSL_CIPHER_get_name(sc)
|
|
SSL_CIPHER *sc
|
|
CODE:
|
|
RETVAL=SSL_CIPHER_get_name(sc);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
MODULE = OpenSSL::SSL PACKAGE = OpenSSL::BIO PREFIX = p5_BIO_
|
|
|
|
void
|
|
p5_BIO_get_ssl(bio)
|
|
BIO *bio;
|
|
PREINIT:
|
|
SSL *ssl;
|
|
SV *ret;
|
|
int i;
|
|
PPCODE:
|
|
if ((i=BIO_get_ssl(bio,&ssl)) > 0)
|
|
{
|
|
ret=(SV *)SSL_get_ex_data(ssl,p5_ssl_ex_ssl_ptr);
|
|
ret=sv_mortalcopy(ret);
|
|
}
|
|
else
|
|
ret= &PL_sv_undef;
|
|
EXTEND(sp,1);
|
|
PUSHs(ret);
|
|
|