/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

  1. {
  2. This file is part of the Free Pascal packages.
  3. Copyright (c) 1999-2006 by the Free Pascal development team
  4. Implements a NTLM password hash algorithm.
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. unit ntlm;
  12. {$mode objfpc}
  13. interface
  14. uses
  15. Math, Strings, md5;
  16. function LMGenerate(const Password: PChar): TMDDigest;
  17. function NTGenerate(const Password: PChar): TMDDigest;
  18. implementation
  19. const
  20. perm1: array[0..55] of Byte = (
  21. 57, 49, 41, 33, 25, 17, 9,
  22. 1, 58, 50, 42, 34, 26, 18,
  23. 10, 2, 59, 51, 43, 35, 27,
  24. 19, 11, 3, 60, 52, 44, 36,
  25. 63, 55, 47, 39, 31, 23, 15,
  26. 7, 62, 54, 46, 38, 30, 22,
  27. 14, 6, 61, 53, 45, 37, 29,
  28. 21, 13, 5, 28, 20, 12, 4);
  29. perm2: array[0..47] of Byte = (
  30. 14, 17, 11, 24, 1, 5,
  31. 3, 28, 15, 6, 21, 10,
  32. 23, 19, 12, 4, 26, 8,
  33. 16, 7, 27, 20, 13, 2,
  34. 41, 52, 31, 37, 47, 55,
  35. 30, 40, 51, 45, 33, 48,
  36. 44, 49, 39, 56, 34, 53,
  37. 46, 42, 50, 36, 29, 32);
  38. perm3: array[0..63] of Byte = (
  39. 58, 50, 42, 34, 26, 18, 10, 2,
  40. 60, 52, 44, 36, 28, 20, 12, 4,
  41. 62, 54, 46, 38, 30, 22, 14, 6,
  42. 64, 56, 48, 40, 32, 24, 16, 8,
  43. 57, 49, 41, 33, 25, 17, 9, 1,
  44. 59, 51, 43, 35, 27, 19, 11, 3,
  45. 61, 53, 45, 37, 29, 21, 13, 5,
  46. 63, 55, 47, 39, 31, 23, 15, 7);
  47. perm4: array[0..47] of Byte = (
  48. 32, 1, 2, 3, 4, 5,
  49. 4, 5, 6, 7, 8, 9,
  50. 8, 9, 10, 11, 12, 13,
  51. 12, 13, 14, 15, 16, 17,
  52. 16, 17, 18, 19, 20, 21,
  53. 20, 21, 22, 23, 24, 25,
  54. 24, 25, 26, 27, 28, 29,
  55. 28, 29, 30, 31, 32, 1);
  56. perm5: array[0..31] of Byte = (
  57. 16, 7, 20, 21,
  58. 29, 12, 28, 17,
  59. 1, 15, 23, 26,
  60. 5, 18, 31, 10,
  61. 2, 8, 24, 14,
  62. 32, 27, 3, 9,
  63. 19, 13, 30, 6,
  64. 22, 11, 4, 25);
  65. perm6: array[0..63] of Byte = (
  66. 40, 8, 48, 16, 56, 24, 64, 32,
  67. 39, 7, 47, 15, 55, 23, 63, 31,
  68. 38, 6, 46, 14, 54, 22, 62, 30,
  69. 37, 5, 45, 13, 53, 21, 61, 29,
  70. 36, 4, 44, 12, 52, 20, 60, 28,
  71. 35, 3, 43, 11, 51, 19, 59, 27,
  72. 34, 2, 42, 10, 50, 18, 58, 26,
  73. 33, 1, 41, 9, 49, 17, 57, 25);
  74. sc: array[0..15] of Byte = (1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 1);
  75. sbox: array[0..7, 0..3, 0..15] of Byte = (
  76. ((14, 4, 13, 1, 2, 15, 11, 8, 3, 10, 6, 12, 5, 9, 0, 7),
  77. (0, 15, 7, 4, 14, 2, 13, 1, 10, 6, 12, 11, 9, 5, 3, 8),
  78. (4, 1, 14, 8, 13, 6, 2, 11, 15, 12, 9, 7, 3, 10, 5, 0),
  79. (15, 12, 8, 2, 4, 9, 1, 7, 5, 11, 3, 14, 10, 0, 6, 13)),
  80. ((15, 1, 8, 14, 6, 11, 3, 4, 9, 7, 2, 13, 12, 0, 5, 10),
  81. (3, 13, 4, 7, 15, 2, 8, 14, 12, 0, 1, 10, 6, 9, 11, 5),
  82. (0, 14, 7, 11, 10, 4, 13, 1, 5, 8, 12, 6, 9, 3, 2, 15),
  83. (13, 8, 10, 1, 3, 15, 4, 2, 11, 6, 7, 12, 0, 5, 14, 9)),
  84. ((10, 0, 9, 14, 6, 3, 15, 5, 1, 13, 12, 7, 11, 4, 2, 8),
  85. (13, 7, 0, 9, 3, 4, 6, 10, 2, 8, 5, 14, 12, 11, 15, 1),
  86. (13, 6, 4, 9, 8, 15, 3, 0, 11, 1, 2, 12, 5, 10, 14, 7),
  87. (1, 10, 13, 0, 6, 9, 8, 7, 4, 15, 14, 3, 11, 5, 2, 12)),
  88. ((7, 13, 14, 3, 0, 6, 9, 10, 1, 2, 8, 5, 11, 12, 4, 15),
  89. (13, 8, 11, 5, 6, 15, 0, 3, 4, 7, 2, 12, 1, 10, 14, 9),
  90. (10, 6, 9, 0, 12, 11, 7, 13, 15, 1, 3, 14, 5, 2, 8, 4),
  91. (3, 15, 0, 6, 10, 1, 13, 8, 9, 4, 5, 11, 12, 7, 2, 14)),
  92. ((2, 12, 4, 1, 7, 10, 11, 6, 8, 5, 3, 15, 13, 0, 14, 9),
  93. (14, 11, 2, 12, 4, 7, 13, 1, 5, 0, 15, 10, 3, 9, 8, 6),
  94. (4, 2, 1, 11, 10, 13, 7, 8, 15, 9, 12, 5, 6, 3, 0, 14),
  95. (11, 8, 12, 7, 1, 14, 2, 13, 6, 15, 0, 9, 10, 4, 5, 3)),
  96. ((12, 1, 10, 15, 9, 2, 6, 8, 0, 13, 3, 4, 14, 7, 5, 11),
  97. (10, 15, 4, 2, 7, 12, 9, 5, 6, 1, 13, 14, 0, 11, 3, 8),
  98. (9, 14, 15, 5, 2, 8, 12, 3, 7, 0, 4, 10, 1, 13, 11, 6),
  99. (4, 3, 2, 12, 9, 5, 15, 10, 11, 14, 1, 7, 6, 0, 8, 13)),
  100. ((4, 11, 2, 14, 15, 0, 8, 13, 3, 12, 9, 7, 5, 10, 6, 1),
  101. (13, 0, 11, 7, 4, 9, 1, 10, 14, 3, 5, 12, 2, 15, 8, 6),
  102. (1, 4, 11, 13, 12, 3, 7, 14, 10, 15, 6, 8, 0, 5, 9, 2),
  103. (6, 11, 13, 8, 1, 4, 10, 7, 9, 5, 0, 15, 14, 2, 3, 12)),
  104. ((13, 2, 8, 4, 6, 15, 11, 1, 10, 9, 3, 14, 5, 0, 12, 7),
  105. (1, 15, 13, 8, 10, 3, 7, 4, 12, 5, 6, 11, 0, 14, 9, 2),
  106. (7, 11, 4, 1, 9, 12, 14, 2, 0, 6, 10, 13, 15, 3, 5, 8),
  107. (2, 1, 14, 7, 4, 10, 8, 13, 15, 12, 9, 0, 3, 5, 6, 11)));
  108. procedure permute({out} const _out: PByte; {in} const _in: PByte; {in} const p: PByte; {in} const n: Integer);
  109. var
  110. i: Integer;
  111. begin
  112. for i := 0 to n-1 do
  113. _out[i] := _in[p[i]-1];
  114. end;
  115. procedure lshift({in/out} const d: PByte; {in} const count: Integer; {in} const n: Integer);
  116. var
  117. _out : array[0..63] of Byte;
  118. i : Integer;
  119. begin
  120. for i := 0 to n-1 do
  121. _out[i] := d[(i+count) mod n];
  122. for i := 0 to n-1 do
  123. d[i] := _out[i];
  124. end;
  125. procedure concat({out} const _out: PByte; {in} const _in1, _in2: PByte; {in} const l1, l2: Integer);
  126. var
  127. i: Integer;
  128. begin
  129. for i := 0 to l1-1 do
  130. _out[i] := _in1[i];
  131. for i := 0 to l2-1 do
  132. _out[i+l1] := _in2[i];
  133. end;
  134. procedure mxor({out} const _out: PByte; {in} const _in1, _in2: PByte; {in} const n: Integer);
  135. var
  136. i: Integer;
  137. begin
  138. for i := 0 to n-1 do
  139. _out[i] := _in1[i] xor _in2[i];
  140. end;
  141. procedure dohash({out} const _out: PByte; {in} const _in: PByte; {in} const key: PByte; {in} const forw: Boolean);
  142. var
  143. i : Integer;
  144. j : Integer;
  145. k : Integer;
  146. pk1 : array[0..55] of Byte;
  147. c : array[0..27] of Byte;
  148. d : array[0..27] of Byte;
  149. cd : array[0..55] of Byte;
  150. ki : array[0..15,0..47] of Byte;
  151. pd1 : array[0..63] of Byte;
  152. l : array[0..31] of Byte;
  153. r : array[0..31] of Byte;
  154. rl : array[0..63] of Byte;
  155. er : array[0..47] of Byte;
  156. erk : array[0..47] of Byte;
  157. b : array[0..7,0..5] of Byte;
  158. cb : array[0..31] of Byte;
  159. pcb : array[0..31] of Byte;
  160. r2 : array[0..31] of Byte;
  161. m : Integer;
  162. n : Integer;
  163. begin
  164. permute(@pk1[0], key, @perm1[0], 56);
  165. for i := 0 to 27 do
  166. begin
  167. c[i] := pk1[i];
  168. d[i] := pk1[i+28];
  169. end;
  170. for i := 0 to 15 do
  171. begin
  172. lshift(@c[0], sc[i], 28);
  173. lshift(@d[0], sc[i], 28);
  174. concat(@cd[0], @c[0], @d[0], 28, 28);
  175. permute(@ki[i][0], @cd[0], @perm2[0], 48);
  176. end;
  177. permute(@pd1[0], _in, @perm3[0], 64);
  178. for i := 0 to 31 do
  179. begin
  180. l[i] := pd1[i];
  181. r[i] := pd1[i+32];
  182. end;
  183. for i := 0 to 15 do
  184. begin
  185. permute(@er[0], @r[0], @perm4[0], 48);
  186. if forw then
  187. mxor(@erk[0], @er[0], @ki[i][0], 48) else
  188. mxor(@erk[0], @er[0], @ki[15-i][0], 48);
  189. for j := 0 to 7 do
  190. for k := 0 to 5 do
  191. b[j][k] := erk[j*6 + k];
  192. for j := 0 to 7 do
  193. begin
  194. m := (b[j][0] shl 1) or b[j][5];
  195. n := (b[j][1] shl 3) or (b[j][2] shl 2) or (b[j][3] shl 1) or (b[j][4]);
  196. for k := 0 to 3 do
  197. b[j][k] := min(sbox[j][m][n] and (1 shl (3-k)), 1); // store binary
  198. end;
  199. for j := 0 to 7 do
  200. for k := 0 to 3 do
  201. cb[j*4+k] := b[j][k];
  202. permute(@pcb[0], @cb[0], @perm5[0], 32);
  203. mxor(@r2[0], @l[0], @pcb[0], 32);
  204. for j := 0 to 31 do
  205. begin
  206. l[j] := r[j];
  207. r[j] := r2[j];
  208. end;
  209. end;
  210. concat(@rl[0], @r[0], @l[0], 32, 32);
  211. permute(_out, @rl[0], @perm6[0], 64);
  212. end;
  213. procedure str_to_key({in} const str: PByte; {out} const key: PByte);
  214. var
  215. i: Integer;
  216. begin
  217. key[0] := str[0] shr 1;
  218. key[1] := ((str[0] and $01) shl 6) or (str[1] shr 2);
  219. key[2] := ((str[1] and $03) shl 5) or (str[2] shr 3);
  220. key[3] := ((str[2] and $07) shl 4) or (str[3] shr 4);
  221. key[4] := ((str[3] and $0F) shl 3) or (str[4] shr 5);
  222. key[5] := ((str[4] and $1F) shl 2) or (str[5] shr 6);
  223. key[6] := ((str[5] and $3F) shl 1) or (str[6] shr 7);
  224. key[7] := str[6] and $7F;
  225. for i := 0 to 7 do
  226. key[i] := key[i] shl 1;
  227. end;
  228. procedure smbhash({out} const _out: PByte; {in} const _in: PByte; {in} const key: PByte; {in} const forw: Boolean);
  229. var
  230. i : Integer;
  231. outb : array[0..63] of Byte;
  232. inb : array[0..63] of Byte;
  233. keyb : array[0..63] of Byte;
  234. key2 : array[0..7] of Byte;
  235. begin
  236. str_to_key(key, @key2[0]);
  237. for i := 0 to 63 do
  238. begin
  239. inb[i] := min( _in[i div 8] and (1 shl (7-(i mod 8))), 1); // store binary
  240. keyb[i] := min(key2[i div 8] and (1 shl (7-(i mod 8))), 1); // store binary
  241. outb[i] := 0;
  242. end;
  243. dohash(@outb[0], @inb[0], @keyb[0], forw);
  244. for i := 0 to 7 do
  245. _out[I] := 0;
  246. for i := 0 to 63 do
  247. begin
  248. if outb[i] <> 0 then
  249. _out[i div 8] := _out[i div 8] or (1 shl (7-(i mod 8)));
  250. end;
  251. end;
  252. procedure E_P16({in} const p14: PByte; {out} const p16: PByte);
  253. const
  254. sp8: array[0..7] of Byte = ($4b, $47, $53, $21, $40, $23, $24, $25);
  255. begin
  256. smbhash(@p16[0], @sp8[0], @p14[0], True);
  257. smbhash(@p16[8], @sp8[0], @p14[7], True);
  258. end;
  259. (*procedure E_P24({in} const p21: PByte; {in} const c8: PByte; {out} const p24: PByte);
  260. begin
  261. smbhash(@p24[0], c8, @p21[0], True);
  262. smbhash(@p24[8], c8, @p21[7], True);
  263. smbhash(@p24[16], c8, @p21[14], True);
  264. end;*)
  265. function LMGenerate(const Password: PChar): TMDDigest;
  266. var
  267. dospwd: array[0..14] of Byte;
  268. begin
  269. if not Assigned(Password) then
  270. Exit;
  271. FillChar(dospwd, Sizeof(dospwd), 0);
  272. (* Password must be converted to DOS charset - null terminated, uppercase *)
  273. StrLCopy(PChar(@dospwd[0]), PChar(@Password[0]), SizeOf(dospwd)-1);
  274. StrUpper(PChar(@dospwd[0]));
  275. (* Only the first 14 chars are considered, password need not be null terminated *)
  276. E_P16(@dospwd[0], @Result);
  277. FillChar(dospwd, Sizeof(dospwd), 0);
  278. end;
  279. function NTGenerate(const Password: PChar): TMDDigest;
  280. var
  281. pos: Integer;
  282. wpwd: array[0..127] of WideChar;
  283. begin
  284. if not Assigned(Password) then
  285. Exit;
  286. pos := 0;
  287. while (pos < 128) and (Password[pos] <> #0) do
  288. begin
  289. wpwd[pos] := Password[pos];
  290. inc(pos);
  291. end;
  292. Result := MDBuffer(wpwd, 2*pos, MD_VERSION_4);
  293. FillChar(wpwd, Sizeof(wpwd), 0);
  294. end;
  295. end.