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 )