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; |