Crypt-CBC
view release on metacpan or search on metacpan
lib/Crypt/CBC.pm view on Meta::CPAN
my $bs = eval {$cipher->blocksize}
or croak "$cipher did not provide a blocksize";
return ($ks,$bs);
}
sub _get_key_materials {
my $self = shift;
my $options = shift;
# "key" is a misnomer here, because it is actually usually a passphrase that is used
# to derive the true key
my $pass = $options->{pass} || $options->{key};
my $cipher_object_provided = $options->{cipher} && ref $options->{cipher};
if ($cipher_object_provided) {
carp "Both a key and a pre-initialized Crypt::* object were passed. The key will be ignored"
if defined $pass;
$pass ||= '';
}
croak "Please provide an encryption/decryption passphrase using -pass or -key"
unless defined $pass;
# Default behavior is to treat -key as a passphrase.
# But if the literal_key option is true, then use key as is
croak "The options -literal_key and -regenerate_key are incompatible with each other"
if exists $options->{literal_key} && exists $options->{regenerate_key};
my $key = $pass if $options->{literal_key};
$key = $pass if exists $options->{regenerate_key} && !$options->{regenerate_key};
# Get the salt.
my $salt = $options->{salt};
my $random_salt = 1 unless defined $salt && $salt ne '1';
croak "Argument to -salt must be exactly 8 bytes long" if defined $salt && length $salt != 8 && $salt ne '1';
# note: iv will be autogenerated by start() if not specified in options
my $iv = $options->{iv};
my $random_iv = 1 unless defined $iv;
my $literal_key = $options->{literal_key} || (exists $options->{regenerate_key} && !$options->{regenerate_key});
undef $pass if $literal_key;
return ($pass,$iv,$salt,$key,$random_salt,$random_iv);
}
sub _get_key_derivation_options {
my $self = shift;
my ($options,$header_mode) = @_;
# KEY DERIVATION PARAMETERS
# Some special cases here
# 1. literal key has been requested - use algorithm 'none'
# 2. headerless mode - use algorithm 'none'
# 3. randomiv header - use algorithm 'nosalt'
my $pbkdf = $options->{pbkdf} || ($options->{literal_key} ? 'none'
:$header_mode eq 'randomiv' ? 'randomiv'
:DEFAULT_PBKDF);
# iterations
my $iter = $options->{iter} || DEFAULT_ITER;
$iter =~ /[\d_]+/ && $iter >= 1 or croak "-iterations argument must be greater than or equal to 1";
$iter =~ /[\d_]+/ && $iter >= 1 or croak "-iterations argument must be greater than or equal to 1";
# hasher
my $hc = $options->{hasher};
my $nodeprecate = $options->{nodeprecate};
return ($pbkdf,$iter,$hc,$nodeprecate);
}
sub _get_chain_mode {
my $self = shift;
my $options = shift;
return $options->{chain_mode} ? $options->{chain_mode}
:$options->{pcbc} ? 'pcbc'
:'cbc';
}
sub _load_module {
my $self = shift;
my ($module,$args) = @_;
my $result = eval "use $module $args; 1;";
warn $@ if $@;
return $result;
}
sub _deprecation_warning {
my $self = shift;
return if $self->nodeprecate;
return if $self->{decrypt};
my $pbkdf = $self->pbkdf;
carp <<END if $pbkdf =~ /^(opensslv1|randomiv)$/;
WARNING: The key derivation method "$pbkdf" is deprecated. Using -pbkdf=>'pbkdf2' would be better.
Pass -nodeprecate=>1 to inhibit this message.
END
}
######################################### chaining mode methods ################################3
sub _needs_padding {
my $self = shift;
$self->chain_mode =~ /^p?cbc$/ && $self->padding ne \&_no_padding;
}
sub _cbc_encrypt {
my $self = shift;
my ($crypt,$iv,$result,$blocks) = @_;
# the copying looks silly, but it is slightly faster than dereferencing the
# variables each time
my ($i,$r) = ($$iv,$$result);
foreach (@$blocks) {
$r .= $i = $crypt->encrypt($i ^ $_);
}
($$iv,$$result) = ($i,$r);
}
sub _cbc_decrypt {
my $self = shift;
my ($crypt,$iv,$result,$blocks) = @_;
# the copying looks silly, but it is slightly faster than dereferencing the
# variables each time
lib/Crypt/CBC.pm view on Meta::CPAN
# The final 32 bits (4 bytes) is the counter, starting at 1
# BUT, the way that openssl v1.1.1 does it is to generate a random
# IV, treat the whole thing as a blocksize-sized integer, and then
# increment.
sub _ctr_encrypt {
my $self = shift;
my ($crypt,$iv,$result,$blocks) = @_;
my $bs = $self->blocksize;
$self->_upgrade_iv_to_ctr($iv);
my ($i,$r) = ($$iv,$$result);
foreach my $plaintext (@$blocks) {
my $bytes = int128_to_net($i++);
# pad with leading nulls if there are insufficient bytes
# (there's gotta be a better way to do this)
if ($bs > length $bytes) {
substr($bytes,0,0) = "\000"x($bs-length $bytes) ;
}
my $ciphertext = $plaintext ^ ($crypt->encrypt($bytes));
substr($ciphertext,length $plaintext) = ''; # truncate
$r .= $ciphertext;
}
($$iv,$$result) = ($i,$r);
}
*_ctr_decrypt = \&_ctr_encrypt; # same code
# upgrades instance vector to a CTR counter
# returns 1 if upgrade performed
sub _upgrade_iv_to_ctr {
my $self = shift;
my $iv = shift; # this is a scalar reference
return if ref $$iv; # already upgraded to an object
$self->_load_module("Math::Int128" => "'net_to_int128','int128_to_net'")
or croak "Optional Math::Int128 module must be installed to use the CTR chaining method";
$$iv = net_to_int128($$iv);
return 1;
}
######################################### chaining mode methods ################################3
sub pbkdf { shift->{pbkdf} }
# get the initialized PBKDF object
sub pbkdf_obj {
my $self = shift;
my $pbkdf = $self->pbkdf;
my $iter = $self->{iter};
my $hc = $self->{hasher};
my @hash_args = $hc ? ref ($hc) ? (hasher => $hc) : (hash_class => $hc)
: ();
return Crypt::CBC::PBKDF->new($pbkdf =>
{
key_len => $self->{keysize},
iv_len => $self->{blocksize},
iterations => $iter,
@hash_args,
}
);
}
############################# generating key, iv and salt ########################
sub set_key_and_iv {
my $self = shift;
if ($self->pbkdf eq 'none' || $self->{literal_key}) {
$self->{iv} = $self->_get_random_bytes($self->blocksize) if $self->{make_random_iv};
} else {
my ($key,$iv) = $self->pbkdf_obj->key_and_iv($self->{salt},$self->{passphrase});
$self->{key} = $key;
$self->{iv} = $iv if $self->{make_random_iv};
}
length $self->{salt} == 8 or croak "Salt must be exactly 8 bytes long";
length $self->{iv} == $self->{blocksize} or croak "IV must be exactly $self->{blocksize} bytes long";
}
# derive the salt, iv and key from the datastream header + passphrase
sub _read_key_and_iv {
my $self = shift;
my $input_stream = shift;
my $bs = $self->blocksize;
# use our header mode to figure out what to do with the data stream
my $header_mode = $self->header_mode;
if ($header_mode eq 'none') {
$self->{salt} ||= $self->_get_random_bytes(8);
return $self->set_key_and_iv;
}
elsif ($header_mode eq 'salt') {
($self->{salt}) = $$input_stream =~ /^Salted__(.{8})/s;
croak "Ciphertext does not begin with a valid header for 'salt' header mode" unless defined $self->{salt};
substr($$input_stream,0,16) = '';
my ($k,$i) = $self->pbkdf_obj->key_and_iv($self->{salt},$self->{passphrase});
$self->{key} = $k unless $self->{literal_key};
$self->{iv} = $i unless $self->{literal_iv};
}
elsif ($header_mode eq 'randomiv') {
($self->{iv}) = $$input_stream =~ /^RandomIV(.{8})/s;
croak "Ciphertext does not begin with a valid header for 'randomiv' header mode" unless defined $self->{iv};
croak "randomiv header mode cannot be used securely when decrypting with a >8 byte block cipher.\n"
unless $self->blocksize == 8;
($self->{key},undef) = $self->pbkdf_obj->key_and_iv(undef,$self->{passphrase});
substr($$input_stream,0,16) = ''; # truncate
}
else {
croak "Invalid header mode '$header_mode'";
}
}
# this subroutine will generate the actual {en,de}cryption key, the iv
# and the block cipher object. This is called when reading from a datastream
( run in 0.550 second using v1.01-cache-2.11-cpan-96521ef73a4 )