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