paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 21:19:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@27319 -
This commit is contained in:
svenbarth 2014-03-28 14:09:52 +00:00
parent e65da0deb8
commit e003e1773c
7 changed files with 517 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitattributes vendored
View File

@ -4073,16 +4073,21 @@ packages/hash/Makefile.fpc.fpcmake svneol=native#text/plain
packages/hash/examples/Makefile svneol=native#text/plain
packages/hash/examples/Makefile.fpc svneol=native#text/plain
packages/hash/examples/crctest.pas svneol=native#text/plain
packages/hash/examples/hmd5.pp svneol=native#text/pascal
packages/hash/examples/hsha1.pp svneol=native#text/pascal
packages/hash/examples/md5.ref svneol=native#text/plain
packages/hash/examples/mdtest.pas svneol=native#text/plain
packages/hash/examples/sha1test.pp svneol=native#text/plain
packages/hash/fpmake.pp svneol=native#text/plain
packages/hash/src/crc.pas svneol=native#text/plain
packages/hash/src/hmac.pp svneol=native#text/pascal
packages/hash/src/md5.pp svneol=native#text/plain
packages/hash/src/ntlm.pas svneol=native#text/plain
packages/hash/src/sha1.pp svneol=native#text/plain
packages/hash/src/unixcrypt.pas svneol=native#text/plain
packages/hash/src/uuid.pas svneol=native#text/plain
packages/hash/tests/tests.pp svneol=native#text/pascal
packages/hash/tests/testshmac.pas svneol=native#text/pascal
packages/hermes/Makefile svneol=native#text/plain
packages/hermes/Makefile.fpc svneol=native#text/plain
packages/hermes/Makefile.fpc.fpcmake svneol=native#text/plain

15
packages/hash/examples/hmd5.pp Normal file
View File

@ -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.

15
packages/hash/examples/hsha1.pp Normal file
View File

@ -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.

7
packages/hash/fpmake.pp
View File

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

192
packages/hash/src/hmac.pp Normal file
View File

@ -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.

16
packages/hash/tests/tests.pp Normal file
View File

@ -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.

269
packages/hash/tests/testshmac.pas Normal file
View File

@ -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.