wbrawner/openssl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
openssl/perl/openssl_ssl.xs
Richard Levitte 95ffe86dbc Perl code patch contributed by "Kurt J. Pires" <kjpires@iat.com> 
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.
2001-02-19 09:29:53 +00:00

483 lines
9.2 KiB
Text
Raw Blame History

#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);
Reference in a new issue View git blame Copy permalink