File Coverage

lib/Crypt/CBC.pm

Criterion	Covered	Total	%
statement	352	445	79.1
branch	163	246	66.2
condition	74	121	61.1
subroutine	57	71	80.2
pod	22	29	75.8
total	668	912	73.2

package Crypt::CBC;

use strict;
use Carp 'croak','carp';
use Crypt::CBC::PBKDF;
use bytes;
use vars qw($VERSION);
no warnings 'uninitialized';
$VERSION = '3.04';

use constant RANDOM_DEVICE      => '/dev/urandom';
use constant DEFAULT_PBKDF      => 'opensslv1';
use constant DEFAULT_ITER       => 10_000;  # same as OpenSSL default

my @valid_options = qw(
    pass
    key
    cipher
    keysize
    chain_mode
    pbkdf
    nodeprecate
    iter
    hasher
    header
    iv
    salt
    padding
    literal_key
    pcbc
    add_header
    generate_key
    prepend_iv
    );

sub new {
    my $class = shift;

    # the _get_*() methods move a lot of the ugliness/legacy logic
    # out of new(). But the ugliness is still there!
    my $options               = $class->_get_options(@_);
    eval {$class->_validate_options($options)} or croak $@;

    my $cipher                = $class->_get_cipher_obj($options);
    my $header_mode           = $class->_get_header_mode($options);
    my ($ks,$bs)              = $class->_get_key_and_block_sizes($cipher,$options);
    my ($pass,$iv,$salt,$key,
	$random_salt,$random_iv) = $class->_get_key_materials($options);
    my $padding                  = $class->_get_padding_mode($bs,$options);
    my ($pbkdf,$iter,
	$hc,$nodeprecate)        = $class->_get_key_derivation_options($options,$header_mode);
    my $chain_mode               = $class->_get_chain_mode($options);

    ### CONSISTENCY CHECKS ####

    # set literal key flag if a key was passed in or the key derivation algorithm is none
    $key               ||= $pass if $pbkdf eq 'none';  # just in case
    my $literal_key      = defined $key;

    # check length of initialization vector
    croak "Initialization vector must be exactly $bs bytes long when using the $cipher cipher"
	if defined $iv and length($iv) != $bs;

    # chaining mode check
    croak "invalid cipher block chain mode: $chain_mode"
	unless $class->can("_${chain_mode}_encrypt");

    # KEYSIZE consistency
    if (defined $key && length($key) != $ks) {
	croak "If specified by -literal_key, then the key length must be equal to the chosen cipher's key length of $ks bytes";
    }

    # HEADER consistency
    if ($header_mode eq 'salt') {
	croak "Cannot use salt-based key generation if literal key is specified"
	    if $literal_key;
    }
    elsif ($header_mode eq 'randomiv') {
	croak "Cannot encrypt using a non-8 byte blocksize cipher when using randomiv header mode"
	    unless $bs == 8
    }

    croak "If a key derivation function (-pbkdf) of 'none' is provided, a literal key and iv must be provided"
	if $pbkdf eq 'none' && (!defined $key || !defined $iv);

    croak "If a -header mode of 'randomiv' is provided, then the -pbkdf key derivation function must be 'randomiv' or undefined"
	if $header_mode eq 'randomiv' and $pbkdf ne 'randomiv';

    return bless {
	'cipher'      => $cipher,
	    'passphrase'  => $pass,
	    'key'         => $key,
	    'iv'          => $iv,
	    'salt'        => $salt,
	    'padding'     => $padding,
	    'blocksize'   => $bs,
	    'keysize'     => $ks,
	    'header_mode' => $header_mode,
	    'literal_key' => $literal_key,
	    'literal_iv'  => defined $iv,
	    'chain_mode'  => $chain_mode,
	    'make_random_salt' => $random_salt,
	    'make_random_iv'   => $random_iv,
	    'pbkdf'        => $pbkdf,
	    'iter'         => $iter,
	    'hasher'       => $hc,
	    'nodeprecate'  => $nodeprecate,
    },$class;
}

sub filehandle {
    my $self = shift;
    $self->_load_module('Crypt::FileHandle')
	or croak "Optional Crypt::FileHandle module must be installed to use the filehandle() method";

    if (ref $self) { # already initialized
	return Crypt::FileHandle->new($self);
    }
    else { # create object
	return Crypt::FileHandle->new($self->new(@_));
    }
}

