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