Add implementation of HMAC-MD5 and HMAC-SHA1 from Silvio Clecio. Resolves Mantis #24136

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@27319 3ad0048d-3df7-0310-abae-a5850022a9f2

6 files changed, 512 insertions, 2 deletions

diff --git a/packages/hash/examples/hmd5.pp b/packages/hash/examples/hmd5.pp
new file mode 100644
index 0000000000..5c0cc31d3f
--- /dev/null
+++ b/packages/hash/examples/hmd5.pp
@@ -0,0 +1,15 @@
+// See some samples in: http://en.wikipedia.org/wiki/Hash-based_message_authentication_code
+program hmd5;
+
+{$mode objfpc}{$H+}
+
+uses
+  HMAC;
+
+begin
+  // for HMAC_MD5("", "") = 0x74e6f7298a9c2d168935f58c001bad88
+  WriteLn('Example 1: ', HMACMD5Print(HMACMD5Digest('', '')));
+  // for HMAC_MD5("key", "The quick brown fox jumps over the lazy dog") = 0x80070713463e7749b90c2dc24911e275
+  WriteLn('Example 2: ', HMACMD5('key', 'The quick brown fox jumps over the lazy dog'));
+end.
+
diff --git a/packages/hash/examples/hsha1.pp b/packages/hash/examples/hsha1.pp
new file mode 100644
index 0000000000..5a79c53c1e
--- /dev/null
+++ b/packages/hash/examples/hsha1.pp
@@ -0,0 +1,15 @@
+// See some samples in: http://en.wikipedia.org/wiki/Hash-based_message_authentication_code
+program hsha1;
+
+{$mode objfpc}{$H+}
+
+uses
+  HMAC;
+
+begin
+  // for HMAC_SHA1("", "") = 0xfbdb1d1b18aa6c08324b7d64b71fb76370690e1d
+  WriteLn('Example 1: ', HMACSHA1Print(HMACSHA1Digest('', '')));
+  // for HMAC_SHA1("key", "The quick brown fox jumps over the lazy dog") = 0xde7c9b85b8b78aa6bc8a7a36f70a90701c9db4d9
+  WriteLn('Example 2: ', HMACSHA1('key', 'The quick brown fox jumps over the lazy dog'));
+end.
+
diff --git a/packages/hash/fpmake.pp b/packages/hash/fpmake.pp
index 9486b746cf..b4c32885c7 100644
--- a/packages/hash/fpmake.pp
+++ b/packages/hash/fpmake.pp
@@ -17,11 +17,11 @@ begin
     P.Directory:=ADirectory;
 {$endif ALLPACKAGES}
 
-    P.Author := 'Free Pascal development team, Mark Adler, Jacques Nomssi Nzali';
+    P.Author := 'Free Pascal development team, Mark Adler, Jacques Nomssi Nzali, Silvio Clecio';
     P.License := 'LGPL with modification, ';
     P.HomepageURL := 'www.freepascal.org';
     P.Email := '';
-    P.Description := 'Several hash algorithms (MD5,CRC,Linux crypt and NTLM1).';
+    P.Description := 'Several hash and cryptography algorithms (MD5,CRC,Linux crypt and NTLM1).';
     P.NeedLibC:= false;
     P.OSes:=P.OSes-[embedded];
     P.Dependencies.Add('rtl-objpas');
@@ -32,11 +32,14 @@ begin
     T:=P.Targets.AddUnit('src/crc.pas');
     T:=P.Targets.AddUnit('src/ntlm.pas');
     T:=P.Targets.AddUnit('src/uuid.pas');
+    T:=P.Targets.AddUnit('src/hmac.pas');
     T:=P.Targets.AddUnit('src/unixcrypt.pas');
       T.OSes:=[Linux];
     T:=P.Targets.AddExampleunit('examples/mdtest.pas');
     T:=P.Targets.AddExampleunit('examples/crctest.pas');
     T:=P.Targets.AddExampleunit('examples/sha1test.pp');
+    T:=P.Targets.AddExampleunit('examples/hmd5.pas');
+    T:=P.Targets.AddExampleunit('examples/hsha1.pas');
     // md5.ref
 {$ifndef ALLPACKAGES}
     Run;
