File Coverage

blib/lib/Crypt/Passphrase/System.pm

Criterion	Covered	Total	%
statement	39	46	84.7
branch	9	16	56.2
condition	10	27	37.0
subroutine	11	11	100.0
pod	5	6	83.3
total	74	106	69.8

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

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

use Crypt::Passphrase::Util::Crypt64 'encode_crypt64';

use Carp 'croak';

my @possibilities = (
	['3' , '$3$'              ,  0, '$3$$8846f7eaee8fb117ad06bdd830b7586c'],
	['',   ''                 ,  2, 'abJnggxhB/yWI' , '%s%s'],
	['_',  '_EQ0.'            ,  3, '_EQ0.jzhSVeUyoSqLupI', '%s%s'],
	['1' , '$1$'              ,  6, '$1$aaaaaa$FuYJ957Lgsw.eVsENqOok1'                                                                ],
	['md5', '$md5,rounds=5000$', 6, '$md5,rounds=5000$GUBv0xjJ$$PI9W.MLvhYh0hQMCkz1CH/', '%s%s$'],
	['sha1', '$sha1$40000$'   ,  6, '$sha1$40000$jtNX3nZ2$hBNaIXkt4wBI2o5rsi8KejSjNqIq'],
	['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$'         , 16, '$gy$j9T$......................$5.2XCu2DhNfGzpifM7X8goEG2Wkio9cWIMtyWnX4tp2'                      ],
	['y' , '$y$j8T$'          , 16, '$y$j9T$F5Jx5fExrKuPp53xLKQ..1$tnSYvahCwPBHKZUspmcxMfb0.WiB9W.zEaKlOBL35rC'                       ],
);

my (%algorithm, $default);

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

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

	my ($settings, $salt_size, $format);
	if (defined($settings = $args{settings})) {
		if ($settings eq '') {
			($salt_size, $format) = (2, '%s%s');
		} elsif ($settings eq '_') {
			($salt_size, $format) = (3, '%s%s');
		} else {
			my $type = $settings =~ /\A \$ ([^\$]+) \$ /x or croak "Invalid settings string '$settings'";
			$salt_size = $args{salt_size} // $algorithm{$type}{salt_size} // 16;
			$format = $args{format} // $algorithm{$type}{format} // '%s%s$';
		}
	}
	else {
		my $type = $args{type} // $default // croak 'No known crypt type found';
		$settings = $algorithm{$type}{settings} // croak "No such crypt type '$type' known";
		$salt_size = $args{salt_size} // $algorithm{$type}{salt_size};
		$format = $args{format} // $algorithm{$type}{format} // '%s%s$';
	}

	return bless {
		settings  => $settings,
		salt_size => $salt_size,
		format    => $format,
	}, $class;
}

sub hash_password {
	my ($self, $password) = @_;
	my $salt = $self->random_bytes($self->{salt_size});
	my $encoded_salt = encode_crypt64($salt);
	substr $encoded_salt, 2, 1, '' if $self->{salt_size} == 2; # descrypt

	my $settings = sprintf $self->{format}, $self->{settings}, $encoded_salt;
	return crypt $password, $settings;
}

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

my @formats;
push @formats, $descrypt if $algorithm{''};
push @formats, qr{ \A _[./0-9A-Za-z]{19} \z }x if $algorithm{'_'};

sub accepts_hash {
	my ($self, $hash) = @_;
	return 1 if $self->SUPER::accepts_hash($hash);
	for my $format (@formats) {
		return 1 if $hash =~ $format;
	}
	return 0;
}

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__