| 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 fill { |
| 82 | croak("Usage: Catacomb::CipherClass::fill(cc, k, [iv], len)") |
| 83 | if @_ < 3 || @_ > 4; |
| 84 | my ($cc, $k, $iv, $len) = @_; |
| 85 | if (@_ == 3) { |
| 86 | $len = $iv; |
| 87 | $iv = undef; |
| 88 | } |
| 89 | my $c = $cc->init($k); |
| 90 | $c->setiv($iv) if defined($iv); |
| 91 | return $c->fill($len); |
| 92 | } |
| 93 | |
| 94 | sub decrypt { |
| 95 | croak("Usage: Catacomb::CipherClass::decrypt(cc, k, [iv], cipher)") |
| 96 | if @_ < 3 || @_ > 4; |
| 97 | my ($cc, $k, $iv, $p) = @_; |
| 98 | if (@_ == 3) { |
| 99 | $p = $iv; |
| 100 | $iv = undef; |
| 101 | } |
| 102 | my $c = $cc->init($k); |
| 103 | $c->setiv($iv) if defined($iv); |
| 104 | return $c->decrypt($p); |
| 105 | } |
| 106 | |
| 107 | sub filldecrypt { |
| 108 | croak("Usage: Catacomb::CipherClass::filldecrypt(cc, k, [iv], len)") |
| 109 | if @_ < 3 || @_ > 4; |
| 110 | my ($cc, $k, $iv, $len) = @_; |
| 111 | if (@_ == 3) { |
| 112 | $len = $iv; |
| 113 | $iv = undef; |
| 114 | } |
| 115 | my $c = $cc->init($k); |
| 116 | $c->setiv($iv) if defined($iv); |
| 117 | return $c->filldecrypt($len); |
| 118 | } |
| 119 | |
| 120 | package Catacomb::HashClass; |
| 121 | use Carp; |
| 122 | |
| 123 | sub hash { |
| 124 | croak("Usage: Catacomb::HashClass::hash(hc, p)") unless @_ == 2; |
| 125 | my ($hc, $p) = @_; |
| 126 | my $h = $hc->init(); |
| 127 | $h->hash($p); |
| 128 | return $h->done(); |
| 129 | } |
| 130 | |
| 131 | package Catacomb::MACClass; |
| 132 | use Carp; |
| 133 | |
| 134 | sub mac { |
| 135 | croak("Usage: Catacomb::MACClass::mac(mc, k, p)") unless @_ == 3; |
| 136 | my ($mc, $k, $p) = @_; |
| 137 | my $m = $mc->key($k); |
| 138 | return $m->hash($p); |
| 139 | } |
| 140 | |
| 141 | package Catacomb::MAC; |
| 142 | use Carp; |
| 143 | |
| 144 | sub hash { |
| 145 | croak("Usage: Catacomb::MAC::hash(m, p)") unless @_ == 2; |
| 146 | my ($m, $p) = @_; |
| 147 | my $h = $m->init(); |
| 148 | $h->hash($p); |
| 149 | return $h->done(); |
| 150 | } |
| 151 | |
| 152 | #----- DSA and KCDSA signing ------------------------------------------------ |
| 153 | |
| 154 | package Catacomb::DSA; |
| 155 | use Carp; |
| 156 | sub new { |
| 157 | croak("Usage: ${me}::new(me, info)") unless @_ == 2; |
| 158 | my ($me, $info) = @_; |
| 159 | return bless $info, $me; |
| 160 | } |
| 161 | |
| 162 | *Catacomb::KCDSA::new = \&new; |
| 163 | |
| 164 | foreach my $i (qw(DSA KCDSA)) { |
| 165 | @{"Catacomb::${i}::Public::ISA"} = ("Catacomb::${i}"); |
| 166 | @{"Catacomb::${i}::Private::ISA"} = ("Catacomb::${i}::Public"); |
| 167 | } |
| 168 | |
| 169 | #----- RSA signing and encryption ------------------------------------------- |
| 170 | |
| 171 | package Catacomb::RSA::Pad; |
| 172 | use Carp; |
| 173 | |
| 174 | sub new { |
| 175 | croak("Usage: ${me}::new(me, info)") unless @_ == 2; |
| 176 | my ($me, $info) = @_; |
| 177 | return bless $info, $me; |
| 178 | } |
| 179 | |
| 180 | foreach my $i (qw(PKCS1Crypt PKCS1Sign OAEP PSS)) { |
| 181 | @{"Catacomb::RSA::${i}::ISA"} = qw(Catacomb::RSA::Pad); |
| 182 | } |
| 183 | |
| 184 | package Catacomb::RSA::Public; |
| 185 | use Carp; |
| 186 | use Catacomb::Base; |
| 187 | use Catacomb::MP; |
| 188 | |
| 189 | sub encrypt { |
| 190 | croak("Usage: Catacomb::RSA::Public::encrypt(pub, pad, msg)") |
| 191 | unless @_ == 3; |
| 192 | my ($pub, $pad, $msg) = @_; |
| 193 | my $n = $pub->n(); |
| 194 | my $r = $pad->pad($msg, $n->octets(), $n->bits()); |
| 195 | return undef unless defined($r); |
| 196 | return $pub->op($r); |
| 197 | } |
| 198 | |
| 199 | sub verify { |
| 200 | croak("Usage: Catacomb::RSA::Public::verify(pub, pad, sig, [msg])") |
| 201 | unless @_ >= 3 && @_ <= 4; |
| 202 | my ($pub, $pad, $sig, $msg) = @_; |
| 203 | my $n = $pub->n(); |
| 204 | my $rc = $pad->unpad($pub->op($sig), $msg, $n->octets(), $n->bits()); |
| 205 | return undef unless defined($rc); |
| 206 | if (defined($msg)) { |
| 207 | return undef unless $rc eq "" || $rc eq $msg; |
| 208 | return 1; |
| 209 | } else { |
| 210 | return $rc; |
| 211 | } |
| 212 | } |
| 213 | |
| 214 | package Catacomb::RSA::Private; |
| 215 | use Carp; |
| 216 | use Catacomb::Base; |
| 217 | use Catacomb::MP; |
| 218 | |
| 219 | sub sign { |
| 220 | croak("Usage: Catacomb::RSA::Private::sign(priv, pad, msg, [rng]") |
| 221 | unless @_ >= 3 && @_ <= 4; |
| 222 | my ($priv, $pad, $msg, $rng) = @_; |
| 223 | my $n = $priv->n(); |
| 224 | my $r = $pad->pad($msg, $n->octets(), $n->bits()); |
| 225 | return undef unless defined($r); |
| 226 | return $priv->op($r, $rng); |
| 227 | } |
| 228 | |
| 229 | sub decrypt { |
| 230 | croak("Usage: Catacomb::RSA::Private::decrypt(priv, pad, ct, [rng]") |
| 231 | unless @_ >= 3 && @_ <= 4; |
| 232 | my ($priv, $pad, $ct, $rng) = @_; |
| 233 | my $n = $priv->n(); |
| 234 | return $pad->unpad($priv->op($ct, $rng), $n->octets(), $n->bits()); |
| 235 | } |
| 236 | |
| 237 | #----- That's all, folks ---------------------------------------------------- |
| 238 | |
| 239 | 1; |