diff --git a/packages/hash/src/hmac.pp b/packages/hash/src/hmac.pp
new file mode 100644
index 0000000000..798474cbfa
--- /dev/null
+++ b/packages/hash/src/hmac.pp
@@ -0,0 +1,192 @@
+{
+  This file is part of the Free Component Library.
+
+  Hash-based supporting HMAC-MD5 and HMAC-SHA-1.
+  Copyright (c) 2013 by Silvio Clecio silvioprog@gmail.com
+
+  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 HMAC;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  MD5, SHA1;
+
+type
+  THMACMD5Digest = TMD5Digest;
+  THMACSHA1Digest = TSHA1Digest;
+
+function HMACMD5Digest(const AKey, AMessage: string): THMACMD5Digest;
+function HMACMD5Print(const ADigest: THMACMD5Digest): string; inline;
+function HMACMD5Match(const ADigest1, ADigest2: THMACMD5Digest): boolean; inline;
+function HMACMD5(const AKey, AMessage: string): string; inline;
+
+function HMACSHA1Digest(const AKey, AMessage: string): THMACSHA1Digest;
+function HMACSHA1Print(const ADigest: THMACSHA1Digest): string; inline;
+function HMACSHA1Match(const ADigest1, ADigest2: THMACSHA1Digest): boolean; inline;
+function HMACSHA1(const AKey, AMessage: string): string; inline;
+
+implementation
+
+const
+  MD5_BLOCK_SIZE = 64;
+  MD5_BLOCK_COUNT = 16;
+  SHA1_BLOCK_SIZE = 64;
+  SHA1_BLOCK_COUNT = 20;
+
+function MD5Raw(var ABuffer; const ABufferLength: PtrUInt): string;
+var
+  I: Byte;
+  VDest: PChar;
+  VDigest: TMD5Digest;
+  VContext: TMD5Context;
+begin
+  MD5Init(VContext);
+  MD5Update(VContext, ABuffer, ABufferLength);
+  MD5Final(VContext, VDigest);
+  SetLength(Result, MD5_BLOCK_COUNT);
+  VDest := Pointer(Result);
+  for I := 0 to MD5_BLOCK_COUNT - 1 do
+  begin
+    VDest^ := Char(VDigest[I]);
+    Inc(VDest);
+  end;
+end;
+
+function HMACMD5Digest(const AKey, AMessage: string): THMACMD5Digest;
+var
+  I: Byte;
+  VLength: PtrUInt;
+  PKey, POPad, PIPad: PChar;
+  VKey, VOPad, VIPad: string;
+begin
+  VLength := Length(AKey);
+  if VLength > MD5_BLOCK_SIZE then
+  begin
+    SetLength(VKey, MD5_BLOCK_SIZE);
+    FillChar(Pointer(VKey)^, MD5_BLOCK_SIZE, #0);
+    VKey := MD5Raw(Pointer(AKey)^, VLength) + VKey;
+  end
+  else
+  begin
+    SetLength(VKey, MD5_BLOCK_SIZE - VLength);
+    FillChar(Pointer(VKey)^, MD5_BLOCK_SIZE - VLength, #0);
+    VKey := AKey + VKey;
+  end;
+  SetLength(VOPad, MD5_BLOCK_SIZE);
+  POPad := PChar(VOPad);
+  FillChar(POPad^, MD5_BLOCK_SIZE, $5c);
+  SetLength(VIPad, MD5_BLOCK_SIZE);
+  PIPad := PChar(VIPad);
+  FillChar(PIPad^, MD5_BLOCK_SIZE, $36);
+  PKey := PChar(VKey);
+  for I := 1 to VLength do
+  begin
+    POPad^ := Char(Ord(POPad^) xor Ord(PKey^));
+    PIPad^ := Char(Ord(PIPad^) xor Ord(PKey^));
+    Inc(POPad);
+    Inc(PIPad);
+    Inc(PKey);
+  end;
+  VIPad := VIPad + AMessage;
+  Result := MD5String(VOPad + MD5Raw(Pointer(VIPad)^, Length(VIPad)));
+end;
+
+function HMACMD5Print(const ADigest: THMACMD5Digest): string;
+begin
+  Result := MD5Print(ADigest);
+end;
+
+function HMACMD5Match(const ADigest1, ADigest2: THMACMD5Digest): boolean;
+begin
+  Result := MD5Match(ADigest1, ADigest2);
+end;
+
+function HMACMD5(const AKey, AMessage: string): string;
+begin
+  Result := HMACMD5Print(HMACMD5Digest(AKey, AMessage));
+end;
+
+function SHA1Raw(const ABuffer; const ABufferLength: PtrUInt): string;
+var
+  I: Byte;
+  VDest: PChar;
+  VDigest: TSHA1Digest;
+  VContext: TSHA1Context;
+begin
+  SHA1Init(VContext);
+  SHA1Update(VContext, ABuffer, ABufferLength);
+  SHA1Final(VContext, VDigest);
+  SetLength(Result, SHA1_BLOCK_COUNT);
+  VDest := Pointer(Result);
+  for I := 0 to SHA1_BLOCK_COUNT - 1 do
+  begin
+    VDest^ := Char(VDigest[I]);
+    Inc(VDest);
+  end;
+end;
+
+function HMACSHA1Digest(const AKey, AMessage: string): THMACSHA1Digest;
+var
+  I: Byte;
+  VLength: PtrUInt;
+  PKey, POPad, PIPad: PChar;
+  VKey, VOPad, VIPad: string;
+begin
+  VLength := Length(AKey);
+  if VLength > SHA1_BLOCK_SIZE then
+  begin
+    SetLength(VKey, SHA1_BLOCK_SIZE);
+    FillChar(Pointer(VKey)^, SHA1_BLOCK_SIZE, #0);
+    VKey := SHA1Raw(Pointer(AKey)^, VLength) + VKey;
+  end
+  else
+  begin
+    SetLength(VKey, SHA1_BLOCK_SIZE - VLength);
+    FillChar(Pointer(VKey)^, SHA1_BLOCK_SIZE - VLength, #0);
+    VKey := AKey + VKey;
+  end;
+  SetLength(VOPad, SHA1_BLOCK_SIZE);
+  POPad := PChar(VOPad);
+  FillChar(POPad^, SHA1_BLOCK_SIZE, $5c);
+  SetLength(VIPad, SHA1_BLOCK_SIZE);
+  PIPad := PChar(VIPad);
+  FillChar(PIPad^, SHA1_BLOCK_SIZE, $36);
+  PKey := PChar(VKey);
+  for I := 1 to VLength do
+  begin
+    POPad^ := Char(Ord(POPad^) xor Ord(PKey^));
+    PIPad^ := Char(Ord(PIPad^) xor Ord(PKey^));
+    Inc(POPad);
+    Inc(PIPad);
+    Inc(PKey);
+  end;
+  VIPad := VIPad + AMessage;
+  Result := SHA1String(VOPad + SHA1Raw(Pointer(VIPad)^, Length(VIPad)));
+end;
+
+function HMACSHA1Print(const ADigest: THMACSHA1Digest): string;
+begin
+  Result := SHA1Print(ADigest);
+end;
+
+function HMACSHA1Match(const ADigest1, ADigest2: THMACSHA1Digest): boolean;
+begin
+  Result := HMACSHA1Match(ADigest1, ADigest2);
+end;
+
+function HMACSHA1(const AKey, AMessage: string): string;
+begin
+  Result := HMACSHA1Print(HMACSHA1Digest(AKey, AMessage));
+end;
+
+end.
diff --git a/packages/hash/tests/tests.pp b/packages/hash/tests/tests.pp
new file mode 100644
index 0000000000..b86d48352e
--- /dev/null
+++ b/packages/hash/tests/tests.pp
@@ -0,0 +1,16 @@
+program tests;
+
+{$mode objfpc}
+
+uses
+  consoletestrunner, TestsHMAC, HMAC;
+
+var
+  Application: TTestRunner;
+begin
+  Application := TTestRunner.Create(nil);
+  Application.Initialize;
+  Application.Run;
+  Application.Free;
+end.
+
diff --git a/packages/hash/tests/testshmac.pas b/packages/hash/tests/testshmac.pas
new file mode 100644
index 0000000000..a69387d839
--- /dev/null
+++ b/packages/hash/tests/testshmac.pas
@@ -0,0 +1,269 @@
+// See all test cases in: http://tools.ietf.org/html/rfc2202
+
+unit TestsHMAC;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  HMAC, FPCUnit, TestRegistry;
+
+type
+
+  { TTestHMACMD5 }
+
+  TTestHMACMD5 = class(TTestCase)
+  published
+    {
+      test_case =     1
+      key =           0x0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b
+      key_len =       16
+      data =          "Hi There"
+      data_len =      8
+      digest =        0x9294727a3638bb1c13f48ef8158bfc9d
+    }
+    procedure Test1;
+    {
+      test_case =     2
+      key =           "Jefe"
+      key_len =       4
+      data =          "what do ya want for nothing?"
+      data_len =      28
+      digest =        0x750c783e6ab0b503eaa86e310a5db738
+    }
+    procedure Test2;
+    {
+      test_case =     3
+      key =           0xaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+      key_len         16
+      data =          0xdd repeated 50 times
+      data_len =      50
+      digest =        0x56be34521d144c88dbb8c733f0e8b3f6
+    }
+    procedure Test3;
+    {
+      test_case =     4
+      key =           0x0102030405060708090a0b0c0d0e0f10111213141516171819
+      key_len         25
+      data =          0xcd repeated 50 times
+      data_len =      50
+      digest =        0x697eaf0aca3a3aea3a75164746ffaa79
+    }
+    procedure Test4;
+    {
+      test_case =     5
+      key =           0x0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c
+      key_len =       16
+      data =          "Test With Truncation"
+      data_len =      20
+      digest =        0x56461ef2342edc00f9bab995690efd4c
+      digest-96       0x56461ef2342edc00f9bab995
+    }
+    procedure Test5;
+    {
+      test_case =     6
+      key =           0xaa repeated 80 times
+      key_len =       80
+      data =          "Test Using Larger Than Block-Size Key - Hash Key First"
+      data_len =      54
+      digest =        0xaa4ae5e15272d00e95705637ce8a3b55ed402112
+    }
+    procedure Test6;
+    {
+      test_case =     7
+      key =           0xaa repeated 80 times
+      key_len =       80
+      data =          "Test Using Larger Than Block-Size Key and Larger
+                      Than One Block-Size Data"
+      data_len =      73
+      digest =        0x6f630fad67cda0ee1fb1f562db3aa53e
+    }
+    procedure Test7;
+  end;
+
+  { TTestHMACSHA1 }
+
+  TTestHMACSHA1 = class(TTestCase)
+  published
+    {
+      test_case =     1
+      key =           0x0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b
+      key_len =       20
+      data =          "Hi There"
+      data_len =      8
+      digest =        0xb617318655057264e28bc0b6fb378c8ef146be00
+    }
+    procedure Test1;
+    {
+      test_case =     2
+      key =           "Jefe"
+      key_len =       4
+      data =          "what do ya want for nothing?"
+      data_len =      28
+      digest =        0xeffcdf6ae5eb2fa2d27416d5f184df9c259a7c79
+    }
+    procedure Test2;
+    {
+      test_case =     3
+      key =           0xaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+      key_len =       20
+      data =          0xdd repeated 50 times
+      data_len =      50
+      digest =        0x125d7342b9ac11cd91a39af48aa17b4f63f175d3
+    }
+    procedure Test3;
+    {
+      test_case =     4
+      key =           0x0102030405060708090a0b0c0d0e0f10111213141516171819
+      key_len =       25
+      data =          0xcd repeated 50 times
+      data_len =      50
+      digest =        0x4c9007f4026250c6bc8414f9bf50c86c2d7235da
+    }
+    procedure Test4;
+    {
+      test_case =     5
+      key =           0x0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c
+      key_len =       20
+      data =          "Test With Truncation"
+      data_len =      20
+      digest =        0x4c1a03424b55e07fe7f27be1d58bb9324a9a5a04
+      digest-96 =     0x4c1a03424b55e07fe7f27be1
+    }
+    procedure Test5;
+    {
+      test_case =     6
+      key =           0xaa repeated 80 times
+      key_len =       80
+      data =          "Test Using Larger Than Block-Size Key - Hash Key First"
+      data_len =      54
+      digest =        0xaa4ae5e15272d00e95705637ce8a3b55ed402112
+    }
+    procedure Test6;
+    {
+      test_case =     7
+      key =           0xaa repeated 80 times
+      key_len =       80
+      data =          "Test Using Larger Than Block-Size Key and Larger
+                      Than One Block-Size Data"
+      data_len =      73
+      digest =        0xe8e99d0f45237d786d6bbaa7965c7808bbff1a91
+      data_len =      20
+      digest =        0x4c1a03424b55e07fe7f27be1d58bb9324a9a5a04
+      digest-96 =     0x4c1a03424b55e07fe7f27be1
+    }
+    procedure Test7;
+  end;
+
+implementation
+
+{ TTestHMACMD5 }
+
+procedure TTestHMACMD5.Test1;
+begin
+  AssertEquals('9294727a3638bb1c13f48ef8158bfc9d',
+    HMACMD5(StringOfChar(#$0b, 16), 'Hi There'));
+end;
+
+procedure TTestHMACMD5.Test2;
+begin
+  AssertEquals('750c783e6ab0b503eaa86e310a5db738', HMACMD5('Jefe',
+    'what do ya want for nothing?'));
+end;
+
+procedure TTestHMACMD5.Test3;
+begin
+  AssertEquals('56be34521d144c88dbb8c733f0e8b3f6',
+    HMACMD5(StringOfChar(#$aa, 16), StringOfChar(#$dd, 50)));
+end;
+
+procedure TTestHMACMD5.Test4;
+begin
+  AssertEquals('697eaf0aca3a3aea3a75164746ffaa79', HMACMD5(#$01+#$02+#$03+#$04+
+    #$05+#$06+#$07+#$08+#$09+#$0a+#$0b+#$0c+#$0d+#$0e+#$0f+#$10+#$11+#$12+#$13+
+    #$14+#$15+#$16+#$17+#$18+#$19, StringOfChar(#$cd, 50)));
+end;
+
+procedure TTestHMACMD5.Test5;
+var
+  S: string;
+begin
+  S := HMACMD5(StringOfChar(#$0c, 16), 'Test With Truncation');
+  AssertEquals('56461ef2342edc00f9bab995690efd4c', S);
+  SetLength(S, 24);
+  AssertEquals('56461ef2342edc00f9bab995', S);
+end;
+
+procedure TTestHMACMD5.Test6;
+begin
+  AssertEquals('6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd',
+    HMACMD5(StringOfChar(#$aa, 80),
+      'Test Using Larger Than Block-Size Key - Hash Key First'));
+end;
+
+procedure TTestHMACMD5.Test7;
+begin
+  AssertEquals('6f630fad67cda0ee1fb1f562db3aa53e',
+    HMACMD5(StringOfChar(#$aa, 80),
+      'Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data'));
+end;
+
+{ TTestHMACSHA1 }
+
+procedure TTestHMACSHA1.Test1;
+begin
+  AssertEquals('b617318655057264e28bc0b6fb378c8ef146be00',
+    HMACSHA1(StringOfChar(#$0b, 20), 'Hi There'));
+end;
+
+procedure TTestHMACSHA1.Test2;
+begin
+  AssertEquals('effcdf6ae5eb2fa2d27416d5f184df9c259a7c79', HMACSHA1('Jefe',
+    'what do ya want for nothing?'));
+end;
+
+procedure TTestHMACSHA1.Test3;
+begin
+  AssertEquals('125d7342b9ac11cd91a39af48aa17b4f63f175d3',
+    HMACSHA1(StringOfChar(#$aa, 20), StringOfChar(#$dd, 50)));
+end;
+
+procedure TTestHMACSHA1.Test4;
+begin
+  AssertEquals('4c9007f4026250c6bc8414f9bf50c86c2d7235da',
+    HMACSHA1(#$01+#$02+#$03+#$04+#$05+#$06+#$07+#$08+#$09+#$0a+#$0b+#$0c+#$0d+
+      #$0e+#$0f+#$10+#$11+#$12+#$13+#$14+#$15+#$16+#$17+#$18+#$19,
+      StringOfChar(#$cd, 50)));
+end;
+
+procedure TTestHMACSHA1.Test5;
+var
+  S: string;
+begin
+  S := HMACSHA1(StringOfChar(#$0c, 20), 'Test With Truncation');
+  AssertEquals('4c1a03424b55e07fe7f27be1d58bb9324a9a5a04', S);
+  SetLength(S, 24);
+  AssertEquals('4c1a03424b55e07fe7f27be1', S);
+end;
+
+procedure TTestHMACSHA1.Test6;
+begin
+  AssertEquals('aa4ae5e15272d00e95705637ce8a3b55ed402112',
+    HMACSHA1(StringOfChar(#$aa, 80),
+      'Test Using Larger Than Block-Size Key - Hash Key First'));
+end;
+
+procedure TTestHMACSHA1.Test7;
+begin
+  AssertEquals('e8e99d0f45237d786d6bbaa7965c7808bbff1a91',
+    HMACSHA1(StringOfChar(#$aa, 80),
+      'Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data'));
+end;
+
+initialization
+  RegisterTest(TTestHMACMD5);
+  RegisterTest(TTestHMACSHA1);
+
+end.
+