--- /dev/null
+;;; -*-emacs-lisp-*-
+
+(setq skel-alist
+ (append
+ '((author . "Straylight/Edgeware")
+ (licence-text . "[[gpl]]")
+ (full-title . "the Perl interface to Catacomb")
+ (program . "Catacomb/Perl"))
+ skel-alist))
--- /dev/null
+# -*-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;
--- /dev/null
+#! /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 <<EOF;
+/* -*-c-*-
+ *
+ * Cipher.xs [generated]
+ */
+
+#include <assert.h>
+
+#include <EXTERN.h>
+#include <perl.h>
+#include <XSUB.h>
+
+#include <catacomb/gcipher.h>
+
+EOF
+print cross("#include <catacomb/", \@cipher, "-",
+ [qw(ecb cbc cfb counter ofb)], ".h>\n"), "\n";
+print cross("#include <catacomb/", \@hash, ".h>\n"), "\n";
+print cross("#include <catacomb/", \@hash, "-",
+ [qw(mgf hmac)], ".h>\n"), "\n";
--- /dev/null
+~$
+^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/
--- /dev/null
+# -*-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 ----------------------------------------------------
--- /dev/null
+# ---?---
+#
+# $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 ----------------------------------------------------
--- /dev/null
+# -*-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;
+/* -*-c-*-
+ *
+ * algs.c [generated]
+ */
+
+#include "catacomb-perl.h"
+
+#include <catacomb/crc32.h>
+
+EOF
+print OUT cross("#include <catacomb/", \@cipher, "-",
+ [qw(ecb cbc cfb counter ofb)], ".h>\n"), "\n";
+print OUT cross("#include <catacomb/", \@stream, ".h>\n"), "\n";
+print OUT cross("#include <catacomb/", \@hash, ".h>\n"), "\n";
+print OUT cross("#include <catacomb/", \@hash, "-",
+ [qw(mgf hmac)], ".h>\n"), "\n";
+
+print OUT <<EOF;
+
+const gccipher *ciphertab[] = {
+EOF
+print OUT cross(" &", \@cipher, "_", [qw(ecb cbc cfb counter ofb)], ",\n");
+print OUT cross(" &", \@hash, "_", [qw(mgf)], ",\n");
+print OUT cross(" &", \@stream, ",\n");
+print OUT <<EOF;
+ 0
+};
+
+const gchash *hashtab[] = {
+EOF
+print OUT cross(" &", \@hash, ",\n");
+print OUT <<EOF;
+ &gcrc32,
+ 0
+};
+
+const gcmac *mactab[] = {
+EOF
+print OUT cross(" &", \@hash, "_", [qw(hmac nmac sslmac)], ",\n");
+print OUT <<EOF;
+ 0
+};
+
+const struct randtab mgftab[] = {
+EOF
+foreach my $i (@hash) { print OUT " { \"$i\", ${i}_mgfrand },\n"; }
+print OUT <<EOF;
+ { 0, 0 }
+};
+
+const struct randtab ctrtab[] = {
+EOF
+foreach my $i (@cipher) { print OUT " { \"$i\", ${i}_counterrand },\n"; }
+print OUT <<EOF;
+ { 0, 0 }
+};
+
+const struct randtab ofbtab[] = {
+EOF
+foreach my $i (@cipher) { print OUT " { \"$i\", ${i}_ofbrand },\n"; }
+print OUT <<EOF;
+ { 0, 0 }
+};
+EOF
+
+#----- That's all, folks ----------------------------------------------------
--- /dev/null
+/* -*-c-*-
+ *
+ * $Id: algstuff.c,v 1.1 2004/04/02 18:04:01 mdw Exp $
+ *
+ * Support stuff for 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: algstuff.c,v $
+ * Revision 1.1 2004/04/02 18:04:01 mdw
+ * Initial checkin.
+ *
+ */
+
+/*----- Header files ------------------------------------------------------*/
+
+#include "catacomb-perl.h"
+
+/*----- Main code ---------------------------------------------------------*/
+
+SV *findrand(const struct randtab *rt, const char *cls,
+ const char *name, SV *k)
+{
+ char *p;
+ STRLEN len;
+ p = SvPV(k, len);
+ for (; rt->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 -------------------------------------------------*/
--- /dev/null
+/* -*-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 <assert.h>
+#include <stdio.h>
+#include <stdarg.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include <EXTERN.h>
+#include <perl.h>
+#include <XSUB.h>
+
+#include <catacomb/gcipher.h>
+#include <catacomb/ghash.h>
+#include <catacomb/gmac.h>
+
+#include <catacomb/grand.h>
+#include <catacomb/fibrand.h>
+#include <catacomb/lcrand.h>
+#include <catacomb/dsarand.h>
+#include <catacomb/rand.h>
+#include <catacomb/noise.h>
+
+#include <catacomb/passphrase.h>
+
+#include <catacomb/mp.h>
+#include <catacomb/mpint.h>
+#include <catacomb/mpmul.h>
+#include <catacomb/mprand.h>
+#include <catacomb/mpcrt.h>
+#include <catacomb/mpmont.h>
+#include <catacomb/mpbarrett.h>
+
+#include <catacomb/pfilt.h>
+#include <catacomb/rabin.h>
+#include <catacomb/pgen.h>
+#include <catacomb/limlee.h>
+#include <catacomb/strongprime.h>
+
+/*----- 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
--- /dev/null
+/* ---?---
+ *
+ * $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
--- /dev/null
+#! /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 <<EOF;
+
+Implements the CipherSaber file encryption system (as described in
+http://ciphersaber.gurus.com/). Options available are:
+
+-h Display this help text.
+-v Show the program's version number.
+-u Show this usage message.
+
+-d Decrypt the input files.
+-e Encrypt the input files. [default]
+-t TAG Use TAG as the passphrase tag.
+-o FILE Write the output to FILE.
+EOF
+#'
+}
+
+sub gripe { print STDERR join(": ", $QUIS, @_), "\n"; $GRIPE = 1; }
+sub barf { gripe(@_); exit(1); }
+sub hexify { unpack("H*", join("", @_)); }
+sub unhexify { my $x = join("", @_); $x =~ tr/\s//d; pack("H*", $x); }
+
+sub debug {
+ return unless $DEBUG;
+ my $what = shift(@_);
+ print STDERR
+ "debug: $what",
+ (@_ ? " = " . join(" ", map { "<" . hexify($_) . ">" } @_) : ""),
+ "\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);
+
--- /dev/null
+# ---?---
+#
+# $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 ----------------------------------------------------
--- /dev/null
+/* -*-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 -------------------------------------------------*/
--- /dev/null
+# ---?---
+#
+# $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 ----------------------------------------------------
--- /dev/null
+# ---?---
+#
+# $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 ----------------------------------------------------
--- /dev/null
+/* -*-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 -------------------------------------------------*/
--- /dev/null
+# -*-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 ----------------------------------------------------
--- /dev/null
+/* -*-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 -------------------------------------------------*/
--- /dev/null
+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";
--- /dev/null
+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);
--- /dev/null
+/* -*-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 -------------------------------------------------*/
~mdw / catacomb-perl / commitdiff