HMAC_SHA1 and FPC

classic Classic list List threaded Threaded
57 messages Options
123
Reply | Threaded
Open this post in threaded view
|

HMAC_SHA1 and FPC

silvioprog
Hello,

How to get HMAC_SHA1 using native functions of FPC?


Thank you!

--
Silvio Clécio
My public projects - github.com/silvioprog

_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: HMAC_SHA1 and FPC

David Butler
Hi

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

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


On Sat, Mar 23, 2013 at 7:28 AM, silvioprog <[hidden email]> wrote:
Hello,

How to get HMAC_SHA1 using native functions of FPC?


Thank you!

--
Silvio Clécio
My public projects - github.com/silvioprog

_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal


_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: HMAC_SHA1 and FPC

Tomas Hajny-2
In reply to this post by silvioprog
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


_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: HMAC_SHA1 and FPC

Tony Whyman
In reply to this post by silvioprog
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.

On 23/03/13 05:28, silvioprog wrote:
Hello,

How to get HMAC_SHA1 using native functions of FPC?


Thank you!

--
Silvio Clécio
My public projects - github.com/silvioprog


_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal


_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: HMAC_SHA1 and FPC

silvioprog
In reply to this post by David Butler
2013/3/23 David Butler <[hidden email]>
Hi

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

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

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

--
Silvio Clécio
My public projects - github.com/silvioprog

_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: HMAC_SHA1 and FPC

silvioprog
In reply to this post by Tomas Hajny-2
2013/3/23 Tomas Hajny <[hidden email]>
On Sat, March 23, 2013 06:28, silvioprog wrote:

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

Tomas

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.

--
Silvio Clécio
My public projects - github.com/silvioprog

_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: HMAC_SHA1 and FPC

silvioprog
In reply to this post by Tony Whyman
2013/3/23 Tony Whyman <[hidden email]>
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.

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

-- 
Silvio Clécio
My public projects - github.com/silvioprog

_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: HMAC_SHA1 and FPC

Tony Whyman
Silvio,

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

Regards

Tony Whyman
MWA

On 23/03/13 15:24, silvioprog wrote:
2013/3/23 Tony Whyman <[hidden email]>
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.

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

-- 
Silvio Clécio
My public projects - github.com/silvioprog


_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal


_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: HMAC_SHA1 and FPC

silvioprog
2013/3/23 Tony Whyman <[hidden email]>
Silvio,

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

Regards

Tony Whyman
MWA

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

-- 
Silvio Clécio
My public projects - github.com/silvioprog

_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: HMAC_SHA1 and FPC

silvioprog
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

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

--
Silvio Clécio
My public projects - github.com/silvioprog

_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: HMAC_SHA1 and FPC

silvioprog
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 <[hidden email]>
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

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

--
Silvio Clécio
My public projects - github.com/silvioprog

_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: HMAC_SHA1 and FPC

David Butler
In reply to this post by 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')

On Sat, Mar 23, 2013 at 5:18 PM, silvioprog <[hidden email]> wrote:
2013/3/23 David Butler <[hidden email]>
Hi

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

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

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

--
Silvio Clécio
My public projects - github.com/silvioprog

_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal


_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: HMAC_SHA1 and FPC

silvioprog
2013/3/23 David Butler <[hidden email]>
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  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: HMAC_SHA1 and FPC

Tomas Hajny-2
In reply to this post by silvioprog
On Sat, March 23, 2013 16:21, silvioprog wrote:

> 2013/3/23 Tomas Hajny <[hidden email]>
>> 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?
>
> 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.

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


_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: 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

_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: HMAC_SHA1 and FPC

silvioprog
Oops...

2013/3/24 silvioprog <[hidden email]>
[...]
Result: 0b7252985d63555b31db4755f37efe218c509711 (same result in PHP, JS and Phyton! ;) )

... Result in my PC: 0b7252985d63555b31db4755f37efe218c509711

-- 
Silvio Clécio
My public projects - github.com/silvioprog

_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: HMAC_SHA1 and FPC

David Butler
In reply to this post by silvioprog
congrats on re-inventing the wheel. all those string allocations/de-allocations could make it slow.

On Sun, Mar 24, 2013 at 6:12 AM, silvioprog <[hidden email]> wrote:
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

_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal


_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: HMAC_SHA1 and FPC

silvioprog
2013/3/24 David Butler <[hidden email]>
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?

-- 
Silvio Clécio
My public projects - github.com/silvioprog

_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: HMAC_SHA1 and FPC

silvioprog
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;

--
Silvio Clécio
My public projects - github.com/silvioprog

_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: HMAC_SHA1 and FPC

silvioprog
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:


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!

--
Silvio Clécio
My public projects - github.com/silvioprog

_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
123