File Coverage

blib/lib/Authen/Passphrase/SaltedDigest.pm
Criterion Covered Total %
statement 115 120 95.8
branch 49 82 59.7
condition 5 15 33.3
subroutine 21 21 100.0
pod 9 9 100.0
total 199 247 80.5


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Authen::Passphrase::SaltedDigest - passphrases using the generic salted
4             digest algorithm
5              
6             =head1 SYNOPSIS
7              
8             use Authen::Passphrase::SaltedDigest;
9              
10             $ppr = Authen::Passphrase::SaltedDigest->new(
11             algorithm => "SHA-1",
12             salt_hex => "a9f524b1e819e96d8cc7".
13             "a04d5471e8b10c84e596",
14             hash_hex => "8270d9d1a345d3806ab2".
15             "3b0385702e10f1acc943");
16              
17             $ppr = Authen::Passphrase::SaltedDigest->new(
18             algorithm => "SHA-1", salt_random => 20,
19             passphrase => "passphrase");
20              
21             $ppr = Authen::Passphrase::SaltedDigest->from_rfc2307(
22             "{SSHA}gnDZ0aNF04BqsjsDhXAuEPGsy".
23             "UOp9SSx6BnpbYzHoE1UceixDITllg==");
24              
25             $algorithm = $ppr->algorithm;
26             $salt = $ppr->salt;
27             $salt_hex = $ppr->salt_hex;
28             $hash = $ppr->hash;
29             $hash_hex = $ppr->hash_hex;
30              
31             if($ppr->match($passphrase)) { ...
32              
33             $userPassword = $ppr->as_rfc2307;
34              
35             =head1 DESCRIPTION
36              
37             An object of this class encapsulates a passphrase hashed using
38             a generic digest-algorithm-based scheme. This is a subclass of
39             L, and this document assumes that the reader is
40             familiar with the documentation for that class.
41              
42             The salt is an arbitrary string of bytes. It is appended to passphrase,
43             and the combined string is passed through a specified message digest
44             algorithm. The output of the message digest algorithm is the passphrase
45             hash.
46              
47             The strength depends entirely on the choice of digest algorithm, so
48             choose according to the level of security required. SHA-1 is suitable for
49             most applications, but recent work has revealed weaknesses in the basic
50             structure of MD5, SHA-1, SHA-256, and all similar digest algorithms.
51             A new generation of digest algorithms emerged in 2008, centred around
52             NIST's competition to design SHA-3. Once these algorithms have been
53             subjected to sufficient cryptanalysis, the survivors will be preferred
54             over SHA-1 and its generation.
55              
56             Digest algorithms are generally designed to be as efficient to compute
57             as possible for their level of cryptographic strength. An unbroken
58             digest algorithm makes brute force the most efficient way to attack it,
59             but makes no effort to resist a brute force attack. This is a concern
60             in some passphrase-using applications.
61              
62             The use of this kind of passphrase scheme is generally recommended for
63             new systems. Choice of digest algorithm is important: SHA-1 is suitable
64             for most applications. If efficiency of brute force attack is a concern,
65             see L for an algorithm designed to
66             be expensive to compute.
67              
68             =cut
69              
70             package Authen::Passphrase::SaltedDigest;
71              
72 2     2   78605 { use 5.006; }
  2         9  
  2         128  
73 2     2   12 use warnings;
  2         3  
  2         80  
74 2     2   9 use strict;
  2         6  
  2         71  
75              
76 2     2   20929 use Authen::Passphrase 0.003;
  2         47  
  2         69  
77 2     2   20 use Carp qw(croak);
  2         5  
  2         137  
78 2     2   2130 use Data::Entropy::Algorithms 0.000 qw(rand_bits);
  2         41719  
  2         162  
79 2     2   5725 use Digest 1.00;
  2         1390  
  2         90  
80 2     2   15 use MIME::Base64 2.21 qw(encode_base64 decode_base64);
  2         34  
  2         145  
81 2     2   13 use Module::Runtime 0.011 qw(is_valid_module_name use_module);
  2         40  
  2         20  
82 2     2   119 use Params::Classify 0.000 qw(is_string is_blessed);
  2         36  
  2         141  
83              
84             our $VERSION = "0.008";
85              
86 2     2   12 use parent "Authen::Passphrase";
  2         5  
  2         15  
87              
88             =head1 CONSTRUCTORS
89              
90             =over
91              
92             =item Authen::Passphrase::SaltedDigest->new(ATTR => VALUE, ...)
93              
94             Generates a new passphrase recogniser object using the generic salted
95             digest algorithm. The following attributes may be given:
96              
97             =over
98              
99             =item B
100              
101             Specifies the algorithm to use. If it is a reference to a blessed object,
102             it must be possible to call the L method on that object to generate
103             a digest context object.
104              
105             If it is a string containing the subsequence "::" then it specifies
106             a module to use. A plain package name in bareword syntax, optionally
107             preceded by "::" (so that top-level packages can be recognised as such),
108             is taken as a class name, on which the L method will be called to
109             generate a digest context object. The package name may optionally be
110             followed by "-" to cause automatic loading of the module, and the "-"
111             (if present) may optionally be followed by a version number that will
112             be checked against. For example, "Digest::MD5-1.99_53" would load the
113             L module and check that it is at least version 1.99_53
114             (which is the first version that can be used by this module).
115              
116             A string not containing "::" and which is understood by
117             L<< Digest->new|Digest/"OO INTERFACE" >> will be passed to that function
118             to generate a digest context object.
119              
120             Any other type of algorithm specifier has undefined behaviour.
121              
122             The digest context objects must support at least the standard C
123             and C methods.
124              
125             =item B
126              
127             The salt, as a raw string of bytes. Defaults to the empty string,
128             yielding an unsalted scheme.
129              
130             =item B
131              
132             The salt, as a string of hexadecimal digits. Defaults to the empty
133             string, yielding an unsalted scheme.
134              
135             =item B
136              
137             Causes salt to be generated randomly. The value given for this
138             attribute must be a non-negative integer, giving the number of bytes
139             of salt to generate. (The same length as the hash is recommended.)
140             The source of randomness may be controlled by the facility described
141             in L.
142              
143             =item B
144              
145             The hash, as a string of bytes.
146              
147             =item B
148              
149             The hash, as a string of hexadecimal digits.
150              
151             =item B
152              
153             A passphrase that will be accepted.
154              
155             =back
156              
157             The digest algorithm must be given, and either the hash or the passphrase.
158              
159             =cut
160              
161             sub new {
162 14     14 1 30 my $class = shift;
163 14         54 my $self = bless({}, $class);
164 14         18 my $passphrase;
165 14         52 while(@_) {
166 42         8608 my $attr = shift;
167 42         98 my $value = shift;
168 42 100       199 if($attr eq "algorithm") {
    100          
    100          
    100          
    100          
    100          
    50          
169 14 50       52 croak "algorithm specified redundantly"
170             if exists $self->{algorithm};
171 14         57 $self->{algorithm} = $value;
172             } elsif($attr eq "salt") {
173 7 50       22 croak "salt specified redundantly"
174             if exists $self->{salt};
175 7 50       31 $value =~ m#\A[\x00-\xff]*\z#
176             or croak "\"$value\" is not a valid salt";
177 7         30 $self->{salt} = "$value";
178             } elsif($attr eq "salt_hex") {
179 6 50       19 croak "salt specified redundantly"
180             if exists $self->{salt};
181 6 50       41 $value =~ m#\A(?:[0-9A-Fa-f]{2})+\z#
182             or croak "\"$value\" is not a valid salt";
183 6         30 $self->{salt} = pack("H*", $value);
184             } elsif($attr eq "salt_random") {
185 1 50       7 croak "salt specified redundantly"
186             if exists $self->{salt};
187 1 50 33     10 croak "\"$value\" is not a valid salt length"
188             unless $value == int($value) && $value >= 0;
189 1         9 $self->{salt} = rand_bits($value * 8);
190             } elsif($attr eq "hash") {
191 6 50 33     42 croak "hash specified redundantly"
192             if exists($self->{hash}) ||
193             defined($passphrase);
194 6 50       27 $value =~ m#\A[\x00-\xff]*\z#
195             or croak "\"$value\" is not a valid hash";
196 6         27 $self->{hash} = "$value";
197             } elsif($attr eq "hash_hex") {
198 6 50 33     48 croak "hash specified redundantly"
199             if exists($self->{hash}) ||
200             defined($passphrase);
201 6 50       39 $value =~ m#\A(?:[0-9A-Fa-f]{2})+\z#
202             or croak "\"$value\" is not a valid hash";
203 6         35 $self->{hash} = pack("H*", $value);
204             } elsif($attr eq "passphrase") {
205 2 50 33     19 croak "passphrase specified redundantly"
206             if exists($self->{hash}) ||
207             defined($passphrase);
208 2         9 $passphrase = $value;
209             } else {
210 0         0 croak "unrecognised attribute `$attr'";
211             }
212             }
213 14 50       45 croak "algorithm not specified" unless exists $self->{algorithm};
214 14 50       57 $self->{salt} = "" unless exists $self->{salt};
215 14 100       58 if(defined $passphrase) {
    50          
216 2         9 $self->{hash} = $self->_hash_of($passphrase);
217             } elsif(exists $self->{hash}) {
218 12 50       49 croak "not a valid ".$self->{algorithm}." hash"
219             unless length($self->{hash}) ==
220             length($self->_hash_of(""));
221             } else {
222 0         0 croak "hash not specified";
223             }
224 14         140 return $self;
225             }
226              
227             =item Authen::Passphrase::SaltedDigest->from_rfc2307(USERPASSWORD)
228              
229             Generates a salted-digest passphrase recogniser from the supplied
230             RFC2307 encoding. The scheme identifier gives the digest algorithm and
231             controls whether salt is permitted. It is followed by a base 64 string,
232             using standard MIME base 64, which encodes the concatenation of the hash
233             and salt.
234              
235             The scheme identifiers accepted are "B<{MD4}>" (unsalted MD4), "B<{MD5}>"
236             (unsalted MD5), "B<{RMD160}>" (unsalted RIPEMD-160), "B<{SHA}>" (unsalted
237             SHA-1), "B<{SMD5}>" (salted MD5), and "B<{SSHA}>" (salted SHA-1).
238             All scheme identifiers are recognised case-insensitively.
239              
240             =cut
241              
242             my %rfc2307_scheme_meaning = (
243             "MD4" => ["MD4", 16, 0],
244             "MD5" => ["MD5", 16, 0],
245             "RMD160" => ["Crypt::RIPEMD160-", 20, 0],
246             "SHA" => ["SHA-1", 20, 0],
247             "SMD5" => ["MD5", 16, 1],
248             "SSHA" => ["SHA-1", 20, 1],
249             );
250              
251             sub from_rfc2307 {
252 2     2 1 30 my($class, $userpassword) = @_;
253 2 50       32 return $class->SUPER::from_rfc2307($userpassword)
254             unless $userpassword =~ /\A\{([-0-9A-Za-z]+)\}/;
255 2         11 my $scheme = uc($1);
256 2         8 my $meaning = $rfc2307_scheme_meaning{$scheme};
257 2 50       9 return $class->SUPER::from_rfc2307($userpassword)
258             unless defined $meaning;
259 2 50       29 croak "malformed {$scheme} data"
260             unless $userpassword =~
261             m#\A\{.*?\}
262             ((?>(?:[A-Za-z0-9+/]{4})*)
263             (?:|[A-Za-z0-9+/]{2}[AEIMQUYcgkosw048]=|
264             [A-Za-z0-9+/][AQgw]==))\z#x;
265 2         9 my $b64 = $1;
266 2         29 my $hash_and_salt = decode_base64($b64);
267 2         9 my($algorithm, $hash_len, $salt_allowed) = @$meaning;
268 2 50       8 croak "insufficient hash data for {$scheme}"
269             if length($hash_and_salt) < $hash_len;
270 2 50 33     10 croak "too much hash data for {$scheme}"
271             if !$salt_allowed && length($hash_and_salt) > $hash_len;
272 2         17 return $class->new(algorithm => $algorithm,
273             salt => substr($hash_and_salt, $hash_len),
274             hash => substr($hash_and_salt, 0, $hash_len));
275             }
276              
277             =back
278              
279             =head1 METHODS
280              
281             =over
282              
283             =item $ppr->algorithm
284              
285             Returns the digest algorithm, in the same form as supplied to the
286             constructor.
287              
288             =cut
289              
290             sub algorithm {
291 2     2 1 1077 my($self) = @_;
292 2         14 return $self->{algorithm};
293             }
294              
295             =item $ppr->salt
296              
297             Returns the salt, in raw form.
298              
299             =cut
300              
301             sub salt {
302 12     12 1 1221 my($self) = @_;
303 12         132 return $self->{salt};
304             }
305              
306             =item $ppr->salt_hex
307              
308             Returns the salt, as a string of hexadecimal digits.
309              
310             =cut
311              
312             sub salt_hex {
313 13     13 1 3907 my($self) = @_;
314 13         85 return unpack("H*", $self->{salt});
315             }
316              
317             =item $ppr->hash
318              
319             Returns the hash value, in raw form.
320              
321             =cut
322              
323             sub hash {
324 12     12 1 25 my($self) = @_;
325 12         51 return $self->{hash};
326             }
327              
328             =item $ppr->hash_hex
329              
330             Returns the hash value, as a string of hexadecimal digits.
331              
332             =cut
333              
334             sub hash_hex {
335 13     13 1 28 my($self) = @_;
336 13         76 return unpack("H*", $self->{hash});
337             }
338              
339             =item $ppr->match(PASSPHRASE)
340              
341             =item $ppr->as_rfc2307
342              
343             These methods are part of the standard L interface.
344             Only passphrase recognisers using certain well-known digest algorithms
345             can be represented in RFC 2307 form.
346              
347             =cut
348              
349             sub _hash_of {
350 65     65   93 my($self, $passphrase) = @_;
351 65         148 my $alg = $self->{algorithm};
352 65         68 my $ctx;
353 65 50       163 if(is_string($alg)) {
    0          
354 65 100       156 if($alg =~ /::/) {
355 1 50       13 $alg =~ /\A(?:::)?([0-9a-zA-Z_:]+)
356             (-([0-9][0-9_]*(?:\._*[0-9][0-9_]*)?)?)?\z/x
357             or croak "module spec `$alg' not understood";
358 1         5 my($pkgname, $load_p, $modver) = ($1, $2, $3);
359 1 50       8 croak "bad package name `$pkgname'"
360             unless is_valid_module_name($pkgname);
361 1 50       59 if($load_p) {
362 1 50       4 if(defined $modver) {
363 1         4 $modver =~ tr/_//d;
364 1         6 use_module($pkgname, $modver);
365             } else {
366 0         0 use_module($pkgname);
367             }
368             }
369 1         61 $ctx = $pkgname->new;
370             } else {
371 64         265 $ctx = Digest->new($alg);
372             }
373             } elsif(is_blessed($alg)) {
374 0         0 $ctx = $alg->new;
375             } else {
376 0         0 croak "algorithm specifier `$alg' is of an unrecognised type";
377             }
378 65         7985 $ctx->add($passphrase);
379 65         182 $ctx->add($self->{salt});
380 65         523 return $ctx->digest;
381             }
382              
383             sub match {
384 51     51 1 27631 my($self, $passphrase) = @_;
385 51         113 return $self->_hash_of($passphrase) eq $self->{hash};
386             }
387              
388             my %rfc2307_scheme_for_digest_name = (
389             "MD4" => "MD4",
390             "MD5" => "MD5",
391             "SHA-1" => "SHA",
392             "SHA1" => "SHA",
393             );
394              
395             my %rfc2307_scheme_for_package_name = (
396             "Crypt::RIPEMD160" => "RMD160",
397             "Digest::MD4" => "MD4",
398             "Digest::MD5" => "MD5",
399             "Digest::MD5::Perl" => "MD5",
400             "Digest::Perl::MD4" => "MD4",
401             "Digest::SHA" => "SHA",
402             "Digest::SHA::PurePerl" => "SHA",
403             "Digest::SHA1" => "SHA",
404             "MD5" => "MD5",
405             "RIPEMD160" => "RMD160",
406             );
407              
408             sub as_rfc2307 {
409 12     12 1 27 my($self) = @_;
410 12         33 my $alg = $self->{algorithm};
411 12         16 my $scheme;
412 12 50       50 if(is_string($alg)) {
413 12 100       77 if($alg =~ /::/) {
414 1 50       10 $scheme = $rfc2307_scheme_for_package_name{$1}
415             if $alg =~ /\A(?:::)?
416             ([0-9a-zA-Z_:]+)(?:-[0-9._]*)?\z/x;
417             } else {
418 11         33 $scheme = $rfc2307_scheme_for_digest_name{$alg};
419             }
420             }
421 12 50       40 croak "don't know RFC 2307 scheme identifier for digest algorithm $alg"
422             unless defined $scheme;
423 12 50       163 return "{".($self->{salt} eq "" ? "" : "S").$scheme."}".
424             encode_base64($self->{hash}.$self->{salt}, "");
425             }
426              
427             =back
428              
429             =head1 SEE ALSO
430              
431             L,
432             L
433              
434             =head1 AUTHOR
435              
436             Andrew Main (Zefram)
437              
438             =head1 COPYRIGHT
439              
440             Copyright (C) 2006, 2007, 2009, 2010, 2012
441             Andrew Main (Zefram)
442              
443             =head1 LICENSE
444              
445             This module is free software; you can redistribute it and/or modify it
446             under the same terms as Perl itself.
447              
448             =cut
449              
450             1;