227 lines
6.3 KiB
Perl
227 lines
6.3 KiB
Perl
package Convert::PEM::CBC;
|
|
use strict;
|
|
|
|
use Carp qw( croak );
|
|
use Digest::MD5 qw( md5 );
|
|
use base qw( Class::ErrorHandler );
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
my $cbc = bless { }, $class;
|
|
$cbc->init(@_);
|
|
}
|
|
|
|
sub init {
|
|
my $cbc = shift;
|
|
my %param = @_;
|
|
$cbc->{iv} = exists $param{IV} ? $param{IV} :
|
|
pack("C*", map { rand 255 } 1..8);
|
|
croak "init: Cipher is required"
|
|
unless my $cipher = $param{Cipher};
|
|
if (ref($cipher)) {
|
|
$cbc->{cipher} = $cipher;
|
|
}
|
|
else {
|
|
eval "use $cipher;";
|
|
croak "Loading '$cipher' failed: $@" if $@;
|
|
my $key = $param{Key};
|
|
if (!$key && exists $param{Passphrase}) {
|
|
$key = bytes_to_key($param{Passphrase}, $cbc->{iv},
|
|
\&md5, $cipher->keysize);
|
|
}
|
|
croak "init: either Key or Passphrase required"
|
|
unless $key;
|
|
$cbc->{cipher} = $cipher->new($key);
|
|
}
|
|
$cbc;
|
|
}
|
|
|
|
sub iv { $_[0]->{iv} }
|
|
|
|
sub encrypt {
|
|
my $cbc = shift;
|
|
my($text) = @_;
|
|
my $cipher = $cbc->{cipher};
|
|
my $bs = $cipher->blocksize;
|
|
my @blocks = $text =~ /(.{1,$bs})/ogs;
|
|
my $last = pop @blocks if length($blocks[-1]) < $bs;
|
|
my $iv = $cbc->{iv};
|
|
my $buf = '';
|
|
for my $block (@blocks) {
|
|
$buf .= $iv = $cipher->encrypt($iv ^ $block);
|
|
}
|
|
$last = pack("C*", ($bs) x $bs) unless $last && length $last;
|
|
if (length $last) {
|
|
$last .= pack("C*", ($bs-length($last)) x ($bs-length($last)))
|
|
if length($last) < $bs;
|
|
$buf .= $iv = $cipher->encrypt($iv ^ $last);
|
|
}
|
|
$cbc->{iv} = $iv;
|
|
$buf;
|
|
}
|
|
|
|
sub decrypt {
|
|
my $cbc = shift;
|
|
my($text) = @_;
|
|
my $cipher = $cbc->{cipher};
|
|
my $bs = $cipher->blocksize;
|
|
my @blocks = $text =~ /(.{1,$bs})/ogs;
|
|
my $last = length($blocks[-1]) < $bs ?
|
|
join '', splice(@blocks, -2) : pop @blocks;
|
|
my $iv = $cbc->{iv};
|
|
my $buf = '';
|
|
for my $block (@blocks) {
|
|
$buf .= $iv ^ $cipher->decrypt($block);
|
|
$iv = $block;
|
|
}
|
|
$last = pack "a$bs", $last;
|
|
if (length($last)) {
|
|
my $tmp = $iv ^ $cipher->decrypt($last);
|
|
$iv = $last;
|
|
$last = $tmp;
|
|
my $cut = ord substr $last, -1;
|
|
return $cbc->error("Bad key/passphrase")
|
|
if $cut > $bs;
|
|
substr($last, -$cut) = '';
|
|
$buf .= $last;
|
|
}
|
|
$cbc->{iv} = $iv;
|
|
$buf;
|
|
}
|
|
|
|
sub bytes_to_key {
|
|
my($key, $salt, $md, $ks) = @_;
|
|
my $ckey = $md->($key, $salt);
|
|
while (length($ckey) < $ks) {
|
|
$ckey .= $md->($ckey, $key, $salt);
|
|
}
|
|
substr $ckey, 0, $ks;
|
|
}
|
|
|
|
1;
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
Convert::PEM::CBC - Cipher Block Chaining Mode implementation
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Convert::PEM::CBC;
|
|
my $cbc = Convert::PEM::CBC->new(
|
|
Cipher => 'Crypt::DES_EDE3',
|
|
Passphrase => 'foo'
|
|
);
|
|
|
|
my $plaintext = 'foo bar baz';
|
|
$cbc->encrypt($plaintext);
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
I<Convert::PEM::CBC> implements the CBC (Cipher Block Chaining)
|
|
mode for encryption/decryption ciphers; the CBC is designed for
|
|
compatability with OpenSSL and may not be compatible with other
|
|
implementations (such as SSH).
|
|
|
|
=head1 USAGE
|
|
|
|
=head2 $cbc = Convert::PEM::CBC->new(%args)
|
|
|
|
Creates a new I<Convert::PEM::CBC> object and initializes it.
|
|
Returns the new object.
|
|
|
|
I<%args> can contain:
|
|
|
|
=over 4
|
|
|
|
=item * Cipher
|
|
|
|
Either the name of an encryption cipher class (eg. I<Crypt::DES>),
|
|
or an object already blessed into such a class. The class must
|
|
support the I<keysize>, I<blocksize>, I<encrypt>, and I<decrypt>
|
|
methods. If the value is a blessed object, it is assumed that the
|
|
object has already been initialized with a key.
|
|
|
|
This argument is mandatory.
|
|
|
|
=item * Passphrase
|
|
|
|
A passphrase to encrypt/decrypt the content. This is different in
|
|
implementation from a key (I<Key>), because it is assumed that a
|
|
passphrase comes directly from a user, and must be munged into the
|
|
correct form for a key. This "munging" is done by repeatedly
|
|
computing an MD5 hash of the passphrase, the IV, and the existing
|
|
hash, until the generated key is longer than the keysize for the
|
|
cipher (I<Cipher>).
|
|
|
|
Because of this "munging", this argument can be any length (even
|
|
an empty string).
|
|
|
|
If you give the I<Cipher> argument an object, this argument is
|
|
ignored. If the I<Cipher> argument is a cipher class, either this
|
|
argument or I<Key> must be provided.
|
|
|
|
=item * Key
|
|
|
|
A raw key, to be passed directly to the new cipher object. Because
|
|
this is passed directly to the cipher itself, the length of the
|
|
key must be equal to or greater than the keysize for the I<Cipher>.
|
|
|
|
As with the I<Passphrase> argument, if you give the I<Cipher>
|
|
argument an already-constructed cipher object, this argument is
|
|
ignored. If the I<Cipher> argument is a cipher class, either this
|
|
argument or I<Passphrase> must be provided.
|
|
|
|
=item * IV
|
|
|
|
The initialization vector for CBC mode.
|
|
|
|
This argument is optional; if not provided, a random IV will be
|
|
generated. Obviously, if you're decrypting data, you should provide
|
|
this argument, because your IV should match the IV used to encrypt
|
|
the data.
|
|
|
|
=back
|
|
|
|
=head2 $cbc->encrypt($plaintext)
|
|
|
|
Encrypts the plaintext I<$plaintext> using the underlying cipher
|
|
implementation in CBC mode, and returns the ciphertext.
|
|
|
|
If any errors occur, returns I<undef>, and you should check the
|
|
I<errstr> method to find out what went wrong.
|
|
|
|
=head2 $cbc->decrypt($ciphertext)
|
|
|
|
Decrypts the ciphertext I<$ciphertext> using the underlying
|
|
cipher implementation in CBC mode, and returns the plaintext.
|
|
|
|
If any errors occur, returns I<undef>, and you should check the
|
|
I<errstr> method to find out what went wrong.
|
|
|
|
=head2 $cbc->iv
|
|
|
|
Returns the current initialization vector. One use for this might be
|
|
to grab the initial value of the IV if it's created randomly (ie.
|
|
you haven't provided an I<IV> argument to I<new>):
|
|
|
|
my $cbc = Convert::PEM::CBC->new( Cipher => $cipher );
|
|
my $iv = $cbc->iv; ## Generated randomly in 'new'.
|
|
|
|
I<Convert::PEM> uses this to write the IV to the PEM file when
|
|
encrypting, so that it can be known when trying to decrypt the
|
|
file.
|
|
|
|
=head2 $cbc->errstr
|
|
|
|
Returns the value of the last error that occurred. This should only
|
|
be considered meaningful when you've received I<undef> from one of
|
|
the functions above; in all other cases its relevance is undefined.
|
|
|
|
=head1 AUTHOR & COPYRIGHTS
|
|
|
|
Please see the Convert::PEM manpage for author, copyright, and
|
|
license information.
|
|
|
|
=cut
|