| 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; |