sub encrypt (\$$) {
    my ($self,$data) = @_;
    $self->start('encrypting');
    my $result = $self->crypt($data);
    $result .= $self->finish;
    $result;
}

sub decrypt (\$$){
    my ($self,$data) = @_;
    $self->start('decrypting');
    my $result = $self->crypt($data);
    $result .= $self->finish;
    $result;
}

sub encrypt_hex (\$$) {
    my ($self,$data) = @_;
    return join('',unpack 'H*',$self->encrypt($data));
}

sub decrypt_hex (\$$) {
    my ($self,$data) = @_;
    return $self->decrypt(pack 'H*',$data);
}

# call to start a series of encryption/decryption operations
sub start (\$$) {
    my $self = shift;
    my $operation = shift;
    croak "Specify ncryption or ecryption" unless $operation=~/^[ed]/i;

    delete $self->{'civ'};
    $self->{'buffer'} = '';
    $self->{'decrypt'} = $operation=~/^d/i;
    $self->_deprecation_warning;
}

sub chain_mode { shift->{chain_mode} || 'cbc' }

sub chaining_method {
    my $self    = shift;
    my $decrypt = shift;

    # memoize this result
    return $self->{chaining_method}{$decrypt}
           if exists $self->{chaining_method}{$decrypt};

    my $cm   = $self->chain_mode;
    my $code = $self->can($decrypt ? "_${cm}_decrypt" : "_${cm}_encrypt");
    croak "Chain mode $cm not supported" unless $code;
    return $self->{chaining_method}{$decrypt} = $code;
}

# call to encrypt/decrypt a bit of data
sub crypt (\$$){
    my $self = shift;
    my $data = shift;

    my $result;

    croak "crypt() called without a preceding start()"
      unless exists $self->{'buffer'};

    my $d = $self->{'decrypt'};

    unless ($self->{civ}) { # block cipher has not yet been initialized
      $result = $self->_generate_iv_and_cipher_from_datastream(\$data)      if $d;
      $result = $self->_generate_iv_and_cipher_from_options()           unless $d;
    }

    my $iv = $self->{'civ'};
    $self->{'buffer'} .= $data;

    my $bs = $self->{'blocksize'};

    croak "When using no padding, plaintext size must be a multiple of $bs"
	if $self->_needs_padding
	and $self->{'padding'} eq \&_no_padding
	and length($data) % $bs;

    croak "When using rijndael_compat padding, plaintext size must be a multiple of $bs"
	if $self->_needs_padding
	and $self->{'padding'} eq \&_rijndael_compat
	and length($data) % $bs;

    return $result unless (length($self->{'buffer'}) >= $bs);

    my @blocks     = unpack("(a$bs)*",$self->{buffer});
    $self->{buffer} = '';

    # if decrypting, leave the last block in the buffer for padding
    if ($d) {
	$self->{buffer} = pop @blocks;
    } else {
	$self->{buffer} = pop @blocks if length $blocks[-1] < $bs;
    }

    my $code = $self->chaining_method($d);
    #    $self->$code($self->{crypt},\$iv,\$result,\@blocks);
    # calling the code sub directly is slightly faster for some reason
    $code->($self,$self->{crypt},\$iv,\$result,\@blocks);

    $self->{'civ'} = $iv;	        # remember the iv
    return $result;
}

# this is called at the end to flush whatever's left
sub finish (\$) {
    my $self = shift;
    my $bs    = $self->{'blocksize'};

    my $block    = $self->{buffer};  # what's left

    # Special case hack for backward compatibility with Crypt::Rijndael's CBC_MODE.
    if (length $block == 0 && $self->{padding} eq \&_rijndael_compat) {
	delete $self->{'civ'};
	delete $self->{'buffer'};
	return '';
    }

    $self->{civ} ||= '';
    my $iv    = $self->{civ};
    my $code = $self->chaining_method($self->{decrypt});

    my $result = '';
    if ($self->{decrypt}) {
	$self->$code($self->{crypt},\$iv,\$result,[$block]);
	$result = $self->{padding}->($result,$bs,'d')        if $self->_needs_padding;
    } else {
	$block = $self->{padding}->($block,$bs,'e')          if $self->_needs_padding;
	$self->$code($self->{crypt},\$iv,\$result,[$block])  unless length $block==0 && !$self->_needs_padding
    }

    delete $self->{'civ'};
    delete $self->{'buffer'};
    return $result;
}

