mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-16 00:09:17 +02:00
+ sha1 unit by Sergei Gorelkin, resolves #14604
git-svn-id: trunk@13727 -
This commit is contained in:
florian
parent
07ef0c33df
commit
ce773b759d
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -2595,6 +2595,7 @@ packages/hash/fpmake.pp svneol=native#text/plain
|
||||
packages/hash/src/crc.pas svneol=native#text/plain
|
||||
packages/hash/src/md5.pp svneol=native#text/plain
|
||||
packages/hash/src/ntlm.pas svneol=native#text/plain
|
||||
packages/hash/src/sha1.pp svneol=native#text/plain
|
||||
packages/hash/src/unixcrypt.pas svneol=native#text/plain
|
||||
packages/hash/src/uuid.pas svneol=native#text/plain
|
||||
packages/hermes/Makefile svneol=native#text/plain
|
||||
@ -8061,6 +8062,7 @@ tests/test/packages/fcl-db/tdb6.pp svneol=native#text/plain
|
||||
tests/test/packages/fcl-db/toolsunit.pas svneol=native#text/plain
|
||||
tests/test/packages/fcl-registry/tregistry1.pp svneol=native#text/plain
|
||||
tests/test/packages/fcl-xml/thtmlwriter.pp svneol=native#text/plain
|
||||
tests/test/packages/hash/sha1test.pp svneol=native#text/plain
|
||||
tests/test/packages/hash/tmdtest.pp svneol=native#text/plain
|
||||
tests/test/packages/webtbs/tw10045.pp svneol=native#text/plain
|
||||
tests/test/packages/webtbs/tw11142.pp svneol=native#text/plain
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
#
|
||||
# Don't edit, this file is generated by FPCMake Version 2.0.0 [2009/08/02]
|
||||
# Don't edit, this file is generated by FPCMake Version 2.0.0 [2009/09/16]
|
||||
#
|
||||
default: all
|
||||
MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded
|
||||
@ -267,178 +267,178 @@ PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(F
|
||||
override PACKAGE_NAME=hash
|
||||
override PACKAGE_VERSION=2.5.1
|
||||
ifeq ($(FULL_TARGET),i386-linux)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid unixcrypt
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1 unixcrypt
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-go32v2)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-win32)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-os2)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-freebsd)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-beos)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-haiku)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-netbsd)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-solaris)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-qnx)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-netware)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-openbsd)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-wdosx)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-darwin)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-emx)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-watcom)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-netwlibc)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-wince)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-embedded)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-symbian)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-linux)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid unixcrypt
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1 unixcrypt
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-freebsd)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-netbsd)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-amiga)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-atari)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-openbsd)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-palmos)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),m68k-embedded)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-linux)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid unixcrypt
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1 unixcrypt
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-netbsd)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-amiga)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-macos)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-darwin)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-morphos)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc-embedded)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),sparc-linux)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid unixcrypt
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1 unixcrypt
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),sparc-netbsd)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),sparc-solaris)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),sparc-embedded)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),x86_64-linux)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid unixcrypt
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1 unixcrypt
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),x86_64-freebsd)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),x86_64-darwin)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),x86_64-win64)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),x86_64-embedded)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-linux)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid unixcrypt
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1 unixcrypt
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-palmos)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-darwin)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-wince)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-gba)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-nds)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-embedded)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),arm-symbian)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc64-linux)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid unixcrypt
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1 unixcrypt
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc64-darwin)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),powerpc64-embedded)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),avr-embedded)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),armeb-linux)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid unixcrypt
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1 unixcrypt
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),armeb-embedded)
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid
|
||||
override TARGET_UNITS+=md5 crc ntlm uuid sha1
|
||||
endif
|
||||
ifeq ($(FULL_TARGET),i386-linux)
|
||||
override TARGET_EXAMPLEDIRS+=examples
|
||||
|
||||
@ -7,7 +7,7 @@ name=hash
|
||||
version=2.5.1
|
||||
|
||||
[target]
|
||||
units=md5 crc ntlm uuid
|
||||
units=md5 crc ntlm uuid sha1
|
||||
units_linux=unixcrypt
|
||||
exampledirs=examples
|
||||
|
||||
|
||||
@ -26,6 +26,7 @@ begin
|
||||
|
||||
P.Version:='2.2.2-0';
|
||||
T:=P.Targets.AddUnit('src/md5.pp');
|
||||
T:=P.Targets.AddUnit('src/sha1.pp');
|
||||
T:=P.Targets.AddUnit('src/crc.pas');
|
||||
T:=P.Targets.AddUnit('src/ntlm.pas');
|
||||
T:=P.Targets.AddUnit('src/uuid.pas');
|
||||
|
||||
305
packages/hash/src/sha1.pp
Normal file
305
packages/hash/src/sha1.pp
Normal file
@ -0,0 +1,305 @@
|
||||
{
|
||||
This file is part of the Free Pascal packages.
|
||||
Copyright (c) 2009 by the Free Pascal development team
|
||||
|
||||
Implements a SHA-1 digest algorithm (RFC 3174)
|
||||
|
||||
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 sha1;
|
||||
{$mode objfpc}{$h+}
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
TSHA1Digest = array[0..19] of Byte;
|
||||
|
||||
TSHA1Context = record
|
||||
State: array[0..4] of Cardinal;
|
||||
Buffer: array[0..63] of Byte;
|
||||
BufCnt: PtrUInt; { in current block, i.e. in range of 0..63 }
|
||||
Length: QWord; { total count of bytes processed }
|
||||
end;
|
||||
|
||||
{ core }
|
||||
procedure SHA1Init(var ctx: TSHA1Context);
|
||||
procedure SHA1Update(var ctx: TSHA1Context; const Buf; BufLen: PtrUInt);
|
||||
procedure SHA1Final(var ctx: TSHA1Context; var Digest: TSHA1Digest);
|
||||
|
||||
{ auxiliary }
|
||||
function SHA1String(const S: String): TSHA1Digest;
|
||||
function SHA1Buffer(const Buf; BufLen: PtrUInt): TSHA1Digest;
|
||||
function SHA1File(const Filename: String; const Bufsize: PtrUInt = 1024): TSHA1Digest;
|
||||
|
||||
{ helpers }
|
||||
function SHA1Print(const Digest: TSHA1Digest): String;
|
||||
function SHA1Match(const Digest1, Digest2: TSHA1Digest): Boolean;
|
||||
|
||||
implementation
|
||||
|
||||
// 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[3] or (S[2] shl 8) or (S[1] shl 16) or (S[0] shl 24);
|
||||
inc(S,4);
|
||||
inc(T);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SHA1Init(var ctx: TSHA1Context);
|
||||
begin
|
||||
FillChar(ctx, sizeof(TSHA1Context), 0);
|
||||
ctx.State[0] := $67452301;
|
||||
ctx.State[1] := $efcdab89;
|
||||
ctx.State[2] := $98badcfe;
|
||||
ctx.State[3] := $10325476;
|
||||
ctx.State[4] := $c3d2e1f0;
|
||||
end;
|
||||
|
||||
const
|
||||
K20 = $5A827999;
|
||||
K40 = $6ED9EBA1;
|
||||
K60 = $8F1BBCDC;
|
||||
K80 = $CA62C1D6;
|
||||
|
||||
procedure SHA1Transform(var ctx: TSHA1Context; Buf: Pointer);
|
||||
var
|
||||
A, B, C, D, E, T: Cardinal;
|
||||
Data: array[0..15] of Cardinal;
|
||||
i: Integer;
|
||||
begin
|
||||
A := ctx.State[0];
|
||||
B := ctx.State[1];
|
||||
C := ctx.State[2];
|
||||
D := ctx.State[3];
|
||||
E := ctx.State[4];
|
||||
Invert(Buf, @Data, 64);
|
||||
{$push}
|
||||
{$r-,q-}
|
||||
i := 0;
|
||||
repeat
|
||||
T := (B and C) or (not B and D) + K20 + E;
|
||||
E := D;
|
||||
D := C;
|
||||
C := rordword(B, 2);
|
||||
B := A;
|
||||
A := T + roldword(A, 5) + Data[i and 15];
|
||||
Data[i and 15] := roldword(Data[i and 15] xor Data[(i+2) and 15] xor Data[(i+8) and 15] xor Data[(i+13) and 15], 1);
|
||||
Inc(i);
|
||||
until i > 19;
|
||||
|
||||
repeat
|
||||
T := (B xor C xor D) + K40 + E;
|
||||
E := D;
|
||||
D := C;
|
||||
C := rordword(B, 2);
|
||||
B := A;
|
||||
A := T + roldword(A, 5) + Data[i and 15];
|
||||
Data[i and 15] := roldword(Data[i and 15] xor Data[(i+2) and 15] xor Data[(i+8) and 15] xor Data[(i+13) and 15], 1);
|
||||
Inc(i);
|
||||
until i > 39;
|
||||
|
||||
repeat
|
||||
T := (B and C) or (B and D) or (C and D) + K60 + E;
|
||||
E := D;
|
||||
D := C;
|
||||
C := rordword(B, 2);
|
||||
B := A;
|
||||
A := T + roldword(A, 5) + Data[i and 15];
|
||||
Data[i and 15] := roldword(Data[i and 15] xor Data[(i+2) and 15] xor Data[(i+8) and 15] xor Data[(i+13) and 15], 1);
|
||||
Inc(i);
|
||||
until i > 59;
|
||||
|
||||
repeat
|
||||
T := (B xor C xor D) + K80 + E;
|
||||
E := D;
|
||||
D := C;
|
||||
C := rordword(B, 2);
|
||||
B := A;
|
||||
A := T + roldword(A, 5) + Data[i and 15];
|
||||
Data[i and 15] := roldword(Data[i and 15] xor Data[(i+2) and 15] xor Data[(i+8) and 15] xor Data[(i+13) and 15], 1);
|
||||
Inc(i);
|
||||
until i > 79;
|
||||
|
||||
Inc(ctx.State[0], A);
|
||||
Inc(ctx.State[1], B);
|
||||
Inc(ctx.State[2], C);
|
||||
Inc(ctx.State[3], D);
|
||||
Inc(ctx.State[4], E);
|
||||
{$pop}
|
||||
Inc(ctx.Length,64);
|
||||
end;
|
||||
|
||||
procedure SHA1Update(var ctx: TSHA1Context; const Buf; BufLen: PtrUInt);
|
||||
var
|
||||
Src: PByte;
|
||||
Num: PtrUInt;
|
||||
begin
|
||||
if BufLen = 0 then
|
||||
Exit;
|
||||
|
||||
Src := @Buf;
|
||||
Num := 0;
|
||||
|
||||
// 1. Transform existing data in buffer
|
||||
if ctx.BufCnt > 0 then
|
||||
begin
|
||||
// 1.1 Try to fill buffer up to block size
|
||||
Num := 64 - ctx.BufCnt;
|
||||
if Num > BufLen then
|
||||
Num := BufLen;
|
||||
|
||||
Move(Src^, ctx.Buffer[ctx.BufCnt], Num);
|
||||
Inc(ctx.BufCnt, Num);
|
||||
Inc(Src, Num);
|
||||
|
||||
// 1.2 If buffer is filled, transform it
|
||||
if ctx.BufCnt = 64 then
|
||||
begin
|
||||
SHA1Transform(ctx, @ctx.Buffer);
|
||||
ctx.BufCnt := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
// 2. Transform input data in 64-byte blocks
|
||||
Num := BufLen - Num;
|
||||
while Num >= 64 do
|
||||
begin
|
||||
SHA1Transform(ctx, Src);
|
||||
Inc(Src, 64);
|
||||
Dec(Num, 64);
|
||||
end;
|
||||
|
||||
// 3. If there's less than 64 bytes left, add it to buffer
|
||||
if Num > 0 then
|
||||
begin
|
||||
ctx.BufCnt := Num;
|
||||
Move(Src^, ctx.Buffer, Num);
|
||||
end;
|
||||
end;
|
||||
|
||||
const
|
||||
PADDING: array[0..63] of Byte =
|
||||
($80,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
|
||||
);
|
||||
|
||||
procedure SHA1Final(var ctx: TSHA1Context; var Digest: TSHA1Digest);
|
||||
var
|
||||
Length: QWord;
|
||||
Pads: Cardinal;
|
||||
begin
|
||||
// 1. Compute length of the whole stream in bits
|
||||
Length := 8 * (ctx.Length + ctx.BufCnt);
|
||||
|
||||
// 2. Append padding bits
|
||||
if ctx.BufCnt >= 56 then
|
||||
Pads := 120 - ctx.BufCnt
|
||||
else
|
||||
Pads := 56 - ctx.BufCnt;
|
||||
SHA1Update(ctx, PADDING, Pads);
|
||||
|
||||
// 3. Append length of the stream (8 bytes)
|
||||
Length := NtoBE(Length);
|
||||
SHA1Update(ctx, Length, 8);
|
||||
|
||||
// 4. Invert state to digest
|
||||
Invert(@ctx.State, @Digest, 20);
|
||||
FillChar(ctx, sizeof(TSHA1Context), 0);
|
||||
end;
|
||||
|
||||
function SHA1String(const S: String): TSHA1Digest;
|
||||
var
|
||||
Context: TSHA1Context;
|
||||
begin
|
||||
SHA1Init(Context);
|
||||
SHA1Update(Context, PChar(S)^, length(S));
|
||||
SHA1Final(Context, Result);
|
||||
end;
|
||||
|
||||
function SHA1Buffer(const Buf; BufLen: PtrUInt): TSHA1Digest;
|
||||
var
|
||||
Context: TSHA1Context;
|
||||
begin
|
||||
SHA1Init(Context);
|
||||
SHA1Update(Context, buf, buflen);
|
||||
SHA1Final(Context, Result);
|
||||
end;
|
||||
|
||||
function SHA1File(const Filename: String; const Bufsize: PtrUInt): TSHA1Digest;
|
||||
var
|
||||
F: File;
|
||||
Buf: Pchar;
|
||||
Context: TSHA1Context;
|
||||
Count: Cardinal;
|
||||
ofm: Longint;
|
||||
begin
|
||||
SHA1Init(Context);
|
||||
|
||||
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
|
||||
SHA1Update(Context, Buf^, Count);
|
||||
until Count < BufSize;
|
||||
FreeMem(Buf, BufSize);
|
||||
Close(F);
|
||||
end;
|
||||
|
||||
SHA1Final(Context, Result);
|
||||
FileMode := ofm;
|
||||
end;
|
||||
|
||||
const
|
||||
HexTbl: array[0..15] of char='0123456789abcdef'; // lowercase
|
||||
|
||||
function SHA1Print(const Digest: TSHA1Digest): String;
|
||||
var
|
||||
I: Integer;
|
||||
P: PChar;
|
||||
begin
|
||||
SetLength(Result, 40);
|
||||
P := Pointer(Result);
|
||||
for I := 0 to 19 do
|
||||
begin
|
||||
P[0] := HexTbl[(Digest[i] shr 4) and 15];
|
||||
P[1] := HexTbl[Digest[i] and 15];
|
||||
Inc(P,2);
|
||||
end;
|
||||
end;
|
||||
|
||||
function SHA1Match(const Digest1, Digest2: TSHA1Digest): Boolean;
|
||||
var
|
||||
A: array[0..4] of Cardinal absolute Digest1;
|
||||
B: array[0..4] 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]) and (A[4] = B[4]);
|
||||
end;
|
||||
|
||||
end.
|
||||
38
tests/test/packages/hash/sha1test.pp
Normal file
38
tests/test/packages/hash/sha1test.pp
Normal file
@ -0,0 +1,38 @@
|
||||
program sha1test;
|
||||
{$mode objfpc}{$h+}
|
||||
|
||||
uses sha1;
|
||||
|
||||
var
|
||||
code: cardinal;
|
||||
s, sdig: string;
|
||||
i: integer;
|
||||
ctx: TSHA1Context;
|
||||
d: TSHA1Digest;
|
||||
begin
|
||||
code := 0;
|
||||
sdig := SHA1Print(SHA1String('abc'));
|
||||
if sdig <> 'a9993e364706816aba3e25717850c26c9cd0d89d' then
|
||||
code := code or 1;
|
||||
|
||||
sdig := SHA1Print(SHA1String('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq'));
|
||||
if sdig <> '84983e441c3bd26ebaae4aa1f95129e5e54670f1' then
|
||||
code := code or 2;
|
||||
|
||||
// SHA-1 of a million 'a' symbols
|
||||
SetLength(s, 1000);
|
||||
for i := 1 to 1000 do s[i] := 'a';
|
||||
SHA1Init(ctx);
|
||||
for i := 0 to 999 do
|
||||
SHA1Update(ctx, PChar(s)^, 1000);
|
||||
SHA1Final(ctx, d);
|
||||
sdig := SHA1Print(d);
|
||||
if sdig <> '34aa973cd4c4daa4f61eeb2bdbad27316534016f' then
|
||||
code := code or 4;
|
||||
|
||||
if code = 0 then
|
||||
writeln('Basic SHA-1 tests passed')
|
||||
else
|
||||
writeln('SHA-1 tests failed: ', code);
|
||||
Halt(code);
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user