chiark - git - mdw - catacomb-perl/blob - Catacomb.pm

   1 # -*-perl-*-
   2 #
   3 # $Id: Catacomb.pm,v 1.2 2004/04/08 01:36:21 mdw Exp $
   4 #
   5 # Perl interface to Catacomb crypto library
   6 #
   7 # (c) 2001 Straylight/Edgeware
   8 #
   9
  10 #----- Licensing notice -----------------------------------------------------
  11 #
  12 # This file is part of the Perl interface to Catacomb.
  13 #
  14 # Catacomb/Perl is free software; you can redistribute it and/or modify
  15 # it under the terms of the GNU General Public License as published by
  16 # the Free Software Foundation; either version 2 of the License, or
  17 # (at your option) any later version.
  18 #
  19 # Catacomb/Perl is distributed in the hope that it will be useful,
  20 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 # GNU General Public License for more details.
  23 #
  24 # You should have received a copy of the GNU General Public License
  25 # along with Catacomb/Perl; if not, write to the Free Software Foundation,
  26 # Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  27
  28 #----- Basic stuff ----------------------------------------------------------
  29
  30 package Catacomb;
  31 use DynaLoader;
  32 use Exporter;
  33 @ISA = qw(DynaLoader Exporter);
  34
  35 $VERSION = "1.0.0";
  36
  37 bootstrap Catacomb;
  38
  39 @EXPORT_OK = qw($random);
  40 %EXPORT_TAGS = ("const" => [qw(GRAND_CRYPTO PGEN_TRY PGEN_FAIL PGEN_PASS
  41                                PGEN_DONE PGEN_ABORT PGEN_BEGIN)]);
  42 Exporter::export_ok_tags("const");
  43
  44 sub AUTOLOAD {
  45   my $val = const($AUTOLOAD);
  46   *$AUTOLOAD = sub { $val };
  47   goto &$AUTOLOAD;
  48 }
  49
  50 #----- Multiprecision arithmetic --------------------------------------------
  51
  52 package Catacomb::MP;
  53 use Carp;
  54
  55 use overload
  56   '+' => sub { _binop(\&add, @_); },
  57   '-' => sub { _binop(\&sub, @_); },
  58   '*' => sub { _binop(\&mul, @_); },
  59   '/' => sub { _binop(\&div, @_); },
  60   '%' => sub { _binop(\&mod, @_); },
  61   '&' => sub { _binop(\&and, @_); },
  62   '|' => sub { _binop(\&or, @_); },
  63   '^' => sub { _binop(\&xor, @_); },
  64   '**' => sub { _binop(\&pow, @_); },
  65   '>>' => sub { &lsr(@_[0, 1]); },
  66   '<<' => sub { &lsl(@_[0, 1]); },
  67   '~' => sub { &not($_[0]) },
  68   '==' => sub { _binop(\&eq, @_); },
  69   '<=>' => sub { _binop(\&cmp, @_); },
  70   '""' => sub { &tostring($_[0]); },
  71   '0+' => sub { &toint($_[0]); },
  72   'sqrt' => sub { &sqrt($_[0]); },
  73   'neg' => sub { &neg($_[0]); };
  74
  75 sub mod { (&div($_[0], $_[1]))[1]; }
  76
  77 sub pow {
  78   croak("Usage: Catacomb::MP::pow(a, b)") unless @_ == 2;
  79   my ($a, $b) = @_;
  80   my $r = Catacomb::MP->new(1);
  81   while ($b) {
  82     $r *= $a if $b & 1;
  83     $a = sqr($a);
  84     $b >>= 1;
  85   }
  86   return $r;
  87 }
  88
  89 sub _binop {
  90   my ($func, $a, $b, $flag) = @_;
  91   return $flag ? &$func($b, $a) : &$func($a, $b);
  92 }
  93
  94 sub modexp {
  95   croak("Usage: Catacomb::MP::modexp(p, g, x)") unless @_ == 3;
  96   my ($p, $g, $x) = @_;
  97   $g = $p - $g if $g < 0;
  98   $g = $g % $p if $g > $p;
  99   if ($p & 1) {
 100     my $mm = Catacomb::MP::Mont->new($p);
 101     return $mm->exp($g, $x);
 102   } else {
 103     my $mb = Catacomb::MP::Barrett->new($p);
 104     return $mb->exp($g, $x);
 105   }
 106 }
 107
 108 sub modinv {
 109   croak("Usage: Catacomb::MP::modinv(p, x)") unless @_ == 2;
 110   my ($g, undef, $i) = gcd($_[0], $_[1]);
 111   croak("Arguments aren't coprime in Catacomb::MP::modinv") unless $g == 1;
 112   return $i;
 113 }
 114
 115 #----- Prime testing --------------------------------------------------------
 116
 117 {
 118   my $cmpg = "Catacomb::MP::Prime::Gen";
 119   foreach my $i (qw(FilterStepper JumpStepper RabinTester)) {
 120     @{"${cmpg}::${i}::ISA"} = ("${cmpg}::MagicProc");
 121   }
 122   @{"${cmpg}::MagicProc::ISA"} = ("${cmpg}::Proc");
 123 }
 124
 125 #----- Crypto algorithms ----------------------------------------------------
 126
 127 package Catacomb;
 128
 129 foreach my $i (qw(Cipher Hash MAC)) {
 130   my $tag = lc($i);
 131   my @v = ();
 132   my $cl = "Catacomb::${i}Class";
 133   foreach my $c (&{"${cl}::list"}($cl)) {
 134     my $x = $c->name(); $x =~ tr/a-zA-Z0-9/_/cs;
 135     ${"Catacomb::${i}::${x}"} = undef; # SUYB
 136     ${"Catacomb::${i}::${x}"} = $c;
 137     push(@v, "\$Catacomb::${i}::${x}");
 138   }
 139   $EXPORT_TAGS{$tag} = \@v;
 140   Exporter::export_ok_tags($tag);
 141 }
 142
 143 package Catacomb::CipherClass;
 144 use Carp;
 145
 146 sub encrypt {
 147   croak("Usage: Catacomb::CipherClass::encrypt(cc, k, [iv], plain)")
 148     if @_ < 3 || @_ > 4;
 149   my ($cc, $k, $iv, $p) = @_;
 150   if (@_ == 3) {
 151     $p = $iv;
 152     $iv = undef;
 153   }
 154   my $c = $cc->init($k);
 155   $c->setiv($iv) if defined($iv);
 156   return $c->encrypt($p);
 157 }
 158
 159 sub decrypt {
 160   croak("Usage: Catacomb::CipherClass::decrypt(cc, k, [iv], cipher)")
 161     if @_ < 3 || @_ > 4;
 162   my ($cc, $k, $iv, $p) = @_;
 163   if (@_ == 3) {
 164     $p = $iv;
 165     $iv = undef;
 166   }
 167   my $c = $cc->init($k);
 168   return $c->decrypt($p);
 169 }
 170
 171 package Catacomb::HashClass;
 172 use Carp;
 173
 174 sub hash {
 175   croak("Usage: Catacomb::HashClass::hash(hc, p)") unless @_ == 2;
 176   my ($hc, $p) = @_;
 177   my $h = $hc->init();
 178   $h->hash($p);
 179   return $h->done();
 180 }
 181
 182 package Catacomb::MACClass;
 183 use Carp;
 184
 185 sub mac {
 186   croak("Usage: Catacomb::MACClass::mac(mc, k, p)") unless @_ == 3;
 187   my ($mc, $k, $p) = @_;
 188   my $m = $mc->key($k);
 189   return $m->hash($p);
 190 }
 191
 192 package Catacomb::MAC;
 193 use Carp;
 194
 195 sub hash {
 196   croak("Usage: Catacomb::MAC::hash(m, p)") unless @_ == 2;
 197   my ($m, $p) = @_;
 198   my $h = $m->init();
 199   $h->hash($p);
 200   return $h->done();
 201 }
 202
 203 #----- Random number generators ---------------------------------------------
 204
 205 package Catacomb;
 206
 207 foreach my $i (qw(True Fib LC DSA RC4 SEAL MGF Counter OFB Magic)) {
 208   @{"Catacomb::Rand::${i}::ISA"} = qw(Catacomb::Rand);
 209 }
 210
 211 $Catacomb::random = Catacomb::Rand::True->_global();
 212 $Catacomb::random->noisesrc();
 213 $Catacomb::random->seed(160);
 214
 215 #----- That's all, folks ----------------------------------------------------
 216
 217 1;