* OneTimePass & test for sha256

(cherry picked from commit 6d4d2f2fb2)

packages/hash/fpmake.pp

@@ -37,6 +37,7 @@ begin
     T:=P.Targets.AddUnit('src/hashutils.pp');
     T:=P.Targets.AddUnit('src/sha256.pp');
     T.Dependencies.AddUnit('hashutils');
+    T:=P.Targets.AddUnit('src/onetimepass.pp');
     T:=P.Targets.AddUnit('src/crc.pas');
     T:=P.Targets.AddUnit('src/ntlm.pas');
     T:=P.Targets.AddUnit('src/uuid.pas');

packages/hash/src/onetimepass.pp

@@ -0,0 +1,129 @@
+{
+  This file is part of the Free Component Library.
+  Copyright (c) 2021 by the Free Pascal team.
+
+  HOTP and TOTP One-time password algorithms. Compatible with the Google Authenticator.
+
+  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 onetimepass;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  SysUtils , basenenc, types, DateUtils;
+
+const
+  TOTP_Mod = 1000000;
+  TOTP_KeyRegeneration = 30; // Time step for TOTP generation. Google Authenticator uses 30 seconds.
+
+Type
+  TRandomBytes = Procedure (aBytes : TByteDynArray);
+
+function HOTPCalculateToken(const aSecret: AnsiString; const Counter: LongInt): LongInt;
+function TOTPCalculateToken(const aSecret: AnsiString): LongInt;
+function TOTPGenerateToken(const aSecret: AnsiString): LongInt;
+function TOTPValidate(const aSecret: AnsiString; const Token: LongInt; const WindowSize: LongInt; var Counter: LongInt): Boolean;
+Function TOTPSharedSecret(aRandom : TRandomBytes = Nil) : String;
+
+implementation
+
+uses sha1, hmac;
+
+// @Result[8]
+Function Int64ToRawString(const Value: Int64) : AnsiString;
+
+var
+  B: array[0..7] of Byte;
+  I: Int32;
+begin
+  PInt64(@B)^ := Value;
+  Result:='';
+  for I := 7 downto 0 do
+    Result:=Result+AnsiChar(B[I]);
+end;
+
+function TOTPCalculateToken(const aSecret: String): Longint;
+
+begin
+  Result:=HOTPCalculateToken(aSecret,-1);
+end;
+
+function HOTPCalculateToken(const aSecret: String; const Counter: Longint): Longint;
+
+var
+  Digest: TSHA1Digest;
+  Key: UInt32;
+  Offset: Longint;
+  Part1, Part2, Part3, Part4: UInt32;
+  SecretBinBuf: TBytes;
+  STime: String;
+  Time: Longint;
+
+begin
+  Time := Counter;
+  if Time=-1 then
+    Time := DateTimeToUnix(Now,False) div TOTP_KeyRegeneration;
+  SecretBinBuf:=Base32.Decode(aSecret);
+  STime:=Int64ToRawString(Time);
+  Digest:=HMACSHA1Digest(TEncoding.UTF8.GetAnsiString(SecretBinBuf), STime);
+  Offset := Digest[19] and $0F;
+  Part1 := (Digest[Offset + 0] and $7F);
+  Part2 := (Digest[Offset + 1] and $FF);
+  Part3 := (Digest[Offset + 2] and $FF);
+  Part4 := (Digest[Offset + 3] and $FF);
+  Key := (Part1 shl 24) or (Part2 shl 16) or (Part3 shl 8) or Part4;
+  Result := Key mod TOTP_Mod; // mod 1000000 in case of otpLength of 6 digits
+end;
+
+function TOTPGenerateToken(const aSecret: AnsiString): LongInt;
+begin
+  Result := HOTPCalculateToken(aSecret, -1);
+end;
+
+Function TOTPSharedSecret(aRandom : TRandomBytes = Nil) : String;
+
+var
+  RandomKey: TByteDynArray;
+  I : Integer;
+
+begin
+  RandomKey:=[];
+  SetLength(RandomKey,10);
+  if aRandom <> Nil then
+    aRandom(RandomKey)
+  else
+    For I:=0 to 9 do
+      RandomKey[I]:=Random(256);
+  Result:=Base32.Encode(RandomKey);
+end;
+
+// @Secret Base32 encoded, @WindowSize=1
+function TOTPValidate(const aSecret: String; const Token: LongInt; const WindowSize: LongInt; var Counter: LongInt): Boolean;
+var
+  TimeStamp: Longint;
+  UnixTime: Longint;
+begin
+  Result := False;
+  UnixTime := DateTimeToUnix(Now,False);
+  TimeStamp := UnixTime div TOTP_KeyRegeneration;
+  Counter := Timestamp-WindowSize;
+  while Counter <= TimeStamp+WindowSize do
+  begin
+    Result := HOTPCalculateToken(aSecret, Counter) = Token;
+    if Result then
+      Exit;
+    Inc(Counter);
+  end;
+end;
+
+end.
+

packages/hash/tests/testonetimepass.pp

@@ -0,0 +1,77 @@
+unit testonetimepass;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  FPCUnit, TestRegistry, Classes, SysUtils, onetimepass ;
+
+type
+
+  { TTestOnetimePass }
+
+  TTestOnetimePass = class(TTestCase)
+  Published
+    Procedure Test1Interval;
+    Procedure Test2Intervals;
+    Procedure TestValid1;
+    Procedure TestInValid1;
+    Procedure TestGen;
+  end;
+
+implementation
+
+Const
+  Secret = 'MFRGGZDFMZTWQ2LK';
+
+Procedure TTestOnetimePass.Test1Interval;
+
+begin
+  AssertEquals('1 interval', 765705, HOTPCalculateToken(Secret, 1));
+end;
+
+procedure TTestOnetimePass.Test2Intervals;
+begin
+  AssertEquals('2 interval', 816065, HOTPCalculateToken(Secret, 2));
+end;
+
+procedure TTestOnetimePass.TestValid1;
+
+Var
+  C,Tok : LongInt;
+
+begin
+  C:=1;
+  Tok:=TOTPCalculateToken(Secret);
+  AssertTrue('Valid',TOTPValidate(Secret,Tok,1,C));
+end;
+
+procedure TTestOnetimePass.TestInValid1;
+Var
+  C,Tok : LongInt;
+
+begin
+  C:=1;
+  Tok:=TOTPCalculateToken(Secret);
+  AssertFalse('Invalid',TOTPValidate(Secret,Tok+1,1,C));
+end;
+
+procedure TTestOnetimePass.TestGen;
+
+var
+  lSecret : String;
+  C,Tok : LongInt;
+
+begin
+  c:=1;
+  lSecret:=TOTPSharedSecret();
+  AssertEquals('Length',16,Length(lSecret));
+  Tok:=TOTPCalculateToken(lSecret);
+  AssertTrue('Valid',TOTPValidate(lSecret,Tok,1,C));
+end;
+
+initialization
+  RegisterTest(TTestOnetimePass);
+end.
+

packages/hash/tests/testsha256.pp

@@ -0,0 +1,116 @@
+unit testsha256;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry, sha256, hashutils;
+
+type
+
+  { TTestSHA256 }
+
+  TTestSHA256 = class(TTestCase)
+  Public
+    Procedure TestHexString(Const aString,aDigest : String);
+    Procedure TestBase64String(Const aString,aDigest : String);
+    Procedure TestHMACString(Const aString,aKey,aDigest : String);
+  published
+    procedure TestEmpty;
+    procedure TestSmallString;
+    procedure TestEmptyBase64;
+    procedure TestSmallBase64;
+    procedure TestSmallHMAC;
+    procedure TestHMACStream;
+  end;
+
+implementation
+
+Procedure TTestSHA256.TestHexString(Const aString,aDigest : String);
+
+var
+  Digest : AnsiString;
+  S : TBytes;
+
+begin
+  S:=[];
+  Digest:='';
+  S:=TEncoding.UTF8.GetAnsiBytes(aString);
+  SHA256Hexa(S, Digest);
+  AssertEquals('Correct hex digest',aDigest, Digest);
+end;
+
+procedure TTestSHA256.TestBase64String(const aString, aDigest: String);
+var
+  Digest : AnsiString;
+  S : TBytes;
+
+begin
+  S:=TEncoding.UTF8.GetAnsiBytes(aString);
+  Digest:='';
+  SHA256Base64(S,False,Digest);
+  AssertEquals('Correct base64 digest',aDigest, Digest);
+end;
+
+procedure TTestSHA256.TestHMACString(const aString, aKey, aDigest: String);
+var
+  Digest : AnsiString;
+  S,K : TBytes;
+
+begin
+  S:=TEncoding.UTF8.GetAnsiBytes(aString);
+  K:=TEncoding.UTF8.GetAnsiBytes(aKey);
+  HMACSHA256Hexa(K,S,Digest);
+  AssertEquals('Correct base64 digest',aDigest, Digest);
+end;
+
+procedure TTestSHA256.TestEmpty;
+
+
+begin
+  TestHexString('','E3B0C44298FC1C149AFBF4C8996FB92427AE41E4649B934CA495991B7852B855');
+end;
+
+procedure TTestSHA256.TestSmallString;
+
+begin
+  TestHexString('abc','BA7816BF8F01CFEA414140DE5DAE2223B00361A396177A9CB410FF61F20015AD');
+end;
+
+procedure TTestSHA256.TestEmptyBase64;
+begin
+  TestBase64String('','47DEQpj8HBSa+/TImW+5JCeuQeRkm5NMpJWZG3hSuFU');
+end;
+
+procedure TTestSHA256.TestSmallBase64;
+
+begin
+  TestBase64String('abc','ungWv48Bz+pBQUDeXa4iI7ADYaOWF3qctBD/YfIAFa0');
+end;
+
+procedure TTestSHA256.TestSmallHMAC;
+begin
+  TestHMACString('abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ',
+                 'Secret key' ,
+                 '6AE3261635F57BF68B6E3DF9C06ED14D3FA793F1B7BE55BC3429895B09F52F77');
+end;
+
+procedure TTestSHA256.TestHMACStream;
+
+Var
+  S : TStringStream;
+
+begin
+  S:=TStringStream.Create('abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ');
+  try
+    AssertEquals('Correct hash','3964294B664613798D1A477EB8AD02118B48D0C5738C427613202F2ED123B5F1',StreamSHA256Hexa(S));
+  finally
+    S.Free;
+  end;
+end;
+
+initialization
+  RegisterTest(TTestSHA256);
+end.
+