openssl/perl/openssl_bio.xs

#include "p5SSLeay.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(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(&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 SSL p5_ssl_info_callback");
		}
	return(ret);
	}

int boot_bio()
	{
	p5_bio_ex_bio_ptr=
		BIO_get_ex_new_index(0,"SSLeay::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 =  SSLeay::BIO	PACKAGE = SSLeay::BIO PREFIX = p5_BIO_

VERSIONCHECK: DISABLE

void
p5_BIO_new_buffer_ssl_connect(...)
	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,"SSLeay::SSL::CTX")))
			croak("Usage: SSLeay::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=new_ref("SSLeay::BIO",(char *)bio,0);
		PUSHs(arg);
		BIO_set_ex_data(bio,p5_bio_ex_bio_ptr,(char *)arg);

void
p5_BIO_new_ssl_connect(...)
	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,"SSLeay::SSL::CTX")))
			croak("Usage: SSLeay::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=new_ref("SSLeay::BIO",(char *)bio,0);
		PUSHs(arg);
		BIO_set_ex_data(bio,p5_bio_ex_bio_ptr,(char *)arg);

void
p5_BIO_new(...)
	PREINIT:
		BIO *bio;
		char *type;
		SV *arg;
	PPCODE:
		pr_name("p5_BIO_new");
		if ((items == 1) && SvPOK(ST(0)))
			type=SvPV(ST(0),na);
		else if ((items == 2) && SvPOK(ST(1)))
			type=SvPV(ST(1),na);
		else
			croak("Usage: SSLeay::BIO::new(type)");

		EXTEND(sp,1);
		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,"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=new_ref("SSLeay::BIO",(char *)bio,0);
		PUSHs(arg);
		BIO_set_ex_data(bio,p5_bio_ex_bio_ptr,(char *)arg);

int
p5_BIO_hostname(bio,name)
	BIO *bio;
	char *name;
	CODE:
		RETVAL=BIO_set_hostname(bio,name);
	OUTPUT:
		RETVAL

int
p5_BIO_set_accept_port(bio,str)
	BIO *bio;
	char *str;
	CODE:
		RETVAL=BIO_set_accept_port(bio,str);
	OUTPUT:
		RETVAL

int
p5_BIO_do_handshake(bio)
	BIO *bio;
	CODE:
		RETVAL=BIO_do_handshake(bio);
	OUTPUT:
		RETVAL

BIO *
p5_BIO_push(b,bio)
	BIO *b;
	BIO *bio;
	CODE:
		/* This reference will be reduced when the reference is
		 * let go, and then when the BIO_free_all() is called
		 * inside the SSLeay library by the BIO with this
		 * pushed into */
		bio->references++;
		RETVAL=BIO_push(b,bio);
	OUTPUT:
		RETVAL

void
p5_BIO_pop(b)
	BIO *b
	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 SSLeay.  For the 'pushed in', it needs
			 * the reference count decememted. */
			arg=(SV *)BIO_get_ex_data(bio,p5_bio_ex_bio_ptr);
			if (arg == NULL)
				{
				arg=new_ref("SSLeay::BIO",(char *)bio,0);
				PUSHs(arg);
				BIO_set_ex_data(bio,p5_bio_ex_bio_ptr,(char *)arg);
				}
			else
				{
				/* it was pushed in */
				SvREFCNT_inc(arg);
				PUSHs(arg);
				if (bio->references < 1)
					abort();
				/* decrement the reference count */
				BIO_free(bio);
				}
			}

int
p5_BIO_sysread(bio,in,num, ...)
	BIO *bio;
	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)
					croad("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;
	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;
	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(ST(0),na);
		i=BIO_gets(bio,p,1024);
		if (i < 0) i=0;
		SvCUR_set(ST(0),i);

int
p5_BIO_flush(bio)
	BIO *bio;
	CODE:
		RETVAL=BIO_flush(bio);
	OUTPUT:
		RETVAL

char *
p5_BIO_type(bio)
	BIO *bio;
	CODE:
		RETVAL=bio->method->name;
	OUTPUT:
		RETVAL

void
p5_BIO_next_bio(b)
	BIO *b
	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("SSLeay::BIO",(char *)bio,0);
				PUSHs(arg);
				BIO_set_ex_data(bio,p5_bio_ex_bio_ptr,(char *)arg);
				}
			else
				{
				SvREFCNT_inc(arg);
				PUSHs(arg);
				}
			}

int
p5_BIO_puts(bio,in)
	BIO *bio;
	SV *in;
	PREINIT:
		char *ptr;
	CODE:
		ptr=SvPV(in,na);
		RETVAL=BIO_puts(bio,ptr);
	OUTPUT:
		RETVAL

void
p5_BIO_set_callback(bio,cb,...)
	BIO *bio;
	SV *cb;
	PREINIT:
		SV *arg=NULL;
		SV *arg2=NULL;
	CODE:
		if (items > 3)
			croak("Usage: SSLeay::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);
		BIO_set_callback(bio,p5_bio_callback);

void
p5_BIO_DESTROY(bio)
	BIO *bio
	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;
	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;
	CODE:
		RETVAL=BIO_number_read(bio);
	OUTPUT:
		RETVAL

int
p5_BIO_number_written(bio)
	BIO *bio;
	CODE:
		RETVAL=BIO_number_written(bio);
	OUTPUT:
		RETVAL

int
p5_BIO_references(bio)
	BIO *bio;
	CODE:
		RETVAL=bio->references;	
	OUTPUT:
		RETVAL