|  |  | 
|  | #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(ST(0),na); | 
|  | else if ((items == 2) && SvPOK(ST(1))) | 
|  | method=SvPV(ST(1),na); | 
|  | 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(ST(2),na); | 
|  | 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(ST(i),na); | 
|  | 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(ST(i),na); | 
|  | 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= &sv_undef; | 
|  | EXTEND(sp,1); | 
|  | PUSHs(ret); | 
|  |  |