openssl/perl/openssl_bio.xs

#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(&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(ST(0),na);
        else if ((items == 2) && SvPOK(ST(1)))
            type = SvPV(ST(1),na);
        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(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;
    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(in,na);
        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