File Coverage

blib/lib/Crypt/Passphrase/Scrypt.pm

Criterion	Covered	Total	%
statement	34	35	97.1
branch	4	8	50.0
condition	11	19	57.8
subroutine	10	11	90.9
pod	5	5	100.0
total	64	78	82.0

package Crypt::Passphrase::Scrypt;
$Crypt::Passphrase::Scrypt::VERSION = '0.002';
use strict;
use warnings;

use parent 'Crypt::Passphrase::Encoder';

use Carp 'croak';
use Crypt::ScryptKDF qw/scrypt_b64 scrypt_raw/;
use MIME::Base64 qw/encode_base64 decode_base64/;

sub new {
	my ($class, %args) = @_;
	return bless {
		cost        => $args{cost}        || 16,
		block_size  => $args{block_size}  ||  8,
		parallel    => $args{parallel}    ||  1,
		salt_size   => $args{salt_size}   || 16,
		output_size => $args{output_size} || 16,
	}, $class;
}

sub hash_password {
	my ($self, $password) = @_;
	my $salt = $self->random_bytes($self->{salt_size});
	my $hash = scrypt_b64($password, $salt, 1 << $self->{cost}, $self->{block_size}, $self->{parallel}, $self->{output_size});
	return sprintf '$scrypt$ln=%d,r=%d,p=%d$%s$%s', $self->{cost}, $self->{block_size}, $self->{parallel}, encode_base64($salt), $hash;
}

my $decode_regex = qr/ \A \$ scrypt \$ ln=(\d+),r=(\d+),p=(\d+) \$ ([^\$]+) \$ ([^\$]*) \z /x;

sub needs_rehash {
	my ($self, $hash) = @_;
	my ($cost, $block_size, $parallel, $salt64, $hash64) = $hash =~ $decode_regex or return 1;
	return 1 if $cost < $self->{cost} or $block_size < $self->{block_size} or $parallel < $self->{parallel};
	return 1 if length decode_base64($salt64) < $self->{salt_size} or length decode_base64($hash64) < $self->{output_size};
	return 0;
}

sub crypt_subtypes {
	return 'scrypt';
}

sub verify_password {
	my ($class, $password, $hash) = @_;
	my ($cost, $block_size, $parallel, $salt64, $hash64) = $hash =~ $decode_regex or return 0;
	my $old_hash = decode_base64($hash64);
	my $new_hash = scrypt_raw($password, decode_base64($salt64), 1 << $cost, $block_size, $parallel, length $old_hash);
	return $class->secure_compare($new_hash, $old_hash);
}

1;

#ABSTRACT: A scrypt encoder for Crypt::Passphrase

__END__