Hello,

How to get HMAC_SHA1 using native functions of FPC?

HMAC_SHA1:
http://en.wikipedia.org/wiki/Hash-based_message_authentication_code#Examples_of_HMAC_.28MD5.2C_SHA1.2C_SHA256.29

Thank you!

Hi

You can find a hash library that supports HMAC-SHA1 here:

http://fundementals.sourceforge.net/dl.html

On Sat, March 23, 2013 06:28, silvioprog wrote:

Hi,

How to get HMAC_SHA1 using native functions of FPC? HMAC_SHA1: http://en.wikipedia.org/wiki/Hash-based_message_authentication_code#Examples_of_HMAC_.28MD5.2C_SHA1.2C_SHA256.29

Doesn't package hash (included with FPC by default for all targets) cover your needs?

Tomas

Silvio,

I had the same requirement for an HMAC and used the DCP library:

http://wiki.freepascal.org/DCPcrypt

I then used the following code snippet to generate the HMAC

Regards

Tony Whyman
MWA

unit hmac;
{$mode objfpc}{$H+}
interface
uses
  Classes, SysUtils;
procedure MakeHMAC(text: string; var seed: LongInt; var hash: string);
function ValidateHMAC(text: string; seed: LongInt; hmac: string): boolean;
implementation
uses DCPsha1;
function GenerateHash(seed: longint; data: string):string;
var b1, b2, b3, b4: byte;
    q: integer;
    sha1: TDCP_sha1;
    buffer: PChar;
    memsize: integer;
    len: integer;
begin
  len := Length(data);
  b1 := seed mod 256;
  q := seed div 256;
  b2 := q mod 256;
  q := q div 256;
  b3 := q mod 256;
  b4 := q div 256;
  sha1 := TDCP_sha1.Create(nil);
  try
    sha1.Init;
    memsize := len + 4;
    buffer := SysGetMem(memsize);
    try
      Move(b1,buffer^,1);
      Move(b2,(buffer+1)^,1);
      Move(b3,(buffer+2)^,1);
      Move(b4,(buffer+3)^,1);
      Move(data[1],(buffer+4)^,len);
      SHA1.Update(buffer^,len+4);
      setlength(Result,20);
      SHA1.Final(Result[1]);
    finally
      SysFreeMem(buffer);
    end;
  finally
    sha1.free;
  end;
end;
procedure MakeHMAC(text: string; var seed: LongInt;
  var hash: string);
begin
       Randomize;
       seed := Round(Random(MaxLongInt));
       hash := GenerateHash(seed,text);
       hash := GenerateHash(seed,hash);
end;
function ValidateHMAC(text: string; seed: LongInt; hmac: string): boolean;
var hash1, hash2: string;
begin
  hash1 := GenerateHash(seed,text);
  hash2 := GenerateHash(seed,hash1);
  Result := CompareMem(@(hmac[1]),@(hash2[1]),20)
end;
end.

2013/3/23 David Butler

But it's not native in Free Pascal. x(

2013/3/23 Tomas Hajny

Yes, the "sha1" unit, but how to do it? I was seeing a function in PHP, but I couldn't port it to the Free Pascal.

2013/3/23 Tony Whyman

Very nice. I will analyze this routine and see if I can remove the dependence of DCP library. Thank you!

Silvio,

Just one extra point - the snippet I sent is example code. It is not intended to be RFC compliant.

Regards

Tony Whyman
MWA

2013/3/23 Tony Whyman

Thank you friend for the answer!

So, seems the Synapse library has the function I'm looking for. I'll compare it with PHP function and if it make hash correctly, I believe that I'll isolate only the part that interests me hehe... :)

Hello,

I could be wrong, but I think that Synapse function have a bug. See:

Using PHP:
<?php
echo hash_hmac("ripemd160", "The quick brown fox jumped over the lazy dog.", "secret");
?>
Result:
b8e7ae12510bdfb1812e463a7f086122cf37e4f7