############# Move the boring new() argument processing here #######
sub _get_options {
    my $class    = shift;

    my $options = {};

    # hashref arguments
    if (ref $_[0] eq 'HASH') {
      $options = shift;
    }

    # CGI style arguments
    elsif ($_[0] =~ /^-[a-zA-Z_]{1,20}$/) {
      my %tmp = @_;
      while ( my($key,$value) = each %tmp) {
	$key =~ s/^-//;
	$options->{lc $key} = $value;
      }
    }

    else {
	$options->{key}    = shift;
	$options->{cipher} = shift;
    }
    return $options;
}

sub _get_cipher_obj {
    my $class = shift;
    my $options = shift;

    my $cipher = $options->{cipher};
    $cipher = 'Crypt::Cipher::AES' unless $cipher;

    unless (ref $cipher) {  # munge the class name if no object passed
      $cipher = $cipher=~/^Crypt::/ ? $cipher : "Crypt::$cipher";
      $cipher->can('encrypt') or eval "require $cipher; 1" or croak "Couldn't load $cipher: $@";
      # some crypt modules use the class Crypt::, and others don't
      $cipher =~ s/^Crypt::// unless $cipher->can('keysize');
    }

    return $cipher;
}

sub _validate_options {
    my $self    = shift;
    my $options = shift;
    my %valid_options = map {$_=>1} @valid_options;
    for my $o (keys %$options) {
	die "'$o' is not a recognized argument" unless $valid_options{$o};
    }
    return 1;
}

sub _get_header_mode {
    my $class = shift;
    my $options = shift;

    # header mode checking
    my %valid_modes = map {$_=>1} qw(none salt randomiv);
    my $header_mode     = $options->{header};
    $header_mode      ||= 'none'     if exists $options->{prepend_iv}  && !$options->{prepend_iv};
    $header_mode      ||= 'none'     if exists $options->{add_header}  && !$options->{add_header};
    $header_mode      ||= 'none'     if $options->{literal_key}        || (exists $options->{pbkdf} && $options->{pbkdf} eq 'none');
    $header_mode      ||= 'salt';    # default
    croak "Invalid -header mode '$header_mode'" unless $valid_modes{$header_mode};

    return $header_mode;
}

sub _get_padding_mode {
    my $class = shift;
    my ($bs,$options) = @_;

    my $padding     = $options->{padding} || 'standard';

    if ($padding && ref($padding) eq 'CODE') {
	# check to see that this code does its padding correctly
	for my $i (1..$bs-1) {
	  my $rbs = length($padding->(" "x$i,$bs,'e'));
	  croak "padding method callback does not behave properly: expected $bs bytes back, got $rbs bytes back."
	      unless ($rbs == $bs);
	}
    } else {
	$padding = $padding eq 'none'     ? \&_no_padding
	    :$padding eq 'null'           ? \&_null_padding
	    :$padding eq 'space'          ? \&_space_padding
	    :$padding eq 'oneandzeroes'   ? \&_oneandzeroes_padding
	    :$padding eq 'rijndael_compat'? \&_rijndael_compat
	    :$padding eq 'standard'       ? \&_standard_padding
	    :croak "'$padding' padding not supported.  See perldoc Crypt::CBC for instructions on creating your own.";
    }
    return $padding;
}

sub _get_key_and_block_sizes {
    my $class = shift;
    my $cipher  = shift;
    my $options = shift;

    # allow user to override the keysize value
    my $ks = $options->{keysize} || eval {$cipher->keysize} || eval {$cipher->max_keysize}
             or croak "Cannot derive keysize from $cipher";

    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 <
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
    my ($i,$r) = ($$iv,$$result);
    foreach (@$blocks) {
	$r    .= $i ^ $crypt->decrypt($_);
	$i     = $_;
    }
    ($$iv,$$result) = ($i,$r);
}

sub _pcbc_encrypt {
    my $self = shift;
    my ($crypt,$iv,$result,$blocks) = @_;
    foreach my $plaintext (@$blocks) {
	$$result .= $$iv = $crypt->encrypt($$iv ^ $plaintext);
	$$iv     ^= $plaintext;
    }
}

