File Coverage

blib/lib/Authen/Passphrase/VMSPurdy.pm
Criterion Covered Total %
statement 83 88 94.3
branch 37 60 61.6
condition 6 18 33.3
subroutine 20 20 100.0
pod 10 10 100.0
total 156 196 79.5


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;