File Coverage

blib/lib/Crypt/Bcrypt.pm

Criterion	Covered	Total	%
statement	46	51	90.2
branch	8	18	44.4
condition	4	9	44.4
subroutine	12	13	92.3
pod	5	5	100.0
total	75	96	78.1

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

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

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

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

sub bcrypt {
	my ($password, $subtype, $cost, $salt) = @_;
	croak "Unknown subtype $subtype" if $subtype !~ /^2[abxy]$/;
	croak "Invalid cost factor $cost" if $cost < 4 || $cost > 31;
	croak "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;
my $algo_qr = qr{ sha[0-9]+ }x;

my %hash_for = (
	sha256 => \&Digest::SHA::hmac_sha256,
	sha384 => \&Digest::SHA::hmac_sha384,
	sha512 => \&Digest::SHA::hmac_sha512,
);

sub bcrypt_prehashed {
	my ($password, $subtype, $cost, $salt, $algorithm) = @_;
	if (length $algorithm) {
		(my $encoded_salt = encode_base64($salt, "")) =~ tr{A-Za-z0-9+/=}{./A-Za-z0-9}d;
		my $hasher = $hash_for{$algorithm} || croak "No such hash $algorithm";
		my $hashed_password = encode_base64($hasher->($password, $encoded_salt), "");
		my $hash = bcrypt($hashed_password, $subtype, $cost, $salt);
		$hash =~ s{ ^ \$ ($subtype_qr) \$ ($cost_qr) \$ ($salt_qr) }{\$bcrypt-$algorithm\$v=2,t=$1,r=$2\$$3\$}x or croak $hash;
		return $hash;
	}
	else {
		bcrypt($password, $subtype, $cost, $salt);
	}
}

sub bcrypt_check_prehashed {
	my ($password, $hash) = @_;
	if ($hash =~ s/ ^ \$ bcrypt-(\w+) \$ v=2,t=($subtype_qr),r=($cost_qr) \$ ($salt_qr) \$ /\$$2\$$3\$$4/x) {
		my $hasher = $hash_for{$1} or return 0;
		return bcrypt_check(encode_base64($hasher->($password, $4), ""), $hash);
	}
	else {
		return bcrypt_check($password, $hash);
	}
}

#legacy names
*bcrypt_hashed = \&bcrypt_prehashed;
*bcrypt_check_hashed = \&bcrypt_check_prehashed;

sub _get_parameters {
	my ($hash) = @_;
	if ($hash =~ / \A \$ ($subtype_qr) \$ ($cost_qr) \$ /x) {
		return ($1, $2, '');
	}
	elsif ($hash =~ / ^ \$ bcrypt-($algo_qr) \$ v=2,t=($subtype_qr),r=($cost_qr) \$ /x) {
		return ($2, $3, $1);
	}
	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 || '');
}

sub bcrypt_supported_prehashes {
	return sort keys %hash_for;
}

1;

# ABSTRACT: A modern bcrypt implementation

__END__