File Coverage

blib/lib/Convert/PEM/CBC.pm
Criterion Covered Total %
statement 70 83 84.3
branch 16 26 61.5
condition 3 6 50.0
subroutine 10 13 76.9
pod 4 6 66.7
total 103 134 76.9


line stmt bran cond sub pod time code
1             # $Id: CBC.pm 1829 2005-05-25 21:51:40Z btrott $
2              
3             package Convert::PEM::CBC;
4 4     4   62 use strict;
  4         58  
  4         130  
5              
6 4     4   82 use Carp qw( croak );
  4         36  
  4         75  
7 4     4   60 use Digest::MD5 qw( md5 );
  4         37  
  4         61  
8 4     4   268 use base qw( Class::ErrorHandler );
  4         39  
  4         74  
9              
10             sub new {
11 8     8 1 253     my $class = shift;
12 8         164     my $cbc = bless { }, $class;
13 8         96     $cbc->init(@_);
14             }
15              
16             sub init {
17 8     8 0 87     my $cbc = shift;
18 8         102     my %param = @_;
19 16         279     $cbc->{iv} = exists $param{IV} ? $param{IV} :
20 8 100       105         pack("C*", map { rand 255 } 1..8);
21 8 50       94     croak "init: Cipher is required"
22                     unless my $cipher = $param{Cipher};
23 8 50       81     if (ref($cipher)) {
24 0         0         $cbc->{cipher} = $cipher;
25                 }
26                 else {
27 8     0   159         eval "use $cipher;";
  0     0   0  
  0     0   0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
  0         0  
28 8 50       202         croak "Loading '$cipher' failed: $@" if $@;
29 8         80         my $key = $param{Key};
30 8 100 66     120         if (!$key && exists $param{Passphrase}) {
31 6         96             $key = bytes_to_key($param{Passphrase}, $cbc->{iv},
32                             \&md5, $cipher->keysize);
33                     }
34 8 50       84         croak "init: either Key or Passphrase required"
35                         unless $key;
36 8         171         $cbc->{cipher} = $cipher->new($key);
37                 }
38 8         119     $cbc;
39             }
40              
41 2     2 1 43 sub iv { $_[0]->{iv} }
42              
43             sub encrypt {
44 3     3 1 179     my $cbc = shift;
45 3         33     my($text) = @_;
46 3         88     my $cipher = $cbc->{cipher};
47 3         37     my $bs = $cipher->blocksize;
48 3         104     my @blocks = $text =~ /(.{1,$bs})/ogs;
49 3 50       43     my $last = pop @blocks if length($blocks[-1]) < $bs;
50 3         34     my $iv = $cbc->{iv};
51 3         29     my $buf = '';
52 3         31     for my $block (@blocks) {
53 0         0         $buf .= $iv = $cipher->encrypt($iv ^ $block);
54                 }
55 3 50 33     57     $last = pack("C*", ($bs) x $bs) unless $last && length $last;
56 3 50       39     if (length $last) {
57 3 50       49         $last .= pack("C*", ($bs-length($last)) x ($bs-length($last)))
58                         if length($last) < $bs;
59 3         43         $buf .= $iv = $cipher->encrypt($iv ^ $last);
60                 }
61 3         33     $cbc->{iv} = $iv;
62 3         44     $buf;
63             }
64              
65             sub decrypt {
66 5     5 1 250     my $cbc = shift;
67 5         52     my($text) = @_;
68 5         48     my $cipher = $cbc->{cipher};
69 5         57     my $bs = $cipher->blocksize;
70 5         132     my @blocks = $text =~ /(.{1,$bs})/ogs;
71 5 50       63     my $last = length($blocks[-1]) < $bs ?
72                     join '', splice(@blocks, -2) : pop @blocks;
73 5         52     my $iv = $cbc->{iv};
74 5         44     my $buf = '';
75 5         51     for my $block (@blocks) {
76 0         0         $buf .= $iv ^ $cipher->decrypt($block);
77 0         0         $iv = $block;
78                 }
79 5         59     $last = pack "a$bs", $last;
80 5 50       58     if (length($last)) {
81 5         58         my $tmp = $iv ^ $cipher->decrypt($last);
82 5         48         $iv = $last;
83 5         44         $last = $tmp;
84 5         50         my $cut = ord substr $last, -1;
85 5 100       86         return $cbc->error("Bad key/passphrase")
86                         if $cut > $bs;
87 3         40         substr($last, -$cut) = '';
88 3         30         $buf .= $last;
89                 }
90 3         28     $cbc->{iv} = $iv;
91 3         39     $buf;
92             }
93              
94             sub bytes_to_key {
95 6     6 0 66     my($key, $salt, $md, $ks) = @_;
96 6         84     my $ckey = $md->($key, $salt);
97 6         72     while (length($ckey) < $ks) {
98 6         90         $ckey .= $md->($ckey, $key, $salt);
99                 }
100 6         72     substr $ckey, 0, $ks;
101             }
102              
103             1;
104             __END__
105            
106             =head1 NAME
107            
108             Convert::PEM::CBC - Cipher Block Chaining Mode implementation
109            
110             =head1 SYNOPSIS
111            
112             use Convert::PEM::CBC;
113             my $cbc = Convert::PEM::CBC->new(
114             Cipher => 'Crypt::DES_EDE3',
115             Passphrase => 'foo'
116             );
117            
118             $cbc->encrypt($plaintext);
119            
120             =head1 DESCRIPTION
121            
122             I<Convert::PEM::CBC> implements the CBC (Cipher Block Chaining)
123             mode for encryption/decryption ciphers; the CBC is designed for
124             compatability with OpenSSL and may not be compatible with other
125             implementations (such as SSH).
126            
127             =head1 USAGE
128            
129             =head2 $cbc = Convert::PEM::CBC->new(%args)
130            
131             Creates a new I<Convert::PEM::CBC> object and initializes it.
132             Returns the new object.
133            
134             I<%args> can contain:
135            
136             =over 4
137            
138             =item * Cipher
139            
140             Either the name of an encryption cipher class (eg. I<Crypt::DES>),
141             or an object already blessed into such a class. The class must
142             support the I<keysize>, I<blocksize>, I<encrypt>, and I<decrypt>
143             methods. If the value is a blessed object, it is assumed that the
144             object has already been initialized with a key.
145            
146             This argument is mandatory.
147            
148             =item * Passphrase
149            
150             A passphrase to encrypt/decrypt the content. This is different in
151             implementation from a key (I<Key>), because it is assumed that a
152             passphrase comes directly from a user, and must be munged into the
153             correct form for a key. This "munging" is done by repeatedly
154             computing an MD5 hash of the passphrase, the IV, and the existing
155             hash, until the generated key is longer than the keysize for the
156             cipher (I<Cipher>).
157            
158             Because of this "munging", this argument can be any length (even
159             an empty string).
160            
161             If you give the I<Cipher> argument an object, this argument is
162             ignored. If the I<Cipher> argument is a cipher class, either this
163             argument or I<Key> must be provided.
164            
165             =item * Key
166            
167             A raw key, to be passed directly to the new cipher object. Because
168             this is passed directly to the cipher itself, the length of the
169             key must be equal to or greater than the keysize for the I<Cipher>.
170            
171             As with the I<Passphrase> argument, if you give the I<Cipher>
172             argument an already-constructed cipher object, this argument is
173             ignored. If the I<Cipher> argument is a cipher class, either this
174             argument or I<Passphrase> must be provided.
175            
176             =item * IV
177            
178             The initialization vector for CBC mode.
179            
180             This argument is optional; if not provided, a random IV will be
181             generated. Obviously, if you're decrypting data, you should provide
182             this argument, because your IV should match the IV used to encrypt
183             the data.
184            
185             =back
186            
187             =head2 $cbc->encrypt($plaintext)
188            
189             Encrypts the plaintext I<$plaintext> using the underlying cipher
190             implementation in CBC mode, and returns the ciphertext.
191            
192             If any errors occur, returns I<undef>, and you should check the
193             I<errstr> method to find out what went wrong.
194            
195             =head2 $cbc->decrypt($ciphertext)
196            
197             Decrypts the ciphertext I<$ciphertext> using the underlying
198             cipher implementation in CBC mode, and returns the plaintext.
199            
200             If any errors occur, returns I<undef>, and you should check the
201             I<errstr> method to find out what went wrong.
202            
203             =head2 $cbc->iv
204            
205             Returns the current initialization vector. One use for this might be
206             to grab the initial value of the IV if it's created randomly (ie.
207             you haven't provided an I<IV> argument to I<new>):
208            
209             my $cbc = Convert::PEM::CBC->new( Cipher => $cipher );
210             my $iv = $cbc->iv; ## Generated randomly in 'new'.
211            
212             I<Convert::PEM> uses this to write the IV to the PEM file when
213             encrypting, so that it can be known when trying to decrypt the
214             file.
215            
216             =head2 $cbc->errstr
217            
218             Returns the value of the last error that occurred. This should only
219             be considered meaningful when you've received I<undef> from one of
220             the functions above; in all other cases its relevance is undefined.
221            
222             =head1 AUTHOR & COPYRIGHTS
223            
224             Please see the Convert::PEM manpage for author, copyright, and
225             license information.
226            
227             =cut
228