File Coverage

blib/lib/Authen/Passphrase/LANManagerHalf.pm
Criterion Covered Total %
statement 64 66 96.9
branch 16 26 61.5
condition 5 12 41.6
subroutine 15 15 100.0
pod 6 6 100.0
total 106 125 84.8


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Authen::Passphrase::LANManagerHalf - passphrases using half the LAN
4             Manager algorithm
5              
6             =head1 SYNOPSIS
7              
8             use Authen::Passphrase::LANManagerHalf;
9              
10             $ppr = Authen::Passphrase::LANManagerHalf->new(
11             hash_hex => "855c3697d9979e78");
12              
13             $ppr = Authen::Passphrase::LANManagerHalf->new(
14             passphrase => "passphr");
15              
16             $ppr = Authen::Passphrase::LANManagerHalf->from_crypt(
17             '$LM$855c3697d9979e78');
18              
19             $ppr = Authen::Passphrase::LANManagerHalf->from_rfc2307(
20             '{CRYPT}$LM$855c3697d9979e78');
21              
22             $hash = $ppr->hash;
23             $hash_hex = $ppr->hash_hex;
24              
25             if($ppr->match($passphrase)) { ...
26              
27             $passwd = $ppr->as_crypt;
28             $userPassword = $ppr->as_rfc2307;
29              
30             =head1 DESCRIPTION
31              
32             An object of this class encapsulates half of a passphrase hashed
33             using the Microsoft LAN Manager hash function. This is a subclass of
34             L, and this document assumes that the reader is
35             familiar with the documentation for that class. For the complete LAN
36             Manager hash function, see L.
37              
38             In a spectacularly bad design decision, the Microsoft LAN Manager hash
39             function splits the passphrase into two parts and hashes them separately.
40             It is therefore possible to separate the halves of a LAN Manager hash,
41             and do things with them (such as crack them) separately. This class is
42             about using such a hash half on its own.
43              
44             The half hash algorithm can be used on up to seven Latin-1 characters of
45             passphrase. First the passphrase is folded to uppercase, and zero-padded
46             to seven bytes. Then the seven bytes are used as a 56-bit DES key, to
47             encrypt the fixed plaintext block "KGS!@#$%". The eight byte ciphertext
48             block is the half hash. There is no salt.
49              
50             I Don't even think about using this seriously. It's an
51             exceptionally weak design, flawed in pretty much every respect.
52              
53             =cut
54              
55             package Authen::Passphrase::LANManagerHalf;
56              
57 2     2   57120 { use 5.006; }
  2         7  
  2         99  
58 2     2   12 use warnings;
  2         5  
  2         68  
59 2     2   12 use strict;
  2         4  
  2         97  
60              
61 2     2   715 use Authen::Passphrase 0.003;
  2         42  
  2         64  
62 2     2   16 use Carp qw(croak);
  2         4  
  2         200  
63 2     2   2151 use Crypt::DES;
  2         5487  
  2         127  
64              
65             our $VERSION = "0.008";
66              
67 2     2   1952 use parent "Authen::Passphrase";
  2         588  
  2         15  
68              
69             =head1 CONSTRUCTORS
70              
71             =over
72              
73             =item Authen::Passphrase::LANManagerHalf->new(ATTR => VALUE, ...)
74              
75             Generates a new passphrase recogniser object using the LAN Manager half
76             hash algorithm. The following attributes may be given:
77              
78             =over
79              
80             =item B
81              
82             The hash, as a string of 8 bytes.
83              
84             =item B
85              
86             The hash, as a string of 16 hexadecimal digits.
87              
88             =item B
89              
90             A passphrase that will be accepted.
91              
92             =back
93              
94             Either the hash or the passphrase must be given.
95              
96             =cut
97              
98             sub new {
99 26     26 1 57 my $class = shift;
100 26         77 my $self = bless({}, $class);
101 26         34 my $passphrase;
102 26         66 while(@_) {
103 26         35 my $attr = shift;
104 26         49 my $value = shift;
105 26 100       76 if($attr eq "hash") {
    100          
    50          
106 17 50 33     98 croak "hash specified redundantly"
107             if exists($self->{hash}) ||
108             defined($passphrase);
109 17 50       62 $value =~ m#\A[\x00-\xff]{8}\z#
110             or croak "not a valid LAN Manager half hash";
111 17         73 $self->{hash} = "$value";
112             } elsif($attr eq "hash_hex") {
113 4 50 33     28 croak "hash specified redundantly"
114             if exists($self->{hash}) ||
115             defined($passphrase);
116 4 50       23 $value =~ m#\A[0-9A-Fa-f]{16}\z#
117             or croak "\"$value\" is not a valid ".
118             "hex LAN Manager half hash";
119 4         27 $self->{hash} = pack("H*", $value);
120             } elsif($attr eq "passphrase") {
121 5 50 33     47 croak "hash specified redundantly"
122             if exists($self->{hash}) ||
123             defined($passphrase);
124 5 50       18 $self->_passphrase_acceptable($value)
125             or croak "can't accept a passphrase exceeding".
126             " seven bytes";
127 5         45 $passphrase = $value;
128             } else {
129 0         0 croak "unrecognised attribute `$attr'";
130             }
131             }
132 26 100       80 $self->{hash} = $self->_hash_of($passphrase) if defined $passphrase;
133 26 50       247 croak "hash not specified" unless exists $self->{hash};
134 26         97 return $self;
135             }
136              
137             =item Authen::Passphrase::LANManagerHalf->from_crypt(PASSWD)
138              
139             Generates a new LAN Manager half passphrase recogniser object from a
140             crypt string. The crypt string must consist of "B<$LM$>" followed by
141             the hash in lowercase hexadecimal.
142              
143             =cut
144              
145             sub from_crypt {
146 2     2 1 5 my($class, $passwd) = @_;
147 2 50       10 if($passwd =~ /\A\$LM\$/) {
148 2 50       11 $passwd =~ m#\A\$LM\$([0-9a-f]{16})\z#
149             or croak "malformed \$LM\$ data";
150 2         5 my $hash = $1;
151 2         8 return $class->new(hash_hex => $hash);
152             }
153 0         0 return $class->SUPER::from_crypt($passwd);
154             }
155              
156             =item Authen::Passphrase::LANManagerHalf->from_rfc2307(USERPASSWORD)
157              
158             Generates a new LAN Manager half passphrase recogniser object from an RFC
159             2307 string. The string must consist of "B<{CRYPT}>" (case insensitive)
160             followed by an acceptable crypt string.
161              
162             =back
163              
164             =head1 METHODS
165              
166             =over
167              
168             =item $ppr->hash
169              
170             Returns the hash value, as a string of 8 bytes.
171              
172             =cut
173              
174             sub hash {
175 56     56 1 1112 my($self) = @_;
176 56         419 return $self->{hash};
177             }
178              
179             =item $ppr->hash_hex
180              
181             Returns the hash value, as a string of 16 hexadecimal digits.
182              
183             =cut
184              
185             sub hash_hex {
186 18     18 1 3615 my($self) = @_;
187 18         143 return unpack("H*", $self->{hash});
188             }
189              
190             =item $ppr->match(PASSPHRASE)
191              
192             =item $ppr->as_crypt
193              
194             =item $ppr->as_rfc2307
195              
196             These methods are part of the standard L interface.
197              
198             =cut
199              
200             sub _passphrase_acceptable {
201 60     60   94 my($self, $passphrase) = @_;
202 60         379 return $passphrase =~ /\A[\x00-\xff]{0,7}\z/;
203             }
204              
205             sub _hash_of {
206 60     60   89 my($self, $passphrase) = @_;
207 60         103 $passphrase = uc($passphrase);
208 60         102 $passphrase = "\0".$passphrase."\0\0\0\0\0\0\0\0";
209 60         78 my $key = "";
210 60         158 for(my $i = 0; $i != 8; $i++) {
211 480         606 my $a = ord(substr($passphrase, $i, 1));
212 480         747 my $b = ord(substr($passphrase, $i+1, 1));
213 480         1226 $key .= chr((($b >> $i) | ($a << (8-$i))) & 0xfe);
214             }
215 60         235 return Crypt::DES->new($key)->encrypt("KGS!\@#\$%");
216             }
217              
218             sub match {
219 55     55 1 13232 my($self, $passphrase) = @_;
220 55   66     126 return $self->_passphrase_acceptable($passphrase) &&
221             $self->_hash_of($passphrase) eq $self->{hash};
222             }
223              
224             sub as_crypt {
225 10     10 1 20 my($self) = @_;
226 10         27 return "\$LM\$".$self->hash_hex;
227             }
228              
229             =back
230              
231             =head1 SEE ALSO
232              
233             L,
234             L,
235             L
236              
237             =head1 AUTHOR
238              
239             Andrew Main (Zefram)
240              
241             =head1 COPYRIGHT
242              
243             Copyright (C) 2006, 2007, 2009, 2010, 2012
244             Andrew Main (Zefram)
245              
246             =head1 LICENSE
247              
248             This module is free software; you can redistribute it and/or modify it
249             under the same terms as Perl itself.
250              
251             =cut
252              
253             1;