提交 a0ecb9b8 编写于 作者: R Richard Levitte

Remove the perl/ subdirectory. It hasn't been worked on for ages, is

very broken, and there are working modules in CPAN, which makes our
module even more moot.
上级 4bf4bc78
OpenSSL STATUS Last modified at OpenSSL STATUS Last modified at
______________ $Date: 2002/02/28 12:42:00 $ ______________ $Date: 2002/02/28 22:07:50 $
DEVELOPMENT STATE DEVELOPMENT STATE
...@@ -91,22 +91,6 @@ ...@@ -91,22 +91,6 @@
which apparently is not flexible enough to generate which apparently is not flexible enough to generate
libcrypto) libcrypto)
o The perl/ stuff needs a major overhaul. Currently it's
totally obsolete. Either we clean it up and enhance it to be up-to-date
with the C code or we also could replace it with the really nice
Net::SSLeay package we can find under
http://www.neuronio.pt/SSLeay.pm.html. Ralf uses this package for a
longer time and it works fine and is a nice Perl module. Best would be
to convince the author to work for the OpenSSL project and create a
Net::OpenSSL or Crypt::OpenSSL package out of it and maintains it for
us.
Status: Ralf thinks we should both contact the author of Net::SSLeay
and look how much effort it is to bring Eric's perl/ stuff up
to date.
Paul +1
WISHES WISHES
o Add variants of DH_generate_parameters() and BN_generate_prime() [etc?] o Add variants of DH_generate_parameters() and BN_generate_prime() [etc?]
......
README.1ST
MANIFEST
Makefile.PL
typemap
OpenSSL.pm
OpenSSL.xs
openssl.h
openssl_bio.xs
openssl_bn.xs
openssl_cipher.xs
openssl_digest.xs
openssl_err.xs
openssl_ssl.xs
openssl_x509.xs
t/01-use.t
t/02-version.t
t/03-bio.t
##
## Makefile.PL -- Perl MakeMaker specification
##
open(IN,"<../Makefile.ssl") || die "unable to open Makefile.ssl!\n";
while(<IN>) {
$V=$1 if (/^VERSION=(.*)$/);
}
close(IN);
print "Configuring companion Perl module for OpenSSL $V\n";
use ExtUtils::MakeMaker;
WriteMakefile(
'OPTIMIZE' => '',
'DISTNAME' => "openssl-$V",
'NAME' => 'OpenSSL',
'VERSION_FROM' => 'OpenSSL.pm',
'LIBS' => ( $^O eq 'MSWin32'
? [ '-L../out32dll -lssleay32 -llibeay32' ]
: [ '-L.. -lssl -lcrypto' ] ),
'DEFINE' => '',
'INC' => '-I../include',
'H' => ['openssl.h'],
'OBJECT' =>
'OpenSSL.o ' .
'openssl_bio.o ' .
'openssl_bn.o ' .
'openssl_cipher.o ' .
'openssl_digest.o ' .
'openssl_err.o ' .
'openssl_ssl.o ' .
'openssl_x509.o ',
'XS' => {
'OpenSSL.xs' => 'OpenSSL.c',
'openssl_bio.xs' => 'openssl_bio.c',
'openssl_bn.xs' => 'openssl_bn.c',
'openssl_cipher.xs' => 'openssl_cipher.c',
'openssl_digest.xs' => 'openssl_digest.c',
'openssl_err.xs' => 'openssl_err.c',
'openssl_ssl.xs' => 'openssl_ssl.c',
'openssl_x509.xs' => 'openssl_x509.c',
},
);
##
## OpenSSL.pm
##
package OpenSSL;
require 5.000;
use Exporter;
use DynaLoader;
@ISA = qw(Exporter DynaLoader);
@EXPORT = qw();
$VERSION = '0.94';
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];
}
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]; 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(@_);
}
1;
/*
** OpenSSL.xs
*/
#include "openssl.h"
SV *
new_ref(type, obj, mort)
char *type;
char *obj;
{
SV *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;
#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");
#ifdef DEBUG
printf("ex_cleanup %08X %s\n", obj, argp);
#endif
if (data != NULL)
SvREFCNT_dec((SV *)data);
}
MODULE = OpenSSL PACKAGE = OpenSSL
PROTOTYPES: ENABLE
BOOT:
boot_bio();
boot_cipher();
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);
WARNING, this Perl interface to OpenSSL is horrible incomplete.
Don't expect it to be really useable!!
/* Copyright (C) 1995-1998 Eric Young (eay@cryptsoft.com)
* All rights reserved.
*
* This package is an SSL implementation written
* by Eric Young (eay@cryptsoft.com).
* The implementation was written so as to conform with Netscapes SSL.
*
* This library is free for commercial and non-commercial use as long as
* the following conditions are aheared to. The following conditions
* apply to all code found in this distribution, be it the RC4, RSA,
* lhash, DES, etc., code; not just the SSL code. The SSL documentation
* included with this distribution is covered by the same copyright terms
* except that the holder is Tim Hudson (tjh@cryptsoft.com).
*
* Copyright remains Eric Young's, and as such any Copyright notices in
* the code are not to be removed.
* If this package is used in a product, Eric Young should be given attribution
* as the author of the parts of the library used.
* This can be in the form of a textual message at program startup or
* in documentation (online or textual) provided with the package.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. All advertising materials mentioning features or use of this software
* must display the following acknowledgement:
* "This product includes cryptographic software written by
* Eric Young (eay@cryptsoft.com)"
* The word 'cryptographic' can be left out if the rouines from the library
* being used are not cryptographic related :-).
* 4. If you include any Windows specific code (or a derivative thereof) from
* the apps directory (application code) you must include an acknowledgement:
* "This product includes software written by Tim Hudson (tjh@cryptsoft.com)"
*
* THIS SOFTWARE IS PROVIDED BY ERIC YOUNG ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
* SUCH DAMAGE.
*
* The licence and distribution terms for any publically available version or
* derivative of this code cannot be changed. i.e. this code cannot simply be
* copied and put under another distribution licence
* [including the GNU Public Licence.]
*/
#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;
#include <openssl/crypto.h>
#include <openssl/buffer.h>
#include <openssl/bio.h>
#include <openssl/evp.h>
#include <openssl/err.h>
#include <openssl/x509.h>
#include <openssl/ssl.h>
#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)
#define pr_name_dd(name,p2,p3)
#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);
#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(&PL_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_
PROTOTYPES: ENABLE
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_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);
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 decremented. */
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_nolen(ST(0));
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_nolen(in);
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
#include "openssl.h"
int sv_to_BIGNUM(var,arg,name)
BIGNUM **var;
SV *arg;
char *name;
{
int ret=1;
if (sv_derived_from(arg,"OpenSSL::BN"))
{
IV tmp = SvIV((SV*)SvRV(arg));
*var = (BIGNUM *) tmp;
}
else if (SvIOK(arg)) {
SV *tmp=sv_newmortal();
*var=BN_new();
BN_set_word(*var,SvIV(arg));
sv_setref_pv(tmp,"OpenSSL::BN",(void*)*var);
}
else if (SvPOK(arg)) {
char *ptr;
STRLEN len;
SV *tmp=sv_newmortal();
*var=BN_new();
sv_setref_pv(tmp,"OpenSSL::BN", (void*)*var);
ptr=SvPV(arg,len);
SvGROW(arg,len+1);
ptr[len]='\0';
BN_dec2bn(var,ptr);
}
else
{
croak(name);
ret=0;
}
return(ret);
}
typedef struct gpc_args_st {
SV *cb;
SV *arg;
} GPC_ARGS;
static void generate_prime_callback(pos,num,arg)
int pos;
int num;
char *arg;
{
dSP ;
int i;
GPC_ARGS *a=(GPC_ARGS *)arg;
ENTER ;
SAVETMPS ;
PUSHMARK(sp);
XPUSHs(sv_2mortal(newSViv(pos)));
XPUSHs(sv_2mortal(newSViv(num)));
XPUSHs(sv_2mortal(newSVsv(a->arg)));
PUTBACK;
i=perl_call_sv(a->cb,G_DISCARD);
SPAGAIN;
PUTBACK;
FREETMPS;
LEAVE;
}
MODULE = OpenSSL::BN PACKAGE = OpenSSL::BN PREFIX = p5_BN_
PROTOTYPES: ENABLE
VERSIONCHECK: DISABLE
void
p5_BN_new(...)
PREINIT:
BIGNUM *bn;
SV *arg;
PPCODE:
pr_name("p5_BN_new");
EXTEND(sp,1);
PUSHs(sv_newmortal());
bn=BN_new();
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)bn);
void
p5_BN_dup(a)
BIGNUM *a;
PREINIT:
BIGNUM *bn;
PPCODE:
pr_name("p5_BN_dup");
EXTEND(sp,1);
PUSHs(sv_newmortal());
bn=BN_dup(a);
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)bn);
void
p5_BN_rand(bits,...)
int bits;
PREINIT:
int top=1;
int bottom=0;
BIGNUM *ret;
PPCODE:
pr_name("p5_BN_rand");
if ((items < 1) || (items > 3))
croak("Usage: OpenSSL::BN::rand(bits[,top_bit][,bottombit]");
if (items >= 2) top=(int)SvIV(ST(0));
if (items >= 3) bottom=(int)SvIV(ST(1));
EXTEND(sp,1);
PUSHs(sv_newmortal());
ret=BN_new();
BN_rand(ret,bits,top,bottom);
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)ret);
void
p5_BN_bin2bn(a)
datum a;
PREINIT:
BIGNUM *ret;
PPCODE:
pr_name("p5_BN_bin2bn");
EXTEND(sp,1);
PUSHs(sv_newmortal());
ret=BN_bin2bn(a.dptr,a.dsize,NULL);
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)ret);
void
p5_BN_bn2bin(a)
BIGNUM *a;
PREINIT:
int i;
PPCODE:
pr_name("p5_BN_bn2bin");
EXTEND(sp,1);
PUSHs(sv_newmortal());
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)
datum a;
PREINIT:
BIGNUM *ret;
PPCODE:
pr_name("p5_BN_mpi2bn");
EXTEND(sp,1);
PUSHs(sv_newmortal());
ret=BN_mpi2bn(a.dptr,a.dsize,NULL);
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)ret);
void
p5_BN_bn2mpi(a)
BIGNUM *a;
PREINIT:
int i;
PPCODE:
pr_name("p5_BN_bn2mpi");
EXTEND(sp,1);
PUSHs(sv_newmortal());
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)
datum a;
PREINIT:
BIGNUM *ret;
PPCODE:
pr_name("p5_BN_hex2bn");
EXTEND(sp,1);
PUSHs(sv_newmortal());
ret=BN_new();
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)ret);
BN_hex2bn(&ret,a.dptr);
void
p5_BN_dec2bn(a)
datum a;
PREINIT:
BIGNUM *ret;
PPCODE:
pr_name("p5_BN_dec2bn");
EXTEND(sp,1);
PUSHs(sv_newmortal());
ret=BN_new();
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)ret);
BN_dec2bn(&ret,a.dptr);
SV *
p5_BN_bn2hex(a)
BIGNUM *a;
PREINIT:
char *ptr;
int i;
CODE:
pr_name("p5_BN_bn2hex");
ptr=BN_bn2hex(a);
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
SV *
p5_BN_bn2dec(a)
BIGNUM *a;
PREINIT:
char *ptr;
int i;
CODE:
pr_name("p5_BN_bn2dec");
ptr=BN_bn2dec(a);
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
void
p5_BN_add(a,b)
BIGNUM *a;
BIGNUM *b;
PREINIT:
BIGNUM *ret;
PPCODE:
pr_name("p5_BN_add");
EXTEND(sp,1);
PUSHs(sv_newmortal());
ret=BN_new();
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)ret);
BN_add(ret,a,b);
void
p5_BN_sub(a,b)
BIGNUM *a;
BIGNUM *b;
PREINIT:
BIGNUM *ret;
PPCODE:
pr_name("p5_BN_sub");
EXTEND(sp,1);
PUSHs(sv_newmortal());
ret=BN_new();
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)ret);
BN_sub(ret,a,b);
void
p5_BN_mul(a,b)
BIGNUM *a;
BIGNUM *b;
PREINIT:
static BN_CTX *ctx=NULL;
BIGNUM *ret;
PPCODE:
pr_name("p5_BN_mul");
if (ctx == NULL) ctx=BN_CTX_new();
EXTEND(sp,1);
PUSHs(sv_newmortal());
ret=BN_new();
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)ret);
BN_mul(ret,a,b,ctx);
void
p5_BN_div(a,b)
BIGNUM *a;
BIGNUM *b;
PREINIT:
static BN_CTX *ctx=NULL;
BIGNUM *div,*mod;
PPCODE:
pr_name("p5_BN_div");
if (ctx == NULL) ctx=BN_CTX_new();
EXTEND(sp,2);
PUSHs(sv_newmortal());
PUSHs(sv_newmortal());
div=BN_new();
mod=BN_new();
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)div);
sv_setref_pv(ST(1), "OpenSSL::BN", (void*)mod);
BN_div(div,mod,a,b,ctx);
void
p5_BN_mod(a,b)
BIGNUM *a;
BIGNUM *b;
PREINIT:
static BN_CTX *ctx=NULL;
BIGNUM *rem;
PPCODE:
pr_name("p5_BN_mod");
if (ctx == NULL) ctx=BN_CTX_new();
EXTEND(sp,1);
PUSHs(sv_newmortal());
rem=BN_new();
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)rem);
BN_mod(rem,a,b,ctx);
void
p5_BN_exp(a,p)
BIGNUM *a;
BIGNUM *p;
PREINIT:
BIGNUM *ret;
static BN_CTX *ctx=NULL;
PPCODE:
pr_name("p5_BN_exp");
if (ctx == NULL) ctx=BN_CTX_new();
EXTEND(sp,1);
PUSHs(sv_newmortal());
ret=BN_new();
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)ret);
BN_exp(ret,a,p,ctx);
void
p5_BN_mod_mul(a,b,c)
BIGNUM *a;
BIGNUM *b;
BIGNUM *c;
PREINIT:
static BN_CTX *ctx=NULL;
BIGNUM *ret;
PPCODE:
pr_name("p5_BN_mod_mul");
if (ctx == NULL) ctx=BN_CTX_new();
EXTEND(sp,1);
PUSHs(sv_newmortal());
ret=BN_new();
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)ret);
BN_mod_mul(ret,a,b,c,ctx);
void
p5_BN_mod_exp(a,b,c)
BIGNUM *a;
BIGNUM *b;
BIGNUM *c;
PREINIT:
static BN_CTX *ctx=NULL;
BIGNUM *ret;
PPCODE:
pr_name("p5_BN_mod_exp");
if (ctx == NULL) ctx=BN_CTX_new();
EXTEND(sp,1);
PUSHs(sv_newmortal());
ret=BN_new();
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)ret);
BN_mod_exp(ret,a,b,c,ctx);
void
p5_BN_generate_prime(...)
PREINIT:
int bits=512;
int strong=0;
BIGNUM *ret=NULL;
SV *callback=NULL;
SV *cb_arg=NULL;
GPC_ARGS arg;
dSP;
PPCODE:
pr_name("p5_BN_generate_prime");
if ((items < 0) || (items > 4))
croak("Usage: OpenSSL::BN::generate_prime(a[,strong][,callback][,cb_arg]");
if (items >= 1) bits=(int)SvIV(ST(0));
if (items >= 2) strong=(int)SvIV(ST(1));
if (items >= 3) callback=ST(2);
if (items == 4) cb_arg=ST(3);
if (callback == NULL)
ret=BN_generate_prime(ret,bits,strong,NULL,NULL,NULL,NULL);
else
{
arg.cb=callback;
arg.arg=cb_arg;
ret=BN_generate_prime(ret,bits,strong,NULL,NULL,
generate_prime_callback,(char *)&arg);
}
SPAGAIN;
sp-=items; /* a bit evil that I do this */
EXTEND(sp,1);
PUSHs(sv_newmortal());
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)ret);
void
p5_BN_is_prime(p,...)
BIGNUM *p;
PREINIT:
int nchecks=5,ret;
SV *callback=NULL;
SV *cb_arg=NULL;
GPC_ARGS arg;
dSP;
static BN_CTX *ctx=NULL;
PPCODE:
pr_name("p5_BN_is_prime");
if ((items < 1) || (items > 4))
croak("Usage: OpenSSL::BN::is_prime(a[,ncheck][,callback][,callback_arg]");
if (ctx == NULL) ctx=BN_CTX_new();
if (items >= 2) nchecks=(int)SvIV(ST(1));
if (items >= 3) callback=ST(2);
if (items >= 4) cb_arg=ST(3);
arg.arg=cb_arg;
if (callback == NULL)
ret=BN_is_prime(p,nchecks,NULL,ctx,NULL);
else
{
arg.cb=callback;
arg.arg=cb_arg;
ret=BN_is_prime(p,nchecks,generate_prime_callback,
ctx,(char *)&arg);
}
SPAGAIN;
sp-=items; /* a bit evil */
PUSHs(sv_2mortal(newSViv(ret)));
int
p5_BN_num_bits(a)
BIGNUM *a;
CODE:
pr_name("p5_BN_num_bits");
RETVAL=BN_num_bits(a);
OUTPUT:
RETVAL
int
p5_BN_cmp(a,b)
BIGNUM *a;
BIGNUM *b;
CODE:
pr_name("p5_BN_cmp");
RETVAL=BN_cmp(a,b);
OUTPUT:
RETVAL
int
p5_BN_ucmp(a,b)
BIGNUM *a;
BIGNUM *b;
CODE:
pr_name("p5_BN_ucmp");
RETVAL=BN_ucmp(a,b);
OUTPUT:
RETVAL
int
p5_BN_is_bit_set(a,b)
BIGNUM *a;
int b;
CODE:
pr_name("p5_BN_is_bit_set");
RETVAL=BN_is_bit_set(a,b);
OUTPUT:
RETVAL
void
p5_BN_set_bit(a,b)
BIGNUM *a;
int b;
PREINIT:
BIGNUM *ret;
PPCODE:
pr_name("p5_BN_set_bit");
EXTEND(sp,1);
PUSHs(sv_newmortal());
ret=BN_dup(a);
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)ret);
BN_set_bit(ret,b);
void
p5_BN_clear_bit(a,b)
BIGNUM *a;
int b;
PREINIT:
BIGNUM *ret;
PPCODE:
pr_name("p5_BN_clear_bit");
EXTEND(sp,1);
PUSHs(sv_newmortal());
ret=BN_dup(a);
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)ret);
BN_clear_bit(ret,b);
void
p5_BN_lshift(a,b)
BIGNUM *a;
int b;
PREINIT:
BIGNUM *ret;
PPCODE:
pr_name("p5_BN_lshift");
EXTEND(sp,1);
PUSHs(sv_newmortal());
ret=BN_new();
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)ret);
if (b == 1)
BN_lshift1(ret,a);
else
BN_lshift(ret,a,b);
void
p5_BN_rshift(a,b)
BIGNUM *a;
int b;
PREINIT:
BIGNUM *ret;
PPCODE:
pr_name("p5_BN_rshift");
EXTEND(sp,1);
PUSHs(sv_newmortal());
ret=BN_new();
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)ret);
if (b == 1)
BN_rshift1(ret,a);
else
BN_rshift(ret,a,b);
void
p5_BN_mask_bits(a,b)
BIGNUM *a;
int b;
PREINIT:
BIGNUM *ret;
PPCODE:
pr_name("p5_BN_mask_bits");
EXTEND(sp,1);
PUSHs(sv_newmortal());
ret=BN_dup(a);
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)ret);
BN_mask_bits(ret,b);
void
p5_BN_clear(a)
BIGNUM *a;
PPCODE:
pr_name("p5_BN_clear");
BN_clear(a);
void
p5_BN_gcd(a,b)
BIGNUM *a;
BIGNUM *b;
PREINIT:
static BN_CTX *ctx=NULL;
BIGNUM *ret;
PPCODE:
pr_name("p5_BN_gcd");
if (ctx == NULL) ctx=BN_CTX_new();
EXTEND(sp,1);
PUSHs(sv_newmortal());
ret=BN_new();
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)ret);
BN_gcd(ret,a,b,ctx);
void
p5_BN_mod_inverse(a,mod)
BIGNUM *a;
BIGNUM *mod;
PREINIT:
static BN_CTX *ctx=NULL;
BIGNUM *ret;
PPCODE:
pr_name("p5_BN_mod_inverse");
if (ctx == NULL) ctx=BN_CTX_new();
ret=BN_mod_inverse(ret,a,mod,ctx);
EXTEND(sp,1);
PUSHs(sv_newmortal());
sv_setref_pv(ST(0), "OpenSSL::BN", (void*)ret);
void
p5_BN_DESTROY(bn)
BIGNUM *bn
CODE:
pr_name("p5_BN_DESTROY");
BN_free(bn);
#include "openssl.h"
int boot_cipher()
{
SSLeay_add_all_ciphers();
return(1);
}
MODULE = OpenSSL::Cipher PACKAGE = OpenSSL::Cipher PREFIX = p5_EVP_C_
PROTOTYPES: ENABLE
VERSIONCHECK: DISABLE
void
p5_EVP_C_new(...)
PREINIT:
EVP_CIPHER_CTX *ctx;
const EVP_CIPHER *c;
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());
c=EVP_get_cipherbyname(name);
if (c != NULL)
{
ctx=malloc(sizeof(EVP_CIPHER_CTX));
EVP_EncryptInit(ctx,c,NULL,NULL);
sv_setref_pv(ST(0), "OpenSSL::Cipher", (void*)ctx);
}
datum
p5_EVP_C_name(ctx)
EVP_CIPHER_CTX *ctx
CODE:
RETVAL.dptr=OBJ_nid2ln(EVP_CIPHER_CTX_nid(ctx));
RETVAL.dsize=strlen(RETVAL.dptr);
OUTPUT:
RETVAL
int
p5_EVP_C_key_length(ctx)
EVP_CIPHER_CTX *ctx
CODE:
RETVAL=EVP_CIPHER_CTX_key_length(ctx);
OUTPUT:
RETVAL
int
p5_EVP_C_iv_length(ctx)
EVP_CIPHER_CTX *ctx
CODE:
RETVAL=EVP_CIPHER_CTX_iv_length(ctx);
OUTPUT:
RETVAL
int
p5_EVP_C_block_size(ctx)
EVP_CIPHER_CTX *ctx
CODE:
RETVAL=EVP_CIPHER_CTX_block_size(ctx);
OUTPUT:
RETVAL
void
p5_EVP_C_init(ctx,key,iv,enc)
EVP_CIPHER_CTX *ctx
datum key
datum iv
int enc
PREINIT:
char loc_iv[EVP_MAX_IV_LENGTH];
char loc_key[EVP_MAX_KEY_LENGTH];
char *ip=loc_iv,*kp=loc_key;
int i;
memset(loc_iv,0,EVP_MAX_IV_LENGTH);
memset(loc_key,0,EVP_MAX_KEY_LENGTH);
CODE:
i=key.dsize;
if (key.dsize > EVP_CIPHER_CTX_key_length(ctx))
i=EVP_CIPHER_CTX_key_length(ctx);
if (i > 0)
{
memset(kp,0,EVP_MAX_KEY_LENGTH);
memcpy(kp,key.dptr,i);
}
else
kp=NULL;
i=iv.dsize;
if (iv.dsize > EVP_CIPHER_CTX_iv_length(ctx))
i=EVP_CIPHER_CTX_iv_length(ctx);
if (i > 0)
{
memcpy(ip,iv.dptr,i);
memset(ip,0,EVP_MAX_IV_LENGTH);
}
else
ip=NULL;
EVP_CipherInit(ctx,EVP_CIPHER_CTX_cipher(ctx),kp,ip,enc);
memset(loc_key,0,sizeof(loc_key));
memset(loc_iv,0,sizeof(loc_iv));
SV *
p5_EVP_C_cipher(ctx,in)
EVP_CIPHER_CTX *ctx;
datum in;
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
SV *
p5_EVP_C_update(ctx, in)
EVP_CIPHER_CTX *ctx
datum in
PREINIT:
int i;
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
SV *
p5_EVP_C_final(ctx)
EVP_CIPHER_CTX *ctx
PREINIT:
int i;
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);
OUTPUT:
RETVAL
void
p5_EVP_C_DESTROY(ctx)
EVP_CIPHER_CTX *ctx
CODE:
free((char *)ctx);
#include "openssl.h"
int boot_digest()
{
SSLeay_add_all_digests();
return(1);
}
MODULE = OpenSSL::MD PACKAGE = OpenSSL::MD PREFIX = p5_EVP_MD_
PROTOTYPES: ENABLE
VERSIONCHECK: DISABLE
# OpenSSL::MD::new(name) name= md2, md5, sha, sha1, or mdc2
# md->name() - returns the name
# md->init() - reinitalises the digest
# md->update(data) - adds more data to digest
# digest=md->final() - returns digest
#
void
p5_EVP_MD_new(...)
PREINIT:
EVP_MD_CTX *ctx;
const EVP_MD *md;
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());
md=EVP_get_digestbyname(name);
if (md != NULL)
{
ctx=malloc(sizeof(EVP_MD_CTX));
EVP_DigestInit(ctx,md);
sv_setref_pv(ST(0), "OpenSSL::MD", (void*)ctx);
}
datum
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
void
p5_EVP_MD_init(ctx)
EVP_MD_CTX *ctx
CODE:
EVP_DigestInit(ctx,EVP_MD_CTX_type(ctx));
void
p5_EVP_MD_update(ctx, in)
EVP_MD_CTX *ctx
datum in
CODE:
EVP_DigestUpdate(ctx,in.dptr,in.dsize);
datum
p5_EVP_MD_final(ctx)
EVP_MD_CTX *ctx
PREINIT:
char md[EVP_MAX_MD_SIZE];
int len;
CODE:
EVP_DigestFinal(ctx,md,&len);
RETVAL.dptr=md;
RETVAL.dsize=len;
OUTPUT:
RETVAL
void
p5_EVP_MD_DESTROY(ctx)
EVP_MD_CTX *ctx
CODE:
free((char *)ctx);
#include "openssl.h"
int boot_err()
{
SSL_load_error_strings();
return(1);
}
MODULE = OpenSSL::ERR PACKAGE = OpenSSL::ERR PREFIX = p5_ERR_
PROTOTYPES: ENABLE
VERSIONCHECK: DISABLE
# md->error() - returns the last error in text or numeric context
void
p5_ERR_get_error(...)
PPCODE:
char buf[512];
unsigned long l;
pr_name("p5_ERR_get_code");
EXTEND(sp,1);
PUSHs(sv_newmortal());
l=ERR_get_error();
ERR_error_string(l,buf);
sv_setiv(ST(0),l);
sv_setpv(ST(0),buf);
SvIOK_on(ST(0));
void
p5_ERR_peek_error(...)
PPCODE:
char buf[512];
unsigned long l;
pr_name("p5_ERR_get_code");
EXTEND(sp,1);
PUSHs(sv_newmortal());
l=ERR_peek_error();
ERR_error_string(l,buf);
sv_setiv(ST(0),l);
sv_setpv(ST(0),buf);
SvIOK_on(ST(0));
#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_nolen(ST(0));
else if ((items == 2) && SvPOK(ST(1)))
method=SvPV_nolen(ST(1));
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_nolen(ST(2));
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_nolen(ST(i));
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_nolen(ST(i));
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= &PL_sv_undef;
EXTEND(sp,1);
PUSHs(ret);
#include "openssl.h"
MODULE = OpenSSL::X509 PACKAGE = OpenSSL::X509 PREFIX = p5_X509_
PROTOTYPES: ENABLE
VERSIONCHECK: DISABLE
void
p5_X509_new(void )
PREINIT:
X509 *x509;
SV *arg;
PPCODE:
pr_name("p5_X509_new");
EXTEND(sp,1);
PUSHs(sv_newmortal());
x509=X509_new();
sv_setref_pv(ST(0),"OpenSSL::X509",(void *)x509);
char *
p5_X509_get_subject_name(x509)
X509 *x509;
PREINIT:
char *p;
X509_NAME *name;
char buf[1024];
int i;
CODE:
name=X509_get_subject_name(x509);
X509_NAME_oneline(name,buf,sizeof(buf));
p= &(buf[0]);
RETVAL=p;
OUTPUT:
RETVAL
char *
p5_X509_get_issuer_name(x509)
X509 *x509;
PREINIT:
char *p;
X509_NAME *name;
char buf[1024];
int i;
CODE:
name=X509_get_issuer_name(x509);
X509_NAME_oneline(name,buf,sizeof(buf));
p= &(buf[0]);
RETVAL=p;
OUTPUT:
RETVAL
int
p5_X509_get_version(x509)
X509 *x509;
CODE:
RETVAL=X509_get_version(x509);
OUTPUT:
RETVAL
BIGNUM *
p5_X509_get_serialNumber(x509)
X509 *x509;
CODE:
RETVAL=ASN1_INTEGER_to_BN(X509_get_serialNumber(x509),NULL);
OUTPUT:
RETVAL
void
p5_X509_DESTROY(x509)
X509 *x509;
CODE:
pr_name("p5_X509_DESTROY");
X509_free(x509);
BEGIN {
$| = 1;
print "1..1\n";
}
END {
print "not ok 1\n" unless $loaded;
}
use OpenSSL;
$loaded = 1;
print "ok 1\n";
print "1..1\n";
use OpenSSL;
if ($OpenSSL::VERSION ne '') {
print "ok 1\n";
}
else {
print "not ok 1\n";
}
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";
datum T_DATUM
EVP_MD_CTX * T_MD_CTX
EVP_CIPHER_CTX * T_CIPHER_CTX
BIGNUM * T_BIGNUM
SSL_METHOD * T_SSL_METHOD
SSL_CTX * T_SSL_CTX
SSL_CIPHER * T_SSL_CIPHER
SSL * T_SSL
BIO * T_BIO
X509 * T_X509
INPUT
T_DATUM
$var.dptr=SvPV($arg,$var.dsize);
T_MD_CTX
if (sv_derived_from($arg, \"OpenSSL::MD\")) {
IV tmp = SvIV((SV*)SvRV($arg));
$var = (EVP_MD_CTX *) tmp;
}
else
croak(\"$var is not of type OpenSSL::MD\")
T_CIPHER_CTX
if (sv_derived_from($arg, \"OpenSSL::Cipher\")) {
IV tmp = SvIV((SV*)SvRV($arg));
$var = (EVP_CIPHER_CTX *) tmp;
}
else
croak(\"$var is not of type OpenSSL::Cipher\")
T_BIGNUM
sv_to_BIGNUM(&($var),$arg,\"$var is not of type OpenSSL::MD, int or string\")
T_SSL_METHOD
if (sv_derived_from($arg, \"OpenSSL::SSL::METHOD\")) {
IV tmp = SvIV((SV*)SvRV($arg));
$var = (SSL_METHOD *) tmp;
}
else
croak(\"$var is not of type OpenSSL::SSL::METHOD\")
T_SSL_CTX
if (sv_derived_from($arg, \"OpenSSL::SSL::CTX\")) {
IV tmp = SvIV((SV*)SvRV($arg));
$var = (SSL_CTX *) tmp;
}
else
croak(\"$var is not of type OpenSSL::SSL::CTX\")
T_SSL_CIPHER
if (sv_derived_from($arg, \"OpenSSL::SSL::CIPHER\")) {
IV tmp = SvIV((SV*)SvRV($arg));
$var = (SSL_CIPHER *) tmp;
}
else
croak(\"$var is not of type OpenSSL::SSL::CIPHER\")
T_SSL
if (sv_derived_from($arg, \"OpenSSL::SSL\")) {
IV tmp = SvIV((SV*)SvRV($arg));
$var = (SSL *) tmp;
}
else
croak(\"$var is not of type OpenSSL::SSL\")
T_BIO
if (sv_derived_from($arg, \"OpenSSL::BIO\")) {
IV tmp = SvIV((SV*)SvRV($arg));
$var = (BIO *) tmp;
}
else
croak(\"$var is not of type OpenSSL::BIO\")
T_X509
if (sv_derived_from($arg, \"OpenSSL::X509\")) {
IV tmp = SvIV((SV*)SvRV($arg));
$var = (X509 *) tmp;
}
else
croak(\"$var is not of type OpenSSL::X509\")
OUTPUT
T_DATUM
sv_setpvn($arg,$var.dptr,$var.dsize);
T_MD_CTX
sv_setref_pv($arg, \"OpenSSL::MD\", (void*)$var);
T_CIPHER_CTX
sv_setref_pv($arg, \"OpenSSL::Cipher\", (void*)$var);
T_BIGNUM
sv_setref_pv($arg, \"OpenSSL::BN\", (void*)$var);
T_SSL_METHOD
sv_setref_pv($arg, \"OpenSSL::SSL::METHOD\", (void*)$var);
T_SSL_CTX
sv_setref_pv($arg, \"OpenSSL::SSL::CTX\", (void*)$var);
T_SSL_CIPHER
sv_setref_pv($arg, \"OpenSSL::SSL::CIPHER\", (void*)$var);
T_SSL
sv_setref_pv($arg, \"OpenSSL::SSL\", (void*)$var);
T_BIO
sv_setref_pv($arg, \"OpenSSL::BIO\", (void*)$var);
T_X509
sv_setref_pv($arg, \"OpenSSL::X509\", (void*)$var);
Markdown is supported
0% .
You are about to add 0 people to the discussion. Proceed with caution.
先完成此消息的编辑!
想要评论请 注册