File Coverage

blib/lib/Crypt/Passphrase/Linux.pm

Criterion	Covered	Total	%
statement	33	34	97.0
branch	2	4	50.0
condition	5	9	55.5
subroutine	9	10	90.0
pod	5	5	100.0
total	54	62	87.1

package Crypt::Passphrase::Linux;
$Crypt::Passphrase::Linux::VERSION = '0.001';
use strict;
use warnings;

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

use Crypt::Passwd::XS 'crypt';
use MIME::Base64 qw/encode_base64 decode_base64/;

my %identifier_for = (
	md5        => '1',
	apache_md5 => 'apr1',
	sha256     => '5',
	sha512     => '6',
);

my %salt_size = (
	md5        => 6,
	apache_md5 => 6,
	sha256     => 12,
	sha512     => 12,
);

sub new {
	my ($class, %args) = @_;
	my $type_name = $args{type} // 'sha512';
	my $type = $identifier_for{$type_name} // die "No such crypt type $type_name";
	my $salt_size = $salt_size{$type_name};
	my $rounds = $args{rounds} // 656_000;

	return bless {
		type      => $type,
		rounds    => $rounds + 0,
		salt_size => $salt_size,
	}, $class;
}

sub hash_password {
	my ($self, $password) = @_;
	my $salt = $self->random_bytes($self->{salt_size});
	my $settings = sprintf '$%s$rounds=%d$%s', $self->{type}, $self->{rounds}, encode_base64($salt);
	return Crypt::Passwd::XS::crypt($password, $settings);
}

sub crypt_subtypes {
	return values %identifier_for;
}

my $regex = qr/ ^ \$ (1|5|6|apr1) \$ (?: rounds= ([0-9]+) \$ )? ([^\$]*) \$ [^\$]+ $ /x;

sub needs_rehash {
	my ($self, $hash) = @_;
	my ($type, $rounds, $salt) = $hash =~ $regex or return 0;
	$rounds = 5000 if $rounds eq '';
	return $type ne $self->{type} || $rounds != $self->{rounds} || length $salt != $self->{salt_size} * 4 / 3;
}

sub verify_password {
	my ($class, $password, $hash) = @_;
	my ($settings) = $hash =~ /^(.*)\$[^\$]*/;
	my $new_hash = Crypt::Passwd::XS::crypt($password, $settings);
	return $class->secure_compare($hash, $new_hash);
}

#ABSTRACT: An linux crypt encoder for Crypt::Passphrase

1;

__END__