Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | package Crypt::CBC; |
2 | ||
3 | use Digest::MD5 'md5'; | |
4 | use Carp; | |
5 | use strict; | |
6 | use vars qw($VERSION); | |
7 | $VERSION = '2.08'; | |
8 | ||
9 | sub new { | |
10 | my $class = shift; | |
11 | my $arg1 = shift; | |
12 | my $arg2 = shift; | |
13 | ||
14 | my $options = {}; | |
15 | ||
16 | if (ref($arg1) eq 'HASH') { | |
17 | $options = $arg1; | |
18 | } else { | |
19 | $options->{key} = $arg1; | |
20 | } | |
21 | ||
22 | if ($arg2) { | |
23 | $options->{cipher} = $arg2; | |
24 | } | |
25 | ||
26 | my $key = $options->{key}; | |
27 | croak "Please provide an encryption/decryption key" unless defined $key; | |
28 | ||
29 | # get key from key? | |
30 | my $gkfk = 1; | |
31 | $gkfk = $options->{regenerate_key} if (exists($options->{regenerate_key})); | |
32 | ||
33 | my $cipher = $options->{cipher}; | |
34 | $cipher = 'Crypt::DES' unless $cipher; | |
35 | $cipher = $cipher=~/^Crypt::/ ? $cipher : "Crypt::$cipher"; | |
36 | eval "require $cipher"; | |
37 | croak "Couldn't load $cipher: $@" if $@; | |
38 | # some crypt modules use the class Crypt::, and others don't | |
39 | $cipher =~ s/^Crypt::// unless $cipher->can('keysize'); | |
40 | ||
41 | my $iv = $options->{iv}; | |
42 | ||
43 | my $ks = eval {$cipher->keysize}; | |
44 | my $bs = eval {$cipher->blocksize}; | |
45 | ||
46 | my $padding = $options->{padding}; | |
47 | $padding ||= \&_standard_padding; | |
48 | ||
49 | if ($padding && ref($padding) eq 'CODE') { | |
50 | # check to see that this code does its padding correctly | |
51 | for my $i (1..$bs-1) { | |
52 | my $rbs = length($padding->(" "x$i,$bs,'e')); | |
53 | croak "padding method callback does not behave properly: expected $bs bytes back, got $rbs bytes back." unless ($rbs == $bs); | |
54 | } | |
55 | } elsif ($padding eq 'null') { | |
56 | $padding = \&_null_padding; | |
57 | } elsif ($padding eq 'space') { | |
58 | $padding = \&_space_padding; | |
59 | } elsif ($padding eq 'oneandzeroes') { | |
60 | $padding = \&_oneandzeroes_padding; | |
61 | } elsif ($padding eq 'standard') { | |
62 | $padding = \&_standard_padding; | |
63 | } else { | |
64 | croak "padding method $padding not supported. Please create your own sub to do it, and pass in a coderef to that"; | |
65 | } | |
66 | ||
67 | # Some of the cipher modules are busted and don't report the | |
68 | # keysize (well, Crypt::Blowfish in any case). If we detect | |
69 | # this, and find the blowfish module in use, then assume 56. | |
70 | # Otherwise assume the least common denominator of 8. | |
71 | $ks ||= $cipher =~ /blowfish/i ? 56 : 8; | |
72 | $bs ||= $ks; | |
73 | ||
74 | if ($gkfk) { | |
75 | # generate the keysize from the | |
76 | # MD5 hash of the provided key. | |
77 | my $material = md5($key); | |
78 | # if that's not enough, keep adding to it | |
79 | while (length($material) < $ks) { | |
80 | $material .= md5($material); | |
81 | } | |
82 | ||
83 | $key = substr($material,0,$ks); | |
84 | } | |
85 | ||
86 | if (length($key) > $ks) { | |
87 | carp "keysize is greater than allowed keysize of $ks for cipher $cipher - using only first $ks bytes"; | |
88 | $key = substr($key, 0, $ks); | |
89 | } | |
90 | ||
91 | my $prepend_iv = exists $options->{'prepend_iv'} | |
92 | ? $options->{'prepend_iv'} | |
93 | : 1; | |
94 | ||
95 | return bless {'crypt' => $cipher->new($key), | |
96 | 'iv' => $iv, | |
97 | 'padding' => $padding, | |
98 | 'blocksize' => $bs, | |
99 | 'prepend_iv' => $prepend_iv, | |
100 | },$class; | |
101 | } | |
102 | ||
103 | sub encrypt (\$$) { | |
104 | my ($self,$data) = @_; | |
105 | $self->start('encrypting'); | |
106 | my $result = $self->crypt($data); | |
107 | $result .= $self->finish; | |
108 | $result; | |
109 | } | |
110 | ||
111 | sub decrypt (\$$){ | |
112 | my ($self,$data) = @_; | |
113 | $self->start('decrypting'); | |
114 | my $result = $self->crypt($data); | |
115 | $result .= $self->finish; | |
116 | $result; | |
117 | } | |
118 | ||
119 | sub encrypt_hex (\$$) { | |
120 | my ($self,$data) = @_; | |
121 | return join('',unpack 'H*',$self->encrypt($data)); | |
122 | } | |
123 | ||
124 | sub decrypt_hex (\$$) { | |
125 | my ($self,$data) = @_; | |
126 | return $self->decrypt(pack'H*',$data); | |
127 | } | |
128 | ||
129 | # call to start a series of encryption/decryption operations | |
130 | sub start (\$$) { | |
131 | my $self = shift; | |
132 | my $operation = shift; | |
133 | croak "Specify <e>ncryption or <d>ecryption" unless $operation=~/^[ed]/i; | |
134 | ||
135 | unless (defined($self->{'iv'})) { | |
136 | $self->{'iv'} = pack("C*",map {rand(256)} 1..8); | |
137 | } | |
138 | ||
139 | $self->{'buffer'} = ''; | |
140 | $self->{'decrypt'} = $operation=~/^d/i; | |
141 | } | |
142 | ||
143 | # call to encrypt/decrypt a bit of data | |
144 | sub crypt (\$$){ | |
145 | my $self = shift; | |
146 | my $data = shift; | |
147 | croak "crypt() called without a preceding start()" | |
148 | unless exists $self->{'buffer'}; | |
149 | ||
150 | my $d = $self->{'decrypt'}; | |
151 | ||
152 | my $iv; | |
153 | my $result = ''; | |
154 | ||
155 | if ( !$self->{'civ'} ) { | |
156 | if ($d) { # decrypting | |
157 | if (($iv) = $data=~ /^RandomIV(.{8})/s) { | |
158 | $self->{'iv'} = $iv; | |
159 | substr($data,0,16) = ''; #truncate | |
160 | } | |
161 | } else { # encrypting | |
162 | if ($self->{'prepend_iv'}) { | |
163 | $result = 'RandomIV'; | |
164 | $result .= $self->{'iv'}; | |
165 | } | |
166 | } | |
167 | $self->{'civ'} = $self->{'iv'}; | |
168 | } | |
169 | ||
170 | $iv = $self->{'civ'}; | |
171 | ||
172 | $self->{'buffer'} .= $data; | |
173 | ||
174 | my $bs = $self->{'blocksize'}; | |
175 | ||
176 | return $result unless (length($self->{'buffer'}) >= $bs); | |
177 | ||
178 | # split into blocksize chunks | |
179 | # used to be: | |
180 | # my @blocks = $self->{'buffer'}=~/(.{1,$bs})/ogs; | |
181 | # but this is a little faster (about 1.5 times) | |
182 | my @blocks = unpack("a$bs "x(int(length($self->{'buffer'})/$bs)) . "a*", $self->{'buffer'}); | |
183 | $self->{'buffer'} = ''; | |
184 | ||
185 | if ($d) { # when decrypting, always leave a free block at the end | |
186 | $self->{'buffer'} = length($blocks[-1]) < $bs ? join '',splice(@blocks,-2) : pop(@blocks); | |
187 | } else { | |
188 | $self->{'buffer'} = pop @blocks if length($blocks[-1]) < $bs; # what's left over | |
189 | } | |
190 | ||
191 | foreach my $block (@blocks) { | |
192 | if ($d) { # decrypting | |
193 | $result .= $iv ^ $self->{'crypt'}->decrypt($block); | |
194 | $iv = $block; | |
195 | } else { # encrypting | |
196 | $result .= $iv = $self->{'crypt'}->encrypt($iv ^ $block); | |
197 | } | |
198 | } | |
199 | $self->{'civ'} = $iv; # remember the iv | |
200 | return $result; | |
201 | } | |
202 | ||
203 | # this is called at the end to flush whatever's left | |
204 | sub finish (\$) { | |
205 | my $self = shift; | |
206 | my $bs = $self->{'blocksize'}; | |
207 | my $block = $self->{'buffer'}; | |
208 | ||
209 | $self->{civ} ||= ''; | |
210 | ||
211 | my $result; | |
212 | if ($self->{'decrypt'}) { #decrypting | |
213 | $block = pack("a$bs",$block); # pad and truncate to block size | |
214 | ||
215 | if (length($block)) { | |
216 | $result = $self->{'civ'} ^ $self->{'crypt'}->decrypt($block); | |
217 | $result = $self->{'padding'}->($result, $bs, 'd'); | |
218 | } else { | |
219 | $result = ''; | |
220 | } | |
221 | ||
222 | } else { # encrypting | |
223 | $block = $self->{'padding'}->($block,$bs,'e'); | |
224 | $result = $self->{'crypt'}->encrypt($self->{'civ'} ^ $block); | |
225 | } | |
226 | delete $self->{'civ'}; | |
227 | delete $self->{'buffer'}; | |
228 | return $result; | |
229 | } | |
230 | ||
231 | sub _standard_padding ($$$) { | |
232 | my ($b,$bs,$decrypt) = @_; | |
233 | if ($decrypt eq 'd') { | |
234 | substr($b, -unpack("C",substr($b,-1)))=''; | |
235 | return $b; | |
236 | } | |
237 | my $pad = $bs - length($b) % $bs; | |
238 | return $b . pack("C*",($pad)x$pad); | |
239 | } | |
240 | ||
241 | sub _space_padding ($$$) { | |
242 | my ($b,$bs,$decrypt) = @_; | |
243 | if ($decrypt eq 'd') { | |
244 | $b=~ s/ *$//s; | |
245 | return $b; | |
246 | } | |
247 | return $b . pack("C*", (32) x ($bs - length($b) % $bs)); | |
248 | } | |
249 | ||
250 | sub _null_padding ($$$) { | |
251 | my ($b,$bs,$decrypt) = @_; | |
252 | if ($decrypt eq 'd') { | |
253 | $b=~ s/\0*$//s; | |
254 | return $b; | |
255 | } | |
256 | return $b . pack("C*", (0) x ($bs - length($b) % $bs)); | |
257 | } | |
258 | ||
259 | sub _oneandzeroes_padding ($$$) { | |
260 | my ($b,$bs,$decrypt) = @_; | |
261 | if ($decrypt eq 'd') { | |
262 | my $hex = unpack("H*", $b); | |
263 | $hex =~ s/80*$//s; | |
264 | return pack("H*", $hex); | |
265 | } | |
266 | return $b . pack("C*", 128, (0) x ($bs - length($b) % $bs - 1) ); | |
267 | } | |
268 | ||
269 | sub get_initialization_vector (\$) { | |
270 | my $self = shift; | |
271 | return $self->{'iv'}; | |
272 | } | |
273 | ||
274 | sub set_initialization_vector (\$$) { | |
275 | my $self = shift; | |
276 | my $iv = shift; | |
277 | ||
278 | croak "Initialization vector must be 8 bytes" unless (length($iv) == 8); | |
279 | ||
280 | if (exists($self->{'iv'})) { | |
281 | carp "Initialization vector already set. Re-setting is not recommended. (doing it anyways)"; | |
282 | } | |
283 | $self->{'iv'} = $iv; | |
284 | } | |
285 | ||
286 | 1; | |
287 | __END__ | |
288 | ||
289 | =head1 NAME | |
290 | ||
291 | Crypt::CBC - Encrypt Data with Cipher Block Chaining Mode | |
292 | ||
293 | =head1 SYNOPSIS | |
294 | ||
295 | use Crypt::CBC; | |
296 | $cipher = Crypt::CBC->new( {'key' => 'my secret key', | |
297 | 'cipher' => 'Blowfish', | |
298 | 'iv' => '$KJh#(}q', | |
299 | 'regenerate_key' => 0, # default true | |
300 | 'padding' => 'space', | |
301 | 'prepend_iv' => 0 | |
302 | }); | |
303 | ||
304 | $ciphertext = $cipher->encrypt("This data is hush hush"); | |
305 | $plaintext = $cipher->decrypt($ciphertext); | |
306 | ||
307 | $cipher->start('encrypting'); | |
308 | open(F,"./BIG_FILE"); | |
309 | while (read(F,$buffer,1024)) { | |
310 | print $cipher->crypt($buffer); | |
311 | } | |
312 | print $cipher->finish; | |
313 | ||
314 | ||
315 | =head1 DESCRIPTION | |
316 | ||
317 | This module is a Perl-only implementation of the cryptographic cipher | |
318 | block chaining mode (CBC). In combination with a block cipher such as | |
319 | DES or IDEA, you can encrypt and decrypt messages of arbitrarily long | |
320 | length. The encrypted messages are compatible with the encryption | |
321 | format used by B<SSLeay>. | |
322 | ||
323 | To use this module, you will first create a Crypt::CBC cipher object with | |
324 | new(). At the time of cipher creation, you specify an encryption key | |
325 | to use and, optionally, a block encryption algorithm. You will then | |
326 | call the start() method to initialize the encryption or decryption | |
327 | process, crypt() to encrypt or decrypt one or more blocks of data, and | |
328 | lastly finish(), to pad and encrypt the final block. For your | |
329 | convenience, you can call the encrypt() and decrypt() methods to | |
330 | operate on a whole data value at once. | |
331 | ||
332 | =head2 new() | |
333 | ||
334 | $cipher = Crypt::CBC->new( {'key' => 'my secret key', | |
335 | 'cipher' => 'Blowfish', | |
336 | 'iv' => '$KJh#(}q', | |
337 | 'regenerate_key' => 0, # default true | |
338 | 'padding' => 'space', | |
339 | 'prepend_iv' => 0 | |
340 | }); | |
341 | ||
342 | # or (for compatibility with earlier versions) | |
343 | $cipher = new Crypt::CBC($key,$algorithm); | |
344 | ||
345 | The new() method creates a new Crypt::CBC object. | |
346 | ||
347 | You must provide an encryption/decryption key, which can be any series | |
348 | of characters of any length. If regenerate_key is not specified as a | |
349 | false value, the actual key used is derived from the MD5 hash of the | |
350 | key you provide. The cipher is optional and will default to DES unless | |
351 | specified otherwise. You may use any compatible block encryption | |
352 | algorithm that you have installed. Currently, this includes Crypt::DES, | |
353 | Crypt::DES_EDE3, Crypt::IDEA, Crypt::Blowfish, and Crypt::Rijndael. You | |
354 | may refer to them using their full names ("Crypt::IDEA") or in | |
355 | abbreviated form ("IDEA"). | |
356 | ||
357 | An initialization vector may be specified, either by passing in a key of | |
358 | 'iv' as an option to new, or by calling | |
359 | $cipher->set_initialization_key($iv) before calling $cipher->start(). | |
360 | The IV will be ignored in decryption if the ciphertext is prepended by | |
361 | text which matches the regex /^RandomIV.{8}/, in which case the 8 | |
362 | characters following "RandomIV" will be used as the IV. When encrypting, | |
363 | by default the ciphertext will be prepended with "RandomIVE<lt>IVE<gt>" | |
364 | (16 bytes). To disable this, set 'prepend_iv' to a false value. The | |
365 | padding method can be specified by the 'padding' option. If no padding | |
366 | method is specified, PKCS#5 ("standard") padding is assumed. | |
367 | ||
368 | =head2 start() | |
369 | ||
370 | $cipher->start('encrypting'); | |
371 | $cipher->start('decrypting'); | |
372 | ||
373 | The start() method prepares the cipher for a series of encryption or | |
374 | decryption steps, resetting the internal state of the cipher if | |
375 | necessary. You must provide a string indicating whether you wish to | |
376 | encrypt or decrypt. "E" or any word that begins with an "e" indicates | |
377 | encryption. "D" or any word that begins with a "d" indicates | |
378 | decryption. | |
379 | ||
380 | =head2 crypt() | |
381 | ||
382 | $ciphertext = $cipher->crypt($plaintext); | |
383 | ||
384 | After calling start(), you should call crypt() as many times as | |
385 | necessary to encrypt the desired data. | |
386 | ||
387 | =head2 finish() | |
388 | ||
389 | $ciphertext = $cipher->finish(); | |
390 | ||
391 | The CBC algorithm must buffer data blocks inernally until they are | |
392 | even multiples of the encryption algorithm's blocksize (typically 8 | |
393 | bytes). After the last call to crypt() you should call finish(). | |
394 | This flushes the internal buffer and returns any leftover ciphertext. | |
395 | ||
396 | In a typical application you will read the plaintext from a file or | |
397 | input stream and write the result to standard output in a loop that | |
398 | might look like this: | |
399 | ||
400 | $cipher = new Crypt::CBC('hey jude!'); | |
401 | $cipher->start('encrypting'); | |
402 | print $cipher->crypt($_) while <>; | |
403 | print $cipher->finish(); | |
404 | ||
405 | =head2 encrypt() | |
406 | ||
407 | $ciphertext = $cipher->encrypt($plaintext) | |
408 | ||
409 | This convenience function runs the entire sequence of start(), crypt() | |
410 | and finish() for you, processing the provided plaintext and returning | |
411 | the corresponding ciphertext. | |
412 | ||
413 | =head2 decrypt() | |
414 | ||
415 | $plaintext = $cipher->decrypt($ciphertext) | |
416 | ||
417 | This convenience function runs the entire sequence of start(), crypt() | |
418 | and finish() for you, processing the provided ciphertext and returning | |
419 | the corresponding plaintext. | |
420 | ||
421 | =head2 encrypt_hex(), decrypt_hex() | |
422 | ||
423 | $ciphertext = $cipher->encrypt_hex($plaintext) | |
424 | $plaintext = $cipher->decrypt_hex($ciphertext) | |
425 | ||
426 | These are convenience functions that operate on ciphertext in a | |
427 | hexadecimal representation. B<encrypt_hex($plaintext)> is exactly | |
428 | equivalent to B<unpack('H*',encrypt($plaintext))>. These functions | |
429 | can be useful if, for example, you wish to place the encrypted | |
430 | ||
431 | =head2 get_initialization_vector() | |
432 | ||
433 | $iv = $cipher->get_initialization_vector() | |
434 | ||
435 | This function will return the IV used in encryption and or decryption. | |
436 | This function may be useful to determine the random IV used when | |
437 | encrypting if none is specified in new(). The IV is not guaranteed to | |
438 | be set when encrypting until start() is called, and when decrypting | |
439 | until crypt() is called the first time. | |
440 | ||
441 | =head2 set_initialization_vector() | |
442 | ||
443 | $cipher->set_initialization_vector('76543210') | |
444 | ||
445 | This function sets the IV used in encryption and/or decryption. This | |
446 | function may be useful if the IV is not contained within the ciphertext | |
447 | string being decrypted, or if a particular IV is desired for encryption. | |
448 | If not set, a random IV will be generated. The IV is not guaranteed to | |
449 | be set when encrypting until start() is called, and when decrypting | |
450 | until crypt() is called the first time. | |
451 | ||
452 | =head2 Padding methods | |
453 | ||
454 | Use the 'padding' option to change the padding method. | |
455 | ||
456 | When the last block of plaintext is shorter than the block size, | |
457 | it must be padded. Padding methods include: "standard" (i.e., PKCS#5), | |
458 | "oneandzeroes", "space", and "null". | |
459 | ||
460 | standard: (default) Binary safe | |
461 | pads with the number of bytes that should be truncated. So, if | |
462 | blocksize is 8, then "0A0B0C" will be padded with "05", resulting | |
463 | in "0A0B0C0505050505". If the final block is a full block of 8 | |
464 | bytes, then a whole block of "0808080808080808" is appended. | |
465 | ||
466 | oneandzeroes: Binary safe | |
467 | pads with "80" followed by as many "00" necessary to fill the | |
468 | block. If the last block is a full block and blocksize is 8, a | |
469 | block of "8000000000000000" will be appended. | |
470 | ||
471 | null: text only | |
472 | pads with as many "00" necessary to fill the block. If the last | |
473 | block is a full block and blocksize is 8, a block of | |
474 | "0000000000000000" will be appended. | |
475 | ||
476 | space: text only | |
477 | same as "null", but with "20". | |
478 | ||
479 | Both the standard and oneandzeroes paddings are binary safe. The | |
480 | space and null paddings are recommended only for text data. Which | |
481 | type of padding you use depends on whether you wish to communicate | |
482 | with an external (non Crypt::CBC library). If this is the case, use | |
483 | whatever padding method is compatible. | |
484 | ||
485 | You can also pass in a custom padding function. To do this, create a | |
486 | function that takes the arguments: | |
487 | ||
488 | $padded_block = function($block,$blocksize,$direction); | |
489 | ||
490 | where $block is the current block of data, $blocksize is the size to | |
491 | pad it to, $direction is "e" for encrypting and "d" for decrypting, | |
492 | and $padded_block is the result after padding or depadding. | |
493 | ||
494 | When encrypting, the function should always return a string of | |
495 | <blocksize> length, and when decrypting, can expect the string coming | |
496 | in to always be that length. See _standard_padding(), _space_padding(), | |
497 | _null_padding(), or _oneandzeroes_padding() in the source for examples. | |
498 | ||
499 | Standard and oneandzeroes padding are recommended, as both space and | |
500 | null padding can potentially truncate more characters than they should. | |
501 | ||
502 | =head1 EXAMPLES | |
503 | ||
504 | Two examples, des.pl and idea.pl can be found in the eg/ subdirectory | |
505 | of the Crypt-CBC distribution. These implement command-line DES and | |
506 | IDEA encryption algorithms. | |
507 | ||
508 | =head1 LIMITATIONS | |
509 | ||
510 | The encryption and decryption process is about a tenth the speed of | |
511 | the equivalent SSLeay programs (compiled C). This could be improved | |
512 | by implementing this module in C. It may also be worthwhile to | |
513 | optimize the DES and IDEA block algorithms further. | |
514 | ||
515 | =head1 BUGS | |
516 | ||
517 | Please report them. | |
518 | ||
519 | =head1 AUTHOR | |
520 | ||
521 | Lincoln Stein, lstein@cshl.org | |
522 | ||
523 | This module is distributed under the ARTISTIC LICENSE using the same | |
524 | terms as Perl itself. | |
525 | ||
526 | =head1 SEE ALSO | |
527 | ||
528 | perl(1), Crypt::DES(3), Crypt::IDEA(3), rfc2898 (PKCS#5) | |
529 | ||
530 | =cut |