Initial Commit
This commit is contained in:
Riley Schneider
226
database/perl/vendor/lib/Convert/PEM/CBC.pm
vendored
Normal file
226
database/perl/vendor/lib/Convert/PEM/CBC.pm
vendored
Normal file
@@ -0,0 +1,226 @@
|
||||
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
|
||||
Reference in New Issue
Block a user