File Coverage

blib/lib/Crypt/SmbHash.pm
Criterion Covered Total %
statement 277 307 90.2
branch 32 46 69.5
condition n/a
subroutine 28 30 93.3
pod 0 24 0.0
total 337 407 82.8


line stmt bran cond sub pod time code
1             #
2             # Samba LM/NT Hash Generating Library.
3             #
4             # Usage:
5             # use Crypt::SmbHash;
6             # ( $lmhash, $nthash ) = ntlmgen($pass);
7             # or
8             # ntlmgen $pass, $lmhash, $nthash;
9             #
10             # Copyright(C) 2001 Benjamin Kuit
11             #
12              
13             package Crypt::SmbHash;
14 1     1   5688 use 5.005;
  1         3  
  1         33  
15 1     1   4 use strict;
  1         1  
  1         26  
16 1     1   4 use Exporter;
  1         10  
  1         30  
17 1     1   4 use Carp;
  1         1  
  1         69  
18 1     1   5 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
  1         2  
  1         164  
19             @ISA = qw(Exporter);
20             $VERSION = '0.12';
21             @EXPORT = qw( ntlmgen );
22              
23             # The mdfour function is available for exporting if they really want
24             # it =)
25             @EXPORT_OK = qw( lmhash nthash ntlmgen mdfour smbhash E_P24 E_P21 SMBNTencrypt );
26              
27             # Works out if local system has Digest::MD4 and Encode
28             my $HaveDigestMD4;
29             my $HaveUnicode;
30             BEGIN {
31 1     1   2 $HaveDigestMD4 = 0;
32 1         2 $HaveUnicode = 0;
33 1 50       57 if ( eval "require 'Digest/MD4.pm';" ) {
34 0         0 $HaveDigestMD4 = 1;
35             }
36 1 50       54 if (eval "require Encode;") {
37 1         11983 import Encode;
38 1         3427 $HaveUnicode = 1;
39             }
40             }
41              
42              
43             # lmhash PASSWORD
44             # Generates lanman password hash for a given password, returns the hash
45             #
46             # Extracted and ported from SAMBA/source/libsmb/smbencrypt.c:nt_lm_owf_gen
47             sub lmhash($;$) {
48 6     6 0 726 my ( $pass, $pwenc ) = @_;
49 6         8 my ( @p16 );
50              
51 6 50       20 $pass = "" unless defined($pass);
52 6         26 $pass = uc($pass);
53 6 50       15 if (!$HaveUnicode) {
54 0 0       0 if (defined($pwenc)) {
55 0         0 croak "Encode module not found: no encoding support";
56             }
57             }
58             else {
59 6 100       18 $pwenc = "iso-8859-1" unless defined($pwenc);
60 6         19 $pass = encode($pwenc,$pass);
61             }
62              
63 6         290 $pass = substr($pass,0,14);
64 6         28 @p16 = E_P16($pass);
65 6         16 return join("", map {sprintf("%02X",$_);} @p16);
  96         242  
66             }
67              
68             # nthash PASSWORD
69             # Generates nt md4 password hash for a given password, returns the hash
70             #
71             # Extracted and ported from SAMBA/source/libsmb/smbencrypt.c:nt_lm_owf_gen
72             sub nthash($) {
73 6     6 0 92 my ( $pass ) = @_;
74 6         13 my ( $hex );
75             my ( $digest );
76 6 50       39 $pass = substr(defined($pass)?$pass:"",0,128);
77 6 50       16 if (!$HaveUnicode) {
78             # No unicode support: do a really broken to ucs2 convert
79 0         0 $pass =~ s/(.)/$1\000/sg;
80             }
81             else {
82 6         30 $pass = encode('ucs2', $pass);
83 6         95845 $pass = pack("v*", unpack("n*",$pass));
84             }
85 6         15 $hex = "";
86 6 50       20 if ( $HaveDigestMD4 ) {
87 0         0 eval {
88 0         0 $digest = new Digest::MD4;
89 0         0 $digest->reset();
90 0         0 $digest->add($pass);
91 0         0 $hex = $digest->hexdigest();
92 0         0 $hex =~ tr/a-z/A-Z/;
93             };
94 0 0       0 $HaveDigestMD4 = 0 unless ( $hex );
95             }
96 6 50       37 $hex = sprintf("%02X"x16,mdfour($pass)) unless ( $hex );
97 6         17 return $hex;
98             }
99              
100             # ntlmgen PASSWORD, LMHASH, NTHASH
101             # Generate lanman and nt md4 password hash for given password, and assigns
102             # values to arguments. Combined function of lmhash and nthash
103             sub ntlmgen {
104 5     5 0 920 my ( $nthash, $lmhash );
105 5         22 $nthash = nthash($_[0]);
106 5         18 $lmhash = lmhash($_[0]);
107 5 50       25 if ( $#_ == 2 ) {
108 5         13 $_[1] = $lmhash;
109 5         11 $_[2] = $nthash;
110             }
111 5         23 return ( $lmhash, $nthash );
112             }
113              
114             # Support functions
115             # Ported from SAMBA/source/lib/md4.c:F,G and H respectfully
116 160     160 0 164 sub F { my ( $X, $Y, $Z ) = @_; return ($X&$Y) | ((~$X)&$Z); }
  160         339  
