File Coverage

blib/lib/Crypt/Passphrase/System.pm

Criterion	Covered	Total	%
statement	34	39	87.1
branch	3	12	25.0
condition	5	15	33.3
subroutine	12	12	100.0
pod	6	6	100.0
total	60	84	71.4

package Crypt::Passphrase::System;
$Crypt::Passphrase::System::VERSION = '0.015';
use strict;
use warnings;

use Crypt::Passphrase -encoder;

use Carp 'croak';
use MIME::Base64 qw/encode_base64/;

my @possibilities = (
	[1   , '$1$'              ,  6, '$1$aaaaaa$FuYJ957Lgsw.eVsENqOok1'                                                                ],
	[5   , '$5$rounds=535000$', 12, '$5$aaaaaa$9hHgJfCniK4.dU43ykArHVETrhKDDElbS.cioeCajw.'                                           ],
	[6   , '$6$rounds=656000$', 12, '$6$aaaaaa$RgJSheuY/DBadaBm/5gQ.s3M9a/2n8gubwCE41kMiz1P4KcxORD6LxY2NUCuOQNZawfiD8tWWfRKg9v0CQjbH0'],
	['2x', '$2x$12$'          , 16, '$2x$08$......................qrjEXaz4RUVmquy3IT5eLKXLB28ahI2'                                    ],
	['2a', '$2a$12$'          , 16, '$2a$08$......................qrjEXaz4RUVmquy3IT5eLKXLB28ahI2'                                    ],
	['2y', '$2y$12$'          , 16, '$2y$08$......................qrjEXaz4RUVmquy3IT5eLKXLB28ahI2'                                    ],
	['2b', '$2b$12$'          , 16, '$2b$08$......................qrjEXaz4RUVmquy3IT5eLKXLB28ahI2'                                    ],
	[7   , '$7$DU..../....'   , 16, '$7$AU..../....2Q9obwLhin8qvQl6sisAO/$E1HizYWxBmnIH4sdPkd1UOML9t62Gf.wvNTnt5XFzs8'                ],
	['gy', '$gy$j8T$'         , 18, '$gy$j9T$......................$5.2XCu2DhNfGzpifM7X8goEG2Wkio9cWIMtyWnX4tp2'                      ],
	['y' , '$y$j8T$'          , 18, '$y$j9T$F5Jx5fExrKuPp53xLKQ..1$tnSYvahCwPBHKZUspmcxMfb0.WiB9W.zEaKlOBL35rC'                       ],
);

my (%algorithm, %salt_for, $default);
for my $row (@possibilities) {
	my ($name, $setting, $salt_size, $value) = @{$row};
	my $hash = eval { crypt('password', $value) };
	if (defined $hash and $hash eq $value) {
		$algorithm{$name} = { settings => $setting, salt_size => $salt_size };
		$default = $name;
	}
}

sub _get_parameters {
	my %args = @_;

	if (defined(my $settings = $args{settings})) {
		return ('', 2) if $settings eq '';

		my ($type) = $settings =~ /\A \$ ([^\$]+) \$ /x or croak "Invalid settings string '$settings'";
		croak "Unsupported algorithm $type" if not $algorithm{$type};
		return ($settings, $args{salt_size} // $algorithm{$type}{salt_size});
	}
	elsif (my $type = $args{type} // $default) {
		$settings = $algorithm{$type}{settings} // croak "No such crypt type $type known";
		return ($settings, $args{salt_size} // $algorithm{$type}{salt_size});
	}
	else {
		return ('', 2);
	}
}

sub new {
	my ($class, %args) = @_;

	my ($settings, $salt_size) = _get_parameters(%args);
	return bless {
		settings  => $settings,
		salt_size => $salt_size,
	}, $class;
}

sub hash_password {
	my ($self, $password) = @_;
	my $salt = $self->random_bytes($self->{salt_size});
	my $encoded_salt = encode_base64($salt, "") =~ tr{A-Za-z0-9+/=}{./0-9A-Za-z}dr;
	return crypt($password, "$self->{settings}$encoded_salt\$");
}

my $descrypt = qr{ \A [./0-9A-Za-z]{13} \z }x;

sub accepts_hash {
	my ($self, $hash) = @_;
	return $hash =~ $descrypt || $self->SUPER::accepts_hash($hash);
}

sub crypt_subtypes {
	return sort keys %algorithm;
}

sub needs_rehash {
	my ($self, $hash) = @_;
	return length $self->{settings} ? substr($hash, 0, length $self->{settings}) ne $self->{settings} : $hash !~ $descrypt;
}

sub verify_password {
	my ($class, $password, $hash) = @_;
	my $new_hash = crypt($password, $hash);
	return $class->secure_compare($hash, $new_hash);
}

#ABSTRACT: An system crypt() encoder for Crypt::Passphrase

1;

__END__