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.
450 lines
11 KiB
Text
450 lines
11 KiB
Text
|
|
#include "openssl.h"
|
|
|
|
static int p5_bio_ex_bio_ptr = 0;
|
|
static int p5_bio_ex_bio_callback = 0;
|
|
static int p5_bio_ex_bio_callback_data = 0;
|
|
|
|
static long
|
|
p5_bio_callback(bio,state,parg,cmd,larg,ret)
|
|
BIO *bio;
|
|
int state;
|
|
char *parg;
|
|
int cmd;
|
|
long larg;
|
|
int ret;
|
|
{
|
|
int i;
|
|
SV *me,*cb;
|
|
|
|
me = (SV *)BIO_get_ex_data(bio, p5_bio_ex_bio_ptr);
|
|
cb = (SV *)BIO_get_ex_data(bio, p5_bio_ex_bio_callback);
|
|
if (cb != NULL) {
|
|
dSP;
|
|
|
|
ENTER;
|
|
SAVETMPS;
|
|
|
|
PUSHMARK(sp);
|
|
XPUSHs(sv_2mortal(newSVsv(me)));
|
|
XPUSHs(sv_2mortal(newSViv(state)));
|
|
XPUSHs(sv_2mortal(newSViv(cmd)));
|
|
if ((state == BIO_CB_READ) || (state == BIO_CB_WRITE))
|
|
XPUSHs(sv_2mortal(newSVpv(parg,larg)));
|
|
else
|
|
XPUSHs(&PL_sv_undef);
|
|
/* ptr one */
|
|
XPUSHs(sv_2mortal(newSViv(larg)));
|
|
XPUSHs(sv_2mortal(newSViv(ret)));
|
|
PUTBACK;
|
|
|
|
i = perl_call_sv(cb,G_SCALAR);
|
|
|
|
SPAGAIN;
|
|
if (i == 1)
|
|
ret = POPi;
|
|
else
|
|
ret = 1;
|
|
PUTBACK;
|
|
FREETMPS;
|
|
LEAVE;
|
|
}
|
|
else {
|
|
croak("Internal error in p5_bio_callback");
|
|
}
|
|
return(ret);
|
|
}
|
|
|
|
int
|
|
boot_bio(void)
|
|
{
|
|
p5_bio_ex_bio_ptr = BIO_get_ex_new_index(0, "OpenSSL::BIO", ex_new, NULL, ex_cleanup);
|
|
p5_bio_ex_bio_callback = BIO_get_ex_new_index(0, "bio_callback", NULL, NULL, ex_cleanup);
|
|
p5_bio_ex_bio_callback_data = BIO_get_ex_new_index(0, "bio_callback_data", NULL, NULL, ex_cleanup);
|
|
return(1);
|
|
}
|
|
|
|
MODULE = OpenSSL::BIO PACKAGE = OpenSSL::BIO PREFIX = p5_BIO_
|
|
|
|
PROTOTYPES: ENABLE
|
|
VERSIONCHECK: DISABLE
|
|
|
|
void
|
|
p5_BIO_new_buffer_ssl_connect(...)
|
|
PROTOTYPE: ;$
|
|
PREINIT:
|
|
SSL_CTX *ctx;
|
|
BIO *bio;
|
|
SV *arg;
|
|
PPCODE:
|
|
if (items == 1)
|
|
arg = ST(0);
|
|
else if (items == 2)
|
|
arg = ST(1);
|
|
else
|
|
arg = NULL;
|
|
if ((arg == NULL) || !(sv_derived_from(arg,"OpenSSL::SSL::CTX")))
|
|
croak("Usage: OpenSSL::BIO::new_buffer_ssl_connect(SSL_CTX)");
|
|
else {
|
|
IV tmp = SvIV((SV *)SvRV(arg));
|
|
ctx = (SSL_CTX *)tmp;
|
|
}
|
|
EXTEND(sp, 1);
|
|
bio = BIO_new_buffer_ssl_connect(ctx);
|
|
arg = (SV *)BIO_get_ex_data(bio, p5_bio_ex_bio_ptr);
|
|
PUSHs(arg);
|
|
|
|
void
|
|
p5_BIO_new_ssl_connect(...)
|
|
PROTOTYPE: ;$
|
|
PREINIT:
|
|
SSL_CTX *ctx;
|
|
BIO *bio;
|
|
SV *arg;
|
|
PPCODE:
|
|
if (items == 1)
|
|
arg = ST(0);
|
|
else if (items == 2)
|
|
arg = ST(1);
|
|
else
|
|
arg = NULL;
|
|
if ((arg == NULL) || !(sv_derived_from(arg,"OpenSSL::SSL::CTX")))
|
|
croak("Usage: OpenSSL::BIO::new_ssl_connect(SSL_CTX)");
|
|
else {
|
|
IV tmp = SvIV((SV *)SvRV(arg));
|
|
ctx = (SSL_CTX *)tmp;
|
|
}
|
|
EXTEND(sp,1);
|
|
bio = BIO_new_ssl_connect(ctx);
|
|
arg = (SV *)BIO_get_ex_data(bio,p5_bio_ex_bio_ptr);
|
|
PUSHs(arg);
|
|
|
|
void
|
|
p5_BIO_new(...)
|
|
PROTOTYPE: ;$
|
|
PREINIT:
|
|
BIO *bio;
|
|
char *type;
|
|
SV *arg;
|
|
PPCODE:
|
|
pr_name("p5_BIO_new");
|
|
if ((items == 1) && SvPOK(ST(0)))
|
|
type = SvPV_nolen(ST(0));
|
|
else if ((items == 2) && SvPOK(ST(1)))
|
|
type = SvPV_nolen(ST(1));
|
|
else
|
|
croak("Usage: OpenSSL::BIO::new(type)");
|
|
EXTEND(sp,1);
|
|
if (strcmp(type, "mem") == 0)
|
|
bio=BIO_new(BIO_s_mem());
|
|
else if (strcmp(type, "socket") == 0)
|
|
bio=BIO_new(BIO_s_socket());
|
|
else if (strcmp(type, "connect") == 0)
|
|
bio=BIO_new(BIO_s_connect());
|
|
else if (strcmp(type, "accept") == 0)
|
|
bio=BIO_new(BIO_s_accept());
|
|
else if (strcmp(type, "fd") == 0)
|
|
bio=BIO_new(BIO_s_fd());
|
|
else if (strcmp(type, "file") == 0)
|
|
bio=BIO_new(BIO_s_file());
|
|
else if (strcmp(type, "null") == 0)
|
|
bio=BIO_new(BIO_s_null());
|
|
else if (strcmp(type, "ssl") == 0)
|
|
bio=BIO_new(BIO_f_ssl());
|
|
else if (strcmp(type, "buffer") == 0)
|
|
bio=BIO_new(BIO_f_buffer());
|
|
else
|
|
croak("unknown BIO type");
|
|
arg = (SV *)BIO_get_ex_data(bio,p5_bio_ex_bio_ptr);
|
|
PUSHs(arg);
|
|
|
|
int
|
|
p5_BIO_hostname(bio, name)
|
|
BIO *bio;
|
|
char *name;
|
|
PROTOTYPE: $$
|
|
CODE:
|
|
RETVAL = BIO_set_conn_hostname(bio, name);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
int
|
|
p5_BIO_set_accept_port(bio, str)
|
|
BIO *bio;
|
|
char *str;
|
|
PROTOTYPE: $$
|
|
CODE:
|
|
RETVAL = BIO_set_accept_port(bio, str);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
int
|
|
p5_BIO_do_handshake(bio)
|
|
BIO *bio;
|
|
PROTOTYPE: $
|
|
CODE:
|
|
RETVAL = BIO_do_handshake(bio);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
BIO *
|
|
p5_BIO_push(b, bio)
|
|
BIO *b;
|
|
BIO *bio;
|
|
PROTOTYPE: $$
|
|
CODE:
|
|
/* This reference will be reduced when the reference is
|
|
* let go, and then when the BIO_free_all() is called
|
|
* inside the OpenSSL library by the BIO with this
|
|
* pushed into */
|
|
bio->references++;
|
|
RETVAL = BIO_push(b, bio);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
void
|
|
p5_BIO_pop(b)
|
|
BIO *b
|
|
PROTOTYPE: $
|
|
PREINIT:
|
|
BIO *bio;
|
|
char *type;
|
|
SV *arg;
|
|
PPCODE:
|
|
bio = BIO_pop(b);
|
|
if (bio != NULL) {
|
|
/* This BIO will either be one created in the
|
|
* perl library, in which case it will have a perl
|
|
* SV, otherwise it will have been created internally,
|
|
* inside OpenSSL. For the 'pushed in', it needs
|
|
* the reference count decremented. */
|
|
arg = (SV *)BIO_get_ex_data(bio, p5_bio_ex_bio_ptr);
|
|
if (arg == NULL) {
|
|
arg = new_ref("OpenSSL::BIO",(char *)bio,0);
|
|
BIO_set_ex_data(bio, p5_bio_ex_bio_ptr, (char *)arg);
|
|
PUSHs(arg);
|
|
}
|
|
else {
|
|
/* it was pushed in */
|
|
SvREFCNT_inc(arg);
|
|
PUSHs(arg);
|
|
}
|
|
}
|
|
|
|
int
|
|
p5_BIO_sysread(bio, in, num, ...)
|
|
BIO *bio;
|
|
SV *in;
|
|
int num;
|
|
PROTOTYPE: $$$;
|
|
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 = BIO_read(bio, p+offset, num);
|
|
RETVAL = i;
|
|
if (i <= 0)
|
|
i = 0;
|
|
SvCUR_set(in, offset+i);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
int
|
|
p5_BIO_syswrite(bio, in, ...)
|
|
BIO *bio;
|
|
SV *in;
|
|
PROTOTYPE: $$;
|
|
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 = BIO_write(bio, ptr+offset, len);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
void
|
|
p5_BIO_getline(bio)
|
|
BIO *bio;
|
|
PROTOTYPE: $
|
|
PREINIT:
|
|
int i;
|
|
char *p;
|
|
PPCODE:
|
|
pr_name("p5_BIO_gets");
|
|
EXTEND(sp, 1);
|
|
PUSHs(sv_newmortal());
|
|
sv_setpvn(ST(0), "", 0);
|
|
SvGROW(ST(0), 1024);
|
|
p=SvPV_nolen(ST(0));
|
|
i = BIO_gets(bio, p, 1024);
|
|
if (i < 0)
|
|
i = 0;
|
|
SvCUR_set(ST(0), i);
|
|
|
|
int
|
|
p5_BIO_flush(bio)
|
|
BIO *bio;
|
|
PROTOTYPE: $
|
|
CODE:
|
|
RETVAL = BIO_flush(bio);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
char *
|
|
p5_BIO_type(bio)
|
|
BIO *bio;
|
|
PROTOTYPE: $
|
|
CODE:
|
|
RETVAL = bio->method->name;
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
void
|
|
p5_BIO_next_bio(b)
|
|
BIO *b
|
|
PROTOTYPE: $
|
|
PREINIT:
|
|
BIO *bio;
|
|
char *type;
|
|
SV *arg;
|
|
PPCODE:
|
|
bio = b->next_bio;
|
|
if (bio != NULL) {
|
|
arg = (SV *)BIO_get_ex_data(bio, p5_bio_ex_bio_ptr);
|
|
if (arg == NULL) {
|
|
arg = new_ref("OpenSSL::BIO", (char *)bio, 0);
|
|
BIO_set_ex_data(bio, p5_bio_ex_bio_ptr, (char *)arg);
|
|
bio->references++;
|
|
PUSHs(arg);
|
|
}
|
|
else {
|
|
SvREFCNT_inc(arg);
|
|
PUSHs(arg);
|
|
}
|
|
}
|
|
|
|
int
|
|
p5_BIO_puts(bio, in)
|
|
BIO *bio;
|
|
SV *in;
|
|
PROTOTYPE: $$
|
|
PREINIT:
|
|
char *ptr;
|
|
CODE:
|
|
ptr = SvPV_nolen(in);
|
|
RETVAL = BIO_puts(bio, ptr);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
void
|
|
p5_BIO_set_callback(bio, cb,...)
|
|
BIO *bio;
|
|
SV *cb;
|
|
PROTOTYPE: $$;
|
|
PREINIT:
|
|
SV *arg = NULL;
|
|
SV *arg2 = NULL;
|
|
CODE:
|
|
if (items > 3)
|
|
croak("Usage: OpenSSL::BIO::set_callback(bio,callback[,arg]");
|
|
if (items == 3) {
|
|
arg2 = sv_mortalcopy(ST(2));
|
|
SvREFCNT_inc(arg2);
|
|
BIO_set_ex_data(bio, p5_bio_ex_bio_callback_data, (char *)arg2);
|
|
}
|
|
arg = sv_mortalcopy(ST(1));
|
|
SvREFCNT_inc(arg);
|
|
BIO_set_ex_data(bio, p5_bio_ex_bio_callback, (char *)arg);
|
|
/* printf("%08lx < bio_ptr\n",BIO_get_ex_data(bio,p5_bio_ex_bio_ptr)); */
|
|
BIO_set_callback(bio, p5_bio_callback);
|
|
|
|
void
|
|
p5_BIO_DESTROY(bio)
|
|
BIO *bio
|
|
PROTOTYPE: $
|
|
PREINIT:
|
|
SV *sv;
|
|
PPCODE:
|
|
pr_name_d("p5_BIO_DESTROY",bio->references);
|
|
/* printf("p5_BIO_DESTROY <%s> %d\n",bio->method->name,bio->references); */
|
|
BIO_set_ex_data(bio,p5_bio_ex_bio_ptr,NULL);
|
|
BIO_free_all(bio);
|
|
|
|
int
|
|
p5_BIO_set_ssl(bio, ssl)
|
|
BIO *bio;
|
|
SSL *ssl;
|
|
PROTOTYPE: $$
|
|
CODE:
|
|
pr_name("p5_BIO_set_ssl");
|
|
ssl->references++;
|
|
RETVAL = BIO_set_ssl(bio, ssl, BIO_CLOSE);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
int
|
|
p5_BIO_number_read(bio)
|
|
BIO *bio;
|
|
PROTOTYPE: $
|
|
CODE:
|
|
RETVAL = BIO_number_read(bio);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
int
|
|
p5_BIO_number_written(bio)
|
|
BIO *bio;
|
|
PROTOTYPE: $
|
|
CODE:
|
|
RETVAL = BIO_number_written(bio);
|
|
OUTPUT:
|
|
RETVAL
|
|
|
|
int
|
|
p5_BIO_references(bio)
|
|
BIO *bio;
|
|
PROTOTYPE: $
|
|
CODE:
|
|
RETVAL = bio->references;
|
|
OUTPUT:
|
|
RETVAL
|
|
|