sub _pcbc_decrypt {
    my $self = shift;
    my ($crypt,$iv,$result,$blocks) = @_;
    foreach my $ciphertext (@$blocks) {
	$$result .= $$iv = $$iv ^ $crypt->decrypt($ciphertext);
	$$iv ^= $ciphertext;
    }
}

sub _cfb_encrypt {
    my $self = shift;
    my ($crypt,$iv,$result,$blocks) = @_;
    my ($i,$r) = ($$iv,$$result);
    foreach my $plaintext (@$blocks) {
	$r .= $i = $plaintext ^ $crypt->encrypt($i)
    }
    ($$iv,$$result) = ($i,$r);
}

sub _cfb_decrypt {
    my $self = shift;
    my ($crypt,$iv,$result,$blocks) = @_;
    my ($i,$r) = ($$iv,$$result);
    foreach my $ciphertext (@$blocks) {
	$r .= $ciphertext ^ $crypt->encrypt($i);
	$i      = $ciphertext;
    }
    ($$iv,$$result) = ($i,$r);
}

sub _ofb_encrypt {
    my $self = shift;
    my ($crypt,$iv,$result,$blocks) = @_;
    my ($i,$r) = ($$iv,$$result);
    foreach my $plaintext (@$blocks) {
	my $ciphertext = $plaintext ^ ($i = $crypt->encrypt($i));
	substr($ciphertext,length $plaintext) = '';  # truncate
	$r .= $ciphertext;
    }
    ($$iv,$$result) = ($i,$r);
}

*_ofb_decrypt = \&_ofb_encrypt;  # same code

