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


line stmt bran cond sub pod time code
1             package Crypt::Password::Util;
2              
3             our $DATE = '2016-01-20'; # DATE
4             our $VERSION = '0.15'; # VERSION
5              
6 1     1   752 use 5.010001;
  1         2  
7 1     1   5 use strict;
  1         1  
  1         20  
8 1     1   4 use warnings;
  1         2  
  1         23  
9              
10 1     1   4 use Exporter;
  1         1  
  1         340  
11             our @ISA = qw(Exporter);
12             our @EXPORT_OK = qw(crypt_type looks_like_crypt crypt);
13              
14             my $b64d = qr![A-Za-z0-9./]!;
15             my $hexd = qr![0-9a-f]!;
16              
17             our %CRYPT_TYPES = (
18             'MD5-CRYPT' => {
19             summary => 'A baroque passphrase scheme based on MD5, designed by Poul-Henning Kamp and originally implemented in FreeBSD',
20             re => qr/\A
21             (?P
\$ (?:apr)?1 \$)
22             (?P$b64d {0,8}) \$
23             (?P$b64d {22}) \z/x,
24             re_summary => '$1$ or $apr1$ header',
25             link => 'http://static.usenix.org/event/usenix99/provos/provos_html/node10.html',
26             },
27             CRYPT => {
28             summary => 'Traditional DES crypt',
29             re => qr/\A
30             (?P$b64d {2} | \$\$) # $$ is not accepted as salt, but we see crypts using those in the wild
31             (?P$b64d {11}) \z/x,
32             re_summary => '11 digit base64 characters',
33             link => 'http://perldoc.perl.org/functions/crypt.html',
34             },
35             'EXT-DES' => {
36             summary => 'Extended DES crypt',
37             re => qr/\A
38             (?P_ $b64d {8} )
39             (?P$b64d {11}) \z/x,
40             re_summary => 'underscore followed by 19 digit base64 characters',
41             link => 'https://en.wikipedia.org/wiki/Crypt_%28C%29#BSDi_extended_DES-based_scheme',
42             },
43             SSHA256 => {
44             summary => 'Salted SHA256, supported by glibc 2.7+',
45             re => qr/\A
46             (?P
\$ 5 \$)
47             (?P (?:rounds=[1-9][0-9]{3,8}\$)? $b64d {0,16}) \$
48             (?P$b64d {43}) \z/x,
49             re_summary => '$5$ header',
50             link => 'http://en.wikipedia.org/wiki/SHA-2',
51             },
52             SSHA512 => {
53             summary => 'Salted SHA512, supported by glibc 2.7+',
54             re => qr/\A
55             (?P
\$ 6 \$)
56             (?P (?:rounds=[1-9][0-9]{3,8}\$)? $b64d {0,16}) \$
57             (?P$b64d {86}) \z/x,
58             re_summary => '$6$ header',
59             link => 'http://en.wikipedia.org/wiki/SHA-2',
60             },
61             BCRYPT => {
62             summary => 'Passphrase scheme based on Blowfish, designed by Niels Provos and David Mazieres for OpenBSD',
63             re => qr/\A
64             (?P
\$ 2a? \$)
65             (?P\d+) \$
66             (?P$b64d {22})
67             (?P$b64d {31}) \z/x,
68             re_summary => '$2$ or $2a$ header followed by cost, followed by 22 base64-digits salt and 31 digits hash',
69             link => 'https://www.usenix.org/legacy/event/usenix99/provos/provos_html/',
70             },
71             'PLAIN-MD5' => {
72             summary => 'Unsalted MD5 hash, popular with PHP web applications',
73             re => qr/\A (?P$hexd {32}) \z/x,
74             re_summary => '32 digits of hex characters',
75             link => 'http://en.wikipedia.org/wiki/MD5',
76             },
77             );
78              
79             sub crypt_type {
80 27     27 1 55 my $crypt = shift;
81 27         34 my $detail = shift;
82              
83 27         86 for my $type (keys %CRYPT_TYPES) {
84 112 100       539 if ($crypt =~ $CRYPT_TYPES{$type}{re}) {
85 24 100       50 if ($detail) {
86 1     1   776 my $res = {%+};
  1         441  
  1         334  
  9         139  
87 9         31 $res->{type} = $type;
88 9         68 return $res;
89             } else {
90 15         93 return $type;
91             }
92             }
93             }
94 3         19 return undef;
95             }
96              
97 2     2 1 7 sub looks_like_crypt { !!crypt_type($_[0]) }
98              
99             sub crypt {
100 2     2 1 1214 require UUID::Random::Patch::UseMRS;
101 2         5474999 require Digest::MD5;
102              
103 2         7 my $pass = shift;
104 2         3 my ($salt, $crypt);
105              
106             # first use SSHA512
107 2         8 $salt = substr(Digest::MD5::md5_base64(UUID::Random::generate()), 0, 16);
108 2         42261 $salt =~ tr/\+/./;
109 2         12908 $crypt = CORE::crypt($pass, '$6$'.$salt.'$');
110             #say "D:salt=$salt, crypt=$crypt";
111 2 50 50     9 return $crypt if (crypt_type($crypt)//"") eq 'SSHA512';
112              
113             # fallback to MD5-CRYPT if failed
114 0           $salt = substr($salt, 0, 8);
115 0           $crypt = CORE::crypt($pass, '$1$'.$salt.'$');
116 0 0 0       return $crypt if (crypt_type($crypt)//"") eq 'MD5-CRYPT';
117              
118             # fallback to CRYPT if failed
119 0           $salt = substr($salt, 0, 2);
120 0           CORE::crypt($pass, $salt);
121             }
122              
123             1;
124             # ABSTRACT: Crypt password utilities
125              
126             __END__