117 160     160 0 156 sub G { my ( $X, $Y, $Z) = @_; return ($X&$Y) | ($X&$Z) | ($Y&$Z); }
  160         327  
118 160     160 0 158 sub H { my ($X, $Y, $Z) = @_; return $X^$Y^$Z; }
  160         304  
119              
120             # Needed? because perl seems to choke on overflowing when doing bitwise
121             # operations on numbers larger than 32 bits. Well, it did on my machine =)
122             sub add32 {
123 520     520 0 686 my ( @v ) = @_;
124 520         435 my ( $ret, @sum );
125 520         689 foreach ( @v ) {
126 1840         3111 $_ = [ ($_&0xffff0000)>>16, ($_&0xffff) ];
127             }
128 520         646 @sum = ();
129 520         539 foreach ( @v ) {
130 1840         1791 $sum[0] += $_->[0];
131 1840         2198 $sum[1] += $_->[1];
132             }
133 520         682 $sum[0] += ($sum[1]&0xffff0000)>>16;
134 520         453 $sum[1] &= 0xffff;
135 520         426 $sum[0] &= 0xffff;
136 520         565 $ret = ($sum[0]<<16) | $sum[1];
137 520         1316 return $ret;
138             }
139             # Ported from SAMBA/source/lib/md4.c:lshift
140             # Renamed to prevent clash with SAMBA/source/libsmb/smbdes.c:lshift
141             sub md4lshift {
142 480     480 0 497 my ($x, $s) = @_;
143 480         411 $x &= 0xFFFFFFFF;
144 480         866 return (($x<<$s)&0xFFFFFFFF) | ($x>>(32-$s));
145             }
146             # Ported from SAMBA/source/lib/md4.c:ROUND1
147             sub ROUND1 {
148 160     160 0 708 my($a,$b,$c,$d,$k,$s,@X) = @_;
149 160         252 $_[0] = md4lshift(add32($a,F($b,$c,$d),$X[$k]), $s);
150 160         257 return $_[0];
151             }
152             # Ported from SAMBA/source/lib/md4.c:ROUND2
153             sub ROUND2 {
154 160     160 0 335 my ($a,$b,$c,$d,$k,$s,@X) = @_;
155 160         239 $_[0] = md4lshift(add32($a,G($b,$c,$d),$X[$k],0x5A827999), $s);
156 160         260 return $_[0];
157             }
158             # Ported from SAMBA/source/lib/md4.c:ROUND3
159             sub ROUND3 {
160 160     160 0 354 my ($a,$b,$c,$d,$k,$s,@X) = @_;
161 160         251 $_[0] = md4lshift(add32($a,H($b,$c,$d),$X[$k],0x6ED9EBA1), $s);
162 160         287 return $_[0];
163             }
164             # Ported from SAMBA/source/lib/md4.c:mdfour64
165             sub mdfour64 {
166 10     10 0 26 my ( $A, $B, $C, $D, @M ) = @_;
167 10         12 my ( $AA, $BB, $CC, $DD );
168 0         0 my ( @X );
169 10 100       23 @X = (map { $_?$_:0 } @M)[0..15];
  160         253  
170 10         16 $AA=$A; $BB=$B; $CC=$C; $DD=$D;
  10         12  
  10         12  
  10         9  
171 10         32 ROUND1($A,$B,$C,$D, 0, 3, @X); ROUND1($D,$A,$B,$C, 1, 7, @X);
  10         19  
172 10         24 ROUND1($C,$D,$A,$B, 2, 11, @X); ROUND1($B,$C,$D,$A, 3, 19, @X);
  10         21  
173 10         20 ROUND1($A,$B,$C,$D, 4, 3, @X); ROUND1($D,$A,$B,$C, 5, 7, @X);
  10         24  
174 10         23 ROUND1($C,$D,$A,$B, 6, 11, @X); ROUND1($B,$C,$D,$A, 7, 19, @X);
  10         46  
175 10         19 ROUND1($A,$B,$C,$D, 8, 3, @X); ROUND1($D,$A,$B,$C, 9, 7, @X);
  10         23  
176 10         23 ROUND1($C,$D,$A,$B, 10, 11, @X); ROUND1($B,$C,$D,$A, 11, 19, @X);
  10         22  
177 10         22 ROUND1($A,$B,$C,$D, 12, 3, @X); ROUND1($D,$A,$B,$C, 13, 7, @X);
  10         25  
178 10         21 ROUND1($C,$D,$A,$B, 14, 11, @X); ROUND1($B,$C,$D,$A, 15, 19, @X);
  10         23  
179 10         26 ROUND2($A,$B,$C,$D, 0, 3, @X); ROUND2($D,$A,$B,$C, 4, 5, @X);
  10         20  
180 10         20 ROUND2($C,$D,$A,$B, 8, 9, @X); ROUND2($B,$C,$D,$A, 12, 13, @X);
  10         19  
181 10         19 ROUND2($A,$B,$C,$D, 1, 3, @X); ROUND2($D,$A,$B,$C, 5, 5, @X);
  10         18  
182 10         20 ROUND2($C,$D,$A,$B, 9, 9, @X); ROUND2($B,$C,$D,$A, 13, 13, @X);
  10         24  
183 10         25 ROUND2($A,$B,$C,$D, 2, 3, @X); ROUND2($D,$A,$B,$C, 6, 5, @X);
  10         25  
184 10         25 ROUND2($C,$D,$A,$B, 10, 9, @X); ROUND2($B,$C,$D,$A, 14, 13, @X);
  10         20  
185 10         23 ROUND2($A,$B,$C,$D, 3, 3, @X); ROUND2($D,$A,$B,$C, 7, 5, @X);
  10         21  
186 10         22 ROUND2($C,$D,$A,$B, 11, 9, @X); ROUND2($B,$C,$D,$A, 15, 13, @X);
  10         22  
187 10         23 ROUND3($A,$B,$C,$D, 0, 3, @X); ROUND3($D,$A,$B,$C, 8, 9, @X);
  10         26  
188 10         24 ROUND3($C,$D,$A,$B, 4, 11, @X); ROUND3($B,$C,$D,$A, 12, 15, @X);
  10         22  
189 10         22 ROUND3($A,$B,$C,$D, 2, 3, @X); ROUND3($D,$A,$B,$C, 10, 9, @X);
  10         22  
190 10         21 ROUND3($C,$D,$A,$B, 6, 11, @X); ROUND3($B,$C,$D,$A, 14, 15, @X);
  10         26  
191 10         20 ROUND3($A,$B,$C,$D, 1, 3, @X); ROUND3($D,$A,$B,$C, 9, 9, @X);
  10         23  
192 10         21 ROUND3($C,$D,$A,$B, 5, 11, @X); ROUND3($B,$C,$D,$A, 13, 15, @X);
  10         25  
193 10         17 ROUND3($A,$B,$C,$D, 3, 3, @X); ROUND3($D,$A,$B,$C, 11, 9, @X);
  10         19  
194 10         17 ROUND3($C,$D,$A,$B, 7, 11, @X); ROUND3($B,$C,$D,$A, 15, 15, @X);
  10         22  
195             # We want to change the arguments, so assign them to $_[0] markers
196             # rather than to $A..$D
197 10         15 $_[0] = add32($A,$AA); $_[1] = add32($B,$BB);
  10         22  
198 10         18 $_[2] = add32($C,$CC); $_[3] = add32($D,$DD);
  10         16  
199 10         25 @X = map { 0 } (1..16);
  160         217  
200             }
201              
202             # Ported from SAMBA/source/lib/md4.c:copy64
203             sub copy64 {
204 10     10 0 94 my ( @in ) = @_;
205 10         12 my ( $i, @M );
206 10         23 for $i ( 0..15 ) {
207 160         338 $M[$i] = ($in[$i*4+3]<<24) | ($in[$i*4+2]<<16) |
208             ($in[$i*4+1]<<8) | ($in[$i*4+0]<<0);
209             }
210 10         73 return @M;
211             }
212             # Ported from SAMBA/source/lib/md4.c:copy4
213             sub copy4 {
214 30     30 0 36 my ( $x ) = @_;
215 30         30 my ( @out );
216 30         39 $out[0] = $x&0xFF;
217 30         38 $out[1] = ($x>>8)&0xFF;
218 30         37 $out[2] = ($x>>16)&0xFF;
219 30         38 $out[3] = ($x>>24)&0xFF;
220 30 100       37 @out = map { $_?$_:0 } @out;
  120         212  
221 30         98 return @out;
222             }
223             # Ported from SAMBA/source/lib/md4.c:mdfour
224             sub mdfour {
225 6     6 0 65 my ( @in ) = unpack("C*",$_[0]);
226 6         18 my ( $b, @A, @M, @buf, @out );
227 6         10 $b = scalar @in * 8;
228 6         18 @A = ( 0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476 );
229 6         20 while (scalar @in > 64 ) {
230 3         17 @M = copy64( @in );
231 3         12 mdfour64( @A, @M );
232 3         92 @in = @in[64..$#in];
233             }
234 6         29 @buf = ( @in, 0x80, map {0} (1..128) )[0..127];
  768         887  
235 6 100       37 if ( scalar @in <= 55 ) {
236 5         20 @buf[56..59] = copy4( $b );
237 5         25 @M = copy64( @buf );
238 5         20 mdfour64( @A, @M );
239             }
240             else {
241 1         4 @buf[120..123] = copy4( $b );
242 1         3 @M = copy64( @buf );
243 1         5 mdfour64( @A, @M );
244 1         8 @M = copy64( @buf[64..$#buf] );
245 1         6 mdfour64( @A, @M );
246             }
247 6         24 @out[0..3] = copy4($A[0]);
248 6         16 @out[4..7] = copy4($A[1]);
249 6         15 @out[8..11] = copy4($A[2]);
250 6         16 @out[12..15] = copy4($A[3]);
251 6         69 return @out;
252             }
253             # Contants used in lanlam hash calculations
254             # Ported from SAMBA/source/libsmb/smbdes.c:perm1[56]
255             my @perm1 = (57, 49, 41, 33, 25, 17, 9,
256             1, 58, 50, 42, 34, 26, 18,
257             10, 2, 59, 51, 43, 35, 27,
258             19, 11, 3, 60, 52, 44, 36,
259             63, 55, 47, 39, 31, 23, 15,
260             7, 62, 54, 46, 38, 30, 22,
261             14, 6, 61, 53, 45, 37, 29,
262             21, 13, 5, 28, 20, 12, 4);
263             # Ported from SAMBA/source/libsmb/smbdes.c:perm2[48]
264             my @perm2 = (14, 17, 11, 24, 1, 5,
265             3, 28, 15, 6, 21, 10,
266             23, 19, 12, 4, 26, 8,
267             16, 7, 27, 20, 13, 2,
268             41, 52, 31, 37, 47, 55,
269             30, 40, 51, 45, 33, 48,
270             44, 49, 39, 56, 34, 53,
271             46, 42, 50, 36, 29, 32);
272             # Ported from SAMBA/source/libsmb/smbdes.c:perm3[64]
273             my @perm3 = (58, 50, 42, 34, 26, 18, 10, 2,
274             60, 52, 44, 36, 28, 20, 12, 4,
275             62, 54, 46, 38, 30, 22, 14, 6,
276             64, 56, 48, 40, 32, 24, 16, 8,
277             57, 49, 41, 33, 25, 17, 9, 1,
278             59, 51, 43, 35, 27, 19, 11, 3,
279             61, 53, 45, 37, 29, 21, 13, 5,
280             63, 55, 47, 39, 31, 23, 15, 7);
281             # Ported from SAMBA/source/libsmb/smbdes.c:perm4[48]
282             my @perm4 = ( 32, 1, 2, 3, 4, 5,
283             4, 5, 6, 7, 8, 9,
284             8, 9, 10, 11, 12, 13,
285             12, 13, 14, 15, 16, 17,
286             16, 17, 18, 19, 20, 21,
287             20, 21, 22, 23, 24, 25,
288             24, 25, 26, 27, 28, 29,
289             28, 29, 30, 31, 32, 1);
290             # Ported from SAMBA/source/libsmb/smbdes.c:perm5[32]
291             my @perm5 = ( 16, 7, 20, 21,
292             29, 12, 28, 17,
293             1, 15, 23, 26,
294             5, 18, 31, 10,
295             2, 8, 24, 14,
296             32, 27, 3, 9,
297             19, 13, 30, 6,
298             22, 11, 4, 25);
299             # Ported from SAMBA/source/libsmb/smbdes.c:perm6[64]
300             my @perm6 =( 40, 8, 48, 16, 56, 24, 64, 32,
301             39, 7, 47, 15, 55, 23, 63, 31,
302             38, 6, 46, 14, 54, 22, 62, 30,
303             37, 5, 45, 13, 53, 21, 61, 29,
304             36, 4, 44, 12, 52, 20, 60, 28,
305             35, 3, 43, 11, 51, 19, 59, 27,
306             34, 2, 42, 10, 50, 18, 58, 26,
307             33, 1, 41, 9, 49, 17, 57, 25);
308             # Ported from SAMBA/source/libsmb/smbdes.c:sc[16]
309             my @sc = (1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 1);
310             # Ported from SAMBA/source/libsmb/smbdes.c:sbox[8][4][16]
311             # Side note, I used cut and paste for all these numbers, I did NOT
312             # type them all in =)
313             my @sbox = ([[14, 4, 13, 1, 2, 15, 11, 8, 3, 10, 6, 12, 5, 9, 0, 7],
314             [ 0, 15, 7, 4, 14, 2, 13, 1, 10, 6, 12, 11, 9, 5, 3, 8],
315             [ 4, 1, 14, 8, 13, 6, 2, 11, 15, 12, 9, 7, 3, 10, 5, 0],
316             [15, 12, 8, 2, 4, 9, 1, 7, 5, 11, 3, 14, 10, 0, 6, 13]],
317             [[15, 1, 8, 14, 6, 11, 3, 4, 9, 7, 2, 13, 12, 0, 5, 10],
318             [ 3, 13, 4, 7, 15, 2, 8, 14, 12, 0, 1, 10, 6, 9, 11, 5],
319             [ 0, 14, 7, 11, 10, 4, 13, 1, 5, 8, 12, 6, 9, 3, 2, 15],
320             [13, 8, 10, 1, 3, 15, 4, 2, 11, 6, 7, 12, 0, 5, 14, 9]],
321             [[10, 0, 9, 14, 6, 3, 15, 5, 1, 13, 12, 7, 11, 4, 2, 8],
322             [13, 7, 0, 9, 3, 4, 6, 10, 2, 8, 5, 14, 12, 11, 15, 1],
323             [13, 6, 4, 9, 8, 15, 3, 0, 11, 1, 2, 12, 5, 10, 14, 7],
324             [ 1, 10, 13, 0, 6, 9, 8, 7, 4, 15, 14, 3, 11, 5, 2, 12]],
325             [[ 7, 13, 14, 3, 0, 6, 9, 10, 1, 2, 8, 5, 11, 12, 4, 15],
326             [13, 8, 11, 5, 6, 15, 0, 3, 4, 7, 2, 12, 1, 10, 14, 9],
327             [10, 6, 9, 0, 12, 11, 7, 13, 15, 1, 3, 14, 5, 2, 8, 4],
328             [ 3, 15, 0, 6, 10, 1, 13, 8, 9, 4, 5, 11, 12, 7, 2, 14]],
329             [[ 2, 12, 4, 1, 7, 10, 11, 6, 8, 5, 3, 15, 13, 0, 14, 9],
330             [14, 11, 2, 12, 4, 7, 13, 1, 5, 0, 15, 10, 3, 9, 8, 6],
331             [ 4, 2, 1, 11, 10, 13, 7, 8, 15, 9, 12, 5, 6, 3, 0, 14],
332             [11, 8, 12, 7, 1, 14, 2, 13, 6, 15, 0, 9, 10, 4, 5, 3]],
333             [[12, 1, 10, 15, 9, 2, 6, 8, 0, 13, 3, 4, 14, 7, 5, 11],
334             [10, 15, 4, 2, 7, 12, 9, 5, 6, 1, 13, 14, 0, 11, 3, 8],
335             [ 9, 14, 15, 5, 2, 8, 12, 3, 7, 0, 4, 10, 1, 13, 11, 6],
336             [ 4, 3, 2, 12, 9, 5, 15, 10, 11, 14, 1, 7, 6, 0, 8, 13]],
337             [[ 4, 11, 2, 14, 15, 0, 8, 13, 3, 12, 9, 7, 5, 10, 6, 1],
338             [13, 0, 11, 7, 4, 9, 1, 10, 14, 3, 5, 12, 2, 15, 8, 6],
339             [ 1, 4, 11, 13, 12, 3, 7, 14, 10, 15, 6, 8, 0, 5, 9, 2],
340             [ 6, 11, 13, 8, 1, 4, 10, 7, 9, 5, 0, 15, 14, 2, 3, 12]],
341             [[13, 2, 8, 4, 6, 15, 11, 1, 10, 9, 3, 14, 5, 0, 12, 7],
342             [ 1, 15, 13, 8, 10, 3, 7, 4, 12, 5, 6, 11, 0, 14, 9, 2],
343             [ 7, 11, 4, 1, 9, 12, 14, 2, 0, 6, 10, 13, 15, 3, 5, 8],
344             [ 2, 1, 14, 7, 4, 10, 8, 13, 15, 12, 9, 0, 3, 5, 6, 11]]);
345              
346             # Ported from SAMBA/source/libsmb/smbdes.c:xor
347             # Hack: Split arguments in half and then xor's first half of arguments to
348             # second half of arguments. Probably proper way of doing this would
349             # be to used referenced variables
350             sub mxor {
351 384     384 0 2159 my ( @in ) = @_;
352 384         374 my ( $i, $off, @ret );
353 384         611 $off = int($#in/2);
354 384         967 for $i ( 0..$off ) {
355 15360         19096 $ret[$i] = $in[$i] ^ $in[$i+$off+1];
356             }
357 384         3087 return @ret;
358             }
359              
360             # Ported from SAMBA/source/libsmb/smbdes.c:str_to_key
361             sub str_to_key {
362 12     12 0 41 my ( @str ) = @_;
363 12         17 my ( $i, @key );
364 12 100       26 @str = map { $_?$_:0 } @str;
  84         740  
365 12         28 $key[0] = $str[0]>>1;
366 12         62 $key[1] = (($str[0]&0x01)<<6) | ($str[1]>>2);
367 12         22 $key[2] = (($str[1]&0x03)<<5) | ($str[2]>>3);
368 12         23 $key[3] = (($str[2]&0x07)<<4) | ($str[3]>>4);
369 12         20 $key[4] = (($str[3]&0x0F)<<3) | ($str[4]>>5);
370 12         24 $key[5] = (($str[4]&0x1F)<<2) | ($str[5]>>6);
371 12         24 $key[6] = (($str[5]&0x3F)<<1) | ($str[6]>>7);
372 12         24 $key[7] = $str[6]&0x7F;
373 12         29 for $i (0..7) {
374 96         137 $key[$i] = ($key[$i]<<1);
375             }
376 12         47 return @key;
377             }
378             # Ported from SAMBA/source/libsmb/smbdes.c:permute
379             # Would probably be better to pass in by reference
380             sub permute {
381 612     612 0 3823 my ( @a ) = @_;
382 612         571 my ( $i, $n, @in, @p, @out );
383              
384             # Last argument is the count of the perm values
385 612         698 $n = $a[$#a];
386 612         3784 @in = @a[0..($#a-$n-1)];
387 612         4673 @p = @_[($#a-$n)..($#a-1)];
388              
389 612         1563 for $i ( 0..($n-1) ) {
390 26784 100       42143 $out[$i] = $in[$p[$i]-1]?1:0;
391             }
392 612         6917 return @out;
393             }
394              
395             # Ported from SAMBA/source/libsmb/smbdes.c:lshift
396             # Lazy shifting =)
397             sub lshift {
398 384     384 0 1093 my ( $count, @d ) = @_;
399 384         440 $count %= ($#d+1);
400 384         2269 @d = (@d,@d)[$count..($#d+$count)];
401 384         3492 return @d;
402             }
403              
404             # Ported from SAMBA/source/libsmb/smbdes.c:dohash
405             sub dohash {
406 12     12 0 113 my ( @a ) = @_;
407 12         15 my ( @in, @key, $forw, @pk1, @c, @d, @ki, @cd, $i, @pd1, @l, @r, @rl, @out );
408              
409 12         164 @in = @a[0..63];
410 12         123 @key = @a[64..($#_-1)];
411 12         38 $forw = $a[$#a];
412              
413 12         62 @pk1 = permute( @key, @perm1, 56 );
414              
415 12         62 @c = @pk1[0..27];
416 12         51 @d = @pk1[28..55];
417              
418 12         22 for $i ( 0..15 ) {
419 192         551 @c = lshift( $sc[$i], @c );
420 192         622 @d = lshift( $sc[$i], @d );
421            
422 192 100       490 @cd = map { $_?1:0 } ( @c, @d );
  10752         16878  
423 192         1022 $ki[$i] = [ permute( @cd, @perm2, 48 ) ];
424             }
425              
426 12         75 @pd1 = permute( @in, @perm3, 64 );
427              
428 12         75 @l = @pd1[0..31];
429 12         44 @r = @pd1[32..63];
430              
431 12         23 for $i ( 0..15 ) {
432 192         210 my ( $j, $k, @b, @er, @erk, @cb, @pcb, @r2 );
433 192         469 @er = permute( @r, @perm4, 48 );
434 192 50       497 @erk = mxor(@er, @{ @ki[$forw?$i:(15-$i)] });
  192         686  
435              
436 192         638 for $j ( 0..7 ) {
437 1536         1805 for $k ( 0..5 ) {
438 9216         16063 $b[$j][$k] = $erk[$j*6 + $k];
439             }
440             }
441 192         264 for $j ( 0..7 ) {
442 1536         1515 my ( $m, $n );
443 1536         2074 $m = ($b[$j][0]<<1) | $b[$j][5];
444 1536         2489 $n = ($b[$j][1]<<3) | ($b[$j][2]<<2) | ($b[$j][3]<<1) | $b[$j][4];
445              
446 1536         2132 for $k ( 0..3 ) {
447 6144 100       14641 $b[$j][$k]=($sbox[$j][$m][$n] & (1<<(3-$k)))?1:0;
448             }
449             }
450 192         283 for $j ( 0..7 ) {
451 1536         1979 for $k ( 0..3 ) {
452 6144         8451 $cb[$j*4+$k]=$b[$j][$k];
453             }
454             }
455 192         610 @pcb = permute( @cb, @perm5, 32);
456 192         574 @r2 = mxor(@l,@pcb);
457 192         1180 @l = @r[0..31];
458 192         2369 @r = @r2[0..31];
459             }
460 12         84 @rl = ( @r, @l );
461 12         54 @out = permute( @rl, @perm6, 64 );
462 12         545 return @out;
463             }
464              
465             # Ported from SAMBA/source/libsmb/smbdes.c:smbhash
466             sub smbhash{
467 12     12 0 18 my ( @in, @key, $forw, @outb, @out, @inb, @keyb, @key2, $i );
468 12         44 @in = @_[0..7];
469 12         36 @key = @_[8..14];
470 12         20 $forw = $_[$#_];
471              
472 12         42 @key2 = str_to_key(@key);
473              
474 12         29 for $i ( 0..63 ) {
475 768 100       1679 $inb[$i] = ( $in[$i/8] & (1<<(7-($i%8)))) ? 1:0;
476 768 100       1338 $keyb[$i] = ( $key2[$i/8] & (1<<(7-($i%8)))) ? 1:0;
477 768         891 $outb[$i] = 0;
478             }
479 12         66 @outb = dohash(@inb,@keyb,$forw);
480 12         64 for $i ( 0..7 ) {
481 96         117 $out[$i] = 0;
482             }
483 12         20 for $i ( 0..64 ) {
484 780 100       1250 if ( $outb[$i] ) {
485 370         745 $out[$i/8] |= (1<<(7-($i%8)));
486             }
487             }
488 12         141 return @out;
489             }
490              
491             # Ported from SAMBA/source/libsmb/smbdes.c:E_P16
492             sub E_P16 {
493 6     6 0 10 my ( @p16, @p14, @sp8 );
494 6         16 @p16 = map { 0 } (1..16);
  96         155  
495 6         30 @p14 = unpack("C*",$_[0]);
496 6         15 @sp8 = ( 0x4b, 0x47, 0x53, 0x21, 0x40, 0x23, 0x24, 0x25 );
497 6         24 @p16 = (smbhash(@sp8,@p14[0..6],1),smbhash(@sp8,@p14[7..13],1));
498 6         43 return @p16;
499             }
500              
501             sub E_P24 {
502 0     0 0   my ( @p21, @c8, @p24 );
503 0           @p21 = @_[0..20]; @c8 = @_[21..28]; @p24 = ();
  0            
  0            
504              
505 0           push @p24, smbhash( @c8, @p21[ 0.. 6], 1 );
506 0           push @p24, smbhash( @c8, @p21[ 7..13], 1 );
507 0           push @p24, smbhash( @c8, @p21[14..20], 1 );
508 0           return @p24;
509             }
510              
511             sub SMBNTencrypt {
512 0     0 0   my ( $password, $key ) = @_;
513 0           my ( $digest, @p21, @c8, @p24, $ret );
514              
515 0           @c8 = unpack("C*",$key);
516 0           $digest = nthash( $password );
517 0           @p21 = map {hex($_)} ($digest =~ /(..)/g);
  0            
518 0           @p24 = E_P24( @p21[0..20], @c8 );
519 0           $ret = join("", map { chr($_) } @p24 );
  0            
520 0           return $ret;
521             }
522              
523             1;
524              
525             __END__