# According to RFC3686, the counter is 128 bits (16 bytes)
# The first 32 bits (4 bytes) is the nonce
# The next  64 bits (8 bytes) is the IV
# 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 ########################
# hopefully a replacement for mess below
sub set_key_and_iv {
    my $self = shift;

    if (!$self->{literal_key}) {
	my ($key,$iv) = $self->pbkdf_obj->key_and_iv($self->{salt},$self->{passphrase});
	$self->{key} = $key;
	$self->{iv}  = $iv if $self->{make_random_iv};
    } else {
	$self->{iv} = $self->_get_random_bytes($self->blocksize) 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;
	(undef,$self->{key}) = $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
# and so it uses previous values of salt or iv if they are encoded in datastream
# header
sub _generate_iv_and_cipher_from_datastream {
  my $self         = shift;
  my $input_stream = shift;

  $self->_read_key_and_iv($input_stream);
  $self->{civ}   = $self->{iv};

  # we should have the key and iv now, or we are dead in the water
  croak "Could not derive key or iv from cipher stream, and you did not specify these values in new()"
    unless $self->{key} && $self->{civ};

  # now we can generate the crypt object itself
  $self->{crypt} = ref $self->{cipher} ? $self->{cipher}
                                       : $self->{cipher}->new($self->{key})
					 or croak "Could not create $self->{cipher} object: $@";
  return '';
}

sub _generate_iv_and_cipher_from_options {
    my $self   = shift;

    $self->{salt}   = $self->_get_random_bytes(8) if $self->{make_random_salt};
    $self->set_key_and_iv;
    $self->{civ}   = $self->{iv};

    my $result = '';
    my $header_mode = $self->header_mode;

    if ($header_mode eq 'salt') {
	$result  = "Salted__$self->{salt}";
    }

    elsif ($header_mode eq 'randomiv') {
	$result = "RandomIV$self->{iv}";
	undef $self->{salt}; # shouldn't be there!
    }

    croak "key and/or iv are missing" unless defined $self->{key} && defined $self->{civ};

    $self->_taintcheck($self->{key});
    $self->{crypt} = ref $self->{cipher} ? $self->{cipher}
                                         : $self->{cipher}->new($self->{key})
  					   or croak "Could not create $self->{cipher} object: $@";
  return $result;
}

sub _taintcheck {
    my $self = shift;
    my $key  = shift;
    return unless ${^TAINT};

    my $has_scalar_util = eval "require Scalar::Util; 1";
    my $tainted;


    if ($has_scalar_util) {
	$tainted = Scalar::Util::tainted($key);
    } else {
	local($@, $SIG{__DIE__}, $SIG{__WARN__});
	local $^W = 0;
	eval { kill 0 * $key };
	$tainted = $@ =~ /^Insecure/;
    }

    croak "Taint checks are turned on and your key is tainted. Please untaint the key and try again"
	if $tainted;
}

sub _digest_obj {
    my $self = shift;

    if ($self->{digest_obj}) {
	$self->{digest_obj}->reset();
	return $self->{digest_obj};
    }

    my $alg  = $self->{digest_alg};
    return $alg if ref $alg && $alg->can('digest');
    my $obj  = eval {Digest->new($alg)};
    croak "Unable to instantiate '$alg' digest object: $@" if $@;

    return $self->{digest_obj} = $obj;
}

sub random_bytes {
  my $self  = shift;
  my $bytes = shift or croak "usage: random_bytes(\$byte_length)";
  $self->_get_random_bytes($bytes);
}

sub _get_random_bytes {
  my $self   = shift;
  my $length = shift;
  my $result;

  if (-r RANDOM_DEVICE && open(F,RANDOM_DEVICE)) {
    read(F,$result,$length);
    close F;
  } else {
    $result = pack("C*",map {rand(256)} 1..$length);
  }
  # Clear taint and check length
  $result =~ /^(.+)$/s;
  length($1) == $length or croak "Invalid length while gathering $length random bytes";
  return $1;
}

sub _standard_padding ($$$) {
  my ($b,$bs,$decrypt) = @_;

  if ($decrypt eq 'd') {
    my $pad_length = unpack("C",substr($b,-1));
    return substr($b,0,$bs-$pad_length);
  }
  my $pad = $bs - length($b);
  return $b . pack("C*",($pad)x$pad);
}

sub _space_padding ($$$) {
    my ($b,$bs,$decrypt) = @_;

    if ($decrypt eq 'd') {
	$b=~ s/ *\z//s;
    } else {
	$b .= pack("C*", (32) x ($bs-length($b)));
    }
    return $b;
}

sub _no_padding ($$$) {
  my ($b,$bs,$decrypt) = @_;
  return $b;
}

sub _null_padding ($$$) {
  my ($b,$bs,$decrypt) = @_;
  return unless length $b;
  $b = length $b ? $b : '';
  if ($decrypt eq 'd') {
     $b=~ s/\0*\z//s;
     return $b;
  }
  return $b . pack("C*", (0) x ($bs - length($b) % $bs));
}

sub _oneandzeroes_padding ($$$) {
  my ($b,$bs,$decrypt) = @_;
  if ($decrypt eq 'd') {
     $b=~ s/\x80\0*\z//s;
     return $b;
  }
  return $b . pack("C*", 128, (0) x ($bs - length($b) - 1) );
}

sub _rijndael_compat ($$$) {
  my ($b,$bs,$decrypt) = @_;

  return unless length $b;
  if ($decrypt eq 'd') {
     $b=~ s/\x80\0*\z//s;
     return $b;
  }
  return $b . pack("C*", 128, (0) x ($bs - length($b) % $bs - 1) );
}

sub get_initialization_vector (\$) {
  my $self = shift;
  $self->iv();
}

sub set_initialization_vector (\$$) {
  my $self = shift;
  my $iv   = shift;
  my $bs   = $self->blocksize;
  croak "Initialization vector must be $bs bytes in length" unless length($iv) == $bs;
  $self->iv($iv);
}

sub salt {
  my $self = shift;
  my $d    = $self->{salt};
  $self->{salt} = shift if @_;
  $d;
}

sub iv {
  my $self = shift;
  my $d    = $self->{iv};
  $self->{iv} = shift if @_;
  $d;
}

sub key {
  my $self = shift;
  my $d    = $self->{key};
  $self->{key} = shift if @_;
  $d;
}

sub passphrase {
  my $self = shift;
  my $d    = $self->{passphrase};
  if (@_) {
    undef $self->{key};
    undef $self->{iv};
    $self->{passphrase} = shift;
  }
  $d;
}

sub keysize   {
    my $self = shift;
    $self->{keysize} = shift if @_;
    $self->{keysize};
}

sub cipher    { shift->{cipher}    }
sub padding   { shift->{padding}   }
sub blocksize { shift->{blocksize} }
sub pcbc      { shift->{pcbc}      }
sub header_mode {shift->{header_mode} }
sub literal_key {shift->{literal_key}}
sub nodeprecate {shift->{nodeprecate}}

1;
__END__