From: Ralf S. Engelschall Date: Mon, 8 Mar 1999 11:25:49 +0000 (+0000) Subject: Second round of fixing the OpenSSL perl/ stuff. It now at least compiled fine X-Git-Tag: OpenSSL_0_9_2b~57 X-Git-Url: https://git.openssl.org/?p=openssl.git;a=commitdiff_plain;h=84107e6ca812b1325907596b6a5bfa9080a16a92;hp=9ea0e64de71d8b7c197a4abbf59f85bf9d0db9d4 Second round of fixing the OpenSSL perl/ stuff. It now at least compiled fine under Unix and passes some trivial tests I've now added. But the whole stuff is horribly incomplete, so a README.1ST with a disclaimer was added to make sure no one expects that this stuff really works in the OpenSSL 0.9.2 release. Additionally I've started to clean the XS sources up and fixed a few little bugs and inconsistencies in OpenSSL.{pm,xs} and openssl_bio.xs. PS: I'm still not convinces whether we should try to make this finally running or kick it out and replace it with some other module.... --- diff --git a/CHANGES b/CHANGES index 3d052f4998..64be2d5ab7 100644 --- a/CHANGES +++ b/CHANGES @@ -5,6 +5,15 @@ Changes between 0.9.1c and 0.9.2 + *) Second round of fixing the OpenSSL perl/ stuff. It now at least compiled + fine under Unix and passes some trivial tests I've now added. But the + whole stuff is horribly incomplete, so a README.1ST with a disclaimer was + added to make sure no one expects that this stuff really works in the + OpenSSL 0.9.2 release. Additionally I've started to clean the XS sources + up and fixed a few little bugs and inconsistencies in OpenSSL.{pm,xs} and + openssl_bio.xs. + [Ralf S. Engelschall] + *) Fix the generation of two part addresses in perl. [Kenji Miyake , integrated by Ben Laurie] diff --git a/perl/MANIFEST b/perl/MANIFEST index 6acbc10af4..a7046cf28c 100644 --- a/perl/MANIFEST +++ b/perl/MANIFEST @@ -1,3 +1,4 @@ +README.1ST MANIFEST Makefile.PL typemap @@ -12,3 +13,6 @@ openssl_err.xs openssl_ssl.xs openssl_x509.xs openssl_cb.c +t/01-use.t +t/02-version.t +t/03-bio.t diff --git a/perl/Makefile.PL b/perl/Makefile.PL index 77d5af5f21..1f0c44abbf 100644 --- a/perl/Makefile.PL +++ b/perl/Makefile.PL @@ -2,14 +2,19 @@ ## Makefile.PL -- Perl MakeMaker specification ## +$V = '0.9.2'; +print "Configuring companion Perl module for OpenSSL $V\n"; + use ExtUtils::MakeMaker; WriteMakefile( 'OPTIMIZE' => '', - 'DISTNAME' => 'OpenSSL-0.9.2', + 'DISTNAME' => "openssl-$V", 'NAME' => 'OpenSSL', 'VERSION_FROM' => 'OpenSSL.pm', - 'LIBS' => ['-L.. -lssl -lcrypto'], + 'LIBS' => ( $^O eq 'MSWin32' + ? [ '-L../out32dll -lssleay32 -llibeay32' ] + : [ '-L.. -lssl -lcrypto' ] ), 'DEFINE' => '', 'INC' => '-I../include', 'H' => ['openssl.h'], diff --git a/perl/OpenSSL.pm b/perl/OpenSSL.pm index 21c05a44cf..8f5aae3e9e 100644 --- a/perl/OpenSSL.pm +++ b/perl/OpenSSL.pm @@ -4,77 +4,87 @@ package OpenSSL; +require 5.000; use Exporter; use DynaLoader; -@ISA = qw(Exporter DynaLoader); +@ISA = qw(Exporter DynaLoader); @EXPORT = qw(); -$VERSION='0.92'; -bootstrap penSSL; - -@OpenSSL::BN::ISA= qw(OpenSSL::ERR); -@OpenSSL::MD::ISA= qw(OpenSSL::ERR); -@OpenSSL::Cipher::ISA= qw(OpenSSL::ERR); -@OpenSSL::SSL::CTX::ISA= qw(OpenSSL::ERR); -@OpenSSL::BIO::ISA= qw(OpenSSL::ERR); -@OpenSSL::SSL::ISA= qw(OpenSSL::ERR); - -@BN::ISA= qw(OpenSSL::BN); -@MD::ISA= qw(OpenSSL::MD); -@Cipher::ISA= qw(OpenSSL::Cipher); -@SSL::ISA= qw(OpenSSL::SSL); -@SSL::CTX::ISA= qw(OpenSSL::SSL::CTX); -@BIO::ISA= qw(OpenSSL::BIO); - -@OpenSSL::MD::names=qw(md2 md5 sha sha1 ripemd160 mdc2); - -@OpenSSL::Cipher::names=qw( - des-ecb des-cfb des-ofb des-cbc - des-ede des-ede-cfb des-ede-ofb des-ede-cbc - des-ede3 des-ede3-cfb des-ede3-ofb des-ede3-cbc - desx-cbc rc4 rc4-40 - idea-ecb idea-cfb idea-ofb idea-cbc - rc2-ecb rc2-cbc rc2-40-cbc rc2-cfb rc2-ofb - bf-ecb bf-cfb bf-ofb bf-cbc - cast5-ecb cast5-cfb cast5-ofb cast5-cbc - rc5-ecb rc5-cfb rc5-ofb rc5-cbc - ); - -sub OpenSSL::SSL::CTX::new_ssl { OpenSSL::SSL::new($_[0]); } - -sub OpenSSL::ERR::error - { - my($o)=@_; - my($s,$ret); - - while (($s=$o->get_error()) != 0) - { - $ret.=$s."\n"; - } - return($ret); - } - -@OpenSSL::Cipher::aliases=qw(des desx des3 idea rc2 bf cast); +$VERSION = '0.92'; +bootstrap OpenSSL; + +@OpenSSL::BN::ISA = qw(OpenSSL::ERR); +@OpenSSL::MD::ISA = qw(OpenSSL::ERR); +@OpenSSL::Cipher::ISA = qw(OpenSSL::ERR); +@OpenSSL::SSL::CTX::ISA = qw(OpenSSL::ERR); +@OpenSSL::BIO::ISA = qw(OpenSSL::ERR); +@OpenSSL::SSL::ISA = qw(OpenSSL::ERR); + +@BN::ISA = qw(OpenSSL::BN); +@MD::ISA = qw(OpenSSL::MD); +@Cipher::ISA = qw(OpenSSL::Cipher); +@SSL::ISA = qw(OpenSSL::SSL); +@SSL::CTX::ISA = qw(OpenSSL::SSL::CTX); +@BIO::ISA = qw(OpenSSL::BIO); + +@OpenSSL::MD::names = qw( + md2 md5 sha sha1 ripemd160 mdc2 +); + +@OpenSSL::Cipher::names = qw( + des-ecb des-cfb des-ofb des-cbc + des-ede des-ede-cfb des-ede-ofb des-ede-cbc + des-ede3 des-ede3-cfb des-ede3-ofb des-ede3-cbc + desx-cbc rc4 rc4-40 + idea-ecb idea-cfb idea-ofb idea-cbc + rc2-ecb rc2-cbc rc2-40-cbc rc2-cfb rc2-ofb + bf-ecb bf-cfb bf-ofb bf-cbc + cast5-ecb cast5-cfb cast5-ofb cast5-cbc + rc5-ecb rc5-cfb rc5-ofb rc5-cbc +); + +sub OpenSSL::SSL::CTX::new_ssl { + OpenSSL::SSL::new($_[0]); +} + +sub OpenSSL::ERR::error { + my($o) = @_; + my($s, $ret); + + while (($s = $o->get_error()) != 0) { + $ret.=$s."\n"; + } + return($ret); +} + +@OpenSSL::Cipher::aliases = qw( + des desx des3 idea rc2 bf cast +); package OpenSSL::BN; -sub bnfix { (ref($_[0]) ne "OpenSSL::BN")?OpenSSL::BN::dec2bn($_[0]):$_[0]; } +sub bnfix { + (ref($_[0]) ne "OpenSSL::BN") ? OpenSSL::BN::dec2bn($_[0]) : $_[0]; +} + use overload -"=" => sub { dup($_[0]); }, -"+" => sub { add($_[0],$_[1]); }, -"-" => sub { ($_[1],$_[0])=($_[0],$_[1]) if $_[2]; - OpenSSL::BN::sub($_[0],$_[1]); }, -"*" => sub { mul($_[0],$_[1]); }, -"/" => sub { ($_[1],$_[0])=($_[0],$_[1]) if $_[2]; (div($_[0],$_[1]))[0]; }, -"%" => sub { ($_[1],$_[0])=($_[0],$_[1]) if $_[2]; mod($_[0],$_[1]); }, -"**" => sub { ($_[1],$_[0])=($_[0],$_[1]) if $_[2]; exp($_[0],$_[1]); }, -"<<" => sub { lshift($_[0],$_[1]); }, -">>" => sub { rshift($_[0],$_[1]); }, -"<=>" => sub { OpenSSL::BN::cmp($_[0],$_[1]); }, -'""' => sub { bn2dec($_[0]); }, -'0+' => sub { dec2bn($_[0]); }, +"=" => sub { dup($_[0]); }, +"+" => sub { add($_[0],$_[1]); }, +"-" => sub { ($_[1],$_[0])=($_[0],$_[1]) if $_[2]; OpenSSL::BN::sub($_[0],$_[1]); }, +"*" => sub { mul($_[0],$_[1]); }, +"**" => sub { ($_[1],$_[0])=($_[0],$_[1]) if $_[2]; OpenSSL::BN::exp($_[0],$_[1]); }, +"/" => sub { ($_[1],$_[0])=($_[0],$_[1]) if $_[2]; (div($_[0],$_[1]))[0]; }, +"%" => sub { ($_[1],$_[0])=($_[0],$_[1]) if $_[2]; mod($_[0],$_[1]); }, +"<<" => sub { lshift($_[0],$_[1]); }, +">>" => sub { rshift($_[0],$_[1]); }, +"<=>" => sub { OpenSSL::BN::cmp($_[0],$_[1]); }, +'""' => sub { bn2dec($_[0]); }, +'0+' => sub { dec2bn($_[0]); }, "bool" => sub { ref($_[0]) eq "OpenSSL::BN"; }; -sub OpenSSL::BIO::do_accept { OpenSSL::BIO::do_handshake(@_); } +sub OpenSSL::BIO::do_accept { + OpenSSL::BIO::do_handshake(@_); +} + 1; diff --git a/perl/OpenSSL.xs b/perl/OpenSSL.xs index 6a975be515..9af3113f76 100644 --- a/perl/OpenSSL.xs +++ b/perl/OpenSSL.xs @@ -4,66 +4,77 @@ #include "openssl.h" -SV *new_ref(type,obj,mort) -char *type; -char *obj; - { - SV *ret; +SV * +new_ref(type, obj, mort) + char *type; + char *obj; +{ + SV *ret; - if (mort) - ret=sv_newmortal(); - else - ret=newSViv(0); -printf(">new_ref %d\n",type); - sv_setref_pv(ret,type,(void *)obj); - return(ret); - } + if (mort) + ret = sv_newmortal(); + else + ret = newSViv(0); +#ifdef DEBUG + printf(">new_ref %d\n",type); +#endif + sv_setref_pv(ret, type, (void *)obj); + return(ret); +} -int ex_new(obj,data,ad,idx,argl,argp) -char *obj; -SV *data; -CRYPTO_EX_DATA *ad; -int idx; -long argl; -char *argp; - { - SV *sv; +int +ex_new(obj, data, ad, idx, argl, argp) + char *obj; + SV *data; + CRYPTO_EX_DATA *ad; + int idx; + long argl; + char *argp; +{ + SV *sv; -fprintf(stderr,"ex_new %08X %s\n",obj,argp); - sv=sv_newmortal(); - sv_setref_pv(sv,argp,(void *)obj); -printf("%d>new_ref '%s'\n",sv,argp); - CRYPTO_set_ex_data(ad,idx,(char *)sv); - return(1); - } +#ifdef DEBUG + printf("ex_new %08X %s\n",obj,argp); +#endif + sv = sv_newmortal(); + sv_setref_pv(sv, argp, (void *)obj); +#ifdef DEBUG + printf("%d>new_ref '%s'\n", sv, argp); +#endif + CRYPTO_set_ex_data(ad, idx, (char *)sv); + return(1); +} -void ex_cleanup(obj,data,ad,idx,argl,argp) -char *obj; -SV *data; -CRYPTO_EX_DATA *ad; -int idx; -long argl; -char *argp; - { - pr_name("ex_cleanup"); -fprintf(stderr,"ex_cleanup %08X %s\n",obj,argp); - if (data != NULL) - SvREFCNT_dec((SV *)data); - } +void +ex_cleanup(obj, data, ad, idx, argl, argp) + char *obj; + SV *data; + CRYPTO_EX_DATA *ad; + int idx; + long argl; + char *argp; +{ + pr_name("ex_cleanup"); +#ifdef DEBUG + printf("ex_cleanup %08X %s\n", obj, argp); +#endif + if (data != NULL) + SvREFCNT_dec((SV *)data); +} -MODULE = OpenSSL PACKAGE = OpenSSL +MODULE = OpenSSL PACKAGE = OpenSSL BOOT: - boot_bio(); - boot_cipher(); - boot_digest(); - boot_err(); - boot_ssl(); - boot_OpenSSL__BN(); - boot_OpenSSL__BIO(); - boot_OpenSSL__Cipher(); - boot_OpenSSL__MD(); - boot_OpenSSL__ERR(); - boot_OpenSSL__SSL(); - boot_OpenSSL__X509(); + boot_bio(); + boot_cipher(); + boot_digest(); + boot_err(); + boot_ssl(); + boot_OpenSSL__BN(); + boot_OpenSSL__BIO(); + boot_OpenSSL__Cipher(); + boot_OpenSSL__MD(); + boot_OpenSSL__ERR(); + boot_OpenSSL__SSL(); + boot_OpenSSL__X509(); diff --git a/perl/README.1ST b/perl/README.1ST new file mode 100644 index 0000000000..7b5a1aa5e9 --- /dev/null +++ b/perl/README.1ST @@ -0,0 +1,4 @@ + + WARNING, this Perl interface to OpenSSL is horrible incomplete. + Don't expect it to be really useable!! + diff --git a/perl/openssl.h b/perl/openssl.h index 299d10e372..d1b6489ea7 100644 --- a/perl/openssl.h +++ b/perl/openssl.h @@ -58,18 +58,19 @@ #ifdef __cplusplus extern "C" { #endif + #include "EXTERN.h" #include "perl.h" #include "XSUB.h" + #ifdef __cplusplus } #endif -typedef struct datum_st - { - char *dptr; - int dsize; - } datum; +typedef struct datum_st { + char *dptr; + int dsize; +} datum; #include "crypto.h" #include "buffer.h" @@ -79,10 +80,10 @@ typedef struct datum_st #include "x509.h" #include "ssl.h" -#if 0 -#define pr_name(name) printf("%s\n",name) -#define pr_name_d(name,p2) printf("%s %d\n",name,p2) -#define pr_name_dd(name,p2,p3) printf("%s %d %d\n",name,p2,p3) +#ifdef DEBUG +#define pr_name(name) printf("%s\n",name) +#define pr_name_d(name,p2) printf("%s %d\n",name,p2) +#define pr_name_dd(name,p2,p3) printf("%s %d %d\n",name,p2,p3) #else #define pr_name(name) #define pr_name_d(name,p2) @@ -90,7 +91,6 @@ typedef struct datum_st #endif SV *new_ref(char *type, char *obj, int mort); -int ex_new(char *obj,SV *data,CRYPTO_EX_DATA *ad,int idx,long argl,char *argp); -void ex_cleanup(char *obj,SV *data,CRYPTO_EX_DATA *ad,int idx, - long argl,char *argp); +int ex_new(char *obj, SV *data, CRYPTO_EX_DATA *ad, int idx, long argl, char *argp); +void ex_cleanup(char *obj, SV *data, CRYPTO_EX_DATA *ad, int idx, long argl, char *argp); diff --git a/perl/openssl_bio.xs b/perl/openssl_bio.xs index 9e204a9f66..346ead441f 100644 --- a/perl/openssl_bio.xs +++ b/perl/openssl_bio.xs @@ -1,451 +1,449 @@ #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(newSViv(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,"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_ +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(...) - 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); - + 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(...) - 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); - + 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(...) - 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,"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=(SV *)BIO_get_ex_data(bio,p5_bio_ex_bio_ptr); - PUSHs(arg); + 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; - CODE: - RETVAL=BIO_set_conn_hostname(bio,name); - OUTPUT: - RETVAL +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; - CODE: - RETVAL=BIO_set_accept_port(bio,str); - OUTPUT: - RETVAL +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; - CODE: - RETVAL=BIO_do_handshake(bio); - OUTPUT: - RETVAL + BIO *bio; + PROTOTYPE: $ + 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 OpenSSL library by the BIO with this - * pushed into */ - bio->references++; - RETVAL=BIO_push(b,bio); - OUTPUT: - RETVAL +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 - 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); -#if 0 /* This does not need to be done. */ - if (bio->references < 1) - abort(); - /* decrement the reference count */ - BIO_free(bio); -#endif - } - } + 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; - 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 +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; - 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 +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; - 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); + 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; - CODE: - RETVAL=BIO_flush(bio); - OUTPUT: - RETVAL + BIO *bio; + PROTOTYPE: $ + CODE: + RETVAL = BIO_flush(bio); + OUTPUT: + RETVAL char * p5_BIO_type(bio) - BIO *bio; - CODE: - RETVAL=bio->method->name; - OUTPUT: - RETVAL + BIO *bio; + PROTOTYPE: $ + 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("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); - } - } + 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; - PREINIT: - char *ptr; - CODE: - ptr=SvPV(in,na); - RETVAL=BIO_puts(bio,ptr); - OUTPUT: - RETVAL +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; - 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); +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 - 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); + 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; - CODE: - pr_name("p5_BIO_set_ssl"); - ssl->references++; - RETVAL=BIO_set_ssl(bio,ssl,BIO_CLOSE); - OUTPUT: - RETVAL +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; - CODE: - RETVAL=BIO_number_read(bio); - OUTPUT: - RETVAL + BIO *bio; + PROTOTYPE: $ + CODE: + RETVAL = BIO_number_read(bio); + OUTPUT: + RETVAL int p5_BIO_number_written(bio) - BIO *bio; - CODE: - RETVAL=BIO_number_written(bio); - OUTPUT: - RETVAL + BIO *bio; + PROTOTYPE: $ + CODE: + RETVAL = BIO_number_written(bio); + OUTPUT: + RETVAL int p5_BIO_references(bio) - BIO *bio; - CODE: - RETVAL=bio->references; - OUTPUT: - RETVAL + BIO *bio; + PROTOTYPE: $ + CODE: + RETVAL = bio->references; + OUTPUT: + RETVAL diff --git a/perl/t/01-use.t b/perl/t/01-use.t new file mode 100644 index 0000000000..e24fd1f504 --- /dev/null +++ b/perl/t/01-use.t @@ -0,0 +1,13 @@ + +BEGIN { + $| = 1; + print "1..1\n"; +} +END { + print "not ok 1\n" unless $loaded; +} +use OpenSSL; +$loaded = 1; +print "ok 1\n"; + + diff --git a/perl/t/02-version.t b/perl/t/02-version.t new file mode 100644 index 0000000000..8b5f6a0c97 --- /dev/null +++ b/perl/t/02-version.t @@ -0,0 +1,10 @@ + +print "1..1\n"; +use OpenSSL; +if ($OpenSSL::VERSION ne '') { + print "ok 1\n"; +} +else { + print "not ok 1\n"; +} + diff --git a/perl/t/03-bio.t b/perl/t/03-bio.t new file mode 100644 index 0000000000..e3ed7ed842 --- /dev/null +++ b/perl/t/03-bio.t @@ -0,0 +1,16 @@ + +BEGIN { + $| = 1; + print "1..1\n"; +} +END { + print "not ok 1\n" unless $ok; +} + +use OpenSSL; +my $bio = OpenSSL::BIO::new("mem") || die; +undef $bio; + +$ok = 1; +print "ok 1\n"; +