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

   1 # -*-perl-*-
   2 #
   3 # $Id$
   4 #
   5 # Cryptographic algorithms
   6 #
   7 # (c) 2004 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 #----- Symmetric crypto algorithms -----------------------------------------
  29
  30 package Catacomb;
  31 use Catacomb::Base;
  32 use Exporter;
  33
  34 foreach my $i (qw(PRP Cipher Hash MAC)) {
  35   my $tag = lc($i);
  36   my @v = ();
  37   my $cl = "Catacomb::${i}Class";
  38   foreach my $c (Catacomb::list($tag)) {
  39     (my $x = $c) =~ tr/a-zA-Z0-9/_/cs;
  40     $$x = undef; # SUYB
  41     $$x = $cl->find($c);
  42     push(@v, "\$$x");
  43   }
  44   $EXPORT_TAGS{$tag} = \@v;
  45   Exporter::export_ok_tags($tag);
  46 }
  47
  48 package Catacomb::PRPClass;
  49 use Carp;
  50
  51 sub eblk {
  52   croak("Usage: Catacomb::PRPClass::eblk(pc, k, pt)") unless @_ == 3;
  53   my ($pc, $k, $pt) = @_;
  54   my $P = $pc->init($k);
  55   return $P->eblk($pt);
  56 }
  57
  58 sub dblk {
  59   croak("Usage: Catacomb::PRPClass::dblk(pc, k, ct)") unless @_ == 3;
  60   my ($pc, $k, $pt) = @_;
  61   my $P = $pc->init($k);
  62   return $P->dblk($ct);
  63 }
  64
  65 package Catacomb::CipherClass;
  66 use Carp;
  67
  68 sub encrypt {
  69   croak("Usage: Catacomb::CipherClass::encrypt(cc, k, [iv], plain)")
  70     if @_ < 3 || @_ > 4;
  71   my ($cc, $k, $iv, $p) = @_;
  72   if (@_ == 3) {
  73     $p = $iv;
  74     $iv = undef;
  75   }
  76   my $c = $cc->init($k);
  77   $c->setiv($iv) if defined($iv);
  78   return $c->encrypt($p);
  79 }
  80
  81 sub decrypt {
  82   croak("Usage: Catacomb::CipherClass::decrypt(cc, k, [iv], cipher)")
  83     if @_ < 3 || @_ > 4;
  84   my ($cc, $k, $iv, $p) = @_;
  85   if (@_ == 3) {
  86     $p = $iv;
  87     $iv = undef;
  88   }
  89   my $c = $cc->init($k);
  90   $c->setiv($iv) if defined($iv);
  91   return $c->decrypt($p);
  92 }
  93
  94 package Catacomb::HashClass;
  95 use Carp;
  96
  97 sub hash {
  98   croak("Usage: Catacomb::HashClass::hash(hc, p)") unless @_ == 2;
  99   my ($hc, $p) = @_;
 100   my $h = $hc->init();
 101   $h->hash($p);
 102   return $h->done();
 103 }
 104
 105 package Catacomb::MACClass;
 106 use Carp;
 107
 108 sub mac {
 109   croak("Usage: Catacomb::MACClass::mac(mc, k, p)") unless @_ == 3;
 110   my ($mc, $k, $p) = @_;
 111   my $m = $mc->key($k);
 112   return $m->hash($p);
 113 }
 114
 115 package Catacomb::MAC;
 116 use Carp;
 117
 118 sub hash {
 119   croak("Usage: Catacomb::MAC::hash(m, p)") unless @_ == 2;
 120   my ($m, $p) = @_;
 121   my $h = $m->init();
 122   $h->hash($p);
 123   return $h->done();
 124 }
 125
 126 #----- DSA and KCDSA signing ------------------------------------------------
 127
 128 package Catacomb::DSA;
 129 use Carp;
 130 sub new {
 131   croak("Usage: ${me}::new(me, info)") unless @_ == 2;
 132   my ($me, $info) = @_;
 133   return bless $info, $me;
 134 }
 135
 136 *Catacomb::KCDSA::new = \&new;
 137
 138 foreach my $i (qw(DSA KCDSA)) {
 139   @{"Catacomb::${i}::Public::ISA"} = ("Catacomb::${i}");
 140   @{"Catacomb::${i}::Private::ISA"} = ("Catacomb::${i}::Public");
 141 }
 142
 143 #----- RSA signing and encryption -------------------------------------------
 144
 145 package Catacomb::RSA::Pad;
 146 use Carp;
 147
 148 sub new {
 149   croak("Usage: ${me}::new(me, info)") unless @_ == 2;
 150   my ($me, $info) = @_;
 151   return bless $info, $me;
 152 }
 153
 154 foreach my $i (qw(PKCS1Crypt PKCS1Sign OAEP PSS)) {
 155   @{"Catacomb::RSA::${i}::ISA"} = qw(Catacomb::RSA::Pad);
 156 }
 157
 158 package Catacomb::RSA::Public;
 159 use Carp;
 160 use Catacomb::Base;
 161 use Catacomb::MP;
 162
 163 sub encrypt {
 164   croak("Usage: Catacomb::RSA::Public::encrypt(pub, pad, msg)")
 165     unless @_ == 3;
 166   my ($pub, $pad, $msg) = @_;
 167   my $n = $pub->n();
 168   my $r = $pad->pad($msg, $n->octets(), $n->bits());
 169   return undef unless defined($r);
 170   return $pub->op($r);
 171 }
 172
 173 sub verify {
 174   croak("Usage: Catacomb::RSA::Public::verify(pub, pad, sig, [msg])")
 175     unless @_ >= 3 && @_ <= 4;
 176   my ($pub, $pad, $sig, $msg) = @_;
 177   my $n = $pub->n();
 178   my $rc = $pad->unpad($pub->op($sig), $msg, $n->octets(), $n->bits());
 179   return undef unless defined($rc);
 180   if (defined($msg)) {
 181     return undef unless $rc eq "" || $rc eq $msg;
 182     return 1;
 183   } else {
 184     return $rc;
 185   }
 186 }
 187
 188 package Catacomb::RSA::Private;
 189 use Carp;
 190 use Catacomb::Base;
 191 use Catacomb::MP;
 192
 193 sub sign {
 194   croak("Usage: Catacomb::RSA::Private::sign(priv, pad, msg, [rng]")
 195     unless @_ >= 3 && @_ <= 4;
 196   my ($priv, $pad, $msg, $rng) = @_;
 197   my $n = $priv->n();
 198   my $r = $pad->pad($msg, $n->octets(), $n->bits());
 199   return undef unless defined($r);
 200   return $priv->op($r, $rng);
 201 }
 202
 203 sub decrypt {
 204   croak("Usage: Catacomb::RSA::Private::decrypt(priv, pad, ct, [rng]")
 205     unless @_ >= 3 && @_ <= 4;
 206   my ($priv, $pad, $ct, $rng) = @_;
 207   my $n = $priv->n();
 208   return $pad->unpad($priv->op($ct, $rng), $n->octets(), $n->bits());
 209 }
 210
 211 #----- That's all, folks ----------------------------------------------------
 212
 213 1;