| |
| #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_ |
| |
| 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 decememted. */ |
| 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 |
| |
