Attached is a patch for the perl code in OpenSSL-0.9.6 to make it work
with Perl5.6.0. The patch should be applied in the main openssl-0.9.6
directory above the "perl" directory. Feel free to place this patch
on the "Contribution" page and/or apply them to the OpenSSL sources.
The patch adds no new functionality (other than a simple test package)
to the libraries, but it allows them to be compiled with Perl5.6.0.
It has only been tested under "Red Hat Linux release 7.0 (Guinness)"
with the unpatched verion of OpenSSL 0.9.6 released last September.
This patch is provided "AS IS" under the same licenses that OpenSSL
is provided without any expressed or implied warranties.
Kurt
diff -N -c -r perl.orig/OpenSSL.xs perl/OpenSSL.xs
*** perl.orig/OpenSSL.xs Thu Jul 22 09:10:31 1999
--- perl/OpenSSL.xs Wed Feb 14 20:11:59 2001
***************
*** 72,82 ****
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();
--- 72,109 ----
boot_digest();
boot_err();
boot_ssl();
!
! /* */
! /* The next macro is the completely correct way to call a C */
! /* function that uses perl calling conventions but is not */
! /* registered with perl. */
! /* */
! /* The second macro seems to work for this context. (We just */
! /* need a mark for the called function since we don't have */
! /* any local variables and what-not.) */
! /* */
! /* Unfortunately, we need to do this because these boot_* */
! /* functions are auto-generated by xsubpp and are normally */
! /* called from DyncLoader, but we're pulling them in here. */
! /* */
! #define FULL_callBootFunc(func) { \
! dSP; \
! ENTER; \
! SAVETMPS; \
! PUSHMARK(SP); \
! func(); \
! FREETMPS; \
! LEAVE; \
! }
! #define callBootFunc(func) { \
! PUSHMARK(SP); \
! func(); \
! }
! callBootFunc(boot_OpenSSL__BN);
! callBootFunc(boot_OpenSSL__BIO);
! callBootFunc(boot_OpenSSL__Cipher);
! callBootFunc(boot_OpenSSL__MD);
! callBootFunc(boot_OpenSSL__ERR);
! callBootFunc(boot_OpenSSL__SSL);
! callBootFunc(boot_OpenSSL__X509);
diff -N -c -r perl.orig/openssl_bio.xs perl/openssl_bio.xs
*** perl.orig/openssl_bio.xs Thu Jul 22 09:10:31 1999
--- perl/openssl_bio.xs Wed Feb 14 19:41:46 2001
***************
*** 32,38 ****
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)));
--- 32,38 ----
if ((state == BIO_CB_READ) || (state == BIO_CB_WRITE))
XPUSHs(sv_2mortal(newSVpv(parg,larg)));
else
! XPUSHs(&PL_sv_undef);
/* ptr one */
XPUSHs(sv_2mortal(newSViv(larg)));
XPUSHs(sv_2mortal(newSViv(ret)));
***************
*** 129,137 ****
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);
--- 129,137 ----
PPCODE:
pr_name("p5_BIO_new");
if ((items == 1) && SvPOK(ST(0)))
! type = SvPV_nolen(ST(0));
else if ((items == 2) && SvPOK(ST(1)))
! type = SvPV_nolen(ST(1));
else
croak("Usage: OpenSSL::BIO::new(type)");
EXTEND(sp,1);
***************
*** 314,320 ****
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;
--- 314,320 ----
PUSHs(sv_newmortal());
sv_setpvn(ST(0), "", 0);
SvGROW(ST(0), 1024);
! p=SvPV_nolen(ST(0));
i = BIO_gets(bio, p, 1024);
if (i < 0)
i = 0;
***************
*** 370,376 ****
PREINIT:
char *ptr;
CODE:
! ptr = SvPV(in,na);
RETVAL = BIO_puts(bio, ptr);
OUTPUT:
RETVAL
--- 370,376 ----
PREINIT:
char *ptr;
CODE:
! ptr = SvPV_nolen(in);
RETVAL = BIO_puts(bio, ptr);
OUTPUT:
RETVAL
diff -N -c -r perl.orig/openssl_bn.xs perl/openssl_bn.xs
*** perl.orig/openssl_bn.xs Thu Jul 22 09:10:31 1999
--- perl/openssl_bn.xs Wed Feb 14 19:42:34 2001
***************
*** 142,148 ****
i=BN_num_bytes(a)+2;
sv_setpvn(ST(0),"",1);
SvGROW(ST(0),i+1);
! SvCUR_set(ST(0),BN_bn2bin(a,SvPV(ST(0),na)));
void
p5_BN_mpi2bn(a)
--- 142,148 ----
i=BN_num_bytes(a)+2;
sv_setpvn(ST(0),"",1);
SvGROW(ST(0),i+1);
! SvCUR_set(ST(0),BN_bn2bin(a,SvPV_nolen(ST(0))));
void
p5_BN_mpi2bn(a)
***************
*** 168,174 ****
i=BN_bn2mpi(a,NULL);
sv_setpvn(ST(0),"",1);
SvGROW(ST(0),i+1);
! SvCUR_set(ST(0),BN_bn2mpi(a,SvPV(ST(0),na)));
void
p5_BN_hex2bn(a)
--- 168,174 ----
i=BN_bn2mpi(a,NULL);
sv_setpvn(ST(0),"",1);
SvGROW(ST(0),i+1);
! SvCUR_set(ST(0),BN_bn2mpi(a,SvPV_nolen(ST(0))));
void
p5_BN_hex2bn(a)
***************
*** 208,216 ****
RETVAL=newSVpv("",0);
i=strlen(ptr);
SvGROW(RETVAL,i+1);
! memcpy(SvPV(RETVAL,na),ptr,i+1);
SvCUR_set(RETVAL,i);
! Free(ptr);
OUTPUT:
RETVAL
--- 208,216 ----
RETVAL=newSVpv("",0);
i=strlen(ptr);
SvGROW(RETVAL,i+1);
! memcpy(SvPV_nolen(RETVAL),ptr,i+1);
SvCUR_set(RETVAL,i);
OPENSSL_free(ptr);
OUTPUT:
RETVAL
***************
*** 226,234 ****
RETVAL=newSVpv("",0);
i=strlen(ptr);
SvGROW(RETVAL,i+1);
! memcpy(SvPV(RETVAL,na),ptr,i+1);
SvCUR_set(RETVAL,i);
! Free(ptr);
OUTPUT:
RETVAL
--- 226,234 ----
RETVAL=newSVpv("",0);
i=strlen(ptr);
SvGROW(RETVAL,i+1);
! memcpy(SvPV_nolen(RETVAL),ptr,i+1);
SvCUR_set(RETVAL,i);
OPENSSL_free(ptr);
OUTPUT:
RETVAL
diff -N -c -r perl.orig/openssl_cipher.xs perl/openssl_cipher.xs
*** perl.orig/openssl_cipher.xs Thu Jul 22 09:10:31 1999
--- perl/openssl_cipher.xs Tue Feb 13 22:47:10 2001
***************
*** 20,28 ****
char *name;
PPCODE:
if ((items == 1) && SvPOK(ST(0)))
! name=SvPV(ST(0),na);
else if ((items == 2) && SvPOK(ST(1)))
! name=SvPV(ST(1),na);
else
croak("Usage: OpenSSL::Cipher::new(type)");
PUSHs(sv_newmortal());
--- 20,28 ----
char *name;
PPCODE:
if ((items == 1) && SvPOK(ST(0)))
! name=SvPV_nolen(ST(0));
else if ((items == 2) && SvPOK(ST(1)))
! name=SvPV_nolen(ST(1));
else
croak("Usage: OpenSSL::Cipher::new(type)");
PUSHs(sv_newmortal());
***************
*** 112,118 ****
CODE:
RETVAL=newSVpv("",0);
SvGROW(RETVAL,in.dsize+EVP_CIPHER_CTX_block_size(ctx)+1);
! EVP_Cipher(ctx,SvPV(RETVAL,na),in.dptr,in.dsize);
SvCUR_set(RETVAL,in.dsize);
OUTPUT:
RETVAL
--- 112,118 ----
CODE:
RETVAL=newSVpv("",0);
SvGROW(RETVAL,in.dsize+EVP_CIPHER_CTX_block_size(ctx)+1);
! EVP_Cipher(ctx,SvPV_nolen(RETVAL),in.dptr,in.dsize);
SvCUR_set(RETVAL,in.dsize);
OUTPUT:
RETVAL
***************
*** 126,132 ****
CODE:
RETVAL=newSVpv("",0);
SvGROW(RETVAL,in.dsize+EVP_CIPHER_CTX_block_size(ctx)+1);
! EVP_CipherUpdate(ctx,SvPV(RETVAL,na),&i,in.dptr,in.dsize);
SvCUR_set(RETVAL,i);
OUTPUT:
RETVAL
--- 126,132 ----
CODE:
RETVAL=newSVpv("",0);
SvGROW(RETVAL,in.dsize+EVP_CIPHER_CTX_block_size(ctx)+1);
! EVP_CipherUpdate(ctx,SvPV_nolen(RETVAL),&i,in.dptr,in.dsize);
SvCUR_set(RETVAL,i);
OUTPUT:
RETVAL
***************
*** 139,145 ****
CODE:
RETVAL=newSVpv("",0);
SvGROW(RETVAL,EVP_CIPHER_CTX_block_size(ctx)+1);
! if (!EVP_CipherFinal(ctx,SvPV(RETVAL,na),&i))
sv_setpv(RETVAL,"BAD DECODE");
else
SvCUR_set(RETVAL,i);
--- 139,145 ----
CODE:
RETVAL=newSVpv("",0);
SvGROW(RETVAL,EVP_CIPHER_CTX_block_size(ctx)+1);
! if (!EVP_CipherFinal(ctx,SvPV_nolen(RETVAL),&i))
sv_setpv(RETVAL,"BAD DECODE");
else
SvCUR_set(RETVAL,i);
diff -N -c -r perl.orig/openssl_digest.xs perl/openssl_digest.xs
*** perl.orig/openssl_digest.xs Thu Jul 22 09:10:31 1999
--- perl/openssl_digest.xs Wed Feb 14 19:44:02 2001
***************
*** 27,35 ****
char *name;
PPCODE:
if ((items == 1) && SvPOK(ST(0)))
! name=SvPV(ST(0),na);
else if ((items == 2) && SvPOK(ST(1)))
! name=SvPV(ST(1),na);
else
croak("Usage: OpenSSL::MD::new(type)");
PUSHs(sv_newmortal());
--- 27,35 ----
char *name;
PPCODE:
if ((items == 1) && SvPOK(ST(0)))
! name=SvPV_nolen(ST(0));
else if ((items == 2) && SvPOK(ST(1)))
! name=SvPV_nolen(ST(1));
else
croak("Usage: OpenSSL::MD::new(type)");
PUSHs(sv_newmortal());
***************
*** 45,52 ****
p5_EVP_MD_name(ctx)
EVP_MD_CTX *ctx
CODE:
! RETVAL.dptr=OBJ_nid2ln(EVP_MD_type(EVP_MD_CTX_type(ctx)));
RETVAL.dsize=strlen(RETVAL.dptr);
OUTPUT:
RETVAL
--- 45,53 ----
p5_EVP_MD_name(ctx)
EVP_MD_CTX *ctx
CODE:
! RETVAL.dptr=OBJ_nid2ln(EVP_MD_CTX_type(ctx));
RETVAL.dsize=strlen(RETVAL.dptr);
+
OUTPUT:
RETVAL
diff -N -c -r perl.orig/openssl_ssl.xs perl/openssl_ssl.xs
*** perl.orig/openssl_ssl.xs Thu Jul 22 09:10:31 1999
--- perl/openssl_ssl.xs Tue Feb 13 23:04:26 2001
***************
*** 72,80 ****
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)");
--- 72,80 ----
PPCODE:
pr_name("p5_SSL_CTX_new");
if ((items == 1) && SvPOK(ST(0)))
! method=SvPV_nolen(ST(0));
else if ((items == 2) && SvPOK(ST(1)))
! method=SvPV_nolen(ST(1));
else
croak("Usage: OpenSSL::SSL::CTX::new(type)");
***************
*** 124,130 ****
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
--- 124,130 ----
croak("OpenSSL::SSL::CTX::use_PrivateKey_file(ssl_ctx,file[,type])");
if (items == 3)
{
! ptr=SvPV_nolen(ST(2));
if (strcmp(ptr,"der") == 0)
i=SSL_FILETYPE_ASN1;
else
***************
*** 148,154 ****
{
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,
--- 148,154 ----
{
if (!SvPOK(ST(i)))
croak("Usage:
OpenSSL::SSL_CTX::set_options(ssl_ctx[,option,value]+)");
! ptr=SvPV_nolen(ST(i));
if (strcmp(ptr,"-info_callback") == 0)
{
SSL_CTX_set_info_callback(ctx,
***************
*** 325,331 ****
{
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,
--- 325,331 ----
{
if (!SvPOK(ST(i)))
croak("Usage:
OpenSSL::SSL::set_options(ssl[,option,value]+)");
! ptr=SvPV_nolen(ST(i));
if (strcmp(ptr,"-info_callback") == 0)
{
SSL_set_info_callback(ssl,
***************
*** 477,483 ****
ret=sv_mortalcopy(ret);
}
else
! ret= &sv_undef;
EXTEND(sp,1);
PUSHs(ret);
--- 477,483 ----
ret=sv_mortalcopy(ret);
}
else
! ret= &PL_sv_undef;
EXTEND(sp,1);
PUSHs(ret);
diff -N -c -r perl.orig/t/04-digests.t perl/t/04-digests.t
*** perl.orig/t/04-digests.t Wed Dec 31 16:00:00 1969
--- perl/t/04-digests.t Wed Feb 14 20:19:42 2001
***************
*** 0 ****
--- 1,59 ----
+ #!/usr/bin/perl
+ use strict;
+
+ BEGIN { $| = 1; print "1..21\n"; };
+ use OpenSSL; my $loadedB = 1;
+ END { print "not ok 1\n" unless $loadedB; }
+
+ sub bin2hex {
+ my $data = shift;
+
+ $data =~ s/(.)/unpack('H2', $1)/seg;
+
+ return $data;
+ }
+
+ print "ok 1 (OpenSSL loaded)\n";
+ my $i = 1;
+
+ my %digestTestH = (
+ '' => { qw(
+ md2 8350e5a3e24c153df2275c9f80692773
+ md5 d41d8cd98f00b204e9800998ecf8427e
+ mdc2 52525252525252522525252525252525
+ rmd160
+9c1185a5c5e9fc54612808977ee8f548b2258d31
+ sha1
+da39a3ee5e6b4b0d3255bfef95601890afd80709
+ ) },
+ 'foo' => { qw(
+ md2 d11f8ce29210b4b50c5e67533b699d02
+ md5 acbd18db4cc2f85cedef654fccc4a4d8
+ mdc2 5da2a8f36bf237c84fddf81b67bd0afc
+ rmd160
+42cfa211018ea492fdee45ac637b7972a0ad6873
+ sha1
+0beec7b5ea3f0fdbc95d0dd47f3c5bc275da8a33
+ ) },
+ 'bar' => { qw(
+ md2 633b01073d72b7fecfca47671aa2c684
+ md5 37b51d194a7513e45b56f6524f2d51f2
+ mdc2 672262fed512ecdac769335dde72541c
+ rmd160
+38e9a158363619d111336fec01a957d0a57a53c9
+ sha1
+62cdb7020ff920e5aa642c3d4066950dd1f01f4d
+ ) },
+ "x\n" => { qw(
+ md2 04698d3830cc118699af4e8ac4b27c1e
+ md5 401b30e3b8b5d629635a5c613cdb7919
+ mdc2 b2d4006db6945b12657323bdf220ce7f
+ rmd160
+6202a78e3f1ccde4446e8a75203107add8f5fdc8
+ sha1
+6fcf9dfbd479ed82697fee719b9f8c610a11ff2a
+ ) },
+ );
+
+ while (my($data, $digestsHR) = each %digestTestH) {
+ while (my($type, $digest) = each %$digestsHR) {
+ ++$i;
+
+ my $digestO = OpenSSL::MD::new($type);
+ $digestO->update($data);
+ my $d = bin2hex($digestO->final());
+ print $d eq $digest ? "ok $i ($type fingerprint)\n" : "not ok $i
+($type: $d ne $digest)\n";
+ }
+ }
diff -N -c -r perl.orig/t/05-ciphers.t perl/t/05-ciphers.t
*** perl.orig/t/05-ciphers.t Wed Dec 31 16:00:00 1969
--- perl/t/05-ciphers.t Wed Feb 14 20:48:37 2001
***************
*** 0 ****
--- 1,71 ----
+ #!/usr/bin/perl
+ use strict;
+
+ BEGIN { $| = 1; print "1..37\n"; };
+ use OpenSSL; my $loadedB = 1;
+ END { print "not ok 1\n" unless $loadedB; }
+
+ sub bin2hex {
+ my $data = shift;
+
+ $data =~ s/(.)/unpack('H2', $1)/seg;
+
+ return $data;
+ }
+
+ print "ok 1 (OpenSSL loaded)\n";
+ my $i = 1;
+
+ #
+ # These are just perliminary tests...
+ # Figure out what really needs testing!
+ #
+
+ my %cipherTestH = (
+ '' => { qw(
+ des-ecb 2b6e1d5d4abf309a
+ des-cbc 2b6e1d5d4abf309a
+ des-ede 2b6e1d5d4abf309a
+ des-ede3 2b6e1d5d4abf309a
+ desx-cbc 720b3a8685a87209
+ bf-ecb 14f6bb08b5747787
+ bf-cbc 14f6bb08b5747787
+ rc5-ecb d765de1027f7d85e
+ rc5-cbc d765de1027f7d85e
+ ) },
+ 'foo' => { qw(
+ des-ecb 4f8a0ead125f87b9
+ des-cbc 4f8a0ead125f87b9
+ des-ede 4f8a0ead125f87b9
+ des-ede3 4f8a0ead125f87b9
+ desx-cbc 6825a2c983fe6705
+ bf-ecb 707fed121a3f7857
+ bf-cbc 707fed121a3f7857
+ rc5-ecb 0aa8984842b265d4
+ rc5-cbc 0aa8984842b265d4
+ ) },
+ );
+
+ while (my($data, $ciphersHR) = each %cipherTestH) {
+ while (my($type, $cipher) = each %$ciphersHR) {
+ my $cipherO = OpenSSL::Cipher::new($type);
+
+ my $key = 'A' x $cipherO->key_length();
+ my $iv = 'B' x $cipherO->iv_length();
+ $cipherO->init($key, $iv, 1); # 1 means "encipher"
+
+ $cipherO->update($data);
+ my $c = bin2hex(my $d = $cipherO->final());
+ ++$i;
+ print $c eq $cipher ? "ok $i ($type encipher)\n" : "not ok $i ($type:
+$c ne $cipher)\n";
+
+ # Now decipher what we just enciphered!
+
+ my $decryptO = OpenSSL::Cipher::new($type);
+ $decryptO->init($key, $iv, 0); # 1 means "decipher"
+ $decryptO->update($d);
+ my $decrypted = $decryptO->final();
+ ++$i;
+ print $decrypted eq $data ? "ok $i ($type decipher)\n" : "not ok $i
+($type: $decrypted ne $data)\n";
+ }
+ }
