[fpc-pascal] HMAC_SHA1 and FPC

[silvioprog]

Eureka!

After spending all day working on it, I finally did it! The pseudo steps
are here:
http://en.wikipedia.org/wiki/Hash-based_message_authentication_code

And, this is the final code (please improves it please):

uses
  SHA1;

function SHA1Raw(const ABuffer; const ABufferLength: PtrUInt): string;
var
  I: Byte;
  VBytes : TBytes;
  VDigest: TSHA1Digest;
  VContext: TSHA1Context;
begin
  Result := '';
  SHA1Init(VContext);
  SHA1Update(VContext, ABuffer, ABufferLength);
  SHA1Final(VContext, VDigest);
  SetLength(VBytes, 20);
  Move(VDigest, VBytes[0], 20);
  for I := 0 to 19 do
    Result := Result + Char(VBytes[I]);
end;

function HMACSHA1(const AKey, AMessage: string): string;
const
  BLOCK_SIZE = 64;
var
  I: Byte;
  VKey: string;
  VLenght: PtrUInt;
  VOPadStr, VIPadStr: string;
  VOPad, VIPad: array[1..BLOCK_SIZE] of Byte;
begin
  VLenght := Length(AKey);
  if VLenght > BLOCK_SIZE then
  begin
    SetLength(VKey, BLOCK_SIZE);
    FillChar(Pointer(VKey)^, BLOCK_SIZE, #0);
    VKey := SHA1Raw(Pointer(AKey)^, VLenght) + VKey;
  end
  else
  begin
    SetLength(VKey, BLOCK_SIZE - VLenght);
    FillChar(Pointer(VKey)^, BLOCK_SIZE - VLenght, #0);
    VKey := AKey + VKey;
  end;
  FillChar(VOPad, BLOCK_SIZE, $5c);
  FillChar(VIPad, BLOCK_SIZE, $36);
  for I := 1 to BLOCK_SIZE do
  begin
    VOPad[I] := VOPad[I] xor Byte(VKey[I]);
    VIPad[I] := VIPad[I] xor Byte(VKey[I]);
  end;
  SetLength(VOPadStr, BLOCK_SIZE);
  Move(VOPad, Pointer(VOPadStr)^, BLOCK_SIZE);
  SetLength(VIPadStr, BLOCK_SIZE);
  Move(VIPad, Pointer(VIPadStr)^, BLOCK_SIZE);
  VIPadStr := VIPadStr + AMessage;
  Result := SHA1Print(SHA1String(VOPadStr +
    SHA1Raw(Pointer(VIPadStr)^, Length(VIPadStr))));
end;

Usage:

WriteLn(HMACSHA1('key', 'The quick brown fox jumped over the lazy dog.')).

Result: 0b7252985d63555b31db4755f37efe218c509711 (same result in PHP, JS
and Phyton! ;) )

So, can you add this code (I'll make HMACMD5 too) in FCL hashes?
(>fpc\VER\source\packages\hash\src)

Thank you very much buddies! :)

-- 
Silvio Clécio
My public projects - github.com/silvioprog
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freepascal.org/pipermail/fpc-pascal/attachments/20130324/241233b4/attachment.html>