File Coverage

blib/lib/Crypt/Password/Util.pm

Criterion	Covered	Total	%
statement	33	38	86.8
branch	5	8	62.5
condition	1	4	25.0
subroutine	8	8	100.0
pod	3	3	100.0
total	50	61	81.9

package Crypt::Password::Util;

our $DATE = '2016-01-21'; # DATE
our $VERSION = '0.16'; # VERSION

use 5.010001;
use strict;
use warnings;

use Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(crypt_type looks_like_crypt crypt);

my $b64d = qr![A-Za-z0-9./]!;
my $hexd = qr![0-9a-f]!;

our %CRYPT_TYPES = (
    'MD5-CRYPT' => {
        summary => 'A baroque passphrase scheme based on MD5, designed by Poul-Henning Kamp and originally implemented in FreeBSD',
        re => qr/\A
                 (?P\$ (?:apr)?1 \$)
                 (?P$b64d {0,8}) \$
                 (?P$b64d {22}) \z/x,
        re_summary => '$1$ or $apr1$ header',
        link => 'http://static.usenix.org/event/usenix99/provos/provos_html/node10.html',
    },
    CRYPT => {
        summary => 'Traditional DES crypt',
        re => qr/\A
                 (?P$b64d {2} | \$\$) # $$ is not accepted as salt, but we see crypts using those in the wild
                 (?P$b64d {11}) \z/x,
        re_summary => '11 digit base64 characters',
        link => 'http://perldoc.perl.org/functions/crypt.html',
    },
    'EXT-DES' => {
        summary => 'Extended DES crypt',
        re => qr/\A
                 (?P_ $b64d {8} )
                 (?P$b64d {11}) \z/x,
        re_summary => 'underscore followed by 19 digit base64 characters',
        link => 'https://en.wikipedia.org/wiki/Crypt_%28C%29#BSDi_extended_DES-based_scheme',
    },
    SSHA256 => {
        summary => 'Salted SHA256, supported by glibc 2.7+',
        re => qr/\A
                 (?P\$ 5 \$)
                 (?P (?:rounds=[1-9][0-9]{3,8}\$)? $b64d {0,16}) \$
                 (?P$b64d {43}) \z/x,
        re_summary => '$5$ header',
        link => 'http://en.wikipedia.org/wiki/SHA-2',
    },
    SSHA512 => {
        summary => 'Salted SHA512, supported by glibc 2.7+',
        re => qr/\A
                 (?P\$ 6 \$)
                 (?P (?:rounds=[1-9][0-9]{3,8}\$)? $b64d {0,16}) \$
                 (?P$b64d {86}) \z/x,
        re_summary => '$6$ header',
        link => 'http://en.wikipedia.org/wiki/SHA-2',
    },
    BCRYPT => {
        summary => 'Passphrase scheme based on Blowfish, designed by Niels Provos and David Mazieres for OpenBSD',
        re => qr/\A
                 (?P\$ 2 [ayb]? \$)
                 (?P\d+) \$
                 (?P$b64d {22})
                 (?P$b64d {31}) \z/x,
        re_summary => '$2$ or $2a$ header followed by cost, followed by 22 base64-digits salt and 31 digits hash',
        link => 'https://www.usenix.org/legacy/event/usenix99/provos/provos_html/',
    },
    'PLAIN-MD5' => {
        summary => 'Unsalted MD5 hash, popular with PHP web applications',
        re => qr/\A (?P$hexd {32}) \z/x,
        re_summary => '32 digits of hex characters',
        link => 'http://en.wikipedia.org/wiki/MD5',
    },
);

sub crypt_type {
    my $crypt = shift;
    my $detail = shift;

    for my $type (keys %CRYPT_TYPES) {
        if ($crypt =~ $CRYPT_TYPES{$type}{re}) {
            if ($detail) {
                my $res = {%+};
                $res->{type} = $type;
                return $res;
            } else {
                return $type;
            }
        }
    }
    return undef;
}

sub looks_like_crypt { !!crypt_type($_[0]) }

sub crypt {
    require UUID::Random::Patch::UseMRS;
    require Digest::MD5;

    my $pass = shift;
    my ($salt, $crypt);

    # first use SSHA512
    $salt  = substr(Digest::MD5::md5_base64(UUID::Random::generate()), 0, 16);
    $salt =~ tr/\+/./;
    $crypt = CORE::crypt($pass, '$6$'.$salt.'$');
    #say "D:salt=$salt, crypt=$crypt";
    return $crypt if (crypt_type($crypt)//"") eq 'SSHA512';

    # fallback to MD5-CRYPT if failed
    $salt = substr($salt, 0, 8);
    $crypt = CORE::crypt($pass, '$1$'.$salt.'$');
    return $crypt if (crypt_type($crypt)//"") eq 'MD5-CRYPT';

    # fallback to CRYPT if failed
    $salt = substr($salt, 0, 2);
    CORE::crypt($pass, $salt);
}

1;
# ABSTRACT: Crypt password utilities

__END__