line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
=head1 NAME |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
Authen::Passphrase::VMSPurdy - passphrases with the VMS Purdy polynomial |
4
|
|
|
|
|
|
|
system |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 SYNOPSIS |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
use Authen::Passphrase::VMSPurdy; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
$ppr = Authen::Passphrase::VMSPurdy->new( |
11
|
|
|
|
|
|
|
username => "jrandom", salt => 25362, |
12
|
|
|
|
|
|
|
hash_hex => "832a0c270179584a"); |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
$ppr = Authen::Passphrase::VMSPurdy->new( |
15
|
|
|
|
|
|
|
username => "jrandom", salt_random => 1, |
16
|
|
|
|
|
|
|
passphrase => "passphrase"); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
$ppr = Authen::Passphrase::VMSPurdy->from_crypt( |
19
|
|
|
|
|
|
|
'$VMS3$1263832A0C270179584AJRANDOM'); |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
$ppr = Authen::Passphrase::VMSPurdy->from_rfc2307( |
22
|
|
|
|
|
|
|
'{CRYPT}$VMS3$1263832A0C270179584AJRANDOM'); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
$algorithm = $ppr->algorithm; |
25
|
|
|
|
|
|
|
$username = $ppr->username; |
26
|
|
|
|
|
|
|
$salt = $ppr->salt; |
27
|
|
|
|
|
|
|
$hash = $ppr->hash; |
28
|
|
|
|
|
|
|
$hash_hex = $ppr->hash_hex; |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
if($ppr->match($passphrase)) { ... |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
$passwd = $ppr->as_crypt; |
33
|
|
|
|
|
|
|
$userPassword = $ppr->as_rfc2307; |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=head1 DESCRIPTION |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
An object of this class encapsulates a passphrase hashed using one of |
38
|
|
|
|
|
|
|
the Purdy polynomial hash functions used in VMS. This is a subclass |
39
|
|
|
|
|
|
|
of L, and this document assumes that the reader is |
40
|
|
|
|
|
|
|
familiar with the documentation for that class. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
The core of the Purdy polynomial hashing algorithm transforms |
43
|
|
|
|
|
|
|
one 64-bit number into another 64-bit number. It was |
44
|
|
|
|
|
|
|
developed by George B. Purdy, and described in the paper |
45
|
|
|
|
|
|
|
"A High Security Log-in Procedure" which can be found at |
46
|
|
|
|
|
|
|
L. |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
For practical use in passphrase hashing, the Purdy polynomial must |
49
|
|
|
|
|
|
|
be augmented by a procedure to turn a variable-length passphrase |
50
|
|
|
|
|
|
|
into the initial 64-bit number to be hashed. In VMS this pre-hashing |
51
|
|
|
|
|
|
|
phase also incorporates the username of the account to which access is |
52
|
|
|
|
|
|
|
being controlled, in order to prevent identical passphrases yielding |
53
|
|
|
|
|
|
|
identical hashes. This is a form of salting. Another salt parameter, |
54
|
|
|
|
|
|
|
a 16-bit integer, is also included, this one going under the name "salt". |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
There are three variants of the pre-hashing algorithm. The original |
57
|
|
|
|
|
|
|
version, known as "B" and used during field testing of VMS 2.0, |
58
|
|
|
|
|
|
|
truncates or space-pads the username to a fixed length. The second |
59
|
|
|
|
|
|
|
version, known as "B" and used from VMS 2.0 up to (but not |
60
|
|
|
|
|
|
|
including) VMS 5.4, properly handles the variable-length nature of |
61
|
|
|
|
|
|
|
the username. The third version, known as "B" and used from |
62
|
|
|
|
|
|
|
VMS 5.4 onwards, performs some extra bit rotations to avoid aliasing |
63
|
|
|
|
|
|
|
problems when pre-hashing long strings. All three versions are supported |
64
|
|
|
|
|
|
|
by this module. |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
VMS heavily restricts the composition of both usernames and passphrases. |
67
|
|
|
|
|
|
|
They may only contain alphanumerics, "B<$>", and "B<_>". Case is |
68
|
|
|
|
|
|
|
insignificant. Usernames must be between 1 and 31 characters long, |
69
|
|
|
|
|
|
|
and passphrases must be between 1 and 32 characters long. This module |
70
|
|
|
|
|
|
|
enforces these rules. An invalid passphrase is never accepted as |
71
|
|
|
|
|
|
|
matching. |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=cut |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
package Authen::Passphrase::VMSPurdy; |
76
|
|
|
|
|
|
|
|
77
|
1
|
|
|
1
|
|
21975
|
{ use 5.006; } |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
35
|
|
78
|
1
|
|
|
1
|
|
12
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
31
|
|
79
|
1
|
|
|
1
|
|
5
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
46
|
|
80
|
|
|
|
|
|
|
|
81
|
1
|
|
|
1
|
|
2879
|
use Authen::DecHpwd 2.003 qw(lgi_hpwd UAI_C_PURDY UAI_C_PURDY_V UAI_C_PURDY_S); |
|
1
|
|
|
|
|
25299
|
|
|
1
|
|
|
|
|
105
|
|
82
|
1
|
|
|
1
|
|
752
|
use Authen::Passphrase 0.003; |
|
1
|
|
|
|
|
23
|
|
|
1
|
|
|
|
|
32
|
|
83
|
1
|
|
|
1
|
|
10
|
use Carp qw(croak); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
153
|
|
84
|
1
|
|
|
1
|
|
1339
|
use Data::Entropy::Algorithms 0.000 qw(rand_int); |
|
1
|
|
|
|
|
36708
|
|
|
1
|
|
|
|
|
109
|
|
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
our $VERSION = "0.008"; |
87
|
|
|
|
|
|
|
|
88
|
1
|
|
|
1
|
|
12
|
use parent "Authen::Passphrase"; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
6
|
|
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
=head1 CONSTRUCTORS |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=over |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=item Authen::Passphrase::VMSPurdy->new(ATTR => VALUE, ...) |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
Generates a new passphrase recogniser object using the VMS Purdy |
97
|
|
|
|
|
|
|
polynomial algorithm family. The following attributes may be given: |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=over |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=item B |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
A string indicating which variant of the algorithm is to be used. |
104
|
|
|
|
|
|
|
Valid values are "B" (the original), "B" (modified to |
105
|
|
|
|
|
|
|
use full length of the username), and "B" (extra rotations to |
106
|
|
|
|
|
|
|
avoid aliasing when processing long strings). Default "B". |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=item B |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
A string to be used as the `username' salt parameter. It is limited to |
111
|
|
|
|
|
|
|
VMS username syntax. |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=item B |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
The salt, as an integer in the range [0, 65536). |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
=item B |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
The salt, as a string of four hexadecimal digits. The first two |
120
|
|
|
|
|
|
|
digits must give the least-significant byte and the last two give |
121
|
|
|
|
|
|
|
the most-significant byte, with most-significant nybble first within |
122
|
|
|
|
|
|
|
each byte. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=item B |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
Causes salt to be generated randomly. The value given for this attribute |
127
|
|
|
|
|
|
|
is ignored. The source of randomness may be controlled by the facility |
128
|
|
|
|
|
|
|
described in L. |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
=item B |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
The hash, as a string of eight bytes. |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=item B |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
The hash, as a string of 16 hexadecimal digits. |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=item B |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
A passphrase that will be accepted. It is limited to VMS passphrase |
141
|
|
|
|
|
|
|
syntax. |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=back |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
The username and salt must be given, and either the hash or the |
146
|
|
|
|
|
|
|
passphrase. |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=cut |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
sub new { |
151
|
15
|
|
|
15
|
1
|
2103
|
my $class = shift; |
152
|
15
|
|
|
|
|
62
|
my $self = bless({}, $class); |
153
|
15
|
|
|
|
|
22
|
my $passphrase; |
154
|
15
|
|
|
|
|
51
|
while(@_) { |
155
|
54
|
|
|
|
|
9822
|
my $attr = shift; |
156
|
54
|
|
|
|
|
86
|
my $value = shift; |
157
|
54
|
100
|
|
|
|
248
|
if($attr eq "algorithm") { |
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
158
|
9
|
50
|
|
|
|
28
|
croak "algorithm specified redundantly" |
159
|
|
|
|
|
|
|
if exists $self->{algorithm}; |
160
|
9
|
50
|
|
|
|
90
|
$value =~ m#\APURDY(?:|_V|_S)\z# |
161
|
|
|
|
|
|
|
or croak "not a valid algorithm"; |
162
|
9
|
|
|
|
|
41
|
$self->{algorithm} = "$value"; |
163
|
|
|
|
|
|
|
} elsif($attr eq "username") { |
164
|
15
|
50
|
|
|
|
52
|
croak "username specified redundantly" |
165
|
|
|
|
|
|
|
if exists $self->{username}; |
166
|
15
|
50
|
|
|
|
72
|
$value =~ m#\A[_\$0-9A-Za-z]{1,31}\z# |
167
|
|
|
|
|
|
|
or croak "not a valid VMS username"; |
168
|
15
|
|
|
|
|
65
|
$self->{username} = uc("$value"); |
169
|
|
|
|
|
|
|
} elsif($attr eq "salt") { |
170
|
12
|
50
|
|
|
|
34
|
croak "salt specified redundantly" |
171
|
|
|
|
|
|
|
if exists $self->{salt}; |
172
|
12
|
50
|
33
|
|
|
94
|
$value == int($value) && $value >= 0 && $value < 65536 |
|
|
|
33
|
|
|
|
|
173
|
|
|
|
|
|
|
or croak "not a valid salt"; |
174
|
12
|
|
|
|
|
37
|
$self->{salt} = 0+$value; |
175
|
|
|
|
|
|
|
} elsif($attr eq "salt_hex") { |
176
|
2
|
50
|
|
|
|
8
|
croak "salt specified redundantly" |
177
|
|
|
|
|
|
|
if exists $self->{salt}; |
178
|
2
|
50
|
|
|
|
9
|
$value =~ /\A([0-9a-fA-F]{2})([0-9a-fA-F]{2})\z/ |
179
|
|
|
|
|
|
|
or croak "not a valid salt"; |
180
|
2
|
|
|
|
|
13
|
$self->{salt} = hex($2.$1); |
181
|
|
|
|
|
|
|
} elsif($attr eq "salt_random") { |
182
|
1
|
50
|
|
|
|
5
|
croak "salt specified redundantly" |
183
|
|
|
|
|
|
|
if exists $self->{salt}; |
184
|
1
|
|
|
|
|
6
|
$self->{salt} = rand_int(65536); |
185
|
|
|
|
|
|
|
} elsif($attr eq "hash") { |
186
|
0
|
0
|
0
|
|
|
0
|
croak "hash specified redundantly" |
187
|
|
|
|
|
|
|
if exists($self->{hash}) || |
188
|
|
|
|
|
|
|
defined($passphrase); |
189
|
0
|
0
|
|
|
|
0
|
$value =~ m#\A[\x00-\xff]{8}\z# |
190
|
|
|
|
|
|
|
or croak "not a valid raw hash"; |
191
|
0
|
|
|
|
|
0
|
$self->{hash} = "$value"; |
192
|
|
|
|
|
|
|
} elsif($attr eq "hash_hex") { |
193
|
6
|
50
|
33
|
|
|
30
|
croak "hash specified redundantly" |
194
|
|
|
|
|
|
|
if exists($self->{hash}) || |
195
|
|
|
|
|
|
|
defined($passphrase); |
196
|
6
|
50
|
|
|
|
25
|
$value =~ m#\A[0-9A-Fa-f]{16}\z# |
197
|
|
|
|
|
|
|
or croak "not a valid hexadecimal hash"; |
198
|
6
|
|
|
|
|
42
|
$self->{hash} = pack("H*", $value); |
199
|
|
|
|
|
|
|
} elsif($attr eq "passphrase") { |
200
|
9
|
50
|
33
|
|
|
42
|
croak "passphrase specified redundantly" |
201
|
|
|
|
|
|
|
if exists($self->{hash}) || |
202
|
|
|
|
|
|
|
defined($passphrase); |
203
|
9
|
100
|
|
|
|
29
|
$self->_passphrase_acceptable($value) |
204
|
|
|
|
|
|
|
or croak "can't accept that passphrase"; |
205
|
5
|
|
|
|
|
13
|
$passphrase = $value; |
206
|
|
|
|
|
|
|
} else { |
207
|
0
|
|
|
|
|
0
|
croak "unrecognised attribute `$attr'"; |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
} |
210
|
11
|
100
|
|
|
|
35
|
$self->{algorithm} = "PURDY_S" unless exists $self->{algorithm}; |
211
|
11
|
50
|
|
|
|
33
|
croak "username not specified" unless exists $self->{username}; |
212
|
11
|
50
|
|
|
|
28
|
croak "salt not specified" unless exists $self->{salt}; |
213
|
11
|
100
|
|
|
|
32
|
$self->{hash} = $self->_hash_of($passphrase) |
214
|
|
|
|
|
|
|
if defined $passphrase; |
215
|
11
|
50
|
|
|
|
30
|
croak "hash not specified" unless exists $self->{hash}; |
216
|
11
|
|
|
|
|
36
|
return $self; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=item Authen::Passphrase::VMSPurdy->from_crypt(PASSWD) |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
Generates a new passphrase recogniser object using the VMS Purdy |
222
|
|
|
|
|
|
|
polynomial algorithm family, from a crypt string. The string must |
223
|
|
|
|
|
|
|
consist of an algorithm identifier, the salt in hexadecimal, the hash |
224
|
|
|
|
|
|
|
in hexadecimal, then the username. The salt must be given as four |
225
|
|
|
|
|
|
|
hexadecimal digits, the first two giving the least-significant byte and |
226
|
|
|
|
|
|
|
the last two giving the most-significant byte, with most-significant |
227
|
|
|
|
|
|
|
nybble first within each byte. The algorithm identifier must be |
228
|
|
|
|
|
|
|
"B<$VMS1$>" for "B", "B<$VMS2$>" for "B", or "B<$VMS3$>" |
229
|
|
|
|
|
|
|
for "B". The whole crypt string must be uppercase. |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=cut |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
my %decode_crypt_alg_num = ( |
234
|
|
|
|
|
|
|
"1" => "PURDY", |
235
|
|
|
|
|
|
|
"2" => "PURDY_V", |
236
|
|
|
|
|
|
|
"3" => "PURDY_S", |
237
|
|
|
|
|
|
|
); |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
sub from_crypt { |
240
|
2
|
|
|
2
|
1
|
4
|
my($class, $passwd) = @_; |
241
|
2
|
50
|
|
|
|
12
|
if($passwd =~ /\A\$VMS([123])\$/) { |
242
|
2
|
|
|
|
|
5
|
my $alg = $1; |
243
|
2
|
50
|
|
|
|
12
|
$passwd =~ /\A\$VMS[123]\$([0-9A-F]{4}) |
244
|
|
|
|
|
|
|
([0-9A-F]{16})([_\$0-9A-Z]{1,31})\z/x |
245
|
|
|
|
|
|
|
or croak "malformed \$VMS${alg}\$ data"; |
246
|
2
|
|
|
|
|
10
|
my($salt, $hash, $un) = ($1, $2, $3); |
247
|
2
|
|
|
|
|
13
|
return $class->new(algorithm => $decode_crypt_alg_num{$alg}, |
248
|
|
|
|
|
|
|
username => $un, salt_hex => $salt, hash_hex => $hash); |
249
|
|
|
|
|
|
|
} |
250
|
0
|
|
|
|
|
0
|
return $class->SUPER::from_crypt($passwd); |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=item Authen::Passphrase::VMSPurdy->from_rfc2307(USERPASSWORD) |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
Generates a new passphrase recogniser object using the VMS Purdy |
256
|
|
|
|
|
|
|
polynomial algorithm family, from an RFC 2307 string. The string must |
257
|
|
|
|
|
|
|
consist of "B<{CRYPT}>" (case insensitive) followed by an acceptable |
258
|
|
|
|
|
|
|
crypt string. |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
=back |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
=head1 METHODS |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
=over |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
=item $ppr->algorithm |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
Returns the algorithm variant identifier string. It may be "B" |
269
|
|
|
|
|
|
|
(the original), "B" (modified to use full length of the |
270
|
|
|
|
|
|
|
username), and "B" (extra rotations to avoid aliasing when |
271
|
|
|
|
|
|
|
processing long strings). |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
=cut |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
sub algorithm { |
276
|
11
|
|
|
11
|
1
|
4002
|
my($self) = @_; |
277
|
11
|
|
|
|
|
50
|
return $self->{algorithm}; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=item $ppr->username |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
Returns the username string. All alphabetic characters in it are |
283
|
|
|
|
|
|
|
uppercase, which is the canonical form. |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
=cut |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
sub username { |
288
|
11
|
|
|
11
|
1
|
22
|
my($self) = @_; |
289
|
11
|
|
|
|
|
52
|
return $self->{username}; |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
=item $ppr->salt |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
Returns the salt, as an integer. |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=cut |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
sub salt { |
299
|
12
|
|
|
12
|
1
|
24
|
my($self) = @_; |
300
|
12
|
|
|
|
|
48
|
return $self->{salt}; |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
=item $ppr->salt_hex |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
Returns the salt, as a string of four hexadecimal digits. The first |
306
|
|
|
|
|
|
|
two digits give the least-significant byte and the last two give the |
307
|
|
|
|
|
|
|
most-significant byte, with most-significant nybble first within each |
308
|
|
|
|
|
|
|
byte. |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
=cut |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
sub salt_hex { |
313
|
19
|
|
|
19
|
1
|
29
|
my($self) = @_; |
314
|
19
|
|
|
|
|
129
|
return sprintf("%02X%02X", $self->{salt} & 0xff, $self->{salt} >> 8); |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
=item $ppr->hash |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
Returns the hash value, as a string of eight bytes. |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
=cut |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
sub hash { |
324
|
11
|
|
|
11
|
1
|
50
|
my($self) = @_; |
325
|
11
|
|
|
|
|
54
|
return $self->{hash}; |
326
|
|
|
|
|
|
|
} |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
=item $ppr->hash_hex |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
Returns the hash value, as a string of 16 uppercase hexadecimal digits. |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
=cut |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
sub hash_hex { |
335
|
23
|
|
|
23
|
1
|
40
|
my($self) = @_; |
336
|
23
|
|
|
|
|
172
|
return uc(unpack("H*", $self->{hash})); |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
=item $ppr->match(PASSPHRASE) |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
=item $ppr->as_crypt |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
=item $ppr->as_rfc2307 |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
These methods are part of the standard L interface. |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
=cut |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
sub _passphrase_acceptable { |
350
|
26
|
|
|
26
|
|
40
|
my($self, $passphrase) = @_; |
351
|
26
|
|
|
|
|
873
|
return $passphrase =~ /\A[_\$0-9A-Za-z]{1,32}\z/; |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
my %hpwd_alg_num = ( |
355
|
|
|
|
|
|
|
PURDY => UAI_C_PURDY, |
356
|
|
|
|
|
|
|
PURDY_V => UAI_C_PURDY_V, |
357
|
|
|
|
|
|
|
PURDY_S => UAI_C_PURDY_S, |
358
|
|
|
|
|
|
|
); |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
sub _hash_of { |
361
|
22
|
|
|
22
|
|
33
|
my($self, $passphrase) = @_; |
362
|
22
|
|
|
|
|
256
|
return lgi_hpwd($self->{username}, uc($passphrase), |
363
|
|
|
|
|
|
|
$hpwd_alg_num{$self->{algorithm}}, $self->{salt}); |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
sub match { |
367
|
17
|
|
|
17
|
1
|
5410
|
my($self, $passphrase) = @_; |
368
|
17
|
|
66
|
|
|
38
|
return $self->_passphrase_acceptable($passphrase) && |
369
|
|
|
|
|
|
|
$self->_hash_of($passphrase) eq $self->{hash}; |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
my %crypt_alg_num = ( |
373
|
|
|
|
|
|
|
PURDY => "1", |
374
|
|
|
|
|
|
|
PURDY_V => "2", |
375
|
|
|
|
|
|
|
PURDY_S => "3", |
376
|
|
|
|
|
|
|
); |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
sub as_crypt { |
379
|
12
|
|
|
12
|
1
|
22
|
my($self) = @_; |
380
|
12
|
|
|
|
|
47
|
return "\$VMS".$crypt_alg_num{$self->{algorithm}}."\$". |
381
|
|
|
|
|
|
|
$self->salt_hex.$self->hash_hex.$self->{username}; |
382
|
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
=back |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
=head1 SEE ALSO |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
L, |
389
|
|
|
|
|
|
|
L |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
=head1 AUTHOR |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
Andrew Main (Zefram) |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
=head1 COPYRIGHT |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
Copyright (C) 2006, 2007, 2009, 2010, 2012 |
398
|
|
|
|
|
|
|
Andrew Main (Zefram) |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
=head1 LICENSE |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or modify it |
403
|
|
|
|
|
|
|
under the same terms as Perl itself. |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
=cut |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
1; |