Various changes. Kinda in the middle of it here, but it seems to work.

[catacomb-perl] / Catacomb.pm

# -*-perl-*-
#
# $Id$
#
# 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.

#----- 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(\&and2c, @_); },
  '|' => sub { _binop(\&or2c, @_); },
  '^' => sub { _binop(\&xor2c, @_); },
  '**' => sub { _binop(\&pow, @_); },
  '>>' => sub { &lsr2c(@_[0, 1]); },
  '<<' => sub { &lsl2c(@_[0, 1]); },
  '~' => sub { &not2c($_[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;
}

#----- Binary polynomials ---------------------------------------------------

package Catacomb::GF;
use Carp;

@ISA = qw(Catacomb::MP);

use overload
  '+' => sub { _binop(\&add, @_); },
  '-' => sub { _binop(\&add, @_); },
  '*' => sub { _binop(\&mul, @_); },
  '/' => sub { _binop(\&div, @_); },
  '%' => sub { _binop(\&mod, @_); },
  '&' => sub { _binop(\&Catacomb::MP::and, @_); },
  '|' => sub { _binop(\&Catacomb::MP::or, @_); },
  '^' => sub { _binop(\&Catacomb::MP::xor, @_); },
  '>>' => sub { &Catacomb::MP::lsr(@_[0, 1]); },
  '<<' => sub { &Catacomb::MP::lsl(@_[0, 1]); },
  '~' => sub { &Catacomb::MP::not($_[0]) },
  '==' => sub { _binop(\&Catacomb::MP::eq, @_); },
  '<=>' => sub { _binop(\&Catacomb::MP::cmp, @_); },
  '""' => sub { "0x" . &Catacomb::MP::tostring($_[0], 16); },
  'neg' => sub { $_[0]; },
  '0+' => sub { &Catacomb::MP::toint($_[0]); };

sub mod { (&div($_[0], $_[1]))[1]; }

sub _binop {
  my ($func, $a, $b, $flag) = @_;
  return $flag ? &$func($b, $a) : &$func($a, $b);
}

#----- 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);
  $c->setiv($iv) if defined($iv);
  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;