File Coverage

blib/lib/Crypt/Bcrypt.pm

Criterion	Covered	Total	%
statement	41	45	91.1
branch	7	16	43.7
condition	3	6	50.0
subroutine	11	11	100.0
pod	4	4	100.0
total	66	82	80.4

package Crypt::Bcrypt;
$Crypt::Bcrypt::VERSION = '0.009';
use strict;
use warnings;

use XSLoader;
XSLoader::load('Crypt::Bcrypt');

use Exporter 5.57 'import';
our @EXPORT_OK = qw(bcrypt bcrypt_check bcrypt_hashed bcrypt_check_hashed bcrypt_needs_rehash);

use Digest::SHA 'hmac_sha256';
use MIME::Base64 2.21 qw(encode_base64);

sub bcrypt {
	my ($password, $subtype, $cost, $salt) = @_;
	die "Unknown subtype $subtype" if $subtype !~ /^2[abxy]$/;
	die "Invalid cost factor $cost" if $cost < 4 || $cost > 31;
	die "Salt must be 16 bytes" if length $salt != 16;
	my $encoded_salt = encode_base64($salt, "");
	$encoded_salt =~ tr{A-Za-z0-9+/=}{./A-Za-z0-9}d;
	return _bcrypt_hashpw($password, sprintf '$%s$%02d$%s', $subtype, $cost, $encoded_salt);
}

my $subtype_qr = qr/2[abxy]/;
my $cost_qr = qr/\d{2}/;
my $salt_qr = qr{ [./A-Za-z0-9]{22} }x;

sub bcrypt_hashed {
	my ($password, $subtype, $cost, $salt, $hash_algorithm) = @_;
	if ($hash_algorithm) {
		(my $encoded_salt = encode_base64($salt, "")) =~ tr{A-Za-z0-9+/=}{./A-Za-z0-9}d;
		my $hashed_password = encode_base64(hmac_sha256($password, $encoded_salt), "");
		my $hash = bcrypt($hashed_password, $subtype, $cost, $salt);
		$hash =~ s{ ^ \$ ($subtype_qr) \$ ($cost_qr) \$ ($salt_qr) }{\$bcrypt-sha256\$v=2,t=$1,r=$2\$$3\$}x or die $hash;
		return $hash;
	}
	else {
		bcrypt($password, $subtype, $cost, $salt);
	}
}

sub bcrypt_check_hashed {
	my ($password, $hash) = @_;
	if ($hash =~ s/ ^ \$ bcrypt-sha256 \$ v=2,t=($subtype_qr),r=($cost_qr) \$ ($salt_qr) \$ /\$$1\$$2\$$3/x) {
		return bcrypt_check(encode_base64(hmac_sha256($password, $3), ""), $hash);
	}
	else {
		bcrypt_check($password, $hash);
	}
}

sub _get_parameters {
	my ($hash) = @_;
	if ($hash =~ / \A \$ ($subtype_qr) \$ ($cost_qr) \$ /x) {
		return ($1, $2, '');
	}
	elsif ($hash =~ / ^ \$ bcrypt-sha256 \$ v=2,t=($subtype_qr),r=($cost_qr) \$ /x) {
		return ($1, $2, 'sha256');
	}
	return ('', 0, '');
}

sub bcrypt_needs_rehash {
	my ($hash, $wanted_subtype, $wanted_cost, $wanted_hash) = @_;
	my ($my_subtype, $my_cost, $my_hash) = _get_parameters($hash);
	return $my_subtype ne $wanted_subtype || $my_cost != $wanted_cost || $my_hash ne ($wanted_hash || '');
}

1;

# ABSTRACT: A modern bcrypt implementation

__END__