/packages/hash/src/ntlm.pas
https://github.com/slibre/freepascal · Pascal · 373 lines · 276 code · 74 blank · 23 comment · 26 complexity · 18bb5a94e81e72214115b315195405fb MD5 · raw file
- {
- This file is part of the Free Pascal packages.
- Copyright (c) 1999-2006 by the Free Pascal development team
- Implements a NTLM password hash algorithm.
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- unit ntlm;
- {$mode objfpc}
- interface
- uses
- Math, Strings, md5;
- function LMGenerate(const Password: PChar): TMDDigest;
- function NTGenerate(const Password: PChar): TMDDigest;
- implementation
- const
- perm1: array[0..55] of Byte = (
- 57, 49, 41, 33, 25, 17, 9,
- 1, 58, 50, 42, 34, 26, 18,
- 10, 2, 59, 51, 43, 35, 27,
- 19, 11, 3, 60, 52, 44, 36,
- 63, 55, 47, 39, 31, 23, 15,
- 7, 62, 54, 46, 38, 30, 22,
- 14, 6, 61, 53, 45, 37, 29,
- 21, 13, 5, 28, 20, 12, 4);
- perm2: array[0..47] of Byte = (
- 14, 17, 11, 24, 1, 5,
- 3, 28, 15, 6, 21, 10,
- 23, 19, 12, 4, 26, 8,
- 16, 7, 27, 20, 13, 2,
- 41, 52, 31, 37, 47, 55,
- 30, 40, 51, 45, 33, 48,
- 44, 49, 39, 56, 34, 53,
- 46, 42, 50, 36, 29, 32);
- perm3: array[0..63] of Byte = (
- 58, 50, 42, 34, 26, 18, 10, 2,
- 60, 52, 44, 36, 28, 20, 12, 4,
- 62, 54, 46, 38, 30, 22, 14, 6,
- 64, 56, 48, 40, 32, 24, 16, 8,
- 57, 49, 41, 33, 25, 17, 9, 1,
- 59, 51, 43, 35, 27, 19, 11, 3,
- 61, 53, 45, 37, 29, 21, 13, 5,
- 63, 55, 47, 39, 31, 23, 15, 7);
- perm4: array[0..47] of Byte = (
- 32, 1, 2, 3, 4, 5,
- 4, 5, 6, 7, 8, 9,
- 8, 9, 10, 11, 12, 13,
- 12, 13, 14, 15, 16, 17,
- 16, 17, 18, 19, 20, 21,
- 20, 21, 22, 23, 24, 25,
- 24, 25, 26, 27, 28, 29,
- 28, 29, 30, 31, 32, 1);
- perm5: array[0..31] of Byte = (
- 16, 7, 20, 21,
- 29, 12, 28, 17,
- 1, 15, 23, 26,
- 5, 18, 31, 10,
- 2, 8, 24, 14,
- 32, 27, 3, 9,
- 19, 13, 30, 6,
- 22, 11, 4, 25);
- perm6: array[0..63] of Byte = (
- 40, 8, 48, 16, 56, 24, 64, 32,
- 39, 7, 47, 15, 55, 23, 63, 31,
- 38, 6, 46, 14, 54, 22, 62, 30,
- 37, 5, 45, 13, 53, 21, 61, 29,
- 36, 4, 44, 12, 52, 20, 60, 28,
- 35, 3, 43, 11, 51, 19, 59, 27,
- 34, 2, 42, 10, 50, 18, 58, 26,
- 33, 1, 41, 9, 49, 17, 57, 25);
- sc: array[0..15] of Byte = (1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 1);
- sbox: array[0..7, 0..3, 0..15] of Byte = (
- ((14, 4, 13, 1, 2, 15, 11, 8, 3, 10, 6, 12, 5, 9, 0, 7),
- (0, 15, 7, 4, 14, 2, 13, 1, 10, 6, 12, 11, 9, 5, 3, 8),
- (4, 1, 14, 8, 13, 6, 2, 11, 15, 12, 9, 7, 3, 10, 5, 0),
- (15, 12, 8, 2, 4, 9, 1, 7, 5, 11, 3, 14, 10, 0, 6, 13)),
- ((15, 1, 8, 14, 6, 11, 3, 4, 9, 7, 2, 13, 12, 0, 5, 10),
- (3, 13, 4, 7, 15, 2, 8, 14, 12, 0, 1, 10, 6, 9, 11, 5),
- (0, 14, 7, 11, 10, 4, 13, 1, 5, 8, 12, 6, 9, 3, 2, 15),
- (13, 8, 10, 1, 3, 15, 4, 2, 11, 6, 7, 12, 0, 5, 14, 9)),
- ((10, 0, 9, 14, 6, 3, 15, 5, 1, 13, 12, 7, 11, 4, 2, 8),
- (13, 7, 0, 9, 3, 4, 6, 10, 2, 8, 5, 14, 12, 11, 15, 1),
- (13, 6, 4, 9, 8, 15, 3, 0, 11, 1, 2, 12, 5, 10, 14, 7),
- (1, 10, 13, 0, 6, 9, 8, 7, 4, 15, 14, 3, 11, 5, 2, 12)),
- ((7, 13, 14, 3, 0, 6, 9, 10, 1, 2, 8, 5, 11, 12, 4, 15),
- (13, 8, 11, 5, 6, 15, 0, 3, 4, 7, 2, 12, 1, 10, 14, 9),
- (10, 6, 9, 0, 12, 11, 7, 13, 15, 1, 3, 14, 5, 2, 8, 4),
- (3, 15, 0, 6, 10, 1, 13, 8, 9, 4, 5, 11, 12, 7, 2, 14)),
- ((2, 12, 4, 1, 7, 10, 11, 6, 8, 5, 3, 15, 13, 0, 14, 9),
- (14, 11, 2, 12, 4, 7, 13, 1, 5, 0, 15, 10, 3, 9, 8, 6),
- (4, 2, 1, 11, 10, 13, 7, 8, 15, 9, 12, 5, 6, 3, 0, 14),
- (11, 8, 12, 7, 1, 14, 2, 13, 6, 15, 0, 9, 10, 4, 5, 3)),
- ((12, 1, 10, 15, 9, 2, 6, 8, 0, 13, 3, 4, 14, 7, 5, 11),
- (10, 15, 4, 2, 7, 12, 9, 5, 6, 1, 13, 14, 0, 11, 3, 8),
- (9, 14, 15, 5, 2, 8, 12, 3, 7, 0, 4, 10, 1, 13, 11, 6),
- (4, 3, 2, 12, 9, 5, 15, 10, 11, 14, 1, 7, 6, 0, 8, 13)),
- ((4, 11, 2, 14, 15, 0, 8, 13, 3, 12, 9, 7, 5, 10, 6, 1),
- (13, 0, 11, 7, 4, 9, 1, 10, 14, 3, 5, 12, 2, 15, 8, 6),
- (1, 4, 11, 13, 12, 3, 7, 14, 10, 15, 6, 8, 0, 5, 9, 2),
- (6, 11, 13, 8, 1, 4, 10, 7, 9, 5, 0, 15, 14, 2, 3, 12)),
- ((13, 2, 8, 4, 6, 15, 11, 1, 10, 9, 3, 14, 5, 0, 12, 7),
- (1, 15, 13, 8, 10, 3, 7, 4, 12, 5, 6, 11, 0, 14, 9, 2),
- (7, 11, 4, 1, 9, 12, 14, 2, 0, 6, 10, 13, 15, 3, 5, 8),
- (2, 1, 14, 7, 4, 10, 8, 13, 15, 12, 9, 0, 3, 5, 6, 11)));
- procedure permute({out} const _out: PByte; {in} const _in: PByte; {in} const p: PByte; {in} const n: Integer);
- var
- i: Integer;
- begin
- for i := 0 to n-1 do
- _out[i] := _in[p[i]-1];
- end;
- procedure lshift({in/out} const d: PByte; {in} const count: Integer; {in} const n: Integer);
- var
- _out : array[0..63] of Byte;
- i : Integer;
- begin
- for i := 0 to n-1 do
- _out[i] := d[(i+count) mod n];
- for i := 0 to n-1 do
- d[i] := _out[i];
- end;
- procedure concat({out} const _out: PByte; {in} const _in1, _in2: PByte; {in} const l1, l2: Integer);
- var
- i: Integer;
- begin
- for i := 0 to l1-1 do
- _out[i] := _in1[i];
- for i := 0 to l2-1 do
- _out[i+l1] := _in2[i];
- end;
- procedure mxor({out} const _out: PByte; {in} const _in1, _in2: PByte; {in} const n: Integer);
- var
- i: Integer;
- begin
- for i := 0 to n-1 do
- _out[i] := _in1[i] xor _in2[i];
- end;
- procedure dohash({out} const _out: PByte; {in} const _in: PByte; {in} const key: PByte; {in} const forw: Boolean);
- var
- i : Integer;
- j : Integer;
- k : Integer;
- pk1 : array[0..55] of Byte;
- c : array[0..27] of Byte;
- d : array[0..27] of Byte;
- cd : array[0..55] of Byte;
- ki : array[0..15,0..47] of Byte;
- pd1 : array[0..63] of Byte;
- l : array[0..31] of Byte;
- r : array[0..31] of Byte;
- rl : array[0..63] of Byte;
- er : array[0..47] of Byte;
- erk : array[0..47] of Byte;
- b : array[0..7,0..5] of Byte;
- cb : array[0..31] of Byte;
- pcb : array[0..31] of Byte;
- r2 : array[0..31] of Byte;
- m : Integer;
- n : Integer;
- begin
- permute(@pk1[0], key, @perm1[0], 56);
- for i := 0 to 27 do
- begin
- c[i] := pk1[i];
- d[i] := pk1[i+28];
- end;
- for i := 0 to 15 do
- begin
- lshift(@c[0], sc[i], 28);
- lshift(@d[0], sc[i], 28);
- concat(@cd[0], @c[0], @d[0], 28, 28);
- permute(@ki[i][0], @cd[0], @perm2[0], 48);
- end;
- permute(@pd1[0], _in, @perm3[0], 64);
- for i := 0 to 31 do
- begin
- l[i] := pd1[i];
- r[i] := pd1[i+32];
- end;
- for i := 0 to 15 do
- begin
- permute(@er[0], @r[0], @perm4[0], 48);
- if forw then
- mxor(@erk[0], @er[0], @ki[i][0], 48) else
- mxor(@erk[0], @er[0], @ki[15-i][0], 48);
- for j := 0 to 7 do
- for k := 0 to 5 do
- b[j][k] := erk[j*6 + k];
- for j := 0 to 7 do
- begin
- m := (b[j][0] shl 1) or b[j][5];
- n := (b[j][1] shl 3) or (b[j][2] shl 2) or (b[j][3] shl 1) or (b[j][4]);
- for k := 0 to 3 do
- b[j][k] := min(sbox[j][m][n] and (1 shl (3-k)), 1); // store binary
- end;
- for j := 0 to 7 do
- for k := 0 to 3 do
- cb[j*4+k] := b[j][k];
- permute(@pcb[0], @cb[0], @perm5[0], 32);
- mxor(@r2[0], @l[0], @pcb[0], 32);
- for j := 0 to 31 do
- begin
- l[j] := r[j];
- r[j] := r2[j];
- end;
- end;
- concat(@rl[0], @r[0], @l[0], 32, 32);
- permute(_out, @rl[0], @perm6[0], 64);
- end;
- procedure str_to_key({in} const str: PByte; {out} const key: PByte);
- var
- i: Integer;
- begin
- key[0] := str[0] shr 1;
- key[1] := ((str[0] and $01) shl 6) or (str[1] shr 2);
- key[2] := ((str[1] and $03) shl 5) or (str[2] shr 3);
- key[3] := ((str[2] and $07) shl 4) or (str[3] shr 4);
- key[4] := ((str[3] and $0F) shl 3) or (str[4] shr 5);
- key[5] := ((str[4] and $1F) shl 2) or (str[5] shr 6);
- key[6] := ((str[5] and $3F) shl 1) or (str[6] shr 7);
- key[7] := str[6] and $7F;
- for i := 0 to 7 do
- key[i] := key[i] shl 1;
- end;
- procedure smbhash({out} const _out: PByte; {in} const _in: PByte; {in} const key: PByte; {in} const forw: Boolean);
- var
- i : Integer;
- outb : array[0..63] of Byte;
- inb : array[0..63] of Byte;
- keyb : array[0..63] of Byte;
- key2 : array[0..7] of Byte;
- begin
- str_to_key(key, @key2[0]);
- for i := 0 to 63 do
- begin
- inb[i] := min( _in[i div 8] and (1 shl (7-(i mod 8))), 1); // store binary
- keyb[i] := min(key2[i div 8] and (1 shl (7-(i mod 8))), 1); // store binary
- outb[i] := 0;
- end;
- dohash(@outb[0], @inb[0], @keyb[0], forw);
- for i := 0 to 7 do
- _out[I] := 0;
- for i := 0 to 63 do
- begin
- if outb[i] <> 0 then
- _out[i div 8] := _out[i div 8] or (1 shl (7-(i mod 8)));
- end;
- end;
- procedure E_P16({in} const p14: PByte; {out} const p16: PByte);
- const
- sp8: array[0..7] of Byte = ($4b, $47, $53, $21, $40, $23, $24, $25);
- begin
- smbhash(@p16[0], @sp8[0], @p14[0], True);
- smbhash(@p16[8], @sp8[0], @p14[7], True);
- end;
- (*procedure E_P24({in} const p21: PByte; {in} const c8: PByte; {out} const p24: PByte);
- begin
- smbhash(@p24[0], c8, @p21[0], True);
- smbhash(@p24[8], c8, @p21[7], True);
- smbhash(@p24[16], c8, @p21[14], True);
- end;*)
- function LMGenerate(const Password: PChar): TMDDigest;
- var
- dospwd: array[0..14] of Byte;
- begin
- if not Assigned(Password) then
- Exit;
- FillChar(dospwd, Sizeof(dospwd), 0);
- (* Password must be converted to DOS charset - null terminated, uppercase *)
- StrLCopy(PChar(@dospwd[0]), PChar(@Password[0]), SizeOf(dospwd)-1);
- StrUpper(PChar(@dospwd[0]));
- (* Only the first 14 chars are considered, password need not be null terminated *)
- E_P16(@dospwd[0], @Result);
- FillChar(dospwd, Sizeof(dospwd), 0);
- end;
- function NTGenerate(const Password: PChar): TMDDigest;
- var
- pos: Integer;
- wpwd: array[0..127] of WideChar;
- begin
- if not Assigned(Password) then
- Exit;
- pos := 0;
- while (pos < 128) and (Password[pos] <> #0) do
- begin
- wpwd[pos] := Password[pos];
- inc(pos);
- end;
- Result := MDBuffer(wpwd, 2*pos, MD_VERSION_4);
- FillChar(wpwd, Sizeof(wpwd), 0);
- end;
- end.