File Coverage

blib/lib/Crypt/CBC.pm
Criterion Covered Total %
statement 208 287 72.5
branch 97 194 50.0
condition 32 97 33.0
subroutine 21 36 58.3
pod 19 22 86.4
total 377 636 59.3


line stmt bran cond sub pod time code
1             package Crypt::CBC;
2              
3 4     4   59 use Digest::MD5 'md5';
  4         55  
  4         78  
4 4     4   62 use Carp;
  4         37  
  4         75  
5 4     4   59 use strict;
  4         37  
  4         57  
6 4     4   117 use vars qw($VERSION);
  4         38  
  4         106  
7             $VERSION = '2.22';
8              
9 4     4   61 use constant RANDOM_DEVICE => '/dev/urandom';
  4         37  
  4         73  
10              
11             sub new {
12 15     15 1 416     my $class = shift;
13              
14 15         215     my $options = {};
15              
16             # hashref arguments
17 15 50       333     if (ref $_[0] eq 'HASH') {
    100          
18 0         0       $options = shift;
19                 }
20              
21             # CGI style arguments
22                 elsif ($_[0] =~ /^-[a-zA-Z_]{1,20}$/) {
23 13         192       my %tmp = @_;
24 13         171       while ( my($key,$value) = each %tmp) {
25 38         398 $key =~ s/^-//;
26 38         2835 $options->{lc $key} = $value;
27                   }
28                 }
29              
30                 else {
31 2         24 $options->{key}    = shift;
32 2         22 $options->{cipher} = shift;
33                 }
34              
35 15   33     214     my $cipher_object_provided = $options->{cipher} && ref $options->{cipher};
36              
37             # "key" is a misnomer here, because it is actually usually a passphrase that is used
38             # to derive the true key
39 15         138     my $pass = $options->{key};
40              
41 15 50       184     if ($cipher_object_provided) {
    50          
42 0 0       0       carp "Both a key and a pre-initialized Crypt::* object were passed. The key will be ignored"
43             if defined $pass;
44 0   0     0       $pass ||= '';
45                 }
46                 elsif (!defined $pass) {
47 0         0       croak "Please provide an encryption/decryption passphrase or key using -key"
48                 }
49              
50             # header mode
51 15         169     my %valid_modes = map {$_=>1} qw(none salt randomiv);
  45         484  
52 15         174     my $header_mode = $options->{header};
53 15 50 0     189     $header_mode ||= 'none' if exists $options->{prepend_iv} && !$options->{prepend_iv};
      33        
54 15 50 0     172     $header_mode ||= 'none' if exists $options->{add_header} && !$options->{add_header};
      33        
55 15   50     181     $header_mode ||= 'salt'; # default
56 15 50       151     croak "Invalid -header mode '$header_mode'" unless $valid_modes{$header_mode};
57              
58 15 50 33     212     croak "The -salt argument is incompatible with a -header mode of $header_mode"
59                   if exists $options->{salt} && $header_mode ne 'salt';
60              
61 15         132     my $cipher = $options->{cipher};
62 15 50       176     $cipher = 'Crypt::DES' unless $cipher;
63 15   33     185     my $cipherclass = ref $cipher || $cipher;
64              
65 15 50       182     unless (ref $cipher) { # munge the class name if no object passed
66 15 50       942       $cipher = $cipher=~/^Crypt::/ ? $cipher : "Crypt::$cipher";
67 15 50 66     776       $cipher->can('encrypt') or eval "require $cipher; 1" or croak "Couldn't load $cipher: $@";
68             # some crypt modules use the class Crypt::, and others don't
69 15 100       263       $cipher =~ s/^Crypt::// unless $cipher->can('keysize');
70                 }
71              
72             # allow user to override these values
73 15         137     my $ks = $options->{keysize};
74 15         134     my $bs = $options->{blocksize};
75              
76             # otherwise we get the values from the cipher
77 15   50     192     $ks ||= eval {$cipher->keysize};
  15         181  
78 15   50     251     $bs ||= eval {$cipher->blocksize};
  15         168  
79              
80             # Some of the cipher modules are busted and don't report the
81             # keysize (well, Crypt::Blowfish in any case). If we detect
82             # this, and find the blowfish module in use, then assume 56.
83             # Otherwise assume the least common denominator of 8.
84 15 50 100     169     $ks ||= $cipherclass =~ /blowfish/i ? 56 : 8;
85 15   50     190     $bs ||= $ks;
86              
87 15         132     my $pcbc = $options->{'pcbc'};
88              
89             # Default behavior is to treat -key as a passphrase.
90             # But if the literal_key option is true, then use key as is
91 15 50 33     163     croak "The options -literal_key and -regenerate_key are incompatible with each other"
92                   if exists $options->{literal_key} && exists $options->{regenerate_key};
93 15         119     my $key;
94 15 50       151     $key = $pass if $options->{literal_key};
95 15 50 33     206     $key = $pass if exists $options->{regenerate_key} && !$options->{regenerate_key};
96              
97             # Get the salt.
98 15         130     my $salt = $options->{salt};
99 15 50 33     768     my $random_salt = 1 unless defined $salt && $salt ne '1';
100 15 50 33     182     croak "Argument to -salt must be exactly 8 bytes long" if defined $salt && length $salt != 8 && $salt ne '1';
      33        
101              
102             # note: iv will be autogenerated by start() if not specified in options
103 15         161     my $iv = $options->{iv};
104 15 50       152     my $random_iv = 1 unless defined $iv;
105 15 50 33     185     croak "Initialization vector must be exactly $bs bytes long when using the $cipherclass cipher" if defined $iv and length($iv) != $bs;
106              
107 15   33     340     my $literal_key = $options->{literal_key} || (exists $options->{regenerate_key} && !$options->{regenerate_key});
      33        
108 15         170     my $legacy_hack = $options->{insecure_legacy_decrypt};
109 15   100     202     my $padding = $options->{padding} || 'standard';
110              
111 15 50 33     216     if ($padding && ref($padding) eq 'CODE') {
112             # check to see that this code does its padding correctly
113 0         0       for my $i (1..$bs-1) {
114 0         0 my $rbs = length($padding->(" "x$i,$bs,'e'));
115 0 0       0 croak "padding method callback does not behave properly: expected $bs bytes back, got $rbs bytes back."
116             unless ($rbs == $bs);
117                   }
118                 } else {
119 15 50       268       $padding = $padding eq 'null' ? \&_null_padding
    100          
    100          
    100          
120             :$padding eq 'space' ? \&_space_padding
121             :$padding eq 'oneandzeroes' ? \&_oneandzeroes_padding
122                             :$padding eq 'standard' ? \&_standard_padding
123             :croak "'$padding' padding not supported. See perldoc Crypt::CBC for instructions on creating your own.";
124                 }
125              
126             # CONSISTENCY CHECKS
127             # HEADER consistency
128 15 50       152     if ($header_mode eq 'salt') {
    0          
    0          
129 15 50       154       croak "Cannot use salt-based key generation if literal key is specified" if $options->{literal_key};
130 15 50       535       croak "Cannot use salt-based IV generation if literal IV is specified" if exists $options->{iv};
131                 }
132                 elsif ($header_mode eq 'randomiv') {
133 0 0 0     0       croak "Cannot encrypt using a non-8 byte blocksize cipher when using randomiv header mode" unless $bs == 8 || $legacy_hack;
134                 }
135                 elsif ($header_mode eq 'none') {
136 0 0       0       croak "You must provide an initialization vector using -iv when using -header=>'none'" unless exists $options->{iv};
137                 }
138              
139             # KEYSIZE consistency
140 15 50 33     179     if (defined $key && length($key) != $ks) {
141 0         0       croak "If specified by -literal_key, then the key length must be equal to the chosen cipher's key length of $ks bytes";
142                 }
143              
144             # IV consistency
145 15 50 33     190     if (defined $iv && length($iv) != $bs) {
146 0         0       croak "If specified by -iv, then the initialization vector length must be equal to the chosen cipher's blocksize of $bs bytes";
147                 }
148              
149              
150 15         539     return bless {'cipher' => $cipher,
151             'passphrase'  => $pass,
152             'key'         => $key,
153             'iv'          => $iv,
154             'salt'        => $salt,
155             'padding'     => $padding,
156             'blocksize'   => $bs,
157             'keysize'     => $ks,
158                               'header_mode' => $header_mode,
159             'legacy_hack' => $legacy_hack,
160                               'literal_key' => $literal_key,
161                               'pcbc' => $pcbc,
162             'make_random_salt' => $random_salt,
163             'make_random_iv'   => $random_iv,
164             },$class;
165             }
166              
167             sub encrypt (\$$) {
168 435     435 1 5162     my ($self,$data) = @_;
169 435         6949     $self->start('encrypting');
170 435         6641     my $result = $self->crypt($data);
171 435         4920     $result .= $self->finish;
172 435         17064     $result;
173             }
174              
175             sub decrypt (\$$){
176 435     435 1 6641     my ($self,$data) = @_;
177 435         5488     $self->start('decrypting');
178 435         13324     my $result = $self->crypt($data);
179 435         8906     $result .= $self->finish;
180 435         7460     $result;
181             }
182              
183             sub encrypt_hex (\$$) {
184 0     0 1 0     my ($self,$data) = @_;
185 0         0     return join('',unpack 'H*',$self->encrypt($data));
186             }
187              
188             sub decrypt_hex (\$$) {
189 0     0 1 0     my ($self,$data) = @_;
190 0         0     return $self->decrypt(pack'H*',$data);
191             }
192            
193             # call to start a series of encryption/decryption operations
194             sub start (\$$) {
195 870     870 1 7910 my $self = shift;
196 870         10008 my $operation = shift;
197 870 50       10944 croak "Specify <e>ncryption or <d>ecryption" unless $operation=~/^[ed]/i;
198            
199 870         8799 $self->{'buffer'} = '';
200 870         9831 $self->{'decrypt'} = $operation=~/^d/i;
201             }
202            
203             # call to encrypt/decrypt a bit of data
204             sub crypt (\$$){
205 870     870 1 10327 my $self = shift;
206 870         9259 my $data = shift;
207            
208 870         8219 my $result;
209            
210 870 50       9543 croak "crypt() called without a preceding start()"
211             unless exists $self->{'buffer'};
212            
213 870         10823 my $d = $self->{'decrypt'};
214            
215 870 50       11220 unless ($self->{civ}) { # block cipher has not yet been initialized
216 870 100       9938 $result = $self->_generate_iv_and_cipher_from_datastream(\$data) if $d;
217 870 100       15341 $result = $self->_generate_iv_and_cipher_from_options() unless $d;
218             }
219            
220 870         11200 my $iv = $self->{'civ'};
221 870         13941 $self->{'buffer'} .= $data;
222            
223 870         8254 my $bs = $self->{'blocksize'};
224            
225 870 100       15652 return $result unless (length($self->{'buffer'}) >= $bs);
226            
227 741         16552 my @blocks = unpack("a$bs "x(int(length($self->{'buffer'})/$bs)) . "a*", $self->{'buffer'});
228 741         13118 $self->{'buffer'} = '';
229            
230 741 100       9434 if ($d) { # when decrypting, always leave a free block at the end
231 426 50       8203 $self->{'buffer'} = length($blocks[-1]) < $bs ? join '',splice(@blocks,-2) : pop(@blocks);
232             } else {
233 315 50       3929 $self->{'buffer'} = pop @blocks if length($blocks[-1]) < $bs; # what's left over
234             }
235            
236 741         7557 foreach my $block (@blocks) {
237 3543 100       34078       if ($d) { # decrypting
238 1758         23418 $result .= $iv = $iv ^ $self->{'crypt'}->decrypt($block);
239 1758 50       34777 $iv = $block unless $self->{pcbc};
240                   } else { # encrypting
241 1785         24060 $result .= $iv = $self->{'crypt'}->encrypt($iv ^ $block);
242                   }
243 3543 50       42755       $iv = $iv ^ $block if $self->{pcbc};
244                 }
245 741         10496     $self->{'civ'} = $iv; # remember the iv
246 741         10660     return $result;
247             }
248              
249             # this is called at the end to flush whatever's left
250             sub finish (\$) {
251 870     870 1 11148     my $self = shift;
252 870         9487     my $bs = $self->{'blocksize'};
253 870 50       9199     my $block = defined $self->{'buffer'} ? $self->{'buffer'} : '';
254              
255 870   50     13317     $self->{civ} ||= '';
256              
257 870         6982     my $result;
258 870 100       8755     if ($self->{'decrypt'}) { #decrypting
259 435 100       6823 $block = length $block ? pack("a$bs",$block) : ''; # pad and truncate to block size
260            
261 435 100       7108 if (length($block)) {
262 426         5316 $result = $self->{'civ'} ^ $self->{'crypt'}->decrypt($block);
263 426         4875 $result = $self->{'padding'}->($result, $bs, 'd');
264             } else {
265 9         77 $result = '';
266             }
267              
268                 } else { # encrypting
269 435   100     4784       $block = $self->{'padding'}->($block,$bs,'e') || '';
270 435 100       6686       $result = length $block ? $self->{'crypt'}->encrypt($self->{'civ'} ^ $block) : '';
271                 }
272 870         9597     delete $self->{'civ'};
273 870         8780     delete $self->{'buffer'};
274 870         9060     return $result;
275             }
276              
277             # this subroutine will generate the actual {en,de}cryption key, the iv
278             # and the block cipher object. This is called when reading from a datastream
279             # and so it uses previous values of salt or iv if they are encoded in datastream
280             # header
281             sub _generate_iv_and_cipher_from_datastream {
282 435     435   4060   my $self = shift;
283 435         6132   my $input_stream = shift;
284 435         4365   my $bs = $self->blocksize;
285              
286             # use our header mode to figure out what to do with the data stream
287 435         5267   my $header_mode = $self->header_mode;
288              
289 435 50       5002   if ($header_mode eq 'none') {
    50          
    0          
290 0 0       0     croak "You must specify a $bs byte initialization vector by passing the -iv option to new() when using -header_mode=>'none'"
291                   unless exists $self->{iv};
292 0         0     $self->{civ} = $self->{iv}; # current IV equals saved IV
293 0   0     0     $self->{key} ||= $self->_key_from_key($self->{passphrase});
294               }
295              
296