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