Add fill for encryption schemes.
[catacomb-perl] / 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 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;