mdw@git.distorted.org.uk Git - catacomb-perl/blob - Catacomb.pm

   1 # -*-perl-*-
   2 #
   3 # $Id$
   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(\&and2c, @_); },
  62   '|' => sub { _binop(\&or2c, @_); },
  63   '^' => sub { _binop(\&xor2c, @_); },
  64   '**' => sub { _binop(\&pow, @_); },
  65   '>>' => sub { &lsr2c(@_[0, 1]); },
  66   '<<' => sub { &lsl2c(@_[0, 1]); },
  67   '~' => sub { &not2c($_[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 #----- Binary polynomials ---------------------------------------------------
 116
 117 package Catacomb::GF;
 118 use Carp;
 119
 120 @ISA = qw(Catacomb::MP);
 121
 122 use overload
 123   '+' => sub { _binop(\&add, @_); },
 124   '-' => sub { _binop(\&add, @_); },
 125   '*' => sub { _binop(\&mul, @_); },
 126   '/' => sub { _binop(\&div, @_); },
 127   '%' => sub { _binop(\&mod, @_); },
 128   '&' => sub { _binop(\&Catacomb::MP::and, @_); },
 129   '|' => sub { _binop(\&Catacomb::MP::or, @_); },
 130   '^' => sub { _binop(\&Catacomb::MP::xor, @_); },
 131   '>>' => sub { &Catacomb::MP::lsr(@_[0, 1]); },
 132   '<<' => sub { &Catacomb::MP::lsl(@_[0, 1]); },
 133   '~' => sub { &Catacomb::MP::not($_[0]) },
 134   '==' => sub { _binop(\&Catacomb::MP::eq, @_); },
 135   '<=>' => sub { _binop(\&Catacomb::MP::cmp, @_); },
 136   '""' => sub { "0x" . &Catacomb::MP::tostring($_[0], 16); },
 137   'neg' => sub { $_[0]; },
 138   '0+' => sub { &Catacomb::MP::toint($_[0]); };
 139
 140 sub mod { (&div($_[0], $_[1]))[1]; }
 141
 142 sub _binop {
 143   my ($func, $a, $b, $flag) = @_;
 144   return $flag ? &$func($b, $a) : &$func($a, $b);
 145 }
 146
 147 #----- Prime testing --------------------------------------------------------
 148
 149 {
 150   my $cmpg = "Catacomb::MP::Prime::Gen";
 151   foreach my $i (qw(FilterStepper JumpStepper RabinTester)) {
 152     @{"${cmpg}::${i}::ISA"} = ("${cmpg}::MagicProc");
 153   }
 154   @{"${cmpg}::MagicProc::ISA"} = ("${cmpg}::Proc");
 155 }
 156
 157 #----- Crypto algorithms ----------------------------------------------------
 158
 159 package Catacomb;
 160
 161 foreach my $i (qw(Cipher Hash MAC)) {
 162   my $tag = lc($i);
 163   my @v = ();
 164   my $cl = "Catacomb::${i}Class";
 165   foreach my $c (&{"${cl}::list"}($cl)) {
 166     my $x = $c->name(); $x =~ tr/a-zA-Z0-9/_/cs;
 167     ${"Catacomb::${i}::${x}"} = undef; # SUYB
 168     ${"Catacomb::${i}::${x}"} = $c;
 169     push(@v, "\$Catacomb::${i}::${x}");
 170   }
 171   $EXPORT_TAGS{$tag} = \@v;
 172   Exporter::export_ok_tags($tag);
 173 }
 174
 175 package Catacomb::CipherClass;
 176 use Carp;
 177
 178 sub encrypt {
 179   croak("Usage: Catacomb::CipherClass::encrypt(cc, k, [iv], plain)")
 180     if @_ < 3 || @_ > 4;
 181   my ($cc, $k, $iv, $p) = @_;
 182   if (@_ == 3) {
 183     $p = $iv;
 184     $iv = undef;
 185   }
 186   my $c = $cc->init($k);
 187   $c->setiv($iv) if defined($iv);
 188   return $c->encrypt($p);
 189 }
 190
 191 sub decrypt {
 192   croak("Usage: Catacomb::CipherClass::decrypt(cc, k, [iv], cipher)")
 193     if @_ < 3 || @_ > 4;
 194   my ($cc, $k, $iv, $p) = @_;
 195   if (@_ == 3) {
 196     $p = $iv;
 197     $iv = undef;
 198   }
 199   my $c = $cc->init($k);
 200   $c->setiv($iv) if defined($iv);
 201   return $c->decrypt($p);
 202 }
 203
 204 package Catacomb::HashClass;
 205 use Carp;
 206
 207 sub hash {
 208   croak("Usage: Catacomb::HashClass::hash(hc, p)") unless @_ == 2;
 209   my ($hc, $p) = @_;
 210   my $h = $hc->init();
 211   $h->hash($p);
 212   return $h->done();
 213 }
 214
 215 package Catacomb::MACClass;
 216 use Carp;
 217
 218 sub mac {
 219   croak("Usage: Catacomb::MACClass::mac(mc, k, p)") unless @_ == 3;
 220   my ($mc, $k, $p) = @_;
 221   my $m = $mc->key($k);
 222   return $m->hash($p);
 223 }
 224
 225 package Catacomb::MAC;
 226 use Carp;
 227
 228 sub hash {
 229   croak("Usage: Catacomb::MAC::hash(m, p)") unless @_ == 2;
 230   my ($m, $p) = @_;
 231   my $h = $m->init();
 232   $h->hash($p);
 233   return $h->done();
 234 }
 235
 236 #----- Random number generators ---------------------------------------------
 237
 238 package Catacomb;
 239
 240 foreach my $i (qw(True Fib LC DSA RC4 SEAL MGF Counter OFB Magic)) {
 241   @{"Catacomb::Rand::${i}::ISA"} = qw(Catacomb::Rand);
 242 }
 243
 244 $Catacomb::random = Catacomb::Rand::True->_global();
 245 $Catacomb::random->noisesrc();
 246 $Catacomb::random->seed(160);
 247
 248 #----- That's all, folks ----------------------------------------------------
 249
 250 1;