Using the http://www.freeformatter.com site
Result:
5d4db2701c7b07de0e23db3e4f22e88bc1a31a49

Using Synapse:
uses

  synacode;

begin
Write(HMAC_SHA1('The quick brown fox jumped over the lazy dog.', 'secret');
end.
Result:
]M?p { ? #?>O"?c I

Other PHP function:

<?php
function hmac_sha1($data, $key, $raw_output=FALSE) {
$block_size = 64;   // SHA-1 block size

if (strlen($key) > $block_size) {
$k = pack("H*", sha1($key));
} else {
$k = str_pad($key, $block_Size, "\x00", STR_PAD_RIGHT); }

$ki = '';
 for($i = 0; $i < $block_size; $i++) {
$ki .= chr(ord(substr($k, $i, 1)) ^ 0x36);
}
 $ko = '';
for($i = 0; $i < $block_size; $i++) {
$ko .= chr(ord(substr($k, $i, 1)) ^ 0x5C);
 }

$h = sha1($ko . pack('H*', sha1($ki . $data)));
if ($raw_output) {
return pack('H*', $h);
} else {
return $h;
}
}

echo hmac_sha1("The quick brown fox jumped over the lazy dog.", "secret");
?>

Result:

5d4db2701c7b07de0e23db3e4f22e88bc1a31a49

2013/3/23 silvioprog

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')

2013/3/23 David Butler

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.

Have you also checked the included examples (in particular sha1test.pp)? I haven't used it myself (I had no such need), but it looks quite straightforward to me.

Tomas

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! :)

Oops...

2013/3/24 silvioprog

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

... Result *in my PC*: 0b7252985d63555b31db4755f37efe218c509711

congrats on re-inventing the wheel. all those string allocations/de-allocations could make it slow.

2013/3/24 David Butler

congrats on re-inventing the wheel. all those string allocations/de-allocations could make it slow.

OK, thank you, and what do you suggest to improve this code? Depend on a huge library of third parties and not simply use native code in FCL?

A small improvement:

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;
  VOPad, VIPad: string;
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;
  SetLength(VOPad, BLOCK_SIZE);
  FillChar(Pointer(VOPad)^, BLOCK_SIZE, $5c);
  SetLength(VIPad, BLOCK_SIZE);
  FillChar(Pointer(VIPad)^, BLOCK_SIZE, $36);
  for I := 1 to BLOCK_SIZE do
  begin
    VOPad[I] := Char(Byte(VOPad[I]) xor Byte(VKey[I]));
    VIPad[I] := Char(Byte(VIPad[I]) xor Byte(VKey[I]));
  end;
  VIPad := VIPad + AMessage;
  Result := SHA1Print(SHA1String(VOPad + SHA1Raw(Pointer(VIPad)^,
Length(VIPad))));
end;

