File Coverage

blib/lib/Authen/Passphrase/PHPass.pm
Criterion Covered Total %
statement 106 108 98.1
branch 33 52 63.4
condition 11 21 52.3
subroutine 20 20 100.0
pod 9 9 100.0
total 179 210 85.2


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Authen::Passphrase::PHPass - passphrases using the phpass algorithm
4              
5             =head1 SYNOPSIS
6              
7             use Authen::Passphrase::PHPass;
8              
9             $ppr = Authen::Passphrase::PHPass->new(
10             cost => 10, salt => "NaClNaCl",
11             hash_base64 => "ObRxTm/.EiiYN02xUeAQs/");
12              
13             $ppr = Authen::Passphrase::PHPass->new(
14             cost => 10, salt_random => 1,
15             passphrase => "passphrase");
16              
17             $ppr = Authen::Passphrase::PHPass->from_crypt(
18             '$P$8NaClNaClObRxTm/.EiiYN02xUeAQs/');
19              
20             $ppr = Authen::Passphrase::PHPass->from_rfc2307(
21             '{CRYPT}$P$8NaClNaClObRxTm/.EiiYN02xUeAQs/');
22              
23             $cost = $ppr->cost;
24             $cost_base64 = $ppr->cost_base64;
25             $cost = $ppr->nrounds_log2;
26             $cost_base64 = $ppr->nrounds_log2_base64;
27             $salt = $ppr->salt;
28             $hash = $ppr->hash;
29             $hash_base64 = $ppr->hash_base64;
30              
31             if($ppr->match($passphrase)) { ...
32              
33             $passwd = $ppr->as_crypt;
34             $userPassword = $ppr->as_rfc2307;
35              
36             =head1 DESCRIPTION
37              
38             An object of this class encapsulates a passphrase hashed using
39             the phpass algorithm invented by Solar Designer and described
40             at L. This is a subclass of
41             L, and this document assumes that the reader is
42             familiar with the documentation for that class.
43              
44             The phpass algorithm is based on the MD5 message digest algorithm.
45             There is an eight-byte salt, which is conventionally restricted to
46             consist of base 64 digits. There is also a cost parameter that controls
47             the expense of hashing. First the salt and passphrase are concatenated
48             and hashed by MD5. Then, 2^cost times, the hash from the previous stage
49             is concatenated with the passphrase and hashed by MD5. The passphrase
50             hash is the output from the final iteration.
51              
52             The passphrase hash is represented in ASCII using the crypt format with
53             prefix "B<$P$>". The first character after the format prefix is a base 64
54             digit giving the cost parameter. The next eight characters are the salt.
55             The salt is followed by 22 base 64 digits giving the hash. The base 64
56             digits are "B<.>", "B", "B<0>" to "B<9>", "B" to "B", "B"
57             to "B" (in ASCII order).
58              
59             =cut
60              
61             package Authen::Passphrase::PHPass;
62              
63 1     1   25700 { use 5.006; }
  1         4  
  1         46  
64 1     1   5 use warnings;
  1         3  
  1         40  
65 1     1   5 use strict;
  1         2  
  1         40  
66              
67 1     1   772 use Authen::Passphrase 0.003;
  1         22  
  1         31  
68 1     1   7 use Carp qw(croak);
  1         2  
  1         60  
69 1     1   1049 use Data::Entropy::Algorithms 0.000 qw(rand_bits);
  1         19496  
  1         82  
70 1     1   10 use Digest::MD5 1.99_53 ();
  1         21  
  1         34  
71              
72             our $VERSION = "0.008";
73              
74 1     1   5 use parent "Authen::Passphrase";
  1         2  
  1         5  
75              
76             my $base64_digits = "./0123456789ABCDEFGHIJKLMNOPQRST".
77             "UVWXYZabcdefghijklmnopqrstuvwxyz";
78              
79             sub _en_base64($) {
80 21     21   7351 my($bytes) = @_;
81 21         28 my $nbytes = length($bytes);
82 21         46 my $npadbytes = 2 - ($nbytes + 2) % 3;
83 21         40 $bytes .= "\0" x $npadbytes;
84 21         23 my $digits = "";
85 21         55 for(my $i = 0; $i < $nbytes; $i += 3) {
86 122         219 my $v = ord(substr($bytes, $i, 1)) |
87             (ord(substr($bytes, $i+1, 1)) << 8) |
88             (ord(substr($bytes, $i+2, 1)) << 16);
89 122         419 $digits .= substr($base64_digits, $v & 0x3f, 1) .
90             substr($base64_digits, ($v >> 6) & 0x3f, 1) .
91             substr($base64_digits, ($v >> 12) & 0x3f, 1) .
92             substr($base64_digits, ($v >> 18) & 0x3f, 1);
93             }
94 21         44 substr $digits, -$npadbytes, $npadbytes, "";
95 21         93 return $digits;
96             }
97              
98             sub _de_base64($) {
99 8     8   11 my($digits) = @_;
100 8         13 my $ndigits = length($digits);
101 8         14 my $npadbytes = 3 - ($ndigits + 3) % 4;
102 8         14 $digits .= "." x $npadbytes;
103 8         17 my $bytes = "";
104 8         19 for(my $i = 0; $i < $ndigits; $i += 4) {
105 48         121 my $v = index($base64_digits, substr($digits,$i,1)) |
106             (index($base64_digits, substr($digits,$i+1,1)) << 6) |
107             (index($base64_digits, substr($digits,$i+2,1)) << 12) |
108             (index($base64_digits, substr($digits,$i+3,1)) << 18);
109 48         128 $bytes .= chr($v & 0xff) .
110             chr(($v >> 8) & 0xff) .
111             chr(($v >> 16) & 0xff);
112             }
113 8         13 substr $bytes, -$npadbytes, $npadbytes, "";
114 8         34 return $bytes;
115             }
116              
117             =head1 CONSTRUCTORS
118              
119             =over
120              
121             =item Authen::Passphrase::PHPass->new(ATTR => VALUE, ...)
122              
123             Generates a new passphrase recogniser object using the phpass algorithm.
124             The following attributes may be given:
125              
126             =over
127              
128             =item B
129              
130             Base-two logarithm of the number of hashing rounds to perform.
131              
132             =item B
133              
134             Base-two logarithm of the number of hashing rounds to perform, expressed
135             as a single base 64 digit.
136              
137             =item B
138              
139             Synonym for B.
140              
141             =item B
142              
143             Synonym for B.
144              
145             =item B
146              
147             The salt, as an eight-byte string.
148              
149             =item B
150              
151             Causes salt to be generated randomly. The value given for this
152             attribute is ignored. The salt will be a string of eight base 64 digits.
153             The source of randomness may be controlled by the facility described
154             in L.
155              
156             =item B
157              
158             The hash, as a 16-byte string.
159              
160             =item B
161              
162             The hash, as a string of 22 base 64 digits.
163              
164             =item B
165              
166             A passphrase that will be accepted.
167              
168             =back
169              
170             The cost and salt must be given, and either the hash or the passphrase.
171              
172             =cut
173              
174             sub new {
175 11     11 1 35 my $class = shift;
176 11         40 my $self = bless({}, $class);
177 11         18 my $passphrase;
178 11         35 while(@_) {
179 33         42 my $attr = shift;
180 33         61 my $value = shift;
181 33 100 100     287 if($attr eq "cost" || $attr eq "nrounds_log2") {
    100 100        
    100          
    100          
    100          
    100          
    50          
182 2 50       15 croak "cost specified redundantly"
183             if exists $self->{cost};
184 2 50 33     20 croak "\"$value\" is not a valid cost parameter"
      33        
185             unless $value == int($value) && $value >= 0 &&
186             $value <= 30;
187 2         9 $self->{cost} = 0+$value;
188             } elsif($attr eq "cost_base64" ||
189             $attr eq "nrounds_log2_base64") {
190 9 50       23 croak "cost specified redundantly"
191             if exists $self->{cost};
192 9 50       31 croak "\"$value\" is not a valid cost parameter"
193             unless $value =~ m#\A[./0-9A-S]\z#;
194 9         41 $self->{cost} = index($base64_digits, $value);
195             } elsif($attr eq "salt") {
196 10 50       27 croak "salt specified redundantly"
197             if exists $self->{salt};
198 10 50       40 $value =~ m#\A[\x00-\xff]{8}\z#
199             or croak "\"$value\" is not a valid salt";
200 10         33 $self->{salt} = "$value";
201             } elsif($attr eq "salt_random") {
202 1 50       4 croak "salt specified redundantly"
203             if exists $self->{salt};
204 1         8 $self->{salt} = _en_base64(rand_bits(48));
205             } elsif($attr eq "hash") {
206 1 50 33     8 croak "hash specified redundantly"
207             if exists($self->{hash}) ||
208             defined($passphrase);
209 1 50       32 $value =~ m#\A[\x00-\xff]{16}\z#
210             or croak "not a valid raw hash";
211 1         5 $self->{hash} = "$value";
212             } elsif($attr eq "hash_base64") {
213 8 50 33     38 croak "hash specified redundantly"
214             if exists($self->{hash}) ||
215             defined($passphrase);
216 8 50       28 $value =~ m#\A[./0-9A-Za-z]{21}[./01]\z#
217             or croak "\"$value\" is not a valid hash";
218 8         19 $self->{hash} = _de_base64($value);
219             } elsif($attr eq "passphrase") {
220 2 50 33     14 croak "passphrase specified redundantly"
221             if exists($self->{hash}) ||
222             defined($passphrase);
223 2         6 $passphrase = $value;
224             } else {
225 0         0 croak "unrecognised attribute `$attr'";
226             }
227             }
228 11 50       29 croak "cost not specified" unless exists $self->{cost};
229 11 50       30 croak "salt not specified" unless exists $self->{salt};
230 11 100       27 $self->{hash} = $self->_hash_of($passphrase) if defined $passphrase;
231 11 50       28 croak "hash not specified" unless exists $self->{hash};
232 11         31 return $self;
233             }
234              
235             =item Authen::Passphrase::PHPass->from_crypt(PASSWD)
236              
237             Generates a new phpass passphrase recogniser object from a crypt string.
238             The crypt string must consist of "B<$P$>", one base 64 character encoding
239             the cost, the salt, then 22 base 64 digits giving the hash. The salt
240             must be exactly 8 characters long, and cannot contain any character that
241             cannot appear in a crypt string.
242              
243             =cut
244              
245             sub from_crypt {
246 2     2 1 4 my($class, $passwd) = @_;
247 2 50       13 if($passwd =~ /\A\$P\$/) {
248 2 50       9 $passwd =~ m#\A\$P\$([./0-9A-Za-z])([!-9;-~]{8})
249             ([./0-9A-Za-z]{22})\z#x
250             or croak "malformed \$P\$ data";
251 2         7 my($cost, $salt, $hash) = ($1, $2, $3);
252 2         10 return $class->new(cost_base64 => $cost, salt => $salt,
253             hash_base64 => $hash);
254             }
255 0         0 return $class->SUPER::from_crypt($passwd);
256             }
257              
258             =item Authen::Passphrase::PHPass->from_rfc2307(USERPASSWORD)
259              
260             Generates a new phpass passphrase recogniser object from an RFC 2307
261             string. The string must consist of "B<{CRYPT}>" (case insensitive)
262             followed by an acceptable crypt string.
263              
264             =back
265              
266             =head1 METHODS
267              
268             =over
269              
270             =item $ppr->cost
271              
272             Returns the base-two logarithm of the number of hashing rounds that will
273             be performed.
274              
275             =cut
276              
277             sub cost {
278 10     10 1 1713 my($self) = @_;
279 10         58 return $self->{cost};
280             }
281              
282             =item $ppr->cost_base64
283              
284             Returns the base-two logarithm of the number of hashing rounds that will
285             be performed, expressed as a single base 64 digit.
286              
287             =cut
288              
289             sub cost_base64 {
290 23     23 1 1399 my($self) = @_;
291 23         97 return substr($base64_digits, $self->{cost}, 1);
292             }
293              
294             =item $ppr->nrounds_log2
295              
296             Synonym for L.
297              
298             =cut
299              
300             *nrounds_log2 = \&cost;
301              
302             =item $ppr->nrounds_log2_base64
303              
304             Synonym for L.
305              
306             =cut
307              
308             *nrounds_log2_base64 = \&cost_base64;
309              
310             =item $ppr->salt
311              
312             Returns the salt, as a string of eight bytes.
313              
314             =cut
315              
316             sub salt {
317 11     11 1 17 my($self) = @_;
318 11         45 return $self->{salt};
319             }
320              
321             =item $ppr->hash
322              
323             Returns the hash value, as a string of 16 bytes.
324              
325             =cut
326              
327             sub hash {
328 3     3 1 6 my($self) = @_;
329 3         14 return $self->{hash};
330             }
331              
332             =item $ppr->hash_base64
333              
334             Returns the hash value, as a string of 22 base 64 digits.
335              
336             =cut
337              
338             sub hash_base64 {
339 20     20 1 29 my($self) = @_;
340 20         50 return _en_base64($self->{hash});
341             }
342              
343             =item $ppr->match(PASSPHRASE)
344              
345             =item $ppr->as_crypt
346              
347             =item $ppr->as_rfc2307
348              
349             These methods are part of the standard L interface.
350              
351             =cut
352              
353             sub _hash_of {
354 28     28   50 my($self, $passphrase) = @_;
355 28         159 my $ctx = Digest::MD5->new;
356 28         118 $ctx->add($self->{salt});
357 28         70 $ctx->add($passphrase);
358 28         92 my $hash = $ctx->digest;
359 28         107 for(my $i = 1 << $self->{cost}; $i--; ) {
360 20128         66574 $ctx = Digest::MD5->new;
361 20128         76545 $ctx->add($hash);
362 20128         34716 $ctx->add($passphrase);
363 20128         76294 $hash = $ctx->digest;
364             }
365 28         341 return $hash;
366             }
367              
368             sub match {
369 26     26 1 11339 my($self, $passphrase) = @_;
370 26         84 return $self->_hash_of($passphrase) eq $self->{hash};
371             }
372              
373             sub as_crypt {
374 10     10 1 15 my($self) = @_;
375 10 50       36 croak "can't put this salt into a crypt string"
376             if $self->{salt} =~ /[^!-9;-~]/;
377 10         16 return "\$P\$".$self->cost_base64.$self->{salt}.$self->hash_base64;
378             }
379              
380             =back
381              
382             =head1 SEE ALSO
383              
384             L,
385             L
386              
387             =head1 AUTHOR
388              
389             Andrew Main (Zefram)
390              
391             =head1 COPYRIGHT
392              
393             Copyright (C) 2006, 2007, 2009, 2010, 2012
394             Andrew Main (Zefram)
395              
396             =head1 LICENSE
397              
398             This module is free software; you can redistribute it and/or modify it
399             under the same terms as Perl itself.
400              
401             =cut
402              
403             1;