From ed19765eee74efdbfac048bf139c9eb7e6b2fd34 Mon Sep 17 00:00:00 2001 From: peter Date: Thu, 25 Oct 2007 20:16:21 +0000 Subject: * move hash git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@8936 3ad0048d-3df7-0310-abae-a5850022a9f2 --- packages/hash/src/crc.pas | 231 ++++++++++++++ packages/hash/src/md5.pp | 684 ++++++++++++++++++++++++++++++++++++++++ packages/hash/src/ntlm.pas | 373 ++++++++++++++++++++++ packages/hash/src/unixcrypt.pas | 60 ++++ packages/hash/src/uuid.pas | 351 +++++++++++++++++++++ 5 files changed, 1699 insertions(+) create mode 100644 packages/hash/src/crc.pas create mode 100644 packages/hash/src/md5.pp create mode 100644 packages/hash/src/ntlm.pas create mode 100644 packages/hash/src/unixcrypt.pas create mode 100644 packages/hash/src/uuid.pas (limited to 'packages/hash/src') diff --git a/packages/hash/src/crc.pas b/packages/hash/src/crc.pas new file mode 100644 index 0000000000..b3a479d199 --- /dev/null +++ b/packages/hash/src/crc.pas @@ -0,0 +1,231 @@ +unit crc; + +{ + crc32.c -- compute the CRC-32 of a data stream + Copyright (C) 1995-1998 Mark Adler + + Pascal tranlastion + Copyright (C) 1998 by Jacques Nomssi Nzali + For conditions of distribution and use, see copyright notice in readme.txt +} + +interface + +function crc32(crc : cardinal; buf : Pbyte; len : cardinal) : cardinal; + +{ Update a running crc with the bytes buf[0..len-1] and return the updated + crc. If buf is NULL, this function returns the required initial value + for the crc. Pre- and post-conditioning (one's complement) is performed + within this function so it shouldn't be done by the application. + Usage example: + + var + crc : cardinal; + begin + crc := crc32(0, nil, 0); + + while (read_buffer(buffer, length) <> EOF) do + crc := crc32(crc, buffer, length); + + if (crc <> original_crc) then error(); + end; + +} + +function get_crc_table : Pcardinal; { can be used by asm versions of crc32() } + + +implementation + +{$IFDEF DYNAMIC_CRC_TABLE} + +{local} +const + crc_table_empty : boolean = TRUE; +{local} +var + crc_table : array[0..256-1] of uLongf; + + +{ + Generate a table for a byte-wise 32-bit CRC calculation on the polynomial: + x^32+x^26+x^23+x^22+x^16+x^12+x^11+x^10+x^8+x^7+x^5+x^4+x^2+x+1. + + Polynomials over GF(2) are represented in binary, one bit per coefficient, + with the lowest powers in the most significant bit. Then adding polynomials + is just exclusive-or, and multiplying a polynomial by x is a right shift by + one. If we call the above polynomial p, and represent a byte as the + polynomial q, also with the lowest power in the most significant bit (so the + byte 0xb1 is the polynomial x^7+x^3+x+1), then the CRC is (q*x^32) mod p, + where a mod b means the remainder after dividing a by b. + + This calculation is done using the shift-register method of multiplying and + taking the remainder. The register is initialized to zero, and for each + incoming bit, x^32 is added mod p to the register if the bit is a one (where + x^32 mod p is p+x^32 = x^26+...+1), and the register is multiplied mod p by + x (which is shifting right by one and adding x^32 mod p if the bit shifted + out is a one). We start with the highest power (least significant bit) of + q and repeat for all eight bits of q. + + The table is simply the CRC of all possible eight bit values. This is all + the information needed to generate CRC's on data a byte at a time for all + combinations of CRC register values and incoming bytes. +} +{local} +procedure make_crc_table; +var + c : cardinal; + n,k : integer; + poly : cardinal; { polynomial exclusive-or pattern } + +const + { terms of polynomial defining this crc (except x^32): } + p: array [0..13] of Byte = (0,1,2,4,5,7,8,10,11,12,16,22,23,26); + +begin + { make exclusive-or pattern from polynomial ($EDB88320) } + poly := longint(0); + for n := 0 to (sizeof(p) div sizeof(Byte))-1 do + poly := poly or (longint(1) shl (31 - p[n])); + + for n := 0 to 255 do + begin + c := cardinal(n); + for k := 0 to 7 do + begin + if (c and 1) <> 0 then + c := poly xor (c shr 1) + else + c := (c shr 1); + end; + crc_table[n] := c; + end; + crc_table_empty := FALSE; +end; + +{$ELSE} + +{ ======================================================================== + Table of CRC-32's of all single-byte values (made by make_crc_table) } + +{local} +const + crc_table : array[0..256-1] of cardinal = ( + $00000000, $77073096, $ee0e612c, $990951ba, $076dc419, + $706af48f, $e963a535, $9e6495a3, $0edb8832, $79dcb8a4, + $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07, + $90bf1d91, $1db71064, $6ab020f2, $f3b97148, $84be41de, + $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7, $136c9856, + $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9, + $fa0f3d63, $8d080df5, $3b6e20c8, $4c69105e, $d56041e4, + $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b, + $35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3, + $45df5c75, $dcd60dcf, $abd13d59, $26d930ac, $51de003a, + $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599, + $b8bda50f, $2802b89e, $5f058808, $c60cd9b2, $b10be924, + $2f6f7c87, $58684c11, $c1611dab, $b6662d3d, $76dc4190, + $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f, + $9fbfe4a5, $e8b8d433, $7807c9a2, $0f00f934, $9609a88e, + $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01, + $6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed, + $1b01a57b, $8208f4c1, $f50fc457, $65b0d9c6, $12b7e950, + $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, + $fbd44c65, $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, + $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb, $4369e96a, + $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5, + $aa0a4c5f, $dd0d7cc9, $5005713c, $270241aa, $be0b1010, + $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f, + $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, + $2eb40d81, $b7bd5c3b, $c0ba6cad, $edb88320, $9abfb3b6, + $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615, + $73dc1683, $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8, + $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1, $f00f9344, + $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb, + $196c3671, $6e6b06e7, $fed41b76, $89d32be0, $10da7a5a, + $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5, + $d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1, + $a6bc5767, $3fb506dd, $48b2364b, $d80d2bda, $af0a1b4c, + $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef, + $4669be79, $cb61b38c, $bc66831a, $256fd2a0, $5268e236, + $cc0c7795, $bb0b4703, $220216b9, $5505262f, $c5ba3bbe, + $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, + $2cd99e8b, $5bdeae1d, $9b64c2b0, $ec63f226, $756aa39c, + $026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713, + $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b, + $e5d5be0d, $7cdcefb7, $0bdbdf21, $86d3d2d4, $f1d4e242, + $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, + $18b74777, $88085ae6, $ff0f6a70, $66063bca, $11010b5c, + $8f659eff, $f862ae69, $616bffd3, $166ccf45, $a00ae278, + $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7, + $4969474d, $3e6e77db, $aed16a4a, $d9d65adc, $40df0b66, + $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9, + $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, + $cdd70693, $54de5729, $23d967bf, $b3667a2e, $c4614ab8, + $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b, + $2d02ef8d); + +{$ENDIF} + +{ ========================================================================= + This function can be used by asm versions of crc32() } + +function get_crc_table : {const} Pcardinal; +begin +{$ifdef DYNAMIC_CRC_TABLE} + if (crc_table_empty) then + make_crc_table; +{$endif} + get_crc_table := {const} Pcardinal(@crc_table); +end; + +{ ========================================================================= } + +function crc32 (crc : cardinal; buf : Pbyte; len : cardinal): cardinal; +begin + if (buf = nil) then + crc32 := 0 + else + begin + +{$IFDEF DYNAMIC_CRC_TABLE} + if crc_table_empty then + make_crc_table; +{$ENDIF} + + crc := crc xor cardinal($ffffffff); + while (len >= 8) do + begin + {DO8(buf)} + crc := crc_table[(integer(crc) xor buf^) and $ff] xor (crc shr 8); + inc(buf); + crc := crc_table[(integer(crc) xor buf^) and $ff] xor (crc shr 8); + inc(buf); + crc := crc_table[(integer(crc) xor buf^) and $ff] xor (crc shr 8); + inc(buf); + crc := crc_table[(integer(crc) xor buf^) and $ff] xor (crc shr 8); + inc(buf); + crc := crc_table[(integer(crc) xor buf^) and $ff] xor (crc shr 8); + inc(buf); + crc := crc_table[(integer(crc) xor buf^) and $ff] xor (crc shr 8); + inc(buf); + crc := crc_table[(integer(crc) xor buf^) and $ff] xor (crc shr 8); + inc(buf); + crc := crc_table[(integer(crc) xor buf^) and $ff] xor (crc shr 8); + inc(buf); + + dec(len, 8); + end; + if (len <> 0) then + repeat + {DO1(buf)} + crc := crc_table[(integer(crc) xor buf^) and $ff] xor (crc shr 8); + inc(buf); + + dec(len); + until (len = 0); + crc32 := crc xor cardinal($ffffffff); + end; +end; + + +end. \ No newline at end of file diff --git a/packages/hash/src/md5.pp b/packages/hash/src/md5.pp new file mode 100644 index 0000000000..8d15396551 --- /dev/null +++ b/packages/hash/src/md5.pp @@ -0,0 +1,684 @@ +{ + This file is part of the Free Pascal packages. + Copyright (c) 1999-2006 by the Free Pascal development team + + Implements a MD2 digest algorithm (RFC 1319) + Implements a MD4 digest algorithm (RFC 1320) + Implements a MD5 digest algorithm (RFC 1321) + + 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 md5; + +{$mode objfpc} +{$inline on} +{$h+} + +interface + + +(****************************************************************************** + * types and constants + ******************************************************************************) + +const + MDDefBufSize = 1024; + +type + TMDVersion = ( + MD_VERSION_2, + MD_VERSION_4, + MD_VERSION_5 + ); + + PMDDigest = ^TMDDigest; + TMDDigest = array[0..15] of Byte; + + PMD2Digset = PMDDigest; + TMD2Digest = TMDDigest; + + PMD4Digset = PMDDigest; + TMD4Digest = TMDDigest; + + PMD5Digset = PMDDigest; + TMD5Digest = TMDDigest; + + PMDContext = ^TMDContext; + TMDContext = record + Version : TMDVersion; + Align : PtrUInt; + State : array[0..3] of Cardinal; + BufCnt : PtrUInt; + Buffer : array[0..63] of Byte; + case Integer of + 0: (Length : PtrUInt); + 1: (Checksum : array[0..15] of Byte); + end; + + PMD2Context = PMDContext; + TMD2Context = TMDContext; + + PMD4Context = PMDContext; + TMD4Context = TMDContext; + + PMD5Context = PMDContext; + TMD5Context = TMDContext; + + + +(****************************************************************************** + * Core raw functions + ******************************************************************************) + +procedure MDInit(var Context: TMDContext; const Version: TMDVersion); +procedure MDUpdate(var Context: TMDContext; var Buf; const BufLen: PtrUInt); +procedure MDFinal(var Context: TMDContext; var Digest: TMDDigest); + + +(****************************************************************************** + * Auxilary functions + ******************************************************************************) + +function MDString(const S: String; const Version: TMDVersion): TMDDigest; +function MDBuffer(var Buf; const BufLen: PtrUInt; const Version: TMDVersion): TMDDigest; +function MDFile(const Filename: String; const Version: TMDVersion; const Bufsize: PtrUInt = MDDefBufSize): TMDDigest; + + +(****************************************************************************** + * Helper functions + ******************************************************************************) + +function MDPrint(const Digest: TMDDigest): String; +function MDMatch(const Digest1, Digest2: TMDDigest): Boolean; + + +(****************************************************************************** + * Dedicated raw functions + ******************************************************************************) + +procedure MD2Init(var Context: TMD2Context); inline; +procedure MD2Update(var Context: TMD2Context; var Buf; const BufLen: PtrUInt); inline; +procedure MD2Final(var Context: TMD2Context; var Digest: TMD2Digest); inline; + +procedure MD4Init(var Context: TMD4Context); inline; +procedure MD4Update(var Context: TMD4Context; var Buf; const BufLen: PtrUInt); inline; +procedure MD4Final(var Context: TMD4Context; var Digest: TMD4Digest); inline; + +procedure MD5Init(var Context: TMD5Context); inline; +procedure MD5Update(var Context: TMD5Context; var Buf; const BufLen: PtrUInt); inline; +procedure MD5Final(var Context: TMD5Context; var Digest: TMD5Digest); inline; + + +(****************************************************************************** + * Dedicated auxilary functions + ******************************************************************************) + +function MD2String(const S: String): TMD2Digest; inline; +function MD2Buffer(var Buf; const BufLen: PtrUInt): TMD2Digest; inline; +function MD2File(const Filename: String; const Bufsize: PtrUInt = MDDefBufSize): TMD2Digest; inline; + +function MD4String(const S: String): TMD4Digest; inline; +function MD4Buffer(var Buf; const BufLen: PtrUInt): TMD4Digest; inline; +function MD4File(const Filename: String; const Bufsize: PtrUInt = MDDefBufSize): TMD4Digest; inline; + +function MD5String(const S: String): TMD5Digest; inline; +function MD5Buffer(var Buf; const BufLen: PtrUInt): TMD5Digest; inline; +function MD5File(const Filename: String; const Bufsize: PtrUInt = MDDefBufSize): TMD5Digest; inline; + + + +(****************************************************************************** + * Dedicated helper functions + ******************************************************************************) + +function MD2Print(const Digest: TMD2Digest): String; inline; +function MD2Match(const Digest1, Digest2: TMD2Digest): Boolean; inline; + +function MD4Print(const Digest: TMD4Digest): String; inline; +function MD4Match(const Digest1, Digest2: TMD4Digest): Boolean; inline; + +function MD5Print(const Digest: TMD5Digest): String; inline; +function MD5Match(const Digest1, Digest2: TMD5Digest): Boolean; inline; + +implementation + + +function rol(x: Cardinal; n: Byte): Cardinal; +begin + Result := (x shl n) or (x shr (32 - n)); +end; + + +// inverts the bytes of (Count div 4) cardinals from source to target. +procedure Invert(Source, Dest: Pointer; Count: PtrUInt); +var + S: PByte; + T: PCardinal; + I: PtrUInt; +begin + S := Source; + T := Dest; + for I := 1 to (Count div 4) do + begin + T^ := S[0] or (S[1] shl 8) or (S[2] shl 16) or (S[3] shl 24); + inc(S,4); + inc(T); + end; +end; + + +procedure MD2Transform(var Context: TMDContext; Buffer: Pointer); +const + PI_SUBST: array[0..255] of Byte = ( + 41, 46, 67, 201, 162, 216, 124, 1, 61, 54, 84, 161, 236, 240, 6, + 19, 98, 167, 5, 243, 192, 199, 115, 140, 152, 147, 43, 217, 188, + 76, 130, 202, 30, 155, 87, 60, 253, 212, 224, 22, 103, 66, 111, 24, + 138, 23, 229, 18, 190, 78, 196, 214, 218, 158, 222, 73, 160, 251, + 245, 142, 187, 47, 238, 122, 169, 104, 121, 145, 21, 178, 7, 63, + 148, 194, 16, 137, 11, 34, 95, 33, 128, 127, 93, 154, 90, 144, 50, + 39, 53, 62, 204, 231, 191, 247, 151, 3, 255, 25, 48, 179, 72, 165, + 181, 209, 215, 94, 146, 42, 172, 86, 170, 198, 79, 184, 56, 210, + 150, 164, 125, 182, 118, 252, 107, 226, 156, 116, 4, 241, 69, 157, + 112, 89, 100, 113, 135, 32, 134, 91, 207, 101, 230, 45, 168, 2, 27, + 96, 37, 173, 174, 176, 185, 246, 28, 70, 97, 105, 52, 64, 126, 15, + 85, 71, 163, 35, 221, 81, 175, 58, 195, 92, 249, 206, 186, 197, + 234, 38, 44, 83, 13, 110, 133, 40, 132, 9, 211, 223, 205, 244, 65, + 129, 77, 82, 106, 220, 55, 200, 108, 193, 171, 250, 36, 225, 123, + 8, 12, 189, 177, 74, 120, 136, 149, 139, 227, 99, 232, 109, 233, + 203, 213, 254, 59, 0, 29, 57, 242, 239, 183, 14, 102, 88, 208, 228, + 166, 119, 114, 248, 235, 117, 75, 10, 49, 68, 80, 180, 143, 237, + 31, 26, 219, 153, 141, 51, 159, 17, 131, 20 +); +var + i: Cardinal; + j: Cardinal; + t: Cardinal; + x: array[0..47] of Byte; +begin + { Form encryption block from state, block, state ^ block } + Move(Context.State, x[0], 16); + Move(Buffer^, x[16], 16); + for i := 0 to 15 do + x[i+32] := PByte(@Context.State)[i] xor PByte(Buffer)[i]; + + { Encrypt block (18 rounds) } + t := 0; + for i := 0 to 17 do + begin + for j := 0 to 47 do + begin + x[j] := x[j] xor PI_SUBST[t]; + t := x[j]; + end; + t := (t + i) and $FF; + end; + + { Save new state } + Move(x[0], Context.State, 16); + + { Update checksum } + t := Context.Checksum[15]; + for i := 0 to 15 do + begin + Context.Checksum[i] := Context.Checksum[i] xor PI_SUBST[PByte(Buffer)[i] xor t]; + t := Context.Checksum[i]; + end; + + { Zeroize sensitive information. } + FillChar(x, Sizeof(x), 0); +end; + + +procedure MD4Transform(var Context: TMDContext; Buffer: Pointer); + + procedure R1(var a: Cardinal; b,c,d,x: Cardinal; s: Byte); + // F(x,y,z) = (x and y) or ((not x) and z) + begin + a := rol(a + {F(b,c,d)}((b and c) or ((not b) and d)) + x, s); + end; + + procedure R2(var a: Cardinal; b,c,d,x: Cardinal; s: Byte); + // G(x,y,z) = (x and y) or (x and z) or (y and z); + begin + a := rol(a + {G(b,c,d)}((b and c) or (b and d) or (c and d)) + x + $5A827999, s); + end; + + procedure R3(var a: Cardinal; b,c,d,x: Cardinal; s: Byte); + // H(x,y,z) = x xor y xor z + begin + a := rol(a + {H(b,c,d)}(b xor c xor d) + x + $6ED9EBA1, s); + end; + +var + a, b, c, d: Cardinal; + Block: array[0..15] of Cardinal; +begin + Invert(Buffer, @Block, 64); + a := Context.State[0]; + b := Context.State[1]; + c := Context.State[2]; + d := Context.State[3]; + + // Round 1 + R1(a,b,c,d,Block[0], 3); R1(d,a,b,c,Block[1], 7); R1(c,d,a,b,Block[2], 11); R1(b,c,d,a,Block[3], 19); + R1(a,b,c,d,Block[4], 3); R1(d,a,b,c,Block[5], 7); R1(c,d,a,b,Block[6], 11); R1(b,c,d,a,Block[7], 19); + R1(a,b,c,d,Block[8], 3); R1(d,a,b,c,Block[9], 7); R1(c,d,a,b,Block[10],11); R1(b,c,d,a,Block[11],19); + R1(a,b,c,d,Block[12], 3); R1(d,a,b,c,Block[13], 7); R1(c,d,a,b,Block[14],11); R1(b,c,d,a,Block[15],19); + + // Round 2 + R2(a,b,c,d,Block[0], 3); R2(d,a,b,c,Block[4], 5); R2(c,d,a,b,Block[8], 9); R2(b,c,d,a,Block[12],13); + R2(a,b,c,d,Block[1], 3); R2(d,a,b,c,Block[5], 5); R2(c,d,a,b,Block[9], 9); R2(b,c,d,a,Block[13],13); + R2(a,b,c,d,Block[2], 3); R2(d,a,b,c,Block[6], 5); R2(c,d,a,b,Block[10], 9); R2(b,c,d,a,Block[14],13); + R2(a,b,c,d,Block[3], 3); R2(d,a,b,c,Block[7], 5); R2(c,d,a,b,Block[11], 9); R2(b,c,d,a,Block[15],13); + + // Round 3 + R3(a,b,c,d,Block[0], 3); R3(d,a,b,c,Block[8], 9); R3(c,d,a,b,Block[4], 11); R3(b,c,d,a,Block[12],15); + R3(a,b,c,d,Block[2], 3); R3(d,a,b,c,Block[10], 9); R3(c,d,a,b,Block[6], 11); R3(b,c,d,a,Block[14],15); + R3(a,b,c,d,Block[1], 3); R3(d,a,b,c,Block[9], 9); R3(c,d,a,b,Block[5], 11); R3(b,c,d,a,Block[13],15); + R3(a,b,c,d,Block[3], 3); R3(d,a,b,c,Block[11], 9); R3(c,d,a,b,Block[7], 11); R3(b,c,d,a,Block[15],15); + + inc(Context.State[0], a); + inc(Context.State[1], b); + inc(Context.State[2], c); + inc(Context.State[3], d); + inc(Context.Length,64); +end; + + +procedure MD5Transform(var Context: TMDContext; Buffer: Pointer); + + procedure R1(var a: Cardinal; b,c,d,x: Cardinal; s: Byte; ac: Cardinal); + // F(x,y,z) = (x and y) or ((not x) and z) + begin + a := b + rol(a + {F(b,c,d)}((b and c) or ((not b) and d)) + x + ac, s); + end; + + procedure R2(var a: Cardinal; b,c,d,x: Cardinal; s: Byte; ac: Cardinal); + // G(x,y,z) = (x and z) or (y and (not z)) + begin + a := b + rol(a + {G(b,c,d)}((b and d) or (c and (not d))) + x + ac, s); + end; + + procedure R3(var a: Cardinal; b,c,d,x: Cardinal; s: Byte; ac: Cardinal); + // H(x,y,z) = x xor y xor z; + begin + a := b + rol(a + {H(b,c,d)}(b xor c xor d) + x + ac, s); + end; + + procedure R4(var a: Cardinal; b,c,d,x: Cardinal; s: Byte; ac: Cardinal); + // I(x,y,z) = y xor (x or (not z)); + begin + a := b + rol(a + {I(b,c,d)}(c xor (b or (not d))) + x + ac, s); + end; + +var + a, b, c, d: Cardinal; + Block: array[0..15] of Cardinal; +begin + Invert(Buffer, @Block, 64); + a := Context.State[0]; + b := Context.State[1]; + c := Context.State[2]; + d := Context.State[3]; + + // Round 1 + R1(a,b,c,d,Block[0] , 7,$d76aa478); R1(d,a,b,c,Block[1] ,12,$e8c7b756); R1(c,d,a,b,Block[2] ,17,$242070db); R1(b,c,d,a,Block[3] ,22,$c1bdceee); + R1(a,b,c,d,Block[4] , 7,$f57c0faf); R1(d,a,b,c,Block[5] ,12,$4787c62a); R1(c,d,a,b,Block[6] ,17,$a8304613); R1(b,c,d,a,Block[7] ,22,$fd469501); + R1(a,b,c,d,Block[8] , 7,$698098d8); R1(d,a,b,c,Block[9] ,12,$8b44f7af); R1(c,d,a,b,Block[10],17,$ffff5bb1); R1(b,c,d,a,Block[11],22,$895cd7be); + R1(a,b,c,d,Block[12], 7,$6b901122); R1(d,a,b,c,Block[13],12,$fd987193); R1(c,d,a,b,Block[14],17,$a679438e); R1(b,c,d,a,Block[15],22,$49b40821); + + // Round 2 + R2(a,b,c,d,Block[1] , 5,$f61e2562); R2(d,a,b,c,Block[6] , 9,$c040b340); R2(c,d,a,b,Block[11],14,$265e5a51); R2(b,c,d,a,Block[0] ,20,$e9b6c7aa); + R2(a,b,c,d,Block[5] , 5,$d62f105d); R2(d,a,b,c,Block[10], 9,$02441453); R2(c,d,a,b,Block[15],14,$d8a1e681); R2(b,c,d,a,Block[4] ,20,$e7d3fbc8); + R2(a,b,c,d,Block[9] , 5,$21e1cde6); R2(d,a,b,c,Block[14], 9,$c33707d6); R2(c,d,a,b,Block[3] ,14,$f4d50d87); R2(b,c,d,a,Block[8] ,20,$455a14ed); + R2(a,b,c,d,Block[13], 5,$a9e3e905); R2(d,a,b,c,Block[2] , 9,$fcefa3f8); R2(c,d,a,b,Block[7] ,14,$676f02d9); R2(b,c,d,a,Block[12],20,$8d2a4c8a); + + // Round 3 + R3(a,b,c,d,Block[5] , 4,$fffa3942); R3(d,a,b,c,Block[8] ,11,$8771f681); R3(c,d,a,b,Block[11],16,$6d9d6122); R3(b,c,d,a,Block[14],23,$fde5380c); + R3(a,b,c,d,Block[1] , 4,$a4beea44); R3(d,a,b,c,Block[4] ,11,$4bdecfa9); R3(c,d,a,b,Block[7] ,16,$f6bb4b60); R3(b,c,d,a,Block[10],23,$bebfbc70); + R3(a,b,c,d,Block[13], 4,$289b7ec6); R3(d,a,b,c,Block[0] ,11,$eaa127fa); R3(c,d,a,b,Block[3] ,16,$d4ef3085); R3(b,c,d,a,Block[6] ,23,$04881d05); + R3(a,b,c,d,Block[9] , 4,$d9d4d039); R3(d,a,b,c,Block[12],11,$e6db99e5); R3(c,d,a,b,Block[15],16,$1fa27cf8); R3(b,c,d,a,Block[2] ,23,$c4ac5665); + + // Round 4 + R4(a,b,c,d,Block[0] , 6,$f4292244); R4(d,a,b,c,Block[7] ,10,$432aff97); R4(c,d,a,b,Block[14],15,$ab9423a7); R4(b,c,d,a,Block[5] ,21,$fc93a039); + R4(a,b,c,d,Block[12], 6,$655b59c3); R4(d,a,b,c,Block[3] ,10,$8f0ccc92); R4(c,d,a,b,Block[10],15,$ffeff47d); R4(b,c,d,a,Block[1] ,21,$85845dd1); + R4(a,b,c,d,Block[8] , 6,$6fa87e4f); R4(d,a,b,c,Block[15],10,$fe2ce6e0); R4(c,d,a,b,Block[6] ,15,$a3014314); R4(b,c,d,a,Block[13],21,$4e0811a1); + R4(a,b,c,d,Block[4] , 6,$f7537e82); R4(d,a,b,c,Block[11],10,$bd3af235); R4(c,d,a,b,Block[2] ,15,$2ad7d2bb); R4(b,c,d,a,Block[9] ,21,$eb86d391); + + inc(Context.State[0],a); + inc(Context.State[1],b); + inc(Context.State[2],c); + inc(Context.State[3],d); + inc(Context.Length,64); +end; + + +procedure MDInit(var Context: TMDContext; const Version: TMDVersion); +begin + FillChar(Context, Sizeof(TMDContext), 0); + Context.Version := Version; + + case Version of + + MD_VERSION_4, MD_VERSION_5: + begin + Context.Align := 64; + Context.State[0] := $67452301; + Context.State[1] := $efcdab89; + Context.State[2] := $98badcfe; + Context.State[3] := $10325476; + Context.Length := 0; + Context.BufCnt := 0; + end; + + MD_VERSION_2: + begin + Context.Align := 16; + end; + + end; +end; + + +procedure MDUpdate(var Context: TMDContext; var Buf; const BufLen: PtrUInt); +var + Align: PtrUInt; + Src: Pointer; + Num: PtrUInt; +begin + if BufLen = 0 then + Exit; + + Align := Context.Align; + Src := @Buf; + Num := 0; + + // 1. Transform existing data in buffer + if Context.BufCnt > 0 then + begin + // 1.1 Try to fill buffer to "Align" bytes + Num := Align - Context.BufCnt; + if Num > BufLen then + Num := BufLen; + + Move(Src^, Context.Buffer[Context.BufCnt], Num); + Context.BufCnt := Context.BufCnt + Num; + Src := Pointer(PtrUInt(Src) + Num); + + // 1.2 If buffer contains "Align" bytes, transform it + if Context.BufCnt = Align then + begin + case Context.Version of + MD_VERSION_2: MD2Transform(Context, @Context.Buffer); + MD_VERSION_4: MD4Transform(Context, @Context.Buffer); + MD_VERSION_5: MD5Transform(Context, @Context.Buffer); + end; + Context.BufCnt := 0; + end; + end; + + // 2. Transform "Align"-Byte blocks of Buf + Num := BufLen - Num; + while Num >= Align do + begin + case Context.Version of + MD_VERSION_2: MD2Transform(Context, Src); + MD_VERSION_4: MD4Transform(Context, Src); + MD_VERSION_5: MD5Transform(Context, Src); + end; + Src := Pointer(PtrUInt(Src) + Align); + Num := Num - Align; + end; + + // 3. If there's a block smaller than "Align" Bytes left, add it to buffer + if Num > 0 then + begin + Context.BufCnt := Num; + Move(Src^, Context.Buffer, Num); + end; +end; + + +procedure MDFinal(var Context: TMDContext; var Digest: TMDDigest); +const + PADDING_MD45: array[0..15] of Cardinal = ($80,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0); +var + Length: QWord; + Pads: Cardinal; +begin + case Context.Version of + + MD_VERSION_4, MD_VERSION_5: + begin + // 1. Compute length of the whole stream in bits + Length := 8 * (Context.Length + Context.BufCnt); + + // 2. Append padding bits + Pads := (120 - Context.BufCnt) mod 64; + if Pads > 0 then + MDUpdate(Context, PADDING_MD45, Pads) else + MDUpdate(Context, PADDING_MD45, 56); + + // 3. Append length of the stream + Invert(@Length, @Length, 8); + MDUpdate(Context, Length, 8); + + // 4. Invert state to digest + Invert(@Context.State, @Digest, 16); + end; + + MD_VERSION_2: + begin + Pads := 16 - Context.BufCnt; + Length := Pads; + while Pads > 0 do + begin + MDUpdate(Context, Length, 1); + Dec(Pads); + end; + MDUpdate(Context, Context.Checksum, 16); + Move(Context.State, Digest, 16); + end; + + end; + + FillChar(Context, SizeOf(TMDContext), 0); +end; + +function MDString(const S: String; const Version: TMDVersion): TMDDigest; +var + Context: TMDContext; +begin + MDInit(Context, Version); + MDUpdate(Context, PChar(S)^, length(S)); + MDFinal(Context, Result); +end; + +function MDBuffer(var Buf; const BufLen: PtrUInt; const Version: TMDVersion): TMDDigest; +var + Context: TMDContext; +begin + MDInit(Context, Version); + MDUpdate(Context, buf, buflen); + MDFinal(Context, Result); +end; + +function MDFile(const Filename: String; const Version: TMDVersion; const BufSize: PtrUInt): TMDDigest; +var + F: File; + Buf: Pchar; + Context: TMDContext; + Count: Cardinal; + ofm: Longint; +begin + MDInit(Context, Version); + + Assign(F, Filename); + {$i-} + ofm := FileMode; + FileMode := 0; + Reset(F, 1); + {$i+} + + if IOResult = 0 then + begin + GetMem(Buf, BufSize); + repeat + BlockRead(F, Buf^, Bufsize, Count); + if Count > 0 then + MDUpdate(Context, Buf^, Count); + until Count < BufSize; + FreeMem(Buf, BufSize); + Close(F); + end; + + MDFinal(Context, Result); + FileMode := ofm; +end; + +function MDPrint(const Digest: TMDDigest): String; +var + I: Byte; +begin + Result := ''; + for I := 0 to 15 do + Result := Result + HexStr(Digest[i],2); + Result := LowerCase(Result); +end; + +function MDMatch(const Digest1, Digest2: TMDDigest): Boolean; +var + A: array[0..3] of Cardinal absolute Digest1; + B: array[0..3] of Cardinal absolute Digest2; +begin + Result := (A[0] = B[0]) and (A[1] = B[1]) and (A[2] = B[2]) and (A[3] = B[3]); +end; + +procedure MD2Init(var Context: TMD2Context); +begin + MDInit(Context, MD_VERSION_2); +end; + +procedure MD2Update(var Context: TMD2Context; var Buf; const BufLen: PtrUInt); +begin + MDUpdate(Context, Buf, BufLen); +end; + +procedure MD2Final(var Context: TMD2Context; var Digest: TMD2Digest); +begin + MDFinal(Context, Digest); +end; + +procedure MD4Init(var Context: TMD4Context); +begin + MDInit(Context, MD_VERSION_4); +end; + +procedure MD4Update(var Context: TMD4Context; var Buf; const BufLen: PtrUInt); +begin + MDUpdate(Context, Buf, BufLen); +end; + +procedure MD4Final(var Context: TMD4Context; var Digest: TMD4Digest); +begin + MDFinal(Context, Digest); +end; + +procedure MD5Init(var Context: TMD5Context); +begin + MDInit(Context, MD_VERSION_5); +end; + +procedure MD5Update(var Context: TMD5Context; var Buf; const BufLen: PtrUInt); +begin + MDUpdate(Context, Buf, BufLen); +end; + +procedure MD5Final(var Context: TMD5Context; var Digest: TMD5Digest); +begin + MDFinal(Context, Digest); +end; + +function MD2String(const S: String): TMD2Digest; +begin + Result := MDString(S, MD_VERSION_2); +end; + +function MD2Buffer(var Buf; const BufLen: PtrUInt): TMD2Digest; +begin + Result := MDBuffer(Buf, BufLen, MD_VERSION_2); +end; + +function MD2File(const Filename: String; const Bufsize: PtrUInt): TMD2Digest; +begin + Result := MDFile(Filename, MD_VERSION_2, Bufsize); +end; + +function MD4String(const S: String): TMD4Digest; +begin + Result := MDString(S, MD_VERSION_4); +end; + +function MD4Buffer(var Buf; const BufLen: PtrUInt): TMD4Digest; +begin + Result := MDBuffer(Buf, BufLen, MD_VERSION_4); +end; + +function MD4File(const Filename: String; const Bufsize: PtrUInt): TMD4Digest; +begin + Result := MDFile(Filename, MD_VERSION_4, Bufsize); +end; + +function MD5String(const S: String): TMD5Digest; +begin + Result := MDString(S, MD_VERSION_5); +end; + +function MD5Buffer(var Buf; const BufLen: PtrUInt): TMD5Digest; +begin + Result := MDBuffer(Buf, BufLen, MD_VERSION_5); +end; + +function MD5File(const Filename: String; const Bufsize: PtrUInt): TMD5Digest; +begin + Result := MDFile(Filename, MD_VERSION_5, Bufsize); +end; + +function MD2Print(const Digest: TMD2Digest): String; +begin + Result := MDPrint(Digest); +end; + +function MD2Match(const Digest1, Digest2: TMD2Digest): Boolean; +begin + Result := MDMatch(Digest1, Digest2); +end; + +function MD4Print(const Digest: TMD4Digest): String; +begin + Result := MDPrint(Digest); +end; + +function MD4Match(const Digest1, Digest2: TMD4Digest): Boolean; +begin + Result := MDMatch(Digest1, Digest2); +end; + +function MD5Print(const Digest: TMD5Digest): String; +begin + Result := MDPrint(Digest); +end; + +function MD5Match(const Digest1, Digest2: TMD5Digest): Boolean; +begin + Result := MDMatch(Digest1, Digest2); +end; + +end. diff --git a/packages/hash/src/ntlm.pas b/packages/hash/src/ntlm.pas new file mode 100644 index 0000000000..22e40e4c7d --- /dev/null +++ b/packages/hash/src/ntlm.pas @@ -0,0 +1,373 @@ +{ + 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. diff --git a/packages/hash/src/unixcrypt.pas b/packages/hash/src/unixcrypt.pas new file mode 100644 index 0000000000..a525e294b3 --- /dev/null +++ b/packages/hash/src/unixcrypt.pas @@ -0,0 +1,60 @@ +unit unixcrypt; + +{$mode objfpc} +{$linklib crypt} +{$H+} + +interface + +uses + ctypes; + +function crypt(const key: pchar; const salt: pchar): pchar; cdecl; external; + +// salt helper functions +function gen_des_salt: string; +function gen_md5_salt: string; + +// crypt helper functions +function crypt_password(const key: string; const UseMD5: boolean): string; +function validate_password(const key: string; const hash: string): boolean; + +implementation + +const + salt_chars: array[0..63] of char = ( + 'a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y','z', + 'A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P','Q','R','S','T','U','V','W','X','Y','Z', + '0','1','2','3','4','5','6','7','8','9','.','/'); + +function gen_des_salt: string; +begin + Result := salt_chars[Random(64)] + salt_chars[Random(64)]; +end; + +function gen_md5_salt: string; +var + i: integer; +begin + Result := '$1$'; + for i := 0 to 7 do + Result := Result + salt_chars[Random(64)]; +end; + +function crypt_password(const key: string; const UseMD5: boolean): string; +begin + if UseMD5 then + Result := crypt(pchar(key), pchar(gen_md5_salt)) else + Result := crypt(pchar(key), pchar(gen_des_salt)); +end; + +function validate_password(const key: string; const hash: string): boolean; +begin + Result := + // MD5 compare + ((Length(hash) = 34) and (hash[1] = '$') and (hash[2] = '1') and (hash[3] = '$') and (hash[12] = '$') and (crypt(pchar(key), pchar(copy(hash, 1, 11))) = hash)) or + // DES compare + ((Length(hash) = 13) and (crypt(pchar(key), pchar(copy(hash, 1, 2))) = hash)); +end; + +end. \ No newline at end of file diff --git a/packages/hash/src/uuid.pas b/packages/hash/src/uuid.pas new file mode 100644 index 0000000000..131bc10040 --- /dev/null +++ b/packages/hash/src/uuid.pas @@ -0,0 +1,351 @@ +{ + This file is part of the Free Pascal packages. + Copyright (c) 1999-2006 by the Free Pascal development team + + Implements a UUID generation algorithm (RFC 4122) + + 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 uuid; + +interface + +{$mode objfpc} +{$h+} + +uses + SysUtils, DateUtils, md5; + + + +(****************************************************************************** + * types and constants + ******************************************************************************) + +type + uuid_t = TGuid; + uuid_time_t = qword; + uuid_node_t = array[0..5] of byte; + unsigned16 = word; + + uuid_state = record + ts : uuid_time_t; // saved timestamp + node : uuid_node_t; // saved node ID + cs : unsigned16; // saved clock sequence + end; + +const + UUID_VERSION_1 = $1; // The time-based version specified in this document. + UUID_VERSION_2 = $2; // DCE Security version, with embedded POSIX UIDs. + UUID_VERSION_3 = $3; // The name-based version specified in this document that uses MD5 hashing. + UUID_VERSION_4 = $4; // The randomly or pseudo-randomly generated version specified in this document. + UUID_VERSION_5 = $5; // The name-based version specified in this document that uses SHA-1 hashing. + +{ set the following to the number of 100ns ticks of the actual resolution of your system's clock } + UUIDS_PER_TICK = 1024; + + + +(****************************************************************************** + * core uuid functions + ******************************************************************************) + +{ uuid_initialize -- used to initialize the uuid_create function } +procedure uuid_initialize(const state: uuid_state); + +{ uuid_create -- generator a UUID } +function uuid_create(var uuid: uuid_t): boolean; + +{ uuid_finalize -- returns the current state } +procedure uuid_finalize(var state: uuid_state); + +{ uuid_create_md5_from_name -- create a version 3 (MD5) UUID using a "name" from a "name space" } +procedure uuid_create_md5_from_name(var uuid: uuid_t; const nsid: uuid_t; const name: string); + +{ uuid_create_sha1_from_name -- create a version 5 (SHA-1) UUID using a "name" from a "name space" } +procedure uuid_create_sha1_from_name(var uuid: uuid_t; const nsid: uuid_t; const name: string); + +{ uuid_compare -- Compare two UUID's "lexically" } +function uuid_compare(const u1, u2: uuid_t): integer; + + + +(****************************************************************************** + * auxilary functions + ******************************************************************************) + +{ read_state -- read UUID generator state from non-volatile store } +function read_state(var clockseq: unsigned16; var timestamp: uuid_time_t; var node: uuid_node_t): boolean; + +{ write_state -- save UUID generator state back to non-volatile storage } +procedure write_state(var clockseq: unsigned16; const timestamp: uuid_time_t; const node: uuid_node_t); + +{ format_uuid_v1 -- make a UUID from the timestamp, clockseq, and node ID } +procedure format_uuid_v1(var uuid: uuid_t; const clockseq: unsigned16; const timestamp: uuid_time_t; const node: uuid_node_t); + +{ format_uuid_v3or5 -- make a UUID from a (pseudo)random 128-bit number } +procedure format_uuid_v3or5(var uuid: uuid_t; const hash: pointer; const v: integer); + +{ get_current_time -- get time as 60-bit 100ns ticks since UUID epoch. Compensate for the fact that real clock resolution is less than 100ns. } +procedure get_current_time(var timestamp: uuid_time_t); + + + +(****************************************************************************** + * system functions + ******************************************************************************) + +{ get_system_time -- system dependent call to get the current system time. Returned as 100ns ticks since UUID epoch, but resolution may be less than 100ns. } +procedure get_system_time(var timestamp: uuid_time_t); + +{ true_random -- generate a crypto-quality random number. } +function true_random: unsigned16; + +implementation + + +{ uuid_initialize } + +var + current_state : uuid_state; + current_node : uuid_node_t; + +procedure uuid_initialize(const state: uuid_state); +begin + Randomize; + current_node[0] := Random($100); + current_node[1] := Random($100); + current_node[2] := Random($100); + current_node[3] := Random($100); + current_node[4] := Random($100); + current_node[5] := Random($100); + current_state := state; +end; + + +{ uuid_finalize } + +procedure uuid_finalize(var state: uuid_state); +begin + state := current_state; +end; + + +{ uuid_create } + +function uuid_create(var uuid: TGuid): boolean; +var + timestamp: uuid_time_t; + last_time: uuid_time_t; + clockseq: unsigned16; + last_node: uuid_node_t; + f: boolean; +begin + (* acquire system-wide lock so we're alone *) +// LOCK; + + (* get time, node ID, saved state from non-volatile storage *) + get_current_time(timestamp); + f := read_state(clockseq, last_time, last_node); + + (* if no NV state, or if clock went backwards, or node ID + changed (e.g., new network card) change clockseq *) + if not f or not CompareMem(@current_node, @last_node, sizeof(uuid_node_t)) then + clockseq := true_random() else + if timestamp < last_time then + clockseq := clockseq + 1; + + (* save the state for next time *) + write_state(clockseq, timestamp, current_node); + +// UNLOCK; + + (* stuff fields into the UUID *) + format_uuid_v1(uuid, clockseq, timestamp, current_node); + + Result := true; +end; + + +{ uuid_create_md5_from_name } + +procedure uuid_create_md5_from_name(var uuid: uuid_t; const nsid: uuid_t; const name: string); +var + net_nsid: uuid_t; + c: TMDContext; + hash: TMDDigest; +begin + (* put name space ID in network byte order so it hashes the same + no matter what endian machine we're on *) + net_nsid := nsid; + net_nsid.time_low := ntobe(net_nsid.time_low); + net_nsid.time_mid := ntobe(net_nsid.time_mid); + net_nsid.time_hi_and_version := ntobe(net_nsid.time_hi_and_version); + + MDInit(c, MD_VERSION_5); + MDUpdate(c, net_nsid, sizeof(net_nsid)); + MDUpdate(c, pchar(name)^, Length(name)); + MDFinal(c, hash); + + (* the hash is in network byte order at this point *) + format_uuid_v3or5(uuid, @hash, UUID_VERSION_3); +end; + + +{ uuid_create_sha1_from_name } + +procedure uuid_create_sha1_from_name(var uuid: uuid_t; const nsid: uuid_t; const name: string); +var + net_nsid: uuid_t; +{ c: TMDContext; + hash: TMDDigest;} +begin + (* put name space ID in network byte order so it hashes the same + no matter what endian machine we're on *) + net_nsid := nsid; + net_nsid.time_low := ntobe(net_nsid.time_low); + net_nsid.time_mid := ntobe(net_nsid.time_mid); + net_nsid.time_hi_and_version := ntobe(net_nsid.time_hi_and_version); + + {SHAInit(c, SHA_VERSION_1); + SHAUpdate(c, net_nsid, sizeof(net_nsid)); + SHAUpdate(c, pchar(name)^, Length(name)); + SHAFinal(c, hash);} + + (* the hash is in network byte order at this point *) + format_uuid_v3or5(uuid, @hash, UUID_VERSION_5); +end; + + +{ uuid_compare } + +function uuid_compare(const u1, u2: uuid_t): integer; +begin + Result := pinteger(@u1)[0] - pinteger(@u2)[0]; + if Result <> 0 then Exit; + Result := pinteger(@u1)[1] - pinteger(@u2)[1]; + if Result <> 0 then Exit; + Result := pinteger(@u1)[2] - pinteger(@u2)[2]; + if Result <> 0 then Exit; + Result := pinteger(@u1)[3] - pinteger(@u2)[3]; +end; + + +{ read_state } + +function read_state(var clockseq: unsigned16; var timestamp: uuid_time_t; var node: uuid_node_t): boolean; +begin + clockseq := current_state.cs; + timestamp := current_state.ts; + node := current_state.node; + Result := true; +end; + + +{ write_state } + +procedure write_state(var clockseq: unsigned16; const timestamp: uuid_time_t; const node: uuid_node_t); +begin + (* always save state to volatile shared state *) + current_state.cs := clockseq; + current_state.ts := timestamp; + current_state.node := node; +end; + + +{ format_uuid_v1 } + +procedure format_uuid_v1(var uuid: uuid_t; const clockseq: unsigned16; const timestamp: uuid_time_t; const node: uuid_node_t); +begin + uuid.time_low := timestamp and $FFFFFFFF; + uuid.time_mid := (timestamp shr 32) and $FFFF; + uuid.time_hi_and_version := (timestamp shr 48) and $0FFF; + uuid.time_hi_and_version := uuid.time_hi_and_version or (UUID_VERSION_1 shl 12); + uuid.clock_seq_low := clockseq and $FF; + uuid.clock_seq_hi_and_reserved := (clockseq shr 8) and $3F; + uuid.clock_seq_hi_and_reserved := uuid.clock_seq_hi_and_reserved or $80; + uuid.node := node; +end; + + +{ format_uuid_v3or5 } + +procedure format_uuid_v3or5(var uuid: uuid_t; const hash: pointer; const v: integer); +begin + (* convert UUID to local byte order *) + move(hash^, uuid, sizeof(uuid)); + uuid.time_low := beton(uuid.time_low); + uuid.time_mid := beton(uuid.time_mid); + uuid.time_hi_and_version := beton(uuid.time_hi_and_version); + + (* put in the variant and version bits *) + uuid.time_hi_and_version := uuid.time_hi_and_version and $0FFF; + uuid.time_hi_and_version := uuid.time_hi_and_version or (v shl 12); + uuid.clock_seq_hi_and_reserved := $3F; + uuid.clock_seq_hi_and_reserved := uuid.clock_seq_hi_and_reserved or $80; +end; + + +{ get_current_time } + +var + time_last: uuid_time_t; + uuids_this_tick: unsigned16 = UUIDS_PER_TICK; + +procedure get_current_time(var timestamp: uuid_time_t); +var + time_now: uuid_time_t; +begin + while true do + begin + get_system_time(time_now); + + (* if clock reading changed since last UUID generated, *) + if time_last <> time_now then + begin + (* reset count of uuids gen'd with this clock reading *) + uuids_this_tick := 0; + time_last := time_now; + Break; + end; + + if uuids_this_tick < UUIDS_PER_TICK then + begin + uuids_this_tick := uuids_this_tick + 1; + Break; + end; + + (* going too fast for our clock; spin *) + end; + + (* add the count of uuids to low order bits of the clock reading *) + timestamp := time_now + uuids_this_tick; +end; + + +{ get_system_time } + +procedure get_system_time(var timestamp: uuid_time_t); +var + Epoch:TDateTime; +begin + Epoch := EncodeDateTime(1582, 10, 15, 0, 0, 0, 0); + timestamp := 10000*MilliSecondsBetween(Epoch, Now); +end; + + +{ true_random } + +function true_random: unsigned16; +begin + Result := Random($10000); +end; + +end. -- cgit v1.2.1