2013/3/23 David Butler <djbut...@gmail.com>
> What do you mean by "native"?
>
> It is pure pascal code that compiles under Delphi and FreePascal.
>
> Using it is as easy as:
>
> SHA1DigestToHexA(CalcHMAC_SHA1('secret', 'message')
>
To not implement a big code like this:
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Forms, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
end;
T512BitBuf = array[0..63] of Byte;
T160BitDigest = record
case integer of
0 : (Longs : array[0..4] of LongWord);
1 : (Words : array[0..9] of Word);
2 : (Bytes : array[0..19] of Byte);
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
procedure SHA1InitDigest(var Digest: T160BitDigest);
begin
Digest.Longs[0] := $67452301;
Digest.Longs[1] := $EFCDAB89;
Digest.Longs[2] := $98BADCFE;
Digest.Longs[3] := $10325476;
Digest.Longs[4] := $C3D2E1F0;
end;
function RotateLeftBits(const Value: LongWord; const Bits: Byte): LongWord;
var I : Integer;
begin
Result := Value;
for I := 1 to Bits do
if Result and $80000000 = 0 then
Result := Value shl 1 else
Result := (Value shl 1) or 1;
end;
procedure TransformSHABuffer(var Digest: T160BitDigest; const Buffer; const
SHA1: Boolean);
var A, B, C, D, E : LongWord;
W : array[0..79] of LongWord;
P, Q : PLongWord;
I : Integer;
J : LongWord;
begin
P := @Buffer;
Q := @W;
for I := 0 to 15 do
begin
Q^ := SwapEndian(P^);
Inc(P);
Inc(Q);
end;
for I := 0 to 63 do
begin
P := Q;
Dec(P, 16);
J := P^;
Inc(P, 2);
J := J xor P^;
Inc(P, 6);
J := J xor P^;
Inc(P, 5);
J := J xor P^;
if SHA1 then
J := RotateLeftBits(J, 1);
Q^ := J;
Inc(Q);
end;
A := Digest.Longs[0];
B := Digest.Longs[1];
C := Digest.Longs[2];
D := Digest.Longs[3];
E := Digest.Longs[4];
P := @W;
for I := 0 to 3 do
begin
Inc(E, (A shl 5 or A shr 27) + (D xor (B and (C xor D))) + P^ +
$5A827999); B := B shr 2 or B shl 30; Inc(P);
Inc(D, (E shl 5 or E shr 27) + (C xor (A and (B xor C))) + P^ +
$5A827999); A := A shr 2 or A shl 30; Inc(P);
Inc(C, (D shl 5 or D shr 27) + (B xor (E and (A xor B))) + P^ +
$5A827999); E := E shr 2 or E shl 30; Inc(P);
Inc(B, (C shl 5 or C shr 27) + (A xor (D and (E xor A))) + P^ +
$5A827999); D := D shr 2 or D shl 30; Inc(P);
Inc(A, (B shl 5 or B shr 27) + (E xor (C and (D xor E))) + P^ +
$5A827999); C := C shr 2 or C shl 30; Inc(P);
end;
for I := 0 to 3 do
begin
Inc(E, (A shl 5 or A shr 27) + (D xor B xor C) + P^ + $6ED9EBA1); B
:= B shr 2 or B shl 30; Inc(P);
Inc(D, (E shl 5 or E shr 27) + (C xor A xor B) + P^ + $6ED9EBA1); A
:= A shr 2 or A shl 30; Inc(P);
Inc(C, (D shl 5 or D shr 27) + (B xor E xor A) + P^ + $6ED9EBA1); E
:= E shr 2 or E shl 30; Inc(P);
Inc(B, (C shl 5 or C shr 27) + (A xor D xor E) + P^ + $6ED9EBA1); D
:= D shr 2 or D shl 30; Inc(P);
Inc(A, (B shl 5 or B shr 27) + (E xor C xor D) + P^ + $6ED9EBA1); C
:= C shr 2 or C shl 30; Inc(P);
end;
for I := 0 to 3 do
begin
Inc(E, (A shl 5 or A shr 27) + ((B and C) or (D and (B or C))) + P^ +
$8F1BBCDC); B := B shr 2 or B shl 30; Inc(P);
Inc(D, (E shl 5 or E shr 27) + ((A and B) or (C and (A or B))) + P^ +
$8F1BBCDC); A := A shr 2 or A shl 30; Inc(P);
Inc(C, (D shl 5 or D shr 27) + ((E and A) or (B and (E or A))) + P^ +
$8F1BBCDC); E := E shr 2 or E shl 30; Inc(P);
Inc(B, (C shl 5 or C shr 27) + ((D and E) or (A and (D or E))) + P^ +
$8F1BBCDC); D := D shr 2 or D shl 30; Inc(P);
Inc(A, (B shl 5 or B shr 27) + ((C and D) or (E and (C or D))) + P^ +
$8F1BBCDC); C := C shr 2 or C shl 30; Inc(P);
end;
for I := 0 to 3 do
begin
Inc(E, (A shl 5 or A shr 27) + (D xor B xor C) + P^ + $CA62C1D6); B
:= B shr 2 or B shl 30; Inc(P);
Inc(D, (E shl 5 or E shr 27) + (C xor A xor B) + P^ + $CA62C1D6); A
:= A shr 2 or A shl 30; Inc(P);
Inc(C, (D shl 5 or D shr 27) + (B xor E xor A) + P^ + $CA62C1D6); E
:= E shr 2 or E shl 30; Inc(P);
Inc(B, (C shl 5 or C shr 27) + (A xor D xor E) + P^ + $CA62C1D6); D
:= D shr 2 or D shl 30; Inc(P);
Inc(A, (B shl 5 or B shr 27) + (E xor C xor D) + P^ + $CA62C1D6); C
:= C shr 2 or C shl 30; Inc(P);
end;
Inc(Digest.Longs[0], A);
Inc(Digest.Longs[1], B);
Inc(Digest.Longs[2], C);
Inc(Digest.Longs[3], D);
Inc(Digest.Longs[4], E);
end;
procedure SHA1Buf(var Digest: T160BitDigest; const Buf; const BufSize:
Integer);
var P : PByte;
I, J : Integer;
begin
I := BufSize;
if I <= 0 then
exit;
Assert(I mod 64 = 0, 'BufSize must be multiple of 64 bytes');
P := @Buf;
for J := 0 to I div 64 - 1 do
begin
TransformSHABuffer(Digest, P^, True);
Inc(P, 64);
end;
end;
procedure ReverseMem(var Buf; const BufSize: Integer);
var I : Integer;
P : PByte;
Q : PByte;
T : Byte;
begin
P := @Buf;
Q := P;
Inc(Q, BufSize - 1);
for I := 1 to BufSize div 2 do
begin
T := P^;
P^ := Q^;
Q^ := T;
Inc(P);
Dec(Q);
end;
end;
procedure StdFinalBuf512(
const Buf; const BufSize: Integer; const TotalSize: Int64;
var Buf1, Buf2: T512BitBuf;
var FinalBufs: Integer;
const SwapEndian: Boolean);
var P, Q : PByte;
I : Integer;
L : Int64;
begin
Assert(BufSize < 64, 'Final BufSize must be less than 64 bytes');
Assert(TotalSize >= BufSize, 'TotalSize >= BufSize');
P := @Buf;
Q := @Buf1[0];
if BufSize > 0 then
begin
Move(P^, Q^, BufSize);
Inc(Q, BufSize);
end;
Q^ := $80;
Inc(Q);
L := Int64(TotalSize * 8);
if SwapEndian then
ReverseMem(L, 8);
if BufSize + 1 > 64 - Sizeof(Int64) then
begin
FillChar(Q^, 64 - BufSize - 1, #0);
Q := @Buf2[0];
FillChar(Q^, 64 - Sizeof(Int64), #0);
Inc(Q, 64 - Sizeof(Int64));
PInt64(Q)^ := L;
FinalBufs := 2;
end
else
begin
I := 64 - Sizeof(Int64) - BufSize - 1;
FillChar(Q^, I, #0);
Inc(Q, I);
PInt64(Q)^ := L;
FinalBufs := 1;
end;
end;
procedure SwapEndianBuf(var Buf; const Count: Integer);
var P : PLongWord;
I : Integer;
begin
P := @Buf;
for I := 1 to Count do
begin
P^ := SwapEndian(P^);
Inc(P);
end;
end;
procedure SecureClear(var Buf; const BufSize: Integer);
begin
if BufSize <= 0 then
exit;
FillChar(Buf, BufSize, #$00);
end;
procedure SecureClear512(var Buf: T512BitBuf);
begin
SecureClear(Buf, SizeOf(Buf));
end;
procedure SHA1FinalBuf(var Digest: T160BitDigest; const Buf; const BufSize:
Integer; const TotalSize: Int64);
var B1, B2 : T512BitBuf;
C : Integer;
begin
StdFinalBuf512(Buf, BufSize, TotalSize, B1, B2, C, True);
TransformSHABuffer(Digest, B1, True);
if C > 1 then
TransformSHABuffer(Digest, B2, True);
SwapEndianBuf(Digest, Sizeof(Digest) div Sizeof(LongWord));
SecureClear512(B1);
if C > 1 then
SecureClear512(B2);
end;
function CalcSHA1(const Buf; const BufSize: Integer): T160BitDigest;
var I, J : Integer;
P : PByte;
begin
SHA1InitDigest(Result);
P := @Buf;
if BufSize <= 0 then
I := 0 else
I := BufSize;
J := (I div 64) * 64;
if J > 0 then
begin
SHA1Buf(Result, P^, J);
Inc(P, J);
Dec(I, J);
end;
SHA1FinalBuf(Result, P^, I, BufSize);
end;
procedure HMAC_KeyBlock512(const Key; const KeySize: Integer; var Buf:
T512BitBuf);
var P : PAnsiChar;
begin
Assert(KeySize <= 64);
P := @Buf;
if KeySize > 0 then
begin
Move(Key, P^, KeySize);
Inc(P, KeySize);
end;
FillChar(P^, 64 - KeySize, #0);
end;
procedure XORBlock512(var Buf: T512BitBuf; const XOR8: Byte);
var I : Integer;
begin
for I := 0 to SizeOf(Buf) - 1 do
Buf[I] := Buf[I] xor XOR8;
end;
procedure HMAC_SHA1Init(const Key: Pointer; const KeySize: Integer; var
Digest: T160BitDigest; var K: T512BitBuf);
var D : T160BitDigest;
S : T512BitBuf;
begin
SHA1InitDigest(Digest);
if KeySize > 64 then
begin
D := CalcSHA1(Key^, KeySize);
HMAC_KeyBlock512(D, Sizeof(D), K);
end else
HMAC_KeyBlock512(Key^, KeySize, K);
Move(K, S, SizeOf(K));
XORBlock512(S, $36);
TransformSHABuffer(Digest, S, True);
SecureClear512(S);
end;
procedure HMAC_SHA1Buf(var Digest: T160BitDigest; const Buf; const BufSize:
Integer);
begin
SHA1Buf(Digest, Buf, BufSize);
end;
procedure HMAC_SHA1FinalBuf(const K: T512BitBuf; var Digest: T160BitDigest;
const Buf; const BufSize: Integer; const TotalSize: Int64);
var
FinBuf : packed record
K : T512BitBuf;
D : T160BitDigest;
end;
begin
SHA1FinalBuf(Digest, Buf, BufSize, TotalSize + 64);
Move(K, FinBuf.K, SizeOf(K));
XORBlock512(FinBuf.K, $5C);
Move(Digest, FinBuf.D, SizeOf(Digest));
Digest := CalcSHA1(FinBuf, SizeOf(FinBuf));
SecureClear(FinBuf, SizeOf(FinBuf));
end;
function CalcHMAC_SHA1(const Key: Pointer; const KeySize: Integer; const
Buf; const BufSize: Integer): T160BitDigest;
var I, J : Integer;
P : PByte;
K : T512BitBuf;
begin
HMAC_SHA1Init(Key, KeySize, Result, K);
P := @Buf;
if BufSize <= 0 then
I := 0 else
I := BufSize;
J := (I div 64) * 64;
if J > 0 then
begin
HMAC_SHA1Buf(Result, P^, J);
Inc(P, J);
Dec(I, J);
end;
HMAC_SHA1FinalBuf(K, Result, P^, I, BufSize);
SecureClear512(K);
end;
function CalcHMAC_SHA1(const Key: AnsiString; const Buf; const BufSize:
Integer): T160BitDigest;
begin
Result := CalcHMAC_SHA1(Pointer(Key), Length(Key), Buf, BufSize);
end;
function CalcHMAC_SHA1(const Key, Buf: AnsiString): T160BitDigest;
begin
Result := CalcHMAC_SHA1(Key, Pointer(Buf)^, Length(Buf));
end;
procedure DigestToHexBuf(const Digest; const Size: Integer; const Buf);
const s_HexDigitsLower : String[16] = '0123456789abcdef';
var I : Integer;
P : PAnsiChar;
Q : PByte;
begin
P := @Buf;;
Assert(Assigned(P));
Q := @Digest;
Assert(Assigned(Q));
for I := 0 to Size - 1 do
begin
P^ := s_HexDigitsLower[Q^ shr 4 + 1];
Inc(P);
P^ := s_HexDigitsLower[Q^ and 15 + 1];
Inc(P);
Inc(Q);
end;
end;
function DigestToHex(const Digest; const Size: Integer): AnsiString;
begin
SetLength(Result, Size * 2);
DigestToHexBuf(Digest, Size, Pointer(Result)^);
end;
function SHA1DigestToHex(const Digest: T160BitDigest): AnsiString;
begin
Result := DigestToHex(Digest, Sizeof(Digest));
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text := SHA1DigestToHex(CalcHMAC_SHA1('secret',
'The quick brown fox jumped over the lazy dog.')); //
5d4db2701c7b07de0e23db3e4f22e88bc1a31a49
end;
end.
--
Silvio Clécio
My public projects - github.com/silvioprog
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