My function is more fast that cHash (
http://fundementals.sourceforge.net/dl.html). The comparison result is:

HMAC: 00:00:01:689 cHash: 00:00:02:038

My final unit is:

http://pastebin.com/4484g9i8

The code used in comparison:

uses
  HMAC, cHash;
procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
  b, e: TDateTime;
  x: string;
begin
  b := now;
  for i := 0 to 300000 do
    x := HMACSHA1('secret', 'The quick brown fox jumped over the lazy
dog.');
  e := now;
  Edit1.Text := 'HMAC: ' + FormatDateTime('hh:nn:ss:zzz', b - e);
  b := now;
  for i := 0 to 300000 do
    x := SHA1DigestToHex(CalcHMAC_SHA1('secret', 'The quick brown fox
jumped over the lazy dog.'));
  e := now;
  Edit1.Text := Edit1.Text + ' cHash: ' + FormatDateTime('hh:nn:ss:zzz', b
- e);
end;

I reinvented the wheel, but I can run faster now. :)

Thanks guys!

I changed it to:

http://pastebin.com/mxeWtncP

And now:

cHash: 00:00:02:188 HMAC: 00:00:00:966

2013/3/24 silvioprog

Could you maybe run your unit through some test vectors if you haven't done already? E.g. these: http://tools.ietf.org/html/rfc4231

If that works satisfactory you could create a bug report and we could include it in the hash package.

Regards,
Sven

Oops. Wrong link. I meant this one: http://tools.ietf.org/html/rfc2202 (contains also test vectors for HMAC-MD5).

If that works satisfactory you could create a bug report and we could include it in the hash package.

Regards,
Sven

2013/3/24 Sven Barth

Yes. I'll try to implement it now! :)

For SHA1 this is the final implementation: http://pastebin.com/t4e3tvXa

Now I'll implement it for MD5 conforming http://tools.ietf.org/html/rfc2202, create some samples showing HMACMD5 and HMACSHA1 and finally create a bug report.

Thank you very much Sven! :)

Some comments:
- Maybe you should have HMACSHA1 return a TSHA1Digest; if the user wants a String she can use SHA1Print herself (and HMACMD5 should consequently return a TMD5Digest) [Note: this will work, because the digest always has a fixed length for MD5 and SHA1 and this is also true for HMAC as you can see in the test vectors in RFC2202)
- I'm not that happy with SHA1Raw and the constants being exported in the interface...

Regards,
Sven

2013/3/24 Sven Barth

Hm... You are right. Those looking for more speed might prefer TSHA1Digest. I'll use TSHA1Digest instead string.

So, I'm tested the test cases and all worked fine, ex (test 2):

=====

test_case = 2
key = "Jefe"
key_len = 4
data = "what do ya want for nothing?"
data_len = 28
digest = 0xeffcdf6ae5eb2fa2d27416d5f184df9c259a7c79

=====

  with TFileStream.Create('test.txt', fmCreate) do
  try
    X := HMACSHA1('Jefe', 'what do ya want for nothing?');
    Write(Pointer(X)^, Length(X));
  finally
    Free;
  end;

Content in test.txt: effcdf6ae5eb2fa2d27416d5f184df9c259a7c79. Perfect! :-*

- I'm not that happy with SHA1Raw and the constants being exported in the

interface...

:/ I also think not. I'll remove it from the interface.

Thank you.

Thank you as well :)

Regards,
Sven

Done for SHA1! :)

Attachment the ZIP file with src, example and test case.

Now, I'll implement support for MD5!

Thank guys!

