generic-library/openssl
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Second round of fixing the OpenSSL perl/ stuff. It now at least compiled fine

Browse Source 
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....
This commit is contained in:
Ralf S. Engelschall 1999-03-08 11:25:49 +00:00
parent 9ea0e64de7
commit 84107e6ca8
11 changed files with 587 additions and 507 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
CHANGES
View File

@ -5,6 +5,15 @@
Changes between 0.9.1c and 0.9.2 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. *) Fix the generation of two part addresses in perl.
[Kenji Miyake <kenji@miyake.org>, integrated by Ben Laurie] [Kenji Miyake <kenji@miyake.org>, integrated by Ben Laurie]

4
perl/MANIFEST
View File

@ -1,3 +1,4 @@
README.1ST
MANIFEST MANIFEST
Makefile.PL Makefile.PL
typemap typemap
@ -12,3 +13,6 @@ openssl_err.xs
openssl_ssl.xs openssl_ssl.xs
openssl_x509.xs openssl_x509.xs
openssl_cb.c openssl_cb.c
t/01-use.t
t/02-version.t
t/03-bio.t

9
perl/Makefile.PL
View File

@ -2,14 +2,19 @@
## Makefile.PL -- Perl MakeMaker specification ## Makefile.PL -- Perl MakeMaker specification
## ##
$V = '0.9.2';
print "Configuring companion Perl module for OpenSSL $V\n";
use ExtUtils::MakeMaker; use ExtUtils::MakeMaker;
WriteMakefile( WriteMakefile(
'OPTIMIZE' => '', 'OPTIMIZE' => '',
'DISTNAME' => 'OpenSSL-0.9.2', 'DISTNAME' => "openssl-$V",
'NAME' => 'OpenSSL', 'NAME' => 'OpenSSL',
'VERSION_FROM' => 'OpenSSL.pm', 'VERSION_FROM' => 'OpenSSL.pm',
'LIBS' => ['-L.. -lssl -lcrypto'], 'LIBS' => ( $^O eq 'MSWin32'
? [ '-L../out32dll -lssleay32 -llibeay32' ]
: [ '-L.. -lssl -lcrypto' ] ),
'DEFINE' => '', 'DEFINE' => '',
'INC' => '-I../include', 'INC' => '-I../include',
'H' => ['openssl.h'], 'H' => ['openssl.h'],

118
perl/OpenSSL.pm
View File

@ -4,77 +4,87 @@
package OpenSSL; package OpenSSL;
require 5.000;
use Exporter; use Exporter;
use DynaLoader; use DynaLoader;
@ISA = qw(Exporter DynaLoader); @ISA = qw(Exporter DynaLoader);
@EXPORT = qw(); @EXPORT = qw();
$VERSION='0.92'; $VERSION = '0.92';
bootstrap penSSL; bootstrap OpenSSL;
@OpenSSL::BN::ISA= qw(OpenSSL::ERR); @OpenSSL::BN::ISA = qw(OpenSSL::ERR);
@OpenSSL::MD::ISA= qw(OpenSSL::ERR); @OpenSSL::MD::ISA = qw(OpenSSL::ERR);
@OpenSSL::Cipher::ISA= qw(OpenSSL::ERR); @OpenSSL::Cipher::ISA = qw(OpenSSL::ERR);
@OpenSSL::SSL::CTX::ISA= qw(OpenSSL::ERR); @OpenSSL::SSL::CTX::ISA = qw(OpenSSL::ERR);
@OpenSSL::BIO::ISA= qw(OpenSSL::ERR); @OpenSSL::BIO::ISA = qw(OpenSSL::ERR);
@OpenSSL::SSL::ISA= qw(OpenSSL::ERR); @OpenSSL::SSL::ISA = qw(OpenSSL::ERR);
@BN::ISA= qw(OpenSSL::BN); @BN::ISA = qw(OpenSSL::BN);
@MD::ISA= qw(OpenSSL::MD); @MD::ISA = qw(OpenSSL::MD);
@Cipher::ISA= qw(OpenSSL::Cipher); @Cipher::ISA = qw(OpenSSL::Cipher);
@SSL::ISA= qw(OpenSSL::SSL); @SSL::ISA = qw(OpenSSL::SSL);
@SSL::CTX::ISA= qw(OpenSSL::SSL::CTX); @SSL::CTX::ISA = qw(OpenSSL::SSL::CTX);
@BIO::ISA= qw(OpenSSL::BIO); @BIO::ISA = qw(OpenSSL::BIO);
@OpenSSL::MD::names=qw(md2 md5 sha sha1 ripemd160 mdc2); @OpenSSL::MD::names = qw(
md2 md5 sha sha1 ripemd160 mdc2
);
@OpenSSL::Cipher::names=qw( @OpenSSL::Cipher::names = qw(
des-ecb des-cfb des-ofb des-cbc des-ecb des-cfb des-ofb des-cbc
des-ede des-ede-cfb des-ede-ofb des-ede-cbc des-ede des-ede-cfb des-ede-ofb des-ede-cbc
des-ede3 des-ede3-cfb des-ede3-ofb des-ede3-cbc des-ede3 des-ede3-cfb des-ede3-ofb des-ede3-cbc
desx-cbc rc4 rc4-40 desx-cbc rc4 rc4-40
idea-ecb idea-cfb idea-ofb idea-cbc idea-ecb idea-cfb idea-ofb idea-cbc
rc2-ecb rc2-cbc rc2-40-cbc rc2-cfb rc2-ofb rc2-ecb rc2-cbc rc2-40-cbc rc2-cfb rc2-ofb
bf-ecb bf-cfb bf-ofb bf-cbc bf-ecb bf-cfb bf-ofb bf-cbc
cast5-ecb cast5-cfb cast5-ofb cast5-cbc cast5-ecb cast5-cfb cast5-ofb cast5-cbc
rc5-ecb rc5-cfb rc5-ofb rc5-cbc rc5-ecb rc5-cfb rc5-ofb rc5-cbc
); );
sub OpenSSL::SSL::CTX::new_ssl { OpenSSL::SSL::new($_[0]); } sub OpenSSL::SSL::CTX::new_ssl {
OpenSSL::SSL::new($_[0]);
}
sub OpenSSL::ERR::error sub OpenSSL::ERR::error {
{ my($o) = @_;
my($o)=@_; my($s, $ret);
my($s,$ret);
while (($s=$o->get_error()) != 0) while (($s = $o->get_error()) != 0) {
{ $ret.=$s."\n";
$ret.=$s."\n"; }
} return($ret);
return($ret); }
}
@OpenSSL::Cipher::aliases=qw(des desx des3 idea rc2 bf cast); @OpenSSL::Cipher::aliases = qw(
des desx des3 idea rc2 bf cast
);
package OpenSSL::BN; 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 use overload
"=" => sub { dup($_[0]); }, "=" => sub { dup($_[0]); },
"+" => sub { add($_[0],$_[1]); }, "+" => sub { add($_[0],$_[1]); },
"-" => sub { ($_[1],$_[0])=($_[0],$_[1]) if $_[2]; "-" => sub { ($_[1],$_[0])=($_[0],$_[1]) if $_[2]; OpenSSL::BN::sub($_[0],$_[1]); },
OpenSSL::BN::sub($_[0],$_[1]); }, "*" => sub { mul($_[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]; (div($_[0],$_[1]))[0]; },
"%" => sub { ($_[1],$_[0])=($_[0],$_[1]) if $_[2]; mod($_[0],$_[1]); }, "%" => 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 { lshift($_[0],$_[1]); }, ">>" => sub { rshift($_[0],$_[1]); },
">>" => sub { rshift($_[0],$_[1]); }, "<=>" => sub { OpenSSL::BN::cmp($_[0],$_[1]); },
"<=>" => sub { OpenSSL::BN::cmp($_[0],$_[1]); }, '""' => sub { bn2dec($_[0]); },
'""' => sub { bn2dec($_[0]); }, '0+' => sub { dec2bn($_[0]); },
'0+' => sub { dec2bn($_[0]); },
"bool" => sub { ref($_[0]) eq "OpenSSL::BN"; }; "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; 1;

121
perl/OpenSSL.xs
View File

@ -4,66 +4,77 @@
#include "openssl.h" #include "openssl.h"
SV *new_ref(type,obj,mort) SV *
char *type; new_ref(type, obj, mort)
char *obj; char *type;
{ char *obj;
SV *ret; {
SV *ret;
if (mort) if (mort)
ret=sv_newmortal(); ret = sv_newmortal();
else else
ret=newSViv(0); ret = newSViv(0);
printf(">new_ref %d\n",type); #ifdef DEBUG
sv_setref_pv(ret,type,(void *)obj); printf(">new_ref %d\n",type);
return(ret); #endif
} sv_setref_pv(ret, type, (void *)obj);
return(ret);
}
int ex_new(obj,data,ad,idx,argl,argp) int
char *obj; ex_new(obj, data, ad, idx, argl, argp)
SV *data; char *obj;
CRYPTO_EX_DATA *ad; SV *data;
int idx; CRYPTO_EX_DATA *ad;
long argl; int idx;
char *argp; long argl;
{ char *argp;
SV *sv; {
SV *sv;
fprintf(stderr,"ex_new %08X %s\n",obj,argp); #ifdef DEBUG
sv=sv_newmortal(); printf("ex_new %08X %s\n",obj,argp);
sv_setref_pv(sv,argp,(void *)obj); #endif
printf("%d>new_ref '%s'\n",sv,argp); sv = sv_newmortal();
CRYPTO_set_ex_data(ad,idx,(char *)sv); sv_setref_pv(sv, argp, (void *)obj);
return(1); #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) void
char *obj; ex_cleanup(obj, data, ad, idx, argl, argp)
SV *data; char *obj;
CRYPTO_EX_DATA *ad; SV *data;
int idx; CRYPTO_EX_DATA *ad;
long argl; int idx;
char *argp; long argl;
{ char *argp;
pr_name("ex_cleanup"); {
fprintf(stderr,"ex_cleanup %08X %s\n",obj,argp); pr_name("ex_cleanup");
if (data != NULL) #ifdef DEBUG
SvREFCNT_dec((SV *)data); 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:
boot_bio(); boot_bio();
boot_cipher(); boot_cipher();
boot_digest(); boot_digest();
boot_err(); boot_err();
boot_ssl(); boot_ssl();
boot_OpenSSL__BN(); boot_OpenSSL__BN();
boot_OpenSSL__BIO(); boot_OpenSSL__BIO();
boot_OpenSSL__Cipher(); boot_OpenSSL__Cipher();
boot_OpenSSL__MD(); boot_OpenSSL__MD();
boot_OpenSSL__ERR(); boot_OpenSSL__ERR();
boot_OpenSSL__SSL(); boot_OpenSSL__SSL();
boot_OpenSSL__X509(); boot_OpenSSL__X509();

4
perl/README.1ST Normal file
View File

@ -0,0 +1,4 @@
WARNING, this Perl interface to OpenSSL is horrible incomplete.
Don't expect it to be really useable!!

24
perl/openssl.h
View File

@ -58,18 +58,19 @@
#ifdef __cplusplus #ifdef __cplusplus
extern "C" { extern "C" {
#endif #endif
#include "EXTERN.h" #include "EXTERN.h"
#include "perl.h" #include "perl.h"
#include "XSUB.h" #include "XSUB.h"
#ifdef __cplusplus #ifdef __cplusplus
} }
#endif #endif
typedef struct datum_st typedef struct datum_st {
{ char *dptr;
char *dptr; int dsize;
int dsize; } datum;
} datum;
#include "crypto.h" #include "crypto.h"
#include "buffer.h" #include "buffer.h"
@ -79,10 +80,10 @@ typedef struct datum_st
#include "x509.h" #include "x509.h"
#include "ssl.h" #include "ssl.h"
#if 0 #ifdef DEBUG
#define pr_name(name) printf("%s\n",name) #define pr_name(name) printf("%s\n",name)
#define pr_name_d(name,p2) printf("%s %d\n",name,p2) #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) #define pr_name_dd(name,p2,p3) printf("%s %d %d\n",name,p2,p3)
#else #else
#define pr_name(name) #define pr_name(name)
#define pr_name_d(name,p2) #define pr_name_d(name,p2)
@ -90,7 +91,6 @@ typedef struct datum_st
#endif #endif
SV *new_ref(char *type, char *obj, int mort); 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); 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, void ex_cleanup(char *obj, SV *data, CRYPTO_EX_DATA *ad, int idx, long argl, char *argp);
long argl,char *argp);

766
perl/openssl_bio.xs
View File

@ -1,451 +1,449 @@
#include "openssl.h" #include "openssl.h"
static int p5_bio_ex_bio_ptr=0; static int p5_bio_ex_bio_ptr = 0;
static int p5_bio_ex_bio_callback=0; static int p5_bio_ex_bio_callback = 0;
static int p5_bio_ex_bio_callback_data=0; static int p5_bio_ex_bio_callback_data = 0;
static long p5_bio_callback(bio,state,parg,cmd,larg,ret) static long
BIO *bio; p5_bio_callback(bio,state,parg,cmd,larg,ret)
int state; BIO *bio;
char *parg; int state;
int cmd; char *parg;
long larg; int cmd;
int ret; long larg;
{ int ret;
int i; {
SV *me,*cb; int i;
SV *me,*cb;
me=(SV *)BIO_get_ex_data(bio,p5_bio_ex_bio_ptr); me = (SV *)BIO_get_ex_data(bio, p5_bio_ex_bio_ptr);
cb=(SV *)BIO_get_ex_data(bio,p5_bio_ex_bio_callback); cb = (SV *)BIO_get_ex_data(bio, p5_bio_ex_bio_callback);
if (cb != NULL) if (cb != NULL) {
{ dSP;
dSP;
ENTER ; ENTER;
SAVETMPS; SAVETMPS;
PUSHMARK(sp); PUSHMARK(sp);
XPUSHs(sv_2mortal(newSViv(me))); XPUSHs(sv_2mortal(newSVsv(me)));
XPUSHs(sv_2mortal(newSViv(state))); XPUSHs(sv_2mortal(newSViv(state)));
XPUSHs(sv_2mortal(newSViv(cmd))); XPUSHs(sv_2mortal(newSViv(cmd)));
if ((state == BIO_CB_READ) || (state == BIO_CB_WRITE)) if ((state == BIO_CB_READ) || (state == BIO_CB_WRITE))
{ XPUSHs(sv_2mortal(newSVpv(parg,larg)));
XPUSHs(sv_2mortal(newSVpv(parg,larg))); else
} XPUSHs(&sv_undef);
else /* ptr one */
XPUSHs(&sv_undef); XPUSHs(sv_2mortal(newSViv(larg)));
/* ptr one */ XPUSHs(sv_2mortal(newSViv(ret)));
XPUSHs(sv_2mortal(newSViv(larg))); PUTBACK;
XPUSHs(sv_2mortal(newSViv(ret)));
PUTBACK;
i=perl_call_sv(cb,G_SCALAR); i = perl_call_sv(cb,G_SCALAR);
SPAGAIN; SPAGAIN;
if (i == 1) if (i == 1)
ret=POPi; ret = POPi;
else else
ret=1; ret = 1;
PUTBACK; PUTBACK;
FREETMPS; FREETMPS;
LEAVE; LEAVE;
} }
else else {
{ croak("Internal error in p5_bio_callback");
croak("Internal error in SSL p5_ssl_info_callback"); }
} return(ret);
return(ret); }
}
int boot_bio() int
{ boot_bio(void)
p5_bio_ex_bio_ptr= {
BIO_get_ex_new_index(0,"OpenSSL::BIO",ex_new,NULL, p5_bio_ex_bio_ptr = BIO_get_ex_new_index(0, "OpenSSL::BIO", ex_new, NULL, ex_cleanup);
ex_cleanup); p5_bio_ex_bio_callback = BIO_get_ex_new_index(0, "bio_callback", NULL, NULL, ex_cleanup);
p5_bio_ex_bio_callback= p5_bio_ex_bio_callback_data = BIO_get_ex_new_index(0, "bio_callback_data", NULL, NULL, ex_cleanup);
BIO_get_ex_new_index(0,"bio_callback",NULL,NULL, return(1);
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_ MODULE = OpenSSL::BIO PACKAGE = OpenSSL::BIO PREFIX = p5_BIO_
VERSIONCHECK: DISABLE VERSIONCHECK: DISABLE
void void
p5_BIO_new_buffer_ssl_connect(...) p5_BIO_new_buffer_ssl_connect(...)
PREINIT: PROTOTYPE: ;$
SSL_CTX *ctx; PREINIT:
BIO *bio; SSL_CTX *ctx;
SV *arg; BIO *bio;
PPCODE: SV *arg;
if (items == 1) PPCODE:
arg=ST(0); if (items == 1)
else if (items == 2) arg = ST(0);
arg=ST(1); else if (items == 2)
else arg = ST(1);
arg=NULL; else
arg = NULL;
if ((arg == NULL) || !(sv_derived_from(arg,"OpenSSL::SSL::CTX"))) if ((arg == NULL) || !(sv_derived_from(arg,"OpenSSL::SSL::CTX")))
croak("Usage: OpenSSL::BIO::new_buffer_ssl_connect(SSL_CTX)"); croak("Usage: OpenSSL::BIO::new_buffer_ssl_connect(SSL_CTX)");
else else {
{ IV tmp = SvIV((SV *)SvRV(arg));
IV tmp=SvIV((SV *)SvRV(arg)); ctx = (SSL_CTX *)tmp;
ctx=(SSL_CTX *)tmp; }
} EXTEND(sp, 1);
EXTEND(sp,1); bio = BIO_new_buffer_ssl_connect(ctx);
bio=BIO_new_buffer_ssl_connect(ctx); arg = (SV *)BIO_get_ex_data(bio, p5_bio_ex_bio_ptr);
arg=(SV *)BIO_get_ex_data(bio,p5_bio_ex_bio_ptr); PUSHs(arg);
PUSHs(arg);
void void
p5_BIO_new_ssl_connect(...) p5_BIO_new_ssl_connect(...)
PREINIT: PROTOTYPE: ;$
SSL_CTX *ctx; PREINIT:
BIO *bio; SSL_CTX *ctx;
SV *arg; BIO *bio;
PPCODE: SV *arg;
if (items == 1) PPCODE:
arg=ST(0); if (items == 1)
else if (items == 2) arg = ST(0);
arg=ST(1); else if (items == 2)
else arg = ST(1);
arg=NULL; else
arg = NULL;
if ((arg == NULL) || !(sv_derived_from(arg,"OpenSSL::SSL::CTX"))) if ((arg == NULL) || !(sv_derived_from(arg,"OpenSSL::SSL::CTX")))
croak("Usage: OpenSSL::BIO::new_ssl_connect(SSL_CTX)"); croak("Usage: OpenSSL::BIO::new_ssl_connect(SSL_CTX)");
else else {
{ IV tmp = SvIV((SV *)SvRV(arg));
IV tmp=SvIV((SV *)SvRV(arg)); ctx = (SSL_CTX *)tmp;
ctx=(SSL_CTX *)tmp; }
} EXTEND(sp,1);
EXTEND(sp,1); bio = BIO_new_ssl_connect(ctx);
bio=BIO_new_ssl_connect(ctx); arg = (SV *)BIO_get_ex_data(bio,p5_bio_ex_bio_ptr);
arg=(SV *)BIO_get_ex_data(bio,p5_bio_ex_bio_ptr); PUSHs(arg);
PUSHs(arg);
void void
p5_BIO_new(...) p5_BIO_new(...)
PREINIT: PROTOTYPE: ;$
BIO *bio; PREINIT:
char *type; BIO *bio;
SV *arg; char *type;
PPCODE: SV *arg;
pr_name("p5_BIO_new"); PPCODE:
if ((items == 1) && SvPOK(ST(0))) pr_name("p5_BIO_new");
type=SvPV(ST(0),na); if ((items == 1) && SvPOK(ST(0)))
else if ((items == 2) && SvPOK(ST(1))) type = SvPV(ST(0),na);
type=SvPV(ST(1),na); else if ((items == 2) && SvPOK(ST(1)))
else type = SvPV(ST(1),na);
croak("Usage: OpenSSL::BIO::new(type)"); else
croak("Usage: OpenSSL::BIO::new(type)");
EXTEND(sp,1); EXTEND(sp,1);
if (strcmp(type,"connect") == 0) if (strcmp(type, "mem") == 0)
bio=BIO_new(BIO_s_connect()); bio=BIO_new(BIO_s_mem());
else if (strcmp(type,"accept") == 0) else if (strcmp(type, "socket") == 0)
bio=BIO_new(BIO_s_accept()); bio=BIO_new(BIO_s_socket());
else if (strcmp(type,"ssl") == 0) else if (strcmp(type, "connect") == 0)
bio=BIO_new(BIO_f_ssl()); bio=BIO_new(BIO_s_connect());
else if (strcmp(type,"buffer") == 0) else if (strcmp(type, "accept") == 0)
bio=BIO_new(BIO_f_buffer()); bio=BIO_new(BIO_s_accept());
else else if (strcmp(type, "fd") == 0)
croak("unknown BIO type"); bio=BIO_new(BIO_s_fd());
arg=(SV *)BIO_get_ex_data(bio,p5_bio_ex_bio_ptr); else if (strcmp(type, "file") == 0)
PUSHs(arg); 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 int
p5_BIO_hostname(bio,name) p5_BIO_hostname(bio, name)
BIO *bio; BIO *bio;
char *name; char *name;
CODE: PROTOTYPE: $$
RETVAL=BIO_set_conn_hostname(bio,name); CODE:
OUTPUT: RETVAL = BIO_set_conn_hostname(bio, name);
RETVAL OUTPUT:
RETVAL
int int
p5_BIO_set_accept_port(bio,str) p5_BIO_set_accept_port(bio, str)
BIO *bio; BIO *bio;
char *str; char *str;
CODE: PROTOTYPE: $$
RETVAL=BIO_set_accept_port(bio,str); CODE:
OUTPUT: RETVAL = BIO_set_accept_port(bio, str);
RETVAL OUTPUT:
RETVAL
int int
p5_BIO_do_handshake(bio) p5_BIO_do_handshake(bio)
BIO *bio; BIO *bio;
CODE: PROTOTYPE: $
RETVAL=BIO_do_handshake(bio); CODE:
OUTPUT: RETVAL = BIO_do_handshake(bio);
RETVAL OUTPUT:
RETVAL
BIO * BIO *
p5_BIO_push(b,bio) p5_BIO_push(b, bio)
BIO *b; BIO *b;
BIO *bio; BIO *bio;
CODE: PROTOTYPE: $$
/* This reference will be reduced when the reference is CODE:
* let go, and then when the BIO_free_all() is called /* This reference will be reduced when the reference is
* inside the OpenSSL library by the BIO with this * let go, and then when the BIO_free_all() is called
* pushed into */ * inside the OpenSSL library by the BIO with this
bio->references++; * pushed into */
RETVAL=BIO_push(b,bio); bio->references++;
OUTPUT: RETVAL = BIO_push(b, bio);
RETVAL OUTPUT:
RETVAL
void void
p5_BIO_pop(b) p5_BIO_pop(b)
BIO *b BIO *b
PREINIT: PROTOTYPE: $
BIO *bio; PREINIT:
char *type; BIO *bio;
SV *arg; char *type;
PPCODE: SV *arg;
bio=BIO_pop(b); PPCODE:
if (bio != NULL) bio = BIO_pop(b);
{ if (bio != NULL) {
/* This BIO will either be one created in the /* This BIO will either be one created in the
* perl library, in which case it will have a perl * perl library, in which case it will have a perl
* SV, otherwise it will have been created internally, * SV, otherwise it will have been created internally,
* inside OpenSSL. For the 'pushed in', it needs * inside OpenSSL. For the 'pushed in', it needs
* the reference count decememted. */ * the reference count decememted. */
arg=(SV *)BIO_get_ex_data(bio,p5_bio_ex_bio_ptr); arg = (SV *)BIO_get_ex_data(bio, p5_bio_ex_bio_ptr);
if (arg == NULL) if (arg == NULL) {
{ arg = new_ref("OpenSSL::BIO",(char *)bio,0);
arg=new_ref("OpenSSL::BIO",(char *)bio,0); BIO_set_ex_data(bio, p5_bio_ex_bio_ptr, (char *)arg);
BIO_set_ex_data(bio,p5_bio_ex_bio_ptr,(char *)arg); PUSHs(arg);
PUSHs(arg); }
} else {
else /* it was pushed in */
{ SvREFCNT_inc(arg);
/* it was pushed in */ PUSHs(arg);
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
}
}
int int
p5_BIO_sysread(bio,in,num, ...) p5_BIO_sysread(bio, in, num, ...)
BIO *bio; BIO *bio;
SV *in; SV *in;
int num; int num;
PREINIT: PROTOTYPE: $$$;
int i,n,olen; PREINIT:
int offset; int i,n,olen;
char *p; int offset;
CODE: char *p;
offset=0; CODE:
if (!SvPOK(in)) offset = 0;
sv_setpvn(in,"",0); if (!SvPOK(in))
SvPV(in,olen); sv_setpvn(in, "", 0);
if (items > 3) SvPV(in, olen);
{ if (items > 3) {
offset=SvIV(ST(3)); offset = SvIV(ST(3));
if (offset < 0) if (offset < 0) {
{ if (-offset > olen)
if (-offset > olen) croak("Offset outside string");
croak("Offset outside string"); offset+=olen;
offset+=olen; }
} }
} if ((num+offset) > olen) {
if ((num+offset) > olen) SvGROW(in, num+offset+1);
{ p=SvPV(in, i);
SvGROW(in,num+offset+1); memset(&(p[olen]), 0, (num+offset)-olen+1);
p=SvPV(in,i); }
memset(&(p[olen]),0,(num+offset)-olen+1); p = SvPV(in,n);
} i = BIO_read(bio, p+offset, num);
p=SvPV(in,n); RETVAL = i;
if (i <= 0)
i=BIO_read(bio,p+offset,num); i = 0;
RETVAL=i; SvCUR_set(in, offset+i);
if (i <= 0) i=0; OUTPUT:
SvCUR_set(in,offset+i); RETVAL
OUTPUT:
RETVAL
int int
p5_BIO_syswrite(bio,in, ...) p5_BIO_syswrite(bio, in, ...)
BIO *bio; BIO *bio;
SV *in; SV *in;
PREINIT: PROTOTYPE: $$;
char *ptr; PREINIT:
int len,in_len; char *ptr;
int offset=0; int len,in_len;
int n; int offset=0;
CODE: int n;
ptr=SvPV(in,in_len); CODE:
if (items > 2) ptr = SvPV(in, in_len);
{ if (items > 2) {
len=SvOK(ST(2))?SvIV(ST(2)):in_len; len = SvOK(ST(2)) ? SvIV(ST(2)) : in_len;
if (items > 3) if (items > 3) {
{ offset = SvIV(ST(3));
offset=SvIV(ST(3)); if (offset < 0) {
if (offset < 0) if (-offset > in_len)
{ croak("Offset outside string");
if (-offset > in_len) offset+=in_len;
croak("Offset outside string"); }
offset+=in_len; else if ((offset >= in_len) && (in_len > 0))
} croak("Offset outside string");
else if ((offset >= in_len) && (in_len > 0)) }
croak("Offset outside string"); if (len >= (in_len-offset))
} len = in_len-offset;
if (len >= (in_len-offset)) }
len=in_len-offset; else
} len = in_len;
else RETVAL = BIO_write(bio, ptr+offset, len);
len=in_len; OUTPUT:
RETVAL
RETVAL=BIO_write(bio,ptr+offset,len);
OUTPUT:
RETVAL
void void
p5_BIO_getline(bio) p5_BIO_getline(bio)
BIO *bio; BIO *bio;
PREINIT: PROTOTYPE: $
int i; PREINIT:
char *p; int i;
PPCODE: char *p;
pr_name("p5_BIO_gets"); PPCODE:
EXTEND(sp,1); pr_name("p5_BIO_gets");
PUSHs(sv_newmortal()); EXTEND(sp, 1);
sv_setpvn(ST(0),"",0); PUSHs(sv_newmortal());
SvGROW(ST(0),1024); sv_setpvn(ST(0), "", 0);
p=SvPV(ST(0),na); SvGROW(ST(0), 1024);
i=BIO_gets(bio,p,1024); p=SvPV(ST(0), na);
if (i < 0) i=0; i = BIO_gets(bio, p, 1024);
SvCUR_set(ST(0),i); if (i < 0)
i = 0;
SvCUR_set(ST(0), i);
int int
p5_BIO_flush(bio) p5_BIO_flush(bio)
BIO *bio; BIO *bio;
CODE: PROTOTYPE: $
RETVAL=BIO_flush(bio); CODE:
OUTPUT: RETVAL = BIO_flush(bio);
RETVAL OUTPUT:
RETVAL
char * char *
p5_BIO_type(bio) p5_BIO_type(bio)
BIO *bio; BIO *bio;
CODE: PROTOTYPE: $
RETVAL=bio->method->name; CODE:
OUTPUT: RETVAL = bio->method->name;
RETVAL OUTPUT:
RETVAL
void void
p5_BIO_next_bio(b) p5_BIO_next_bio(b)
BIO *b BIO *b
PREINIT: PROTOTYPE: $
BIO *bio; PREINIT:
char *type; BIO *bio;
SV *arg; char *type;
PPCODE: SV *arg;
bio=b->next_bio; PPCODE:
if (bio != NULL) bio = b->next_bio;
{ if (bio != NULL) {
arg=(SV *)BIO_get_ex_data(bio,p5_bio_ex_bio_ptr); arg = (SV *)BIO_get_ex_data(bio, p5_bio_ex_bio_ptr);
if (arg == NULL) if (arg == NULL) {
{ arg = new_ref("OpenSSL::BIO", (char *)bio, 0);
arg=new_ref("OpenSSL::BIO",(char *)bio,0); BIO_set_ex_data(bio, p5_bio_ex_bio_ptr, (char *)arg);
BIO_set_ex_data(bio,p5_bio_ex_bio_ptr,(char *)arg); bio->references++;
bio->references++; PUSHs(arg);
PUSHs(arg); }
} else {
else SvREFCNT_inc(arg);
{ PUSHs(arg);
SvREFCNT_inc(arg); }
PUSHs(arg); }
}
}
int int
p5_BIO_puts(bio,in) p5_BIO_puts(bio, in)
BIO *bio; BIO *bio;
SV *in; SV *in;
PREINIT: PROTOTYPE: $$
char *ptr; PREINIT:
CODE: char *ptr;
ptr=SvPV(in,na); CODE:
RETVAL=BIO_puts(bio,ptr); ptr = SvPV(in,na);
OUTPUT: RETVAL = BIO_puts(bio, ptr);
RETVAL OUTPUT:
RETVAL
void void
p5_BIO_set_callback(bio,cb,...) p5_BIO_set_callback(bio, cb,...)
BIO *bio; BIO *bio;
SV *cb; SV *cb;
PREINIT: PROTOTYPE: $$;
SV *arg=NULL; PREINIT:
SV *arg2=NULL; SV *arg = NULL;
CODE: SV *arg2 = NULL;
if (items > 3) CODE:
croak("Usage: OpenSSL::BIO::set_callback(bio,callback[,arg]"); if (items > 3)
if (items == 3) croak("Usage: OpenSSL::BIO::set_callback(bio,callback[,arg]");
{ if (items == 3) {
arg2=sv_mortalcopy(ST(2)); arg2 = sv_mortalcopy(ST(2));
SvREFCNT_inc(arg2); SvREFCNT_inc(arg2);
BIO_set_ex_data(bio,p5_bio_ex_bio_callback_data, BIO_set_ex_data(bio, p5_bio_ex_bio_callback_data, (char *)arg2);
(char *)arg2); }
} arg = sv_mortalcopy(ST(1));
arg=sv_mortalcopy(ST(1)); SvREFCNT_inc(arg);
SvREFCNT_inc(arg); BIO_set_ex_data(bio, p5_bio_ex_bio_callback, (char *)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)); */
printf("%08lx < bio_ptr\n",BIO_get_ex_data(bio,p5_bio_ex_bio_ptr)); BIO_set_callback(bio, p5_bio_callback);
BIO_set_callback(bio,p5_bio_callback);
void void
p5_BIO_DESTROY(bio) p5_BIO_DESTROY(bio)
BIO *bio BIO *bio
PREINIT: PROTOTYPE: $
SV *sv; PREINIT:
PPCODE: SV *sv;
pr_name_d("p5_BIO_DESTROY",bio->references); PPCODE:
printf("p5_BIO_DESTROY <%s> %d\n",bio->method->name,bio->references); pr_name_d("p5_BIO_DESTROY",bio->references);
BIO_set_ex_data(bio,p5_bio_ex_bio_ptr,NULL); /* printf("p5_BIO_DESTROY <%s> %d\n",bio->method->name,bio->references); */
BIO_free_all(bio); BIO_set_ex_data(bio,p5_bio_ex_bio_ptr,NULL);
BIO_free_all(bio);
int int
p5_BIO_set_ssl(bio,ssl) p5_BIO_set_ssl(bio, ssl)
BIO *bio; BIO *bio;
SSL *ssl; SSL *ssl;
CODE: PROTOTYPE: $$
pr_name("p5_BIO_set_ssl"); CODE:
ssl->references++; pr_name("p5_BIO_set_ssl");
RETVAL=BIO_set_ssl(bio,ssl,BIO_CLOSE); ssl->references++;
OUTPUT: RETVAL = BIO_set_ssl(bio, ssl, BIO_CLOSE);
RETVAL OUTPUT:
RETVAL
int int
p5_BIO_number_read(bio) p5_BIO_number_read(bio)
BIO *bio; BIO *bio;
CODE: PROTOTYPE: $
RETVAL=BIO_number_read(bio); CODE:
OUTPUT: RETVAL = BIO_number_read(bio);
RETVAL OUTPUT:
RETVAL
int int
p5_BIO_number_written(bio) p5_BIO_number_written(bio)
BIO *bio; BIO *bio;
CODE: PROTOTYPE: $
RETVAL=BIO_number_written(bio); CODE:
OUTPUT: RETVAL = BIO_number_written(bio);
RETVAL OUTPUT:
RETVAL
int int
p5_BIO_references(bio) p5_BIO_references(bio)
BIO *bio; BIO *bio;
CODE: PROTOTYPE: $
RETVAL=bio->references; CODE:
OUTPUT: RETVAL = bio->references;
RETVAL OUTPUT:
RETVAL

13
perl/t/01-use.t Normal file
View File

@ -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";

10
perl/t/02-version.t Normal file
View File

@ -0,0 +1,10 @@
print "1..1\n";
use OpenSSL;
if ($OpenSSL::VERSION ne '') {
print "ok 1\n";
}
else {
print "not ok 1\n";
}

16
perl/t/03-bio.t Normal file
View File

@ -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";