From 660b443cc58d4dd4e92730104429fb64d78c7075 Mon Sep 17 00:00:00 2001 From: mdw Date: Fri, 2 Apr 2004 18:04:01 +0000 Subject: [PATCH] Initial checkin. --- .skelrc | 9 + Catacomb.pm | 224 +++++++++++++++++ Cipher.pl | 51 ++++ MANIFEST.SKIP | 21 ++ Makefile.PL | 83 +++++++ algorithms.xs | 725 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ algs.PL | 140 +++++++++++ algstuff.c | 63 +++++ catacomb-perl.h | 151 ++++++++++++ catacomb.xs | 63 +++++ ciphersaber | 144 +++++++++++ key.xs | 74 ++++++ keystuff.c | 62 +++++ misc.xs | 84 +++++++ mp.xs | 547 ++++++++++++++++++++++++++++++++++++++++++ mpstuff.c | 143 +++++++++++ pgen.xs | 369 ++++++++++++++++++++++++++++ pgproc.c | 95 ++++++++ test.pl | 39 +++ typemap | 100 ++++++++ utils.c | 56 +++++ 21 files changed, 3243 insertions(+) create mode 100644 .skelrc create mode 100644 Catacomb.pm create mode 100644 Cipher.pl create mode 100644 MANIFEST.SKIP create mode 100644 Makefile.PL create mode 100644 algorithms.xs create mode 100644 algs.PL create mode 100644 algstuff.c create mode 100644 catacomb-perl.h create mode 100644 catacomb.xs create mode 100755 ciphersaber create mode 100644 key.xs create mode 100644 keystuff.c create mode 100644 misc.xs create mode 100644 mp.xs create mode 100644 mpstuff.c create mode 100644 pgen.xs create mode 100644 pgproc.c create mode 100644 test.pl create mode 100644 typemap create mode 100644 utils.c 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 -------------------------------------------------*/ -- 2.11.0