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 <bj@it.uts.edu.au> 11# 12 13package Crypt::SmbHash; 14use 5.005; 15use strict; 16use Exporter; 17use Carp; 18use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); 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 28my $HaveDigestMD4; 29my $HaveUnicode; 30BEGIN { 31 $HaveDigestMD4 = 0; 32 $HaveUnicode = 0; 33 if ( eval "require 'Digest/MD4.pm';" ) { 34 $HaveDigestMD4 = 1; 35 } 36 if (eval "require Encode;") { 37 import Encode; 38 $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 47sub lmhash($;$) { 48 my ( $pass, $pwenc ) = @_; 49 my ( @p16 ); 50 51 $pass = "" unless defined($pass); 52 $pass = uc($pass); 53 if (!$HaveUnicode) { 54 if (defined($pwenc)) { 55 croak "Encode module not found: no encoding support"; 56 } 57 } 58 else { 59 $pwenc = "iso-8859-1" unless defined($pwenc); 60 $pass = encode($pwenc,$pass); 61 } 62 63 $pass = substr($pass,0,14); 64 @p16 = E_P16($pass); 65 return join("", map {sprintf("%02X",$_);} @p16); 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 72sub nthash($) { 73 my ( $pass ) = @_; 74 my ( $hex ); 75 my ( $digest ); 76 $pass = substr(defined($pass)?$pass:"",0,128); 77 if (!$HaveUnicode) { 78 # No unicode support: do a really broken to ucs2 convert 79 $pass =~ s/(.)/$1\000/sg; 80 } 81 else { 82 $pass = encode('ucs2', $pass); 83 $pass = pack("v*", unpack("n*",$pass)); 84 } 85 $hex = ""; 86 if ( $HaveDigestMD4 ) { 87 eval { 88 $digest = new Digest::MD4; 89 $digest->reset(); 90 $digest->add($pass); 91 $hex = $digest->hexdigest(); 92 $hex =~ tr/a-z/A-Z/; 93 }; 94 $HaveDigestMD4 = 0 unless ( $hex ); 95 } 96 $hex = sprintf("%02X"x16,mdfour($pass)) unless ( $hex ); 97 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 103sub ntlmgen { 104 my ( $nthash, $lmhash ); 105 $nthash = nthash($_[0]); 106 $lmhash = lmhash($_[0]); 107 if ( $#_ == 2 ) { 108 $_[1] = $lmhash; 109 $_[2] = $nthash; 110 } 111 return ( $lmhash, $nthash ); 112} 113 114# Support functions 115# Ported from SAMBA/source/lib/md4.c:F,G and H respectfully 116sub F { my ( $X, $Y, $Z ) = @_; return ($X&$Y) | ((~$X)&$Z); } 117sub G { my ( $X, $Y, $Z) = @_; return ($X&$Y) | ($X&$Z) | ($Y&$Z); } 118sub H { my ($X, $Y, $Z) = @_; return $X^$Y^$Z; } 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 =) 122sub add32 { 123 my ( @v ) = @_; 124 my ( $ret, @sum ); 125 foreach ( @v ) { 126 $_ = [ ($_&0xffff0000)>>16, ($_&0xffff) ]; 127 } 128 @sum = (); 129 foreach ( @v ) { 130 $sum[0] += $_->[0]; 131 $sum[1] += $_->[1]; 132 } 133 $sum[0] += ($sum[1]&0xffff0000)>>16; 134 $sum[1] &= 0xffff; 135 $sum[0] &= 0xffff; 136 $ret = ($sum[0]<<16) | $sum[1]; 137 return $ret; 138} 139# Ported from SAMBA/source/lib/md4.c:lshift 140# Renamed to prevent clash with SAMBA/source/libsmb/smbdes.c:lshift 141sub md4lshift { 142 my ($x, $s) = @_; 143 $x &= 0xFFFFFFFF; 144 return (($x<<$s)&0xFFFFFFFF) | ($x>>(32-$s)); 145} 146# Ported from SAMBA/source/lib/md4.c:ROUND1 147sub ROUND1 { 148 my($a,$b,$c,$d,$k,$s,@X) = @_; 149 $_[0] = md4lshift(add32($a,F($b,$c,$d),$X[$k]), $s); 150 return $_[0]; 151} 152# Ported from SAMBA/source/lib/md4.c:ROUND2 153sub ROUND2 { 154 my ($a,$b,$c,$d,$k,$s,@X) = @_; 155 $_[0] = md4lshift(add32($a,G($b,$c,$d),$X[$k],0x5A827999), $s); 156 return $_[0]; 157} 158# Ported from SAMBA/source/lib/md4.c:ROUND3 159sub ROUND3 { 160 my ($a,$b,$c,$d,$k,$s,@X) = @_; 161 $_[0] = md4lshift(add32($a,H($b,$c,$d),$X[$k],0x6ED9EBA1), $s); 162 return $_[0]; 163} 164# Ported from SAMBA/source/lib/md4.c:mdfour64 165sub mdfour64 { 166 my ( $A, $B, $C, $D, @M ) = @_; 167 my ( $AA, $BB, $CC, $DD ); 168 my ( @X ); 169 @X = (map { $_?$_:0 } @M)[0..15]; 170 $AA=$A; $BB=$B; $CC=$C; $DD=$D; 171 ROUND1($A,$B,$C,$D, 0, 3, @X); ROUND1($D,$A,$B,$C, 1, 7, @X); 172 ROUND1($C,$D,$A,$B, 2, 11, @X); ROUND1($B,$C,$D,$A, 3, 19, @X); 173 ROUND1($A,$B,$C,$D, 4, 3, @X); ROUND1($D,$A,$B,$C, 5, 7, @X); 174 ROUND1($C,$D,$A,$B, 6, 11, @X); ROUND1($B,$C,$D,$A, 7, 19, @X); 175 ROUND1($A,$B,$C,$D, 8, 3, @X); ROUND1($D,$A,$B,$C, 9, 7, @X); 176 ROUND1($C,$D,$A,$B, 10, 11, @X); ROUND1($B,$C,$D,$A, 11, 19, @X); 177 ROUND1($A,$B,$C,$D, 12, 3, @X); ROUND1($D,$A,$B,$C, 13, 7, @X); 178 ROUND1($C,$D,$A,$B, 14, 11, @X); ROUND1($B,$C,$D,$A, 15, 19, @X); 179 ROUND2($A,$B,$C,$D, 0, 3, @X); ROUND2($D,$A,$B,$C, 4, 5, @X); 180 ROUND2($C,$D,$A,$B, 8, 9, @X); ROUND2($B,$C,$D,$A, 12, 13, @X); 181 ROUND2($A,$B,$C,$D, 1, 3, @X); ROUND2($D,$A,$B,$C, 5, 5, @X); 182 ROUND2($C,$D,$A,$B, 9, 9, @X); ROUND2($B,$C,$D,$A, 13, 13, @X); 183 ROUND2($A,$B,$C,$D, 2, 3, @X); ROUND2($D,$A,$B,$C, 6, 5, @X); 184 ROUND2($C,$D,$A,$B, 10, 9, @X); ROUND2($B,$C,$D,$A, 14, 13, @X); 185 ROUND2($A,$B,$C,$D, 3, 3, @X); ROUND2($D,$A,$B,$C, 7, 5, @X); 186 ROUND2($C,$D,$A,$B, 11, 9, @X); ROUND2($B,$C,$D,$A, 15, 13, @X); 187 ROUND3($A,$B,$C,$D, 0, 3, @X); ROUND3($D,$A,$B,$C, 8, 9, @X); 188 ROUND3($C,$D,$A,$B, 4, 11, @X); ROUND3($B,$C,$D,$A, 12, 15, @X); 189 ROUND3($A,$B,$C,$D, 2, 3, @X); ROUND3($D,$A,$B,$C, 10, 9, @X); 190 ROUND3($C,$D,$A,$B, 6, 11, @X); ROUND3($B,$C,$D,$A, 14, 15, @X); 191 ROUND3($A,$B,$C,$D, 1, 3, @X); ROUND3($D,$A,$B,$C, 9, 9, @X); 192 ROUND3($C,$D,$A,$B, 5, 11, @X); ROUND3($B,$C,$D,$A, 13, 15, @X); 193 ROUND3($A,$B,$C,$D, 3, 3, @X); ROUND3($D,$A,$B,$C, 11, 9, @X); 194 ROUND3($C,$D,$A,$B, 7, 11, @X); ROUND3($B,$C,$D,$A, 15, 15, @X); 195 # We want to change the arguments, so assign them to $_[0] markers 196 # rather than to $A..$D 197 $_[0] = add32($A,$AA); $_[1] = add32($B,$BB); 198 $_[2] = add32($C,$CC); $_[3] = add32($D,$DD); 199 @X = map { 0 } (1..16); 200} 201 202# Ported from SAMBA/source/lib/md4.c:copy64 203sub copy64 { 204 my ( @in ) = @_; 205 my ( $i, @M ); 206 for $i ( 0..15 ) { 207 $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 return @M; 211} 212# Ported from SAMBA/source/lib/md4.c:copy4 213sub copy4 { 214 my ( $x ) = @_; 215 my ( @out ); 216 $out[0] = $x&0xFF; 217 $out[1] = ($x>>8)&0xFF; 218 $out[2] = ($x>>16)&0xFF; 219 $out[3] = ($x>>24)&0xFF; 220 @out = map { $_?$_:0 } @out; 221 return @out; 222} 223# Ported from SAMBA/source/lib/md4.c:mdfour 224sub mdfour { 225 my ( @in ) = unpack("C*",$_[0]); 226 my ( $b, @A, @M, @buf, @out ); 227 $b = scalar @in * 8; 228 @A = ( 0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476 ); 229 while (scalar @in > 64 ) { 230 @M = copy64( @in ); 231 mdfour64( @A, @M ); 232 @in = @in[64..$#in]; 233 } 234 @buf = ( @in, 0x80, map {0} (1..128) )[0..127]; 235 if ( scalar @in <= 55 ) { 236 @buf[56..59] = copy4( $b ); 237 @M = copy64( @buf ); 238 mdfour64( @A, @M ); 239 } 240 else { 241 @buf[120..123] = copy4( $b ); 242 @M = copy64( @buf ); 243 mdfour64( @A, @M ); 244 @M = copy64( @buf[64..$#buf] ); 245 mdfour64( @A, @M ); 246 } 247 @out[0..3] = copy4($A[0]); 248 @out[4..7] = copy4($A[1]); 249 @out[8..11] = copy4($A[2]); 250 @out[12..15] = copy4($A[3]); 251 return @out; 252} 253# Contants used in lanlam hash calculations 254# Ported from SAMBA/source/libsmb/smbdes.c:perm1[56] 255my @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] 264my @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] 273my @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] 282my @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] 291my @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] 300my @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] 309my @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 =) 313my @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 350sub mxor { 351 my ( @in ) = @_; 352 my ( $i, $off, @ret ); 353 $off = int($#in/2); 354 for $i ( 0..$off ) { 355 $ret[$i] = $in[$i] ^ $in[$i+$off+1]; 356 } 357 return @ret; 358} 359 360# Ported from SAMBA/source/libsmb/smbdes.c:str_to_key 361sub str_to_key { 362 my ( @str ) = @_; 363 my ( $i, @key ); 364 @str = map { $_?$_:0 } @str; 365 $key[0] = $str[0]>>1; 366 $key[1] = (($str[0]&0x01)<<6) | ($str[1]>>2); 367 $key[2] = (($str[1]&0x03)<<5) | ($str[2]>>3); 368 $key[3] = (($str[2]&0x07)<<4) | ($str[3]>>4); 369 $key[4] = (($str[3]&0x0F)<<3) | ($str[4]>>5); 370 $key[5] = (($str[4]&0x1F)<<2) | ($str[5]>>6); 371 $key[6] = (($str[5]&0x3F)<<1) | ($str[6]>>7); 372 $key[7] = $str[6]&0x7F; 373 for $i (0..7) { 374 $key[$i] = ($key[$i]<<1); 375 } 376 return @key; 377} 378# Ported from SAMBA/source/libsmb/smbdes.c:permute 379# Would probably be better to pass in by reference 380sub permute { 381 my ( @a ) = @_; 382 my ( $i, $n, @in, @p, @out ); 383 384 # Last argument is the count of the perm values 385 $n = $a[$#a]; 386 @in = @a[0..($#a-$n-1)]; 387 @p = @_[($#a-$n)..($#a-1)]; 388 389 for $i ( 0..($n-1) ) { 390 $out[$i] = $in[$p[$i]-1]?1:0; 391 } 392 return @out; 393} 394 395# Ported from SAMBA/source/libsmb/smbdes.c:lshift 396# Lazy shifting =) 397sub lshift { 398 my ( $count, @d ) = @_; 399 $count %= ($#d+1); 400 @d = (@d,@d)[$count..($#d+$count)]; 401 return @d; 402} 403 404# Ported from SAMBA/source/libsmb/smbdes.c:dohash 405sub dohash { 406 my ( @a ) = @_; 407 my ( @in, @key, $forw, @pk1, @c, @d, @ki, @cd, $i, @pd1, @l, @r, @rl, @out ); 408 409 @in = @a[0..63]; 410 @key = @a[64..($#_-1)]; 411 $forw = $a[$#a]; 412 413 @pk1 = permute( @key, @perm1, 56 ); 414 415 @c = @pk1[0..27]; 416 @d = @pk1[28..55]; 417 418 for $i ( 0..15 ) { 419 @c = lshift( $sc[$i], @c ); 420 @d = lshift( $sc[$i], @d ); 421 422 @cd = map { $_?1:0 } ( @c, @d ); 423 $ki[$i] = [ permute( @cd, @perm2, 48 ) ]; 424 } 425 426 @pd1 = permute( @in, @perm3, 64 ); 427 428 @l = @pd1[0..31]; 429 @r = @pd1[32..63]; 430 431 for $i ( 0..15 ) { 432 my ( $j, $k, @b, @er, @erk, @cb, @pcb, @r2 ); 433 @er = permute( @r, @perm4, 48 ); 434 @erk = mxor(@er, @{ @ki[$forw?$i:(15-$i)] }); 435 436 for $j ( 0..7 ) { 437 for $k ( 0..5 ) { 438 $b[$j][$k] = $erk[$j*6 + $k]; 439 } 440 } 441 for $j ( 0..7 ) { 442 my ( $m, $n ); 443 $m = ($b[$j][0]<<1) | $b[$j][5]; 444 $n = ($b[$j][1]<<3) | ($b[$j][2]<<2) | ($b[$j][3]<<1) | $b[$j][4]; 445 446 for $k ( 0..3 ) { 447 $b[$j][$k]=($sbox[$j][$m][$n] & (1<<(3-$k)))?1:0; 448 } 449 } 450 for $j ( 0..7 ) { 451 for $k ( 0..3 ) { 452 $cb[$j*4+$k]=$b[$j][$k]; 453 } 454 } 455 @pcb = permute( @cb, @perm5, 32); 456 @r2 = mxor(@l,@pcb); 457 @l = @r[0..31]; 458 @r = @r2[0..31]; 459 } 460 @rl = ( @r, @l ); 461 @out = permute( @rl, @perm6, 64 ); 462 return @out; 463} 464 465# Ported from SAMBA/source/libsmb/smbdes.c:smbhash 466sub smbhash{ 467 my ( @in, @key, $forw, @outb, @out, @inb, @keyb, @key2, $i ); 468 @in = @_[0..7]; 469 @key = @_[8..14]; 470 $forw = $_[$#_]; 471 472 @key2 = str_to_key(@key); 473 474 for $i ( 0..63 ) { 475 $inb[$i] = ( $in[$i/8] & (1<<(7-($i%8)))) ? 1:0; 476 $keyb[$i] = ( $key2[$i/8] & (1<<(7-($i%8)))) ? 1:0; 477 $outb[$i] = 0; 478 } 479 @outb = dohash(@inb,@keyb,$forw); 480 for $i ( 0..7 ) { 481 $out[$i] = 0; 482 } 483 for $i ( 0..64 ) { 484 if ( $outb[$i] ) { 485 $out[$i/8] |= (1<<(7-($i%8))); 486 } 487 } 488 return @out; 489} 490 491# Ported from SAMBA/source/libsmb/smbdes.c:E_P16 492sub E_P16 { 493 my ( @p16, @p14, @sp8 ); 494 @p16 = map { 0 } (1..16); 495 @p14 = unpack("C*",$_[0]); 496 @sp8 = ( 0x4b, 0x47, 0x53, 0x21, 0x40, 0x23, 0x24, 0x25 ); 497 @p16 = (smbhash(@sp8,@p14[0..6],1),smbhash(@sp8,@p14[7..13],1)); 498 return @p16; 499} 500 501sub E_P24 { 502 my ( @p21, @c8, @p24 ); 503 @p21 = @_[0..20]; @c8 = @_[21..28]; @p24 = (); 504 505 push @p24, smbhash( @c8, @p21[ 0.. 6], 1 ); 506 push @p24, smbhash( @c8, @p21[ 7..13], 1 ); 507 push @p24, smbhash( @c8, @p21[14..20], 1 ); 508 return @p24; 509} 510 511sub SMBNTencrypt { 512 my ( $password, $key ) = @_; 513 my ( $digest, @p21, @c8, @p24, $ret ); 514 515 @c8 = unpack("C*",$key); 516 $digest = nthash( $password ); 517 @p21 = map {hex($_)} ($digest =~ /(..)/g); 518 @p24 = E_P24( @p21[0..20], @c8 ); 519 $ret = join("", map { chr($_) } @p24 ); 520 return $ret; 521} 522 5231; 524 525__END__ 526 527=head1 NAME 528 529Crypt::SmbHash - Perl-only implementation of lanman and nt md4 hash functions, for use in Samba style smbpasswd entries 530 531=head1 SYNOPSIS 532 533 use Crypt::SmbHash; 534 535 ntlmgen SCALAR, LMSCALAR, NTSCALAR; 536 537=head1 DESCRIPTION 538 539This module generates Lanman and NT MD4 style password hashes, using 540perl-only code for portability. The module aids in the administration 541of Samba style systems. 542 543In the Samba distribution, authentication is referred to a private 544smbpasswd file. Entries have similar forms to the following: 545 546username:unixuid:LM:NT 547 548Where LM and NT are one-way password hashes of the same password. 549 550ntlmgen generates the hashes given in the first argument, and places 551the result in the second and third arguments. 552 553Example: 554To generate a smbpasswd entry: 555 556 #!/usr/local/bin/perl 557 use Crypt::SmbHash; 558 $username = $ARGV[0]; 559 $password = $ARGV[1]; 560 if ( !$password ) { 561 print "Not enough arguments\n"; 562 print "Usage: $0 username password\n"; 563 exit 1; 564 } 565 $uid = (getpwnam($username))[2]; 566 my ($login,undef,$uid) = getpwnam($ARGV[0]); 567 ntlmgen $password, $lm, $nt; 568 printf "%s:%d:%s:%s:[%-11s]:LCT-%08X\n", $login, $uid, $lm, $nt, "U", time; 569 570 571ntlmgen returns returns the hash values in a list context, so the alternative 572method of using it is: 573 574 ( $lm, $nt ) = ntlmgen $password; 575 576The functions lmhash and nthash are used by ntlmgen to generate the 577hashes, and are available when requested: 578 579 use Crypt::SmbHash qw(lmhash nthash) 580 $lm = lmhash($pass); 581 $nt = nthash($pass); 582 583If Encoding is available (part of perl-5.8) the $pass argument to 584ntlmgen, lmhash and nthash must be a perl string. In double use this: 585 586 use Crypt::SmbHash qw(ntlmgen lmhash nthash); 587 use Encode; 588 ( $lm, $nt ) = ntlmgen decode('iso-8859-1', $pass); 589 $lm = lmhash(decode_utf8($pass), $pwenc); 590 $nt = nthash(decode_utf8($pass)); 591 592The $pwenc parameter to lmhash() is optional and defaults to 'iso-8859-1'. 593It specifies the encoding to which the password is encoded before hashing. 594 595=head1 MD4 596 597The algorithm used in nthash requires the md4 algorithm. This algorithm 598is included in this module for completeness, but because it is written 599in all-perl code ( rather than in C ), it's not very quick. 600 601However if you have the Digest::MD4 module installed, Crypt::SmbHash will 602try to use that module instead, making it much faster. 603 604A simple test compared calling nthash without Digest::MD4 installed, and 605with, this showed that using nthash on a system with Digest::MD4 installed 606proved to be over 90 times faster. 607 608=head1 AUTHOR 609 610Ported from Samba by Benjamin Kuit <lt>bj@it.uts.edu.au<gt>. 611 612Samba is Copyright(C) Andrew Tridgell 1997-1998 613 614Because this module is a direct port of code within the Samba 615distribution, it follows the same license, that is: 616 617 This program is free software; you can redistribute it and/or modify 618 it under the terms of the GNU General Public License as published by 619 the Free Software Foundation; either version 2 of the License, or 620 (at your option) any later version. 621 622 This program is distributed in the hope that it will be useful, 623 but WITHOUT ANY WARRANTY; without even the implied warranty of 624 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 625 GNU General Public License for more details. 626 627=cut 628