Please discart the *hmac-sha1only.zip*. I improved the routines for SHA1 ( http://pastebin.com/PKdL2xx7).

I'll finish all codes (MD5/SHA1) tomorrow. Now I'm implementing the test cases (seven for MD5 and nine for SHA1), and this will take a little time.

Wait ...

Oops ...

2013/3/25 silvioprog
[...]

(seven for MD5 and nine for SHA1), ...

... seven for both.

...because you must convert binary string into hexadecimal string, if you wish. Use:

write(StrToHex(HMAC_SHA1('The quick brown fox jumped over the lazy
dog.', 'secret')));

2013/3/25 Lukas Gebauer

Hello Lukas, thank you very much for the information friend. :)

I've a friend who uses Synapse with Delphi and I'll indicate this routine! ;)

2013/3/24 Sven Barth

Done.

http://bugs.freepascal.org/view.php?id=24136

The patch includes source, examples and test cases (7 for MD5 and 7 for SHA1).

I use OpenSSL for this stuff, which can be compiled directly into your project.

{$ifdef windows}
// optionally link library into the project
{$define static}
{$endif}
{$ifdef static}
  {$define libssl := external}
  {$define libeay := external}
{$else}
  {$ifdef unix}
  {$define libssl := external 'libssl.so'}
  {$define libeay := external 'libssl.so'}
  {$else}
  {$define libssl := external 'libssl32.dll'}
    {$define libeay := external 'libeay32.dll'}
  {$endif}
{$endif}
function SSL_library_init: Integer; cdecl; libssl;
procedure SSL_load_error_strings; cdecl; libssl;
function SSLv23_client_method: TSSLMethod; cdecl; libssl;
function SSL_CTX_new(method: TSSLMethod): TSSLCtx; cdecl; libssl;
procedure SSL_CTX_free(context: TSSLCtx); cdecl; libssl;
function SSL_new(context: TSSLCtx): TSSL; cdecl; libssl;
function SSL_shutdown(ssl: TSSL): LongInt; cdecl; libssl;
procedure SSL_free(ssl: TSSL); cdecl; libssl;
function SSL_set_fd(ssl: TSSL; socket: LongInt): LongBool; cdecl; libssl;
function SSL_connect(ssl: TSSL): LongBool; cdecl; libssl;
function SSL_write(ssl: TSSL; buffer: Pointer; size: LongWord): LongInt;
cdecl; libssl;
function SSL_read(ssl: TSSL; buffer: Pointer; size: LongWord): LongInt;
cdecl; libssl;
function SSL_get_error(ssl: TSSL; ret_code: Integer): Integer; cdecl;
libssl;

{ Hashing routines }

function MD5_Init(out context: TMD5Ctx): LongBool; cdecl; libeay;
function MD5_Update(var context: TMD5Ctx; data: Pointer; size: Cardinal):
LongBool; cdecl; libeay;
function MD5_Final(out digest: TMD5Digest; var context: TMD5Ctx): LongBool;
cdecl; libeay;
function SHA1_Init(out context: TSHA1Ctx): LongBool; cdecl; libeay;
function SHA1_Update(var context: TSHA1Ctx; data: Pointer; size: Cardinal):
LongBool; cdecl; libeay;
function SHA1_Final(out digest: TSHA1Digest; var context: TSHA1Ctx):
LongBool; cdecl; libeay;
function SHA256_Init(out context: TSHA256Ctx): LongBool; cdecl; libeay;
function SHA256_Update(var context: TSHA256Ctx; data: Pointer; size:
Cardinal): LongBool; cdecl; libeay;
function SHA256_Final(out digest: TSHA256Digest; var context: TSHA256Ctx):
LongBool; cdecl; libeay;
function SHA512_Init(out context: TSHA512Ctx): LongBool; cdecl; libeay;
function SHA512_Update(var context: TSHA512Ctx; data: Pointer; size:
Cardinal): LongBool; cdecl; libeay;
function SHA512_Final(out digest: TSHA512Digest; var context: TSHA512Ctx):
LongBool; cdecl; libeay;
function EVP_md5: TEVPMethod; cdecl; libeay;
function EVP_sha1: TEVPMethod; cdecl; libeay;
function EVP_sha256: TEVPMethod; cdecl; libeay;
function EVP_sha512: TEVPMethod; cdecl; libeay;
procedure HMAC_CTX_init(out context: THMACCtx); cdecl; libeay;
procedure HMAC_CTX_cleanup(var context: THMACCtx); cdecl; libeay;
function HMAC_Init_ex(var context: THMACCtx; key: Pointer; size: Cardinal;
method: TEVPMethod; engine: Pointer): LongBool; cdecl; libeay;
function HMAC_Update(var context: THMACCtx; data: Pointer; size: Cardinal):
LongBool; cdecl; libeay;
function HMAC_Final(var context: THMACCtx; digest: Pointer; var digestSize:
LongWord): LongBool; cdecl; libeay;
implementation
{$ifdef static}
{$linklib libssl.a}
{$linklib libcrypto.a}
{$endif}

2013/3/26 Anthony Walter

Nice.

But there situations that the user does not have the OpenSSL lib.

The routines I sent does not depend on external libs.

It's possible to build static lib files for Win 32 and 64 on Linux.

... download the sources from here http://www.openssl.org/source/ then ...

sudo apt-get install mingw-w64

... goto the OpenSSL source directory and ...

CROSS_COMPILE="i686-w64-mingw32-" ./Configure mingw64 no-asm shared make
CROSS_COMPILE="x86_64-w64-mingw32-" ./Configure mingw64 no-asm shared make

... and copy libcrypto.a and libssl.a to a FPC lib path ...

Now you can compile for Win 32/64 using OpenSSL static lib files.

2013/3/26 Anthony Walter

o.o'

Don't know why so much work if you can use it directly from the FCL.

silvioprog wrote

Don't know why so much work if you can use it directly from the FCL.

Because...

OpenSSL is quite robust, well documented. tested, and proven OpenSSL provides a full compilement of cryptography and hashing functions On Linux/OSX you can link to external shared object files, which further reduces project build size and system resources

Side benefit: OpenSSL also provides a simple secure socket implementation, which many times pairs nicely along with SHA/HMAC

2013/3/26 Anthony Walter

I don't know if you noticed, but I sent the ALL test cases required by the RFC 2202 (http://tools.ietf.org/html/rfc2202), i.e., it's enough to check whether the algorithm it's well implemented or not.

I'll await the answer of the staff of Core, because for me the final answer is theirs.

I wasn't asking you to stop your work, rather I was attempting to share insights and my opinions with the group. My point in the previous message was that many times it make sense to reuse something which works, and possibly part of the operating system, rather than recreating that which already exists.

2013/3/26 Anthony Walter

OK, sorry.

I'm rooting for them implement it direct in FCL. The routines in hmac.pp will fall like a glove.

We already have a "hash" package and I'm all for improving/extending it. This can prove especially useful for platforms where OpenSSL is not supported (think the embedded targets or similar here). Also I'm a big fan of "as less non-Pascal dependencies as possible" :)

Regards,
Sven

Hi,
Is possible to make that only using Windows for any lib?

Best regards,
Marcos Douglas

Marcos,

Are you asking, "Is it possible to build any static lib for Windows and link it to a free pascal project"?

No, not all the time. Libraries may depend on systems function on one platform which are not available on another.

But, many times you can if the library can compile with mingw64. When this is the case you build a C project using mingw64, copy the lib files to a directory free pascal is using (see environment settings in lazarus), list the functions in a unit, then put {$linklib youlibname.a} in the implementation section. You may need a few {$ifdef}s for your different platforms.

The benefit of this is that you can easily incorporate (much more easily rewriting) *complex* functionality into your free pascal projects knowing what you are reusing is probably faster, has more features, is more robust, and better tested than a implementation of X that someone reinvented again for free pascal.

Sometimes though you might be are better off using dynamic linking (so, dll on windows) if you know the OS is going to provide features. Examples are msxml.dll vs libxml2.so, gdiplus.dll vs libcario.so, ect. Of course in these cases what probably you need to do is write some lite wrappers, since the apis vary in form (but not function). In those cases I typically use interfaces...

IXmlDocument, IXmlNode // for pasring or building Xml ICanvas, IBrush // for drawing

and then

function CreateXmlDocument: IXmlDocument; {$fidef}s
function CreateCanvas: ICanvas; {$fidef}s

Another advantage of OpenSSL is performance. Especially on x64 where OpenSSL is an order of magnitude faster than fe. the synapse sha1 implementation. It uses assembly to optimize code. I doubt that will ever be done in a FPC library.

Ludo

Yes, that's it. Thank you.

I had seen this $linklib but I did not know what it was for.

Good ideas. Thank you for share.

Marcos Douglas

2013/3/26 Sven Barth

+1.

And I'm sure the hmac is fast as anything else out there who write, even using libs maked in C/C+. :)

If someone provides a patch to additionally add assembly versions to cryptographic algorithms I doubt that we'll turn them down...

Regards,
Sven

Hi,

Actually I think on OS X and Linux it makes sense to depend on OpenSSL, but not for the reasons you mentioned so much as one more: Security. If you are using doing encryption, then it's better to use a library that is updated more often for bug fixes, and to have the updates be applied to your program automatically. If you static-link it in, it will never be updated until you update it and ship a new version of your program and everyone installs it. If you dynamically link to it, then then the operating system updates it, you get the updates "for free".

After bad past experiences with VB and OCX files that broke all the time, and Java (enough said), I vastly prefer to use Pascal code in most cases and have everything linked static (less moving parts = less to break) - but there can be exceptions. (I use SQLite a lot, which isn't included by default in Windows). For HMAC only though I just use Synapse.

Thank you,
Noah Silva

2013/3/26 Anthony Walter

2013/4/2 Noah Silva

Well, who wants to link and configure an entire DLL to use only a single function, so be it. Who wants to use and configure an entire lib (Synapse, DCPcrypt etc) to use only a single function, so be it. But nothing prevents that it being implemented directly in the FCL, quick to declare/use.

Sorry, but I'll stop commenting in this topic. Now I feel like a dog trying to chasing its own tail (
http://stream1.gifsoup.com/webroot/animatedgifs6/2077970_o.gif). :p

Noah Silva wrote

Actually I think on OS X and Linux it makes sense to depend on OpenSSL, but not for the reasons you mentioned so much as one more: Security.

That's probably why the previous poster wrote robust etc. Sounds like security attributes to me.

If you feel so strongly about it, why not submit a patch that uses OpenSSL on platforms that are sure to have it and use Silvio's native code for others?

Hi Reinier,

2013/4/2 Reinier Olislagers

Haha I was just mentioning one positive benefit. Also, I am pretty sure Synapse can use the OpenSSL DLLs.

I am much more likely to submit some patches to the OS X GUI for Lazarus that I have been fixing in the last week or so. We'll see.

Thank you,
Noah Silva

p.s.: I don't see a big deal in pulling in something like Synapse so long as it compiles easily for your platform. You don't have to use all the units, and the linker shouldn't even include all of the code from the units you do use. If you only use one function that is mostly contained (like HMAC), then it shouldn't add much to your program's size in the scheme of things. I don't like when people use things that aren't really needed mainly because you have to then download them and pray they compile on your setup. (And in some cases, recompile Lazarus!). For more common things that "just work", I have no issue.

Depends. If you're using (say) a hash function to store a token in lieu of a password then the important thing is that this behaves consistently across platforms and program versions. If an external library eliminated a potential security flaw (the most common case being when null text was processed) that might be significant in the case of key scheduling for data transfer over an insecure channel, but not for purely local storage.

As usual, there's little substitute for the original programmer knowing what he's doing, and for him documenting what he's done so that maintainers know what sort of external event can cause an issue.

Yep.

I am much more likely to submit some patches to the OS X GUI for Lazarus that I have been fixing in the last week or so. We'll see.

That does seem like a more worthwhile area, yes....

Thank you, Noah Silva

No worries,
Reinier

Agreed - Synapse is nicely self-contained and modular.

Well, yes. But you can hardly limit use of the function to local storage only.

As usual, there's little substitute for the original programmer knowing what he's doing, and for him documenting what he's done so that maintainers know what sort of external event can cause an issue.

... and prove it works/interoperates by including a test set, as I think Silvio has done.

Noah Silva wrote

Haha I was just mentioning one positive benefit. Also, I am pretty sure Synapse can use the OpenSSL DLLs.

it does... and on at least three platforms, too... winwhatever, *nix and OS2...

Hi

Thank very much Silvio for share this, today I was looking for a code for HMACMD5 and I don't wanna use a big library like Dcpcrypt or Synapse or Opennssl, when I develop for embedded platform I try to avoid dependencies as much as possible.

Best regards.