From: mdw Date: Fri, 2 Apr 2004 18:04:01 +0000 (+0000) Subject: Initial checkin. X-Git-Url: https://git.distorted.org.uk/~mdw/catacomb-perl/commitdiff_plain/660b443cc58d4dd4e92730104429fb64d78c7075 Initial checkin. --- 660b443cc58d4dd4e92730104429fb64d78c7075 diff --git a/.skelrc b/.skelrc new file mode 100644 index 0000000..df3505a --- /dev/null +++ b/.skelrc @@ -0,0 +1,9 @@ +;;; -*-emacs-lisp-*- + +(setq skel-alist + (append + '((author . "Straylight/Edgeware") + (licence-text . "[[gpl]]") + (full-title . "the Perl interface to Catacomb") + (program . "Catacomb/Perl")) + skel-alist)) diff --git a/Catacomb.pm b/Catacomb.pm new file mode 100644 index 0000000..154b3db --- /dev/null +++ b/Catacomb.pm @@ -0,0 +1,224 @@ +# -*-perl-*- +# +# $Id: Catacomb.pm,v 1.1 2004/04/02 18:04:01 mdw Exp $ +# +# Perl interface to Catacomb crypto library +# +# (c) 2001 Straylight/Edgeware +# + +#----- Licensing notice ----------------------------------------------------- +# +# This file is part of the Perl interface to Catacomb. +# +# Catacomb/Perl is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# Catacomb/Perl is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Catacomb/Perl; if not, write to the Free Software Foundation, +# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +#----- Revision history ----------------------------------------------------- +# +# $Log: Catacomb.pm,v $ +# Revision 1.1 2004/04/02 18:04:01 mdw +# Initial checkin. +# + +#----- Basic stuff ---------------------------------------------------------- + +package Catacomb; +use DynaLoader; +use Exporter; +@ISA = qw(DynaLoader Exporter); + +$VERSION = "1.0.0"; + +bootstrap Catacomb; + +@EXPORT_OK = qw($random); +%EXPORT_TAGS = ("const" => [qw(GRAND_CRYPTO PGEN_TRY PGEN_FAIL PGEN_PASS + PGEN_DONE PGEN_ABORT PGEN_BEGIN)]); +Exporter::export_ok_tags("const"); + +sub AUTOLOAD { + my $val = const($AUTOLOAD); + *$AUTOLOAD = sub { $val }; + goto &$AUTOLOAD; +} + +#----- Multiprecision arithmetic -------------------------------------------- + +package Catacomb::MP; +use Carp; + +use overload + '+' => sub { _binop(\&add, @_); }, + '-' => sub { _binop(\&sub, @_); }, + '*' => sub { _binop(\&mul, @_); }, + '/' => sub { _binop(\&div, @_); }, + '%' => sub { _binop(\&mod, @_); }, + '&' => sub { _binop(\&and, @_); }, + '|' => sub { _binop(\&or, @_); }, + '^' => sub { _binop(\&xor, @_); }, + '**' => sub { _binop(\&pow, @_); }, + '>>' => sub { &lsr(@_[0, 1]); }, + '<<' => sub { &lsl(@_[0, 1]); }, + '~' => sub { ¬($_[0]) }, + '==' => sub { _binop(\&eq, @_); }, + '<=>' => sub { _binop(\&cmp, @_); }, + '""' => sub { &tostring($_[0]); }, + '0+' => sub { &toint($_[0]); }, + 'sqrt' => sub { &sqrt($_[0]); }, + 'neg' => sub { &neg($_[0]); }; + +sub mod { (&div($_[0], $_[1]))[1]; } + +sub pow { + croak("Usage: Catacomb::MP::pow(a, b)") unless @_ == 2; + my ($a, $b) = @_; + my $r = Catacomb::MP->new(1); + while ($b) { + $r *= $a if $b & 1; + $a = sqr($a); + $b >>= 1; + } + return $r; +} + +sub _binop { + my ($func, $a, $b, $flag) = @_; + return $flag ? &$func($b, $a) : &$func($a, $b); +} + +sub modexp { + croak("Usage: Catacomb::MP::modexp(p, g, x)") unless @_ == 3; + my ($p, $g, $x) = @_; + $g = $p - $g if $g < 0; + $g = $g % $p if $g > $p; + if ($p & 1) { + my $mm = Catacomb::MP::Mont->new($p); + return $mm->exp($g, $x); + } else { + my $mb = Catacomb::MP::Barrett->new($p); + return $mb->exp($g, $x); + } +} + +sub modinv { + croak("Usage: Catacomb::MP::modinv(p, x)") unless @_ == 2; + my ($g, undef, $i) = gcd($_[0], $_[1]); + croak("Arguments aren't coprime in Catacomb::MP::modinv") unless $g == 1; + return $i; +} + +#----- Prime testing -------------------------------------------------------- + +{ + my $cmpg = "Catacomb::MP::Prime::Gen"; + foreach my $i (qw(FilterStepper JumpStepper RabinTester)) { + @{"${cmpg}::${i}::ISA"} = ("${cmpg}::MagicProc"); + } + @{"${cmpg}::MagicProc::ISA"} = ("${cmpg}::Proc"); +} + +#----- Crypto algorithms ---------------------------------------------------- + +package Catacomb; + +foreach my $i (qw(Cipher Hash MAC)) { + my $tag = lc($i); + my @v = (); + my $cl = "Catacomb::${i}Class"; + foreach my $c (&{"${cl}::list"}($cl)) { + my $x = $c->name(); $x =~ tr/a-zA-Z0-9/_/cs; + ${"Catacomb::${i}::${x}"} = undef; # SUYB + ${"Catacomb::${i}::${x}"} = $c; + push(@v, "\$Catacomb::${i}::${x}"); + } + $EXPORT_TAGS{$tag} = \@v; + Exporter::export_ok_tags($tag); +} + +package Catacomb::CipherClass; +use Carp; + +sub encrypt { + croak("Usage: Catacomb::CipherClass::encrypt(cc, k, [iv], plain)") + if @_ < 3 || @_ > 4; + my ($cc, $k, $iv, $p) = @_; + if (@_ == 3) { + $p = $iv; + $iv = undef; + } + my $c = $cc->init($k); + $c->setiv($iv) if defined($iv); + return $c->encrypt($p); +} + +sub decrypt { + croak("Usage: Catacomb::CipherClass::decrypt(cc, k, [iv], cipher)") + if @_ < 3 || @_ > 4; + my ($cc, $k, $iv, $p) = @_; + if (@_ == 3) { + $p = $iv; + $iv = undef; + } + my $c = $cc->init($k); + return $c->decrypt($p); +} + +package Catacomb::HashClass; +use Carp; + +sub hash { + croak("Usage: Catacomb::HashClass::hash(hc, p)") unless @_ == 2; + my ($hc, $p) = @_; + my $h = $hc->init(); + $h->hash($p); + return $h->done(); +} + +package Catacomb::MACClass; +use Carp; + +sub mac { + croak("Usage: Catacomb::MACClass::mac(mc, k, p)") unless @_ == 3; + my ($mc, $k, $p) = @_; + my $m = $mc->key($k); + return $m->hash($p); +} + +package Catacomb::MAC; +use Carp; + +sub hash { + croak("Usage: Catacomb::MAC::hash(m, p)") unless @_ == 2; + my ($m, $p) = @_; + my $h = $m->init(); + $h->hash($p); + return $h->done(); +} + +#----- Random number generators --------------------------------------------- + +package Catacomb; + +foreach my $i (qw(True Fib LC DSA RC4 SEAL MGF Counter OFB Magic)) { + @{"Catacomb::Rand::${i}::ISA"} = qw(Catacomb::Rand); +} + +$Catacomb::random = Catacomb::Rand::True->_global(); +$Catacomb::random->noisesrc(); +$Catacomb::random->seed(160); + +#----- That's all, folks ---------------------------------------------------- + +1; diff --git a/Cipher.pl b/Cipher.pl new file mode 100644 index 0000000..d151c61 --- /dev/null +++ b/Cipher.pl @@ -0,0 +1,51 @@ +#! /usr/bin/perl + +@cipher = qw(blowfish cast128 cast256 des des3 idea rc2 rc5 rijndael serpent + skipjack square tea twofish xtea); +@streams = qw(rc4 seal); +@hash = qw(md5 md4 md2 tiger + sha sha256 sha384 sha512 + rmd128 rmd160 rmd256 rmd320); + +sub enum { + $x = shift; + if (!ref($x)) { return $x; } + elsif (ref($x) eq ARRAY) { return @$x } + else { die "bad ref"; } +} + +sub cross { + my $x = []; + foreach my $i (@_) { + my @y = enum($i); + if (@$x) { + my @x = (); + foreach my $j (@$x) { foreach my $k (@y) { push(@x, $j.$k); } } + $x = \@x; + } else { + $x = \@y; + } + } + return @$x; +} + +print < + +#include +#include +#include + +#include + +EOF +print cross("#include \n"), "\n"; +print cross("#include \n"), "\n"; +print cross("#include \n"), "\n"; diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..1cb3644 --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,21 @@ +~$ +^Makefile$ +^\.cvsignore$ +^\.skelrc +\bCVS\B +\.o$ +^MANIFEST\. +^blib/ +^# +\.aperl$ +\.old$ +^core$ +^catacomb\.c$ +^algs\.c$ +\.bs$ +^perlmain\.c$ +^perl$ +^pm_to_blib$ +^xstmp\.c$ +^catacomb-perl- +^tmp/ diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..b53a393 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,83 @@ +# -*-perl-*- +# +# $Id: Makefile.PL,v 1.1 2004/04/02 18:04:01 mdw Exp $ +# +# Makefile for Catacomb/Perl +# +# (c) 2000 Straylight/Edgeware +# + +#----- Licensing notice ----------------------------------------------------- +# +# This file is part of the Perl interface to Catacomb. +# +# Catacomb/Perl is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# Catacomb/Perl is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Catacomb/Perl; if not, write to the Free Software Foundation, +# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +#----- Revision history ----------------------------------------------------- +# +# $Log: Makefile.PL,v $ +# Revision 1.1 2004/04/02 18:04:01 mdw +# Initial checkin. +# + +use ExtUtils::MakeMaker; +use Config; + +WriteMakefile(NAME => "Catacomb", + DISTNAME => "catacomb-perl", + AUTHOR => "Mark Wooding (mdw\@nsict.org)", + OPTIMIZE => "-O2 -g", + XS => { "catacomb.xs" => "catacomb.c" }, + OBJECT => join(" ", grep { s/$/$Config{_o}/ } + @{[qw(algs mpstuff catacomb algstuff + pgproc utils)]}), + CONFIGURE => \&configure, + PL_FILES => { 'algs.PL' => 'algs.c' }, + depend => { '$(MAKEFILE)' => '$(VERSION_FROM)', + 'catacomb.c' => + join(" ", grep { s/$/.xs/ } + @{[qw(catacomb algorithms mp misc pgen)]}) + }, + VERSION_FROM => "Catacomb.pm"); + +sub libconfig_item { + my $lib = shift; + my $what = shift; + my $out = `$lib-config --$what`; + $? and die("nonzero exit status from $lib-config --$what"); + chomp $out; + $config{$what} .= " " if defined($config{$what}); + $config{$what} .= $out; +} + +sub libconfig { + my $lib = shift; + my $version = shift; + + system("$lib-config --check $version") + and die("$lib version $version not found"); + libconfig_item($lib, "cflags"); + libconfig_item($lib, "libs"); +} + +sub configure { + local %config; + libconfig("mLib", "2.0.0pre4"); + libconfig("catacomb", "2.0.0pre8"); + return { CCFLAGS => $config{cflags}, + LIBS => [ $config{libs} ] }; +} + +#----- That's all, folks ---------------------------------------------------- diff --git a/algorithms.xs b/algorithms.xs new file mode 100644 index 0000000..5844f17 --- /dev/null +++ b/algorithms.xs @@ -0,0 +1,725 @@ +# ---?--- +# +# $Id: algorithms.xs,v 1.1 2004/04/02 18:04:01 mdw Exp $ +# +# Interface to crypto algorithms +# +# (c) 2001 Straylight/Edgeware +# + +#----- Licensing notice ----------------------------------------------------- +# +# This file is part of the Perl interface to Catacomb. +# +# Catacomb/Perl is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# Catacomb/Perl is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Catacomb/Perl; if not, write to the Free Software Foundation, +# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +#----- Revision history ----------------------------------------------------- +# +# $Log: algorithms.xs,v $ +# Revision 1.1 2004/04/02 18:04:01 mdw +# Initial checkin. +# + +MODULE = Catacomb PACKAGE = Catacomb::CipherClass + +PROTOTYPES: DISABLE + +gccipher * +find(me, name) + SV *me + char *name + PREINIT: + const gccipher **cc; + CODE: + RETVAL = 0; + for (cc = ciphertab; *cc; cc++) { + if (strcmp((*cc)->name, name) == 0) { + RETVAL = (gccipher *)*cc; + break; + } + } + OUTPUT: + RETVAL + +SV * +list(me) + SV *me + PREINIT: + const gccipher **cc; + SV *sv; + PPCODE: + for (cc = ciphertab; *cc; cc++) + XPUSHs(RET(*cc, "Catacomb::CipherClass")); + +keysize * +keysz(cc) + gccipher *cc + CODE: + RETVAL = cc->keysz; + OUTPUT: + RETVAL + +char * +name(cc) + gccipher *cc + CODE: + RETVAL = (char *)cc->name; + OUTPUT: + RETVAL + +size_t +blksz(cc) + gccipher *cc + CODE: + RETVAL = cc->blksz; + OUTPUT: + RETVAL + +gcipher * +init(cc, k) + gccipher *cc + SV *k + PREINIT: + STRLEN len; + char *p; + CODE: + p = SvPV(k, len); + if (keysz(len, cc->keysz) != len) { + croak("bad key size %lu for cipher `%s'", + (unsigned long)len, cc->name); + } + RETVAL = cc->init(p, len); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::Cipher + +SV * +DESTROY(c) + gcipher *c + CODE: + c->ops->destroy(c); + XSRETURN_UNDEF; + +SV * +encrypt(c, plain) + gcipher *c + SV *plain + PREINIT: + STRLEN len; + char *p; + CODE: + p = SvPV(plain, len); + RETVAL = NEWSV(0, len ? len : 1); + c->ops->encrypt(c, p, SvPVX(RETVAL), len); + SvCUR_set(RETVAL, len); + SvPOK_on(RETVAL); + OUTPUT: + RETVAL + +SV * +decrypt(c, cipher) + gcipher *c + SV *cipher + PREINIT: + STRLEN len; + char *p; + CODE: + p = SvPV(cipher, len); + RETVAL = NEWSV(0, len ? len : 1); + c->ops->decrypt(c, p, SvPVX(RETVAL), len); + SvCUR_set(RETVAL, len); + SvPOK_on(RETVAL); + OUTPUT: + RETVAL + +SV * +setiv(c, iv) + gcipher *c + SV *iv + PREINIT: + STRLEN len; + char *p; + CODE: + p = SvPV(iv, len); + if (c->ops->c->blksz && len != c->ops->c->blksz) { + croak("IV for block cipher `%s' must be %lu", + c->ops->c->name, (unsigned long)c->ops->c->blksz); + } + c->ops->setiv(c, p); + XSRETURN_UNDEF; + +SV * +bdry(c) + gcipher *c + CODE: + c->ops->bdry(c); + XSRETURN_UNDEF; + +gccipher * +class(c) + gcipher *c + CODE: + RETVAL = (gccipher *)c->ops->c; + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::HashClass + +gchash * +find(me, name) + SV *me + char *name + PREINIT: + const gchash **hc; + CODE: + RETVAL = 0; + for (hc = hashtab; *hc; hc++) { + if (strcmp((*hc)->name, name) == 0) { + RETVAL = (gchash *)*hc; + break; + } + } + OUTPUT: + RETVAL + +SV * +list(me) + SV *me + PREINIT: + const gchash **hc; + SV *sv; + PPCODE: + for (hc = hashtab; *hc; hc++) + XPUSHs(RET(*hc, "Catacomb::HashClass")); + +size_t +hashsz(hc) + gchash *hc + CODE: + RETVAL = hc->hashsz; + OUTPUT: + RETVAL + +char * +name(hc) + gchash *hc + CODE: + RETVAL = (char *)hc->name; + OUTPUT: + RETVAL + +ghash * +init(hc) + gchash *hc + CODE: + RETVAL = hc->init(); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::Hash + +SV * +DESTROY(h) + ghash *h + CODE: + h->ops->destroy(h); + XSRETURN_UNDEF; + +SV * +hash(h, sv) + ghash *h + SV *sv + PREINIT: + STRLEN len; + char *p; + CODE: + p = SvPV(sv, len); + h->ops->hash(h, p, len); + XSRETURN_UNDEF; + +SV * +done(h) + ghash *h + CODE: + RETVAL = NEWSV(0, h->ops->c->hashsz); + h->ops->done(h, SvPVX(RETVAL)); + SvCUR_set(RETVAL, h->ops->c->hashsz); + SvPOK_on(RETVAL); + OUTPUT: + RETVAL + +ghash * +copy(h) + ghash *h + CODE: + RETVAL = h->ops->copy(h); + OUTPUT: + RETVAL + +gchash * +class(h) + ghash *h + CODE: + RETVAL = (gchash *)h->ops->c; + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::MACClass + +gcMAC * +find(me, name) + SV *me + char *name + PREINIT: + const gcMAC **mc; + CODE: + RETVAL = 0; + for (mc = mactab; *mc; mc++) { + if (strcmp((*mc)->name, name) == 0) { + RETVAL = (gcMAC *)*mc; + break; + } + } + OUTPUT: + RETVAL + +SV * +list(me) + SV *me + PREINIT: + const gcMAC **mc; + SV *sv; + PPCODE: + for (mc = mactab; *mc; mc++) + XPUSHs(RET(*mc, "Catacomb::MACClass")); + +size_t +hashsz(mc) + gcMAC *mc + CODE: + RETVAL = mc->hashsz; + OUTPUT: + RETVAL + +keysize * +keysz(mc) + gcMAC *mc + CODE: + RETVAL = mc->keysz; + OUTPUT: + RETVAL + +char * +name(mc) + gcMAC *mc + CODE: + RETVAL = (char *)mc->name; + OUTPUT: + RETVAL + +gMAC * +key(mc, k) + gcMAC *mc + SV *k + PREINIT: + STRLEN len; + char *p; + CODE: + p = SvPV(k, len); + if (keysz(len, mc->keysz) != len) { + croak("bad key size %lu for mac `%s'", + (unsigned long)len, mc->name); + } + RETVAL = mc->key(p, len); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::MAC + +SV * +DESTROY(m) + gMAC *m + CODE: + m->ops->destroy(m); + XSRETURN_UNDEF; + +ghash * +init(m) + gMAC *m + CODE: + RETVAL = m->ops->init(m); + OUTPUT: + RETVAL + +gcMAC * +class(m) + gMAC *m + CODE: + RETVAL = (gcMAC *)m->ops->c; + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::Rand + +SV * +seedint(r, seed) + grand *r + U32 seed + CODE: + if (!r->ops->misc(r, GRAND_CHECK, GRAND_SEEDUINT32)) + croak("rng `%s' doesn't support `seedint'", r->ops->name); + r->ops->misc(r, GRAND_SEEDUINT32, seed); + XSRETURN_UNDEF; + +SV * +seedblock(r, seed) + grand *r + SV *seed + PREINIT: + STRLEN len; + char *p; + CODE: + if (!r->ops->misc(r, GRAND_CHECK, GRAND_SEEDBLOCK)) + croak("rng `%s' doesn't support `seedblock'", r->ops->name); + p = SvPV(seed, len); + r->ops->misc(r, GRAND_SEEDBLOCK, p, len); + XSRETURN_UNDEF; + +SV * +seedmp(r, seed) + grand *r + mp *seed + CODE: + if (!r->ops->misc(r, GRAND_CHECK, GRAND_SEEDMP)) + croak("rng `%s' doesn't support `seedmp'", r->ops->name); + r->ops->misc(r, GRAND_SEEDMP, seed); + XSRETURN_UNDEF; + +SV * +seedrand(r, seed) + grand *r + grand *seed + CODE: + if (!r->ops->misc(r, GRAND_CHECK, GRAND_SEEDRAND)) + croak("rng `%s' doesn't support `seedrand'", r->ops->name); + r->ops->misc(r, GRAND_SEEDRAND, seed); + XSRETURN_UNDEF; + +U32 +raw(r) + grand *r + CODE: + RETVAL = r->ops->raw(r); + OUTPUT: + RETVAL + +U32 +word(r) + grand *r + CODE: + RETVAL = r->ops->word(r); + OUTPUT: + RETVAL + +U8 +byte(r) + grand *r + CODE: + RETVAL = r->ops->byte(r); + OUTPUT: + RETVAL + +char +char(r) + grand *r + CODE: + RETVAL = r->ops->byte(r); + OUTPUT: + RETVAL + +U32 +range(r, limit) + grand *r + U32 limit + CODE: + RETVAL = r->ops->range(r, limit); + OUTPUT: + RETVAL + +mp * +mp(r, bits, or = 0) + grand *r + unsigned or + unsigned bits + CODE: + RETVAL = mprand(MP_NEW, bits, r, or); + OUTPUT: + RETVAL + +mp * +mprange(r, limit) + grand *r + mp *limit + CODE: + RETVAL = mprand_range(MP_NEW, limit, r, 0); + OUTPUT: + RETVAL + +SV * +fill(r, n) + grand *r + size_t n + CODE: + RETVAL = NEWSV(0, n ? n : 1); + r->ops->fill(r, SvPVX(RETVAL), n); + SvCUR_set(RETVAL, n); + SvPOK_on(RETVAL); + OUTPUT: + RETVAL + +char * +name(r) + grand *r + CODE: + RETVAL = (char *)r->ops->name; + OUTPUT: + RETVAL + +U32 +flags(r) + grand *r + CODE: + RETVAL = r->ops->f; + OUTPUT: + RETVAL + +U32 +max(r) + grand *r + CODE: + RETVAL = r->ops->max; + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::Rand::True + +Rand_True * +_global(me) + SV *me + CODE: + RETVAL = &rand_global; + OUTPUT: + RETVAL + +Rand_True * +rand(me) + SV *me + CODE: + RETVAL = rand_create(); + OUTPUT: + RETVAL + +SV * +gate(r) + Rand_True *r + CODE: + r->ops->misc(r, RAND_GATE); + XSRETURN_UNDEF; + +SV * +stretch(r) + Rand_True *r + CODE: + r->ops->misc(r, RAND_STRETCH); + XSRETURN_UNDEF; + +SV * +key(r, k) + Rand_True *r + SV *k + PREINIT: + STRLEN len; + char *p; + CODE: + p = SvPV(k, len); + r->ops->misc(r, RAND_KEY, p, len); + XSRETURN_UNDEF; + +SV * +noisesrc(r) + Rand_True *r + CODE: + r->ops->misc(r, RAND_NOISESRC, &noise_source); + XSRETURN_UNDEF; + +SV * +seed(r, bits = 160) + Rand_True *r + int bits + CODE: + r->ops->misc(r, RAND_SEED, bits); + XSRETURN_UNDEF; + +MODULE = Catacomb PACKAGE = Catacomb::Rand::Fib + +SV * +new(me, seed) + SV *me + U32 seed + CODE: + RETVAL = MAKE(fibrand_create(seed), "Catacomb::Rand::Fib"); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::Rand::LC + +SV * +new(me, seed) + SV *me + U32 seed + CODE: + RETVAL = MAKE(lcrand_create(seed), "Catacomb::Rand::LC"); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::Rand::DSA + +Rand_DSA * +new(me, k) + SV *me + SV *k + PREINIT: + STRLEN len; + char *p; + CODE: + p = SvPV(k, len); + RETVAL = dsarand_create(p, len); + OUTPUT: + RETVAL + +SV * +passes(r, n) + Rand_DSA *r + unsigned n + CODE: + r->ops->misc(r, DSARAND_PASSES, n); + XSRETURN_UNDEF; + +SV * +seed(r) + Rand_DSA *r + PREINIT: + size_t sz; + CODE: + sz = r->ops->misc(r, DSARAND_SEEDSZ); + RETVAL = NEWSV(0, sz ? sz : 1); + r->ops->misc(r, DSARAND_GETSEED, SvPVX(RETVAL)); + SvCUR_set(RETVAL, sz); + SvPOK_on(RETVAL); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::Rand::RC4 + +SV * +new(me, k) + SV *me + SV *k + PREINIT: + STRLEN len; + char *p; + CODE: + p = SvPV(k, len); + RETVAL = MAKE(rc4_rand(p, len), "Catacomb::Rand::RC4"); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::Rand::SEAL + +SV * +new(me, k, n = 0) + SV *me + SV *k + U32 n + PREINIT: + STRLEN len; + char *p; + CODE: + p = SvPV(k, len); + RETVAL = MAKE(seal_rand(p, len, n), "Catacomb::Rand::SEAL"); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::Rand::MGF + +SV * +new(name, k) + char *name + SV *k + CODE: + RETVAL = findrand(mgftab, "Catacomb::Rand::MGF", name, k); + OUTPUT: + RETVAL + +void +list(me) + SV *me + PPCODE: + listrand(mgftab); + +MODULE = Catacomb PACKAGE = Catacomb::Rand::Counter + +SV * +new(name, k) + char *name + SV *k + CODE: + RETVAL = findrand(ctrtab, "Catacomb::Rand::Counter", name, k); + OUTPUT: + RETVAL + +void +list(me) + SV *me + PPCODE: + listrand(ctrtab); + +MODULE = Catacomb PACKAGE = Catacomb::Rand::OFB + +SV * +new(name, k) + char *name + SV *k + CODE: + RETVAL = findrand(ofbtab, "Catacomb::Rand::OFB", name, k); + OUTPUT: + RETVAL + +void +list(me) + SV *me + PPCODE: + listrand(ofbtab); + +MODULE = Catacomb PACKAGE = Catacomb::Rand::Magic + +SV * +DESTROY(r) + grand *r + CODE: + XSRETURN_UNDEF; + +#----- That's all, folks ---------------------------------------------------- diff --git a/algs.PL b/algs.PL new file mode 100644 index 0000000..d16e196 --- /dev/null +++ b/algs.PL @@ -0,0 +1,140 @@ +# -*-perl-*- +# +# $Id: algs.PL,v 1.1 2004/04/02 18:04:01 mdw Exp $ +# +# Create tables of algorithms +# +# (c) 2001 Straylight/Edgeware +# + +#----- Licensing notice ----------------------------------------------------- +# +# This file is part of the Perl interface to Catacomb. +# +# Catacomb/Perl is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# Catacomb/Perl is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Catacomb/Perl; if not, write to the Free Software Foundation, +# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +#----- Revision history ----------------------------------------------------- +# +# $Log: algs.PL,v $ +# Revision 1.1 2004/04/02 18:04:01 mdw +# Initial checkin. +# + +@cipher = qw(des desx des3 + blowfish twofish + cast128 cast256 + idea safer safersk + rc2 rc5 + square rijndael rijndael192 rijndael256 + serpent + skipjack + mars + tea xtea); +@stream = qw(rc4 seal); +@hash = qw(md5 md4 md2 tiger + sha sha256 sha384 sha512 + rmd128 rmd160 rmd256 rmd320); + +sub enum { + $x = shift; + if (!ref($x)) { return $x; } + elsif (ref($x) eq ARRAY) { return @$x } + else { die "bad ref"; } +} + +sub cross { + my $x = []; + foreach my $i (@_) { + my @y = enum($i); + if (@$x) { + my @x = (); + foreach my $j (@$x) { foreach my $k (@y) { push(@x, $j.$k); } } + $x = \@x; + } else { + $x = \@y; + } + } + return @$x; +} + +open OUT, "> $ARGV[0]" or die "couldn't write `$ARGV[0].c': $!"; + +print OUT < + +EOF +print OUT cross("#include \n"), "\n"; +print OUT cross("#include \n"), "\n"; +print OUT cross("#include \n"), "\n"; +print OUT cross("#include \n"), "\n"; + +print OUT <name; rt++) { + if (strcmp(name, rt->name) == 0) + return (MAKE(rt->rand(p, len), cls)); + } + return (0); +} + +void listrand(const struct randtab *rt) +{ + dSP; + for (; rt->name; rt++) + XPUSHs(sv_2mortal(newSVpvn((char *)rt->name, strlen(rt->name)))); +} + +/*----- That's all, folks -------------------------------------------------*/ diff --git a/catacomb-perl.h b/catacomb-perl.h new file mode 100644 index 0000000..a30f27d --- /dev/null +++ b/catacomb-perl.h @@ -0,0 +1,151 @@ +/* -*-c-*- + * + * $Id: catacomb-perl.h,v 1.1 2004/04/02 18:04:01 mdw Exp $ + * + * Main header file for Catacomb/Perl + * + * (c) 2001 Straylight/Edgeware + */ + +/*----- Licensing notice --------------------------------------------------* + * + * This file is part of the Perl interface to Catacomb. + * + * Catacomb/Perl is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * Catacomb/Perl is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with Catacomb/Perl; if not, write to the Free Software Foundation, + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + */ + +/*----- Revision history --------------------------------------------------* + * + * $Log: catacomb-perl.h,v $ + * Revision 1.1 2004/04/02 18:04:01 mdw + * Initial checkin. + * + */ + +#ifndef CATACOMB_PERL_H +#define CATACOMB_PERL_H + +#ifdef __cplusplus + extern "C" { +#endif + +/*----- Header files ------------------------------------------------------*/ + +#include +#include +#include +#include +#include + +#include +#include +#include + +#include +#include +#include + +#include +#include +#include +#include +#include +#include + +#include + +#include +#include +#include +#include +#include +#include +#include + +#include +#include +#include +#include +#include + +/*----- Misc support ------------------------------------------------------*/ + +struct consttab { const char *name; UV val; }; + +extern U32 findconst(const struct consttab *cc, + const char *pkg, const char *name); + +#define SET(sv, ob, ty) sv_setref_pv((sv), (char *)(ty), (void *)(ob)) +#define MAKE(ob, ty) SET(NEWSV(0, 0), ob, ty) +#define RET(ob, ty) SET(sv_newmortal(), ob, ty) + +/*----- Crypto algorithms -------------------------------------------------*/ + +struct randtab { const char *name; grand *(*rand)(const void *, size_t); }; + +typedef const octet keysize; +typedef gmac gMAC; +typedef gcmac gcMAC; + +typedef grand Rand_True, Rand_DSA; + +extern const gccipher *ciphertab[]; +extern const gchash *hashtab[]; +extern const gcmac *mactab[]; +extern const struct randtab mgftab[], ctrtab[], ofbtab[]; + +extern SV *findrand(const struct randtab *rt, const char *cls, + const char *name, SV *k); +extern void listrand(const struct randtab *rt); + +/*------ Multiprecision maths ---------------------------------------------*/ + +typedef mpmont MP_Mont; +typedef mpbarrett MP_Barrett; +typedef mpcrt MP_CRT; + +#define XSINTERFACE_FUNC_SETMP(cv, f) \ + CvXSUBANY(cv).any_dptr = (void (*) _((void *)))(mp_##f) + +#define SET_MP(sv, x) SET(sv, x, "Catacomb::MP") +#define RET_MP(x) RET(x, "Catacomb::MP") + +extern mp *mp_fromiv(mp *d, IV iv); +extern IV mp_toiv(mp *x); +extern mp *mp_readsv(mp *m, SV *sv, STRLEN *off, int radix); +extern int mp_writesv(mp *m, SV *sv, int radix); +extern mp *mp_fromsv(SV *sv, const char *what, int radix, int keep, ...); + +/*----- Prime generation --------------------------------------------------*/ + +typedef struct { pfilt pf; int rc; } MP_Prime_Filter; +typedef rabin MP_Prime_Rabin; +typedef SV MP_Prime_Gen_Proc, MP_Prime_Gen_NullProc; +typedef struct { pgen_proc *p; void *ctx; } pgmagic, MP_Prime_Gen_MagicProc; +typedef struct { pgmagic mg; pgen_filterctx f; } MP_Prime_Gen_FilterStepper; +typedef struct { pgmagic mg; pgen_jumpctx j; pfilt pf; } + MP_Prime_Gen_JumpStepper; +typedef struct { pgmagic mg; rabin r; } MP_Prime_Gen_RabinTester; +typedef struct pgen_event MP_Prime_Gen_Event; + +extern void pgproc_get(SV *sv, pgen_proc **p, void **ctx); + +/*----- That's all, folks -------------------------------------------------*/ + +#ifdef __cplusplus + } +#endif + +#endif diff --git a/catacomb.xs b/catacomb.xs new file mode 100644 index 0000000..fb4db58 --- /dev/null +++ b/catacomb.xs @@ -0,0 +1,63 @@ +/* ---?--- + * + * $Id: catacomb.xs,v 1.1 2004/04/02 18:04:01 mdw Exp $ + * + * Main interface to Catacomb functionality + * + * (c) 2001 Straylight/Edgeware + */ + +/*----- Licensing notice --------------------------------------------------* + * + * This file is part of the Perl interface to Catacomb. + * + * Catacomb/Perl is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * Catacomb/Perl is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with Catacomb/Perl; if not, write to the Free Software Foundation, + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + */ + +/*----- Revision history --------------------------------------------------* + * + * $Log: catacomb.xs,v $ + * Revision 1.1 2004/04/02 18:04:01 mdw + * Initial checkin. + * + */ + +#include "catacomb-perl.h" + +MODULE = Catacomb PACKAGE = Catacomb + +U32 +const(name) + char *name + PREINIT: + const struct consttab ct[] = { +#define C(x) { #x, x } + C(GRAND_CRYPTO), + C(PGEN_BEGIN), C(PGEN_TRY), C(PGEN_FAIL), C(PGEN_PASS), + C(PGEN_DONE), C(PGEN_ABORT), +#undef C + { 0, 0 }, + }; + CODE: + RETVAL = findconst(ct, "Catacomb", name); + OUTPUT: + RETVAL + +PROTOTYPES: DISABLE + +INCLUDE: algorithms.xs +INCLUDE: mp.xs +INCLUDE: misc.xs +INCLUDE: pgen.xs diff --git a/ciphersaber b/ciphersaber new file mode 100755 index 0000000..6cab045 --- /dev/null +++ b/ciphersaber @@ -0,0 +1,144 @@ +#! /usr/bin/perl -w + +use Catacomb; + +my $GRIPE = 0; +my $DEBUG = 0; +my $QUIS = $0; $QUIS =~ s:^.*/::; + +my $MODE = \&encrypt; +my $OFILE = "-"; +my $TAG = "ciphersaber-%s"; + +sub usage { + my $f = shift; + print $f "Usage: $QUIS [-de] [-t TAG] [-o FILE] file...\n"; +} +sub version { + my $f = shift; + print $f "$QUIS, catacomb-perl version $Catacomb::VERSION\n"; +} +sub help { + my $f = shift; + version($f); + print $f "\n"; + usage($f); + print $f <" } @_) : ""), + "\n"; +} + +sub encrypt { + my $salt = pack("N", time()) . $Catacomb::random->fill(6); + debug("salt", $salt); + my $tag = sprintf($TAG, hexify($salt)); + my $pass = Catacomb::Passphrase->verify($tag); + barf("passwords don't match") unless defined($pass); + open OUT, "> $OFILE" or barf("couldn't write file `$OFILE'", $!); + syswrite(OUT, $salt) or barf("error writing `$OFILE'", $!); + my $c = $Catacomb::Cipher::rc4->init($pass . $salt); + foreach my $f (@ARGV ? @ARGV : "-") { + open IN, $f or barf("couldn't read file `$f'", $!); + for (;;) { + my $buf; + my $rc = sysread(IN, $buf, 8192); + barf("error reading `$f'", $!) unless defined($rc); + last unless $rc; + syswrite(OUT, $c->encrypt($buf)) or barf("error writing `$OFILE'", $!); + } + close(IN); + } + close(OUT) or barf("error writing `$OFILE'", $!); +} + +sub decrypt { + open OUT, "> $OFILE" or barf("couldn't write file `$OFILE'", $!); + foreach my $f (@ARGV ? @ARGV : "-") { + open IN, $f or barf("couldn't read file `$f'", $!); + my ($salt, $buf); + my $rc = sysread(IN, $salt, 10); + barf("error reading `$f'", $!) unless defined($rc); + barf("ciphertext file is too short") unless $rc; + debug("salt", $salt); + my $tag = sprintf($TAG, hexify($salt)); + my $pass = Catacomb::Passphrase->read($tag) + or barf("couldn't read passphrase", $!); + my $c = $Catacomb::Cipher::rc4->init($pass . $salt); + for (;;) { + my $buf; + my $rc = sysread(IN, $buf, 8192); + barf("error reading `$f'", $!) unless defined($rc); + last unless $rc; + syswrite(OUT, $c->decrypt($buf)) or barf("error writing `$OFILE'", $!); + } + close(IN); + } + close(OUT) or barf("error writing `$OFILE'", $!); +} + +while (@ARGV) { + my $opt = $ARGV[0]; + last if $opt eq "-" || $opt =~ /^[^-]/; + shift(@ARGV); + last if $opt eq "--"; + $opt = substr($opt, 1); + while (length($opt)) { + my $o = substr($opt, 0, 1); + $opt = substr($opt, 1); + if ($o eq "o") { + $OFILE = length($opt) ? $opt : shift(@ARGV); $opt = ""; + gripe("option `-o' requires an argument") unless defined($OFILE); + } elsif ($o eq "d") { + $MODE = \&decrypt; + } elsif ($o eq "e") { + $MODE = \&encrypt; + } elsif ($o eq "t") { + $TAG = length($opt) ? $opt : shift(@ARGV); $opt = ""; + gripe("option `-t' requires an argument") unless defined($TAG); + } elsif ($o eq "h") { + help(\*STDOUT); + exit(0); + } elsif ($o eq "v") { + version(\*STDOUT); + exit(0); + } elsif ($o eq "u") { + usage(\*STDOUT); + exit(0); + } elsif ($o eq "D") { + $DEBUG = 1; + } else { + gripe("unknown option `-$o'"); + } + } +} +if ($GRIPE) { usage(\*STDERR); exit(1); } + +&$MODE(); +exit(0); + diff --git a/key.xs b/key.xs new file mode 100644 index 0000000..603cce3 --- /dev/null +++ b/key.xs @@ -0,0 +1,74 @@ +# ---?--- +# +# $Id: key.xs,v 1.1 2004/04/02 18:04:01 mdw Exp $ +# +# Key-management interface +# +# (c) 2001 Straylight/Edgeware +# + +#----- Licensing notice ----------------------------------------------------- +# +# This file is part of the Perl interface to Catacomb. +# +# Catacomb/Perl is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# Catacomb/Perl is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Catacomb/Perl; if not, write to the Free Software Foundation, +# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +#----- Revision history ----------------------------------------------------- +# +# $Log: key.xs,v $ +# Revision 1.1 2004/04/02 18:04:01 mdw +# Initial checkin. +# + +MODULE = Catacomb PACKAGE = Catacomb::Key + +MODULE = Catacomb PACKAGE = Catacomb::Key::Data + +MODULE = Catacomb PACKAGE = Catacomb::Key::File PREFIX = key_ + +Key_File * +new(file, how) + char *file + unsigned how + CODE: + RETVAL = CREATE(key_file); + if (key_open(RETVAL, file, how, warn_keyreporter, 0)) { + DESTROY(RETVAL); + RETVAL = 0; + } + OUTPUT: + RETVAL + +SV * +DESTROY(kf) + Key_File *kf + CODE: + key_close(kf); + XSRETURN_UNDEF; + +KEYERR +merge(kf, name, fp) + Key_File *kf + char *name + FILE *fp + CODE: + RETVAL = key_merge(kf, name, fp, warn_keyreporter, 0); + OUTPUT: + RETVAL + +SV * +extract + +#----- That's all, folks ---------------------------------------------------- diff --git a/keystuff.c b/keystuff.c new file mode 100644 index 0000000..377afaf --- /dev/null +++ b/keystuff.c @@ -0,0 +1,62 @@ +/* -*-c-*- + * + * $Id: keystuff.c,v 1.1 2004/04/02 18:04:01 mdw Exp $ + * + * Useful key-management functions + * + * (c) 2001 Straylight/Edgeware + */ + +/*----- Licensing notice --------------------------------------------------* + * + * This file is part of the Perl interface to Catacomb. + * + * Catacomb/Perl is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * Catacomb/Perl is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with Catacomb/Perl; if not, write to the Free Software Foundation, + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + */ + +/*----- Revision history --------------------------------------------------* + * + * $Log: keystuff.c,v $ + * Revision 1.1 2004/04/02 18:04:01 mdw + * Initial checkin. + * + */ + +/*----- Header files ------------------------------------------------------*/ + +/*----- Data structures ---------------------------------------------------*/ + +/*----- Static variables --------------------------------------------------*/ + +/*----- Main code ---------------------------------------------------------*/ + +void warn_keyreporter(const char *file, int line, char *err, void *p) +{ + warn("%s:%i: keyfile error: %s", file, line, msg); +} + +SV *keyerr(int rc) +{ + SV *sv; + if (!rc) + return (&PL_sv_yes); + sv = perl_get_sv("Catacomb::Key::error", TRUE); + sv_setiv(sv, rc); + sv_setpv(sv, key_strerror(rc)); + SvIOK_on(sv); + return (&PL_sv_undef); +} + +/*----- That's all, folks -------------------------------------------------*/ diff --git a/misc.xs b/misc.xs new file mode 100644 index 0000000..8ca3ab8 --- /dev/null +++ b/misc.xs @@ -0,0 +1,84 @@ +# ---?--- +# +# $Id: misc.xs,v 1.1 2004/04/02 18:04:01 mdw Exp $ +# +# Miscellaneous function interfaces +# +# (c) 2001 Straylight/Edgeware +# + +#----- Licensing notice ----------------------------------------------------- +# +# This file is part of the Perl interface to Catacomb. +# +# Catacomb/Perl is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# Catacomb/Perl is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Catacomb/Perl; if not, write to the Free Software Foundation, +# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +#----- Revision history ----------------------------------------------------- +# +# $Log: misc.xs,v $ +# Revision 1.1 2004/04/02 18:04:01 mdw +# Initial checkin. +# + +MODULE = Catacomb PACKAGE = Catacomb::Passphrase + +SV * +read(me, tag, len = 256) + SV *me + char *tag + int len + CODE: + RETVAL = NEWSV(0, len); + if (passphrase_read(tag, PMODE_READ, SvPVX(RETVAL), len + 1)) + XSRETURN_UNDEF; + SvCUR_set(RETVAL, strlen(SvPVX(RETVAL))); + SvPOK_on(RETVAL); + OUTPUT: + RETVAL + +SV * +verify(me, tag, len = 256) + SV *me + char *tag + int len + CODE: + RETVAL = NEWSV(0, len); + if (passphrase_read(tag, PMODE_VERIFY, SvPVX(RETVAL), len + 1)) + XSRETURN_UNDEF; + SvCUR_set(RETVAL, strlen(SvPVX(RETVAL))); + SvPOK_on(RETVAL); + OUTPUT: + RETVAL + +SV * +cancel(me, tag) + SV *me + char *tag + CODE: + passphrase_cancel(tag); + XSRETURN_UNDEF; + +MODULE = Catacomb PACKAGE = Catacomb::KeySize + +int +keysz(ksz, sz) + keysize *ksz + int sz + CODE: + RETVAL = keysz(sz, ksz); + OUTPUT: + RETVAL + +#----- That's all, folks ---------------------------------------------------- diff --git a/mp.xs b/mp.xs new file mode 100644 index 0000000..e405339 --- /dev/null +++ b/mp.xs @@ -0,0 +1,547 @@ +# ---?--- +# +# $Id: mp.xs,v 1.1 2004/04/02 18:04:01 mdw Exp $ +# +# Multiprecision interface +# +# (c) 2000 Straylight/Edgeware +# + +#----- Licensing notice ----------------------------------------------------- +# +# This file is part of the Perl interface to Catacomb. +# +# Catacomb/Perl is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# Catacomb/Perl is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Catacomb/Perl; if not, write to the Free Software Foundation, +# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +# + +#----- Revision history ----------------------------------------------------- +# +# $Log: mp.xs,v $ +# Revision 1.1 2004/04/02 18:04:01 mdw +# Initial checkin. +# + +MODULE = Catacomb PACKAGE = Catacomb::MP PREFIX = mp_ + +mp * +new(me, sv = 0, radix = 0) + SV *me + SV *sv + int radix + CODE: + RETVAL = sv ? mp_fromsv(sv, "sv", radix, 1) : MP_ZERO; + OUTPUT: + RETVAL + +mp * +mp_copy(x) + mp *x + +mp * +loadb(me, sv) + SV *me + SV *sv + PREINIT: + char *p; + STRLEN len; + CODE: + p = SvPV(sv, len); + RETVAL = mp_loadb(MP_NEW, p, len); + OUTPUT: + RETVAL + +mp * +loadl(me, sv) + SV *me + SV *sv + PREINIT: + char *p; + STRLEN len; + CODE: + p = SvPV(sv, len); + RETVAL = mp_loadl(MP_NEW, p, len); + OUTPUT: + RETVAL + +int +metrics(m) + mp *m + INTERFACE_MACRO: + XSINTERFACE_FUNC + XSINTERFACE_FUNC_SETMP + INTERFACE: + octets bits + +SV * +storeb(m, i = -1) + mp *m + int i + PREINIT: + size_t sz; + CODE: + sz = (i < 0) ? mp_octets(m) : i; + RETVAL = NEWSV(0, sz ? sz : 1); + mp_storeb(m, SvPVX(RETVAL), sz); + SvCUR_set(RETVAL, sz); + SvPOK_on(RETVAL); + OUTPUT: + RETVAL + +SV * +storel(m, i = -1) + mp *m + int i + PREINIT: + size_t sz; + CODE: + sz = (i < 0) ? mp_octets(m) : i; + RETVAL = NEWSV(0, sz ? sz : 1); + mp_storel(m, SvPVX(RETVAL), sz); + SvCUR_set(RETVAL, sz); + SvPOK_on(RETVAL); + OUTPUT: + RETVAL + +SV * +tostring(m, radix = 10) + mp *m + int radix + CODE: + RETVAL = NEWSV(0, 0); + mp_writesv(m, RETVAL, radix); + OUTPUT: + RETVAL + +SV * +toint(m) + mp *m + CODE: + RETVAL = newSViv(mp_toiv(m)); + OUTPUT: + RETVAL + +SV * +DESTROY(m) + mp *m + CODE: + mp_drop(m); + XSRETURN_UNDEF; + +mp * +unop(a) + mp *a + C_ARGS: + MP_NEW, a + INTERFACE_MACRO: + XSINTERFACE_FUNC + XSINTERFACE_FUNC_SETMP + INTERFACE: + not sqr sqrt + +mp * +neg(a) + mp *a + CODE: + mp_copy(a); + RETVAL = mp_split(a); + if (RETVAL->v < RETVAL->vl) + RETVAL->f ^= MP_NEG; + OUTPUT: + RETVAL + +mp * +mp_factorial(me, x) + SV *me + IV x + C_ARGS: + x + +mp * +binop(a, b) + mp *a + mp *b + C_ARGS: + MP_NEW, a, b + INTERFACE_MACRO: + XSINTERFACE_FUNC + XSINTERFACE_FUNC_SETMP + INTERFACE: + add sub mul and or xor + +mp * +shiftop(a, n) + mp *a + int n + C_ARGS: + MP_NEW, a, n + INTERFACE_MACRO: + XSINTERFACE_FUNC + XSINTERFACE_FUNC_SETMP + INTERFACE: + lsl lsr + +int +mp_cmp(a, b) + mp *a + mp *b + +int +mp_eq(a, b) + mp *a + mp *b + +int +jacobi(a, n) + mp *a + mp *n + CODE: + if (!MP_LEN(n) || !(n->v[0] & 1)) + croak("n must be odd in Catacomb::MP::jacobi"); + RETVAL = mp_jacobi(a, n); + OUTPUT: + RETVAL + +mp * +mp_modsqrt(p, x) + mp *p + mp *x + C_ARGS: + MP_NEW, x, p + +void +div(a, b) + mp *a + mp *b + PREINIT: + mp *q = MP_NEW, *r = MP_NEW; + PPCODE: + if (MP_EQ(b, MP_ZERO)) + croak("Divide by zero in Catacomb::MP::div"); + q = MP_NEW; + switch (GIMME_V) { + case G_ARRAY: + r = MP_NEW; + mp_div(&q, &r, a, b); + EXTEND(SP, 2); + PUSHs(RET_MP(q)); + PUSHs(RET_MP(r)); + break; + case G_VOID: + break; + default: + mp_div(&q, &r, a, b); + EXTEND(SP, 1); + PUSHs(RET_MP(q)); + break; + } + +void +gcd(a, b) + mp *a + mp *b + PREINIT: + mp *g = MP_NEW, *x = MP_NEW, *y = MP_NEW; + PPCODE: + switch (GIMME_V) { + case G_ARRAY: + mp_gcd(&g, &x, &y, a, b); + EXTEND(SP, 3); + PUSHs(RET_MP(g)); + PUSHs(RET_MP(x)); + PUSHs(RET_MP(y)); + break; + case G_VOID: + break; + default: + mp_gcd(&g, 0, 0, a, b); + EXTEND(SP, 1); + PUSHs(RET_MP(g)); + break; + } + +void +odd(m) + mp *m + PREINIT: + mp *t; + size_t s; + PPCODE: + t = mp_odd(MP_NEW, m, &s); + EXTEND(SP, 2); + PUSHs(RET_MP(t)); + PUSHs(sv_2mortal(newSViv(s))); + +int +smallfactor(x) + mp *x + CODE: + RETVAL = pfilt_smallfactor(x); + OUTPUT: + RETVAL + +MP_Mont * +mont(x) + mp *x + CODE: + if (x->f & MP_NEG) + croak("Argument to Catacomb::MP::mont must be positive"); + if (x->v == x->vl || !(x->v[0] & 1u)) + croak("Argument to Catacomb::MP::mont must be odd"); + RETVAL = CREATE(MP_Mont); + mpmont_create(RETVAL, x); + OUTPUT: + RETVAL + +MP_Barrett * +barrett(x) + mp *x + CODE: + if (x->f & MP_NEG) + croak("Argument to Catacomb::MP::barrett must be positive"); + RETVAL = CREATE(mpbarrett); + mpbarrett_create(RETVAL, x); + OUTPUT: + RETVAL + +MP_Prime_Rabin * +rabin(x) + mp *x + CODE: + if (x->f & MP_NEG) + croak("Argument to Catacomb::MP::rabin must be positive"); + if (x->v == x->vl || !(x->v[0] & 1u)) + croak("Argument to Catacomb::MP::rabin must be odd"); + RETVAL = CREATE(MP_Prime_Rabin); + rabin_create(RETVAL, x); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::MP::Mont PREFIX = mpmont_ + +MP_Mont * +new(me, x) + SV *me + mp *x + CODE: + if (x->f & MP_NEG) + croak("Argument to Catacomb::MP::Mont::new must be positive"); + if (x->v == x->vl || !(x->v[0] & 1u)) + croak("Argument to Catacomb::MP::Mont::new must be odd"); + RETVAL = CREATE(MP_Mont); + mpmont_create(RETVAL, x); + OUTPUT: + RETVAL + +SV * +DESTROY(mm) + MP_Mont *mm + CODE: + mpmont_destroy(mm); + DESTROY(mm); + XSRETURN_UNDEF; + +mp * +mpmont_reduce(mm, x) + MP_Mont *mm + mp *x + C_ARGS: + mm, MP_NEW, x + +mp * +mpmont_mul(mm, x, y) + MP_Mont *mm + mp *x + mp *y + C_ARGS: + mm, MP_NEW, x, y + +mp * +mpmont_expr(mm, g, x) + MP_Mont *mm + mp *g + mp *x + C_ARGS: + mm, MP_NEW, g, x + +mp * +mpmont_exp(mm, g, x) + MP_Mont *mm + mp *g + mp *x + C_ARGS: + mm, MP_NEW, g, x + +mp * +mpmont_mexpr(mm, ...) + MP_Mont *mm + PREINIT: + mp_expfactor *v; + size_t i, j, n; + CODE: + if (items < 3 || !(items & 1)) { + croak("Usage: Catacomb::MP::Mont::mexpr" + "(mm, g_0, x_0, g_1, x_1, ..."); + } + n = (items - 1)/2; + v = xmalloc(n * sizeof(mp_expfactor)); + for (i = 1, j = 0; i < items; i += 2, j++) { + v[j].base = mp_fromsv(ST(i), "g_i", 0, 0); + v[j].exp = mp_fromsv(ST(i + 1), "x_i", 0, 0); + } + RETVAL = mpmont_mexpr(mm, MP_NEW, v, n); + xfree(v); + OUTPUT: + RETVAL + +mp * +mpmont_mexp(mm, ...) + MP_Mont *mm + PREINIT: + mp_expfactor *v; + size_t i, j, n; + CODE: + if (items < 3 || !(items & 1)) { + croak("Usage: Catacomb::MP::Mont::mexp" + "(mm, g_0, x_0, g_1, x_1, ..."); + } + n = (items - 1)/2; + v = xmalloc(n * sizeof(mp_expfactor)); + for (i = 1, j = 0; i < items; i += 2, j++) { + v[j].base = mp_fromsv(ST(i), "g_%lu", 0, 0, (unsigned long)i); + v[j].exp = mp_fromsv(ST(i + 1), "x_%lu", 0, 0, (unsigned long)i); + } + RETVAL = mpmont_mexp(mm, MP_NEW, v, n); + xfree(v); + OUTPUT: + RETVAL + +mp * +r(mm) + MP_Mont *mm + CODE: + RETVAL = mp_copy(mm->r); + OUTPUT: + RETVAL + +mp * +r2(mm) + MP_Mont *mm + CODE: + RETVAL = mp_copy(mm->r2); + OUTPUT: + RETVAL + +mp * +m(mm) + MP_Mont *mm + CODE: + RETVAL = mp_copy(mm->m); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::MP::Barrett PREFIX = mpbarrett_ + +MP_Barrett * +new(me, x) + SV *me + mp *x + CODE: + if (x->f & MP_NEG) + croak("Argument to Catacomb::MP::Barrett::new must be positive"); + RETVAL = CREATE(mpbarrett); + mpbarrett_create(RETVAL, x); + OUTPUT: + RETVAL + +SV * +DESTROY(mb) + MP_Barrett *mb + CODE: + mpbarrett_destroy(mb); + DESTROY(mb); + XSRETURN_UNDEF; + +mp * +mpbarrett_reduce(mb, x) + MP_Barrett *mb + mp *x + C_ARGS: + mb, MP_NEW, x + +mp * +mpbarrett_exp(mb, g, x) + MP_Barrett *mb + mp *g + mp *x + C_ARGS: + mb, MP_NEW, g, x + +mp * +m(mb) + MP_Barrett *mb + CODE: + RETVAL = mp_copy(mb->m); + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::MP::CRT + +MP_CRT * +new(me, ...) + SV *me + PREINIT: + mpcrt_mod *v; + size_t n, i; + CODE: + if (items < 1) + croak("Usage: Catacomb::MP::CRT::new(me, n_0, n_1, ...)"); + n = items - 1; + v = xmalloc(n * sizeof(mpcrt_mod)); + for (i = 0; i < n; i++) { + v[i].m = mp_copy(mp_fromsv(ST(i + 1), "n_%lu", 0, 0, + (unsigned long)i)); + } + RETVAL = CREATE(MP_CRT); + mpcrt_create(RETVAL, v, n, 0); + OUTPUT: + RETVAL + +SV * +DESTROY(mc) + MP_CRT *mc + CODE: + mpcrt_destroy(mc); + xfree(mc->v); + DESTROY(mc); + XSRETURN_UNDEF; + +mp * +solve(mc, ...) + MP_CRT *mc + PREINIT: + mp **v; + size_t n, i; + CODE: + n = mc->k; + if (items - 1 != n) + croak("Wrong number of residues for this CRT context"); + for (i = 0; i < n; i++) + v[i] = mp_fromsv(ST(i + 1), "r_%lu", 0, 0, (unsigned long)i); + RETVAL = mpcrt_solve(mc, MP_NEW, v); + xfree(v); + OUTPUT: + RETVAL + +#----- That's all, folks ---------------------------------------------------- diff --git a/mpstuff.c b/mpstuff.c new file mode 100644 index 0000000..094f987 --- /dev/null +++ b/mpstuff.c @@ -0,0 +1,143 @@ +/* -*-c-*- + * + * $Id: mpstuff.c,v 1.1 2004/04/02 18:04:01 mdw Exp $ + * + * MP manipulation stuff + * + * (c) 2001 Straylight/Edgeware + */ + +/*----- Licensing notice --------------------------------------------------* + * + * This file is part of the Perl interface to Catacomb. + * + * Catacomb/Perl is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * Catacomb/Perl is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with Catacomb/Perl; if not, write to the Free Software Foundation, + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + */ + +/*----- Revision history --------------------------------------------------* + * + * $Log: mpstuff.c,v $ + * Revision 1.1 2004/04/02 18:04:01 mdw + * Initial checkin. + * + */ + +/*----- Header files ------------------------------------------------------*/ + +#include "catacomb-perl.h" + +/*----- Main code ---------------------------------------------------------*/ + +/* --- Convert Perl integers to multiprecision --- */ + +mp *mp_fromiv(mp *d, IV iv) +{ + MP_FROMINT(d, IV, iv); + return (d); +} + +IV mp_toiv(mp *x) +{ + IV i; + MP_TOINT(x, IV, IV_MAX, i); + return (i); +} + +/* --- Parse Perl strings into integers --- */ + +typedef struct mptext_svctx { + SV *sv; + STRLEN i; +} mptext_svctx; + +static int svget(void *p) +{ + mptext_svctx *c = p; + if (c->i >= SvCUR(c->sv)) + return (EOF); + return ((unsigned char)SvPVX(c->sv)[c->i++]); +} + +static void svunget(int ch, void *p) +{ + mptext_svctx *c = p; + if (ch == EOF || c->i == 0) + return; + c->i--; +} + +static int svput(const char *s, size_t sz, void *p) +{ + mptext_svctx *c = p; + sv_catpvn(c->sv, (char *)s, sz); + return (0); +} + +static const mptext_ops mptext_svops = { svget, svunget, svput }; + +mp *mp_readsv(mp *m, SV *sv, STRLEN *off, int radix) +{ + mptext_svctx c; + STRLEN len; + SvPV(sv, len); + if (!SvPOK(sv)) + return (0); + c.sv = sv; + c.i = off ? *off : 0; + m = mp_read(m, radix, &mptext_svops, &c); + if (off) + *off = c.i; + return (m); +} + +int mp_writesv(mp *m, SV *sv, int radix) +{ + mptext_svctx c; + int rc; + STRLEN len; + SvPV(sv, len); + c.sv = sv; + rc = mp_write(m, radix, &mptext_svops, &c); + return (rc); +} + +/* --- Conversion to and from SVs --- */ + +mp *mp_fromsv(SV *sv, const char *what, int radix, int keep, ...) +{ + mp *m; + if (SvROK(sv)) { + if (sv_derived_from(sv, "Catacomb::MP")) + m = (mp *)SvIV((SV *)SvRV(sv)); + else { + va_list ap; + SV *t = NEWSV(0, 0); + va_start(ap, keep); + sv_vsetpvfn(t, what, strlen(what), &ap, 0, 0, 0); + croak("%s is not of type Catacomb::MP", SvPVX(t)); + SvREFCNT_dec(t); + } + } else { + if (SvIOK(sv)) + m = mp_fromiv(MP_NEW, SvIV(sv)); + else + m = mp_readsv(MP_NEW, sv, 0, radix); + if (m && !keep) + RET_MP(m); /* Kill temporary later */ + } + return (m); +} + +/*----- That's all, folks -------------------------------------------------*/ diff --git a/pgen.xs b/pgen.xs new file mode 100644 index 0000000..8955bb8 --- /dev/null +++ b/pgen.xs @@ -0,0 +1,369 @@ +# -*-fundamental-*- +# +# $Id: pgen.xs,v 1.1 2004/04/02 18:04:01 mdw Exp $ +# +# Prime generation gubbins +# +# (c) 2001 Straylight/Edgeware +# + +#----- Licensing notice ----------------------------------------------------- +# +# This file is part of the Perl interface to Catacomb. +# +# Catacomb/Perl is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# Catacomb/Perl is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with Catacomb/Perl; if not, write to the Free Software Foundation, +# Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +#----- Revision history ----------------------------------------------------- +# +# $Log: pgen.xs,v $ +# Revision 1.1 2004/04/02 18:04:01 mdw +# Initial checkin. +# + +MODULE = Catacomb PACKAGE = Catacomb::MP::Prime::Filter + +MP_Prime_Filter * +new(me, x) + SV *me + mp *x + CODE: + RETVAL = CREATE(MP_Prime_Filter); + RETVAL->rc = pfilt_create(&RETVAL->pf, x); + OUTPUT: + RETVAL + +SV * +DESTROY(pf) + MP_Prime_Filter *pf + CODE: + pfilt_destroy(&pf->pf); + DESTROY(pf); + XSRETURN_UNDEF; + +int +status(pf) + MP_Prime_Filter *pf + CODE: + RETVAL = pf->rc; + OUTPUT: + RETVAL + +MP_Prime_Filter * +muladd(pf, m, a) + MP_Prime_Filter *pf + U32 m + U32 a + CODE: + if (m > MPW_MAX) + croak("multiplier too large in Catacomb::MP::Prime::Filter::muladd"); + if (a > MPW_MAX) + croak("step too large in Catacomb::MP::Prime::Filter::muladd"); + RETVAL = CREATE(MP_Prime_Filter); + RETVAL->rc = pfilt_muladd(&RETVAL->pf, &pf->pf, m, a); + OUTPUT: + RETVAL + +int +step(pf, n) + MP_Prime_Filter *pf + U32 n + CODE: + if (n > MPW_MAX) + croak("step too large in Catacomb::MP::Prime::Filter::step"); + RETVAL = pf->rc = pfilt_step(&pf->pf, n); + OUTPUT: + RETVAL + +int +jump(pf, j) + MP_Prime_Filter *pf + MP_Prime_Filter *j + CODE: + RETVAL = pf->rc = pfilt_jump(&pf->pf, &j->pf); + OUTPUT: + RETVAL + +mp * +m(pf) + MP_Prime_Filter *pf + CODE: + RETVAL = mp_copy(pf->pf.m); + OUTPUT: + RETVAL + +MP_Prime_Gen_FilterStepper * +stepper(me, step) + SV *me + unsigned step + CODE: + RETVAL = CREATE(MP_Prime_Gen_FilterStepper); + RETVAL->f.step = step; + RETVAL->mg.p = pgen_filter; + RETVAL->mg.ctx = &RETVAL->f; + OUTPUT: + RETVAL + +MP_Prime_Gen_JumpStepper * +jumper(me, j) + SV *me + mp *j + CODE: + RETVAL = CREATE(MP_Prime_Gen_JumpStepper); + pfilt_create(&RETVAL->pf, j); + RETVAL->j.j = &RETVAL->pf; + RETVAL->mg.p = pgen_jump; + RETVAL->mg.ctx = &RETVAL->j; + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::MP::Prime::Rabin PREFIX = rabin_ + +MP_Prime_Rabin * +new(me, x) + SV *me + mp *x + CODE: + if (x->f & MP_NEG) + croak("Argument to Catacomb::MP::Prime::Rabin must be positive"); + if (x->v == x->vl || !(x->v[0] & 1u)) + croak("Argument to Catacomb::MP::Prime::Rabin must be odd"); + RETVAL = CREATE(MP_Prime_Rabin); + rabin_create(RETVAL, x); + OUTPUT: + RETVAL + +SV * +DESTROY(r) + MP_Prime_Rabin *r + CODE: + rabin_destroy(r); + DESTROY(r); + XSRETURN_UNDEF; + +int +rabin_test(r, g) + MP_Prime_Rabin *r + mp *g + +int +rabin_iters(r) + MP_Prime_Rabin *r + C_ARGS: + mp_bits(r->mm.m) + +int +ntests(bits) + int bits + CODE: + RETVAL = rabin_iters(bits); + OUTPUT: + RETVAL + +MP_Prime_Gen_RabinTester * +tester(me) + SV *me + CODE: + RETVAL = CREATE(MP_Prime_Gen_RabinTester); + RETVAL->mg.p = pgen_test; + RETVAL->mg.ctx = &RETVAL->r; + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::MP::Prime::Gen::MagicProc + +SV * +DESTROY(proc) + MP_Prime_Gen_MagicProc *proc + CODE: + DESTROY(proc); + XSRETURN_UNDEF; + +MODULE = Catacomb PACKAGE = Catacomb::MP::Prime::Gen::FilterStepper + +SV * +DESTROY(s) + MP_Prime_Gen_FilterStepper *s + CODE: + DESTROY(s); + XSRETURN_UNDEF; + +MODULE = Catacomb PACKAGE = Catacomb::MP::Prime::Gen::JumpStepper + +SV * +DESTROY(s) + MP_Prime_Gen_JumpStepper *s + CODE: + pfilt_destroy(&s->pf); + DESTROY(s); + XSRETURN_UNDEF; + +MODULE = Catacomb PACKAGE = Catacomb::MP::Prime::Gen::RabinTester + +SV * +DESTROY(t) + MP_Prime_Gen_RabinTester *t + CODE: + DESTROY(t); + XSRETURN_UNDEF; + +MODULE = Catacomb PACKAGE = Catacomb::MP::Prime::Gen::Proc + +MP_Prime_Gen_MagicProc * +ev(me) + SV *me + CODE: + RETVAL = CREATE(MP_Prime_Gen_MagicProc); + RETVAL->p = pgen_ev; + RETVAL->ctx = 0; + OUTPUT: + RETVAL + +MP_Prime_Gen_MagicProc * +evspin(me) + SV *me + CODE: + RETVAL = CREATE(MP_Prime_Gen_MagicProc); + RETVAL->p = pgen_evspin; + RETVAL->ctx = 0; + OUTPUT: + RETVAL + +MP_Prime_Gen_MagicProc * +subev(me) + SV *me + CODE: + RETVAL = CREATE(MP_Prime_Gen_MagicProc); + RETVAL->p = pgen_subev; + RETVAL->ctx = 0; + OUTPUT: + RETVAL + +MODULE = Catacomb PACKAGE = Catacomb::MP::Prime + +mp * +gen(name, m, steps, stepper, tests, tester, events = &PL_sv_undef) + char *name + mp *m + MP_Prime_Gen_NullProc *events + unsigned steps + MP_Prime_Gen_Proc *stepper + unsigned tests + MP_Prime_Gen_Proc *tester + PREINIT: + pgen_proc *ev, *step, *test; + void *ectx, *sctx, *tctx; + CODE: + pgproc_get(events, &ev, &ectx); + pgproc_get(stepper, &step, &sctx); + pgproc_get(tester, &test, &tctx); + RETVAL = pgen(name, MP_NEW, m, ev, ectx, + steps, step, sctx, tests, test, tctx); + OUTPUT: + RETVAL + +void +strongprime_setup(name, bits, r = &rand_global, n = 0, events = &PL_sv_undef) + char *name + unsigned bits + grand *r + unsigned n + MP_Prime_Gen_NullProc *events + PREINIT: + pgen_proc *ev; + void *ectx; + mp *d; + MP_Prime_Gen_JumpStepper *j; + PPCODE: + pgproc_get(events, &ev, &ectx); + j = CREATE(MP_Prime_Gen_JumpStepper); + d = strongprime_setup(name, MP_NEW, &j->pf, bits, r, n, ev, ectx); + EXTEND(SP, 2); + if (!d) { + DESTROY(j); + PUSHs(&PL_sv_undef); + PUSHs(&PL_sv_undef); + } else { + j->j.j = &j->pf; + j->mg.p = pgen_jump; + j->mg.ctx = &j->j; + PUSHs(RET_MP(d)); + PUSHs(RET(j, "Catacomb::MP::Prime::Gen::JumpStepper")); + } + +void +limlee(name, qbits, pbits, r = &rand_global, on = 0, oevents = &PL_sv_undef, ievents = &PL_sv_undef) + char *name + unsigned qbits + unsigned pbits + grand *r + unsigned on + MP_Prime_Gen_NullProc *oevents + MP_Prime_Gen_NullProc *ievents + PREINIT: + pgen_proc *oev, *iev; + void *oec, *iec; + mp **f; + size_t nf, i; + mp *x; + PPCODE: + pgproc_get(oevents, &oev, &oec); + pgproc_get(ievents, &iev, &iec); + if (GIMME_V == G_SCALAR) { + x = limlee(name, MP_NEW, MP_NEW, qbits, pbits, r, on, + oev, oec, iev, iec, 0, 0); + EXTEND(SP, 1); + PUSHs(RET_MP(x)); + } else { + x = limlee(name, MP_NEW, MP_NEW, qbits, pbits, r, on, + oev, oec, iev, iec, &nf, &f); + EXTEND(SP, 1 + nf); + PUSHs(RET_MP(x)); + for (i = 0; i < nf; i++) + PUSHs(RET_MP(f[i])); + xfree(f); + } + +MODULE = Catacomb PACKAGE = Catacomb::MP::Prime::Gen::Event + +char * +name(ev) + MP_Prime_Gen_Event *ev + CODE: + RETVAL = (char *)ev->name; + OUTPUT: + RETVAL + +mp * +mp(ev, m = 0) + MP_Prime_Gen_Event *ev + mp *m + CODE: + RETVAL = mp_copy(ev->m); + if (items > 1) { + mp_drop(ev->m); + ev->m = mp_copy(m); + } + OUTPUT: + RETVAL + +SV * +rand(ev) + MP_Prime_Gen_Event *ev + CODE: + RETVAL = MAKE(ev->r, "Catacomb::Rand::Magic"); + OUTPUT: + RETVAL + +#----- That's all, folks ---------------------------------------------------- diff --git a/pgproc.c b/pgproc.c new file mode 100644 index 0000000..0701530 --- /dev/null +++ b/pgproc.c @@ -0,0 +1,95 @@ +/* -*-c-*- + * + * $Id: pgproc.c,v 1.1 2004/04/02 18:04:01 mdw Exp $ + * + * Prime generation procedures + * + * (c) 2001 Straylight/Edgeware + */ + +/*----- Licensing notice --------------------------------------------------* + * + * This file is part of the Perl interface to Catacomb. + * + * Catacomb/Perl is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * Catacomb/Perl is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with Catacomb/Perl; if not, write to the Free Software Foundation, + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + */ + +/*----- Revision history --------------------------------------------------* + * + * $Log: pgproc.c,v $ + * Revision 1.1 2004/04/02 18:04:01 mdw + * Initial checkin. + * + */ + +/*----- Header files ------------------------------------------------------*/ + +#include "catacomb-perl.h" + +/*----- Main code ---------------------------------------------------------*/ + +static int perlevent(int rq, pgen_event *e, void *p) +{ + char *meth = 0; + int n; + SV *sv = p; + int rc; + dSP; + + switch (rq) { + case PGEN_BEGIN: meth = "pgen_begin"; break; + case PGEN_TRY: meth = "pgen_try"; break; + case PGEN_FAIL: meth = "pgen_fail"; break; + case PGEN_PASS: meth = "pgen_pass"; break; + case PGEN_DONE: meth = "pgen_done"; break; + case PGEN_ABORT: meth = "pgen_abort"; break; + default: + abort(); + } + + ENTER; + SAVETMPS; + PUSHMARK(SP); + XPUSHs(sv); + XPUSHs(sv_setref_pv(sv_newmortal(), "Catacomb::MP::Prime::Gen::Event", + (void *)e)); + PUTBACK; + n = perl_call_method(meth, G_SCALAR); + assert(n == 1); + SPAGAIN; + rc = POPi; + PUTBACK; + FREETMPS; + LEAVE; + return (rc); +} + +void pgproc_get(SV *sv, pgen_proc **p, void **ctx) +{ + if (!SvOK(sv)) { + *p = 0; + *ctx = 0; + } else if (sv_derived_from(sv, "Catacomb::MP::Prime::Gen::MagicProc")) { + MP_Prime_Gen_MagicProc *mg = + (MP_Prime_Gen_MagicProc *)SvIV((SV *)SvRV(sv)); + *p = mg->p; + *ctx = mg->ctx; + } else { + *p = perlevent; + *ctx = sv; + } +} + +/*----- That's all, folks -------------------------------------------------*/ diff --git a/test.pl b/test.pl new file mode 100644 index 0000000..01b9f63 --- /dev/null +++ b/test.pl @@ -0,0 +1,39 @@ +use Catacomb qw(:const); + +package EV; +@ISA = qw(Catacomb::MP::Prime::Gen::Proc); +sub pgen_begin { my ($me, $ev) = @_; print $ev->name(), ": "; } +sub pgen_pass { print "*"; } +sub pgen_fail { print "."; } +sub pgen_done { print "*\n"; } +sub new { my $me = bless { FLUSH => $| }, $_[0]; $| = 1; return $me; } +sub DESTROY { my $me = shift; $| = $me->{FLUSH}; } + +package main; + +$mm = Catacomb::MP->factorial(16); +$mm2 = $mm; +$mm++; +print join(", ", $mm2->gcd(19)), "\n"; + +$md5 = Catacomb::HashClass->find("md5"); +$h = $md5->init(); +$h->hash("abc"); +$hh = $h->done(); +print length($hh), "\n"; +print unpack("H*", $hh), "\n"; + +foreach $i (Catacomb::CipherClass->list()) { + print $i->name(), "\n"; +} + +$p = Catacomb::MP::Prime::gen("p", $Catacomb::random->mp(512, 3), + 0, Catacomb::MP::Prime::Filter->stepper(4), + 5, Catacomb::MP::Prime::Rabin->tester(), + EV->new()); +$q = Catacomb::MP::Prime::gen("q", $Catacomb::random->mp(512, 3), + 0, Catacomb::MP::Prime::Filter->stepper(4), + 5, Catacomb::MP::Prime::Rabin->tester(), + EV->new()); + +print "p = $p\nq = $q\n"; diff --git a/typemap b/typemap new file mode 100644 index 0000000..0ffd393 --- /dev/null +++ b/typemap @@ -0,0 +1,100 @@ +TYPEMAP +mp * T_MP +gccipher * T_GCALG +gchash * T_GCALG +gcMAC * T_GCALG +gcipher * T_GALG +ghash * T_GALG +gMAC * T_GALG +grand * T_GALG +keysize * T_KEYSZ + +Rand_True * T_CATSTRUCT +Rand_DSA * T_CATSTRUCT + +MP_Mont * T_CATSTRUCT +MP_Barrett * T_CATSTRUCT +MP_Mul * T_CATSTRUCT +MP_CRT * T_CATSTRUCT +MP_Prime_Filter * T_CATSTRUCT +MP_Prime_Rabin * T_CATSTRUCT +MP_Prime_Gen_Event * T_CATSTRUCT +MP_Prime_Gen_Proc * T_PGENPROC +MP_Prime_Gen_NullProc * T_NULLPGENPROC +MP_Prime_Gen_MagicProc * T_CATSTRUCT +MP_Prime_Gen_FilterStepper * T_CATSTRUCT +MP_Prime_Gen_JumpStepper * T_CATSTRUCT +MP_Prime_Gen_RabinTester * T_CATSTRUCT + +Key_File * T_CATSTRUCT +Key_Data * T_CATSTRUCT +Key * T_CATSTRUCT + +KeyErr T_KEYERR + +INPUT +T_MP + $var = mp_fromsv($arg, \"$var\", 0, 0) +T_CATSTRUCT + if (sv_derived_from($arg, \"${my $ntt = $ntype; $ntt =~ s/^(.*)Ptr$/Catacomb::$1/; $ntt =~ s/_/::/g; \$ntt}\")) + $var = ($type)SvIV((SV *)SvRV($arg)); + else + croak(\"$var is not of type ${my $ntt = $ntype; $ntt =~ s/^(.*)Ptr$/Catacomb::$1/; $ntt =~ s/_/::/g; \$ntt}\") +T_GALG + if (sv_derived_from($arg, \"${my $ntt = $ntype; $ntt =~ s/^g(.*)Ptr$/Catacomb::\u$1/; \$ntt}\")) + $var = ($type)SvIV((SV *)SvRV($arg)); + else + croak(\"$var is not of type ${my $ntt = $ntype; $ntt =~ s/^g(.*)Ptr$/Catacomb::\u$1/; \$ntt}\") +T_GCALG + if (sv_derived_from($arg, \"${my $ntt = $ntype; $ntt =~ s/^gc(.*)Ptr$/Catacomb::\u$1Class/; \$ntt}\")) + $var = ($type)SvIV((SV *)SvRV($arg)); + else + croak(\"$var is not of type ${my $ntt = $ntype; $ntt =~ s/^gc(.*)Ptr$/Catacomb::\u$1Class/; \$ntt}\") +T_KEYSZ + if (sv_derived_from($arg, \"Catacomb::KeySize\")) + $var = (keysize *)SvIV((SV *)SvRV($arg)); + else + croak(\"$var is not of type Catacomb::KeySize\") +T_PGENPROC + if (sv_derived_from($arg, \"Catacomb::MP::Prime::Gen::Proc\")) + $var = $arg; + else + croak(\"$var is not of type Catacomb::MP::Prime::Gen::Proc\") +T_NULLPGENPROC + if (!SvOK($arg) || + sv_derived_from($arg, \"Catacomb::MP::Prime::Gen::Proc\")) + $var = $arg; + else + croak(\"$var is not of type Catacomb::MP::Prime::Gen::Proc\") + +OUTPUT +T_MP + if ($var) + sv_setref_pv($arg, \"Catacomb::MP\", (void*)$var); + else + $arg = &PL_sv_undef; +T_CATSTRUCT + if ($var) + sv_setref_pv($arg, \"${my $ntt = $ntype; $ntt =~ s/^(.*)Ptr$/Catacomb::$1/; $ntt =~ s/_/::/g; \$ntt}\", (void *)$var); + else + $arg = &PL_sv_undef; +T_GALG + if ($var) + sv_setref_pv($arg, \"${my $ntt = $ntype; $ntt =~ s/^g(.*)Ptr$/Catacomb::\u$1/; \$ntt}\", (void *)$var); + else + $arg = &PL_sv_undef; +T_GCALG + if ($var) + sv_setref_pv($arg, \"${my $ntt = $ntype; $ntt =~ s/^gc(.*)Ptr$/Catacomb::\u$1Class/; \$ntt}\", (void *)$var); + else + $arg = &PL_sv_undef; +T_KEYSZ + if ($var) + sv_setref_pv($arg, \"Catacomb::KeySize\", (void *)$var); + else + $arg = &PL_sv_undef; +T_PGENPROC + $arg = $var; + +T_KEYERR + $arg = keyerr($var); diff --git a/utils.c b/utils.c new file mode 100644 index 0000000..3d856be --- /dev/null +++ b/utils.c @@ -0,0 +1,56 @@ +/* -*-c-*- + * + * $Id: utils.c,v 1.1 2004/04/02 18:04:01 mdw Exp $ + * + * Utilities for Catacomb/Perl + * + * (c) 2001 Straylight/Edgeware + */ + +/*----- Licensing notice --------------------------------------------------* + * + * This file is part of the Perl interface to Catacomb. + * + * Catacomb/Perl is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * Catacomb/Perl is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with Catacomb/Perl; if not, write to the Free Software Foundation, + * Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + */ + +/*----- Revision history --------------------------------------------------* + * + * $Log: utils.c,v $ + * Revision 1.1 2004/04/02 18:04:01 mdw + * Initial checkin. + * + */ + +/*----- Header files ------------------------------------------------------*/ + +#include "catacomb-perl.h" + +/*----- Main code ---------------------------------------------------------*/ + +U32 findconst(const struct consttab *cc, const char *pkg, const char *name) +{ + const char *p; + if ((p = strrchr(name, ':')) != 0) + name = p + 1; + while (cc->name) { + if (strcmp(cc->name, name) == 0) + return (cc->val); + cc++; + } + croak("unknown %s constant `%s'", pkg, name); +} + +/*----- That's all, folks -------------------------------------------------*/