samba/smbhash.pl

   1 #
   2 # Samba LM/NT Hash Generating Library.
   3 # Slightly modified to fit in with Webmin
   4 #
   5 # Copyright(C) 2001 Benjamin Kuit <bj@it.uts.edu.au>
   6 #
   7
   8 # Works out if local system has the module Digest::MD4, and uses it
   9 # if it does, otherwise uses ported version of the md4 algorithm
  10 # Performance is alot better with Digest::MD4, so its recommended to
  11 # get Digest::MD4 installed if you intend to generate alot of hashes
  12 # in a small amount of time.
  13 my $HaveDigestMD4;
  14
  15 BEGIN {
  16         $HaveDigestMD4 = 0;
  17         if ( eval "require 'Digest/MD4.pm';" ) {
  18                 $HaveDigestMD4 = 1;
  19         }
  20 }
  21
  22 # lmhash PASSWORD
  23 # Generates lanman password hash for a given password, returns the hash
  24 #
  25 # Extracted and ported from SAMBA/source/libsmb/smbencrypt.c:nt_lm_owf_gen
  26 sub lmhash($) {
  27         my ( $pass ) = @_;
  28         my ( @p16 );
  29
  30         $pass = substr($pass||"",0,129);
  31         $pass =~ tr/a-z/A-Z/;
  32         $pass = substr($pass,0,14);
  33         @p16 = E_P16($pass);
  34         return join("", map {sprintf("%02X",$_);} @p16);
  35 }
  36
  37 # nthash PASSWORD
  38 # Generates nt md4 password hash for a given password, returns the hash
  39 #
  40 # Extracted and ported from SAMBA/source/libsmb/smbencrypt.c:nt_lm_owf_gen
  41 sub nthash($) {
  42         my ( $pass ) = @_;
  43         my ( $hex );
  44         my ( $digest );
  45         $pass = substr($pass||"",0,128);
  46         $pass =~ s/(.)/$1\000/sg;
  47         $hex = "";
  48         if ( $HaveDigestMD4 ) {
  49                 eval {
  50                         $digest = new Digest::MD4;
  51                         $digest->reset();
  52                         $digest->add($pass);
  53                         $hex = $digest->hexdigest();
  54                         $hex =~ tr/a-z/A-Z/;
  55                 };
  56                 $HaveDigestMD4 = 0 unless ( $hex );
  57         }
  58         $hex = sprintf("%02X"x16,mdfour($pass)) unless ( $hex );
  59         return $hex;
  60 }
  61
  62 # ntlmgen PASSWORD, LMHASH, NTHASH
  63 # Generate lanman and nt md4 password hash for given password, and assigns
  64 # values to arguments. Combined function of lmhash and nthash
  65 sub ntlmgen {
  66         my ( $nthash, $lmhash );
  67         $nthash = nthash($_[0]);
  68         $lmhash = lmhash($_[0]);
  69         if ( $#_ == 2 ) {
  70                 $_[1] = $lmhash;
  71                 $_[2] = $nthash;
  72         }
  73         return ( $lmhash, $nthash );
  74 }
  75
  76 # Support functions
  77 # Ported from SAMBA/source/lib/md4.c:F,G and H respectfully
  78 sub F { my ( $X, $Y, $Z ) = @_; return ($X&$Y) | ((~$X)&$Z); }
  79 sub G { my ( $X, $Y, $Z) = @_; return ($X&$Y) | ($X&$Z) | ($Y&$Z); }
  80 sub H { my ($X, $Y, $Z) = @_; return $X^$Y^$Z; }
  81
  82 # Needed? because perl seems to choke on overflowing when doing bitwise
  83 # operations on numbers larger than 32 bits. Well, it did on my machine =)
  84 sub add32 {
  85         my ( @v ) = @_;
  86         my ( $ret, @sum );
  87         foreach ( @v ) {
  88                 $_ = [ ($_&0xffff0000)>>16, ($_&0xffff) ];
  89         }
  90         @sum = ();
  91         foreach ( @v ) {
  92                 $sum[0] += $_->[0];
  93                 $sum[1] += $_->[1];
  94         }
  95         $sum[0] += ($sum[1]&0xffff0000)>>16;
  96         $sum[1] &= 0xffff;
  97         $sum[0] &= 0xffff;
  98         $ret = ($sum[0]<<16) | $sum[1];
  99         return $ret;
 100 }
 101 # Ported from SAMBA/source/lib/md4.c:lshift
 102 # Renamed to prevent clash with SAMBA/source/libsmb/smbdes.c:lshift
 103 sub md4lshift {
 104         my ($x, $s) = @_;
 105         $x &= 0xFFFFFFFF;
 106         return (($x<<$s)&0xFFFFFFFF) | ($x>>(32-$s));
 107 }
 108 # Ported from SAMBA/source/lib/md4.c:ROUND1
 109 sub ROUND1 {
 110         my($a,$b,$c,$d,$k,$s,@X) = @_;
 111         $_[0] = md4lshift(add32($a,F($b,$c,$d),$X[$k]), $s);
 112         return $_[0];
 113 }
 114 # Ported from SAMBA/source/lib/md4.c:ROUND2
 115 sub ROUND2 {
 116         my ($a,$b,$c,$d,$k,$s,@X) = @_;
 117         $_[0] = md4lshift(add32($a,G($b,$c,$d),$X[$k],0x5A827999), $s);
 118         return $_[0];
 119 }
 120 # Ported from SAMBA/source/lib/md4.c:ROUND3
 121 sub ROUND3 {
 122         my ($a,$b,$c,$d,$k,$s,@X) = @_;
 123         $_[0] = md4lshift(add32($a,H($b,$c,$d),$X[$k],0x6ED9EBA1), $s);
 124         return $_[0];
 125 }
 126 # Ported from SAMBA/source/lib/md4.c:mdfour64
 127 sub mdfour64 {
 128         my ( $A, $B, $C, $D, @M ) = @_;
 129         my ( $AA, $BB, $CC, $DD );
 130         my ( @X );
 131         @X = (map { $_?$_:0 } @M)[0..15];
 132         $AA=$A; $BB=$B; $CC=$C; $DD=$D;
 133         ROUND1($A,$B,$C,$D,  0,  3, @X);  ROUND1($D,$A,$B,$C,  1,  7, @X);
 134         ROUND1($C,$D,$A,$B,  2, 11, @X);  ROUND1($B,$C,$D,$A,  3, 19, @X);
 135         ROUND1($A,$B,$C,$D,  4,  3, @X);  ROUND1($D,$A,$B,$C,  5,  7, @X);
 136         ROUND1($C,$D,$A,$B,  6, 11, @X);  ROUND1($B,$C,$D,$A,  7, 19, @X);
 137         ROUND1($A,$B,$C,$D,  8,  3, @X);  ROUND1($D,$A,$B,$C,  9,  7, @X);
 138         ROUND1($C,$D,$A,$B, 10, 11, @X);  ROUND1($B,$C,$D,$A, 11, 19, @X);
 139         ROUND1($A,$B,$C,$D, 12,  3, @X);  ROUND1($D,$A,$B,$C, 13,  7, @X);
 140         ROUND1($C,$D,$A,$B, 14, 11, @X);  ROUND1($B,$C,$D,$A, 15, 19, @X);
 141         ROUND2($A,$B,$C,$D,  0,  3, @X);  ROUND2($D,$A,$B,$C,  4,  5, @X);
 142         ROUND2($C,$D,$A,$B,  8,  9, @X);  ROUND2($B,$C,$D,$A, 12, 13, @X);
 143         ROUND2($A,$B,$C,$D,  1,  3, @X);  ROUND2($D,$A,$B,$C,  5,  5, @X);
 144         ROUND2($C,$D,$A,$B,  9,  9, @X);  ROUND2($B,$C,$D,$A, 13, 13, @X);
 145         ROUND2($A,$B,$C,$D,  2,  3, @X);  ROUND2($D,$A,$B,$C,  6,  5, @X);
 146         ROUND2($C,$D,$A,$B, 10,  9, @X);  ROUND2($B,$C,$D,$A, 14, 13, @X);
 147         ROUND2($A,$B,$C,$D,  3,  3, @X);  ROUND2($D,$A,$B,$C,  7,  5, @X);
 148         ROUND2($C,$D,$A,$B, 11,  9, @X);  ROUND2($B,$C,$D,$A, 15, 13, @X);
 149         ROUND3($A,$B,$C,$D,  0,  3, @X);  ROUND3($D,$A,$B,$C,  8,  9, @X);
 150         ROUND3($C,$D,$A,$B,  4, 11, @X);  ROUND3($B,$C,$D,$A, 12, 15, @X);
 151         ROUND3($A,$B,$C,$D,  2,  3, @X);  ROUND3($D,$A,$B,$C, 10,  9, @X);
 152         ROUND3($C,$D,$A,$B,  6, 11, @X);  ROUND3($B,$C,$D,$A, 14, 15, @X);
 153         ROUND3($A,$B,$C,$D,  1,  3, @X);  ROUND3($D,$A,$B,$C,  9,  9, @X);
 154         ROUND3($C,$D,$A,$B,  5, 11, @X);  ROUND3($B,$C,$D,$A, 13, 15, @X);
 155         ROUND3($A,$B,$C,$D,  3,  3, @X);  ROUND3($D,$A,$B,$C, 11,  9, @X);
 156         ROUND3($C,$D,$A,$B,  7, 11, @X);  ROUND3($B,$C,$D,$A, 15, 15, @X);
 157         # We want to change the arguments, so assign them to $_[0] markers
 158         # rather than to $A..$D
 159         $_[0] = add32($A,$AA); $_[1] = add32($B,$BB);
 160         $_[2] = add32($C,$CC); $_[3] = add32($D,$DD);
 161         @X = map { 0 } (1..16);
 162 }
 163
 164 # Ported from SAMBA/source/lib/md4.c:copy64
 165 sub copy64 {
 166         my ( @in ) = @_;
 167         my ( $i, @M );
 168         for $i ( 0..15 ) {
 169                 $M[$i] = ($in[$i*4+3]<<24) | ($in[$i*4+2]<<16) |
 170                         ($in[$i*4+1]<<8) | ($in[$i*4+0]<<0);
 171         }
 172         return @M;
 173 }
 174 # Ported from SAMBA/source/lib/md4.c:copy4
 175 sub copy4 {
 176         my ( $x ) = @_;
 177         my ( @out );
 178         $out[0] = $x&0xFF;
 179         $out[1] = ($x>>8)&0xFF;
 180         $out[2] = ($x>>16)&0xFF;
 181         $out[3] = ($x>>24)&0xFF;
 182         @out = map { $_?$_:0 } @out;
 183         return @out;
 184 }
 185 # Ported from SAMBA/source/lib/md4.c:mdfour
 186 sub mdfour {
 187         my ( @in ) = unpack("C*",$_[0]);
 188         my ( $b, @A, @M, @buf, @out );
 189         $b = scalar @in * 8;
 190         @A = ( 0x67452301, 0xefcdab89, 0x98badcfe, 0x10325476 );
 191         while (scalar @in > 64 ) {
 192                 @M = copy64( @in );
 193                 mdfour64( @A, @M );
 194                 @in = @in[64..$#in];
 195         }
 196         @buf = ( @in, 0x80, map {0} (1..128) )[0..127];
 197         if ( scalar @in <= 55 ) {
 198                 @buf[56..59] = copy4( $b );
 199                 @M = copy64( @buf );
 200                 mdfour64( @A, @M );
 201         }
 202         else {
 203                 @buf[120..123] = copy4( $b );
 204                 @M = copy64( @buf );
 205                 mdfour64( @A, @M );
 206                 @M = copy64( @buf[64..$#buf] );
 207                 mdfour64( @A, @M );
 208         }
 209         @out[0..3] = copy4($A[0]);
 210         @out[4..7] = copy4($A[1]);
 211         @out[8..11] = copy4($A[2]);
 212         @out[12..15] = copy4($A[3]);
 213         return @out;
 214 }
 215 # Contants used in lanlam hash calculations
 216 # Ported from SAMBA/source/libsmb/smbdes.c:perm1[56]
 217 my @perm1 = (57, 49, 41, 33, 25, 17,  9,
 218               1, 58, 50, 42, 34, 26, 18,
 219              10,  2, 59, 51, 43, 35, 27,
 220              19, 11,  3, 60, 52, 44, 36,
 221              63, 55, 47, 39, 31, 23, 15,
 222               7, 62, 54, 46, 38, 30, 22,
 223              14,  6, 61, 53, 45, 37, 29,
 224              21, 13,  5, 28, 20, 12,  4);
 225 # Ported from SAMBA/source/libsmb/smbdes.c:perm2[48]
 226 my @perm2 = (14, 17, 11, 24,  1,  5,
 227               3, 28, 15,  6, 21, 10,
 228              23, 19, 12,  4, 26,  8,
 229              16,  7, 27, 20, 13,  2,
 230              41, 52, 31, 37, 47, 55,
 231              30, 40, 51, 45, 33, 48,
 232              44, 49, 39, 56, 34, 53,
 233              46, 42, 50, 36, 29, 32);
 234 # Ported from SAMBA/source/libsmb/smbdes.c:perm3[64]
 235 my @perm3 = (58, 50, 42, 34, 26, 18, 10,  2,
 236              60, 52, 44, 36, 28, 20, 12,  4,
 237              62, 54, 46, 38, 30, 22, 14,  6,
 238              64, 56, 48, 40, 32, 24, 16,  8,
 239              57, 49, 41, 33, 25, 17,  9,  1,
 240              59, 51, 43, 35, 27, 19, 11,  3,
 241              61, 53, 45, 37, 29, 21, 13,  5,
 242              63, 55, 47, 39, 31, 23, 15,  7);
 243 # Ported from SAMBA/source/libsmb/smbdes.c:perm4[48]
 244 my @perm4 = (   32,  1,  2,  3,  4,  5,
 245                  4,  5,  6,  7,  8,  9,
 246                  8,  9, 10, 11, 12, 13,
 247                 12, 13, 14, 15, 16, 17,
 248                 16, 17, 18, 19, 20, 21,
 249                 20, 21, 22, 23, 24, 25,
 250                 24, 25, 26, 27, 28, 29,
 251                 28, 29, 30, 31, 32,  1);
 252 # Ported from SAMBA/source/libsmb/smbdes.c:perm5[32]
 253 my @perm5 = (      16,  7, 20, 21,
 254                    29, 12, 28, 17,
 255                     1, 15, 23, 26,
 256                     5, 18, 31, 10,
 257                     2,  8, 24, 14,
 258                    32, 27,  3,  9,
 259                    19, 13, 30,  6,
 260                    22, 11,  4, 25);
 261 # Ported from SAMBA/source/libsmb/smbdes.c:perm6[64]
 262 my @perm6 =( 40,  8, 48, 16, 56, 24, 64, 32,
 263              39,  7, 47, 15, 55, 23, 63, 31,
 264              38,  6, 46, 14, 54, 22, 62, 30,
 265              37,  5, 45, 13, 53, 21, 61, 29,
 266              36,  4, 44, 12, 52, 20, 60, 28,
 267              35,  3, 43, 11, 51, 19, 59, 27,
 268              34,  2, 42, 10, 50, 18, 58, 26,
 269              33,  1, 41,  9, 49, 17, 57, 25);
 270 # Ported from SAMBA/source/libsmb/smbdes.c:sc[16]
 271 my @sc = (1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 1);
 272 # Ported from SAMBA/source/libsmb/smbdes.c:sbox[8][4][16]
 273 # Side note, I used cut and paste for all these numbers, I did NOT
 274 # type them all in =)
 275 my @sbox = ([[14,  4, 13,  1,  2, 15, 11,  8,  3, 10,  6, 12,  5,  9,  0,  7],
 276              [ 0, 15,  7,  4, 14,  2, 13,  1, 10,  6, 12, 11,  9,  5,  3,  8],
 277              [ 4,  1, 14,  8, 13,  6,  2, 11, 15, 12,  9,  7,  3, 10,  5,  0],
 278              [15, 12,  8,  2,  4,  9,  1,  7,  5, 11,  3, 14, 10,  0,  6, 13]],
 279             [[15,  1,  8, 14,  6, 11,  3,  4,  9,  7,  2, 13, 12,  0,  5, 10],
 280              [ 3, 13,  4,  7, 15,  2,  8, 14, 12,  0,  1, 10,  6,  9, 11,  5],
 281              [ 0, 14,  7, 11, 10,  4, 13,  1,  5,  8, 12,  6,  9,  3,  2, 15],
 282              [13,  8, 10,  1,  3, 15,  4,  2, 11,  6,  7, 12,  0,  5, 14,  9]],
 283             [[10,  0,  9, 14,  6,  3, 15,  5,  1, 13, 12,  7, 11,  4,  2,  8],
 284              [13,  7,  0,  9,  3,  4,  6, 10,  2,  8,  5, 14, 12, 11, 15,  1],
 285              [13,  6,  4,  9,  8, 15,  3,  0, 11,  1,  2, 12,  5, 10, 14,  7],
 286              [ 1, 10, 13,  0,  6,  9,  8,  7,  4, 15, 14,  3, 11,  5,  2, 12]],
 287             [[ 7, 13, 14,  3,  0,  6,  9, 10,  1,  2,  8,  5, 11, 12,  4, 15],
 288              [13,  8, 11,  5,  6, 15,  0,  3,  4,  7,  2, 12,  1, 10, 14,  9],
 289              [10,  6,  9,  0, 12, 11,  7, 13, 15,  1,  3, 14,  5,  2,  8,  4],
 290              [ 3, 15,  0,  6, 10,  1, 13,  8,  9,  4,  5, 11, 12,  7,  2, 14]],
 291             [[ 2, 12,  4,  1,  7, 10, 11,  6,  8,  5,  3, 15, 13,  0, 14,  9],
 292              [14, 11,  2, 12,  4,  7, 13,  1,  5,  0, 15, 10,  3,  9,  8,  6],
 293              [ 4,  2,  1, 11, 10, 13,  7,  8, 15,  9, 12,  5,  6,  3,  0, 14],
 294              [11,  8, 12,  7,  1, 14,  2, 13,  6, 15,  0,  9, 10,  4,  5,  3]],
 295             [[12,  1, 10, 15,  9,  2,  6,  8,  0, 13,  3,  4, 14,  7,  5, 11],
 296              [10, 15,  4,  2,  7, 12,  9,  5,  6,  1, 13, 14,  0, 11,  3,  8],
 297              [ 9, 14, 15,  5,  2,  8, 12,  3,  7,  0,  4, 10,  1, 13, 11,  6],
 298              [ 4,  3,  2, 12,  9,  5, 15, 10, 11, 14,  1,  7,  6,  0,  8, 13]],
 299             [[ 4, 11,  2, 14, 15,  0,  8, 13,  3, 12,  9,  7,  5, 10,  6,  1],
 300              [13,  0, 11,  7,  4,  9,  1, 10, 14,  3,  5, 12,  2, 15,  8,  6],
 301              [ 1,  4, 11, 13, 12,  3,  7, 14, 10, 15,  6,  8,  0,  5,  9,  2],
 302              [ 6, 11, 13,  8,  1,  4, 10,  7,  9,  5,  0, 15, 14,  2,  3, 12]],
 303             [[13,  2,  8,  4,  6, 15, 11,  1, 10,  9,  3, 14,  5,  0, 12,  7],
 304              [ 1, 15, 13,  8, 10,  3,  7,  4, 12,  5,  6, 11,  0, 14,  9,  2],
 305              [ 7, 11,  4,  1,  9, 12, 14,  2,  0,  6, 10, 13, 15,  3,  5,  8],
 306              [ 2,  1, 14,  7,  4, 10,  8, 13, 15, 12,  9,  0,  3,  5,  6, 11]]);
 307
 308 # Ported from SAMBA/source/libsmb/smbdes.c:xor
 309 # Hack: Split arguments in half and then xor's first half of arguments to
 310 # second half of arguments. Probably proper way of doing this would
 311 # be to used referenced variables
 312 sub mxor {
 313         my ( @in ) = @_;
 314         my ( $i, $off, @ret );
 315         $off = int($#in/2);
 316         for $i ( 0..$off ) {
 317                 $ret[$i] = $in[$i] ^ $in[$i+$off+1];
 318         }
 319         return @ret;
 320 }
 321
 322 # Ported from SAMBA/source/libsmb/smbdes.c:str_to_key
 323 sub str_to_key {
 324         my ( @str ) = @_;
 325         my ( $i, @key );
 326         @str = map { $_?$_:0 } @str;
 327         $key[0] = $str[0]>>1;
 328         $key[1] = (($str[0]&0x01)<<6) | ($str[1]>>2);
 329         $key[2] = (($str[1]&0x03)<<5) | ($str[2]>>3);
 330         $key[3] = (($str[2]&0x07)<<4) | ($str[3]>>4);
 331         $key[4] = (($str[3]&0x0F)<<3) | ($str[4]>>5);
 332         $key[5] = (($str[4]&0x1F)<<2) | ($str[5]>>6);
 333         $key[6] = (($str[5]&0x3F)<<1) | ($str[6]>>7);
 334         $key[7] = $str[6]&0x7F;
 335         for $i (0..7) {
 336                 $key[$i] = ($key[$i]<<1);
 337         }
 338         return @key;
 339 }
 340 # Ported from SAMBA/source/libsmb/smbdes.c:permute
 341 # Would probably be better to pass in by reference
 342 sub permute {
 343         my ( @a ) = @_;
 344         my ( $i, $n, @in, @p, @out );
 345
 346         # Last argument is the count of the perm values
 347         $n = $a[$#a];
 348         @in = @a[0..($#a-$n-1)];
 349         @p = @_[($#a-$n)..($#a-1)];
 350
 351         for $i ( 0..($n-1) ) {
 352                 $out[$i] = $in[$p[$i]-1]?1:0;
 353         }
 354         return @out;
 355 }
 356
 357 # Ported from SAMBA/source/libsmb/smbdes.c:lshift
 358 # Lazy shifting =)
 359 sub lshift {
 360         my ( $count, @d ) = @_;
 361         $count %= ($#d+1);
 362         @d = (@d,@d)[$count..($#d+$count)];
 363         return @d;
 364 }
 365
 366 # Ported from SAMBA/source/libsmb/smbdes.c:dohash
 367 sub dohash {
 368         my ( @a ) = @_;
 369         my ( @in, @key, $forw, @pk1, @c, @d, @ki, @cd, $i, @pd1, @l, @r, @rl, @out );
 370
 371         @in = @a[0..63];
 372         @key = @a[64..($#_-1)];
 373         $forw = $a[$#a];
 374
 375         @pk1 = permute( @key, @perm1, 56 );
 376
 377         @c = @pk1[0..27];
 378         @d = @pk1[28..55];
 379
 380         for $i ( 0..15 ) {
 381                 @c = lshift( $sc[$i], @c );
 382                 @d = lshift( $sc[$i], @d );
 383
 384                 @cd = map { $_?1:0 } ( @c, @d );
 385                 $ki[$i] = [ permute( @cd, @perm2, 48 ) ];
 386         }
 387
 388         @pd1 = permute( @in, @perm3, 64 );
 389
 390         @l = @pd1[0..31];
 391         @r = @pd1[32..63];
 392
 393         for $i ( 0..15 ) {
 394                 my ( $j, $k, @b, @er, @erk, @cb, @pcb, @r2 );
 395                 @er = permute( @r, @perm4, 48 );
 396                 @erk = mxor(@er, @{ @ki[$forw?$i:(15-$i)] });
 397
 398                 for $j ( 0..7 ) {
 399                         for $k ( 0..5 ) {
 400                                 $b[$j][$k] = $erk[$j*6 + $k];
 401                         }
 402                 }
 403                 for $j ( 0..7 ) {
 404                         my ( $m, $n );
 405                         $m = ($b[$j][0]<<1) | $b[$j][5];
 406                         $n = ($b[$j][1]<<3) | ($b[$j][2]<<2) | ($b[$j][3]<<1) | $b[$j][4];
 407
 408                         for $k ( 0..3 ) {
 409                                 $b[$j][$k]=($sbox[$j][$m][$n] & (1<<(3-$k)))?1:0;
 410                         }
 411                 }
 412                 for $j ( 0..7 ) {
 413                         for $k ( 0..3 ) {
 414                                 $cb[$j*4+$k]=$b[$j][$k];
 415                         }
 416                 }
 417                 @pcb = permute( @cb, @perm5, 32);
 418                 @r2 = mxor(@l,@pcb);
 419                 @l = @r[0..31];
 420                 @r = @r2[0..31];
 421         }
 422         @rl = ( @r, @l );
 423         @out = permute( @rl, @perm6, 64 );
 424         return @out;
 425 }
 426
 427 # Ported from SAMBA/source/libsmb/smbdes.c:smbhash
 428 sub smbhash{
 429         my ( @in, @key, $forw, @outb, @out, @inb, @keyb, @key2, $i );
 430         @in = @_[0..7];
 431         @key = @_[8..14];
 432         $forw = $_[$#_];
 433
 434         @key2 = str_to_key(@key);
 435
 436         for $i ( 0..63 ) {
 437                 $inb[$i] = ( $in[$i/8] & (1<<(7-($i%8)))) ? 1:0;
 438                 $keyb[$i] = ( $key2[$i/8] & (1<<(7-($i%8)))) ? 1:0;
 439                 $outb[$i] = 0;
 440         }
 441         @outb = dohash(@inb,@keyb,$forw);
 442         for $i ( 0..7 ) {
 443                 $out[$i] = 0;
 444         }
 445         for $i ( 0..64 ) {
 446                 if ( $outb[$i] )  {
 447                         $out[$i/8] |= (1<<(7-($i%8)));
 448                 }
 449         }
 450         return @out;
 451 }
 452
 453 # Ported from SAMBA/source/libsmb/smbdes.c:E_P16
 454 sub E_P16 {
 455         my ( @p16, @p14, @sp8 );
 456         @p16 = map { 0 } (1..16);
 457         @p14 = unpack("C*",$_[0]);
 458         @sp8 = ( 0x4b, 0x47, 0x53, 0x21, 0x40, 0x23, 0x24, 0x25 );
 459         @p16 = (smbhash(@sp8,@p14[0..6],1),smbhash(@sp8,@p14[7..13],1));
 460         return @p16;
 461 }
 462
 463 1;
 464
 465 __END__
 466
 467 =head1 NAME
 468
 469 Crypt::SmbHash - Perl-only implementation of lanman and nt md4 hash functions, for use in Samba style smbpasswd entries
 470
 471 =head1 SYNOPSIS
 472
 473   use Crypt::SmbHash;
 474
 475   ntlmgen SCALAR, LMSCALAR, NTSCALAR;
 476
 477 =head1 DESCRIPTION
 478
 479 This module generates Lanman and NT MD4 style password hashes, using
 480 perl-only code for portability. The module aids in the administration
 481 of Samba style systems.
 482
 483 In the Samba distribution, authentication is referred to a private
 484 smbpasswd file. Entries have similar forms to the following:
 485
 486 username:unixuid:LM:NT
 487
 488 Where LM and NT are one-way password hashes of the same password.
 489
 490 ntlmgen generates the hashes given in the first argument, and places
 491 the result in the second and third arguments.
 492
 493 Example:
 494 To generate a smbpasswd entry:
 495
 496    #!/usr/local/bin/perl
 497    use Crypt::SmbHash;
 498    $username = $ARGV[0];
 499    $password = $ARGV[1];
 500    if ( !$password ) {
 501            print "Not enough arguments\n";
 502            print "Usage: $0 username password\n";
 503            exit 1;
 504    }
 505    $uid = (getpwnam($username))[2];
 506    my ($login,undef,$uid) = getpwnam($ARGV[0]);
 507    ntlmgen $password, $lm, $nt;
 508    printf "%s:%d:%s:%s:[%-11s]:LCT-%08X\n", $login, $uid, $lm, $nt, "U", time;
 509
 510
 511 ntlmgen returns returns the hash values in a list context, so the alternative
 512 method of using it is:
 513
 514    ( $lm, $nt ) = ntlmgen $password;
 515
 516 The functions lmhash and nthash are used by ntlmgen to generate the
 517 hashes, and are available when requested:
 518
 519    use Crypt::SmbHash qw(lmhash nthash)
 520    $lm = lmhash($pass);
 521    $nt = nthash($pass);
 522
 523 =head1 MD4
 524
 525 The algorithm used in nthash requires the md4 algorithm. This algorithm
 526 is included in this module for completeness, but because it is written
 527 in all-perl code ( rather than in C ), it's not very quick.
 528
 529 However if you have the Digest::MD4 module installed, Crypt::SmbHash will
 530 try to use that module instead, making it much faster.
 531
 532 A simple test compared calling nthash without Digest::MD4 installed, and
 533 with, this showed that using nthash on a system with Digest::MD4 installed
 534 proved to be over 90 times faster.
 535
 536 =head1 AUTHOR
 537
 538 Ported from Samba by Benjamin Kuit <lt>bj@it.uts.edu.au<gt>.
 539
 540 Samba is Copyright(C) Andrew Tridgell 1997-1998
 541
 542 Because this module is a direct port of code within the Samba
 543 distribution, it follows the same license, that is:
 544
 545    This program is free software; you can redistribute it and/or modify
 546    it under the terms of the GNU General Public License as published by
 547    the Free Software Foundation; either version 2 of the License, or
 548    (at your option) any later version.
 549
 550    This program is distributed in the hope that it will be useful,
 551    but WITHOUT ANY WARRANTY; without even the implied warranty of
 552    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 553    GNU General Public License for more details.
 554
 555 =cut