xtool/contrib/fundamentals/Cipher/flcCipherRandom.pas

319 lines
10 KiB
ObjectPascal

{******************************************************************************}
{ }
{ Library: Fundamentals 5.00 }
{ File name: flcCipherRandom.pas }
{ File version: 5.06 }
{ Description: Cipher random }
{ }
{ Copyright: Copyright (c) 2010-2020, David J Butler }
{ All rights reserved. }
{ This file is licensed under the BSD License. }
{ See http://www.opensource.org/licenses/bsd-license.php }
{ Redistribution and use in source and binary forms, with }
{ or without modification, are permitted provided that }
{ the following conditions are met: }
{ Redistributions of source code must retain the above }
{ copyright notice, this list of conditions and the }
{ following disclaimer. }
{ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND }
{ CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED }
{ WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED }
{ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A }
{ PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL }
{ THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, }
{ INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR }
{ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, }
{ PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF }
{ USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) }
{ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER }
{ IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING }
{ NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE }
{ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE }
{ POSSIBILITY OF SUCH DAMAGE. }
{ }
{ Github: https://github.com/fundamentalslib }
{ E-mail: fundamentals.library at gmail.com }
{ }
{ Revision history: }
{ }
{ 2010/12/17 4.01 Initial version. }
{ 2013/09/25 4.02 UnicodeString version. }
{ 2015/05/05 4.03 Multiple PRNGs and PRSS and SHA512 hash in random block }
{ generator. }
{ 2016/01/09 5.04 Revised for Fundamentals 5. }
{ 2019/06/06 5.05 SecureRandomBytes function. }
{ 2020/02/13 5.06 Remove MD5 from generator. }
{ Use 8 random bits in generator for each secure }
{ random bit. }
{ }
{******************************************************************************}
{$INCLUDE flcCipher.inc}
unit flcCipherRandom;
interface
uses
{ System }
SysUtils,
{ Fundamentals }
flcStdTypes;
procedure SecureRandomBuf(var Buf; const Size: Integer);
function SecureRandomBytes(const Size: Integer): TBytes;
function SecureRandomStrA(const Size: Integer): RawByteString;
function SecureRandomHexStr(const Digits: Integer; const UpperCase: Boolean = True): String;
function SecureRandomHexStrB(const Digits: Integer; const UpperCase: Boolean = True): RawByteString;
function SecureRandomHexStrU(const Digits: Integer; const UpperCase: Boolean = True): UnicodeString;
function SecureRandomWord32: Word32;
implementation
uses
{ Fundamentals }
flcUtils,
flcRandom,
flcHash;
const
SecureRandomBlockBits = 128;
SecureRandomBlockSize = SecureRandomBlockBits div 8; // 16 bytes
type
TSecureRandomBlock = array[0..SecureRandomBlockSize - 1] of Byte;
PSecureRandomBlock = ^TSecureRandomBlock;
// produces a block of SecureRandomBlockSize bytes of secure random material
procedure SecureRandomBlockGenerator(var Block: TSecureRandomBlock);
const
RandomDataBits = SecureRandomBlockBits * 8; // 1024 bits (128 bytes)
RandomDataLen = RandomDataBits div 32; // 32 * Word32
var
I : Integer;
RData : array[0..RandomDataLen - 1] of Word32;
S32 : Word32;
H512 : T512BitDigest;
H256 : T256BitDigest;
begin
try
// initialise 1024 bits with multiple Pseudo Random Numbers Generators (PRNG)
// and Pseudo Random System State (PRSS)
FillChar(RData, SizeOf(RData), $FF);
S32 := RandomSeed32;
RData[0] := RData[0] xor S32;
for I := 0 to RandomDataLen - 1 do
RData[I] := RData[I] xor RandomUniform32;
for I := 0 to RandomDataLen - 1 do
RData[I] := RData[I] xor urnRandom32;
S32 := RandomSeed32;
RData[RandomDataLen - 1] := RData[RandomDataLen - 1] xor S32;
// hash 1024 bits using SHA512 into 512 bits
H512 := CalcSHA512(RData, SizeOf(RData));
// hash 512 bits using SHA256 into 256 bits
H256 := CalcSHA256(H512, SizeOf(T512BitDigest));
// move 128 bits to secure random block
Assert(SizeOf(H256) >= SecureRandomBlockSize);
Move(H256, Block, SecureRandomBlockSize);
finally
SecureClear(H256, SizeOf(T256BitDigest));
SecureClear(H512, SizeOf(T512BitDigest));
SecureClear(RData, SizeOf(RData));
end;
end;
procedure SecureRandomBuf(var Buf; const Size: Integer);
var
P : PSecureRandomBlock;
L : Integer;
B : TSecureRandomBlock;
begin
P := @Buf;
L := Size;
while L >= SecureRandomBlockSize do
begin
SecureRandomBlockGenerator(P^);
Inc(P);
Dec(L, SecureRandomBlockSize);
end;
if L > 0 then
begin
SecureRandomBlockGenerator(B);
Move(B, P^, L);
SecureClear(B, SecureRandomBlockSize);
end;
end;
function SecureRandomBytes(const Size: Integer): TBytes;
begin
SetLength(Result, Size);
if Size <= 0 then
exit;
SecureRandomBuf(Pointer(Result)^, Size);
end;
function SecureRandomStrA(const Size: Integer): RawByteString;
begin
SetLength(Result, Size);
if Size <= 0 then
exit;
SecureRandomBuf(Result[1], Size);
end;
function SecureRandomHexStr(const Digits: Integer; const UpperCase: Boolean = True): String;
var
B : TSecureRandomBlock;
S, T : String;
L, N : Integer;
P : PWord32;
Q : PChar;
begin
if Digits <= 0 then
begin
Result := '';
exit;
end;
SetLength(S, Digits);
Q := PChar(S);
L := Digits;
while L >= 8 do
begin
SecureRandomBlockGenerator(B);
P := @B;
N := SecureRandomBlockSize div 4;
while (L >= 8) and (N > 0) do
begin
T := Word32ToHex(P^, 8, UpperCase);
Move(PChar(T)^, Q^, 8 * SizeOf(Char));
SecureClearStr(T);
Inc(Q, 8);
Dec(N);
Inc(P);
Dec(L, 8);
end;
end;
if L > 0 then
begin
SecureRandomBlockGenerator(B);
P := @B;
T := Word32ToHex(P^, L, UpperCase);
Move(PChar(T)^, Q^, L * SizeOf(Char));
SecureClearStr(T);
end;
SecureClear(B, SecureRandomBlockSize);
Result := S;
end;
function SecureRandomHexStrB(const Digits: Integer; const UpperCase: Boolean): RawByteString;
var
B : TSecureRandomBlock;
S, T : RawByteString;
L, N : Integer;
P : PWord32;
Q : PByte;
begin
if Digits <= 0 then
begin
Result := '';
exit;
end;
SetLength(S, Digits);
Q := PByte(S);
L := Digits;
while L >= 8 do
begin
SecureRandomBlockGenerator(B);
P := @B;
N := SecureRandomBlockSize div 4;
while (L >= 8) and (N > 0) do
begin
T := Word32ToHexB(P^, 8, UpperCase);
Move(PByte(T)^, Q^, 8);
SecureClearStrB(T);
Inc(Q, 8);
Dec(N);
Inc(P);
Dec(L, 8);
end;
end;
if L > 0 then
begin
SecureRandomBlockGenerator(B);
P := @B;
T := Word32ToHexB(P^, L, UpperCase);
Move(PByte(T)^, Q^, L);
SecureClearStrB(T);
end;
SecureClear(B, SecureRandomBlockSize);
Result := S;
end;
function SecureRandomHexStrU(const Digits: Integer; const UpperCase: Boolean): UnicodeString;
var
B : TSecureRandomBlock;
S, T : UnicodeString;
L, N : Integer;
P : PWord32;
Q : PWideChar;
begin
if Digits <= 0 then
begin
Result := '';
exit;
end;
SetLength(S, Digits);
Q := PWideChar(S);
L := Digits;
while L >= 8 do
begin
SecureRandomBlockGenerator(B);
P := @B;
N := SecureRandomBlockSize div 4;
while (L >= 8) and (N > 0) do
begin
T := Word32ToHexU(P^, 8, UpperCase);
Move(PWideChar(T)^, Q^, 8 * SizeOf(WideChar));
SecureClear(T[1], 8 * SizeOf(WideChar));
Inc(Q, 8);
Dec(N);
Inc(P);
Dec(L, 8);
end;
end;
if L > 0 then
begin
SecureRandomBlockGenerator(B);
P := @B;
T := Word32ToHexU(P^, L, UpperCase);
Move(PWideChar(T)^, Q^, L * SizeOf(WideChar));
SecureClear(T[1], 8 * SizeOf(WideChar));
end;
SecureClear(B, SecureRandomBlockSize);
Result := S;
end;
function SecureRandomWord32: Word32;
var
L : Word32;
begin
SecureRandomBuf(L, SizeOf(Word32));
Result := L;
SecureClear(L, SizeOf(Word32));
end;
end.