File Coverage

blib/lib/Authen/Passphrase/NTHash.pm
Criterion Covered Total %
statement 68 70 97.1
branch 21 32 65.6
condition 3 9 33.3
subroutine 16 16 100.0
pod 8 8 100.0
total 116 135 85.9


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Authen::Passphrase::NTHash - passphrases using the NT-Hash algorithm
4              
5             =head1 SYNOPSIS
6              
7             use Authen::Passphrase::NTHash;
8              
9             $ppr = Authen::Passphrase::NTHash->new(
10             hash_hex => "7f8fe03093cc84b267b109625f6bbf4b");
11              
12             $ppr = Authen::Passphrase::NTHash->new(
13             passphrase => "passphrase");
14              
15             $ppr = Authen::Passphrase::NTHash->from_crypt(
16             '$3$$7f8fe03093cc84b267b109625f6bbf4b');
17              
18             $ppr = Authen::Passphrase::NTHash->from_rfc2307(
19             '{MSNT}7f8fe03093cc84b267b109625f6bbf4b');
20              
21             $hash = $ppr->hash;
22             $hash_hex = $ppr->hash_hex;
23              
24             if($ppr->match($passphrase)) { ...
25              
26             $passwd = $ppr->as_crypt;
27             $userPassword = $ppr->as_rfc2307;
28              
29             =head1 DESCRIPTION
30              
31             An object of this class encapsulates a passphrase hashed using the NT-Hash
32             function. This is a subclass of L, and this document
33             assumes that the reader is familiar with the documentation for that class.
34              
35             The NT-Hash scheme is based on the MD4 digest algorithm. Up to 128
36             characters of passphrase (characters beyond the 128th are ignored)
37             are represented in Unicode, and hashed using MD4. No salt is used.
38              
39             I MD4 is a weak hash algorithm by current standards, and the
40             lack of salt is a design flaw in this scheme. Use this for compatibility
41             only, not by choice.
42              
43             =cut
44              
45             package Authen::Passphrase::NTHash;
46              
47 1     1   47167 { use 5.006; }
  1         4  
  1         65  
48 1     1   8 use warnings;
  1         2  
  1         52  
49 1     1   6 use strict;
  1         9  
  1         49  
50              
51 1     1   1072 use Authen::Passphrase 0.003;
  1         32  
  1         42  
52 1     1   15 use Carp qw(croak);
  1         3  
  1         87  
53 1     1   5271 use Digest::MD4 1.2 qw(md4);
  1         5880  
  1         170  
54              
55             our $VERSION = "0.008";
56              
57 1     1   1278 use parent "Authen::Passphrase";
  1         382  
  1         6  
58              
59             =head1 CONSTRUCTORS
60              
61             =over
62              
63             =item Authen::Passphrase::NTHash->new(ATTR => VALUE, ...)
64              
65             Generates a new passphrase recogniser object using the NT-Hash algorithm.
66             The following attributes may be given:
67              
68             =over
69              
70             =item B
71              
72             The hash, as a string of 16 bytes.
73              
74             =item B
75              
76             The hash, as a string of 32 hexadecimal digits.
77              
78             =item B
79              
80             A passphrase that will be accepted.
81              
82             =back
83              
84             Either the hash or the passphrase must be given.
85              
86             =cut
87              
88             sub new {
89 10     10 1 31 my $class = shift;
90 10         29 my $self = bless({}, $class);
91 10         13 my $passphrase;
92 10         26 while(@_) {
93 10         13 my $attr = shift;
94 10         12 my $value = shift;
95 10 100       36 if($attr eq "hash") {
    100          
    50          
96 2 50 33     16 croak "hash specified redundantly"
97             if exists($self->{hash}) ||
98             defined($passphrase);
99 2 50       10 $value =~ m#\A[\x00-\xff]{16}\z#
100             or croak "not a valid MD4 hash";
101 2         10 $self->{hash} = "$value";
102             } elsif($attr eq "hash_hex") {
103 7 50 33     38 croak "hash specified redundantly"
104             if exists($self->{hash}) ||
105             defined($passphrase);
106 7 50       28 $value =~ m#\A[0-9A-Fa-f]{32}\z#
107             or croak "\"$value\" is not a valid ".
108             "hex MD4 hash";
109 7         41 $self->{hash} = pack("H*", $value);
110             } elsif($attr eq "passphrase") {
111 1 50 33     19 croak "passphrase specified redundantly"
112             if exists($self->{hash}) ||
113             defined($passphrase);
114 1         6 $passphrase = $value;
115             } else {
116 0         0 croak "unrecognised attribute `$attr'";
117             }
118             }
119 10 100       41 $self->{hash} = $self->_hash_of($passphrase) if defined $passphrase;
120 10 50       25 croak "hash not specified" unless exists $self->{hash};
121 10         26 return $self;
122             }
123              
124             =item Authen::Passphrase::NTHash->from_crypt(PASSWD)
125              
126             Generates a new NT-Hash passphrase recogniser object from a crypt string.
127             Two forms are accepted. In the first form, the he crypt string must
128             consist of "B<$3$$>" (note the extra "B<$>") followed by the hash in
129             lowercase hexadecimal. In the second form, the he crypt string must
130             consist of "B<$NT$>" followed by the hash in lowercase hexadecimal.
131              
132             =cut
133              
134             sub from_crypt {
135 3     3 1 7 my($class, $passwd) = @_;
136 3 100       17 if($passwd =~ /\A\$3\$/) {
    50          
137 2 50       10 $passwd =~ m#\A\$3\$\$([0-9a-f]{32})\z#
138             or croak "malformed \$3\$ data";
139 2         6 my $hash = $1;
140 2         8 return $class->new(hash_hex => $hash);
141             } elsif($passwd =~ /\A\$NT\$/) {
142 1 50       6 $passwd =~ m#\A\$NT\$([0-9a-f]{32})\z#
143             or croak "malformed \$NT\$ data";
144 1         4 my $hash = $1;
145 1         3 return $class->new(hash_hex => $hash);
146             }
147 0         0 return $class->SUPER::from_crypt($passwd);
148             }
149              
150             =item Authen::Passphrase::NTHash->from_rfc2307(USERPASSWORD)
151              
152             Generates a new NT-Hash passphrase recogniser object from an RFC
153             2307 string. Two forms are accepted. In the first form, the string
154             must consist of "B<{MSNT}>" followed by the hash in hexadecimal; case
155             is ignored. In the second form, the string must consist of "B<{CRYPT}>"
156             (case insensitive) followed by an acceptable crypt string.
157              
158             =cut
159              
160             sub from_rfc2307 {
161 2     2 1 5 my($class, $userpassword) = @_;
162 2 100       10 if($userpassword =~ /\A\{(?i:msnt)\}/) {
163 1 50       7 $userpassword =~ /\A\{.*?\}([0-9a-fA-F]{32})\z/
164             or croak "malformed {MSNT} data";
165 1         3 my $hash = $1;
166 1         3 return $class->new(hash_hex => $hash);
167             }
168 1         13 return $class->SUPER::from_rfc2307($userpassword);
169             }
170              
171             =back
172              
173             =head1 METHODS
174              
175             =over
176              
177             =item $ppr->hash
178              
179             Returns the hash value, as a string of 16 bytes.
180              
181             =cut
182              
183             sub hash {
184 6     6 1 745 my($self) = @_;
185 6         25 return $self->{hash};
186             }
187              
188             =item $ppr->hash_hex
189              
190             Returns the hash value, as a string of 32 hexadecimal digits.
191              
192             =cut
193              
194             sub hash_hex {
195 20     20 1 3423 my($self) = @_;
196 20         139 return unpack("H*", $self->{hash});
197             }
198              
199             =item $ppr->match(PASSPHRASE)
200              
201             =item $ppr->as_crypt
202              
203             =item $ppr->as_rfc2307
204              
205             These methods are part of the standard L interface.
206              
207             =cut
208              
209             sub _hash_of {
210 26     26   39 my($self, $passphrase) = @_;
211 26         77 $passphrase = substr($passphrase, 0, 128);
212 26         100 $passphrase =~ s/(.)/pack("v", ord($1))/eg;
  201         569  
213 26         217 return md4($passphrase);
214             }
215              
216             sub match {
217 25     25 1 9496 my($self, $passphrase) = @_;
218 25         52 return $self->_hash_of($passphrase) eq $self->{hash};
219             }
220              
221             sub as_crypt {
222 5     5 1 9 my($self) = @_;
223 5         12 return "\$3\$\$".$self->hash_hex;
224             }
225              
226             sub as_rfc2307 {
227 5     5 1 9 my($self) = @_;
228 5         14 return "{MSNT}".$self->hash_hex;
229             }
230              
231             =back
232              
233             =head1 SEE ALSO
234              
235             L,
236             L
237              
238             =head1 AUTHOR
239              
240             Andrew Main (Zefram)
241              
242             =head1 COPYRIGHT
243              
244             Copyright (C) 2006, 2007, 2009, 2010, 2012
245             Andrew Main (Zefram)
246              
247             =head1 LICENSE
248              
249             This module is free software; you can redistribute it and/or modify it
250             under the same terms as Perl itself.
251              
252             =cut
253              
254             1;