File Coverage

blib/lib/Crypt/Passphrase/Scrypt.pm

Criterion	Covered	Total	%
statement	60	63	95.2
branch	8	12	66.6
condition	13	19	68.4
subroutine	13	14	92.8
pod	5	6	83.3
total	99	114	86.8

package Crypt::Passphrase::Scrypt;
$Crypt::Passphrase::Scrypt::VERSION = '0.004';
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/;
our @CARP_NOT = 'Crypt::Passphrase';

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} || 32,
	}, $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', '7');
}

my $base64_digits = './0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
sub _decode_crypt64 {
	my $digits = shift;
	my $ndigits = length($digits);
	my $npadbytes = 3 - ($ndigits + 3) % 4;
	$digits .= "." x $npadbytes;
	my $bytes = "";
	for(my $i = 0; $i < $ndigits; $i += 4) {
		my $v = index($base64_digits, substr $digits, $i, 1) |
			(index($base64_digits, substr $digits, $i + 1, 1) << 6) |
			(index($base64_digits, substr $digits, $i + 2, 1) << 12) |
			(index($base64_digits, substr $digits, $i + 3, 1) << 18);
		$bytes .= chr($v & 0xff) . chr(($v >> 8) & 0xff) . chr(($v >> 16) & 0xff);
	}
	substr $bytes, -$npadbytes, $npadbytes, "";
	return $bytes;
}

sub _decode_number {
	my $input = shift;
	my $result = 0;
	for (0 .. length($input) - 1) {
		$result += index($base64_digits, substr $input, $_, 1) * (1 << (6 * $_));
	}
	return $result;
}

my $char64 = qr{[./0-9A-Za-z]};
my $regex7 = qr/ ^ \$7\$ ($char64) ($char64{5}) ($char64{5}) ([^\$]{22}) \$ ([^\$]*) /x;

sub verify_password {
	my ($class, $password, $hash) = @_;
	if (my ($cost, $block_size, $parallel, $salt64, $hash64) = $hash =~ $decode_regex) {
		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);
	}
	elsif (my ($encoded_cost, $encoded_block_size, $encoded_parallel, $salt, $encoded_hash) = $hash =~ $regex7) {
		my ($cost, $block_size, $parallel) = map { _decode_number($_) } $encoded_cost, $encoded_block_size, $encoded_parallel;
		my $old_hash = _decode_crypt64($encoded_hash);
		my $new_hash = scrypt_raw($password, $salt, 1 << $cost, $block_size, $parallel, length $old_hash);
		return $class->secure_compare($new_hash, $old_hash);
	}
	return !!0;
}

sub recode_hash {
	my ($self, $hash) = @_;
	if (my ($encoded_cost, $encoded_block_size, $encoded_parallel, $salt, $encoded_hash) = $hash =~ $regex7) {
		my ($cost, $block_size, $parallel) = map { _decode_number($_) } $encoded_cost, $encoded_block_size, $encoded_parallel;
		my $recoded_hash = encode_base64(_decode_crypt64($encoded_hash));
		return sprintf '$scrypt$ln=%d,r=%d,p=%d$%s$%s', $cost, $block_size, $parallel, encode_base64($salt), $recoded_hash;
	}
	return $hash;
}

1;

#ABSTRACT: A scrypt encoder for Crypt::Passphrase

__END__