Vichingo455-RePacks
/
xtool
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases 1 Wiki Activity
xtool/contrib/mORMot/SynCrypto.pas

15572 lines
532 KiB
ObjectPascal
Raw Blame History

/// fast cryptographic routines (hashing and cypher)
// - implements AES,XOR,ADLER32,MD5,RC4,SHA1,SHA256,SHA384,SHA512,SHA3 and JWT
// - optimized for speed (tuned assembler and SSE3/SSE4/AES-NI/PADLOCK support)
// - this unit is a part of the freeware Synopse mORMot framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit SynCrypto;
(*
This file is part of Synopse framework.
Synopse framework. Copyright (C) 2022 Arnaud Bouchez
Synopse Informatique - https://synopse.info
*** BEGIN LICENSE BLOCK *****
Version: MPL 1.1/GPL 2.0/LGPL 2.1
The contents of this file are subject to the Mozilla Public License Version
1.1 (the "License"); you may not use this file except in compliance with
the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
for the specific language governing rights and limitations under the License.
The Original Code is Synopse mORMot framework.
The Initial Developer of the Original Code is Arnaud Bouchez.
Portions created by the Initial Developer are Copyright (C) 2022
the Initial Developer. All Rights Reserved.
Contributor(s):
- Alfred Glaenzer (alf)
- Eric Grange for SHA-3 MMX asm optimization
- EvaF
- Intel's sha256_sse4.asm under under a three-clause Open Software license
- Johan Bontes
- souchaud
- Project Nayuki (MIT License) for SHA-512 optimized x86 asm
- Wolfgang Ehrhardt under zlib license for SHA-3 and AES "pure pascal" code
- Maxim Masiutin for the MD5 asm
Alternatively, the contents of this file may be used under the terms of
either the GNU General Public License Version 2 or later (the "GPL"), or
the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
in which case the provisions of the GPL or the LGPL are applicable instead
of those above. If you wish to allow use of your version of this file only
under the terms of either the GPL or the LGPL, and not to allow others to
use your version of this file under the terms of the MPL, indicate your
decision by deleting the provisions above and replace them with the notice
and other provisions required by the GPL or the LGPL. If you do not delete
the provisions above, a recipient may use your version of this file under
the terms of any one of the MPL, the GPL or the LGPL.
***** END LICENSE BLOCK *****
Synopse Cryptographic routines
==============================
- fastest ever 100% Delphi (and asm ;) code
- AES Crypto(128,192,256 bits key) with optimized asm version
and multi-threaded code for multi-core CPU for blocks > 512 KB
- XOR Crypto (32 bits key) - very fast with variable or fixed key
- RC4 Crypto - weak, but simple and standard (used e.g. by SynPdf)
- ADLER32 - 32 bits fast Hash with optimized asm version
- MD5 - standard fast 128 bits Hash
- SHA-1 - 160 bits Secure Hash
- SHA-256 - 256 bits Secure Hash with optimized asm version
- SHA-512 - 512 bits Secure Hash with optimized asm version (with SHA-384)
- SHA-3 - 224/256/384/512/Shake algorithms based on Keccak permutation
- hardware AES-NI and SHA-SSE4 support for latest CPU
- VIA PADLOCK optional support - native .o code on linux or .dll (Win32)
(tested on a Dedibox C7 (rev1) linux server - need validation for Win32)
- Microsoft AES Cryptographic Provider optional support via CryptoAPI
*)
interface
{$I Synopse.inc} // define HASINLINE CPU32 CPU64 OWNNORMTOUPPER
{.$define USEPADLOCK}
{.$define AESPASCAL} // for debug
{$ifdef Linux}
{$undef USETHREADSFORBIGAESBLOCKS} // uses low-level WinAPI threading
{$ifdef KYLIX3}
{.$define USEPADLOCK} // dedibox Linux tested only
{$endif}
{$else}
{$ifndef DELPHI5OROLDER}
// on Windows: enable Microsoft AES Cryptographic Provider (XP SP3 and up)
{$define USE_PROV_RSA_AES}
{$endif}
// on Windows: will use Threads for very big blocks (>512KB) if multi-CPU
{$define USETHREADSFORBIGAESBLOCKS}
{$endif}
{$ifdef USEPADLOCK}
{$ifdef MSWINDOWS}
{$define USEPADLOCKDLL} // Win32: we can use LibPadlock.dll
{$else}
{.$define PADLOCKDEBUG} // display message before using padlock
{.$define USEPADLOCKDLL} // Linux: use fast .o linked code
{$endif}
{$endif}
uses
{$ifdef MSWINDOWS}
Windows,
{$else}
{$ifdef KYLIX3}
LibC,
SynKylix,
{$endif}
{$ifdef FPC}
BaseUnix,
SynFPCLinux,
{$endif FPC}
{$endif MSWINDOWS}
SysUtils,
{$ifndef LVCL}
{$ifndef DELPHI5OROLDER}
RTLConsts,
{$endif}
{$endif LVCL}
Classes,
SynLZ, // already included in SynCommons, and used by CompressShaAes()
SynCommons,
SynTable; // for TSynUniqueIdentifierGenerator
{$ifdef ABSOLUTEPASCAL}
{$define AES_PASCAL}
{$define SHA3_PASCAL}
{$else}
{$ifdef DELPHI5OROLDER}
{$define AES_PASCAL} // Delphi 5 internal asm is buggy :(
{$define SHA3_PASCAL}
{$define SHA512_X86} // external sha512-x86.obj
{$else}
{$ifdef CPUINTEL} // AES-NI supported for x86 and x64 under Windows
{$ifdef CPU64}
{$ifdef HASAESNI}
{$define USEAESNI}
{$define USEAESNI64}
{$else}
{$define AES_PASCAL} // Delphi XE2/XE3 do not have the AES-NI opcodes :(
{$endif}
{$define AESPASCAL_OR_CPU64}
{$ifndef BSD}
{$define CRC32C_X64} // external crc32_iscsi_01 for win64/lin64
{$define SHA512_X64} // external sha512_sse4 for win64/lin64
{$endif}
{$else}
{$ifdef MSWINDOWS}
{$define SHA512_X86} // external sha512-x86.obj/.o
{$endif}
{$ifdef ABSOLUTEPASCAL}
{$define AES_PASCAL} // x86 AES asm below is not PIC-safe
{$else}
{$define CPUX86_NOTPIC}
{$endif ABSOLUTEPASCAL}
{$ifdef FPC}
{$ifdef DARWIN}
{$define AES_PASCAL} // as reported by alf
{$endif DARWIN}
{$ifdef LINUX}
{$ifndef AES_PASCAL}
{$define SHA512_X86} // external linux32/sha512-x86.o
{$endif AES_PASCAL}
{$endif}
{$endif FPC}
{$ifndef AES_PASCAL}
{$define USEAESNI} // some functions are not PIC-safe
{$define USEAESNI32}
{$endif AES_PASCAL}
{$endif}
{$else}
{$define AES_PASCAL}
{$define SHA3_PASCAL}
{$endif CPUINTEL}
{$endif}
{$endif}
{$ifdef AES_PASCAL}
{$define AESPASCAL_OR_CPU64}
{$endif}
{.$define AES_ROLLED}
// if defined, use rolled version, which is slightly slower (at least on my CPU)
{$ifndef AESPASCAL_OR_CPU64}
{$define AES_ROLLED} // asm requires rolled decryption keys
{$endif}
{$ifdef CPUX64}
{$define AES_ROLLED} // asm requires rolled decryption keys
{$endif}
{$ifdef USEPADLOCK}
var
/// if dll/so and VIA padlock compatible CPU are present
padlock_available: boolean = false;
{$endif}
const
/// hide all AES Context complex code
AESContextSize = 276+sizeof(pointer){$ifdef USEPADLOCK}*2{$endif}
{$ifdef USEAESNI32}+sizeof(pointer){$endif};
/// hide all SHA-1/SHA-2 complex code by storing the context as buffer
SHAContextSize = 108;
/// hide all SHA-3 complex code by storing the Keccak Sponge as buffer
SHA3ContextSize = 412;
/// power of two for a standard AES block size during cypher/uncypher
// - to be used as 1 shl AESBlockShift or 1 shr AESBlockShift for fast div/mod
AESBlockShift = 4;
/// bit mask for fast modulo of AES block size
AESBlockMod = 15;
/// maximum AES key size (in bytes)
AESKeySize = 256 div 8;
type
/// class of Exceptions raised by this unit
ESynCrypto = class(ESynException);
/// 128 bits memory block for AES data cypher/uncypher
TAESBlock = THash128;
/// points to a 128 bits memory block, as used for AES data cypher/uncypher
PAESBlock = ^TAESBlock;
/// 256 bits memory block for maximum AES key storage
TAESKey = THash256;
/// stores an array of THash128 to check for their unicity
// - used e.g. to implement TAESAbstract.IVHistoryDepth property, but may be
// also used to efficiently store a list of 128-bit IPv6 addresses
{$ifdef USERECORDWITHMETHODS}THash128History = record
{$else}THash128History = object{$endif}
private
Previous: array of THash128Rec;
Index: integer;
public
/// how many THash128 values can be stored
Depth: integer;
/// how many THash128 values are currently stored
Count: integer;
/// initialize the storage for a given history depth
// - if Count reaches Depth, then older items will be removed
procedure Init(size, maxsize: integer);
/// O(n) fast search of a hash value in the stored entries
// - returns true if the hash was found, or false if it did not appear
function Exists(const hash: THash128): boolean;
{$ifdef HASINLINE}inline;{$endif}
/// add a hash value to the stored entries, checking for duplicates
// - returns true if the hash was added, or false if it did already appear
function Add(const hash: THash128): boolean;
end;
PAES = ^TAES;
/// handle AES cypher/uncypher
// - this is the default Electronic codebook (ECB) mode
// - this class will use AES-NI hardware instructions, if available
{$ifdef USEPADLOCK}
// - this class will use VIA PadLock instructions, if available
{$endif}
// - we defined a record instead of a class, to allow stack allocation and
// thread-safe reuse of one initialized instance (warning: not for Padlock)
{$ifdef USERECORDWITHMETHODS}TAES = record
{$else}TAES = object{$endif}
private
Context: packed array[1..AESContextSize] of byte;
{$ifdef USEPADLOCK}
function DoPadlockInit(const Key; KeySize: cardinal): boolean;
{$endif}
public
/// Initialize AES contexts for cypher
// - first method to call before using this object for encryption
// - KeySize is in bits, i.e. 128,192,256
function EncryptInit(const Key; KeySize: cardinal): boolean;
/// encrypt an AES data block into another data block
procedure Encrypt(const BI: TAESBlock; var BO: TAESBlock); overload;
/// encrypt an AES data block
procedure Encrypt(var B: TAESBlock); overload;
/// Initialize AES contexts for uncypher
// - first method to call before using this object for decryption
// - KeySize is in bits, i.e. 128,192,256
function DecryptInit(const Key; KeySize: cardinal): boolean;
/// Initialize AES contexts for uncypher, from another TAES.EncryptInit
function DecryptInitFrom(const Encryption{$ifndef DELPHI5OROLDER}: TAES{$endif};
const Key; KeySize: cardinal): boolean;
/// decrypt an AES data block
procedure Decrypt(var B: TAESBlock); overload;
/// decrypt an AES data block into another data block
procedure Decrypt(const BI: TAESBlock; var BO: TAESBlock); overload;
/// Finalize AES contexts for both cypher and uncypher
// - would fill the TAES instance with zeros, for safety
// - is only mandatoy when padlock is used
procedure Done;
/// generic initialization method for AES contexts
// - call either EncryptInit() either DecryptInit() method
function DoInit(const Key; KeySize: cardinal; doEncrypt: boolean): boolean;
/// perform the AES cypher or uncypher to continuous memory blocks
// - call either Encrypt() either Decrypt() method
procedure DoBlocks(pIn, pOut: PAESBlock; out oIn, oOut: PAESBLock; Count: integer; doEncrypt: boolean); overload;
/// perform the AES cypher or uncypher to continuous memory blocks
// - call either Encrypt() either Decrypt() method
procedure DoBlocks(pIn, pOut: PAESBlock; Count: integer; doEncrypt: boolean); overload;
{$ifdef USETHREADSFORBIGAESBLOCKS}
/// perform the AES cypher or uncypher to continuous memory blocks
// - this special method will use Threads for bigs blocks (>512KB) if multi-CPU
// - call either Encrypt() either Decrypt() method
procedure DoBlocksThread(var bIn, bOut: PAESBlock; Count: integer; doEncrypt: boolean);
{$endif}
/// performs AES-OFB encryption and decryption on whole blocks
// - may be called instead of TAESOFB when only a raw TAES is available
// - this method is thread-safe (except if padlock is used)
procedure DoBlocksOFB(const iv: TAESBlock; src, dst: pointer; blockcount: PtrUInt);
/// TRUE if the context was initialized via EncryptInit/DecryptInit
function Initialized: boolean; {$ifdef FPC}inline;{$endif}
/// return TRUE if the AES-NI instruction sets are available on this CPU
function UsesAESNI: boolean; {$ifdef HASINLINE}inline;{$endif}
/// returns the key size in bits (128/192/256)
function KeyBits: integer; {$ifdef FPC}inline;{$endif}
end;
type
/// low-level AES-GCM processing
// - implements standard AEAD (authenticated-encryption with associated-data)
// algorithm, as defined by NIST and
TAESGCMEngine = object
private
/// standard AES encryption context
// - will use AES-NI if available
actx: TAES;
/// ghash value of the Authentication Data
aad_ghv: TAESBlock;
/// ghash value of the Ciphertext
txt_ghv: TAESBlock;
/// ghash H current value
ghash_h: TAESBlock;
/// number of Authentication Data bytes processed
aad_cnt: TQWordRec;
/// number of bytes of the Ciphertext
atx_cnt: TQWordRec;
/// initial 32-bit ctr val - to be reused in Final()
y0_val: integer;
/// current 0..15 position in encryption block
blen: byte;
/// the state of this context
flags: set of (flagInitialized, flagFinalComputed, flagFlushed);
/// lookup table for fast Galois Finite Field multiplication
// - is defined as last field of the object for better code generation
gf_t4k: array[byte] of TAESBlock;
/// build the gf_t4k[] internal table - assuming set to zero by caller
procedure Make4K_Table;
/// compute a * ghash_h in Galois Finite Field 2^128
procedure gf_mul_h(var a: TAESBlock); {$ifdef FPC} inline; {$endif}
/// low-level AES-CTR encryption
procedure internal_crypt(ptp, ctp: PByte; ILen: PtrUInt);
/// low-level GCM authentication
procedure internal_auth(ctp: PByte; ILen: PtrUInt;
var ghv: TAESBlock; var gcnt: TQWordRec);
public
/// initialize the AES-GCM structure for the supplied Key
function Init(const Key; KeyBits: PtrInt): boolean;
/// start AES-GCM encryption with a given Initialization Vector
// - IV_len is in bytes use 12 for exact IV setting, otherwise the
// supplied buffer will be hashed using gf_mul_h()
function Reset(pIV: pointer; IV_len: PtrInt): boolean;
/// encrypt a buffer with AES-GCM, updating the associated authentication data
function Encrypt(ptp, ctp: Pointer; ILen: PtrInt): boolean;
/// decrypt a buffer with AES-GCM, updating the associated authentication data
// - also validate the GMAC with the supplied ptag/tlen if ptag<>nil,
// and skip the AES-CTR phase if the authentication doesn't match
function Decrypt(ctp, ptp: Pointer; ILen: PtrInt;
ptag: pointer=nil; tlen: PtrInt=0): boolean;
/// append some data to be authenticated, but not encrypted
function Add_AAD(pAAD: pointer; aLen: PtrInt): boolean;
/// finalize the AES-GCM encryption, returning the authentication tag
// - will also flush the AES context to avoid forensic issues, unless
// andDone is forced to false
function Final(out tag: TAESBlock; andDone: boolean=true): boolean;
/// flush the AES context to avoid forensic issues
// - do nothing if Final() has been already called
procedure Done;
/// single call AES-GCM encryption and authentication process
function FullEncryptAndAuthenticate(const Key; KeyBits: PtrInt;
pIV: pointer; IV_len: PtrInt; pAAD: pointer; aLen: PtrInt;
ptp, ctp: Pointer; pLen: PtrInt; out tag: TAESBlock): boolean;
/// single call AES-GCM decryption and verification process
function FullDecryptAndVerify(const Key; KeyBits: PtrInt;
pIV: pointer; IV_len: PtrInt; pAAD: pointer; aLen: PtrInt;
ctp, ptp: Pointer; pLen: PtrInt; ptag: pointer; tLen: PtrInt): boolean;
end;
/// class-reference type (metaclass) of an AES cypher/uncypher
TAESAbstractClass = class of TAESAbstract;
/// used internally by TAESAbstract to detect replay attacks
// - when EncryptPKCS7/DecryptPKCS7 are used with IVAtBeginning=true, and
// IVReplayAttackCheck property contains repCheckedIfAvailable or repMandatory
// - EncryptPKCS7 will encrypt this record (using the global shared
// AESIVCTR_KEY over AES-128) to create a random IV, as a secure
// cryptographic pseudorandom number generator (CSPRNG), nonce and ctr
// ensuring 96 bits of entropy
// - DecryptPKCS7 will decode and ensure that the IV has an increasing CTR
// - memory size matches an TAESBlock on purpose, for direct encryption
TAESIVCTR = packed record
/// 8 bytes of random value
nonce: QWord;
/// contains the crc32c hash of the block cipher mode (e.g. 'AESCFB')
// - when magic won't match (i.e. in case of mORMot revision < 3063), the
// check won't be applied in DecryptPKCS7: this security feature is
// backward compatible if IVReplayAttackCheck is repCheckedIfAvailable,
// but will fail for repMandatory
magic: cardinal;
/// an increasing counter, used to detect replay attacks
// - is set to a 32-bit random value at initialization
// - is increased by one for every EncryptPKCS7, so can be checked against
// replay attack in DecryptPKCS7, and implement a safe CSPRNG for stored IV
ctr: cardinal;
end;
/// how TAESAbstract.DecryptPKCS7 should detect replay attack
// - repNoCheck and repCheckedIfAvailable will be compatible with older
// versions of the protocol, but repMandatory will reject any encryption
// without the TAESIVCTR algorithm
TAESIVReplayAttackCheck = (repNoCheck, repCheckedIfAvailable, repMandatory);
/// handle AES cypher/uncypher with chaining
// - use any of the inherited implementation, corresponding to the chaining
// mode required - TAESECB, TAESCBC, TAESCFB, TAESOFB and TAESCTR classes to
// handle in ECB, CBC, CFB, OFB and CTR mode (including PKCS7-like padding)
TAESAbstract = class(TSynPersistent)
protected
fKeySize: cardinal;
fKeySizeBytes: cardinal;
fKey: TAESKey;
fIV: TAESBlock;
fIVCTR: TAESIVCTR;
fIVCTRState: (ctrUnknown, ctrUsed, ctrNotused);
fIVHistoryDec: THash128History;
fIVReplayAttackCheck: TAESIVReplayAttackCheck;
procedure SetIVHistory(aDepth: integer);
procedure SetIVCTR;
function DecryptPKCS7Len(var InputLen,ivsize: integer; Input: pointer;
IVAtBeginning, RaiseESynCryptoOnError: boolean): boolean;
public
/// Initialize AES context for cypher
// - first method to call before using this class
// - KeySize is in bits, i.e. 128,192,256
constructor Create(const aKey; aKeySize: cardinal); reintroduce; overload; virtual;
/// Initialize AES context for AES-128 cypher
// - first method to call before using this class
// - just a wrapper around Create(aKey,128);
constructor Create(const aKey: THash128); reintroduce; overload;
/// Initialize AES context for AES-256 cypher
// - first method to call before using this class
// - just a wrapper around Create(aKey,256);
constructor Create(const aKey: THash256); reintroduce; overload;
/// Initialize AES context for cypher, from some TAESPRNG random bytes
// - may be used to hide some sensitive information from memory, like
// CryptDataForCurrentUser but with a temporary key
constructor CreateTemp(aKeySize: cardinal);
/// Initialize AES context for cypher, from SHA-256 hash
// - here the Key is supplied as a string, and will be hashed using SHA-256
// via the SHA256Weak proprietary algorithm - to be used only for backward
// compatibility of existing code
// - consider using more secure (and more standard) CreateFromPBKDF2 instead
constructor CreateFromSha256(const aKey: RawUTF8);
/// Initialize AES context for cypher, from PBKDF2_HMAC_SHA256 derivation
// - here the Key is supplied as a string, and will be hashed using
// PBKDF2_HMAC_SHA256 with the specified salt and rounds
constructor CreateFromPBKDF2(const aKey: RawUTF8; const aSalt: RawByteString;
aRounds: Integer);
/// compute a class instance similar to this one
// - could be used to have a thread-safe re-use of a given encryption key
function Clone: TAESAbstract; virtual;
/// compute a class instance similar to this one, for performing the
// reverse encryption/decryption process
// - this default implementation calls Clone, but CFB/OFB/CTR chaining modes
// using only AES encryption (i.e. inheriting from TAESAbstractEncryptOnly)
// will return self to avoid creating two instances
// - warning: to be used only with IVAtBeginning=false
function CloneEncryptDecrypt: TAESAbstract; virtual;
/// release the used instance memory and resources
// - also fill the secret fKey buffer with zeros, for safety
destructor Destroy; override;
/// perform the AES cypher in the corresponding mode
// - when used in block chaining mode, you should have set the IV property
procedure Encrypt(BufIn, BufOut: pointer; Count: cardinal); virtual; abstract;
/// perform the AES un-cypher in the corresponding mode
// - when used in block chaining mode, you should have set the IV property
procedure Decrypt(BufIn, BufOut: pointer; Count: cardinal); virtual; abstract;
/// encrypt a memory buffer using a PKCS7 padding pattern
// - PKCS7 padding is described in RFC 5652 - it will add up to 16 bytes to
// the input buffer; note this method uses the padding only, not the whole
// PKCS#7 Cryptographic Message Syntax
// - if IVAtBeginning is TRUE, a random Initialization Vector will be computed,
// and stored at the beginning of the output binary buffer - this IV may
// contain an internal encrypted CTR, to detect any replay attack attempt,
// if IVReplayAttackCheck is set to repCheckedIfAvailable or repMandatory
function EncryptPKCS7(const Input: RawByteString; IVAtBeginning: boolean=false): RawByteString; overload;
/// decrypt a memory buffer using a PKCS7 padding pattern
// - PKCS7 padding is described in RFC 5652 - it will trim up to 16 bytes from
// the input buffer; note this method uses the padding only, not the whole
// PKCS#7 Cryptographic Message Syntax
// - if IVAtBeginning is TRUE, the Initialization Vector will be taken
// from the beginning of the input binary buffer - if IVReplayAttackCheck is
// set, this IV will be validated to contain an increasing encrypted CTR,
// and raise an ESynCrypto when a replay attack attempt is detected
// - if RaiseESynCryptoOnError=false, returns '' on any decryption error
function DecryptPKCS7(const Input: RawByteString; IVAtBeginning: boolean=false;
RaiseESynCryptoOnError: boolean=true): RawByteString; overload;
/// encrypt a memory buffer using a PKCS7 padding pattern
// - PKCS7 padding is described in RFC 5652 - it will add up to 16 bytes to
// the input buffer; note this method uses the padding only, not the whole
// PKCS#7 Cryptographic Message Syntax
// - if IVAtBeginning is TRUE, a random Initialization Vector will be computed,
// and stored at the beginning of the output binary buffer - this IV may
// contain an internal encrypted CTR, to detect any replay attack attempt,
// if IVReplayAttackCheck is set to repCheckedIfAvailable or repMandatory
function EncryptPKCS7(const Input: TBytes; IVAtBeginning: boolean=false): TBytes; overload;
/// decrypt a memory buffer using a PKCS7 padding pattern
// - PKCS7 padding is described in RFC 5652 - it will trim up to 16 bytes from
// the input buffer; note this method uses the padding only, not the whole
// PKCS#7 Cryptographic Message Syntax
// - if IVAtBeginning is TRUE, the Initialization Vector will be taken
// from the beginning of the input binary buffer - if IVReplayAttackCheck is
// set, this IV will be validated to contain an increasing encrypted CTR,
// and raise an ESynCrypto when a replay attack attempt is detected
// - if RaiseESynCryptoOnError=false, returns [] on any decryption error
function DecryptPKCS7(const Input: TBytes; IVAtBeginning: boolean=false;
RaiseESynCryptoOnError: boolean=true): TBytes; overload;
/// compute how many bytes would be needed in the output buffer, when
// encrypte using a PKCS7 padding pattern
// - could be used to pre-compute the OutputLength for EncryptPKCS7Buffer()
// - PKCS7 padding is described in RFC 5652 - it will add up to 16 bytes to
// the input buffer; note this method uses the padding only, not the whole
// PKCS#7 Cryptographic Message Syntax
function EncryptPKCS7Length(InputLen: cardinal; IVAtBeginning: boolean): cardinal;
{$ifdef HASINLINE}inline;{$endif}
/// encrypt a memory buffer using a PKCS7 padding pattern
// - PKCS7 padding is described in RFC 5652 - it will add up to 16 bytes to
// the input buffer; note this method uses the padding only, not the whole
// PKCS#7 Cryptographic Message Syntax
// - use EncryptPKCS7Length() function to compute the actual needed length
// - if IVAtBeginning is TRUE, a random Initialization Vector will be computed,
// and stored at the beginning of the output binary buffer - this IV will in
// fact contain an internal encrypted CTR, to detect any replay attack attempt
// - returns TRUE on success, FALSE if OutputLen is not correct - you should
// use EncryptPKCS7Length() to compute the exact needed number of bytes
function EncryptPKCS7Buffer(Input,Output: Pointer; InputLen,OutputLen: cardinal;
IVAtBeginning: boolean): boolean;
/// decrypt a memory buffer using a PKCS7 padding pattern
// - PKCS7 padding is described in RFC 5652 - it will trim up to 16 bytes from
// the input buffer; note this method uses the padding only, not the whole
// PKCS#7 Cryptographic Message Syntax
// - if IVAtBeginning is TRUE, the Initialization Vector will be taken
// from the beginning of the input binary buffer - this IV will in fact
// contain an internal encrypted CTR, to detect any replay attack attempt
// - if RaiseESynCryptoOnError=false, returns '' on any decryption error
function DecryptPKCS7Buffer(Input: Pointer; InputLen: integer;
IVAtBeginning: boolean; RaiseESynCryptoOnError: boolean=true): RawByteString;
/// initialize AEAD (authenticated-encryption with associated-data) nonce
// - i.e. setup 256-bit MAC computation during next Encrypt/Decrypt call
// - may be used e.g. for AES-GCM or our custom AES-CTR modes
// - default implementation, for a non AEAD protocol, returns false
function MACSetNonce(const aKey: THash256; aAssociated: pointer=nil;
aAssociatedLen: integer=0): boolean; virtual;
/// returns AEAD (authenticated-encryption with associated-data) MAC
/// - i.e. optional 256-bit MAC computation during last Encrypt/Decrypt call
// - may be used e.g. for AES-GCM or our custom AES-CTR modes
// - default implementation, for a non AEAD protocol, returns false
function MACGetLast(out aCRC: THash256): boolean; virtual;
/// validate if the computed AEAD MAC matches the expected supplied value
// - is just a wrapper around MACGetLast() and IsEqual() functions
function MACEquals(const aCRC: THash256): boolean; virtual;
/// validate if an encrypted buffer matches the stored AEAD MAC
// - expects the 256-bit MAC, as returned by MACGetLast, to be stored after
// the encrypted data
// - default implementation, for a non AEAD protocol, returns false
function MACCheckError(aEncrypted: pointer; Count: cardinal): boolean; virtual;
/// perform one step PKCS7 encryption/decryption and authentication from
// a given 256-bit key
// - returns '' on any (MAC) issue during decryption (Encrypt=false) or if
// this class does not support AEAD MAC
// - as used e.g. by CryptDataForCurrentUser()
// - do not use this abstract class method, but inherited TAESCFBCRC/TAESOFBCRC
// - will store a header with its own CRC, so detection of most invalid
// formats (e.g. from fuzzing input) will occur before any AES/MAC process
class function MACEncrypt(const Data: RawByteString; const Key: THash256;
Encrypt: boolean): RawByteString; overload;
/// perform one step PKCS7 encryption/decryption and authentication from
// a given 128-bit key
// - returns '' on any (MAC) issue during decryption (Encrypt=false) or if
// this class does not support AEAD MAC
// - do not use this abstract class method, but inherited TAESCFBCRC/TAESOFBCRC
// - will store a header with its own CRC, so detection of most invalid
// formats (e.g. from fuzzing input) will occur before any AES/MAC process
class function MACEncrypt(const Data: RawByteString; const Key: THash128;
Encrypt: boolean): RawByteString; overload;
/// perform one step PKCS7 encryption/decryption and authentication with
// the curent AES instance
// - returns '' on any (MAC) issue during decryption (Encrypt=false) or if
// this class does not support AEAD MAC
// - as used e.g. by CryptDataForCurrentUser()
// - do not use this abstract class method, but inherited TAESCFBCRC/TAESOFBCRC
// - will store a header with its own CRC, so detection of most invalid
// formats (e.g. from fuzzing input) will occur before any AES/MAC process
function MACAndCrypt(const Data: RawByteString; Encrypt: boolean): RawByteString;
/// simple wrapper able to cypher/decypher any in-memory content
// - here data variables could be text or binary
// - use StringToUTF8() to define the Key parameter from a VCL string
// - if IVAtBeginning is TRUE, a random Initialization Vector will be computed,
// and stored at the beginning of the output binary buffer
// - will use SHA256Weak() and PKCS7 padding with the current class mode
class function SimpleEncrypt(const Input,Key: RawByteString; Encrypt: boolean;
IVAtBeginning: boolean=false; RaiseESynCryptoOnError: boolean=true): RawByteString; overload;
/// simple wrapper able to cypher/decypher any in-memory content
// - here data variables could be text or binary
// - you could use e.g. THMAC_SHA256 to safely compute the Key/KeySize value
// - if IVAtBeginning is TRUE, a random Initialization Vector will be computed,
// and stored at the beginning of the output binary buffer
// - will use SHA256Weak() and PKCS7 padding with the current class mode
class function SimpleEncrypt(const Input: RawByteString; const Key;
KeySize: integer; Encrypt: boolean; IVAtBeginning: boolean=false;
RaiseESynCryptoOnError: boolean=true): RawByteString; overload;
/// simple wrapper able to cypher/decypher any file content
// - just a wrapper around SimpleEncrypt() and StringFromFile/FileFromString
// - use StringToUTF8() to define the Key parameter from a VCL string
// - if IVAtBeginning is TRUE, a random Initialization Vector will be computed,
// and stored at the beginning of the output binary buffer
// - will use SHA256Weak() and PKCS7 padding with the current class mode
class function SimpleEncryptFile(const InputFile, OutputFile: TFileName;
const Key: RawByteString; Encrypt: boolean; IVAtBeginning: boolean=false;
RaiseESynCryptoOnError: boolean=true): boolean; overload;
/// simple wrapper able to cypher/decypher any file content
// - just a wrapper around SimpleEncrypt() and StringFromFile/FileFromString
// - you could use e.g. THMAC_SHA256 to safely compute the Key/KeySize value
// - if IVAtBeginning is TRUE, a random Initialization Vector will be computed,
// and stored at the beginning of the output binary buffer
// - will use SHA256Weak() and PKCS7 padding with the current class mode
class function SimpleEncryptFile(const InputFile, Outputfile: TFileName; const Key;
KeySize: integer; Encrypt: boolean; IVAtBeginning: boolean=false;
RaiseESynCryptoOnError: boolean=true): boolean; overload;
//// returns e.g. 'aes128cfb' or '' if nil
function AlgoName: TShort16;
/// associated Key Size, in bits (i.e. 128,192,256)
property KeySize: cardinal read fKeySize;
/// associated Initialization Vector
// - all modes (except ECB) do expect an IV to be supplied for chaining,
// before any encryption or decryption is performed
// - you could also use PKCS7 encoding with IVAtBeginning=true option
property IV: TAESBlock read fIV write fIV;
/// let IV detect replay attack for EncryptPKCS7 and DecryptPKCS7
// - if IVAtBeginning=true and this property is set, EncryptPKCS7 will
// store a random IV from an internal CTR, and DecryptPKCS7 will check this
// incoming IV CTR consistency, and raise an ESynCrypto exception on failure
// - leave it to its default repNoCheck if the very same TAESAbstract
// instance is expected to be used with several sources, by which the IV CTR
// will be unsynchronized
// - security warning: by design, this is NOT cautious with CBC chaining:
// you should use it only with CFB, OFB or CTR mode, since the IV sequence
// will be predictable if you know the fixed AES private key of this unit,
// but the IV sequence features uniqueness as it is generated by a good PRNG -
// see http://crypto.stackexchange.com/q/3515
property IVReplayAttackCheck: TAESIVReplayAttackCheck
read fIVReplayAttackCheck write fIVReplayAttackCheck;
/// maintains an history of previous IV, to avoid re-play attacks
// - only useful when EncryptPKCS7/DecryptPKCS7 are used with
// IVAtBeginning=true, and IVReplayAttackCheck is left to repNoCheck
property IVHistoryDepth: integer read fIVHistoryDec.Depth write SetIVHistory;
end;
/// handle AES cypher/uncypher with chaining with out own optimized code
// - use any of the inherited implementation, corresponding to the chaining
// mode required - TAESECB, TAESCBC, TAESCFB, TAESOFB and TAESCTR classes to
// handle in ECB, CBC, CFB, OFB and CTR mode (including PKCS7-like padding)
// - this class will use AES-NI hardware instructions, if available
// - those classes are re-entrant, i.e. that you can call the Encrypt*
// or Decrypt* methods on the same instance several times
TAESAbstractSyn = class(TAESAbstract)
protected
fIn, fOut: PAESBlock;
fCV: TAESBlock;
AES: TAES;
fAESInit: (initNone, initEncrypt, initDecrypt);
procedure EncryptInit;
procedure DecryptInit;
procedure TrailerBytes(count: cardinal);
public
/// creates a new instance with the very same values
// - by design, our classes will use TAES stateless context, so this method
// will just copy the current fields to a new instance, by-passing
// the key creation step
function Clone: TAESAbstract; override;
/// release the used instance memory and resources
// - also fill the TAES instance with zeros, for safety
destructor Destroy; override;
/// perform the AES cypher in the corresponding mode, over Count bytes
// - this abstract method will set CV from fIV property, and fIn/fOut
// from BufIn/BufOut
procedure Encrypt(BufIn, BufOut: pointer; Count: cardinal); override;
/// perform the AES un-cypher in the corresponding mode
// - this abstract method will set CV from fIV property, and fIn/fOut
// from BufIn/BufOut
procedure Decrypt(BufIn, BufOut: pointer; Count: cardinal); override;
/// read-only access to the internal CV block, which may be have just been
// used by Encrypt/Decrypt methods
property CV: TAESBlock read fCV;
end;
/// handle AES cypher/uncypher without chaining (ECB)
// - this mode is known to be less secure than the others
// - IV property should be set to a fixed value to encode the trailing bytes
// of the buffer by a simple XOR - but you should better use the PKC7 pattern
// - this class will use AES-NI hardware instructions, if available, e.g.
// ! ECB128: 19.70ms in x86 optimized code, 6.97ms with AES-NI
TAESECB = class(TAESAbstractSyn)
public
/// perform the AES cypher in the ECB mode
procedure Encrypt(BufIn, BufOut: pointer; Count: cardinal); override;
/// perform the AES un-cypher in the ECB mode
procedure Decrypt(BufIn, BufOut: pointer; Count: cardinal); override;
end;
/// handle AES cypher/uncypher with Cipher-block chaining (CBC)
// - this class will use AES-NI hardware instructions, if available, e.g.
// ! CBC192: 24.91ms in x86 optimized code, 9.75ms with AES-NI
// - expect IV to be set before process, or IVAtBeginning=true
TAESCBC = class(TAESAbstractSyn)
public
/// perform the AES cypher in the CBC mode
procedure Encrypt(BufIn, BufOut: pointer; Count: cardinal); override;
/// perform the AES un-cypher in the CBC mode
procedure Decrypt(BufIn, BufOut: pointer; Count: cardinal); override;
end;
/// abstract parent class for chaining modes using only AES encryption
TAESAbstractEncryptOnly = class(TAESAbstractSyn)
public
/// Initialize AES context for cypher
// - will pre-generate the encryption key (aKeySize in bits, i.e. 128,192,256)
constructor Create(const aKey; aKeySize: cardinal); override;
/// compute a class instance similar to this one, for performing the
// reverse encryption/decryption process
// - will return self to avoid creating two instances
// - warning: to be used only with IVAtBeginning=false
function CloneEncryptDecrypt: TAESAbstract; override;
end;
/// handle AES cypher/uncypher with Cipher feedback (CFB)
// - this class will use AES-NI hardware instructions, if available, e.g.
// ! CFB128: 22.25ms in x86 optimized code, 9.29ms with AES-NI
// - expect IV to be set before process, or IVAtBeginning=true
TAESCFB = class(TAESAbstractEncryptOnly)
public
/// perform the AES cypher in the CFB mode
procedure Encrypt(BufIn, BufOut: pointer; Count: cardinal); override;
/// perform the AES un-cypher in the CFB mode
procedure Decrypt(BufIn, BufOut: pointer; Count: cardinal); override;
end;
/// handle AES cypher/uncypher with Output feedback (OFB)
// - this class will use AES-NI hardware instructions, if available, e.g.
// ! OFB256: 27.69ms in x86 optimized code, 9.94ms with AES-NI
// - expect IV to be set before process, or IVAtBeginning=true
// - TAESOFB 128/256 have an optimized asm version under x86_64 + AES_NI
TAESOFB = class(TAESAbstractEncryptOnly)
public
/// perform the AES cypher in the OFB mode
procedure Encrypt(BufIn, BufOut: pointer; Count: cardinal); override;
/// perform the AES un-cypher in the OFB mode
procedure Decrypt(BufIn, BufOut: pointer; Count: cardinal); override;
end;
/// handle AES cypher/uncypher with 64-bit Counter mode (CTR)
// - the CTR will use a counter in bytes 7..0 by default - which is safe
// but not standard - call ComposeIV() to change e.g. to NIST behavior
// - this class will use AES-NI hardware instructions, e.g.
// ! CTR256: 28.13ms in x86 optimized code, 10.63ms with AES-NI
// - expect IV to be set before process, or IVAtBeginning=true
TAESCTR = class(TAESAbstractEncryptOnly)
protected
fCTROffset, fCTROffsetMin: PtrInt;
public
/// Initialize AES context for cypher
// - will pre-generate the encryption key (aKeySize in bits, i.e. 128,192,256)
constructor Create(const aKey; aKeySize: cardinal); override;
/// defines how the IV is set and updated in CTR mode
// - default (if you don't call this method) uses a Counter in bytes 7..0
// - you can specify startup Nonce and Counter, and the Counter position
// - NonceLen + CounterLen should be 16 - otherwise it fails and returns false
function ComposeIV(Nonce, Counter: PAESBlock; NonceLen, CounterLen: integer;
LSBCounter: boolean): boolean; overload;
/// defines how the IV is set and updated in CTR mode
// - you can specify startup Nonce and Counter, and the Counter position
// - Nonce + Counter lengths should add to 16 - otherwise returns false
function ComposeIV(const Nonce, Counter: TByteDynArray; LSBCounter: boolean): boolean; overload;
/// perform the AES cypher in the CTR mode
procedure Encrypt(BufIn, BufOut: pointer; Count: cardinal); override;
/// perform the AES un-cypher in the CTR mode
procedure Decrypt(BufIn, BufOut: pointer; Count: cardinal); override;
end;
/// internal 256-bit structure used for TAESAbstractAEAD MAC storage
TAESMAC256 = record
/// the AES-encrypted MAC of the plain content
// - plain text digital signature, to perform message authentication
// and integrity
plain: THash128;
/// the plain MAC of the encrypted content
// - encrypted text digital signature, to check for errors,
// with no compromission of the plain content
encrypted: THash128;
end;
/// AEAD (authenticated-encryption with associated-data) abstract class
// - perform AES encryption and on-the-fly MAC computation, i.e. computes
// a proprietary 256-bit MAC during AES cyphering, as 128-bit CRC of the
// encrypted data and 128-bit CRC of the plain data, seeded from a Key
// - the 128-bit CRC of the plain text is then encrypted using the current AES
// engine, so returned 256-bit MAC value has cryptographic level, and ensure
// data integrity, authenticity, and check against transmission errors
TAESAbstractAEAD = class(TAESAbstractEncryptOnly)
protected
fMAC, fMACKey: TAESMAC256;
public
/// release the used instance memory and resources
// - also fill the internal internal MAC hashes with zeros, for safety
destructor Destroy; override;
/// initialize 256-bit MAC computation for next Encrypt/Decrypt call
// - initialize the internal fMACKey property, and returns true
// - only the plain text crc is seeded from aKey - encrypted message crc
// will use -1 as fixed seed, to avoid aKey compromission
// - should be set with a new MAC key value before each message, to avoid
// replay attacks (as called from TECDHEProtocol.SetKey)
function MACSetNonce(const aKey: THash256; aAssociated: pointer=nil;
aAssociatedLen: integer=0): boolean; override;
/// returns 256-bit MAC computed during last Encrypt/Decrypt call
// - encrypt the internal fMAC property value using the current AES cypher
// on the plain content and returns true; only the plain content CRC-128 is
// AES encrypted, to avoid reverse attacks against the known encrypted data
function MACGetLast(out aCRC: THash256): boolean; override;
/// validate if an encrypted buffer matches the stored MAC
// - expects the 256-bit MAC, as returned by MACGetLast, to be stored after
// the encrypted data
// - returns true if the 128-bit CRC of the encrypted text matches the
// supplied buffer, ignoring the 128-bit CRC of the plain data
// - since it is easy to forge such 128-bit CRC, it will only indicate
// that no transmission error occured, but won't be an integrity or
// authentication proof (which will need full Decrypt + MACGetLast)
// - may use any MACSetNonce() aAssociated value
function MACCheckError(aEncrypted: pointer; Count: cardinal): boolean; override;
end;
/// AEAD combination of AES with Cipher feedback (CFB) and 256-bit MAC
// - this class will use AES-NI and CRC32C hardware instructions, if available
// - expect IV to be set before process, or IVAtBeginning=true
TAESCFBCRC = class(TAESAbstractAEAD)
public
/// perform the AES cypher in the CFB mode, and compute a 256-bit MAC
procedure Encrypt(BufIn, BufOut: pointer; Count: cardinal); override;
/// perform the AES un-cypher in the CFB mode, and compute 256-bit MAC
procedure Decrypt(BufIn, BufOut: pointer; Count: cardinal); override;
end;
/// AEAD combination of AES with Output feedback (OFB) and 256-bit MAC
// - this class will use AES-NI and CRC32C hardware instructions, if available
// - expect IV to be set before process, or IVAtBeginning=true
TAESOFBCRC = class(TAESAbstractAEAD)
public
/// perform the AES cypher in the OFB mode, and compute a 256-bit MAC
procedure Encrypt(BufIn, BufOut: pointer; Count: cardinal); override;
/// perform the AES un-cypher in the OFB mode, and compute a 256-bit MAC
procedure Decrypt(BufIn, BufOut: pointer; Count: cardinal); override;
end;
/// handle AES-GCM cypher/uncypher with built-in authentication
// - implements AEAD (authenticated-encryption with associated-data) methods
// like MACEncrypt/MACCheckError
// - this class will use AES-NI hardware instructions, if available
TAESGCM = class(TAESAbstract)
protected
fAES: TAESGCMEngine;
fContext: (ctxNone,ctxEncrypt,ctxDecrypt); // used to call AES.Reset()
public
/// Initialize the AES-GCM context for cypher
// - first method to call before using this class
// - KeySize is in bits, i.e. 128,192,256
constructor Create(const aKey; aKeySize: cardinal); override;
/// creates a new instance with the very same values
// - by design, our classes will use TAESGCMEngine stateless context, so
// this method will just copy the current fields to a new instance,
// by-passing the key creation step
function Clone: TAESAbstract; override;
/// release the used instance memory and resources
// - also fill the internal TAES instance with zeros, for safety
destructor Destroy; override;
/// perform the AES-GCM cypher and authentication
procedure Encrypt(BufIn, BufOut: pointer; Count: cardinal); override;
/// perform the AES un-cypher and authentication
procedure Decrypt(BufIn, BufOut: pointer; Count: cardinal); override;
/// prepare the AES-GCM process before Encrypt/Decrypt is called
// - aKey is not used: AES-GCM has its own nonce setting algorithm, and
// the IV will be set from random value by EncryptPKCS7()
// - will just include any supplied associated data to the GMAC tag
function MACSetNonce(const aKey: THash256; aAssociated: pointer=nil;
aAssociatedLen: integer=0): boolean; override;
/// returns AEAD (authenticated-encryption with associated-data) MAC
/// - only the lower 128-bit (THash256.Lo) of aCRC is filled with the GMAC
function MACGetLast(out aCRC: THash256): boolean; override;
/// validate if an encrypted buffer matches the stored AEAD MAC
// - since AES-GCM is a one pass process, always assume the content is fine
// and returns true - we don't know the IV at this time
function MACCheckError(aEncrypted: pointer; Count: cardinal): boolean; override;
end;
{$ifdef USE_PROV_RSA_AES}
type
/// handle AES cypher/uncypher using Windows CryptoAPI and the
// official Microsoft AES Cryptographic Provider (PROV_RSA_AES)
// - see @http://msdn.microsoft.com/en-us/library/windows/desktop/aa386979
// - timing of our optimized asm versions, for small (<=8KB) block processing
// (similar to standard web pages or most typical JSON/XML content),
// benchmarked on a Core i7 notebook and compiled as Win32 platform:
// ! AES128 - ECB:79.33ms CBC:83.37ms CFB:80.75ms OFB:78.98ms CTR:80.45ms
// ! AES192 - ECB:91.16ms CBC:96.06ms CFB:96.45ms OFB:92.12ms CTR:93.38ms
// ! AES256 - ECB:103.22ms CBC:119.14ms CFB:111.59ms OFB:107.00ms CTR:110.13ms
// - timing of the same process, using CryptoAPI official PROV_RSA_AES provider:
// ! AES128 - ECB_API:102.88ms CBC_API:124.91ms
// ! AES192 - ECB_API:115.75ms CBC_API:129.95ms
// ! AES256 - ECB_API:139.50ms CBC_API:154.02ms
// - but the CryptoAPI does not supports AES-NI, whereas our classes handle it,
// with a huge speed benefit
// - under Win64, the official CryptoAPI is faster than our PUREPASCAL version,
// and the Win32 version of CryptoAPI itself, but slower than our AES-NI code
// ! AES128 - ECB:107.95ms CBC:112.65ms CFB:109.62ms OFB:107.23ms CTR:109.42ms
// ! AES192 - ECB:130.30ms CBC:133.04ms CFB:128.78ms OFB:127.25ms CTR:130.22ms
// ! AES256 - ECB:145.33ms CBC:147.01ms CFB:148.36ms OFB:145.96ms CTR:149.67ms
// ! AES128 - ECB_API:89.64ms CBC_API:100.84ms
// ! AES192 - ECB_API:99.05ms CBC_API:105.85ms
// ! AES256 - ECB_API:107.11ms CBC_API:118.04ms
// - in practice, you could forget about using the CryptoAPI, unless you are
// required to do so, for legal/corporate reasons
TAESAbstract_API = class(TAESAbstract)
protected
fKeyHeader: packed record
bType: byte;
bVersion: byte;
reserved: word;
aiKeyAlg: cardinal;
dwKeyLength: cardinal;
end;
fKeyHeaderKey: TAESKey; // should be just after fKeyHeader record
fKeyCryptoAPI: pointer;
fInternalMode: cardinal;
procedure InternalSetMode; virtual; abstract;
procedure EncryptDecrypt(BufIn, BufOut: pointer; Count: cardinal; DoEncrypt: boolean);
public
/// Initialize AES context for cypher
// - first method to call before using this class
// - KeySize is in bits, i.e. 128,192,256
constructor Create(const aKey; aKeySize: cardinal); override;
/// release the AES execution context
destructor Destroy; override;
/// perform the AES cypher in the ECB mode
// - if Count is not a multiple of a 16 bytes block, the IV will be used
// to XOR the trailing bytes - so it won't be compatible with our
// TAESAbstractSyn classes: you should better use PKC7 padding instead
procedure Encrypt(BufIn, BufOut: pointer; Count: cardinal); override;
/// perform the AES un-cypher in the ECB mode
// - if Count is not a multiple of a 16 bytes block, the IV will be used
// to XOR the trailing bytes - so it won't be compatible with our
// TAESAbstractSyn classes: you should better use PKC7 padding instead
procedure Decrypt(BufIn, BufOut: pointer; Count: cardinal); override;
end;
/// handle AES cypher/uncypher without chaining (ECB) using Windows CryptoAPI
TAESECB_API = class(TAESAbstract_API)
protected
/// will set fInternalMode := CRYPT_MODE_ECB
procedure InternalSetMode; override;
end;
/// handle AES cypher/uncypher Cipher-block chaining (CBC) using Windows CryptoAPI
TAESCBC_API = class(TAESAbstract_API)
protected
/// will set fInternalMode := CRYPT_MODE_CBC
procedure InternalSetMode; override;
end;
/// handle AES cypher/uncypher Cipher feedback (CFB) using Windows CryptoAPI
// - NOT TO BE USED: the current PROV_RSA_AES provider does not return
// expected values for CFB
TAESCFB_API = class(TAESAbstract_API)
protected
/// will set fInternalMode := CRYPT_MODE_CFB
procedure InternalSetMode; override;
end;
/// handle AES cypher/uncypher Output feedback (OFB) using Windows CryptoAPI
// - NOT TO BE USED: the current PROV_RSA_AES provider does not implement
// this mode, and returns a NTE_BAD_ALGID error
TAESOFB_API = class(TAESAbstract_API)
protected
/// will set fInternalMode := CRYPT_MODE_OFB
procedure InternalSetMode; override;
end;
{$endif USE_PROV_RSA_AES}
var
/// 128-bit random AES-128 entropy key for TAESAbstract.IVReplayAttackCheck
// - as used internally by AESIVCtrEncryptDecrypt() function
// - you may customize this secret for your own project, but be aware that
// it will affect all TAESAbstract instances, so should match on all ends
AESIVCTR_KEY: TBlock128 = (
$ce5d5e3e, $26506c65, $568e0092, $12cce480);
/// global shared function which may encrypt or decrypt any 128-bit block
// using AES-128 and the global AESIVCTR_KEY
procedure AESIVCtrEncryptDecrypt(const BI; var BO; DoEncrypt: boolean);
type
/// thread-safe class containing a TAES encryption/decryption engine
TAESLocked = class(TSynPersistentLock)
protected
fAES: TAES;
public
/// finalize all used memory and resources
destructor Destroy; override;
end;
/// cryptographic pseudorandom number generator (CSPRNG) based on AES-256
// - use as a shared instance via TAESPRNG.Fill() overloaded class methods
// - this class is able to generate some random output by encrypting successive
// values of a counter with AES-256 and a secret key
// - this internal secret key is generated from PBKDF2 derivation of OS-supplied
// entropy using HMAC over SHA-512
// - by design, such a PRNG is as good as the cypher used - for reference, see
// https://en.wikipedia.org/wiki/Cryptographically_secure_pseudorandom_number_generator
// - it would use fast hardware AES-NI or Padlock opcodes, if available
TAESPRNG = class(TAESLocked)
protected
fCTR: THash128Rec; // we use a litle-endian CTR
fBytesSinceSeed: integer;
fSeedAfterBytes: integer;
fAESKeySize: integer;
fSeedPBKDF2Rounds: cardinal;
fTotalBytes: QWord;
procedure IncrementCTR; {$ifdef HASINLINE}inline;{$endif}
public
/// initialize the internal secret key, using Operating System entropy
// - entropy is gathered from the OS, using GetEntropy() method
// - you can specify how many PBKDF2_HMAC_SHA512 rounds are applied to the
// OS-gathered entropy - the higher, the better, but also the slower
// - internal private key would be re-seeded after ReseedAfterBytes
// bytes (1MB by default) are generated, using GetEntropy()
// - by default, AES-256 will be used, unless AESKeySize is set to 128,
// which may be slightly faster (especially if AES-NI is not available)
constructor Create(PBKDF2Rounds: integer = 16;
ReseedAfterBytes: integer = 1024*1024; AESKeySize: integer = 256); reintroduce; virtual;
/// fill a TAESBlock with some pseudorandom data
// - could be used e.g. to compute an AES Initialization Vector (IV)
// - this method is thread-safe
procedure FillRandom(out Block: TAESBlock); overload; virtual;
/// fill a 256-bit buffer with some pseudorandom data
// - this method is thread-safe
procedure FillRandom(out Buffer: THash256); overload;
/// fill a binary buffer with some pseudorandom data
// - this method is thread-safe
procedure FillRandom(Buffer: pointer; Len: integer); overload; virtual;
/// returns a binary buffer filled with some pseudorandom data
// - this method is thread-safe
function FillRandom(Len: integer): RawByteString; overload;
/// returns a binary buffer filled with some pseudorandom data
// - this method is thread-safe
function FillRandomBytes(Len: integer): TBytes;
/// returns an hexa-encoded binary buffer filled with some pseudorandom data
// - this method is thread-safe
function FillRandomHex(Len: integer): RawUTF8;
/// returns a 32-bit unsigned random number
function Random32: cardinal; overload;
/// returns a 32-bit unsigned random number, with a maximum value
function Random32(max: cardinal): cardinal; overload;
/// returns a 64-bit unsigned random number
function Random64: QWord;
/// returns a floating-point random number in range [0..1]
function RandomExt: TSynExtended;
/// returns a 64-bit floating-point random number in range [0..1]
function RandomDouble: double;
/// computes a random ASCII password
// - will contain uppercase/lower letters, digits and $.:()?%!-+*/@#
// excluding ;,= to allow direct use in CSV content
function RandomPassword(Len: integer): RawUTF8;
/// would force the internal generator to re-seed its private key
// - avoid potential attacks on backward or forward security
// - would be called by FillRandom() methods, according to SeedAfterBytes
// - this method is thread-safe
procedure Seed; virtual;
/// retrieve some entropy bytes from the Operating System
// - entropy comes from CryptGenRandom API on Windows, and /dev/urandom or
// /dev/random on Linux/POSIX
// - this system-supplied entropy is then XORed with the output of a SHA-3
// cryptographic SHAKE-256 generator in XOF mode, of several entropy sources
// (timestamp, thread and system information, SynCommons.Random32 function)
// unless SystemOnly is TRUE
// - depending on the system, entropy may not be true randomness: if you need
// some truly random values, use TAESPRNG.Main.FillRandom() or TAESPRNG.Fill()
// methods, NOT this class function (which will be much slower, BTW)
class function GetEntropy(Len: integer; SystemOnly: boolean=false): RawByteString; virtual;
/// returns a shared instance of a TAESPRNG instance
// - if you need to generate some random content, just call the
// TAESPRNG.Main.FillRandom() overloaded methods, or directly TAESPRNG.Fill()
class function Main: TAESPRNG;
{$ifdef HASINLINE}inline;{$endif}
/// just a wrapper around TAESPRNG.Main.FillRandom() function
// - this method is thread-safe, but you may use your own TAESPRNG instance
// if you need some custom entropy level
class procedure Fill(Buffer: pointer; Len: integer); overload;
{$ifdef HASINLINE}inline;{$endif}
/// just a wrapper around TAESPRNG.Main.FillRandom() function
// - this method is thread-safe, but you may use your own TAESPRNG instance
// if you need some custom entropy level
class procedure Fill(out Block: TAESBlock); overload;
/// just a wrapper around TAESPRNG.Main.FillRandom() function
// - this method is thread-safe, but you may use your own TAESPRNG instance
// if you need some custom entropy level
class procedure Fill(out Block: THash256); overload;
{$ifdef HASINLINE}inline;{$endif}
/// just a wrapper around TAESPRNG.Main.FillRandom() function
// - this method is thread-safe, but you may use your own TAESPRNG instance
// if you need some custom entropy level
class function Fill(Len: integer): RawByteString; overload;
{$ifdef HASINLINE}inline;{$endif}
/// just a wrapper around TAESPRNG.Main.FillRandomBytes() function
// - this method is thread-safe, but you may use your own TAESPRNG instance
// if you need some custom entropy level
class function Bytes(Len: integer): TBytes;
{$ifdef HASINLINE}inline;{$endif}
/// create an anti-forensic representation of a key for safe storage
// - a binary buffer will be split into StripesCount items, ready to be
// saved on disk; returned length is BufferBytes*(StripesCount+1) bytes
// - AFSplit supports secure data destruction crucial for secure on-disk
// key management. The key idea is to bloat information and therefore
// improve the chance of destroying a single bit of it. The information
// is bloated in such a way, that a single missing bit causes the original
// information become unrecoverable.
// - this implementation uses SHA-256 as diffusion element, and the current
// TAESPRNG instance to gather randomness
// - for reference, see TKS1 as used for LUKS and defined in
// @https://gitlab.com/cryptsetup/cryptsetup/wikis/TKS1-draft.pdf
function AFSplit(const Buffer; BufferBytes, StripesCount: integer): RawByteString; overload;
/// create an anti-forensic representation of a key for safe storage
// - a binary buffer will be split into StripesCount items, ready to be
// saved on disk; returned length is BufferBytes*(StripesCount+1) bytes
// - jsut a wrapper around the other overloaded AFSplit() funtion
function AFSplit(const Buffer: RawByteString; StripesCount: integer): RawByteString; overload;
/// retrieve a key from its anti-forensic representation
// - is the reverse function of AFSplit() method
// - returns TRUE if the input buffer matches BufferBytes value
class function AFUnsplit(const Split: RawByteString;
out Buffer; BufferBytes: integer): boolean; overload;
/// retrieve a key from its anti-forensic representation
// - is the reverse function of AFSplit() method
// - returns the un-splitted binary content
// - returns '' if StripesCount is incorrect
class function AFUnsplit(const Split: RawByteString;
StripesCount: integer): RawByteString; overload;
/// after how many generated bytes Seed method would be called
// - default is 1 MB
property SeedAfterBytes: integer read fSeedAfterBytes;
/// how many PBKDF2_HMAC_SHA512 count is applied by Seed to the entropy
// - default is 16 rounds, which is more than enough for entropy gathering,
// since GetEntropy output comes from a SHAKE-256 generator in XOF mode
property SeedPBKDF2Rounds: cardinal read fSeedPBKDF2Rounds;
/// how many bits (128 or 256 - which is the default) are used for the AES
property AESKeySize: integer read fAESKeySize;
/// how many bytes this generator did compute
property TotalBytes: QWord read fTotalBytes;
end;
/// TAESPRNG-compatible class using Operating System pseudorandom source
// - may be used instead of TAESPRNG if a "standard" generator is required -
// you could override MainAESPRNG global variable
// - will call /dev/urandom under POSIX, and CryptGenRandom API on Windows
// - warning: may block on some BSD flavors, depending on /dev/urandom
// - from the cryptographic point of view, our TAESPRNG class doesn't suffer
// from the "black-box" approach of Windows, give consistent randomness
// over all supported cross-platform, and is indubitably faster
TAESPRNGSystem = class(TAESPRNG)
public
/// initialize the Operating System PRNG
constructor Create; reintroduce; virtual;
/// fill a TAESBlock with some pseudorandom data
// - this method is thread-safe
procedure FillRandom(out Block: TAESBlock); override;
/// fill a binary buffer with some pseudorandom data
// - this method is thread-safe
procedure FillRandom(Buffer: pointer; Len: integer); override;
/// called to force the internal generator to re-seed its private key
// - won't do anything for the Operating System pseudorandom source
procedure Seed; override;
end;
var
/// the shared TAESPRNG instance returned by TAESPRNG.Main class function
// - you may override this to a customized instance, e.g. if you expect
// a specific random generator to be used, like TAESPRNGSystem
// - all TAESPRNG.Fill() class functions will use this instance
MainAESPRNG: TAESPRNG;
{$ifdef HASINLINE}
/// defined globally to initialize MainAESPRNG for inlining TAESPRNG.Main
procedure SetMainAESPRNG;
{$endif}
/// low-level function returning some random binary using standard API
// - will call /dev/urandom or /dev/random under POSIX, and CryptGenRandom API
// on Windows, and fallback to SynCommons.FillRandom if the system API failed
// or for padding if more than 32 bytes is retrieved from /dev/urandom
// - you should not have to call this procedure, but faster and safer TAESPRNG
procedure FillSystemRandom(Buffer: PByteArray; Len: integer; AllowBlocking: boolean);
/// low-level function able to derivate a 0..1 floating-point from 128-bit of data
// - used e.g. by TAESPRNG.RandomExt
function Hash128ToExt({$ifdef FPC}constref{$else}const{$endif} r: THash128): TSynExtended;
{$ifdef FPC}inline;{$endif}
/// low-level function able to derivate a 0..1 64-bit floating-point from 128-bit of data
// - used e.g. by TAESPRNG.RandomDouble
function Hash128ToDouble({$ifdef FPC}constref{$else}const{$endif} r: THash128): double;
{$ifdef FPC}inline;{$endif}
/// low-level function able to derivate a 0..1 32-bit floating-point from 128-bit of data
function Hash128ToSingle({$ifdef FPC}constref{$else}const{$endif} r: THash128): double;
{$ifdef FPC}inline;{$endif}
type
PSHA1Digest = ^TSHA1Digest;
/// 160 bits memory block for SHA-1 hash digest storage
TSHA1Digest = THash160;
PSHA1 = ^TSHA1;
/// handle SHA-1 hashing
// - we defined a record instead of a class, to allow stack allocation and
// thread-safe reuse of one initialized instance, e.g. for THMAC_SHA1
// - see TSynHasher if you expect to support more than one algorithm at runtime
{$ifdef USERECORDWITHMETHODS}TSHA1 = record
{$else}TSHA1 = object{$endif}
private
Context: packed array[1..SHAContextSize] of byte;
public
/// initialize SHA-1 context for hashing
procedure Init;
/// update the SHA-1 context with some data
procedure Update(Buffer: pointer; Len: integer); overload;
/// update the SHA-1 context with some data
procedure Update(const Buffer: RawByteString); overload;
/// finalize and compute the resulting SHA-1 hash Digest of all data
// affected to Update() method
// - will also call Init to reset all internal temporary context, for safety
procedure Final(out Digest: TSHA1Digest; NoInit: boolean=false); overload;
/// finalize and compute the resulting SHA-1 hash Digest of all data
// affected to Update() method
// - will also call Init to reset all internal temporary context, for safety
function Final(NoInit: boolean=false): TSHA1Digest; overload; {$ifdef HASINLINE}inline;{$endif}
/// one method to rule them all
// - call Init, then Update(), then Final()
// - only Full() is Padlock-implemented - use this rather than Update()
procedure Full(Buffer: pointer; Len: integer; out Digest: TSHA1Digest);
end;
PSHA256Digest = ^TSHA256Digest;
/// 256 bits (32 bytes) memory block for SHA-256 hash digest storage
TSHA256Digest = THash256;
PSHA256 = ^TSHA256;
/// handle SHA-256 hashing
// - we defined a record instead of a class, to allow stack allocation and
// thread-safe reuse of one initialized instance, e.g. for THMAC_SHA256
// - see TSynHasher if you expect to support more than one algorithm at runtime
{$ifdef USERECORDWITHMETHODS}TSHA256 = record
{$else}TSHA256 = object{$endif}
private
Context: packed array[1..SHAContextSize] of byte;
public
/// initialize SHA-256 context for hashing
procedure Init;
/// update the SHA-256 context with some data
procedure Update(Buffer: pointer; Len: integer); overload;
/// update the SHA-256 context with some data
procedure Update(const Buffer: RawByteString); overload;
/// finalize and compute the resulting SHA-256 hash Digest of all data
// affected to Update() method
procedure Final(out Digest: TSHA256Digest; NoInit: boolean=false); overload;
/// finalize and compute the resulting SHA-256 hash Digest of all data
// affected to Update() method
function Final(NoInit: boolean=false): TSHA256Digest; overload; {$ifdef HASINLINE}inline;{$endif}
/// one method to rule them all
// - call Init, then Update(), then Final()
// - only Full() is Padlock-implemented - use this rather than Update()
procedure Full(Buffer: pointer; Len: integer; out Digest: TSHA256Digest);
end;
TSHA512Hash = record a, b, c, d, e, f, g, h: QWord; end;
PSHA384Digest = ^TSHA384Digest;
/// 384 bits (64 bytes) memory block for SHA-384 hash digest storage
TSHA384Digest = THash384;
/// handle SHA-384 hashing
// - it is in fact a TSHA512 truncated hash, with other initial hash values
// - we defined a record instead of a class, to allow stack allocation and
// thread-safe reuse of one initialized instance, e.g. for THMAC_SHA384
// - see TSynHasher if you expect to support more than one algorithm at runtime
{$ifdef USERECORDWITHMETHODS}TSHA384 = record
{$else}TSHA384 = object{$endif}
private
Hash: TSHA512Hash;
MLen: QWord;
Data: array[0..127] of byte;
Index: integer;
public
/// initialize SHA-384 context for hashing
procedure Init;
/// update the SHA-384 context with some data
procedure Update(Buffer: pointer; Len: integer); overload;
/// update the SHA-384 context with some data
procedure Update(const Buffer: RawByteString); overload;
/// finalize and compute the resulting SHA-384 hash Digest of all data
// affected to Update() method
// - will also call Init to reset all internal temporary context, for safety
procedure Final(out Digest: TSHA384Digest; NoInit: boolean=false); overload;
/// finalize and compute the resulting SHA-384 hash Digest of all data
// affected to Update() method
function Final(NoInit: boolean=false): TSHA384Digest; overload; {$ifdef HASINLINE}inline;{$endif}
/// one method to rule them all
// - call Init, then Update(), then Final()
procedure Full(Buffer: pointer; Len: integer; out Digest: TSHA384Digest);
end;
/// points to SHA-384 hashing instance
PSHA384 = ^TSHA384;
PSHA512Digest = ^TSHA512Digest;
/// 512 bits (64 bytes) memory block for SHA-512 hash digest storage
TSHA512Digest = THash512;
/// handle SHA-512 hashing
// - by design, this algorithm is expected to be much faster on 64-bit CPU,
// since all internal process involves QWord - but we included a SSE3 asm
// optimized version on 32-bit CPU under Windows and Linux, which is almost
// as fast as on plain x64, and even faster than SHA-256 and SHA-3
// - under x86/Delphi, plain pascal is 40MB/s, SSE3 asm 180MB/s
// - on x64, pascal Delphi is 150MB/s, and FPC is 190MB/s (thanks to native
// RorQWord intrinsic compiler function) - we also included a SSE4 asm version
// which outperforms other cryptographic hashes to more than 380MB/s
// - we defined a record instead of a class, to allow stack allocation and
// thread-safe reuse of one initialized instance, e.g. for THMAC_SHA512
// - see TSynHasher if you expect to support more than one algorithm at runtime
{$ifdef USERECORDWITHMETHODS}TSHA512 = record
{$else}TSHA512 = object{$endif}
private
Hash: TSHA512Hash;
MLen: QWord;
Data: array[0..127] of byte;
Index: integer;
public
/// initialize SHA-512 context for hashing
procedure Init;
/// update the SHA-512 context with some data
procedure Update(Buffer: pointer; Len: integer); overload;
/// update the SHA-512 context with some data
procedure Update(const Buffer: RawByteString); overload;
/// finalize and compute the resulting SHA-512 hash Digest of all data
// affected to Update() method
// - will also call Init to reset all internal temporary context, for safety
procedure Final(out Digest: TSHA512Digest; NoInit: boolean=false); overload;
/// finalize and compute the resulting SHA-512 hash Digest of all data
// affected to Update() method
function Final(NoInit: boolean=false): TSHA512Digest; overload; {$ifdef HASINLINE}inline;{$endif}
/// one method to rule them all
// - call Init, then Update(), then Final()
procedure Full(Buffer: pointer; Len: integer; out Digest: TSHA512Digest);
end;
/// points to SHA-512 hashing instance
PSHA512 = ^TSHA512;
/// SHA-3 instances, as defined by NIST Standard for Keccak sponge construction
TSHA3Algo = (SHA3_224, SHA3_256, SHA3_384, SHA3_512, SHAKE_128, SHAKE_256);
PSHA3 = ^TSHA3;
/// handle SHA-3 (Keccak) hashing
// - Keccak was the winner of the NIST hashing competition for a new hashing
// algorithm to provide an alternative to SHA-256. It became SHA-3 and was
// named by NIST a FIPS 180-4, then FIPS 202 hashing standard in 2015
// - by design, SHA-3 doesn't need to be encapsulated into a HMAC algorithm,
// since it already includes proper padding, so keys could be concatenated
// - this implementation is based on Wolfgang Ehrhardt's and Eric Grange's,
// with our own manually optimized x64 assembly
// - we defined a record instead of a class, to allow stack allocation and
// thread-safe reuse of one initialized instance, e.g. after InitCypher
// - see TSynHasher if you expect to support more than one algorithm at runtime
{$ifdef USERECORDWITHMETHODS}TSHA3 = record
{$else}TSHA3 = object{$endif}
private
Context: packed array[1..SHA3ContextSize] of byte;
public
/// initialize SHA-3 context for hashing
// - in practice, you may use SHA3_256 or SHA3_512 to return THash256
// or THash512 digests
procedure Init(Algo: TSHA3Algo);
/// update the SHA-3 context with some data
procedure Update(Buffer: pointer; Len: integer); overload;
/// update the SHA-3 context with some data
procedure Update(const Buffer: RawByteString); overload;
/// finalize and compute the resulting SHA-3 hash 256-bit Digest
procedure Final(out Digest: THash256; NoInit: boolean=false); overload;
/// finalize and compute the resulting SHA-3 hash 512-bit Digest
procedure Final(out Digest: THash512; NoInit: boolean=false); overload;
/// finalize and compute the resulting SHA-3 hash 256-bit Digest
function Final256(NoInit: boolean=false): THash256;
/// finalize and compute the resulting SHA-3 hash 512-bit Digest
function Final512(NoInit: boolean=false): THash512;
/// finalize and compute the resulting SHA-3 hash Digest
// - Digest destination buffer must contain enough bytes
// - default DigestBits=0 will write the default number of bits to Digest
// output memory buffer, according to the current TSHA3Algo
// - you can call this method several times, to use this SHA-3 hasher as
// "Extendable-Output Function" (XOF), e.g. for stream encryption (ensure
// NoInit is set to true, to enable recall)
procedure Final(Digest: pointer; DigestBits: integer=0; NoInit: boolean=false); overload;
/// compute a SHA-3 hash 256-bit Digest from a buffer, in one call
// - call Init, then Update(), then Final() using SHA3_256 into a THash256
procedure Full(Buffer: pointer; Len: integer; out Digest: THash256); overload;
/// compute a SHA-3 hash 512-bit Digest from a buffer, in one call
// - call Init, then Update(), then Final() using SHA3_512 into a THash512
procedure Full(Buffer: pointer; Len: integer; out Digest: THash512); overload;
/// compute a SHA-3 hash Digest from a buffer, in one call
// - call Init, then Update(), then Final() using the supplied algorithm
// - default DigestBits=0 will write the default number of bits to Digest
// output memory buffer, according to the specified TSHA3Algo
procedure Full(Algo: TSHA3Algo; Buffer: pointer; Len: integer;
Digest: pointer; DigestBits: integer=0); overload;
/// compute a SHA-3 hash hexadecimal Digest from a buffer, in one call
// - call Init, then Update(), then Final() using the supplied algorithm
// - default DigestBits=0 will write the default number of bits to Digest
// output memory buffer, according to the specified TSHA3Algo
function FullStr(Algo: TSHA3Algo; Buffer: pointer; Len: integer;
DigestBits: integer=0): RawUTF8;
/// uses SHA-3 in "Extendable-Output Function" (XOF) to cypher some content
// - there is no MAC stored in the resulting binary
// - Source and Dest will have the very same DataLen size in bytes,
// and Dest will be Source XORed with the XOF output, so encryption and
// decryption are just obtained by the same symmetric call
// - in this implementation, Source and Dest should point to two diverse buffers
// - for safety, the Key should be a secret value, pre-pended with a random
// salt/IV or a resource-specific identifier (e.g. a record ID or a S/N),
// to avoid reverse composition of the cypher from known content - note that
// concatenating keys with SHA-3 is as safe as computing a HMAC for SHA-2
procedure Cypher(Key, Source, Dest: pointer; KeyLen, DataLen: integer;
Algo: TSHA3Algo = SHAKE_256); overload;
/// uses SHA-3 in "Extendable-Output Function" (XOF) to cypher some content
// - this overloaded function works with RawByteString content
// - resulting string will have the very same size than the Source
// - XOF is implemented as a symmetrical algorithm: use this Cypher()
// method for both encryption and decryption of any buffer
function Cypher(const Key, Source: RawByteString; Algo: TSHA3Algo = SHAKE_256): RawByteString; overload;
/// uses SHA-3 in "Extendable-Output Function" (XOF) to cypher some content
// - prepare the instance to further Cypher() calls
// - you may reuse the very same TSHA3 instance by copying it to a local
// variable before calling this method (this copy is thread-safe)
// - works with RawByteString content
procedure InitCypher(Key: pointer; KeyLen: integer; Algo: TSHA3Algo = SHAKE_256); overload;
/// uses SHA-3 in "Extendable-Output Function" (XOF) to cypher some content
// - prepare the instance to further Cypher() calls
// - you may reuse the very same TSHA3 instance by copying it to a local
// variable before calling this method (this copy is thread-safe)
// - works with RawByteString content
procedure InitCypher(const Key: RawByteString; Algo: TSHA3Algo = SHAKE_256); overload;
/// uses SHA-3 in "Extendable-Output Function" (XOF) to cypher some content
// - this overloaded function expects the instance to have been prepared
// by previous InitCypher call
// - resulting Dest buffer will have the very same size than the Source
// - XOF is implemented as a symmetrical algorithm: use this Cypher()
// method for both encryption and decryption of any buffer
// - you can call this method several times, to work with a stream buffer;
// but for safety, you should eventually call Done
procedure Cypher(Source, Dest: pointer; DataLen: integer); overload;
/// uses SHA-3 in "Extendable-Output Function" (XOF) to cypher some content
// - this overloaded function expects the instance to have been prepared
// by previous InitCypher call
// - resulting string will have the very same size than the Source
// - XOF is implemented as a symmetrical algorithm: use this Cypher()
// method for both encryption and decryption of any buffer
// - you can call this method several times, to work with a stream buffer;
// but for safety, you should eventually call Done
function Cypher(const Source: RawByteString): RawByteString; overload;
/// returns the algorithm specified at Init()
function Algorithm: TSHA3Algo;
/// fill all used memory context with zeros, for safety
// - is necessary only when NoInit is set to true (e.g. after InitCypher)
procedure Done;
end;
TMD5In = array[0..15] of cardinal;
PMD5In = ^TMD5In;
/// 128 bits memory block for MD5 hash digest storage
TMD5Digest = THash128;
PMD5Digest = ^TMD5Digest;
PMD5 = ^TMD5;
TMD5Buf = TBlock128;
/// handle MD5 hashing
// - we defined a record instead of a class, to allow stack allocation and
// thread-safe reuse of one initialized instance
// - see TSynHasher if you expect to support more than one algorithm at runtime
// - even if MD5 is now seldom used, it is still faster than SHA alternatives,
// when you need a 128-bit cryptographic hash, but can afford some collisions
// - this implementation has optimized x86 and x64 assembly, for processing
// around 500MB/s, and a pure-pascal fallback code on other platforms
{$ifdef USERECORDWITHMETHODS}TMD5 = record
{$else}TMD5 = object{$endif}
private
in_: TMD5In;
bytes: array[0..1] of cardinal;
public
buf: TMD5Buf;
/// initialize MD5 context for hashing
procedure Init;
/// update the MD5 context with some data
procedure Update(const buffer; Len: cardinal); overload;
/// update the MD5 context with some data
procedure Update(const Buffer: RawByteString); overload;
/// finalize the MD5 hash process
// - the resulting hash digest would be stored in buf public variable
procedure Finalize;
/// finalize and compute the resulting MD5 hash Digest of all data
// affected to Update() method
procedure Final(out result: TMD5Digest); overload;
/// finalize and compute the resulting MD5 hash Digest of all data
// affected to Update() method
function Final: TMD5Digest; overload;
/// one method to rule them all
// - call Init, then Update(), then Final()
procedure Full(Buffer: pointer; Len: integer; out Digest: TMD5Digest);
end;
/// handle RC4 encryption/decryption
// - we defined a record instead of a class, to allow stack allocation and
// thread-safe reuse of one initialized instance
// - you can also restore and backup any previous state of the RC4 encryption
// by copying the whole TRC4 variable into another (stack-allocated) variable
{$ifdef USERECORDWITHMETHODS}TRC4 = record
{$else}TRC4 = object{$endif}
private
{$ifdef CPUINTEL}
state: array[byte] of PtrInt; // PtrInt=270MB/s byte=240MB/s on x86
{$else}
state: array[byte] of byte; // on ARM, keep the CPU cache usage low
{$endif}
currI, currJ: PtrInt;
public
/// initialize the RC4 encryption/decryption
// - KeyLen is in bytes, and should be within 1..255 range
procedure Init(const aKey; aKeyLen: integer);
/// initialize RC4-drop[3072] encryption/decryption after SHA-3 hashing
// - will use SHAKE-128 generator in XOF mode to generate a 256 bytes key,
// then drop the first 3072 bytes from the RC4 stream
// - this initializer is much safer than plain Init, so should be considered
// for any use on RC4 for new projects - even if AES-NI is 2 times faster,
// and safer SHAKE-128 operates in XOF mode at a similar speed range
procedure InitSHA3(const aKey; aKeyLen: integer);
/// drop the next Count bytes from the RC4 cypher state
// - may be used in Stream mode, or to initialize in RC4-drop[n] mode
procedure Drop(Count: cardinal);
/// perform the RC4 cypher encryption/decryption on a buffer
// - each call to this method shall be preceeded with an Init() call
// - RC4 is a symmetrical algorithm: use this Encrypt() method
// for both encryption and decryption of any buffer
procedure Encrypt(const BufIn; var BufOut; Count: cardinal);
{$ifdef HASINLINE}inline;{$endif}
/// perform the RC4 cypher encryption/decryption on a buffer
// - each call to this method shall be preceeded with an Init() call
// - RC4 is a symmetrical algorithm: use this EncryptBuffer() method
// for both encryption and decryption of any buffer
procedure EncryptBuffer(BufIn, BufOut: PByte; Count: cardinal);
end;
{$A-} { packed memory structure }
/// internal header for storing our AES data with salt and CRC
// - memory size matches an TAESBlock on purpose, for direct encryption
{$ifdef USERECORDWITHMETHODS}TAESFullHeader = record
{$else}TAESFullHeader = object{$endif}
public
/// Len before compression (if any)
OriginalLen,
/// Len before AES encoding
SourceLen,
/// Random Salt for better encryption
SomeSalt,
/// CRC from header
HeaderCheck: cardinal;
/// computes the Key checksum, using Adler32 algorithm
function Calc(const Key; KeySize: cardinal): cardinal;
end;
{$A+}
PAESFull = ^TAESFull;
/// AES and XOR encryption object for easy direct memory or stream access
// - calls internaly TAES objet methods, and handle memory and streams for best speed
// - a TAESFullHeader is encrypted at the begining, allowing fast Key validation,
// but the resulting stream is not compatible with raw TAES object
{$ifdef USERECORDWITHMETHODS}TAESFull = record
{$else}TAESFull = object{$endif}
public
/// header, stored at the beginning of struct -> 16-byte aligned
Head: TAESFullHeader;
/// this memory stream is used in case of EncodeDecode(outStream=bOut=nil)
// method call
outStreamCreated: TMemoryStream;
/// main method of AES or XOR cypher/uncypher
// - return out size, -1 if error on decoding (Key not correct)
// - valid KeySize: 0=nothing, 32=xor, 128,192,256=AES
// - if outStream is TMemoryStream -> auto-reserve space (no Realloc:)
// - for normal usage, you just have to Assign one In and one Out
// - if outStream AND bOut are both nil, an outStream is created via
// THeapMemoryStream.Create
// - if Padlock is used, 16-byte alignment is forced (via tmp buffer if necessary)
// - if Encrypt -> OriginalLen can be used to store unCompressed Len
function EncodeDecode(const Key; KeySize, inLen: cardinal; Encrypt: boolean;
inStream, outStream: TStream; bIn, bOut: pointer; OriginalLen: cardinal=0): integer;
end;
/// AES encryption stream
// - encrypt the Data on the fly, in a compatible way with AES() - last bytes
// are coded with XOR (not compatible with TAESFull format)
// - not optimized for small blocks -> ok if used AFTER TBZCompressor/TZipCompressor
// - warning: Write() will crypt Buffer memory in place -> use AFTER T*Compressor
TAESWriteStream = class(TStream)
public
Adler, // CRC from uncrypted compressed data - for Key check
DestSize: cardinal;
private
Dest: TStream;
Buf: TAESBlock; // very small buffer for remainging 0..15 bytes
BufCount: integer; // number of pending bytes (0..15) in Buf
AES: TAES;
NoCrypt: boolean; // if KeySize=0
public
/// initialize the AES encryption stream for an output stream (e.g.
// a TMemoryStream or a TFileStream)
constructor Create(outStream: TStream; const Key; KeySize: cardinal);
/// finalize the AES encryption stream
// - internaly call the Finish method
destructor Destroy; override;
/// read some data is not allowed -> this method will raise an exception on call
function Read(var Buffer; Count: Longint): Longint; override;
/// append some data to the outStream, after encryption
function Write(const Buffer; Count: Longint): Longint; override;
/// read some data is not allowed -> this method will raise an exception on call
function Seek(Offset: Longint; Origin: Word): Longint; override;
/// write pending data
// - should always be called before closeing the outStream (some data may
// still be in the internal buffers)
procedure Finish;
end;
/// direct MD5 hash calculation of some data
function MD5Buf(const Buffer; Len: Cardinal): TMD5Digest;
/// direct MD5 hash calculation of some data (string-encoded)
// - result is returned in hexadecimal format
function MD5(const s: RawByteString): RawUTF8;
/// direct SHA-1 hash calculation of some data (string-encoded)
// - result is returned in hexadecimal format
function SHA1(const s: RawByteString): RawUTF8;
/// direct SHA-384 hash calculation of some data (string-encoded)
// - result is returned in hexadecimal format
function SHA384(const s: RawByteString): RawUTF8;
/// direct SHA-512 hash calculation of some data (string-encoded)
// - result is returned in hexadecimal format
function SHA512(const s: RawByteString): RawUTF8;
type
/// compute the HMAC message authentication code using SHA-1 as hash function
// - you may use HMAC_SHA1() overloaded functions for one-step process
// - we defined a record instead of a class, to allow stack allocation and
// thread-safe reuse of one initialized instance via Compute(), e.g. for fast PBKDF2
{$ifdef USERECORDWITHMETHODS}THMAC_SHA1 = record
{$else}THMAC_SHA1 = object{$endif}
private
sha: TSHA1;
step7data: THash512Rec;
public
/// prepare the HMAC authentication with the supplied key
// - content of this record is stateless, so you can prepare a HMAC for a
// key using Init, then copy this THMAC_SHA1 instance to a local variable,
// and use this local thread-safe copy for actual HMAC computing
procedure Init(key: pointer; keylen: integer);
/// call this method for each continuous message block
// - iterate over all message blocks, then call Done to retrieve the HMAC
procedure Update(msg: pointer; msglen: integer);
/// computes the HMAC of all supplied message according to the key
procedure Done(out result: TSHA1Digest; NoInit: boolean=false); overload;
/// computes the HMAC of all supplied message according to the key
procedure Done(out result: RawUTF8; NoInit: boolean=false); overload;
/// computes the HMAC of the supplied message according to the key
// - expects a previous call on Init() to setup the shared key
// - similar to a single Update(msg,msglen) followed by Done, but re-usable
// - this method is thread-safe on any shared THMAC_SHA1 instance
procedure Compute(msg: pointer; msglen: integer; out result: TSHA1Digest);
end;
/// points to a HMAC message authentication context using SHA-1
PHMAC_SHA1 = ^THMAC_SHA1;
/// compute the HMAC message authentication code using SHA-1 as hash function
procedure HMAC_SHA1(const key,msg: RawByteString; out result: TSHA1Digest); overload;
/// compute the HMAC message authentication code using SHA-1 as hash function
procedure HMAC_SHA1(const key: TSHA1Digest; const msg: RawByteString;
out result: TSHA1Digest); overload;
/// compute the HMAC message authentication code using SHA-1 as hash function
procedure HMAC_SHA1(key,msg: pointer; keylen,msglen: integer;
out result: TSHA1Digest); overload;
/// compute the PBKDF2 derivation of a password using HMAC over SHA-1
// - this function expect the resulting key length to match SHA-1 digest size
procedure PBKDF2_HMAC_SHA1(const password,salt: RawByteString; count: Integer;
out result: TSHA1Digest);
type
/// compute the HMAC message authentication code using SHA-384 as hash function
// - you may use HMAC_SHA384() overloaded functions for one-step process
// - we defined a record instead of a class, to allow stack allocation and
// thread-safe reuse of one initialized instance via Compute(), e.g. for fast PBKDF2
{$ifdef USERECORDWITHMETHODS}THMAC_SHA384 = record
{$else}THMAC_SHA384 = object{$endif}
private
sha: TSHA384;
step7data: array[0..31] of cardinal;
public
/// prepare the HMAC authentication with the supplied key
// - content of this record is stateless, so you can prepare a HMAC for a
// key using Init, then copy this THMAC_SHA384 instance to a local variable,
// and use this local thread-safe copy for actual HMAC computing
procedure Init(key: pointer; keylen: integer);
/// call this method for each continuous message block
// - iterate over all message blocks, then call Done to retrieve the HMAC
procedure Update(msg: pointer; msglen: integer);
/// computes the HMAC of all supplied message according to the key
procedure Done(out result: TSHA384Digest; NoInit: boolean=false); overload;
/// computes the HMAC of all supplied message according to the key
procedure Done(out result: RawUTF8; NoInit: boolean=false); overload;
/// computes the HMAC of the supplied message according to the key
// - expects a previous call on Init() to setup the shared key
// - similar to a single Update(msg,msglen) followed by Done, but re-usable
// - this method is thread-safe on any shared THMAC_SHA384 instance
procedure Compute(msg: pointer; msglen: integer; out result: TSHA384Digest);
end;
/// points to a HMAC message authentication context using SHA-384
PHMAC_SHA384 = ^THMAC_SHA384;
/// compute the HMAC message authentication code using SHA-384 as hash function
procedure HMAC_SHA384(const key,msg: RawByteString; out result: TSHA384Digest); overload;
/// compute the HMAC message authentication code using SHA-384 as hash function
procedure HMAC_SHA384(const key: TSHA384Digest; const msg: RawByteString;
out result: TSHA384Digest); overload;
/// compute the HMAC message authentication code using SHA-384 as hash function
procedure HMAC_SHA384(key,msg: pointer; keylen,msglen: integer;
out result: TSHA384Digest); overload;
/// compute the PBKDF2 derivation of a password using HMAC over SHA-384
// - this function expect the resulting key length to match SHA-384 digest size
procedure PBKDF2_HMAC_SHA384(const password,salt: RawByteString; count: Integer;
out result: TSHA384Digest);
type
/// compute the HMAC message authentication code using SHA-512 as hash function
// - you may use HMAC_SHA512() overloaded functions for one-step process
// - we defined a record instead of a class, to allow stack allocation and
// thread-safe reuse of one initialized instance via Compute(), e.g. for fast PBKDF2
{$ifdef USERECORDWITHMETHODS}THMAC_SHA512 = record
{$else}THMAC_SHA512 = object{$endif}
private
sha: TSHA512;
step7data: array[0..31] of cardinal;
public
/// prepare the HMAC authentication with the supplied key
// - content of this record is stateless, so you can prepare a HMAC for a
// key using Init, then copy this THMAC_SHA512 instance to a local variable,
// and use this local thread-safe copy for actual HMAC computing
procedure Init(key: pointer; keylen: integer);
/// call this method for each continuous message block
// - iterate over all message blocks, then call Done to retrieve the HMAC
procedure Update(msg: pointer; msglen: integer);
/// computes the HMAC of all supplied message according to the key
procedure Done(out result: TSHA512Digest; NoInit: boolean=false); overload;
/// computes the HMAC of all supplied message according to the key
procedure Done(out result: RawUTF8; NoInit: boolean=false); overload;
/// computes the HMAC of the supplied message according to the key
// - expects a previous call on Init() to setup the shared key
// - similar to a single Update(msg,msglen) followed by Done, but re-usable
// - this method is thread-safe on any shared THMAC_SHA512 instance
procedure Compute(msg: pointer; msglen: integer; out result: TSHA512Digest);
end;
/// points to a HMAC message authentication context using SHA-512
PHMAC_SHA512 = ^THMAC_SHA512;
/// compute the HMAC message authentication code using SHA-512 as hash function
procedure HMAC_SHA512(const key,msg: RawByteString; out result: TSHA512Digest); overload;
/// compute the HMAC message authentication code using SHA-512 as hash function
procedure HMAC_SHA512(const key: TSHA512Digest; const msg: RawByteString;
out result: TSHA512Digest); overload;
/// compute the HMAC message authentication code using SHA-512 as hash function
procedure HMAC_SHA512(key,msg: pointer; keylen,msglen: integer;
out result: TSHA512Digest); overload;
/// compute the PBKDF2 derivation of a password using HMAC over SHA-512
// - this function expect the resulting key length to match SHA-512 digest size
procedure PBKDF2_HMAC_SHA512(const password,salt: RawByteString; count: Integer;
out result: TSHA512Digest);
/// direct SHA-256 hash calculation of some data (string-encoded)
// - result is returned in hexadecimal format
function SHA256(const s: RawByteString): RawUTF8; overload;
/// direct SHA-256 hash calculation of some binary data
// - result is returned in hexadecimal format
function SHA256(Data: pointer; Len: integer): RawUTF8; overload;
/// direct SHA-256 hash calculation of some binary data
// - result is returned in TSHA256Digest binary format
// - since the result would be stored temporarly in the stack, it may be
// safer to use an explicit TSHA256Digest variable, which would be filled
// with zeros by a ... finally FillZero(
function SHA256Digest(Data: pointer; Len: integer): TSHA256Digest; overload;
/// direct SHA-256 hash calculation of some binary data
// - result is returned in TSHA256Digest binary format
// - since the result would be stored temporarly in the stack, it may be
// safer to use an explicit TSHA256Digest variable, which would be filled
// with zeros by a ... finally FillZero(
function SHA256Digest(const Data: RawByteString): TSHA256Digest; overload;
/// direct SHA-256 hash calculation of some data (string-encoded)
// - result is returned in hexadecimal format
// - this procedure has a weak password protection: small incoming data
// is append to some salt, in order to have at least a 256 bytes long hash:
// such a feature improve security for small passwords, e.g.
// - note that this algorithm is proprietary, and less secure (and standard)
// than the PBKDF2 algorithm, so is there only for backward compatibility of
// existing code: use PBKDF2_HMAC_SHA256 or similar functions for password
// derivation
procedure SHA256Weak(const s: RawByteString; out Digest: TSHA256Digest);
type
/// compute the HMAC message authentication code using SHA-256 as hash function
// - you may use HMAC_SHA256() overloaded functions for one-step process
// - we defined a record instead of a class, to allow stack allocation and
// thread-safe reuse of one initialized instance via Compute(), e.g. for fast PBKDF2
{$ifdef USERECORDWITHMETHODS}THMAC_SHA256 = record
{$else}THMAC_SHA256 = object{$endif}
private
sha: TSha256;
step7data: THash512Rec;
public
/// prepare the HMAC authentication with the supplied key
// - content of this record is stateless, so you can prepare a HMAC for a
// key using Init, then copy this THMAC_SHA256 instance to a local variable,
// and use this local thread-safe copy for actual HMAC computing
procedure Init(key: pointer; keylen: integer);
/// call this method for each continuous message block
// - iterate over all message blocks, then call Done to retrieve the HMAC
procedure Update(msg: pointer; msglen: integer); overload;
/// call this method for each continuous message block
// - iterate over all message blocks, then call Done to retrieve the HMAC
procedure Update(const msg: THash128); overload;
/// call this method for each continuous message block
// - iterate over all message blocks, then call Done to retrieve the HMAC
procedure Update(const msg: THash256); overload;
/// call this method for each continuous message block
// - iterate over all message blocks, then call Done to retrieve the HMAC
procedure Update(const msg: RawByteString); overload;
/// computes the HMAC of all supplied message according to the key
procedure Done(out result: TSHA256Digest; NoInit: boolean=false); overload;
/// computes the HMAC of all supplied message according to the key
procedure Done(out result: RawUTF8; NoInit: boolean=false); overload;
/// computes the HMAC of the supplied message according to the key
// - expects a previous call on Init() to setup the shared key
// - similar to a single Update(msg,msglen) followed by Done, but re-usable
// - this method is thread-safe on any shared THMAC_SHA256 instance
procedure Compute(msg: pointer; msglen: integer; out result: TSHA256Digest);
end;
/// points to a HMAC message authentication context using SHA-256
PHMAC_SHA256 = ^THMAC_SHA256;
/// compute the HMAC message authentication code using SHA-256 as hash function
procedure HMAC_SHA256(const key,msg: RawByteString; out result: TSHA256Digest); overload;
/// compute the HMAC message authentication code using SHA-256 as hash function
procedure HMAC_SHA256(const key: TSHA256Digest; const msg: RawByteString;
out result: TSHA256Digest); overload;
/// compute the HMAC message authentication code using SHA-256 as hash function
procedure HMAC_SHA256(key,msg: pointer; keylen,msglen: integer; out result: TSHA256Digest); overload;
/// compute the PBKDF2 derivation of a password using HMAC over SHA-256
// - this function expect the resulting key length to match SHA-256 digest size
procedure PBKDF2_HMAC_SHA256(const password,salt: RawByteString; count: Integer;
out result: TSHA256Digest; const saltdefault: RawByteString=''); overload;
/// compute the PBKDF2 derivation of a password using HMAC over SHA-256, into
// several 256-bit items, so can be used to return any size of output key
// - this function expect the result array to have the expected output length
// - allows resulting key length to be more than one SHA-256 digest size, e.g.
// to be used for both Encryption and MAC
procedure PBKDF2_HMAC_SHA256(const password,salt: RawByteString; count: Integer;
var result: THash256DynArray; const saltdefault: RawByteString=''); overload;
/// low-level anti-forensic diffusion of a memory buffer using SHA-256
// - as used by TAESPRNG.AFSplit and TAESPRNG.AFUnSplit
procedure AFDiffusion(buf,rnd: pointer; size: cardinal);
/// direct SHA-3 hash calculation of some data (string-encoded)
// - result is returned in hexadecimal format
// - default DigestBits=0 will write the default number of bits to Digest
// output memory buffer, according to the specified TSHA3Algo
function SHA3(Algo: TSHA3Algo; const s: RawByteString;
DigestBits: integer=0): RawUTF8; overload;
/// direct SHA-3 hash calculation of some binary buffer
// - result is returned in hexadecimal format
// - default DigestBits=0 will write the default number of bits to Digest
// output memory buffer, according to the specified TSHA3Algo
function SHA3(Algo: TSHA3Algo; Buffer: pointer; Len: integer;
DigestBits: integer=0): RawUTF8; overload;
/// safe key derivation using iterated SHA-3 hashing
// - you can use SHA3_224, SHA3_256, SHA3_384, SHA3_512 algorithm to fill
// the result buffer with the default sized derivated key of 224,256,384 or 512
// bits (leaving resultbytes = 0)
// - or you may select SHAKE_128 or SHAKE_256, and specify any custom key size
// in resultbytes (used e.g. by PBKDF2_SHA3_Crypt)
procedure PBKDF2_SHA3(algo: TSHA3Algo; const password,salt: RawByteString;
count: Integer; result: PByte; resultbytes: integer=0);
/// encryption/decryption of any data using iterated SHA-3 hashing key derivation
// - specified algo is expected to be SHAKE_128 or SHAKE_256
// - expected the supplied data buffer to be small - for bigger content, consider
// using TSHA.Cypher after 256-bit PBKDF2_SHA3 key derivation
procedure PBKDF2_SHA3_Crypt(algo: TSHA3Algo; const password,salt: RawByteString;
count: Integer; var data: RawByteString);
type
/// the HMAC/SHA-3 algorithms known by TSynSigner
TSignAlgo = (
saSha1, saSha256, saSha384, saSha512,
saSha3224, saSha3256, saSha3384, saSha3512, saSha3S128, saSha3S256);
/// JSON-serialization ready object as used by TSynSigner.PBKDF2 overloaded methods
// - default value for unspecified parameters will be SHAKE_128 with
// rounds=1000 and a fixed salt
TSynSignerParams = packed record
algo: TSignAlgo;
secret,salt: RawUTF8;
rounds: integer;
end;
/// a generic wrapper object to handle digital HMAC-SHA-2/SHA-3 signatures
// - used e.g. to implement TJWTSynSignerAbstract
{$ifdef USERECORDWITHMETHODS}TSynSigner = record
{$else}TSynSigner = object{$endif}
private
ctxt: packed array[1..SHA3ContextSize] of byte; // enough space for all
fSignatureSize: integer;
fAlgo: TSignAlgo;
public
/// initialize the digital HMAC/SHA-3 signing context with some secret text
procedure Init(aAlgo: TSignAlgo; const aSecret: RawUTF8); overload;
/// initialize the digital HMAC/SHA-3 signing context with some secret binary
procedure Init(aAlgo: TSignAlgo; aSecret: pointer; aSecretLen: integer); overload;
/// initialize the digital HMAC/SHA-3 signing context with PBKDF2 safe
// iterative key derivation of a secret salted text
procedure Init(aAlgo: TSignAlgo; const aSecret, aSalt: RawUTF8;
aSecretPBKDF2Rounds: integer; aPBKDF2Secret: PHash512Rec=nil); overload;
/// process some message content supplied as memory buffer
procedure Update(aBuffer: pointer; aLen: integer); overload;
/// process some message content supplied as string
procedure Update(const aBuffer: RawByteString); overload; {$ifdef HASINLINE}inline;{$endif}
/// returns the computed digital signature as lowercase hexadecimal text
function Final: RawUTF8; overload;
/// returns the raw computed digital signature
// - SignatureSize bytes will be written: use Signature.Lo/h0/b3/b accessors
procedure Final(out aSignature: THash512Rec; aNoInit: boolean=false); overload;
/// one-step digital signature of a buffer as lowercase hexadecimal string
function Full(aAlgo: TSignAlgo; const aSecret: RawUTF8;
aBuffer: Pointer; aLen: integer): RawUTF8; overload;
/// one-step digital signature of a buffer with PBKDF2 derivation
function Full(aAlgo: TSignAlgo; const aSecret, aSalt: RawUTF8;
aSecretPBKDF2Rounds: integer; aBuffer: Pointer; aLen: integer): RawUTF8; overload;
/// convenient wrapper to perform PBKDF2 safe iterative key derivation
procedure PBKDF2(aAlgo: TSignAlgo; const aSecret, aSalt: RawUTF8;
aSecretPBKDF2Rounds: integer; out aDerivatedKey: THash512Rec); overload;
/// convenient wrapper to perform PBKDF2 safe iterative key derivation
procedure PBKDF2(const aParams: TSynSignerParams; out aDerivatedKey: THash512Rec); overload;
/// convenient wrapper to perform PBKDF2 safe iterative key derivation
// - accept as input a TSynSignerParams serialized as JSON object
procedure PBKDF2(aParamsJSON: PUTF8Char; aParamsJSONLen: integer;
out aDerivatedKey: THash512Rec; const aDefaultSalt: RawUTF8='I6sWioAidNnhXO9BK';
aDefaultAlgo: TSignAlgo=saSha3S128); overload;
/// convenient wrapper to perform PBKDF2 safe iterative key derivation
// - accept as input a TSynSignerParams serialized as JSON object
procedure PBKDF2(const aParamsJSON: RawUTF8; out aDerivatedKey: THash512Rec;
const aDefaultSalt: RawUTF8='I6sWioAidNnhXO9BK'; aDefaultAlgo: TSignAlgo=saSha3S128); overload;
/// prepare a TAES object with the key derivated via a PBKDF2() call
// - aDerivatedKey is defined as "var", since it will be zeroed after use
procedure AssignTo(var aDerivatedKey: THash512Rec; out aAES: TAES; aEncrypt: boolean);
/// fill the intenral context with zeros, for security
procedure Done;
/// the algorithm used for digitial signature
property Algo: TSignAlgo read fAlgo;
/// the size, in bytes, of the digital signature of this algorithm
// - potential values are 20, 28, 32, 48 and 64
property SignatureSize: integer read fSignatureSize;
end;
/// reference to TSynSigner wrapper object
PSynSigner = ^TSynSigner;
/// hash algorithms available for HashFile/HashFull functions and TSynHasher object
THashAlgo = (hfMD5, hfSHA1, hfSHA256, hfSHA384, hfSHA512, hfSHA3_256, hfSHA3_512);
/// set of algorithms available for HashFile/HashFull functions and TSynHasher object
THashAlgos = set of THashAlgo;
/// convenient multi-algorithm hashing wrapper
// - as used e.g. by HashFile/HashFull functions
// - we defined a record instead of a class, to allow stack allocation and
// thread-safe reuse of one initialized instance
{$ifdef USERECORDWITHMETHODS}TSynHasher = record
{$else}TSynHasher = object{$endif}
private
fAlgo: THashAlgo;
ctxt: array[1..SHA3ContextSize] of byte; // enough space for all algorithms
public
/// initialize the internal hashing structure for a specific algorithm
// - returns false on unknown/unsupported algorithm
function Init(aAlgo: THashAlgo): boolean;
/// hash the supplied memory buffer
procedure Update(aBuffer: Pointer; aLen: integer); overload;
/// hash the supplied string content
procedure Update(const aBuffer: RawByteString); overload; {$ifdef HASINLINE}inline;{$endif}
/// returns the resulting hash as lowercase hexadecimal string
function Final: RawUTF8;
/// one-step hash computation of a buffer as lowercase hexadecimal string
function Full(aAlgo: THashAlgo; aBuffer: Pointer; aLen: integer): RawUTF8;
/// the hash algorithm used by this instance
property Algo: THashAlgo read fAlgo;
end;
/// compute the hexadecimal hash of any (big) file
// - using a temporary buffer of 1MB for the sequential reading
function HashFile(const aFileName: TFileName; aAlgo: THashAlgo): RawUTF8; overload;
/// compute the hexadecimal hashe(s) of one file, as external .md5/.sha256/.. files
// - reading the file once in memory, then apply all algorithms on it and
// generate the text hash files in the very same folder
procedure HashFile(const aFileName: TFileName; aAlgos: THashAlgos); overload;
/// one-step hash computation of a buffer as lowercase hexadecimal string
function HashFull(aAlgo: THashAlgo; aBuffer: Pointer; aLen: integer): RawUTF8;
/// compute the HMAC message authentication code using crc256c as hash function
// - HMAC over a non cryptographic hash function like crc256c is known to be
// safe as MAC, if the supplied key comes e.g. from cryptographic HMAC_SHA256
// - performs two crc32c hashes, so SSE 4.2 gives more than 2.2 GB/s on a Core i7
procedure HMAC_CRC256C(key,msg: pointer; keylen,msglen: integer; out result: THash256); overload;
/// compute the HMAC message authentication code using crc256c as hash function
// - HMAC over a non cryptographic hash function like crc256c is known to be
// safe as MAC, if the supplied key comes e.g. from cryptographic HMAC_SHA256
// - performs two crc32c hashes, so SSE 4.2 gives more than 2.2 GB/s on a Core i7
procedure HMAC_CRC256C(const key: THash256; const msg: RawByteString; out result: THash256); overload;
/// compute the HMAC message authentication code using crc256c as hash function
// - HMAC over a non cryptographic hash function like crc256c is known to be
// safe as MAC, if the supplied key comes e.g. from cryptographic HMAC_SHA256
// - performs two crc32c hashes, so SSE 4.2 gives more than 2.2 GB/s on a Core i7
procedure HMAC_CRC256C(const key,msg: RawByteString; out result: THash256); overload;
type
/// compute the HMAC message authentication code using crc32c as hash function
// - HMAC over a non cryptographic hash function like crc32c is known to be a
// safe enough MAC, if the supplied key comes e.g. from cryptographic HMAC_SHA256
// - SSE 4.2 will let MAC be computed at 4 GB/s on a Core i7
// - you may use HMAC_CRC32C() overloaded functions for one-step process
// - we defined a record instead of a class, to allow stack allocation and
// thread-safe reuse of one initialized instance via Compute()
{$ifdef USERECORDWITHMETHODS}THMAC_CRC32C = record
{$else}THMAC_CRC32C = object{$endif}
private
seed: cardinal;
step7data: THash512Rec;
public
/// prepare the HMAC authentication with the supplied key
// - consider using Compute to re-use a prepared HMAC instance
procedure Init(key: pointer; keylen: integer); overload;
/// prepare the HMAC authentication with the supplied key
// - consider using Compute to re-use a prepared HMAC instance
procedure Init(const key: RawByteString); overload;
/// call this method for each continuous message block
// - iterate over all message blocks, then call Done to retrieve the HMAC
procedure Update(msg: pointer; msglen: integer); overload;
{$ifdef HASINLINE}inline;{$endif}
/// call this method for each continuous message block
// - iterate over all message blocks, then call Done to retrieve the HMAC
procedure Update(const msg: RawByteString); overload;
{$ifdef HASINLINE}inline;{$endif}
/// computes the HMAC of all supplied message according to the key
function Done(NoInit: boolean=false): cardinal;
{$ifdef HASINLINE}inline;{$endif}
/// computes the HMAC of the supplied message according to the key
// - expects a previous call on Init() to setup the shared key
// - similar to a single Update(msg,msglen) followed by Done, but re-usable
// - this method is thread-safe
function Compute(msg: pointer; msglen: integer): cardinal;
end;
/// points to HMAC message authentication code using crc32c as hash function
PHMAC_CRC32C= ^THMAC_CRC32C;
/// compute the HMAC message authentication code using crc32c as hash function
// - HMAC over a non cryptographic hash function like crc32c is known to be a
// safe enough MAC, if the supplied key comes e.g. from cryptographic HMAC_SHA256
// - SSE 4.2 will let MAC be computed at 4 GB/s on a Core i7
function HMAC_CRC32C(key,msg: pointer; keylen,msglen: integer): cardinal; overload;
/// compute the HMAC message authentication code using crc32c as hash function
// - HMAC over a non cryptographic hash function like crc32c is known to be a
// safe enough MAC, if the supplied key comes e.g. from cryptographic HMAC_SHA256
// - SSE 4.2 will let MAC be computed at 4 GB/s on a Core i7
function HMAC_CRC32C(const key: THash256; const msg: RawByteString): cardinal; overload;
/// compute the HMAC message authentication code using crc32c as hash function
// - HMAC over a non cryptographic hash function like crc32c is known to be a
// safe enough MAC, if the supplied key comes e.g. from cryptographic HMAC_SHA256
// - SSE 4.2 will let MAC be computed at 4 GB/s on a Core i7
function HMAC_CRC32C(const key,msg: RawByteString): cardinal; overload;
/// direct Encrypt/Decrypt of data using the TAES class
// - last bytes (not part of 16 bytes blocks) are not crypted by AES, but with XOR
procedure AES(const Key; KeySize: cardinal; buffer: pointer; Len: Integer; Encrypt: boolean); overload;
/// direct Encrypt/Decrypt of data using the TAES class
// - last bytes (not part of 16 bytes blocks) are not crypted by AES, but with XOR
procedure AES(const Key; KeySize: cardinal; bIn, bOut: pointer; Len: Integer; Encrypt: boolean); overload;
/// direct Encrypt/Decrypt of data using the TAES class
// - last bytes (not part of 16 bytes blocks) are not crypted by AES, but with XOR
function AES(const Key; KeySize: cardinal; const s: RawByteString; Encrypt: boolean): RawByteString; overload;
/// direct Encrypt/Decrypt of data using the TAES class
// - last bytes (not part of 16 bytes blocks) are not crypted by AES, but with XOR
function AES(const Key; KeySize: cardinal; buffer: pointer; Len: cardinal; Stream: TStream; Encrypt: boolean): boolean; overload;
/// AES and XOR encryption using the TAESFull format
// - outStream will be larger/smaller than Len (full AES encrypted)
// - returns true if OK
function AESFull(const Key; KeySize: cardinal; bIn: pointer; Len: Integer;
outStream: TStream; Encrypt: boolean; OriginalLen: Cardinal=0): boolean; overload;
/// AES and XOR encryption using the TAESFull format
// - bOut must be at least bIn+32/Encrypt bIn-16/Decrypt
// - returns outLength, -1 if error
function AESFull(const Key; KeySize: cardinal; bIn, bOut: pointer; Len: Integer;
Encrypt: boolean; OriginalLen: Cardinal=0): integer; overload;
/// AES and XOR decryption check using the TAESFull format
// - return true if begining of buff contains true AESFull encrypted data with this Key
// - if not KeySize in [128,192,256] -> use fast and efficient Xor Cypher
function AESFullKeyOK(const Key; KeySize: cardinal; buff: pointer): boolean;
/// AES encryption using the TAES format with a supplied SHA-256 password
// - last bytes (not part of 16 bytes blocks) are not crypted by AES, but with XOR
procedure AESSHA256(Buffer: pointer; Len: integer; const Password: RawByteString; Encrypt: boolean); overload;
/// AES encryption using the TAES format with a supplied SHA-256 password
// - last bytes (not part of 16 bytes blocks) are not crypted by AES, but with XOR
procedure AESSHA256(bIn, bOut: pointer; Len: integer; const Password: RawByteString; Encrypt: boolean); overload;
/// AES encryption using the TAES format with a supplied SHA-256 password
// - last bytes (not part of 16 bytes blocks) are not crypted by AES, but with XOR
function AESSHA256(const s, Password: RawByteString; Encrypt: boolean): RawByteString; overload;
/// AES encryption using the TAESFull format with a supplied SHA-256 password
// - outStream will be larger/smaller than Len: this is a full AES version with
// a triming TAESFullHeader at the beginning
procedure AESSHA256Full(bIn: pointer; Len: Integer; outStream: TStream; const Password: RawByteString; Encrypt: boolean); overload;
var
/// salt for CryptDataForCurrentUser function
// - is filled with some random bytes by default, but you may override
// it for a set of custom processes calling CryptDataForCurrentUser
CryptProtectDataEntropy: THash256 = (
$19,$8E,$BA,$52,$FA,$D6,$56,$99,$7B,$73,$1B,$D0,$8B,$3A,$95,$AB,
$94,$63,$C2,$C0,$78,$05,$9C,$8B,$85,$B7,$A1,$E3,$ED,$93,$27,$18);
{$ifdef MSWINDOWS}
/// protect some data for the current user, using Windows DPAPI
// - the application can specify a secret salt text, which should reflect the
// current execution context, to ensure nobody could decrypt the data without
// knowing this application-specific AppSecret value
// - will use CryptProtectData DPAPI function call under Windows
// - see https://msdn.microsoft.com/en-us/library/ms995355
// - this function is Windows-only, could be slow, and you don't know which
// algorithm is really used on your system, so using CryptDataForCurrentUser()
// may be a better (and cross-platform) alternative
// - also note that DPAPI has been closely reverse engineered - see e.g.
// https://www.passcape.com/index.php?section=docsys&cmd=details&id=28
function CryptDataForCurrentUserDPAPI(const Data,AppSecret: RawByteString; Encrypt: boolean): RawByteString;
{$endif}
/// protect some data via AES-256-CFB and a secret known by the current user only
// - the application can specify a secret salt text, which should reflect the
// current execution context, to ensure nobody could decrypt the data without
// knowing this application-specific AppSecret value
// - here data is cyphered using a random secret key, stored in a file located in
// ! GetSystemPath(spUserData)+sep+PBKDF2_HMAC_SHA256(CryptProtectDataEntropy,User)
// with sep='_' under Windows, and sep='.syn-' under Linux/Posix
// - under Windows, it will encode the secret file via CryptProtectData DPAPI,
// so has the same security level than plain CryptDataForCurrentUserDPAPI()
// - under Linux/POSIX, access to the $HOME user's .xxxxxxxxxxx secret file with
// chmod 400 is considered to be a safe enough approach
// - this function is up to 100 times faster than CryptDataForCurrentUserDPAPI,
// generates smaller results, and is consistent on all Operating Systems
// - you can use this function over a specified variable, to cypher it in place,
// with try ... finally block to protect memory access of the plain data:
// ! constructor TMyClass.Create;
// ! ...
// ! fSecret := CryptDataForCurrentUser('Some Secret Value','appsalt',true);
// ! ...
// ! procedure TMyClass.DoSomething;
// ! var plain: RawByteString;
// ! begin
// ! plain := CryptDataForCurrentUser(fSecret,'appsalt',false);
// ! try
// ! // here plain = 'Some Secret Value'
// ! finally
// ! FillZero(plain); // safely erase uncyphered content from heap
// ! end;
// ! end;
function CryptDataForCurrentUser(const Data,AppSecret: RawByteString; Encrypt: boolean): RawByteString;
const
SHA1DIGESTSTRLEN = sizeof(TSHA1Digest)*2;
SHA256DIGESTSTRLEN = sizeof(TSHA256Digest)*2;
MD5DIGESTSTRLEN = sizeof(TMD5Digest)*2;
type
/// 32-characters ASCII string, e.g. as returned by AESBlockToShortString()
Short32 = string[32];
/// compute the hexadecial representation of an AES 16-byte block
// - returns a stack-allocated short string
function AESBlockToShortString(const block: TAESBlock): short32; overload;
{$ifdef HASINLINE}inline;{$endif}
/// compute the hexadecial representation of an AES 16-byte block
// - fill a stack-allocated short string
procedure AESBlockToShortString(const block: TAESBlock; out result: short32); overload;
{$ifdef HASINLINE}inline;{$endif}
/// compute the hexadecial representation of an AES 16-byte block
function AESBlockToString(const block: TAESBlock): RawUTF8;
/// compute the hexadecimal representation of a SHA-1 digest
function SHA1DigestToString(const D: TSHA1Digest): RawUTF8;
{$ifdef HASINLINE}inline;{$endif}
/// compute the SHA-1 digest from its hexadecimal representation
// - returns true on success (i.e. Source has the expected size and characters)
// - just a wrapper around SynCommons.HexToBin()
function SHA1StringToDigest(const Source: RawUTF8; out Dest: TSHA1Digest): boolean;
{$ifdef HASINLINE}inline;{$endif}
/// compute the hexadecimal representation of a SHA-256 digest
function SHA256DigestToString(const D: TSHA256Digest): RawUTF8;
{$ifdef HASINLINE}inline;{$endif}
/// compute the SHA-256 digest from its hexadecimal representation
// - returns true on success (i.e. Source has the expected size and characters)
// - just a wrapper around SynCommons.HexToBin()
function SHA256StringToDigest(const Source: RawUTF8; out Dest: TSHA256Digest): boolean;
{$ifdef HASINLINE}inline;{$endif}
/// compute the hexadecimal representation of a SHA-384 digest
function SHA384DigestToString(const D: TSHA384Digest): RawUTF8;
{$ifdef HASINLINE}inline;{$endif}
/// compute the hexadecimal representation of a SHA-512 digest
function SHA512DigestToString(const D: TSHA512Digest): RawUTF8;
{$ifdef HASINLINE}inline;{$endif}
/// compute the hexadecimal representation of a MD5 digest
function MD5DigestToString(const D: TMD5Digest): RawUTF8;
{$ifdef HASINLINE}inline;{$endif}
/// compute the MD5 digest from its hexadecimal representation
// - returns true on success (i.e. Source has the expected size and characters)
// - just a wrapper around SynCommons.HexToBin()
function MD5StringToDigest(const Source: RawUTF8; out Dest: TMD5Digest): boolean;
/// apply the XOR operation to the supplied binary buffers of 16 bytes
procedure XorBlock16(A,B: {$ifdef CPU64}PInt64Array{$else}PCardinalArray{$endif});
{$ifdef HASINLINE}inline;{$endif} overload;
/// apply the XOR operation to the supplied binary buffers of 16 bytes
procedure XorBlock16(A,B,C: {$ifdef CPU64}PInt64Array{$else}PCardinalArray{$endif});
{$ifdef HASINLINE}inline;{$endif} overload;
/// compute the HTDigest for a user and a realm, according to a supplied password
// - apache-compatible: 'agent007:download area:8364d0044ef57b3defcfa141e8f77b65'
function htdigest(const user, realm, pass: RawByteString): RawUTF8;
/// self test of Adler32 routines
function Adler32SelfTest: boolean;
/// self test of MD5 routines
function MD5SelfTest: boolean;
/// self test of SHA-1 routines
function SHA1SelfTest: boolean;
/// self test of SHA-256 routines
function SHA256SelfTest: boolean;
/// self test of AES routines
function AESSelfTest(onlytables: Boolean): boolean;
/// self test of RC4 routines
function RC4SelfTest: boolean;
/// entry point of the raw MD5 transform function - may be used for low-level use
procedure RawMd5Compress(var Hash; Data: pointer);
/// entry point of the raw SHA-1 transform function - may be used for low-level use
procedure RawSha1Compress(var Hash; Data: pointer);
/// entry point of the raw SHA-256 transform function - may be used for low-level use
procedure RawSha256Compress(var Hash; Data: pointer);
/// entry point of the raw SHA-512 transform function - may be used for low-level use
procedure RawSha512Compress(var Hash; Data: pointer);
// little endian fast conversion
// - 160 bits = 5 integers
// - use fast bswap asm in x86/x64 mode
procedure bswap160(s,d: PIntegerArray);
// little endian fast conversion
// - 256 bits = 8 integers
// - use fast bswap asm in x86/x64 mode
procedure bswap256(s,d: PIntegerArray);
/// simple Adler32 implementation
// - a bit slower than Adler32Asm() version below, but shorter code size
function Adler32Pas(Adler: cardinal; p: pointer; Count: Integer): cardinal;
/// fast Adler32 implementation
// - 16-bytes-chunck unrolled asm version
function Adler32Asm(Adler: cardinal; p: pointer; Count: Integer): cardinal;
{$ifdef PUREPASCAL}{$ifdef HASINLINE}inline;{$endif}{$endif}
// - very fast XOR according to Cod - not Compression or Stream compatible
// - used in AESFull() for KeySize=32
procedure XorBlock(p: PIntegerArray; Count, Cod: integer);
/// fast and simple XOR Cypher using Index (=Position in Dest Stream)
// - Compression not compatible with this function: should be applied after
// compress (e.g. as outStream for TAESWriteStream)
// - Stream compatible (with updated Index)
// - used in AES() and TAESWriteStream
procedure XorOffset(P: PByteArray; Index,Count: integer);
/// fast XOR Cypher changing by Count value
// - Compression compatible, since the XOR value is always the same, the
// compression rate will not change a lot
procedure XorConst(p: PIntegerArray; Count: integer);
var
/// the encryption key used by CompressShaAes() global function
// - the key is global to the whole process
// - use CompressShaAesSetKey() procedure to set this Key from text
CompressShaAesKey: TSHA256Digest;
/// the AES-256 encoding class used by CompressShaAes() global function
// - use any of the implementation classes, corresponding to the chaining
// mode required - TAESECB, TAESCBC, TAESCFB, TAESOFB and TAESCTR classes to
// handle in ECB, CBC, CFB, OFB and CTR mode (including PKCS7-like padding)
// - set to the secure and efficient CFB mode by default
CompressShaAesClass: TAESAbstractClass = TAESCFB;
/// set an text-based encryption key for CompressShaAes() global function
// - will compute the key via SHA256Weak() and set CompressShaAesKey
// - the key is global to the whole process
procedure CompressShaAesSetKey(const Key: RawByteString; AesClass: TAESAbstractClass=nil);
/// encrypt data content using the AES-256/CFB algorithm, after SynLZ compression
// - as expected by THttpSocket.RegisterCompress()
// - will return 'synshaaes' as ACCEPT-ENCODING: header parameter
// - will use global CompressShaAesKey / CompressShaAesClass variables to be set
// according to the expected algorithm and Key e.g. via a call to CompressShaAesSetKey()
// - if you want to change the chaining mode, you can customize the global
// CompressShaAesClass variable to the expected TAES* class name
// - will store a hash of both cyphered and clear stream: if the
// data is corrupted during transmission, will instantly return ''
function CompressShaAes(var DataRawByteString; Compress: boolean): AnsiString;
type
/// possible return codes by IProtocol classes
TProtocolResult = (sprSuccess,
sprBadRequest, sprUnsupported, sprUnexpectedAlgorithm,
sprInvalidCertificate, sprInvalidSignature,
sprInvalidEphemeralKey, sprInvalidPublicKey, sprInvalidPrivateKey,
sprInvalidMAC);
/// perform safe communication after unilateral or mutual authentication
// - see e.g. TProtocolNone or SynEcc's TECDHEProtocolClient and
// TECDHEProtocolServer implementation classes
IProtocol = interface
['{91E3CA39-3AE2-44F4-9B8C-673AC37C1D1D}']
/// initialize the communication by exchanging some client/server information
// - expects the handshaking messages to be supplied as UTF-8 text, may be as
// base64-encoded binary - see e.g. TWebSocketProtocolBinary.ProcessHandshake
// - should return sprUnsupported if the implemented protocol does not
// expect any handshaking mechanism
// - returns sprSuccess and set something into OutData, depending on the
// current step of the handshake
// - returns an error code otherwise
function ProcessHandshake(const MsgIn: RawUTF8; out MsgOut: RawUTF8): TProtocolResult;
/// encrypt a message on one side, ready to be transmitted to the other side
// - this method should be thread-safe in the implementation class
procedure Encrypt(const aPlain: RawByteString; out aEncrypted: RawByteString);
/// decrypt a message on one side, as transmitted from the other side
// - should return sprSuccess if the
// - should return sprInvalidMAC in case of wrong aEncrypted input (e.g.
// packet corruption, MiM or Replay attacks attempts)
// - this method should be thread-safe in the implementation class
function Decrypt(const aEncrypted: RawByteString; out aPlain: RawByteString): TProtocolResult;
/// will create another instance of this communication protocol
function Clone: IProtocol;
end;
/// stores a list of IProtocol instances
IProtocolDynArray = array of IProtocol;
/// implements a fake no-encryption protocol
// - may be used for debugging purposes, or when encryption is not needed
TProtocolNone = class(TInterfacedObject, IProtocol)
public
/// initialize the communication by exchanging some client/server information
// - this method will return sprUnsupported
function ProcessHandshake(const MsgIn: RawUTF8; out MsgOut: RawUTF8): TProtocolResult;
/// encrypt a message on one side, ready to be transmitted to the other side
// - this method will return the plain text with no actual encryption
procedure Encrypt(const aPlain: RawByteString; out aEncrypted: RawByteString);
/// decrypt a message on one side, as transmitted from the other side
// - this method will return the encrypted text with no actual decryption
function Decrypt(const aEncrypted: RawByteString; out aPlain: RawByteString): TProtocolResult;
/// will create another instance of this communication protocol
function Clone: IProtocol;
end;
/// implements a secure protocol using AES encryption
// - as used e.g. by 'synopsebinary' WebSockets protocol
// - this class will maintain two TAESAbstract instances, one for encryption
// and another one for decryption, with PKCS7 padding and no MAC validation
TProtocolAES = class(TInterfacedObjectLocked, IProtocol)
protected
fAES: array[boolean] of TAESAbstract; // [false]=decrypt [true]=encrypt
public
/// initialize this encryption protocol with the given AES settings
constructor Create(aClass: TAESAbstractClass; const aKey; aKeySize: cardinal;
aIVReplayAttackCheck: TAESIVReplayAttackCheck=repCheckedIfAvailable); reintroduce; virtual;
/// will create another instance of this communication protocol
constructor CreateFrom(aAnother: TProtocolAES); reintroduce; virtual;
/// finalize the encryption
destructor Destroy; override;
/// initialize the communication by exchanging some client/server information
// - this method will return sprUnsupported, since no key negociation is involved
function ProcessHandshake(const MsgIn: RawUTF8; out MsgOut: RawUTF8): TProtocolResult;
/// encrypt a message on one side, ready to be transmitted to the other side
// - this method uses AES encryption and PKCS7 padding
procedure Encrypt(const aPlain: RawByteString; out aEncrypted: RawByteString);
/// decrypt a message on one side, as transmitted from the other side
// - this method uses AES decryption and PKCS7 padding
function Decrypt(const aEncrypted: RawByteString; out aPlain: RawByteString): TProtocolResult;
/// will create another instance of this communication protocol
function Clone: IProtocol;
end;
/// class-reference type (metaclass) of an AES secure protocol
TProtocolAESClass = class of TProtocolAES;
{$ifndef NOVARIANTS}
type
/// JWT Registered Claims, as defined in RFC 7519
// - known registered claims have a specific name and behavior, and will be
// handled automatically by TJWTAbstract
// - corresponding field names are iss,sub,aud,exp,nbf,iat,jti - as defined
// in JWT_CLAIMS_TEXT constant
// - jrcIssuer identifies the server which originated the token, e.g.
// "iss":"https://example.auth0.com/" when the token comes from Auth0 servers
// - jrcSubject is the application-specific extent which is protected by this
// JWT, e.g. an User or Resource ID, e.g. "sub":"auth0|57fe9f1bad961aa242870e"
// - jrcAudience claims that the token is valid only for one or several
// resource servers (may be a JSON string or a JSON array of strings), e.g.
// "aud":["https://myshineyfileserver.sometld"] - TJWTAbstract will check
// that the supplied "aud" field does match an expected list of identifiers
// - jrcExpirationTime contains the Unix timestamp in seconds after which
// the token must not be granted access, e.g. "exp":1477474667
// - jrcNotBefore contains the Unix timestamp in seconds before which the
// token must not be granted access, e.g. "nbf":147745438
// - jrcIssuedAt contains the Unix timestamp in seconds when the token was
// generated, e.g. "iat":1477438667
// - jrcJwtID provides a unique identifier for the JWT, to prevent any replay;
// TJWTAbstract.Compute will set an obfuscated TSynUniqueIdentifierGenerator
// hexadecimal value
TJWTClaim = (
jrcIssuer, jrcSubject, jrcAudience, jrcExpirationTime, jrcNotBefore,
jrcIssuedAt, jrcJwtID);
/// set of JWT Registered Claims, as in TJWTAbstract.Claims
TJWTClaims = set of TJWTClaim;
/// Exception raised when running JSON Web Tokens
EJWTException = class(ESynException);
/// TJWTContent.result codes after TJWTAbstract.Verify method call
TJWTResult = (jwtValid,
jwtNoToken, jwtWrongFormat, jwtInvalidAlgorithm, jwtInvalidPayload,
jwtUnexpectedClaim, jwtMissingClaim, jwtUnknownAudience,
jwtExpired, jwtNotBeforeFailed, jwtInvalidIssuedAt, jwtInvalidID,
jwtInvalidSignature);
//// set of TJWTContent.result codes
TJWTResults = set of TJWTResult;
/// JWT decoded content, as processed by TJWTAbstract
// - optionally cached in memory
TJWTContent = record
/// store latest Verify() result
result: TJWTResult;
/// set of known/registered claims, as stored in the JWT payload
claims: TJWTClaims;
/// match TJWTAbstract.Audience[] indexes for reg[jrcAudience]
audience: set of 0..15;
/// known/registered claims UTF-8 values, as stored in the JWT payload
// - e.g. reg[jrcSubject]='1234567890' and reg[jrcIssuer]='' for
// $ {"sub": "1234567890","name": "John Doe","admin": true}
reg: array[TJWTClaim] of RawUTF8;
/// custom/unregistered claim values, as stored in the JWT payload
// - registered claims will be available from reg[], not in this field
// - e.g. data.U['name']='John Doe' and data.B['admin']=true for
// $ {"sub": "1234567890","name": "John Doe","admin": true}
// but data.U['sub'] if not defined, and reg[jrcSubject]='1234567890'
data: TDocVariantData;
end;
/// pointer to a JWT decoded content, as processed by TJWTAbstract
PJWTContent = ^TJWTContent;
/// used to store a list of JWT decoded content
// - as used e.g. by TJWTAbstract cache
TJWTContentDynArray = array of TJWTContent;
/// available options for TJWTAbstract process
TJWTOption = (joHeaderParse, joAllowUnexpectedClaims, joAllowUnexpectedAudience,
joNoJwtIDGenerate, joNoJwtIDCheck, joDoubleInData);
/// store options for TJWTAbstract process
TJWTOptions = set of TJWTOption;
/// abstract parent class for implementing JSON Web Tokens
// - to represent claims securely between two parties, as defined in industry
// standard @http://tools.ietf.org/html/rfc7519
// - you should never use this abstract class directly, but e.g. TJWTHS256,
// TJWTHS384, TJWTHS512 or TJWTES256 (as defined in SynEcc.pas) inherited classes
// - for security reasons, one inherited class is implementing a single
// algorithm, as is very likely to be the case on production: you pickup one
// "alg", then you stick to it; if your server needs more than one algorithm
// for compatibility reasons, use a separate key and URI - this design will
// reduce attack surface, and fully avoid weaknesses as described in
// @https://auth0.com/blog/critical-vulnerabilities-in-json-web-token-libraries
// and @http://tools.ietf.org/html/rfc7518#section-8.5
TJWTAbstract = class(TSynPersistent)
protected
fAlgorithm: RawUTF8;
fHeader: RawUTF8;
fHeaderB64: RawUTF8;
fClaims: TJWTClaims;
fOptions: TJWTOptions;
fAudience: TRawUTF8DynArray;
fExpirationSeconds: integer;
fIDGen: TSynUniqueIdentifierGenerator;
fCacheTimeoutSeconds: integer;
fCacheResults: TJWTResults;
fCache: TSynDictionary;
procedure SetCacheTimeoutSeconds(value: integer); virtual;
function PayloadToJSON(const DataNameValue: array of const;
const Issuer, Subject, Audience: RawUTF8; NotBefore: TDateTime;
ExpirationMinutes: cardinal): RawUTF8; virtual;
procedure Parse(const Token: RawUTF8; var JWT: TJWTContent;
out headpayload: RawUTF8; out signature: RawByteString; excluded: TJWTClaims); virtual;
function CheckAgainstActualTimestamp(var JWT: TJWTContent): boolean;
// abstract methods which should be overriden by inherited classes
function ComputeSignature(const headpayload: RawUTF8): RawUTF8; virtual; abstract;
procedure CheckSignature(const headpayload: RawUTF8; const signature: RawByteString;
var JWT: TJWTContent); virtual; abstract;
public
/// initialize the JWT processing instance
// - the supplied set of claims are expected to be defined in the JWT payload
// - aAudience are the allowed values for the jrcAudience claim
// - aExpirationMinutes is the deprecation time for the jrcExpirationTime claim
// - aIDIdentifier and aIDObfuscationKey are passed to a
// TSynUniqueIdentifierGenerator instance used for jrcJwtID claim
constructor Create(const aAlgorithm: RawUTF8; aClaims: TJWTClaims;
const aAudience: array of RawUTF8; aExpirationMinutes: integer;
aIDIdentifier: TSynUniqueIdentifierProcess; aIDObfuscationKey: RawUTF8); reintroduce;
/// finalize the instance
destructor Destroy; override;
/// compute a new JWT for a given payload
// - here the data payload is supplied as Name,Value pairs - by convention,
// some registered Names (see TJWTClaim) should not be used here, and private
// claims names are expected to be short (typically 3 chars), or an URI
// - depending on the instance Claims, you should also specify associated
// Issuer, Subject, Audience and NotBefore values; expected 'exp', 'nbf',
// 'iat', 'jti' claims will also be generated and included, if needed
// - you can override the aExpirationMinutes value as defined in Create()
// - Audience is usually a single text, serialized as a JSON string, but
// if the value supplied starts with '[', it is expected to be an array
// of text values, already serialized as a JSON array of strings
// - this method is thread-safe
function Compute(const DataNameValue: array of const; const Issuer: RawUTF8='';
const Subject: RawUTF8=''; const Audience: RawUTF8=''; NotBefore: TDateTime=0;
ExpirationMinutes: integer=0; Signature: PRawUTF8=nil): RawUTF8;
/// compute a HTTP Authorization header containing a JWT for a given payload
// - just a wrapper around Compute(), returned the HTTP header value:
// $ Authorization: <HttpAuthorizationHeader>
// following the expected pattern:
// $ Authorization: Bearer <Token>
// - this method is thread-safe
function ComputeAuthorizationHeader(const DataNameValue: array of const;
const Issuer: RawUTF8=''; const Subject: RawUTF8=''; const Audience: RawUTF8='';
NotBefore: TDateTime=0; ExpirationMinutes: integer=0): RawUTF8;
/// check a JWT value, and its signature
// - will validate all expected Claims (minus ExcludedClaims optional
// parameter), and the associated signature
// - verification state is returned in JWT.result (jwtValid for a valid JWT),
// together with all parsed payload information
// - supplied JWT is transmitted e.g. in HTTP header:
// $ Authorization: Bearer <Token>
// - this method is thread-safe
procedure Verify(const Token: RawUTF8; out JWT: TJWTContent;
ExcludedClaims: TJWTClaims=[]); overload;
/// check a JWT value, and its signature
// - will validate all expected Claims, and the associated signature
// - verification state is returned as function result
// - supplied JWT is transmitted e.g. in HTTP header:
// $ Authorization: Bearer <Token>
// - this method is thread-safe
function Verify(const Token: RawUTF8): TJWTResult; overload;
/// check a HTTP Authorization header value as JWT, and its signature
// - will validate all expected Claims, and the associated signature
// - verification state is returned in JWT.result (jwtValid for a valid JWT),
// together with all parsed payload information
// - expect supplied HttpAuthorizationHeader as transmitted in HTTP header:
// $ Authorization: <HttpAuthorizationHeader>
// - this method is thread-safe
function VerifyAuthorizationHeader(const HttpAuthorizationHeader: RawUTF8;
out JWT: TJWTContent): boolean; overload;
/// in-place decoding and quick check of the JWT paylod
// - it won't check the signature, but the header's algorithm against the
// class name (use TJWTAbstract class to allow any algorithm)
// - it will decode the JWT payload and check for its expiration, and some
// mandatory fied values - you can optionally retrieve the Expiration time,
// the ending Signature, and/or the Payload decoded as TDocVariant
// - NotBeforeDelta allows to define some time frame for the "nbf" field
// - may be used on client side to quickly validate a JWT received from
// server, without knowing the exact algorithm or secret keys
class function VerifyPayload(const Token, ExpectedSubject, ExpectedIssuer,
ExpectedAudience: RawUTF8; Expiration: PUnixTime=nil; Signature: PRawUTF8=nil;
Payload: PVariant=nil; IgnoreTime: boolean=false; NotBeforeDelta: TUnixTime=15): TJWTResult;
published
/// the name of the algorithm used by this instance (e.g. 'HS256')
property Algorithm: RawUTF8 read fAlgorithm;
/// allow to tune the Verify and Compute method process
property Options: TJWTOptions read fOptions write fOptions;
/// the JWT Registered Claims, as implemented by this instance
// - Verify() method will ensure all claims are defined in the payload,
// then fill TJWTContent.reg[] with all corresponding values
property Claims: TJWTClaims read fClaims;
/// the period, in seconds, for the "exp" claim
property ExpirationSeconds: integer read fExpirationSeconds;
/// the audience string values associated with this instance
// - will be checked by Verify() method, and set in TJWTContent.audience
property Audience: TRawUTF8DynArray read fAudience;
/// delay of optional in-memory cache of Verify() TJWTContent
// - equals 0 by default, i.e. cache is disabled
// - may be useful if the signature process is very resource consumming
// (e.g. for TJWTES256 or even HMAC-SHA-256) - see also CacheResults
// - each time this property is assigned, internal cache content is flushed
property CacheTimeoutSeconds: integer read fCacheTimeoutSeconds
write SetCacheTimeoutSeconds;
/// which TJWTContent.result should be stored in in-memory cache
// - default is [jwtValid] but you may also include jwtInvalidSignature
// if signature checking uses a lot of resources
// - only used if CacheTimeoutSeconds>0
property CacheResults: TJWTResults read fCacheResults write fCacheResults;
end;
/// class-reference type (metaclass) of a JWT algorithm process
TJWTAbstractClass = class of TJWTAbstract;
/// implements JSON Web Tokens using 'none' algorithm
// - as defined in @http://tools.ietf.org/html/rfc7518 paragraph 3.6
// - you should never use this weak algorithm in production, unless your
// communication is already secured by other means, and use JWT as cookies
TJWTNone = class(TJWTAbstract)
protected
function ComputeSignature(const headpayload: RawUTF8): RawUTF8; override;
procedure CheckSignature(const headpayload: RawUTF8; const signature: RawByteString;
var JWT: TJWTContent); override;
public
/// initialize the JWT processing using the 'none' algorithm
// - the supplied set of claims are expected to be defined in the JWT payload
// - aAudience are the allowed values for the jrcAudience claim
// - aExpirationMinutes is the deprecation time for the jrcExpirationTime claim
// - aIDIdentifier and aIDObfuscationKey are passed to a
// TSynUniqueIdentifierGenerator instance used for jrcJwtID claim
constructor Create(aClaims: TJWTClaims; const aAudience: array of RawUTF8;
aExpirationMinutes: integer=0; aIDIdentifier: TSynUniqueIdentifierProcess=0;
aIDObfuscationKey: RawUTF8=''); reintroduce;
end;
/// abstract parent of JSON Web Tokens using HMAC-SHA2 or SHA-3 algorithms
// - SHA-3 is not yet officially defined in @http://tools.ietf.org/html/rfc7518
// but could be used as a safer (and sometimes faster) alternative to HMAC-SHA2
// - digital signature will be processed by an internal TSynSigner instance
// - never use this abstract class, but any inherited class, or
// JWT_CLASS[].Create to instantiate a JWT process from a given algorithm
TJWTSynSignerAbstract = class(TJWTAbstract)
protected
fSignPrepared: TSynSigner;
function GetAlgo: TSignAlgo; virtual; abstract;
function ComputeSignature(const headpayload: RawUTF8): RawUTF8; override;
procedure CheckSignature(const headpayload: RawUTF8; const signature: RawByteString;
var JWT: TJWTContent); override;
public
/// initialize the JWT processing using SHA3 algorithm
// - the supplied set of claims are expected to be defined in the JWT payload
// - the supplied secret text will be used to compute the digital signature,
// directly if aSecretPBKDF2Rounds=0, or via PBKDF2 iterative key derivation
// if some number of rounds were specified
// - aAudience are the allowed values for the jrcAudience claim
// - aExpirationMinutes is the deprecation time for the jrcExpirationTime claim
// - aIDIdentifier and aIDObfuscationKey are passed to a
// TSynUniqueIdentifierGenerator instance used for jrcJwtID claim
// - optionally return the PBKDF2 derivated key for aSecretPBKDF2Rounds>0
constructor Create(const aSecret: RawUTF8; aSecretPBKDF2Rounds: integer;
aClaims: TJWTClaims; const aAudience: array of RawUTF8; aExpirationMinutes: integer=0;
aIDIdentifier: TSynUniqueIdentifierProcess=0; aIDObfuscationKey: RawUTF8='';
aPBKDF2Secret: PHash512Rec=nil); reintroduce;
/// finalize the instance
destructor Destroy; override;
/// the digital signature size, in byte
property SignatureSize: integer read fSignPrepared.fSignatureSize;
/// the TSynSigner raw algorithm used for digital signature
property SignatureAlgo: TSignAlgo read fSignPrepared.fAlgo;
/// low-level read access to the internal signature structure
property SignPrepared: TSynSigner read fSignPrepared;
end;
/// meta-class for TJWTSynSignerAbstract creations
TJWTSynSignerAbstractClass = class of TJWTSynSignerAbstract;
/// implements JSON Web Tokens using 'HS256' (HMAC SHA-256) algorithm
// - as defined in @http://tools.ietf.org/html/rfc7518 paragraph 3.2
// - our HMAC SHA-256 implementation used is thread safe, and very fast
// (x86: 3us, x64: 2.5us) so cache is not needed
// - resulting signature size will be of 256 bits
TJWTHS256 = class(TJWTSynSignerAbstract)
protected
function GetAlgo: TSignAlgo; override;
end;
/// implements JSON Web Tokens using 'HS384' (HMAC SHA-384) algorithm
// - as defined in @http://tools.ietf.org/html/rfc7518 paragraph 3.2
// - our HMAC SHA-384 implementation used is thread safe, and very fast
// even on x86 (if the CPU supports SSE3 opcodes)
// - resulting signature size will be of 384 bits
TJWTHS384 = class(TJWTSynSignerAbstract)
protected
function GetAlgo: TSignAlgo; override;
end;
/// implements JSON Web Tokens using 'HS512' (HMAC SHA-512) algorithm
// - as defined in @http://tools.ietf.org/html/rfc7518 paragraph 3.2
// - our HMAC SHA-512 implementation used is thread safe, and very fast
// even on x86 (if the CPU supports SSE3 opcodes)
// - resulting signature size will be of 512 bits
TJWTHS512 = class(TJWTSynSignerAbstract)
protected
function GetAlgo: TSignAlgo; override;
end;
/// experimental JSON Web Tokens using SHA3-224 algorithm
// - SHA-3 is not yet officially defined in @http://tools.ietf.org/html/rfc7518
// but could be used as a safer (and sometimes faster) alternative to HMAC-SHA2
// - resulting signature size will be of 224 bits
TJWTS3224 = class(TJWTSynSignerAbstract)
protected
function GetAlgo: TSignAlgo; override;
end;
/// experimental JSON Web Tokens using SHA3-256 algorithm
// - SHA-3 is not yet officially defined in @http://tools.ietf.org/html/rfc7518
// but could be used as a safer (and sometimes faster) alternative to HMAC-SHA2
// - resulting signature size will be of 256 bits
TJWTS3256 = class(TJWTSynSignerAbstract)
protected
function GetAlgo: TSignAlgo; override;
end;
/// experimental JSON Web Tokens using SHA3-384 algorithm
// - SHA-3 is not yet officially defined in @http://tools.ietf.org/html/rfc7518
// but could be used as a safer (and sometimes faster) alternative to HMAC-SHA2
// - resulting signature size will be of 384 bits
TJWTS3384 = class(TJWTSynSignerAbstract)
protected
function GetAlgo: TSignAlgo; override;
end;
/// experimental JSON Web Tokens using SHA3-512 algorithm
// - SHA-3 is not yet officially defined in @http://tools.ietf.org/html/rfc7518
// but could be used as a safer (and sometimes faster) alternative to HMAC-SHA2
// - resulting signature size will be of 512 bits
TJWTS3512 = class(TJWTSynSignerAbstract)
protected
function GetAlgo: TSignAlgo; override;
end;
/// experimental JSON Web Tokens using SHA3-SHAKE128 algorithm
// - SHA-3 is not yet officially defined in @http://tools.ietf.org/html/rfc7518
// but could be used as a safer (and sometimes faster) alternative to HMAC-SHA2
// - resulting signature size will be of 256 bits
TJWTS3S128 = class(TJWTSynSignerAbstract)
protected
function GetAlgo: TSignAlgo; override;
end;
/// experimental JSON Web Tokens using SHA3-SHAKE256 algorithm
// - SHA-3 is not yet officially defined in @http://tools.ietf.org/html/rfc7518
// but could be used as a safer (and sometimes faster) alternative to HMAC-SHA2
// - resulting signature size will be of 512 bits
TJWTS3S256 = class(TJWTSynSignerAbstract)
protected
function GetAlgo: TSignAlgo; override;
end;
const
/// the text field names of the registerd claims, as defined by RFC 7519
// - see TJWTClaim enumeration and TJWTClaims set
// - RFC standard expects those to be case-sensitive
JWT_CLAIMS_TEXT: array[TJWTClaim] of RawUTF8 = (
'iss','sub','aud','exp','nbf','iat','jti');
/// how TJWTSynSignerAbstract algorithms are identified in the JWT
// - SHA-1 will fallback to HS256 (since there will never be SHA-1 support)
// - SHA-3 is not yet officially defined in @http://tools.ietf.org/html/rfc7518
JWT_TEXT: array[TSignAlgo] of RawUTF8 = (
'HS256','HS256','HS384','HS512','S3224','S3256','S3384','S3512','S3S128','S3S256');
/// able to instantiate any of the TJWTSynSignerAbstract instance expected
// - SHA-1 will fallback to TJWTHS256 (since SHA-1 will never be supported)
// - SHA-3 is not yet officially defined in @http://tools.ietf.org/html/rfc7518
// - typical use is the following:
// ! result := JWT_CLASS[algo].Create(master, round, claims, [], expirationMinutes);
JWT_CLASS: array[TSignAlgo] of TJWTSynSignerAbstractClass = (
TJWTHS256, TJWTHS256, TJWTHS384, TJWTHS512,
TJWTS3224, TJWTS3256, TJWTS3384, TJWTS3512, TJWTS3S128, TJWTS3S256);
function ToText(res: TJWTResult): PShortString; overload;
function ToCaption(res: TJWTResult): string; overload;
function ToText(claim: TJWTClaim): PShortString; overload;
function ToText(claims: TJWTClaims): ShortString; overload;
{$endif NOVARIANTS}
function ToText(chk: TAESIVReplayAttackCheck): PShortString; overload;
function ToText(res: TProtocolResult): PShortString; overload;
function ToText(algo: TSignAlgo): PShortString; overload;
function ToText(algo: THashAlgo): PShortString; overload;
function ToText(algo: TSHA3Algo): PShortString; overload;
implementation
{$ifndef NOVARIANTS}
uses
Variants;
{$endif}
function ToText(res: TProtocolResult): PShortString;
begin
result := GetEnumName(TypeInfo(TProtocolResult),ord(res));
end;
function ToText(chk: TAESIVReplayAttackCheck): PShortString;
begin
result := GetEnumName(TypeInfo(TAESIVReplayAttackCheck),ord(chk));
end;
function ToText(algo: TSignAlgo): PShortString;
begin
result := GetEnumName(TypeInfo(TSignAlgo),ord(algo));
end;
function ToText(algo: THashAlgo): PShortString;
begin
result := GetEnumName(TypeInfo(THashAlgo),ord(algo));
end;
function ToText(algo: TSHA3Algo): PShortString;
begin
result := GetEnumName(TypeInfo(TSHA3Algo),ord(algo));
end;
{$ifdef CPU64}
procedure XorBlock16(A,B: PInt64Array);
begin
A[0] := A[0] xor B[0];
A[1] := A[1] xor B[1];
end;
procedure XorBlock16(A,B,C: PInt64Array);
begin
B[0] := A[0] xor C[0];
B[1] := A[1] xor C[1];
end;
{$else}
procedure XorBlock16(A,B: PCardinalArray);
begin
A[0] := A[0] xor B[0];
A[1] := A[1] xor B[1];
A[2] := A[2] xor B[2];
A[3] := A[3] xor B[3];
end;
procedure XorBlock16(A,B,C: PCardinalArray);
begin
B[0] := A[0] xor C[0];
B[1] := A[1] xor C[1];
B[2] := A[2] xor C[2];
B[3] := A[3] xor C[3];
end;
{$endif}
procedure AESBlockToShortString(const block: TAESBlock; out result: short32);
begin
result[0] := #32;
SynCommons.BinToHex(@block,@result[1],16);
end;
function AESBlockToShortString(const block: TAESBlock): short32;
begin
AESBlockToShortString(block,result);
end;
function AESBlockToString(const block: TAESBlock): RawUTF8;
begin
FastSetString(result,nil,32);
SynCommons.BinToHex(@block,pointer(result),16);
end;
function MD5DigestToString(const D: TMD5Digest): RawUTF8;
begin
BinToHexLower(@D,sizeof(D),result);
end;
function MD5StringToDigest(const Source: RawUTF8; out Dest: TMD5Digest): boolean;
begin
result := SynCommons.HexToBin(pointer(Source), @Dest, sizeof(Dest));
end;
function SHA1DigestToString(const D: TSHA1Digest): RawUTF8;
begin
BinToHexLower(@D,sizeof(D),result);
end;
function SHA1StringToDigest(const Source: RawUTF8; out Dest: TSHA1Digest): boolean;
begin
result := SynCommons.HexToBin(pointer(Source), @Dest, sizeof(Dest));
end;
function SHA256DigestToString(const D: TSHA256Digest): RawUTF8;
begin
BinToHexLower(@D,sizeof(D),result);
end;
function SHA256StringToDigest(const Source: RawUTF8; out Dest: TSHA256Digest): boolean;
begin
result := SynCommons.HexToBin(pointer(Source), @Dest, sizeof(Dest));
end;
function SHA512DigestToString(const D: TSHA512Digest): RawUTF8;
begin
BinToHexLower(@D, sizeof(D), result);
end;
function SHA384DigestToString(const D: TSHA384Digest): RawUTF8;
begin
BinToHexLower(@D, sizeof(D), result);
end;
{$ifdef USEPADLOCK}
const
AES_SUCCEEDED = 0;
KEY_128BITS = 0;
KEY_192BITS = 1;
KEY_256BITS = 2;
ACE_AES_ECB = 0;
ACE_AES_CBC = 1;
{$ifdef USEPADLOCKDLL}
type
tpadlock_phe_available = function: boolean; cdecl;
tpadlock_phe_sha = function(
buffer: pointer; nbytes: integer; var Digest): integer; cdecl;
tpadlock_ace_available = function: boolean; cdecl;
tpadlock_aes_begin = function: pointer; cdecl;
tpadlock_aes_setkey = function(
ctx: pointer; const key; key_len: integer): integer; cdecl;
tpadlock_aes_setmodeiv = function(
ctx: pointer; mode: integer; var iv): integer; cdecl;
tpadlock_aes_encrypt = function(
ctx, bIn, bOut: pointer; nbytes: integer): integer; cdecl;
tpadlock_aes_decrypt = function(
ctx, bIn, bOut: pointer; nbytes: integer): integer; cdecl;
tpadlock_aes_close = function(
ctx: pointer): integer; cdecl;
var
padlock_phe_available: tpadlock_phe_available = nil;
padlock_phe_sha1: tpadlock_phe_sha = nil;
padlock_phe_sha256: tpadlock_phe_sha = nil;
padlock_ace_available: tpadlock_ace_available = nil;
padlock_aes_begin: tpadlock_aes_begin = nil;
padlock_aes_setkey: tpadlock_aes_setkey = nil;
padlock_aes_setmodeiv: tpadlock_aes_setmodeiv = nil;
padlock_aes_encrypt: tpadlock_aes_encrypt = nil;
padlock_aes_decrypt: tpadlock_aes_decrypt = nil;
padlock_aes_close: tpadlock_aes_close = nil;
{$ifdef MSWINDOWS}
PadLockLibHandle: THandle = 0;
{$else} // Linux:
PadLockLibHandle: HMODULE = 0;
{$endif}
procedure PadlockInit;
begin
{$ifdef MSWINDOWS}
PadLockLibHandle := LoadLibrary('LibPadlock');
{$else} // Linux:
PadLockLibHandle := LoadLibrary('libvia_padlock.so');
if PadLockLibHandle=0 then
PadLockLibHandle := LoadLibrary('libvia_padlock.so.1.0.0');
{$endif}
if PadLockLibHandle=0 then
exit;
padlock_phe_available := GetProcAddress(PadLockLibHandle,'padlock_phe_available');
padlock_phe_sha1 := GetProcAddress(PadLockLibHandle,'padlock_phe_sha1');
padlock_phe_sha256 := GetProcAddress(PadLockLibHandle,'padlock_phe_sha256');
padlock_ace_available := GetProcAddress(PadLockLibHandle,'padlock_ace_available');
padlock_aes_begin := GetProcAddress(PadLockLibHandle,'padlock_aes_begin');
padlock_aes_setkey := GetProcAddress(PadLockLibHandle,'padlock_aes_setkey');
padlock_aes_setmodeiv := GetProcAddress(PadLockLibHandle,'padlock_aes_setmodeiv');
padlock_aes_encrypt := GetProcAddress(PadLockLibHandle,'padlock_aes_encrypt');
padlock_aes_decrypt := GetProcAddress(PadLockLibHandle,'padlock_aes_decrypt');
padlock_aes_close := GetProcAddress(PadLockLibHandle,'padlock_aes_close');
if @padlock_phe_available=nil then exit;
if @padlock_phe_sha1=nil then exit;
if @padlock_phe_sha256=nil then exit;
if @padlock_ace_available=nil then exit;
if @padlock_aes_begin=nil then exit;
if @padlock_aes_setkey=nil then exit;
if @padlock_aes_setmodeiv=nil then exit;
if @padlock_aes_encrypt=nil then exit;
if @padlock_aes_decrypt=nil then exit;
if @padlock_aes_close=nil then exit;
if padlock_phe_available and padlock_ace_available then
padlock_available := true;
end;
{$else} // not USEPADLOCKDLL:
{$ifdef MSWINDOWS}
{$L padlock.obj}
{$L padlock_sha.obj}
{$L padlock_aes.obj}
{$else}
{$L padlock.o}
{$L padlock_sha.o}
{$L padlock_aes.o}
{$endif}
function memcpy(dest, src: Pointer; count: integer): Pointer; cdecl;
begin
MoveFast(src^, dest^, count);
Result := dest;
end;
function memset(dest: Pointer; val: Integer; count: integer): Pointer; cdecl;
begin
FillcharFast(dest^, count, val);
Result := dest;
end;
function malloc(size: integer): Pointer; cdecl;
begin
GetMem(Result, size);
end;
procedure free(pBlock: Pointer); cdecl;
begin
FreeMem(pBlock);
end;
function printf(format:PAnsiChar; args:array of const): PAnsiChar; cdecl;
begin
result := format;
// called on error -> do nothing
end;
{ this .o files have been generated from the sdk sources with
gcc-2.95 -c -O2 padlock*.c -I../include
}
function padlock_phe_available: boolean; cdecl; external;
function padlock_phe_sha1(buf: pointer; nbytes: integer; var Digest): integer; cdecl; external;
function padlock_phe_sha256(buf: pointer; nbytes: integer; var Digest): integer; cdecl; external;
function padlock_ace_available: boolean; cdecl; external;
function padlock_aes_begin: pointer; cdecl; external;
function padlock_aes_setkey(ctx: pointer; const key; key_len: integer): integer; cdecl; external;
function padlock_aes_setmodeiv(ctx: pointer; mode: integer; var iv): integer; cdecl; external;
function padlock_aes_encrypt(ctx, bIn, bOut: pointer; nbytes: integer): integer; cdecl; external;
function padlock_aes_decrypt(ctx, bIn, bOut: pointer; nbytes: integer): integer; cdecl; external;
function padlock_aes_close(ctx: pointer): integer; cdecl; external;
procedure PadlockInit;
begin
if padlock_phe_available and padlock_ace_available then
padlock_available := true;
{$ifdef PADLOCKDEBUG}if padlock_available then writeln('PADLOCK available'); {$endif}
end;
{$endif USEPADLOCKDLL}
{$endif USEPADLOCK}
procedure XorMemoryPtrInt(dest, source: PPtrIntArray; count: integer);
{$ifdef HASINLINE}inline;{$endif}
{$ifdef FPC}
begin
while count>0 do begin
dec(count);
PPtrInt(dest)^ := PPtrInt(dest)^ xor PPtrInt(source)^;
inc(PPtrInt(dest));
inc(PPtrInt(source));
end;
end;
{$else}
var i: integer;
begin
for i := 0 to count-1 do
dest^[i] := dest^[i] xor source^[i];
end;
{$endif}
const
AESMaxRounds = 14;
type
TKeyArray = packed array[0..AESMaxRounds] of TAESBlock;
/// low-level content of TAES.Context (AESContextSize bytes)
// - is defined privately in the implementation section
// - don't change the structure below: it is fixed in the asm code
// -> use PUREPASCAL if you really have to change it
TAESContext = packed record
RK: TKeyArray; // Key (encr. or decr.)
IV: TAESBlock; // IV or CTR
buf: TAESBlock; // Work buffer
{$ifdef USEPADLOCK}
ViaCtx: pointer; // padlock_*() context
{$endif}
DoBlock: procedure(const ctxt, source, dest); // main AES function
{$ifdef USEAESNI32}AesNi32: pointer;{$endif}
Initialized: boolean;
Rounds: byte; // Number of rounds
KeyBits: word; // Number of bits in key (128/192/256)
end;
// helper types for better code generation
type
TWA4 = TBlock128; // AES block as array of cardinal
TAWk = packed array[0..4*(AESMaxRounds+1)-1] of cardinal; // Key as array of cardinal
PWA4 = ^TWA4;
PAWk = ^TAWk;
const
RCon: array[0..9] of cardinal = ($01,$02,$04,$08,$10,$20,$40,$80,$1b,$36);
// AES computed tables - don't change the order below!
var
Td0, Td1, Td2, Td3, Te0, Te1, Te2, Te3: array[byte] of cardinal;
SBox, InvSBox: array[byte] of byte;
Xor32Byte: TByteArray absolute Td0; // 2^13=$2000=8192 bytes of XOR tables ;)
procedure ComputeAesStaticTables;
var i, x,y: byte;
pow,log: array[byte] of byte;
c: cardinal;
begin // 835 bytes of code to compute 4.5 KB of tables
x := 1;
for i := 0 to 255 do begin
pow[i] := x;
log[x] := i;
if x and $80<>0 then
x := x xor (x shl 1) xor $1B else
x := x xor (x shl 1);
end;
SBox[0] := $63;
InvSBox[$63] := 0;
for i := 1 to 255 do begin
x := pow[255-log[i]]; y := (x shl 1)+(x shr 7);
x := x xor y; y := (y shl 1)+(y shr 7);
x := x xor y; y := (y shl 1)+(y shr 7);
x := x xor y; y := (y shl 1)+(y shr 7);
x := x xor y xor $63;
SBox[i] := x;
InvSBox[x] := i;
end;
for i := 0 to 255 do begin
x := SBox[i];
y := x shl 1;
if x and $80<>0 then
y := y xor $1B;
Te0[i] := y+x shl 8+x shl 16+(y xor x)shl 24;
Te1[i] := Te0[i] shl 8+Te0[i] shr 24;
Te2[i] := Te1[i] shl 8+Te1[i] shr 24;
Te3[i] := Te2[i] shl 8+Te2[i] shr 24;
x := InvSBox[i];
if x=0 then
continue;
c := log[x]; // Td0[c] = Si[c].[0e,09,0d,0b] -> e.g. log[$0e]=223 below
Td0[i] := pow[(c+223)mod 255]+pow[(c+199)mod 255]shl 8+
pow[(c+238)mod 255]shl 16+pow[(c+104)mod 255]shl 24;
Td1[i] := Td0[i] shl 8+Td0[i] shr 24;
Td2[i] := Td1[i] shl 8+Td1[i] shr 24;
Td3[i] := Td2[i] shl 8+Td2[i] shr 24;
end;
end;
type
TSHAHash = packed record
A,B,C,D,E,F,G,H: cardinal; // will use A..E with TSHA1, A..H with TSHA256
end;
TSHAContext = packed record
// Working hash (TSHA256.Init expect this field to be the first)
Hash: TSHAHash;
// 64bit msg length
MLen: QWord;
// Block buffer
Buffer: array[0..63] of byte;
// Index in buffer
Index : integer;
end;
{$ifdef CPUINTEL}
{$ifdef CPU32}
procedure bswap256(s,d: PIntegerArray); {$ifdef FPC}nostackframe; assembler;{$endif}
asm
push ebx
mov ecx, eax // ecx=s, edx=d
mov eax, [ecx]
mov ebx, [ecx + 4]
bswap eax
bswap ebx
mov [edx], eax
mov [edx + 4], ebx
mov eax, [ecx + 8]
mov ebx, [ecx + 12]
bswap eax
bswap ebx
mov [edx + 8], eax
mov [edx + 12], ebx
mov eax, [ecx + 16]
mov ebx, [ecx + 20]
bswap eax
bswap ebx
mov [edx + 16], eax
mov [edx + 20], ebx
mov eax, [ecx + 24]
mov ebx, [ecx + 28]
bswap eax
bswap ebx
mov [edx + 24], eax
mov [edx + 28], ebx
pop ebx
end;
procedure bswap160(s,d: PIntegerArray); {$ifdef FPC}nostackframe; assembler;{$endif}
asm
push ebx
mov ecx, eax // ecx=s, edx=d
mov eax, [ecx]
mov ebx, [ecx + 4]
bswap eax
bswap ebx
mov [edx], eax
mov [edx + 4], ebx
mov eax, [ecx + 8]
mov ebx, [ecx + 12]
bswap eax
bswap ebx
mov [edx + 8], eax
mov [edx + 12], ebx
mov eax, [ecx + 16]
bswap eax
mov [edx + 16], eax
pop ebx
end;
function gf2_multiply(x,y,m: PtrUInt): PtrUInt; {$ifdef FPC}nostackframe; assembler;{$endif}
asm // eax=x edx=y ecx=m
push esi
push edi
push ebx
push ebp
mov ebp, 32
mov ebx, eax
and eax, 1
cmovne eax, edx
@s: mov esi, eax
mov edi, ecx
shr esi, 1
xor edi, esi
test al, 1
mov eax, esi
cmovne eax, edi
shr ebx, 1
mov esi, eax
xor esi, edx
test bl, 1
cmovne eax, esi
dec ebp
jne @s
pop ebp
pop ebx
pop edi
pop esi
end;
{$endif CPU32}
{$ifdef CPU64}
procedure bswap256(s,d: PIntegerArray); {$ifdef FPC} nostackframe; assembler;
asm {$else} asm .noframe {$endif}
mov eax, dword ptr[s]
mov r8d, dword ptr[s + 4]
mov r9d, dword ptr[s + 8]
mov r10d, dword ptr[s + 12]
bswap eax
bswap r8d
bswap r9d
bswap r10d
mov dword ptr[d], eax
mov dword ptr[d + 4], r8d
mov dword ptr[d + 8], r9d
mov dword ptr[d + 12], r10d
mov eax, dword ptr[s + 16]
mov r8d, dword ptr[s + 20]
mov r9d, dword ptr[s + 24]
mov r10d, dword ptr[s + 28]
bswap eax
bswap r8d
bswap r9d
bswap r10d
mov dword ptr[d + 16], eax
mov dword ptr[d + 20], r8d
mov dword ptr[d + 24], r9d
mov dword ptr[d + 28], r10d
end;
procedure bswap160(s,d: PIntegerArray); {$ifdef FPC} nostackframe; assembler;
asm {$else} asm .noframe {$endif}
mov eax, dword ptr[s]
mov r8d, dword ptr[s + 4]
mov r9d, dword ptr[s + 8]
mov r10d, dword ptr[s + 12]
bswap eax
bswap r8d
bswap r9d
bswap r10d
mov dword ptr[d], eax
mov dword ptr[d + 4], r8d
mov dword ptr[d + 8], r9d
mov dword ptr[d + 12], r10d
mov eax, dword ptr[s + 16]
bswap eax
mov dword ptr[d + 16], eax
end;
// see http://nicst.de/crc.pdf
function gf2_multiply(x,y,m,bits: PtrUInt): PtrUInt; {$ifdef FPC} nostackframe; assembler;
asm {$else} asm .noframe {$endif}
mov rax, x
and rax, 1
cmovne rax, y
@s: mov r10, rax
mov r11, m
shr r10, 1
xor r11, r10
test al, 1
mov rax, r10
cmovne rax, r11
shr x, 1
mov r10, rax
xor r10, y
{$ifdef win64}
test cl, 1
{$else}
test dil, 1
{$endif}
cmovne rax, r10
dec bits
jne @s
end;
{$endif CPU64}
{$else not CPUINTEL}
procedure bswap256(s,d: PIntegerArray);
begin
{$ifdef FPC} // use fast platform-specific function
d[0] := SwapEndian(s[0]);
d[1] := SwapEndian(s[1]);
d[2] := SwapEndian(s[2]);
d[3] := SwapEndian(s[3]);
d[4] := SwapEndian(s[4]);
d[5] := SwapEndian(s[5]);
d[6] := SwapEndian(s[6]);
d[7] := SwapEndian(s[7]);
{$else}
d[0] := bswap32(s[0]);
d[1] := bswap32(s[1]);
d[2] := bswap32(s[2]);
d[3] := bswap32(s[3]);
d[4] := bswap32(s[4]);
d[5] := bswap32(s[5]);
d[6] := bswap32(s[6]);
d[7] := bswap32(s[7]);
{$endif FPC}
end;
procedure bswap160(s,d: PIntegerArray);
begin
{$ifdef FPC} // use fast platform-specific function
d[0] := SwapEndian(s[0]);
d[1] := SwapEndian(s[1]);
d[2] := SwapEndian(s[2]);
d[3] := SwapEndian(s[3]);
d[4] := SwapEndian(s[4]);
{$else}
d[0] := bswap32(s[0]);
d[1] := bswap32(s[1]);
d[2] := bswap32(s[2]);
d[3] := bswap32(s[3]);
d[4] := bswap32(s[4]);
{$endif FPC}
end;
{$endif CPUINTEL}
function SHA256SelfTest: boolean;
function SingleTest(const s: RawByteString; const TDig: TSHA256Digest): boolean;
var SHA: TSHA256;
Digest: TSHA256Digest;
i: integer;
begin
// 1. Hash complete RawByteString
SHA.Full(pointer(s),length(s),Digest);
result := IsEqual(Digest,TDig);
if not result then exit;
// 2. one update call for all chars
SHA.Init;
for i := 1 to length(s) do
SHA.Update(@s[i],1);
SHA.Final(Digest);
result := IsEqual(Digest,TDig);
// 3. test consistency with Padlock engine down results
{$ifdef USEPADLOCK}
if not result or not padlock_available then exit;
padlock_available := false; // force PadLock engine down
SHA.Full(pointer(s),length(s),Digest);
result := IsEqual(Digest,TDig);
{$ifdef PADLOCKDEBUG} write('=padlock '); {$endif}
padlock_available := true;
{$endif}
end;
var Digest: TSHA256Digest;
const
D1: TSHA256Digest = ($ba,$78,$16,$bf,$8f,$01,$cf,$ea,$41,$41,$40,$de,$5d,$ae,$22,$23,
$b0,$03,$61,$a3,$96,$17,$7a,$9c,$b4,$10,$ff,$61,$f2,$00,$15,$ad);
D2: TSHA256Digest = ($24,$8d,$6a,$61,$d2,$06,$38,$b8,$e5,$c0,$26,$93,$0c,$3e,$60,$39,
$a3,$3c,$e4,$59,$64,$ff,$21,$67,$f6,$ec,$ed,$d4,$19,$db,$06,$c1);
D3: TSHA256Digest =
($94,$E4,$A9,$D9,$05,$31,$23,$1D,$BE,$D8,$7E,$D2,$E4,$F3,$5E,$4A,
$0B,$F4,$B3,$BC,$CE,$EB,$17,$16,$D5,$77,$B1,$E0,$8B,$A9,$BA,$A3);
begin
// result := true; exit;
result := SingleTest('abc', D1) and
SingleTest('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq', D2);
if not result then exit;
SHA256Weak('lagrangehommage',Digest); // test with len=256>64
result := IsEqual(Digest,D3);
{$ifdef CPU64}
{$ifdef CPUINTEL}
if cfSSE41 in CpuFeatures then begin
Exclude(CpuFeatures,cfSSE41);
result := result and SingleTest('abc', D1) and
SingleTest('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq', D2);
Include(CpuFeatures,cfSSE41);
end;
{$endif}
{$endif}
end;
function MD5(const s: RawByteString): RawUTF8;
var MD5: TMD5;
D: TMD5Digest;
begin
MD5.Full(pointer(s),Length(s),D);
result := MD5DigestToString(D);
FillZero(D);
end;
function SHA1(const s: RawByteString): RawUTF8;
var SHA: TSHA1;
Digest: TSHA1Digest;
begin
SHA.Full(pointer(s),length(s),Digest);
result := SHA1DigestToString(Digest);
FillZero(Digest);
end;
function SHA384(const s: RawByteString): RawUTF8;
var SHA: TSHA384;
Digest: TSHA384Digest;
begin
SHA.Full(pointer(s),length(s),Digest);
result := SHA384DigestToString(Digest);
FillZero(Digest);
end;
function SHA512(const s: RawByteString): RawUTF8;
var SHA: TSHA512;
Digest: TSHA512Digest;
begin
SHA.Full(pointer(s),length(s),Digest);
result := SHA512DigestToString(Digest);
FillZero(Digest);
end;
{ THMAC_SHA1 }
procedure THMAC_SHA1.Init(key: pointer; keylen: integer);
var i: integer;
k0,k0xorIpad: THash512Rec;
begin
FillZero(k0.b);
if keylen>sizeof(k0) then
sha.Full(key,keylen,k0.b160) else
MoveFast(key^,k0,keylen);
for i := 0 to 15 do
k0xorIpad.c[i] := k0.c[i] xor $36363636;
for i := 0 to 15 do
step7data.c[i] := k0.c[i] xor $5c5c5c5c;
sha.Init;
sha.Update(@k0xorIpad,sizeof(k0xorIpad));
FillZero(k0.b);
FillZero(k0xorIpad.b);
end;
procedure THMAC_SHA1.Update(msg: pointer; msglen: integer);
begin
sha.Update(msg,msglen);
end;
procedure THMAC_SHA1.Done(out result: TSHA1Digest; NoInit: boolean);
begin
sha.Final(result);
sha.Update(@step7data,sizeof(step7data));
sha.Update(@result,sizeof(result));
sha.Final(result,NoInit);
if not NoInit then
FillZero(step7data.b);
end;
procedure THMAC_SHA1.Done(out result: RawUTF8; NoInit: boolean);
var res: TSHA1Digest;
begin
Done(res,NoInit);
result := SHA1DigestToString(res);
if not NoInit then
FillZero(res);
end;
procedure THMAC_SHA1.Compute(msg: pointer; msglen: integer; out result: TSHA1Digest);
var temp: THMAC_SHA1;
begin
temp := self; // thread-safe copy
temp.Update(msg,msglen);
temp.Done(result);
end;
procedure HMAC_SHA1(key,msg: pointer; keylen,msglen: integer; out result: TSHA1Digest);
var mac: THMAC_SHA1;
begin
mac.Init(key,keylen);
mac.Update(msg,msglen);
mac.Done(result);
end;
procedure HMAC_SHA1(const key,msg: RawByteString; out result: TSHA1Digest);
begin
HMAC_SHA1(pointer(key),pointer(msg),length(key),length(msg),result);
end;
procedure HMAC_SHA1(const key: TSHA1Digest; const msg: RawByteString; out result: TSHA1Digest);
begin
HMAC_SHA1(@key,pointer(msg),sizeof(key),length(msg),result);
end;
procedure PBKDF2_HMAC_SHA1(const password,salt: RawByteString; count: Integer;
out result: TSHA1Digest);
var i: integer;
tmp: TSHA1Digest;
mac: THMAC_SHA1;
first: THMAC_SHA1;
begin
HMAC_SHA1(password,salt+#0#0#0#1,result);
if count<2 then
exit;
tmp := result;
first.Init(pointer(password),length(password));
for i := 2 to count do begin
mac := first; // re-use the very same SHA context for best performance
mac.sha.Update(@tmp,sizeof(tmp));
mac.Done(tmp,true);
XorMemory(@result,@tmp,sizeof(result));
end;
FillcharFast(mac,sizeof(mac),0);
FillcharFast(first,sizeof(first),0);
FillZero(tmp);
end;
{ THMAC_SHA256 }
procedure THMAC_SHA256.Init(key: pointer; keylen: integer);
var i: integer;
k0,k0xorIpad: THash512Rec;
begin
FillZero(k0.b);
if keylen>sizeof(k0) then
sha.Full(key,keylen,k0.Lo) else
MoveFast(key^,k0,keylen);
for i := 0 to 15 do
k0xorIpad.c[i] := k0.c[i] xor $36363636;
for i := 0 to 15 do
step7data.c[i] := k0.c[i] xor $5c5c5c5c;
sha.Init;
sha.Update(@k0xorIpad,sizeof(k0xorIpad));
FillZero(k0.b);
FillZero(k0xorIpad.b);
end;
procedure THMAC_SHA256.Update(msg: pointer; msglen: integer);
begin
sha.Update(msg,msglen);
end;
procedure THMAC_SHA256.Update(const msg: THash128);
begin
sha.Update(@msg,sizeof(msg));
end;
procedure THMAC_SHA256.Update(const msg: THash256);
begin
sha.Update(@msg,sizeof(msg));
end;
procedure THMAC_SHA256.Update(const msg: RawByteString);
begin
sha.Update(pointer(msg),length(msg));
end;
procedure THMAC_SHA256.Done(out result: TSHA256Digest; NoInit: boolean);
begin
sha.Final(result);
sha.Update(@step7data,sizeof(step7data));
sha.Update(@result,sizeof(result));
sha.Final(result,NoInit);
if not NoInit then
FillZero(step7data.b);
end;
procedure THMAC_SHA256.Done(out result: RawUTF8; NoInit: boolean);
var res: THash256;
begin
Done(res,NoInit);
result := SHA256DigestToString(res);
if not NoInit then
FillZero(res);
end;
procedure THMAC_SHA256.Compute(msg: pointer; msglen: integer; out result: TSHA256Digest);
var temp: THMAC_SHA256;
begin
temp := self; // thread-safe copy
temp.Update(msg,msglen);
temp.Done(result);
end;
procedure HMAC_SHA256(key,msg: pointer; keylen,msglen: integer; out result: TSHA256Digest);
var mac: THMAC_SHA256;
begin
mac.Init(key,keylen);
mac.Update(msg,msglen);
mac.Done(result);
end;
procedure HMAC_SHA256(const key,msg: RawByteString; out result: TSHA256Digest);
begin
HMAC_SHA256(pointer(key),pointer(msg),length(key),length(msg),result);
end;
procedure HMAC_SHA256(const key: TSHA256Digest; const msg: RawByteString; out result: TSHA256Digest);
begin
HMAC_SHA256(@key,pointer(msg),sizeof(key),length(msg),result);
end;
procedure PBKDF2_HMAC_SHA256(const password,salt: RawByteString; count: Integer;
out result: TSHA256Digest; const saltdefault: RawByteString);
var i: integer;
tmp: TSHA256Digest;
mac: THMAC_SHA256;
first: THMAC_SHA256;
begin
if salt='' then
HMAC_SHA256(password,saltdefault+#0#0#0#1,result) else
HMAC_SHA256(password,salt+#0#0#0#1,result);
if count<2 then
exit;
tmp := result;
first.Init(pointer(password),length(password));
for i := 2 to count do begin
mac := first; // re-use the very same SHA context for best performance
mac.sha.Update(@tmp,sizeof(tmp));
mac.Done(tmp,true);
XorMemoryPtrInt(@result,@tmp,sizeof(result) shr {$ifdef CPU32}2{$else}3{$endif});
end;
FillcharFast(first,sizeof(first),0);
FillcharFast(mac,sizeof(mac),0);
FillZero(tmp);
end;
procedure PBKDF2_HMAC_SHA256(const password,salt: RawByteString; count: Integer;
var result: THash256DynArray; const saltdefault: RawByteString);
var n,i: integer;
iter: RawByteString;
tmp: TSHA256Digest;
mac: THMAC_SHA256;
first: THMAC_SHA256;
begin
first.Init(pointer(password),length(password));
SetLength(iter,sizeof(integer));
for n := 0 to high(result) do begin
PInteger(iter)^ := bswap32(n+1); // U1 = PRF(Password, Salt || INT_32_BE(i))
if salt='' then
HMAC_SHA256(password,saltdefault+iter,result[n]) else
HMAC_SHA256(password,salt+iter,result[n]);
tmp := result[n];
for i := 2 to count do begin
mac := first; // re-use the very same SHA context for best performance
mac.sha.Update(@tmp,sizeof(tmp));
mac.Done(tmp,true);
XorMemoryPtrInt(@result[n],@tmp,sizeof(result[n]) shr {$ifdef CPU32}2{$else}3{$endif});
end;
end;
FillZero(tmp);
FillcharFast(mac,sizeof(mac),0);
FillcharFast(first,sizeof(first),0);
end;
function SHA256(const s: RawByteString): RawUTF8;
var SHA: TSHA256;
Digest: TSHA256Digest;
begin
SHA.Full(pointer(s),length(s),Digest);
result := SHA256DigestToString(Digest);
FillZero(Digest);
end;
function SHA256(Data: pointer; Len: integer): RawUTF8;
var SHA: TSHA256;
Digest: TSHA256Digest;
begin
SHA.Full(Data,Len,Digest);
result := SHA256DigestToString(Digest);
FillZero(Digest);
end;
function SHA256Digest(Data: pointer; Len: integer): TSHA256Digest;
var SHA: TSHA256;
begin
SHA.Full(Data,Len,result);
end;
function SHA256Digest(const Data: RawByteString): TSHA256Digest;
var SHA: TSHA256;
begin
SHA.Full(pointer(Data),Length(Data),result);
end;
{ THMAC_SHA384 }
procedure THMAC_SHA384.Init(key: pointer; keylen: integer);
var i: integer;
k0,k0xorIpad: array[0..31] of cardinal;
begin
FillCharFast(k0,sizeof(k0),0);
if keylen>sizeof(k0) then
sha.Full(key,keylen,PSHA384Digest(@k0)^) else
MoveFast(key^,k0,keylen);
for i := 0 to 31 do
k0xorIpad[i] := k0[i] xor $36363636;
for i := 0 to 31 do
step7data[i] := k0[i] xor $5c5c5c5c;
sha.Init;
sha.Update(@k0xorIpad,sizeof(k0xorIpad));
FillCharFast(k0,sizeof(k0),0);
FillCharFast(k0xorIpad,sizeof(k0xorIpad),0);
end;
procedure THMAC_SHA384.Update(msg: pointer; msglen: integer);
begin
sha.Update(msg,msglen);
end;
procedure THMAC_SHA384.Done(out result: TSHA384Digest; NoInit: boolean);
begin
sha.Final(result);
sha.Update(@step7data,sizeof(step7data));
sha.Update(@result,sizeof(result));
sha.Final(result,NoInit);
if not NoInit then
FillCharFast(step7data,sizeof(step7data),0);
end;
procedure THMAC_SHA384.Done(out result: RawUTF8; NoInit: boolean);
var res: THash384;
begin
Done(res,NoInit);
result := SHA384DigestToString(res);
if not NoInit then
FillZero(res);
end;
procedure THMAC_SHA384.Compute(msg: pointer; msglen: integer; out result: TSHA384Digest);
var temp: THMAC_SHA384;
begin
temp := self; // thread-safe copy
temp.Update(msg,msglen);
temp.Done(result);
end;
procedure HMAC_SHA384(key,msg: pointer; keylen,msglen: integer; out result: TSHA384Digest);
var mac: THMAC_SHA384;
begin
mac.Init(key,keylen);
mac.Update(msg,msglen);
mac.Done(result);
end;
procedure HMAC_SHA384(const key,msg: RawByteString; out result: TSHA384Digest);
begin
HMAC_SHA384(pointer(key),pointer(msg),length(key),length(msg),result);
end;
procedure HMAC_SHA384(const key: TSHA384Digest; const msg: RawByteString; out result: TSHA384Digest);
begin
HMAC_SHA384(@key,pointer(msg),sizeof(key),length(msg),result);
end;
procedure PBKDF2_HMAC_SHA384(const password,salt: RawByteString; count: Integer;
out result: TSHA384Digest);
var i: integer;
tmp: TSHA384Digest;
mac: THMAC_SHA384;
first: THMAC_SHA384;
begin
HMAC_SHA384(password,salt+#0#0#0#1,result);
if count<2 then
exit;
tmp := result;
first.Init(pointer(password),length(password));
for i := 2 to count do begin
mac := first; // re-use the very same SHA context for best performance
mac.sha.Update(@tmp,sizeof(tmp));
mac.Done(tmp,true);
XorMemoryPtrInt(@result,@tmp,sizeof(result) shr {$ifdef CPU32}2{$else}3{$endif});
end;
FillcharFast(mac,sizeof(mac),0);
FillcharFast(first,sizeof(first),0);
FillZero(tmp);
end;
{ THMAC_SHA512 }
procedure THMAC_SHA512.Init(key: pointer; keylen: integer);
var i: integer;
k0,k0xorIpad: array[0..31] of cardinal;
begin
FillCharFast(k0,sizeof(k0),0);
if keylen>sizeof(k0) then
sha.Full(key,keylen,PSHA512Digest(@k0)^) else
MoveFast(key^,k0,keylen);
for i := 0 to 31 do
k0xorIpad[i] := k0[i] xor $36363636;
for i := 0 to 31 do
step7data[i] := k0[i] xor $5c5c5c5c;
sha.Init;
sha.Update(@k0xorIpad,sizeof(k0xorIpad));
FillCharFast(k0,sizeof(k0),0);
FillCharFast(k0xorIpad,sizeof(k0xorIpad),0);
end;
procedure THMAC_SHA512.Update(msg: pointer; msglen: integer);
begin
sha.Update(msg,msglen);
end;
procedure THMAC_SHA512.Done(out result: TSHA512Digest; NoInit: boolean);
begin
sha.Final(result);
sha.Update(@step7data,sizeof(step7data));
sha.Update(@result,sizeof(result));
sha.Final(result,NoInit);
if not NoInit then
FillCharFast(step7data,sizeof(step7data),0);
end;
procedure THMAC_SHA512.Done(out result: RawUTF8; NoInit: boolean);
var res: THash512;
begin
Done(res,NoInit);
result := SHA512DigestToString(res);
if not NoInit then
FillZero(res);
end;
procedure THMAC_SHA512.Compute(msg: pointer; msglen: integer; out result: TSHA512Digest);
var temp: THMAC_SHA512;
begin
temp := self; // thread-safe copy
temp.Update(msg,msglen);
temp.Done(result);
end;
procedure HMAC_SHA512(key,msg: pointer; keylen,msglen: integer; out result: TSHA512Digest);
var mac: THMAC_SHA512;
begin
mac.Init(key,keylen);
mac.Update(msg,msglen);
mac.Done(result);
end;
procedure HMAC_SHA512(const key,msg: RawByteString; out result: TSHA512Digest);
begin
HMAC_SHA512(pointer(key),pointer(msg),length(key),length(msg),result);
end;
procedure HMAC_SHA512(const key: TSHA512Digest; const msg: RawByteString; out result: TSHA512Digest);
begin
HMAC_SHA512(@key,pointer(msg),sizeof(key),length(msg),result);
end;
procedure PBKDF2_HMAC_SHA512(const password,salt: RawByteString; count: Integer;
out result: TSHA512Digest);
var i: integer;
tmp: TSHA512Digest;
mac: THMAC_SHA512;
first: THMAC_SHA512;
begin
HMAC_SHA512(password,salt+#0#0#0#1,result);
if count<2 then
exit;
tmp := result;
first.Init(pointer(password),length(password));
for i := 2 to count do begin
mac := first; // re-use the very same SHA context for best performance
mac.sha.Update(@tmp,sizeof(tmp));
mac.Done(tmp,true);
XorMemoryPtrInt(@result,@tmp,sizeof(result) shr {$ifdef CPU32}2{$else}3{$endif});
end;
FillcharFast(mac,sizeof(mac),0);
FillcharFast(first,sizeof(first),0);
FillZero(tmp);
end;
{ HMAC_CRC256C }
procedure crc256cmix(h1,h2: cardinal; h: PCardinalArray);
begin // see https://goo.gl/Pls5wi
h^[0] := h1; inc(h1,h2);
h^[1] := h1; inc(h1,h2);
h^[2] := h1; inc(h1,h2);
h^[3] := h1; inc(h1,h2);
h^[4] := h1; inc(h1,h2);
h^[5] := h1; inc(h1,h2);
h^[6] := h1; inc(h1,h2);
h^[7] := h1;
end;
procedure HMAC_CRC256C(key,msg: pointer; keylen,msglen: integer; out result: THash256);
var i: integer;
h1,h2: cardinal;
k0,k0xorIpad,step7data: THash512Rec;
begin
FillCharFast(k0,sizeof(k0),0);
if keylen>sizeof(k0) then
crc256c(key,keylen,k0.Lo) else
MoveFast(key^,k0,keylen);
for i := 0 to 15 do
k0xorIpad.c[i] := k0.c[i] xor $36363636;
for i := 0 to 15 do
step7data.c[i] := k0.c[i] xor $5c5c5c5c;
h1 := crc32c(crc32c(0,@k0xorIpad,sizeof(k0xorIpad)),msg,msglen);
h2 := crc32c(crc32c(h1,@k0xorIpad,sizeof(k0xorIpad)),msg,msglen);
crc256cmix(h1,h2,@result);
h1 := crc32c(crc32c(0,@step7data,sizeof(step7data)),@result,sizeof(result));
h2 := crc32c(crc32c(h1,@step7data,sizeof(step7data)),@result,sizeof(result));
crc256cmix(h1,h2,@result);
FillCharFast(k0,sizeof(k0),0);
FillCharFast(k0xorIpad,sizeof(k0),0);
FillCharFast(step7data,sizeof(k0),0);
end;
procedure HMAC_CRC256C(const key: THash256; const msg: RawByteString; out result: THash256);
begin
HMAC_CRC256C(@key,pointer(msg),SizeOf(key),length(msg),result);
end;
procedure HMAC_CRC256C(const key,msg: RawByteString; out result: THash256);
begin
HMAC_CRC256C(pointer(key),pointer(msg),length(key),length(msg),result);
end;
{ THMAC_CRC32C }
procedure THMAC_CRC32C.Init(const key: RawByteString);
begin
Init(pointer(key),length(key));
end;
procedure THMAC_CRC32C.Init(key: pointer; keylen: integer);
var i: integer;
k0,k0xorIpad: THash512Rec;
begin
FillCharFast(k0,sizeof(k0),0);
if keylen>sizeof(k0) then
crc256c(key,keylen,k0.Lo) else
MoveFast(key^,k0,keylen);
for i := 0 to 15 do
k0xorIpad.c[i] := k0.c[i] xor $36363636;
for i := 0 to 15 do
step7data.c[i] := k0.c[i] xor $5c5c5c5c;
seed := crc32c(0,@k0xorIpad,sizeof(k0xorIpad));
FillCharFast(k0,sizeof(k0),0);
FillCharFast(k0xorIpad,sizeof(k0xorIpad),0);
end;
procedure THMAC_CRC32C.Update(msg: pointer; msglen: integer);
begin
seed := crc32c(seed,msg,msglen);
end;
procedure THMAC_CRC32C.Update(const msg: RawByteString);
begin
seed := crc32c(seed,pointer(msg),length(msg));
end;
function THMAC_CRC32C.Done(NoInit: boolean): cardinal;
begin
result := crc32c(seed,@step7data,sizeof(step7data));
if not NoInit then
FillcharFast(self,sizeof(self),0);
end;
function THMAC_CRC32C.Compute(msg: pointer; msglen: integer): cardinal;
begin
result := crc32c(crc32c(seed,msg,msglen),@step7data,sizeof(step7data));
end;
function HMAC_CRC32C(key,msg: pointer; keylen,msglen: integer): cardinal;
var mac: THMAC_CRC32C;
begin
mac.Init(key,keylen);
mac.Update(msg,msglen);
result := mac.Done;
end;
function HMAC_CRC32C(const key: THash256; const msg: RawByteString): cardinal;
begin
result := HMAC_CRC32C(@key,pointer(msg),SizeOf(key),length(msg));
end;
function HMAC_CRC32C(const key,msg: RawByteString): cardinal;
begin
result := HMAC_CRC32C(pointer(key),pointer(msg),length(key),length(msg));
end;
function SHA1SelfTest: boolean;
function SingleTest(const s: RawByteString; TDig: TSHA1Digest): boolean;
var SHA: TSHA1;
Digest: TSHA1Digest;
i: integer;
begin
// 1. Hash complete RawByteString
SHA.Full(pointer(s),length(s),Digest);
result := IsEqual(Digest,TDig);
if not result then exit;
// 2. one update call for all chars
for i := 1 to length(s) do
SHA.Update(@s[i],1);
SHA.Final(Digest);
result := IsEqual(Digest,TDig);
// 3. test consistency with Padlock engine down results
{$ifdef USEPADLOCK}
if not result or not padlock_available then exit;
padlock_available := false; // force PadLock engine down
SHA.Full(pointer(s),length(s),Digest);
result := IsEqual(Digest,TDig);
{$ifdef PADLOCKDEBUG} write('=padlock '); {$endif}
padlock_available := true;
{$endif}
end;
const
Test1Out: TSHA1Digest=
($A9,$99,$3E,$36,$47,$06,$81,$6A,$BA,$3E,$25,$71,$78,$50,$C2,$6C,$9C,$D0,$D8,$9D);
Test2Out: TSHA1Digest=
($84,$98,$3E,$44,$1C,$3B,$D2,$6E,$BA,$AE,$4A,$A1,$F9,$51,$29,$E5,$E5,$46,$70,$F1);
var
s: RawByteString;
SHA: TSHA1;
Digest: TSHA1Digest;
begin
result := SingleTest('abc',Test1Out) and
SingleTest('abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq',Test2Out);
if not result then exit;
s := 'Wikipedia, l''encyclopedie libre et gratuite';
SHA.Full(pointer(s),length(s),Digest);
result := SHA1DigestToString(Digest)='c18cc65028bbdc147288a2d136313287782b9c73';
if not result then exit;
HMAC_SHA1('','',Digest);
result := SHA1DigestToString(Digest)='fbdb1d1b18aa6c08324b7d64b71fb76370690e1d';
if not result then exit;
HMAC_SHA1('key','The quick brown fox jumps over the lazy dog',Digest);
result := SHA1DigestToString(Digest)='de7c9b85b8b78aa6bc8a7a36f70a90701c9db4d9';
if not result then exit;
// from https://www.ietf.org/rfc/rfc6070.txt
PBKDF2_HMAC_SHA1('password','salt',1,Digest);
s := SHA1DigestToString(Digest);
result := s='0c60c80f961f0e71f3a9b524af6012062fe037a6';
if not result then exit;
PBKDF2_HMAC_SHA1('password','salt',2,Digest);
s := SHA1DigestToString(Digest);
result := s='ea6c014dc72d6f8ccd1ed92ace1d41f0d8de8957';
if not result then exit;
PBKDF2_HMAC_SHA1('password','salt',4096,Digest);
s := SHA1DigestToString(Digest);
result := s='4b007901b765489abead49d926f721d065a429c1';
end;
{ TAES }
function AESSelfTest(onlytables: Boolean): boolean;
var A: TAES;
st: RawByteString;
Key: TSHA256Digest;
s,b,p: TAESBlock;
i,k,ks: integer;
begin
// ensure that we have $2000 bytes of contiguous XOR tables ;)
result := (PtrUInt(@TD0)+$400=PtrUInt(@TD1))and(PtrUInt(@TD0)+$800=PtrUInt(@TD2))
and(PtrUInt(@TD0)+$C00=PtrUInt(@TD3))and(PtrUInt(@TD0)+$1000=PtrUInt(@TE0))
and(PtrUInt(@TD0)+$1400=PtrUInt(@TE1))and(PtrUInt(@TD0)+$1800=PtrUInt(@TE2))
and(PtrUInt(@TD0)+$1C00=PtrUInt(@TE3))and
(SBox[255]=$16)and(InvSBox[0]=$52)and
(Te0[0]=$a56363c6)and(Te0[255]=$3a16162c)and
(Te1[0]=$6363c6a5)and(Te1[255]=$16162c3a)and
(Te3[0]=$c6a56363)and(Te3[255]=$2c3a1616)and
(Td0[0]=$50a7f451)and(Td0[99]=0)and(Td0[255]=$4257b8d0)and
(Td3[0]=$5150a7f4)and(Td3[255]=$d04257b8);
if onlytables or not result then
exit;
// test
result := false;
Randomize;
st := '1234essai';
PInteger(@st[1])^ := Random(MaxInt);
for k := 0 to 2 do begin
ks := 128+k*64; // test keysize of 128,192 and 256 bits
// write('Test AES ',ks);
for i := 1 to 100 do begin
SHA256Weak(st,Key);
moveFast(Key,s,16);
A.EncryptInit(Key,ks);
A.Encrypt(s,b);
A.Done;
A.DecryptInit(Key,ks);
A.Decrypt(b,p);
A.Done;
if not IsEqual(p,s) then begin
writeln('AESSelfTest compareError with keysize=',ks);
exit;
end;
st := st+AnsiChar(Random(255));
end;
end;
result := true;
end;
procedure TAES.Encrypt(var B: TAESBlock);
begin
TAESContext(Context).DoBlock(Context,B,B);
end;
{$ifdef USEAESNI}
{$ifdef CPU32}
procedure AesNiEncryptXmm7_128; {$ifdef FPC} nostackframe; assembler; {$endif}
asm // input: eax=TAESContext, xmm7=data; output: eax=TAESContext, xmm7=data
movups xmm0, [eax + 16 * 0]
movups xmm1, [eax + 16 * 1]
movups xmm2, [eax + 16 * 2]
movups xmm3, [eax + 16 * 3]
movups xmm4, [eax + 16 * 4]
movups xmm5, [eax + 16 * 5]
movups xmm6, [eax + 16 * 6]
pxor xmm7, xmm0
{$ifdef HASAESNI}
aesenc xmm7, xmm1
aesenc xmm7, xmm2
aesenc xmm7, xmm3
aesenc xmm7, xmm4
aesenc xmm7, xmm5
aesenc xmm7, xmm6
{$else}
db $66, $0F, $38, $DC, $F9
db $66, $0F, $38, $DC, $FA
db $66, $0F, $38, $DC, $FB
db $66, $0F, $38, $DC, $FC
db $66, $0F, $38, $DC, $FD
db $66, $0F, $38, $DC, $FE
{$endif}
movups xmm0, [eax + 16 * 7]
movups xmm1, [eax + 16 * 8]
movups xmm2, [eax + 16 * 9]
movups xmm3, [eax + 16 * 10]
{$ifdef HASAESNI}
aesenc xmm7, xmm0
aesenc xmm7, xmm1
aesenc xmm7, xmm2
aesenclast xmm7, xmm3
{$else}
db $66, $0F, $38, $DC, $F8
db $66, $0F, $38, $DC, $F9
db $66, $0F, $38, $DC, $FA
db $66, $0F, $38, $DD, $FB
{$endif}
end;
procedure aesniencrypt128(const ctxt, source, dest);
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=ctxt edx=source ecx=dest
movups xmm7, [edx]
call AesNiEncryptXmm7_128
movups [ecx], xmm7
pxor xmm7, xmm7 // for safety
end;
procedure AesNiEncryptXmm7_192;
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // input: eax=TAESContext, xmm7=data; output: eax=TAESContext, xmm7=data
movups xmm0, [eax + 16 * 0]
movups xmm1, [eax + 16 * 1]
movups xmm2, [eax + 16 * 2]
movups xmm3, [eax + 16 * 3]
movups xmm4, [eax + 16 * 4]
movups xmm5, [eax + 16 * 5]
movups xmm6, [eax + 16 * 6]
pxor xmm7, xmm0
{$ifdef HASAESNI}
aesenc xmm7, xmm1
aesenc xmm7, xmm2
aesenc xmm7, xmm3
aesenc xmm7, xmm4
aesenc xmm7, xmm5
aesenc xmm7, xmm6
{$else}
db $66, $0F, $38, $DC, $F9
db $66, $0F, $38, $DC, $FA
db $66, $0F, $38, $DC, $FB
db $66, $0F, $38, $DC, $FC
db $66, $0F, $38, $DC, $FD
db $66, $0F, $38, $DC, $FE
{$endif}
movups xmm0, [eax + 16 * 7]
movups xmm1, [eax + 16 * 8]
movups xmm2, [eax + 16 * 9]
movups xmm3, [eax + 16 * 10]
movups xmm4, [eax + 16 * 11]
movups xmm5, [eax + 16 * 12]
{$ifdef HASAESNI}
aesenc xmm7, xmm0
aesenc xmm7, xmm1
aesenc xmm7, xmm2
aesenc xmm7, xmm3
aesenc xmm7, xmm4
aesenclast xmm7, xmm5
{$else}
db $66, $0F, $38, $DC, $F8
db $66, $0F, $38, $DC, $F9
db $66, $0F, $38, $DC, $FA
db $66, $0F, $38, $DC, $FB
db $66, $0F, $38, $DC, $FC
db $66, $0F, $38, $DD, $FD
{$endif}
end;
procedure aesniencrypt192(const ctxt, source, dest);
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=ctxt edx=source ecx=dest
movups xmm7, [edx]
call AesNiEncryptXmm7_192
movups [ecx], xmm7
pxor xmm7, xmm7 // for safety
end;
procedure AesNiEncryptXmm7_256;
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // input: eax=TAESContext, xmm7=data; output: eax=TAESContext, xmm7=data
movups xmm0, [eax + 16 * 0]
movups xmm1, [eax + 16 * 1]
movups xmm2, [eax + 16 * 2]
movups xmm3, [eax + 16 * 3]
movups xmm4, [eax + 16 * 4]
movups xmm5, [eax + 16 * 5]
movups xmm6, [eax + 16 * 6]
pxor xmm7, xmm0
{$ifdef HASAESNI}
aesenc xmm7, xmm1
aesenc xmm7, xmm2
aesenc xmm7, xmm3
aesenc xmm7, xmm4
aesenc xmm7, xmm5
aesenc xmm7, xmm6
{$else}
db $66, $0F, $38, $DC, $F9
db $66, $0F, $38, $DC, $FA
db $66, $0F, $38, $DC, $FB
db $66, $0F, $38, $DC, $FC
db $66, $0F, $38, $DC, $FD
db $66, $0F, $38, $DC, $FE
{$endif}
movups xmm0, [eax + 16 * 7]
movups xmm1, [eax + 16 * 8]
movups xmm2, [eax + 16 * 9]
movups xmm3, [eax + 16 * 10]
movups xmm4, [eax + 16 * 11]
movups xmm5, [eax + 16 * 12]
movups xmm6, [eax + 16 * 13]
{$ifdef HASAESNI}
aesenc xmm7, xmm0
aesenc xmm7, xmm1
aesenc xmm7, xmm2
aesenc xmm7, xmm3
aesenc xmm7, xmm4
aesenc xmm7, xmm5
aesenc xmm7, xmm6
{$else}
db $66, $0F, $38, $DC, $F8
db $66, $0F, $38, $DC, $F9
db $66, $0F, $38, $DC, $FA
db $66, $0F, $38, $DC, $FB
db $66, $0F, $38, $DC, $FC
db $66, $0F, $38, $DC, $FD
db $66, $0F, $38, $DC, $FE
{$endif}
movups xmm1, [eax + 16 * 14]
{$ifdef HASAESNI}
aesenclast xmm7, xmm1
{$else}
db $66, $0F, $38, $DD, $F9
{$endif}
end;
procedure aesniencrypt256(const ctxt, source, dest);
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=ctxt edx=source ecx=dest
movups xmm7, [edx]
call AesNiEncryptXmm7_256
movups [ecx], xmm7
pxor xmm7, xmm7 // for safety
end;
{$endif CPU32}
{$ifdef CPU64}
procedure aesniencrypt128(const ctxt, source, dest); {$ifdef FPC}nostackframe; assembler;
asm {$else} asm .noframe {$endif}
movups xmm7, dqword ptr[source]
movups xmm0, dqword ptr[ctxt + 16 * 0]
movups xmm1, dqword ptr[ctxt + 16 * 1]
movups xmm2, dqword ptr[ctxt + 16 * 2]
movups xmm3, dqword ptr[ctxt + 16 * 3]
movups xmm4, dqword ptr[ctxt + 16 * 4]
movups xmm5, dqword ptr[ctxt + 16 * 5]
movups xmm6, dqword ptr[ctxt + 16 * 6]
movups xmm8, dqword ptr[ctxt + 16 * 7]
movups xmm9, dqword ptr[ctxt + 16 * 8]
movups xmm10, dqword ptr[ctxt + 16 * 9]
movups xmm11, dqword ptr[ctxt + 16 * 10]
pxor xmm7, xmm0
aesenc xmm7, xmm1
aesenc xmm7, xmm2
aesenc xmm7, xmm3
aesenc xmm7, xmm4
aesenc xmm7, xmm5
aesenc xmm7, xmm6
aesenc xmm7, xmm8
aesenc xmm7, xmm9
aesenc xmm7, xmm10
aesenclast xmm7, xmm11
movups dqword ptr[dest], xmm7
pxor xmm7, xmm7 // for safety
end;
procedure aesniencrypt192(const ctxt, source, dest); {$ifdef FPC}nostackframe; assembler;
asm {$else} asm .noframe {$endif}
movups xmm7, dqword ptr[source]
movups xmm0, dqword ptr[ctxt + 16 * 0]
movups xmm1, dqword ptr[ctxt + 16 * 1]
movups xmm2, dqword ptr[ctxt + 16 * 2]
movups xmm3, dqword ptr[ctxt + 16 * 3]
movups xmm4, dqword ptr[ctxt + 16 * 4]
movups xmm5, dqword ptr[ctxt + 16 * 5]
movups xmm6, dqword ptr[ctxt + 16 * 6]
movups xmm8, dqword ptr[ctxt + 16 * 7]
movups xmm9, dqword ptr[ctxt + 16 * 8]
movups xmm10, dqword ptr[ctxt + 16 * 9]
movups xmm11, dqword ptr[ctxt + 16 * 10]
movups xmm12, dqword ptr[ctxt + 16 * 11]
movups xmm13, dqword ptr[ctxt + 16 * 12]
pxor xmm7, xmm0
aesenc xmm7, xmm1
aesenc xmm7, xmm2
aesenc xmm7, xmm3
aesenc xmm7, xmm4
aesenc xmm7, xmm5
aesenc xmm7, xmm6
aesenc xmm7, xmm8
aesenc xmm7, xmm9
aesenc xmm7, xmm10
aesenc xmm7, xmm11
aesenc xmm7, xmm12
aesenclast xmm7, xmm13
movups dqword ptr[dest], xmm7
pxor xmm7, xmm7 // for safety
end;
procedure aesniencrypt256(const ctxt, source, dest); {$ifdef FPC}nostackframe; assembler;
asm {$else} asm .noframe {$endif}
movups xmm7, dqword ptr[source]
movups xmm0, dqword ptr[ctxt + 16 * 0]
movups xmm1, dqword ptr[ctxt + 16 * 1]
movups xmm2, dqword ptr[ctxt + 16 * 2]
movups xmm3, dqword ptr[ctxt + 16 * 3]
movups xmm4, dqword ptr[ctxt + 16 * 4]
movups xmm5, dqword ptr[ctxt + 16 * 5]
movups xmm6, dqword ptr[ctxt + 16 * 6]
movups xmm8, dqword ptr[ctxt + 16 * 7]
movups xmm9, dqword ptr[ctxt + 16 * 8]
movups xmm10, dqword ptr[ctxt + 16 * 9]
movups xmm11, dqword ptr[ctxt + 16 * 10]
movups xmm12, dqword ptr[ctxt + 16 * 11]
movups xmm13, dqword ptr[ctxt + 16 * 12]
movups xmm14, dqword ptr[ctxt + 16 * 13]
movups xmm15, dqword ptr[ctxt + 16 * 14]
pxor xmm7, xmm0
aesenc xmm7, xmm1
aesenc xmm7, xmm2
aesenc xmm7, xmm3
aesenc xmm7, xmm4
aesenc xmm7, xmm5
aesenc xmm7, xmm6
aesenc xmm7, xmm8
aesenc xmm7, xmm9
aesenc xmm7, xmm10
aesenc xmm7, xmm11
aesenc xmm7, xmm12
aesenc xmm7, xmm13
aesenc xmm7, xmm14
aesenclast xmm7, xmm15
movups dqword ptr[dest], xmm7
pxor xmm7, xmm7 // for safety
end;
procedure aesnidecrypt128(const ctxt, source, dest); {$ifdef FPC}nostackframe; assembler;
asm {$else} asm .noframe {$endif}
movups xmm7, dqword ptr[source]
movups xmm0, dqword ptr[ctxt + 16 * 10]
movups xmm1, dqword ptr[ctxt + 16 * 9]
movups xmm2, dqword ptr[ctxt + 16 * 8]
movups xmm3, dqword ptr[ctxt + 16 * 7]
movups xmm4, dqword ptr[ctxt + 16 * 6]
movups xmm5, dqword ptr[ctxt + 16 * 5]
movups xmm6, dqword ptr[ctxt + 16 * 4]
movups xmm8, dqword ptr[ctxt + 16 * 3]
movups xmm9, dqword ptr[ctxt + 16 * 2]
movups xmm10, dqword ptr[ctxt + 16 * 1]
movups xmm11, dqword ptr[ctxt + 16 * 0]
pxor xmm7, xmm0
aesdec xmm7, xmm1
aesdec xmm7, xmm2
aesdec xmm7, xmm3
aesdec xmm7, xmm4
aesdec xmm7, xmm5
aesdec xmm7, xmm6
aesdec xmm7, xmm8
aesdec xmm7, xmm9
aesdec xmm7, xmm10
aesdeclast xmm7, xmm11
movups dqword ptr[dest], xmm7
pxor xmm7, xmm7 // for safety
end;
procedure aesnidecrypt192(const ctxt, source, dest); {$ifdef FPC}nostackframe; assembler;
asm {$else} asm .noframe {$endif}
movups xmm7, dqword ptr[source]
movups xmm0, dqword ptr[ctxt + 16 * 12]
movups xmm1, dqword ptr[ctxt + 16 * 11]
movups xmm2, dqword ptr[ctxt + 16 * 10]
movups xmm3, dqword ptr[ctxt + 16 * 9]
movups xmm4, dqword ptr[ctxt + 16 * 8]
movups xmm5, dqword ptr[ctxt + 16 * 7]
movups xmm6, dqword ptr[ctxt + 16 * 6]
movups xmm8, dqword ptr[ctxt + 16 * 5]
movups xmm9, dqword ptr[ctxt + 16 * 4]
movups xmm10, dqword ptr[ctxt + 16 * 3]
movups xmm11, dqword ptr[ctxt + 16 * 2]
movups xmm12, dqword ptr[ctxt + 16 * 1]
movups xmm13, dqword ptr[ctxt + 16 * 0]
pxor xmm7, xmm0
aesdec xmm7, xmm1
aesdec xmm7, xmm2
aesdec xmm7, xmm3
aesdec xmm7, xmm4
aesdec xmm7, xmm5
aesdec xmm7, xmm6
aesdec xmm7, xmm8
aesdec xmm7, xmm9
aesdec xmm7, xmm10
aesdec xmm7, xmm11
aesdec xmm7, xmm12
aesdeclast xmm7, xmm13
movups dqword ptr[dest], xmm7
pxor xmm7, xmm7 // for safety
end;
procedure aesnidecrypt256(const ctxt, source, dest); {$ifdef FPC}nostackframe; assembler;
asm {$else} asm .noframe {$endif}
movups xmm7, dqword ptr[source]
movups xmm0, dqword ptr[ctxt + 16 * 14]
movups xmm1, dqword ptr[ctxt + 16 * 13]
movups xmm2, dqword ptr[ctxt + 16 * 12]
movups xmm3, dqword ptr[ctxt + 16 * 11]
movups xmm4, dqword ptr[ctxt + 16 * 10]
movups xmm5, dqword ptr[ctxt + 16 * 9]
movups xmm6, dqword ptr[ctxt + 16 * 8]
movups xmm8, dqword ptr[ctxt + 16 * 7]
movups xmm9, dqword ptr[ctxt + 16 * 6]
movups xmm10, dqword ptr[ctxt + 16 * 5]
movups xmm11, dqword ptr[ctxt + 16 * 4]
movups xmm12, dqword ptr[ctxt + 16 * 3]
movups xmm13, dqword ptr[ctxt + 16 * 2]
movups xmm14, dqword ptr[ctxt + 16 * 1]
movups xmm15, dqword ptr[ctxt + 16 * 0]
pxor xmm7, xmm0
aesdec xmm7, xmm1
aesdec xmm7, xmm2
aesdec xmm7, xmm3
aesdec xmm7, xmm4
aesdec xmm7, xmm5
aesdec xmm7, xmm6
aesdec xmm7, xmm8
aesdec xmm7, xmm9
aesdec xmm7, xmm10
aesdec xmm7, xmm11
aesdec xmm7, xmm12
aesdec xmm7, xmm13
aesdec xmm7, xmm14
aesdeclast xmm7, xmm15
movups dqword ptr[dest], xmm7
pxor xmm7, xmm7 // for safety
end;
{$endif CPU64}
{$endif USEAESNI}
procedure aesencryptpas(const ctxt: TAESContext; bi, bo: PWA4);
{ AES_PASCAL version (c) Wolfgang Ehrhardt under zlib license:
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution.
-> code has been refactored and tuned especially for FPC x86_64 target }
var
t: PCardinalArray; // faster on a PIC system
{$ifdef AES_ROLLED}
s0,s1,s2,s3: PtrUInt; // TAESBlock s# as separate variables
t0,t1,t2: cardinal; // TAESBlock t# as separate variables
pk: PWA4;
i: integer;
begin
pk := @ctxt.RK;
s0 := bi[0] xor pk[0];
s1 := bi[1] xor pk[1];
s2 := bi[2] xor pk[2];
s3 := bi[3] xor pk[3];
inc(pk);
t := @Te0;
for i := 1 to ctxt.rounds-1 do begin
t0 := t[s0 and $ff] xor t[$100+s1 shr 8 and $ff] xor t[$200+s2 shr 16 and $ff] xor t[$300+s3 shr 24];
t1 := t[s1 and $ff] xor t[$100+s2 shr 8 and $ff] xor t[$200+s3 shr 16 and $ff] xor t[$300+s0 shr 24];
t2 := t[s2 and $ff] xor t[$100+s3 shr 8 and $ff] xor t[$200+s0 shr 16 and $ff] xor t[$300+s1 shr 24];
s3 := t[s3 and $ff] xor t[$100+s0 shr 8 and $ff] xor t[$200+s1 shr 16 and $ff] xor t[$300+s2 shr 24] xor pk[3];;
s0 := t0 xor pk[0];
s1 := t1 xor pk[1];
s2 := t2 xor pk[2];
inc(pk);
end;
bo[0] := ((SBox[s0 and $ff]) xor
(SBox[s1 shr 8 and $ff]) shl 8 xor
(SBox[s2 shr 16 and $ff]) shl 16 xor
(SBox[s3 shr 24]) shl 24 ) xor pk[0];
bo[1] := ((SBox[s1 and $ff]) xor
(SBox[s2 shr 8 and $ff]) shl 8 xor
(SBox[s3 shr 16 and $ff]) shl 16 xor
(SBox[s0 shr 24]) shl 24 ) xor pk[1];
bo[2] := ((SBox[s2 and $ff]) xor
(SBox[s3 shr 8 and $ff]) shl 8 xor
(SBox[s0 shr 16 and $ff]) shl 16 xor
(SBox[s1 shr 24]) shl 24 ) xor pk[2];
bo[3] := ((SBox[s3 and $ff]) xor
(SBox[s0 shr 8 and $ff]) shl 8 xor
(SBox[s1 shr 16 and $ff]) shl 16 xor
(SBox[s2 shr 24]) shl 24 ) xor pk[3];
{$else}
s0,s1,s2,s3,t0,t1,t2,t3: cardinal; // TAESBlock s#/t# as separate variables
pK: PAWk;
begin
pK := @ctxt.RK;
// Initialize with input block
s0 := bi[0] xor pk[0];
s1 := bi[1] xor pk[1];
s2 := bi[2] xor pk[2];
s3 := bi[3] xor pk[3];
t := @Te0;
// Round 1
t0 := t[s0 and $ff] xor t[$100+s1 shr 8 and $ff] xor t[$200+s2 shr 16 and $ff] xor t[$300+s3 shr 24] xor pk[4];
t1 := t[s1 and $ff] xor t[$100+s2 shr 8 and $ff] xor t[$200+s3 shr 16 and $ff] xor t[$300+s0 shr 24] xor pk[5];
t2 := t[s2 and $ff] xor t[$100+s3 shr 8 and $ff] xor t[$200+s0 shr 16 and $ff] xor t[$300+s1 shr 24] xor pk[6];
t3 := t[s3 and $ff] xor t[$100+s0 shr 8 and $ff] xor t[$200+s1 shr 16 and $ff] xor t[$300+s2 shr 24] xor pk[7];
// Round 2
s0 := t[t0 and $ff] xor t[$100+t1 shr 8 and $ff] xor t[$200+t2 shr 16 and $ff] xor t[$300+t3 shr 24] xor pk[8];
s1 := t[t1 and $ff] xor t[$100+t2 shr 8 and $ff] xor t[$200+t3 shr 16 and $ff] xor t[$300+t0 shr 24] xor pk[9];
s2 := t[t2 and $ff] xor t[$100+t3 shr 8 and $ff] xor t[$200+t0 shr 16 and $ff] xor t[$300+t1 shr 24] xor pk[10];
s3 := t[t3 and $ff] xor t[$100+t0 shr 8 and $ff] xor t[$200+t1 shr 16 and $ff] xor t[$300+t2 shr 24] xor pk[11];
// Round 3
t0 := t[s0 and $ff] xor t[$100+s1 shr 8 and $ff] xor t[$200+s2 shr 16 and $ff] xor t[$300+s3 shr 24] xor pk[12];
t1 := t[s1 and $ff] xor t[$100+s2 shr 8 and $ff] xor t[$200+s3 shr 16 and $ff] xor t[$300+s0 shr 24] xor pk[13];
t2 := t[s2 and $ff] xor t[$100+s3 shr 8 and $ff] xor t[$200+s0 shr 16 and $ff] xor t[$300+s1 shr 24] xor pk[14];
t3 := t[s3 and $ff] xor t[$100+s0 shr 8 and $ff] xor t[$200+s1 shr 16 and $ff] xor t[$300+s2 shr 24] xor pk[15];
// Round 4
s0 := t[t0 and $ff] xor t[$100+t1 shr 8 and $ff] xor t[$200+t2 shr 16 and $ff] xor t[$300+t3 shr 24] xor pk[16];
s1 := t[t1 and $ff] xor t[$100+t2 shr 8 and $ff] xor t[$200+t3 shr 16 and $ff] xor t[$300+t0 shr 24] xor pk[17];
s2 := t[t2 and $ff] xor t[$100+t3 shr 8 and $ff] xor t[$200+t0 shr 16 and $ff] xor t[$300+t1 shr 24] xor pk[18];
s3 := t[t3 and $ff] xor t[$100+t0 shr 8 and $ff] xor t[$200+t1 shr 16 and $ff] xor t[$300+t2 shr 24] xor pk[19];
// Round 5
t0 := t[s0 and $ff] xor t[$100+s1 shr 8 and $ff] xor t[$200+s2 shr 16 and $ff] xor t[$300+s3 shr 24] xor pk[20];
t1 := t[s1 and $ff] xor t[$100+s2 shr 8 and $ff] xor t[$200+s3 shr 16 and $ff] xor t[$300+s0 shr 24] xor pk[21];
t2 := t[s2 and $ff] xor t[$100+s3 shr 8 and $ff] xor t[$200+s0 shr 16 and $ff] xor t[$300+s1 shr 24] xor pk[22];
t3 := t[s3 and $ff] xor t[$100+s0 shr 8 and $ff] xor t[$200+s1 shr 16 and $ff] xor t[$300+s2 shr 24] xor pk[23];
// Round 6
s0 := t[t0 and $ff] xor t[$100+t1 shr 8 and $ff] xor t[$200+t2 shr 16 and $ff] xor t[$300+t3 shr 24] xor pk[24];
s1 := t[t1 and $ff] xor t[$100+t2 shr 8 and $ff] xor t[$200+t3 shr 16 and $ff] xor t[$300+t0 shr 24] xor pk[25];
s2 := t[t2 and $ff] xor t[$100+t3 shr 8 and $ff] xor t[$200+t0 shr 16 and $ff] xor t[$300+t1 shr 24] xor pk[26];
s3 := t[t3 and $ff] xor t[$100+t0 shr 8 and $ff] xor t[$200+t1 shr 16 and $ff] xor t[$300+t2 shr 24] xor pk[27];
// Round 7
t0 := t[s0 and $ff] xor t[$100+s1 shr 8 and $ff] xor t[$200+s2 shr 16 and $ff] xor t[$300+s3 shr 24] xor pk[28];
t1 := t[s1 and $ff] xor t[$100+s2 shr 8 and $ff] xor t[$200+s3 shr 16 and $ff] xor t[$300+s0 shr 24] xor pk[29];
t2 := t[s2 and $ff] xor t[$100+s3 shr 8 and $ff] xor t[$200+s0 shr 16 and $ff] xor t[$300+s1 shr 24] xor pk[30];
t3 := t[s3 and $ff] xor t[$100+s0 shr 8 and $ff] xor t[$200+s1 shr 16 and $ff] xor t[$300+s2 shr 24] xor pk[31];
// Round 8
s0 := t[t0 and $ff] xor t[$100+t1 shr 8 and $ff] xor t[$200+t2 shr 16 and $ff] xor t[$300+t3 shr 24] xor pk[32];
s1 := t[t1 and $ff] xor t[$100+t2 shr 8 and $ff] xor t[$200+t3 shr 16 and $ff] xor t[$300+t0 shr 24] xor pk[33];
s2 := t[t2 and $ff] xor t[$100+t3 shr 8 and $ff] xor t[$200+t0 shr 16 and $ff] xor t[$300+t1 shr 24] xor pk[34];
s3 := t[t3 and $ff] xor t[$100+t0 shr 8 and $ff] xor t[$200+t1 shr 16 and $ff] xor t[$300+t2 shr 24] xor pk[35];
// Round 9
t0 := t[s0 and $ff] xor t[$100+s1 shr 8 and $ff] xor t[$200+s2 shr 16 and $ff] xor t[$300+s3 shr 24] xor pk[36];
t1 := t[s1 and $ff] xor t[$100+s2 shr 8 and $ff] xor t[$200+s3 shr 16 and $ff] xor t[$300+s0 shr 24] xor pk[37];
t2 := t[s2 and $ff] xor t[$100+s3 shr 8 and $ff] xor t[$200+s0 shr 16 and $ff] xor t[$300+s1 shr 24] xor pk[38];
t3 := t[s3 and $ff] xor t[$100+s0 shr 8 and $ff] xor t[$200+s1 shr 16 and $ff] xor t[$300+s2 shr 24] xor pk[39];
if ctxt.rounds>10 then begin
// Round 10
s0 := t[t0 and $ff] xor t[$100+t1 shr 8 and $ff] xor t[$200+t2 shr 16 and $ff] xor t[$300+t3 shr 24] xor pk[40];
s1 := t[t1 and $ff] xor t[$100+t2 shr 8 and $ff] xor t[$200+t3 shr 16 and $ff] xor t[$300+t0 shr 24] xor pk[41];
s2 := t[t2 and $ff] xor t[$100+t3 shr 8 and $ff] xor t[$200+t0 shr 16 and $ff] xor t[$300+t1 shr 24] xor pk[42];
s3 := t[t3 and $ff] xor t[$100+t0 shr 8 and $ff] xor t[$200+t1 shr 16 and $ff] xor t[$300+t2 shr 24] xor pk[43];
// Round 11
t0 := t[s0 and $ff] xor t[$100+s1 shr 8 and $ff] xor t[$200+s2 shr 16 and $ff] xor t[$300+s3 shr 24] xor pk[44];
t1 := t[s1 and $ff] xor t[$100+s2 shr 8 and $ff] xor t[$200+s3 shr 16 and $ff] xor t[$300+s0 shr 24] xor pk[45];
t2 := t[s2 and $ff] xor t[$100+s3 shr 8 and $ff] xor t[$200+s0 shr 16 and $ff] xor t[$300+s1 shr 24] xor pk[46];
t3 := t[s3 and $ff] xor t[$100+s0 shr 8 and $ff] xor t[$200+s1 shr 16 and $ff] xor t[$300+s2 shr 24] xor pk[47];
if ctxt.rounds>12 then begin
// Round 12
s0 := t[t0 and $ff] xor t[$100+t1 shr 8 and $ff] xor t[$200+t2 shr 16 and $ff] xor t[$300+t3 shr 24] xor pk[48];
s1 := t[t1 and $ff] xor t[$100+t2 shr 8 and $ff] xor t[$200+t3 shr 16 and $ff] xor t[$300+t0 shr 24] xor pk[49];
s2 := t[t2 and $ff] xor t[$100+t3 shr 8 and $ff] xor t[$200+t0 shr 16 and $ff] xor t[$300+t1 shr 24] xor pk[50];
s3 := t[t3 and $ff] xor t[$100+t0 shr 8 and $ff] xor t[$200+t1 shr 16 and $ff] xor t[$300+t2 shr 24] xor pk[51];
// Round 13
t0 := t[s0 and $ff] xor t[$100+s1 shr 8 and $ff] xor t[$200+s2 shr 16 and $ff] xor t[$300+s3 shr 24] xor pk[52];
t1 := t[s1 and $ff] xor t[$100+s2 shr 8 and $ff] xor t[$200+s3 shr 16 and $ff] xor t[$300+s0 shr 24] xor pk[53];
t2 := t[s2 and $ff] xor t[$100+s3 shr 8 and $ff] xor t[$200+s0 shr 16 and $ff] xor t[$300+s1 shr 24] xor pk[54];
t3 := t[s3 and $ff] xor t[$100+s0 shr 8 and $ff] xor t[$200+s1 shr 16 and $ff] xor t[$300+s2 shr 24] xor pk[55];
end;
end;
inc(PByte(pK), ctxt.rounds shl 4);
bo[0] := ((SBox[t0 and $ff]) xor
(SBox[t1 shr 8 and $ff]) shl 8 xor
(SBox[t2 shr 16 and $ff]) shl 16 xor
(SBox[t3 shr 24]) shl 24 ) xor pk[0];
bo[1] := ((SBox[t1 and $ff]) xor
(SBox[t2 shr 8 and $ff]) shl 8 xor
(SBox[t3 shr 16 and $ff]) shl 16 xor
(SBox[t0 shr 24]) shl 24 ) xor pk[1];
bo[2] := ((SBox[t2 and $ff]) xor
(SBox[t3 shr 8 and $ff]) shl 8 xor
(SBox[t0 shr 16 and $ff]) shl 16 xor
(SBox[t1 shr 24]) shl 24 ) xor pk[2];
bo[3] := ((SBox[t3 and $ff]) xor
(SBox[t0 shr 8 and $ff]) shl 8 xor
(SBox[t1 shr 16 and $ff]) shl 16 xor
(SBox[t2 shr 24]) shl 24 ) xor pk[3];
{$endif}
end;
{$ifdef USEPADLOCK}
procedure aesencryptpadlock(const ctxt: TAESContext; bi, bo: PWA4);
begin
padlock_aes_encrypt(ctxt.ViaCtx,bi,bo,16);
end;
{$endif}
{$ifdef CPUX64}
procedure aesencryptx64(const ctxt: TAESContext; bi, bo: PWA4);
{$ifdef FPC}nostackframe; assembler; asm{$else}
asm // input: rcx/rdi=TAESContext, rdx/rsi=source, r8/rdx=dest
.noframe
{$endif} // rolled optimized encryption asm version by A. Bouchez
push r15
push r14
push r13
push r12
push rbx
push rbp
{$ifdef win64}
push rdi
push rsi
mov r15, r8
mov r12, rcx
{$else}
mov r15, rdx
mov rdx, rsi
mov r12, rdi
{$endif win64}
movzx r13, byte ptr [r12].TAESContext.Rounds
mov eax, dword ptr [rdx]
mov ebx, dword ptr [rdx+4H]
mov ecx, dword ptr [rdx+8H]
mov edx, dword ptr [rdx+0CH]
xor eax, dword ptr [r12]
xor ebx, dword ptr [r12+4H]
xor ecx, dword ptr [r12+8H]
xor edx, dword ptr [r12+0CH]
sub r13, 1
add r12, 16
lea r14, [rip+Te0]
{$ifdef FPC} align 16 {$else} .align 16 {$endif}
@round: mov esi, eax
mov edi, edx
movzx r8d, al
movzx r9d, cl
movzx r10d, bl
mov r8d, dword ptr [r14+r8*4]
mov r9d, dword ptr [r14+r9*4]
mov r10d, dword ptr [r14+r10*4]
shr esi, 16
shr edi, 16
movzx ebp, bh
xor r8d, dword ptr [r14+rbp*4+400H]
movzx ebp, dh
xor r9d, dword ptr [r14+rbp*4+400H]
movzx ebp, ch
xor r10d, dword ptr [r14+rbp*4+400H]
shr ebx, 16
shr ecx, 16
movzx ebp, dl
mov edx, dword ptr [r14+rbp*4]
movzx ebp, cl
xor r8d, dword ptr [r14+rbp*4+800H]
movzx ebp, sil
xor r9d, dword ptr [r14+rbp*4+800H]
movzx r11, dil
movzx eax, ah
shr edi, 8
movzx ebp, bh
shr esi, 8
xor r10d, dword ptr [r14+r11*4+800H]
xor edx, dword ptr [r14+rax*4+400H]
xor r8d, dword ptr [r14+rdi*4+0C00H]
xor r9d, dword ptr [r14+rbp*4+0C00H]
xor r10d, dword ptr [r14+rsi*4+0C00H]
movzx ebp, bl
xor edx, dword ptr [r14+rbp*4+800H]
mov rbx, r10
mov rax, r8
movzx ebp, ch
xor edx, dword ptr [r14+rbp*4+0C00H]
mov rcx, r9
xor eax, dword ptr [r12]
xor ebx, dword ptr [r12+4H]
xor ecx, dword ptr [r12+8H]
xor edx, dword ptr [r12+0CH]
add r12, 16
sub r13, 1
jnz @round
lea r9, [rip+SBox]
movzx r8, al
movzx r14, byte ptr [r9+r8]
movzx edi, bh
movzx r8, byte ptr [r9+rdi]
shl r8d, 8
xor r14d, r8d
mov r11, rcx
shr r11, 16
and r11, 0FFH
movzx r8, byte ptr [r9+r11]
shl r8d, 16
xor r14d, r8d
mov r11, rdx
shr r11, 24
movzx r8, byte ptr [r9+r11]
shl r8d, 24
xor r14d, r8d
xor r14d, dword ptr [r12]
mov dword ptr [r15], r14d
movzx r8, bl
movzx r14, byte ptr [r9+r8]
movzx edi, ch
movzx r8, byte ptr [r9+rdi]
shl r8d, 8
xor r14d, r8d
mov r11, rdx
shr r11, 16
and r11, 0FFH
movzx r8, byte ptr [r9+r11]
shl r8d, 16
xor r14d, r8d
mov r11, rax
shr r11, 24
movzx r8, byte ptr [r9+r11]
shl r8d, 24
xor r14d, r8d
xor r14d, dword ptr [r12+4H]
mov dword ptr [r15+4H], r14d
movzx r8, cl
movzx r14, byte ptr [r9+r8]
movzx edi, dh
movzx r8, byte ptr [r9+rdi]
shl r8d, 8
xor r14d, r8d
mov r11, rax
shr r11, 16
and r11, 0FFH
movzx r8, byte ptr [r9+r11]
shl r8d, 16
xor r14d, r8d
mov r11, rbx
shr r11, 24
movzx r8, byte ptr [r9+r11]
shl r8d, 24
xor r14d, r8d
xor r14d, dword ptr [r12+8H]
mov dword ptr [r15+8H], r14d
and rdx, 0FFH
movzx r14, byte ptr [r9+rdx]
movzx eax, ah
movzx r8, byte ptr [r9+rax]
shl r8d, 8
xor r14d, r8d
shr rbx, 16
and rbx, 0FFH
movzx r8, byte ptr [r9+rbx]
shl r8d, 16
xor r14d, r8d
shr rcx, 24
movzx r8, byte ptr [r9+rcx]
shl r8d, 24
xor r14d, r8d
xor r14d, dword ptr [r12+0CH]
mov dword ptr [r15+0CH], r14d
{$ifdef win64}
pop rsi
pop rdi
{$endif win64}
pop rbp
pop rbx
pop r12
pop r13
pop r14
pop r15
end;
{$endif CPUX64}
{$ifdef CPUX86_NOTPIC}
procedure aesencrypt386(const ctxt: TAESContext; bi, bo: PWA4);
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // rolled optimized encryption asm version by A. Bouchez
push ebx
push esi
push edi
push ebp
add esp, - 24
mov [esp + 4], ecx
mov ecx, eax // ecx=pk
movzx eax, byte ptr[eax].taescontext.rounds
dec eax
mov [esp + 20], eax
mov ebx, [edx]
xor ebx, [ecx]
mov esi, [edx + 4]
xor esi, [ecx + 4]
mov eax, [edx + 8]
xor eax, [ecx + 8]
mov edx, [edx + 12]
xor edx, [ecx + 12]
lea ecx, [ecx + 16]
@1: // pk=ecx s0=ebx s1=esi s2=eax s3=edx
movzx edi, bl
mov edi, dword ptr[4 * edi + te0]
movzx ebp, si
shr ebp, $08
xor edi, dword ptr[4 * ebp + te1]
mov ebp, eax
shr ebp, $10
and ebp, $ff
xor edi, dword ptr[4 * ebp + te2]
mov ebp, edx
shr ebp, $18
xor edi, dword ptr[4 * ebp + te3]
mov [esp + 8], edi
mov edi, esi
and edi, 255
mov edi, dword ptr[4 * edi + te0]
movzx ebp, ax
shr ebp, $08
xor edi, dword ptr[4 * ebp + te1]
mov ebp, edx
shr ebp, $10
and ebp, 255
xor edi, dword ptr[4 * ebp + te2]
mov ebp, ebx
shr ebp, $18
xor edi, dword ptr[4 * ebp + te3]
mov [esp + 12], edi
movzx edi, al
mov edi, dword ptr[4 * edi + te0]
movzx ebp, dh
xor edi, dword ptr[4 * ebp + te1]
mov ebp, ebx
shr ebp, $10
and ebp, 255
xor edi, dword ptr[4 * ebp + te2]
mov ebp, esi
shr ebp, $18
xor edi, dword ptr[4 * ebp + te3]
mov [esp + 16], edi
and edx, 255
mov edx, dword ptr[4 * edx + te0]
shr ebx, $08
and ebx, 255
xor edx, dword ptr[4 * ebx + te1]
shr esi, $10
and esi, 255
xor edx, dword ptr[4 * esi + te2]
shr eax, $18
xor edx, dword ptr[4 * eax + te3]
mov ebx, [ecx]
xor ebx, [esp + 8]
mov esi, [ecx + 4]
xor esi, [esp + 12]
mov eax, [ecx + 8]
xor eax, [esp + 16]
xor edx, [ecx + 12]
lea ecx, [ecx + 16]
dec byte ptr[esp + 20]
jne @1
mov ebp, ecx // ebp=pk
movzx ecx, bl
mov edi, esi
movzx ecx, byte ptr[ecx + SBox]
shr edi, $08
and edi, 255
movzx edi, byte ptr[edi + SBox]
shl edi, $08
xor ecx, edi
mov edi, eax
shr edi, $10
and edi, 255
movzx edi, byte ptr[edi + SBox]
shl edi, $10
xor ecx, edi
mov edi, edx
shr edi, $18
movzx edi, byte ptr[edi + SBox]
shl edi, $18
xor ecx, edi
xor ecx, [ebp]
mov edi, [esp + 4]
mov [edi], ecx
mov ecx, esi
and ecx, 255
movzx ecx, byte ptr[ecx + SBox]
movzx edi, ah
movzx edi, byte ptr[edi + SBox]
shl edi, $08
xor ecx, edi
mov edi, edx
shr edi, $10
and edi, 255
movzx edi, byte ptr[edi + SBox]
shl edi, $10
xor ecx, edi
mov edi, ebx
shr edi, $18
movzx edi, byte ptr[edi + SBox]
shl edi, $18
xor ecx, edi
xor ecx, [ebp + 4]
mov edi, [esp + 4]
mov [edi + 4], ecx
mov ecx, eax
and ecx, 255
movzx ecx, byte ptr[ecx + SBox]
movzx edi, dh
movzx edi, byte ptr[edi + SBox]
shl edi, $08
xor ecx, edi
mov edi, ebx
shr edi, $10
and edi, 255
movzx edi, byte ptr[edi + SBox]
shl edi, $10
xor ecx, edi
mov edi, esi
shr edi, $18
movzx edi, byte ptr[edi + SBox]
shl edi, $18
xor ecx, edi
xor ecx, [ebp + 8]
mov edi, [esp + 4]
mov [edi + 8], ecx
and edx, 255
movzx edx, byte ptr[edx + SBox]
shr ebx, $08
and ebx, 255
xor ecx, ecx
mov cl, byte ptr[ebx + SBox]
shl ecx, $08
xor edx, ecx
shr esi, $10
and esi, 255
xor ecx, ecx
mov cl, byte ptr[esi + SBox]
shl ecx, $10
xor edx, ecx
shr eax, $18
movzx eax, byte ptr[eax + SBox]
shl eax, $18
xor edx, eax
xor edx, [ebp + 12]
mov eax, [esp + 4]
mov [eax + 12], edx
add esp, 24
pop ebp
pop edi
pop esi
pop ebx
end;
{$endif CPUX86_NOTPIC}
procedure TAES.Encrypt(const BI: TAESBlock; var BO: TAESBlock);
begin
TAESContext(Context).DoBlock(Context,BI,BO);
end;
{$ifdef USEAESNI} // should be put outside the main method for FPC :(
procedure ShiftAesNi(KeySize: cardinal; pk: pointer);
{$ifdef CPU32} {$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=KeySize edx=pk
movups xmm1, [edx]
movups xmm5, dqword ptr[@mask]
cmp al, 128
je @128
cmp al, 192
je @e // 192 bits is very complicated -> skip by now (use 128+256)
@256: movups xmm3, [edx + 16]
add edx, 32
db $66, $0F, $3A, $DF, $D3, $01 // aeskeygenassist xmm2,xmm3,1
call @exp256
db $66, $0F, $3A, $DF, $D3, $02 // aeskeygenassist xmm2,xmm3,2
call @exp256
db $66, $0F, $3A, $DF, $D3, $04 // aeskeygenassist xmm2,xmm3,4
call @exp256
db $66, $0F, $3A, $DF, $D3, $08 // aeskeygenassist xmm2,xmm3,8
call @exp256
db $66, $0F, $3A, $DF, $D3, $10 // aeskeygenassist xmm2,xmm3,$10
call @exp256
db $66, $0F, $3A, $DF, $D3, $20 // aeskeygenassist xmm2,xmm3,$20
call @exp256
db $66, $0F, $3A, $DF, $D3, $40 // aeskeygenassist xmm2,xmm3,$40
pshufd xmm2, xmm2, $FF
movups xmm4, xmm1
db $66, $0F, $38, $00, $E5 // pshufb xmm4,xmm5
pxor xmm1, xmm4
db $66, $0F, $38, $00, $E5 // pshufb xmm4,xmm5
pxor xmm1, xmm4
db $66, $0F, $38, $00, $E5 // pshufb xmm4,xmm5
pxor xmm1, xmm4
pxor xmm1, xmm2
movups [edx], xmm1
jmp @e
@mask: dd $ffffffff
dd $03020100
dd $07060504
dd $0b0a0908
@exp256:pshufd xmm2, xmm2, $ff
movups xmm4, xmm1
db $66, $0F, $38, $00, $E5 // pshufb xmm4,xmm5
pxor xmm1, xmm4
db $66, $0F, $38, $00, $E5 // pshufb xmm4,xmm5
pxor xmm1, xmm4
db $66, $0F, $38, $00, $E5 // pshufb xmm4,xmm5
pxor xmm1, xmm4
pxor xmm1, xmm2
movups [edx], xmm1
add edx, $10
db $66, $0F, $3A, $DF, $E1, $00 // aeskeygenassist xmm4,xmm1,0
pshufd xmm2, xmm4, $AA
movups xmm4, xmm3
db $66, $0F, $38, $00, $E5 // pshufb xmm4,xmm5
pxor xmm3, xmm4
db $66, $0F, $38, $00, $E5 // pshufb xmm4,xmm5
pxor xmm3, xmm4
db $66, $0F, $38, $00, $E5 // pshufb xmm4,xmm5
pxor xmm3, xmm4
pxor xmm3, xmm2
movups [edx], xmm3
add edx, $10
ret
@exp128:pshufd xmm2, xmm2, $FF
movups xmm3, xmm1
db $66, $0F, $38, $00, $DD // pshufb xmm3,xmm5
pxor xmm1, xmm3
db $66, $0F, $38, $00, $DD // pshufb xmm3,xmm5
pxor xmm1, xmm3
db $66, $0F, $38, $00, $DD // pshufb xmm3,xmm5
pxor xmm1, xmm3
pxor xmm1, xmm2
movups [edx], xmm1
add edx, $10
ret
@128: add edx, 16
db $66, $0F, $3A, $DF, $D1, $01 // aeskeygenassist xmm2,xmm1,1
call @exp128
db $66, $0F, $3A, $DF, $D1, $02 // aeskeygenassist xmm2,xmm1,2
call @exp128
db $66, $0F, $3A, $DF, $D1, $04 // aeskeygenassist xmm2,xmm1,4
call @exp128
db $66, $0F, $3A, $DF, $D1, $08 // aeskeygenassist xmm2,xmm1,8
call @exp128
db $66, $0F, $3A, $DF, $D1, $10 // aeskeygenassist xmm2,xmm1,$10
call @exp128
db $66, $0F, $3A, $DF, $D1, $20 // aeskeygenassist xmm2,xmm1,$20
call @exp128
db $66, $0F, $3A, $DF, $D1, $40 // aeskeygenassist xmm2,xmm1,$40
call @exp128
db $66, $0F, $3A, $DF, $D1, $80 // aeskeygenassist xmm2,xmm1,$80
call @exp128
db $66, $0F, $3A, $DF, $D1, $1b // aeskeygenassist xmm2,xmm1,$1b
call @exp128
db $66, $0F, $3A, $DF, $D1, $36 // aeskeygenassist xmm2,xmm1,$36
call @exp128
@e: db $f3 // rep ret
end;
{$endif CPU32}
{$ifdef CPU64}
{$ifdef FPC} nostackframe; assembler; asm {$else} asm .noframe {$endif}
mov eax, keysize
movups xmm1, dqword ptr[pk]
movaps xmm5, dqword ptr[rip + @mask]
cmp al, 128
je @128
cmp al, 192
je @e // 192 bits is very complicated -> skip by now (128+256)
@256: movups xmm3, dqword ptr[pk + 16]
add pk, 32
aeskeygenassist xmm2, xmm3, 1
call @exp256
aeskeygenassist xmm2, xmm3, 2
call @exp256
aeskeygenassist xmm2, xmm3, 4
call @exp256
aeskeygenassist xmm2, xmm3, 8
call @exp256
aeskeygenassist xmm2, xmm3, $10
call @exp256
aeskeygenassist xmm2, xmm3, $20
call @exp256
aeskeygenassist xmm2, xmm3, $40
pshufd xmm2, xmm2, $FF
movups xmm4, xmm1
pshufb xmm4, xmm5
pxor xmm1, xmm4
pshufb xmm4, xmm5
pxor xmm1, xmm4
pshufb xmm4, xmm5
pxor xmm1, xmm4
pxor xmm1, xmm2
movups dqword ptr[pk], xmm1
jmp @e
{$ifdef FPC} align 16 {$else} .align 16 {$endif}
@mask: dd $ffffffff
dd $03020100
dd $07060504
dd $0b0a0908
@exp256:pshufd xmm2, xmm2, $ff
movups xmm4, xmm1
pshufb xmm4, xmm5
pxor xmm1, xmm4
pshufb xmm4, xmm5
pxor xmm1, xmm4
pshufb xmm4, xmm5
pxor xmm1, xmm4
pxor xmm1, xmm2
movups dqword ptr[pk], xmm1
add pk, $10
aeskeygenassist xmm4, xmm1, 0
pshufd xmm2, xmm4, $AA
movups xmm4, xmm3
pshufb xmm4, xmm5
pxor xmm3, xmm4
pshufb xmm4, xmm5
pxor xmm3, xmm4
pshufb xmm4, xmm5
pxor xmm3, xmm4
pxor xmm3, xmm2
movups dqword ptr[pk], xmm3
add pk, $10
@e: ret
@exp128:pshufd xmm2, xmm2, $FF
movups xmm3, xmm1
pshufb xmm3, xmm5
pxor xmm1, xmm3
pshufb xmm3, xmm5
pxor xmm1, xmm3
pshufb xmm3, xmm5
pxor xmm1, xmm3
pxor xmm1, xmm2
movups dqword ptr[pk], xmm1
add pk, $10
ret
@128: add pk, 16
aeskeygenassist xmm2, xmm1, 1
call @exp128
aeskeygenassist xmm2, xmm1, 2
call @exp128
aeskeygenassist xmm2, xmm1, 4
call @exp128
aeskeygenassist xmm2, xmm1, 8
call @exp128
aeskeygenassist xmm2, xmm1, $10
call @exp128
aeskeygenassist xmm2, xmm1, $20
call @exp128
aeskeygenassist xmm2, xmm1, $40
call @exp128
aeskeygenassist xmm2, xmm1, $80
call @exp128
aeskeygenassist xmm2, xmm1, $1b
call @exp128
aeskeygenassist xmm2, xmm1, $36
call @exp128
end;
{$endif CPU64}
{$endif USEAESNI}
function TAES.EncryptInit(const Key; KeySize: cardinal): boolean;
procedure Shift(KeySize: cardinal; pk: PAWK);
var i: integer;
temp: cardinal;
begin
// 32 bit use shift and mask
case KeySize of
128:
for i := 0 to 9 do begin
temp := pK^[3];
// SubWord(RotWord(temp)) if "word" count mod 4 = 0
pK^[4] := ((SBox[(temp shr 8) and $ff]) ) xor
((SBox[(temp shr 16) and $ff]) shl 8) xor
((SBox[(temp shr 24) ]) shl 16) xor
((SBox[(temp ) and $ff]) shl 24) xor
pK^[0] xor RCon[i];
pK^[5] := pK^[1] xor pK^[4];
pK^[6] := pK^[2] xor pK^[5];
pK^[7] := pK^[3] xor pK^[6];
inc(PByte(pK),4*4);
end;
192:
for i := 0 to 7 do begin
temp := pK^[5];
// SubWord(RotWord(temp)) if "word" count mod 6 = 0
pK^[ 6] := ((SBox[(temp shr 8) and $ff]) ) xor
((SBox[(temp shr 16) and $ff]) shl 8) xor
((SBox[(temp shr 24) ]) shl 16) xor
((SBox[(temp ) and $ff]) shl 24) xor
pK^[0] xor RCon[i];
pK^[ 7] := pK^[1] xor pK^[6];
pK^[ 8] := pK^[2] xor pK^[7];
pK^[ 9] := pK^[3] xor pK^[8];
if i=7 then exit;
pK^[10] := pK^[4] xor pK^[ 9];
pK^[11] := pK^[5] xor pK^[10];
inc(PByte(pK),6*4);
end;
else // 256:
for i := 0 to 6 do begin
temp := pK^[7];
// SubWord(RotWord(temp)) if "word" count mod 8 = 0
pK^[ 8] := ((SBox[(temp shr 8) and $ff]) ) xor
((SBox[(temp shr 16) and $ff]) shl 8) xor
((SBox[(temp shr 24) ]) shl 16) xor
((SBox[(temp ) and $ff]) shl 24) xor
pK^[0] xor RCon[i];
pK^[ 9] := pK^[1] xor pK^[ 8];
pK^[10] := pK^[2] xor pK^[ 9];
pK^[11] := pK^[3] xor pK^[10];
if i=6 then exit;
temp := pK^[11];
// SubWord(temp) if "word" count mod 8 = 4
pK^[12] := ((SBox[(temp ) and $ff]) ) xor
((SBox[(temp shr 8) and $ff]) shl 8) xor
((SBox[(temp shr 16) and $ff]) shl 16) xor
((SBox[(temp shr 24) ]) shl 24) xor
pK^[4];
pK^[13] := pK^[5] xor pK^[12];
pK^[14] := pK^[6] xor pK^[13];
pK^[15] := pK^[7] xor pK^[14];
inc(PByte(pK),8*4);
end;
end;
end;
var Nk: integer;
ctx: TAESContext absolute Context;
begin
result := true;
ctx.Initialized := true;
{$ifdef USEPADLOCK}
if DoPadlockInit(Key,KeySize) then begin
ctx.DoBlock := @aesencryptpadlock;
exit; // Init OK
end;
{$endif}
if (KeySize<>128) and (KeySize<>192) and (KeySize<>256) then begin
result := false;
ctx.Initialized := false;
exit;
end;
Nk := KeySize div 32;
MoveFast(Key, ctx.RK, 4*Nk);
// aes128ofb: aesencryptpas=140MB/s aesencryptx64=200MB/s aesniencrypt=500MB/s
{$ifdef CPUX64}
ctx.DoBlock := @aesencryptx64;
{$else}
{$ifdef CPUX86_NOTPIC}
ctx.DoBlock := @aesencrypt386;
{$else}
ctx.DoBlock := @aesencryptpas;
{$endif}
{$endif}
{$ifdef CPUINTEL}
{$ifdef USEAESNI}
if cfAESNI in CpuFeatures then begin
case KeySize of
128: ctx.DoBlock := @aesniencrypt128;
192: ctx.DoBlock := @aesniencrypt192;
256: ctx.DoBlock := @aesniencrypt256;
end;
{$ifdef USEAESNI32}
case KeySize of
128: ctx.AesNi32 := @AesNiEncryptXmm7_128;
192: ctx.AesNi32 := @AesNiEncryptXmm7_192;
256: ctx.AesNi32 := @AesNiEncryptXmm7_256;
end;
{$endif}
end;
{$endif}
{$endif}
ctx.Rounds := 6+Nk;
ctx.KeyBits := KeySize;
// Calculate encryption round keys
{$ifdef USEAESNI} // 192 is more complex and seldom used -> skip to pascal
if (KeySize<>192) and (cfAESNI in CpuFeatures) then
ShiftAesNi(KeySize,@ctx.RK) else
{$endif}
Shift(KeySize,pointer(@ctx.RK));
end;
{$ifdef USEAESNI} // should be put outside the main method for FPC :(
{$ifdef CPU32}
procedure MakeDecrKeyAesNi(Rounds: integer; RK: Pointer);
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=Rounds edx=RK
sub eax, 9
movups xmm0, [edx + $10]
movups xmm1, [edx + $20]
movups xmm2, [edx + $30]
movups xmm3, [edx + $40]
movups xmm4, [edx + $50]
movups xmm5, [edx + $60]
movups xmm6, [edx + $70]
movups xmm7, [edx + $80]
{$ifdef HASAESNI}
aesimc xmm0, xmm0
aesimc xmm1, xmm1
aesimc xmm2, xmm2
aesimc xmm3, xmm3
aesimc xmm4, xmm4
aesimc xmm5, xmm5
aesimc xmm6, xmm6
aesimc xmm7, xmm7
{$else}
db $66, $0F, $38, $DB, $C0
db $66, $0F, $38, $DB, $C9
db $66, $0F, $38, $DB, $D2
db $66, $0F, $38, $DB, $DB
db $66, $0F, $38, $DB, $E4
db $66, $0F, $38, $DB, $ED
db $66, $0F, $38, $DB, $F6
db $66, $0F, $38, $DB, $FF
{$endif}
movups [edx + $10], xmm0
movups [edx + $20], xmm1
movups [edx + $30], xmm2
movups [edx + $40], xmm3
movups [edx + $50], xmm4
movups [edx + $60], xmm5
movups [edx + $70], xmm6
movups [edx + $80], xmm7
lea edx, [edx + $90]
@loop: movups xmm0, [edx]
db $66, $0F, $38, $DB, $C0 // aesimc xmm0,xmm0
movups [edx], xmm0
dec eax
lea edx, [edx + 16]
jnz @loop
end;
{$endif CPU32}
{$ifdef CPU64}
procedure MakeDecrKeyAesNi(Rounds: integer; RK: Pointer);
{$ifdef FPC} nostackframe; assembler; asm {$else} asm .noframe {$endif}
mov eax, Rounds
sub eax, 9
movups xmm0, dqword ptr[RK + $10]
movups xmm1, dqword ptr[RK + $20]
movups xmm2, dqword ptr[RK + $30]
movups xmm3, dqword ptr[RK + $40]
movups xmm4, dqword ptr[RK + $50]
movups xmm5, dqword ptr[RK + $60]
movups xmm6, dqword ptr[RK + $70]
movups xmm7, dqword ptr[RK + $80]
aesimc xmm0, xmm0
aesimc xmm1, xmm1
aesimc xmm2, xmm2
aesimc xmm3, xmm3
aesimc xmm4, xmm4
aesimc xmm5, xmm5
aesimc xmm6, xmm6
aesimc xmm7, xmm7
movups dqword ptr[RK + $10], xmm0
movups dqword ptr[RK + $20], xmm1
movups dqword ptr[RK + $30], xmm2
movups dqword ptr[RK + $40], xmm3
movups dqword ptr[RK + $50], xmm4
movups dqword ptr[RK + $60], xmm5
movups dqword ptr[RK + $70], xmm6
movups dqword ptr[RK + $80], xmm7
lea RK, [RK + $90]
@loop: movups xmm0, dqword ptr[RK]
aesimc xmm0, xmm0
movups dqword ptr[RK], xmm0
dec eax
lea RK, [RK + 16]
jnz @loop
end;
{$endif CPU64}
{$endif USEAESNI}
{$ifdef USEPADLOCK}
procedure aesdecryptpadlock(const ctxt: TAESContext; bi, bo: PWA4);
begin
padlock_aes_decrypt(ctxt.ViaCtx,bi,bo,16);
end;
{$endif}
procedure aesdecryptpas(const ctxt: TAESContext; bi, bo: PWA4);
var
{$ifdef AES_ROLLED}
s0,s1,s2,s3: PtrUInt; // TAESBlock s# as separate variables
t0,t1,t2: cardinal; // TAESBlock t# as separate variables
i: integer;
pk: PWA4;
{$else}
s0,s1,s2,s3,t0,t1,t2,t3: cardinal; // TAESBlock s#/t# as separate variables
pk: PAWk; // pointer to loop rount key
{$endif}
t: PCardinalArray; // faster on a PIC system
begin
t := @Td0;
{$ifdef AES_ROLLED}
// Wolfgang Ehrhardt rolled version - faster on modern CPU than unrolled one below
// Setup key pointer
pk := PWA4(@ctxt.RK[ctxt.Rounds]);
// Initialize with input block
s0 := bi[0] xor pk[0];
s1 := bi[1] xor pk[1];
s2 := bi[2] xor pk[2];
s3 := bi[3] xor pk[3];
dec(pk);
for I := 1 to ctxt.Rounds-1 do begin
t0 := t[s0 and $ff] xor t[$100+s3 shr 8 and $ff] xor t[$200+s2 shr 16 and $ff] xor t[$300+s1 shr 24];
t1 := t[s1 and $ff] xor t[$100+s0 shr 8 and $ff] xor t[$200+s3 shr 16 and $ff] xor t[$300+s2 shr 24];
t2 := t[s2 and $ff] xor t[$100+s1 shr 8 and $ff] xor t[$200+s0 shr 16 and $ff] xor t[$300+s3 shr 24];
s3 := t[s3 and $ff] xor t[$100+s2 shr 8 and $ff] xor t[$200+s1 shr 16 and $ff] xor t[$300+s0 shr 24] xor pk[3];
s0 := t0 xor pk[0];
s1 := t1 xor pk[1];
s2 := t2 xor pk[2];
dec(pk);
end;
bo[0] := ((InvSBox[s0 and $ff]) xor
(InvSBox[s3 shr 8 and $ff]) shl 8 xor
(InvSBox[s2 shr 16 and $ff]) shl 16 xor
(InvSBox[s1 shr 24]) shl 24 ) xor pk[0];
bo[1] := ((InvSBox[s1 and $ff]) xor
(InvSBox[s0 shr 8 and $ff]) shl 8 xor
(InvSBox[s3 shr 16 and $ff]) shl 16 xor
(InvSBox[s2 shr 24]) shl 24 ) xor pk[1];
bo[2] := ((InvSBox[s2 and $ff]) xor
(InvSBox[s1 shr 8 and $ff]) shl 8 xor
(InvSBox[s0 shr 16 and $ff]) shl 16 xor
(InvSBox[s3 shr 24]) shl 24 ) xor pk[2];
bo[3] := ((InvSBox[s3 and $ff]) xor
(InvSBox[s2 shr 8 and $ff]) shl 8 xor
(InvSBox[s1 shr 16 and $ff]) shl 16 xor
(InvSBox[s0 shr 24]) shl 24 ) xor pk[3];
{$else} // unrolled version (WE6) from Wolfgang Ehrhardt - slower
// Setup key pointer
pk := PAWk(@ctxt.RK);
// Initialize with input block
s0 := bi[0] xor pk[0];
s1 := bi[1] xor pk[1];
s2 := bi[2] xor pk[2];
s3 := bi[3] xor pk[3];
// Round 1
t0 := t[s0 and $ff] xor t[$100+s3 shr 8 and $ff] xor t[$200+s2 shr 16 and $ff] xor t[$300+s1 shr 24] xor pk[4];
t1 := t[s1 and $ff] xor t[$100+s0 shr 8 and $ff] xor t[$200+s3 shr 16 and $ff] xor t[$300+s2 shr 24] xor pk[5];
t2 := t[s2 and $ff] xor t[$100+s1 shr 8 and $ff] xor t[$200+s0 shr 16 and $ff] xor t[$300+s3 shr 24] xor pk[6];
t3 := t[s3 and $ff] xor t[$100+s2 shr 8 and $ff] xor t[$200+s1 shr 16 and $ff] xor t[$300+s0 shr 24] xor pk[7];
// Round 2
s0 := t[t0 and $ff] xor t[$100+t3 shr 8 and $ff] xor t[$200+t2 shr 16 and $ff] xor t[$300+t1 shr 24] xor pk[8];
s1 := t[t1 and $ff] xor t[$100+t0 shr 8 and $ff] xor t[$200+t3 shr 16 and $ff] xor t[$300+t2 shr 24] xor pk[9];
s2 := t[t2 and $ff] xor t[$100+t1 shr 8 and $ff] xor t[$200+t0 shr 16 and $ff] xor t[$300+t3 shr 24] xor pk[10];
s3 := t[t3 and $ff] xor t[$100+t2 shr 8 and $ff] xor t[$200+t1 shr 16 and $ff] xor t[$300+t0 shr 24] xor pk[11];
// Round 3
t0 := t[s0 and $ff] xor t[$100+s3 shr 8 and $ff] xor t[$200+s2 shr 16 and $ff] xor t[$300+s1 shr 24] xor pk[12];
t1 := t[s1 and $ff] xor t[$100+s0 shr 8 and $ff] xor t[$200+s3 shr 16 and $ff] xor t[$300+s2 shr 24] xor pk[13];
t2 := t[s2 and $ff] xor t[$100+s1 shr 8 and $ff] xor t[$200+s0 shr 16 and $ff] xor t[$300+s3 shr 24] xor pk[14];
t3 := t[s3 and $ff] xor t[$100+s2 shr 8 and $ff] xor t[$200+s1 shr 16 and $ff] xor t[$300+s0 shr 24] xor pk[15];
// Round 4
s0 := t[t0 and $ff] xor t[$100+t3 shr 8 and $ff] xor t[$200+t2 shr 16 and $ff] xor t[$300+t1 shr 24] xor pk[16];
s1 := t[t1 and $ff] xor t[$100+t0 shr 8 and $ff] xor t[$200+t3 shr 16 and $ff] xor t[$300+t2 shr 24] xor pk[17];
s2 := t[t2 and $ff] xor t[$100+t1 shr 8 and $ff] xor t[$200+t0 shr 16 and $ff] xor t[$300+t3 shr 24] xor pk[18];
s3 := t[t3 and $ff] xor t[$100+t2 shr 8 and $ff] xor t[$200+t1 shr 16 and $ff] xor t[$300+t0 shr 24] xor pk[19];
// Round 5
t0 := t[s0 and $ff] xor t[$100+s3 shr 8 and $ff] xor t[$200+s2 shr 16 and $ff] xor t[$300+s1 shr 24] xor pk[20];
t1 := t[s1 and $ff] xor t[$100+s0 shr 8 and $ff] xor t[$200+s3 shr 16 and $ff] xor t[$300+s2 shr 24] xor pk[21];
t2 := t[s2 and $ff] xor t[$100+s1 shr 8 and $ff] xor t[$200+s0 shr 16 and $ff] xor t[$300+s3 shr 24] xor pk[22];
t3 := t[s3 and $ff] xor t[$100+s2 shr 8 and $ff] xor t[$200+s1 shr 16 and $ff] xor t[$300+s0 shr 24] xor pk[23];
// Round 6
s0 := t[t0 and $ff] xor t[$100+t3 shr 8 and $ff] xor t[$200+t2 shr 16 and $ff] xor t[$300+t1 shr 24] xor pk[24];
s1 := t[t1 and $ff] xor t[$100+t0 shr 8 and $ff] xor t[$200+t3 shr 16 and $ff] xor t[$300+t2 shr 24] xor pk[25];
s2 := t[t2 and $ff] xor t[$100+t1 shr 8 and $ff] xor t[$200+t0 shr 16 and $ff] xor t[$300+t3 shr 24] xor pk[26];
s3 := t[t3 and $ff] xor t[$100+t2 shr 8 and $ff] xor t[$200+t1 shr 16 and $ff] xor t[$300+t0 shr 24] xor pk[27];
// Round 7
t0 := t[s0 and $ff] xor t[$100+s3 shr 8 and $ff] xor t[$200+s2 shr 16 and $ff] xor t[$300+s1 shr 24] xor pk[28];
t1 := t[s1 and $ff] xor t[$100+s0 shr 8 and $ff] xor t[$200+s3 shr 16 and $ff] xor t[$300+s2 shr 24] xor pk[29];
t2 := t[s2 and $ff] xor t[$100+s1 shr 8 and $ff] xor t[$200+s0 shr 16 and $ff] xor t[$300+s3 shr 24] xor pk[30];
t3 := t[s3 and $ff] xor t[$100+s2 shr 8 and $ff] xor t[$200+s1 shr 16 and $ff] xor t[$300+s0 shr 24] xor pk[31];
// Round 8
s0 := t[t0 and $ff] xor t[$100+t3 shr 8 and $ff] xor t[$200+t2 shr 16 and $ff] xor t[$300+t1 shr 24] xor pk[32];
s1 := t[t1 and $ff] xor t[$100+t0 shr 8 and $ff] xor t[$200+t3 shr 16 and $ff] xor t[$300+t2 shr 24] xor pk[33];
s2 := t[t2 and $ff] xor t[$100+t1 shr 8 and $ff] xor t[$200+t0 shr 16 and $ff] xor t[$300+t3 shr 24] xor pk[34];
s3 := t[t3 and $ff] xor t[$100+t2 shr 8 and $ff] xor t[$200+t1 shr 16 and $ff] xor t[$300+t0 shr 24] xor pk[35];
// Round 9
t0 := t[s0 and $ff] xor t[$100+s3 shr 8 and $ff] xor t[$200+s2 shr 16 and $ff] xor t[$300+s1 shr 24] xor pk[36];
t1 := t[s1 and $ff] xor t[$100+s0 shr 8 and $ff] xor t[$200+s3 shr 16 and $ff] xor t[$300+s2 shr 24] xor pk[37];
t2 := t[s2 and $ff] xor t[$100+s1 shr 8 and $ff] xor t[$200+s0 shr 16 and $ff] xor t[$300+s3 shr 24] xor pk[38];
t3 := t[s3 and $ff] xor t[$100+s2 shr 8 and $ff] xor t[$200+s1 shr 16 and $ff] xor t[$300+s0 shr 24] xor pk[39];
if ctxt.rounds>10 then begin
// Round 10
s0 := t[t0 and $ff] xor t[$100+t3 shr 8 and $ff] xor t[$200+t2 shr 16 and $ff] xor t[$300+t1 shr 24] xor pk[40];
s1 := t[t1 and $ff] xor t[$100+t0 shr 8 and $ff] xor t[$200+t3 shr 16 and $ff] xor t[$300+t2 shr 24] xor pk[41];
s2 := t[t2 and $ff] xor t[$100+t1 shr 8 and $ff] xor t[$200+t0 shr 16 and $ff] xor t[$300+t3 shr 24] xor pk[42];
s3 := t[t3 and $ff] xor t[$100+t2 shr 8 and $ff] xor t[$200+t1 shr 16 and $ff] xor t[$300+t0 shr 24] xor pk[43];
// Round 11
t0 := t[s0 and $ff] xor t[$100+s3 shr 8 and $ff] xor t[$200+s2 shr 16 and $ff] xor t[$300+s1 shr 24] xor pk[44];
t1 := t[s1 and $ff] xor t[$100+s0 shr 8 and $ff] xor t[$200+s3 shr 16 and $ff] xor t[$300+s2 shr 24] xor pk[45];
t2 := t[s2 and $ff] xor t[$100+s1 shr 8 and $ff] xor t[$200+s0 shr 16 and $ff] xor t[$300+s3 shr 24] xor pk[46];
t3 := t[s3 and $ff] xor t[$100+s2 shr 8 and $ff] xor t[$200+s1 shr 16 and $ff] xor t[$300+s0 shr 24] xor pk[47];
if ctxt.rounds>12 then begin
// Round 12
s0 := t[t0 and $ff] xor t[$100+t3 shr 8 and $ff] xor t[$200+t2 shr 16 and $ff] xor t[$300+t1 shr 24] xor pk[48];
s1 := t[t1 and $ff] xor t[$100+t0 shr 8 and $ff] xor t[$200+t3 shr 16 and $ff] xor t[$300+t2 shr 24] xor pk[49];
s2 := t[t2 and $ff] xor t[$100+t1 shr 8 and $ff] xor t[$200+t0 shr 16 and $ff] xor t[$300+t3 shr 24] xor pk[50];
s3 := t[t3 and $ff] xor t[$100+t2 shr 8 and $ff] xor t[$200+t1 shr 16 and $ff] xor t[$300+t0 shr 24] xor pk[51];
// Round 13
t0 := t[s0 and $ff] xor t[$100+s3 shr 8 and $ff] xor t[$200+s2 shr 16 and $ff] xor t[$300+s1 shr 24] xor pk[52];
t1 := t[s1 and $ff] xor t[$100+s0 shr 8 and $ff] xor t[$200+s3 shr 16 and $ff] xor t[$300+s2 shr 24] xor pk[53];
t2 := t[s2 and $ff] xor t[$100+s1 shr 8 and $ff] xor t[$200+s0 shr 16 and $ff] xor t[$300+s3 shr 24] xor pk[54];
t3 := t[s3 and $ff] xor t[$100+s2 shr 8 and $ff] xor t[$200+s1 shr 16 and $ff] xor t[$300+s0 shr 24] xor pk[55];
end;
end;
inc(PByte(pk), (ctxt.rounds shl 4));
// Uses InvSBox and shl, needs type cast cardinal() for
// 16 bit compilers: here InvSBox is byte, Td4 is cardinal
bo[0] := ((InvSBox[t0 and $ff]) xor
(InvSBox[t3 shr 8 and $ff]) shl 8 xor
(InvSBox[t2 shr 16 and $ff]) shl 16 xor
(InvSBox[t1 shr 24]) shl 24) xor pk[0];
bo[1] := ((InvSBox[t1 and $ff]) xor
(InvSBox[t0 shr 8 and $ff]) shl 8 xor
(InvSBox[t3 shr 16 and $ff]) shl 16 xor
(InvSBox[t2 shr 24]) shl 24) xor pk[1];
bo[2] := ((InvSBox[t2 and $ff]) xor
(InvSBox[t1 shr 8 and $ff]) shl 8 xor
(InvSBox[t0 shr 16 and $ff]) shl 16 xor
(InvSBox[t3 shr 24]) shl 24) xor pk[2];
bo[3] := ((InvSBox[t3 and $ff]) xor
(InvSBox[t2 shr 8 and $ff]) shl 8 xor
(InvSBox[t1 shr 16 and $ff]) shl 16 xor
(InvSBox[t0 shr 24]) shl 24) xor pk[3];
{$endif AES_ROLLED}
end;
{$ifdef CPUX86}
{$ifdef USEAESNI}
procedure aesnidecrypt128(const ctxt, source, dest);
{$ifdef FPC} nostackframe; assembler; {$endif}
asm
movups xmm7, [edx]
movups xmm0, [eax + 16 * 10]
movups xmm1, [eax + 16 * 9]
movups xmm2, [eax + 16 * 8]
movups xmm3, [eax + 16 * 7]
movups xmm4, [eax + 16 * 6]
movups xmm5, [eax + 16 * 5]
movups xmm6, [eax + 16 * 4]
pxor xmm7, xmm0
{$ifdef HASAESNI}
aesdec xmm7, xmm1
aesdec xmm7, xmm2
aesdec xmm7, xmm3
aesdec xmm7, xmm4
{$else}
db $66, $0F, $38, $DE, $F9
db $66, $0F, $38, $DE, $FA
db $66, $0F, $38, $DE, $FB
db $66, $0F, $38, $DE, $FC
{$endif}
movups xmm0, [eax + 16 * 3]
movups xmm1, [eax + 16 * 2]
movups xmm2, [eax + 16 * 1]
movups xmm3, [eax + 16 * 0]
{$ifdef HASAESNI}
aesdec xmm7, xmm5
aesdec xmm7, xmm6
aesdec xmm7, xmm0
aesdec xmm7, xmm1
aesdec xmm7, xmm2
aesdeclast xmm7, xmm3
{$else}
db $66, $0F, $38, $DE, $FD
db $66, $0F, $38, $DE, $FE
db $66, $0F, $38, $DE, $F8
db $66, $0F, $38, $DE, $F9
db $66, $0F, $38, $DE, $FA
db $66, $0F, $38, $DF, $FB
{$endif}
movups [ecx], xmm7
pxor xmm7, xmm7
end;
procedure aesnidecrypt192(const ctxt, source, dest);
{$ifdef FPC} nostackframe; assembler; {$endif}
asm
movups xmm7, [edx]
movups xmm0, [eax + 16 * 12]
movups xmm1, [eax + 16 * 11]
movups xmm2, [eax + 16 * 10]
movups xmm3, [eax + 16 * 9]
movups xmm4, [eax + 16 * 8]
movups xmm5, [eax + 16 * 7]
movups xmm6, [eax + 16 * 6]
pxor xmm7, xmm0
{$ifdef HASAESNI}
aesdec xmm7, xmm1
aesdec xmm7, xmm2
aesdec xmm7, xmm3
aesdec xmm7, xmm4
aesdec xmm7, xmm5
aesdec xmm7, xmm6
{$else}
db $66, $0F, $38, $DE, $F9
db $66, $0F, $38, $DE, $FA
db $66, $0F, $38, $DE, $FB
db $66, $0F, $38, $DE, $FC
db $66, $0F, $38, $DE, $FD
db $66, $0F, $38, $DE, $FE
{$endif}
movups xmm0, [eax + 16 * 5]
movups xmm1, [eax + 16 * 4]
movups xmm2, [eax + 16 * 3]
movups xmm3, [eax + 16 * 2]
movups xmm4, [eax + 16 * 1]
movups xmm5, [eax + 16 * 0]
{$ifdef HASAESNI}
aesdec xmm7, xmm0
aesdec xmm7, xmm1
aesdec xmm7, xmm2
aesdec xmm7, xmm3
aesdec xmm7, xmm4
aesdeclast xmm7, xmm5
{$else}
db $66, $0F, $38, $DE, $F8
db $66, $0F, $38, $DE, $F9
db $66, $0F, $38, $DE, $FA
db $66, $0F, $38, $DE, $FB
db $66, $0F, $38, $DE, $FC
db $66, $0F, $38, $DF, $FD
{$endif}
movups [ecx], xmm7
pxor xmm7, xmm7
end;
procedure aesnidecrypt256(const ctxt, source, dest);
{$ifdef FPC} nostackframe; assembler; {$endif}
asm
movups xmm7, [edx]
movups xmm0, [eax + 16 * 14]
movups xmm1, [eax + 16 * 13]
movups xmm2, [eax + 16 * 12]
movups xmm3, [eax + 16 * 11]
movups xmm4, [eax + 16 * 10]
movups xmm5, [eax + 16 * 9]
movups xmm6, [eax + 16 * 8]
pxor xmm7, xmm0
{$ifdef HASAESNI}
aesdec xmm7, xmm1
aesdec xmm7, xmm2
aesdec xmm7, xmm3
aesdec xmm7, xmm4
aesdec xmm7, xmm5
aesdec xmm7, xmm6
{$else}
db $66, $0F, $38, $DE, $F9
db $66, $0F, $38, $DE, $FA
db $66, $0F, $38, $DE, $FB
db $66, $0F, $38, $DE, $FC
db $66, $0F, $38, $DE, $FD
db $66, $0F, $38, $DE, $FE
{$endif}
movups xmm0, [eax + 16 * 7]
movups xmm1, [eax + 16 * 6]
movups xmm2, [eax + 16 * 5]
movups xmm3, [eax + 16 * 4]
movups xmm4, [eax + 16 * 3]
movups xmm5, [eax + 16 * 2]
movups xmm6, [eax + 16 * 1]
{$ifdef HASAESNI}
aesdec xmm7, xmm0
aesdec xmm7, xmm1
aesdec xmm7, xmm2
aesdec xmm7, xmm3
aesdec xmm7, xmm4
aesdec xmm7, xmm5
aesdec xmm7, xmm6
{$else}
db $66, $0F, $38, $DE, $F8
db $66, $0F, $38, $DE, $F9
db $66, $0F, $38, $DE, $FA
db $66, $0F, $38, $DE, $FB
db $66, $0F, $38, $DE, $FC
db $66, $0F, $38, $DE, $FD
db $66, $0F, $38, $DE, $FE
{$endif}
movups xmm0, [eax + 16 * 0]
{$ifdef HASAESNI}
aesdeclast xmm7, xmm0
{$else}
db $66, $0F, $38, $DF, $F8
{$endif}
movups [ecx], xmm7
pxor xmm7, xmm7
end;
{$endif}
{$ifdef CPUX86_NOTPIC}
procedure aesdecrypt386(const ctxt: TAESContext; bi, bo: PWA4);
{$ifdef FPC} nostackframe; assembler; {$endif}
asm
push ebx
push esi
push edi
push ebp
add esp, - 20
mov [esp], ecx
movzx ecx, byte ptr[eax].taescontext.rounds
lea esi, [4 * ecx]
lea ecx, [ecx - 1]
lea eax, [eax + 4 * esi] // eax=@ctx.rk[ctx.rounds]=pk
mov [esp + 16], ecx // [esp+16]=ctx.round
mov ebx, [edx]
xor ebx, [eax]
mov esi, [edx + 4]
xor esi, [eax + 4]
mov ecx, [edx + 8]
xor ecx, [eax + 8]
mov edx, [edx + 12]
xor edx, [eax + 12]
lea eax, [eax - 16]
@1: // pk=eax s0=ebx s1=esi s2=ecx s3=edx
movzx edi, bl
mov edi, dword ptr[4 * edi + td0]
movzx ebp, dh
xor edi, dword ptr[4 * ebp + td1]
mov ebp, ecx
shr ebp, $10
and ebp, 255
xor edi, dword ptr[4 * ebp + td2]
mov ebp, esi
shr ebp, $18
xor edi, dword ptr[4 * ebp + td3]
mov [esp + 4], edi
mov edi, esi
and edi, 255
mov edi, dword ptr[4 * edi + td0]
movzx ebp, bh
xor edi, dword ptr[4 * ebp + td1]
mov ebp, edx
shr ebp, $10
and ebp, 255
xor edi, dword ptr[4 * ebp + td2]
mov ebp, ecx
shr ebp, $18
xor edi, dword ptr[4 * ebp + td3]
mov [esp + 8], edi
movzx edi, cl
mov edi, dword ptr[4 * edi + td0]
movzx ebp, si
shr ebp, $08
xor edi, dword ptr[4 * ebp + td1]
mov ebp, ebx
shr ebp, $10
and ebp, 255
xor edi, dword ptr[4 * ebp + td2]
mov ebp, edx
shr ebp, $18
xor edi, dword ptr[4 * ebp + td3]
mov [esp + 12], edi
and edx, 255
mov edx, dword ptr[4 * edx + td0]
movzx ecx, ch
xor edx, dword ptr[4 * ecx + td1]
shr esi, $10
and esi, 255
xor edx, dword ptr[4 * esi + td2]
shr ebx, $18
xor edx, dword ptr[4 * ebx + td3]
xor edx, [eax + 12]
mov ebx, [eax]
xor ebx, [esp + 4]
mov esi, [eax + 4]
xor esi, [esp + 8]
mov ecx, [eax + 8]
xor ecx, [esp + 12]
lea eax, [eax - 16]
dec byte ptr[esp + 16]
jnz @1
mov ebp, eax
movzx eax, bl
movzx eax, byte ptr[eax + invsbox]
movzx edi, dh
movzx edi, byte ptr[edi + invsbox]
shl edi, $08
xor eax, edi
mov edi, ecx
shr edi, $10
and edi, 255
movzx edi, byte ptr[edi + invsbox]
shl edi, $10
xor eax, edi
mov edi, esi
shr edi, $18
movzx edi, byte ptr[edi + invsbox]
shl edi, $18
xor eax, edi
xor eax, [ebp]
mov edi, [esp]
mov [edi], eax
mov eax, esi
and eax, 255
movzx eax, byte ptr[eax + invsbox]
movzx edi, bh
movzx edi, byte ptr[edi + invsbox]
shl edi, $08
xor eax, edi
mov edi, edx
shr edi, $10
and edi, 255
movzx edi, byte ptr[edi + invsbox]
shl edi, $10
xor eax, edi
mov edi, ecx
shr edi, $18
movzx edi, byte ptr[edi + invsbox]
shl edi, $18
xor eax, edi
xor eax, [ebp + 4]
mov edi, [esp]
mov [edi + 4], eax
movzx eax, cl
movzx eax, byte ptr[eax + invsbox]
movzx edi, si
shr edi, $08
movzx edi, byte ptr[edi + invsbox]
shl edi, $08
xor eax, edi
mov edi, ebx
shr edi, $10
and edi, 255
movzx edi, byte ptr[edi + invsbox]
shl edi, $10
xor eax, edi
mov edi, edx
shr edi, $18
movzx edi, byte ptr[edi + invsbox]
shl edi, $18
xor eax, edi
xor eax, [ebp + 8]
mov edi, [esp]
mov [edi + 8], eax
and edx, 255
movzx eax, byte ptr[edx + invsbox]
shr ecx, $08
and ecx, 255
movzx edx, byte ptr[ecx + invsbox]
shl edx, $08
xor eax, edx
shr esi, $10
and esi, 255
movzx edx, byte ptr[esi + invsbox]
shl edx, $10
xor eax, edx
shr ebx, $18
movzx edx, byte ptr[ebx + invsbox]
shl edx, $18
xor eax, edx
xor eax, [ebp + 12]
mov [edi + 12], eax
add esp, 20
pop ebp
pop edi
pop esi
pop ebx
end;
{$endif CPUX86_NOTPIC}
{$endif CPUX86}
procedure MakeDecrKey(rounds: integer; k: PAWk);
// Calculate decryption key from encryption key
var x: cardinal;
{$ifndef AES_ROLLED}
i,j: integer;
{$endif}
t: PCardinalArray; // faster on a PIC system
s: PByteArray;
begin
{$ifndef AES_ROLLED} // inversion is needed only for fully unrolled version
i := 0;
j := 4*rounds;
while i<j do begin
x := k[i]; k[i] := k[j]; k[j] := x;
x := k[i+1]; k[i+1] := k[j+1]; k[j+1] := x;
x := k[i+2]; k[i+2] := k[j+2]; k[j+2] := x;
x := k[i+3]; k[i+3] := k[j+3]; k[j+3] := x;
inc(i,4);
dec(j,4);
end;
{$endif}
t := @Td0;
s := @SBox;
repeat
inc(PByte(k),16);
dec(rounds);
x := k[0];
k[0] := t[$300+s[x shr 24]] xor t[$200+s[x shr 16 and $ff]] xor
t[$100+s[x shr 8 and $ff]] xor t[s[x and $ff]];
x := k[1];
k[1] := t[$300+s[x shr 24]] xor t[$200+s[x shr 16 and $ff]] xor
t[$100+s[x shr 8 and $ff]] xor t[s[x and $ff]];
x := k[2];
k[2] := t[$300+s[x shr 24]] xor t[$200+s[x shr 16 and $ff]] xor
t[$100+s[x shr 8 and $ff]] xor t[s[x and $ff]];
x := k[3];
k[3] := t[$300+s[x shr 24]] xor t[$200+s[x shr 16 and $ff]] xor
t[$100+s[x shr 8 and $ff]] xor t[s[x and $ff]];
until rounds=1;
end;
function TAES.DecryptInitFrom(const Encryption{$ifndef DELPHI5OROLDER}: TAES{$endif};
const Key; KeySize: cardinal): boolean;
var ctx: TAESContext absolute Context;
begin
{$ifdef USEPADLOCK}
if DoPadlockInit(Key,KeySize) then begin
result := true;
ctx.Initialized := true;
ctx.DoBlock := @aesdecryptpadlock;
exit; // Init OK
end;
{$endif}
ctx.Initialized := false;
if not {$ifdef DELPHI5OROLDER}TAES{$endif}(Encryption).Initialized then
// e.g. called from DecryptInit()
EncryptInit(Key, KeySize) else // contains Initialized := true
self := {$ifdef DELPHI5OROLDER}TAES{$endif}(Encryption);
result := ctx.Initialized;
if not result then
exit;
{$ifdef CPUX86_NOTPIC}
ctx.DoBlock := @aesdecrypt386;
{$else}
ctx.DoBlock := @aesdecryptpas;
{$endif}
{$ifdef USEAESNI}
if cfAESNI in CpuFeatures then begin
MakeDecrKeyAesNi(ctx.Rounds,@ctx.RK);
case KeySize of
128: ctx.DoBlock := @aesnidecrypt128;
192: ctx.DoBlock := @aesnidecrypt192;
256: ctx.DoBlock := @aesnidecrypt256;
end;
end else
{$endif}
MakeDecrKey(ctx.Rounds,@ctx.RK);
end;
function TAES.DecryptInit(const Key; KeySize: cardinal): boolean;
begin
result := DecryptInitFrom(self, Key, KeySize);
end;
procedure TAES.Decrypt(var B: TAESBlock);
begin
TAESContext(Context).DoBlock(Context,B,B);
end;
procedure TAES.Decrypt(const BI: TAESBlock; var BO: TAESBlock);
begin
TAESContext(Context).DoBlock(Context,BI,BO);
end;
procedure TAES.DoBlocks(pIn, pOut: PAESBlock; out oIn, oOut: PAESBLock;
Count: integer; doEncrypt: boolean);
var i: integer;
ctx: TAESContext absolute Context;
begin
{$ifdef USEPADLOCK}
// assert(PtrUInt(pIn) and $F=0); // must be 16 bytes aligned
if ctx.ViaCtx<>nil then begin
if Count<>0 then begin
Count := Count shl AESBlockShift;
if doEncrypt then
padlock_aes_encrypt(ctx.ViaCtx,pIn,pOut,Count) else
padlock_aes_decrypt(ctx.ViaCtx,pIn,pOut,Count);
end;
oIn := pointer(PtrUInt(pIn)+PtrUInt(Count));
oOut := pointer(PtrUInt(pOut)+PtrUInt(Count));
exit;
end;
{$endif}
for i := 1 to Count do begin
ctx.DoBlock(ctx,pIn^,pOut^);
inc(pIn);
inc(pOut);
end;
oIn := pIn;
oOut := pOut;
end;
function TAES.DoInit(const Key; KeySize: cardinal; doEncrypt: boolean): boolean;
begin
if doEncrypt then
result := EncryptInit(Key, KeySize) else
result := DecryptInit(Key,KeySize);
end;
procedure TAES.DoBlocks(pIn, pOut: PAESBlock; Count: integer; doEncrypt: boolean);
begin
DoBlocks(pIn,pOut,pIn,pOut,Count,doEncrypt);
end;
procedure TAES.DoBlocksOFB(const iv: TAESBlock; src, dst: pointer; blockcount: PtrUInt);
var cv: TAESBlock;
begin
cv := iv;
while blockcount > 0 do begin
dec(blockcount);
TAESContext(Context).DoBlock(Context,cv,cv);
XorBlock16(src,dst,pointer(@cv));
inc(PByte(src),SizeOf(TAESBlock));
inc(PByte(dst),SizeOf(TAESBlock));
end;
end;
function TAES.Initialized: boolean;
begin
result := TAESContext(Context).Initialized;
end;
function TAES.UsesAESNI: boolean;
begin
{$ifdef CPUINTEL}
result := cfAESNI in CpuFeatures;
{$else}
result := false;
{$endif}
end;
function TAES.KeyBits: integer;
begin
result := TAESContext(Context).KeyBits;
end;
procedure TAES.Done;
var ctx: TAESContext absolute Context;
begin
{$ifdef USEPADLOCK}
if Initialized and padlock_available and (ctx.ViaCtx<>nil) then
padlock_aes_close(ctx.ViaCtx);
{$endif USEPADLOCK}
FillcharFast(ctx,sizeof(ctx),0); // always erase key in memory after use
end;
{$ifdef USETHREADSFORBIGAESBLOCKS}
type
TThreadParams = record
bIn, bOut: pAESBlock;
BlockCount,BlockIndex: integer;
Encrypt: boolean;
ID: DWORD;
AES: TAES;
end;
{ we use direct Windows threads, since we don't need any exception handling
nor memory usage inside the Thread handler
-> avoid classes.TThread and system.BeginThread() use
-> application is still "officialy" mono-threaded (i.e. IsMultiThread=false),
for faster System.pas and FastMM4 (no locking)
-> code is even shorter then original one using TThread }
function ThreadWrapper(var P: TThreadParams): Integer; stdcall;
begin
with P do
AES.DoBlocks(bIn,bOut,bIn,bOut,BlockCount,Encrypt);
ExitThread(0);
result := 0; // make the compiler happy, but won't never be called
end;
procedure TAES.DoBlocksThread(var bIn, bOut: PAESBlock; Count: integer; doEncrypt: boolean);
var Thread: array[0..3] of TThreadParams; // faster than dynamic array
Handle: array[0..3] of THandle; // high(Thread) is not compiled by XE2
nThread, i, nOne: integer;
pIn, pOut: PAESBlock;
begin
if Count=0 then exit;
if {$ifdef USEPADLOCK} padlock_available or {$endif}
{$ifdef USEAESNI} (cfAESNI in CpuFeatures) or {$endif}
(SystemInfo.dwNumberOfProcessors<=1) or // (DebugHook<>0) or
(Count<((512*1024) shr AESBlockShift)) then begin // not needed below 512 KB
DoBlocks(bIn,bOut,bIn,bOut,Count,doEncrypt);
exit;
end;
nThread := SystemInfo.dwNumberOfProcessors;
if nThread>length(Thread) then // a quad-core is enough ;)
nThread := length(Thread);
nOne := Count div nThread;
pIn := bIn;
pOut := bOut;
for i := 0 to nThread-1 do
with Thread[i] do begin // create threads parameters
bIn := pIn;
bOut := pOut;
BlockCount := nOne;
BlockIndex := i+1;
Encrypt := doEncrypt;
AES := self; // local copy of the AES context for every thread
Handle[i] := CreateThread(nil,0,@ThreadWrapper,@Thread[i],0,ID);
inc(pIn,nOne);
inc(pOut,nOne);
dec(Count,nOne);
end;
if Count>0 then
DoBlocks(pIn,pOut,pIn,pOut,Count,doEncrypt); // remaining blocks
{$ifopt C+}
inc(Count,nOne*nThread);
assert(PtrUInt(pIn)-PtrUInt(bIn)=cardinal(Count)shl AESBlockShift);
assert(PtrUInt(pOut)-PtrUInt(bOut)=cardinal(Count)shl AESBlockShift);
{$endif}
bIn := pIn;
bOut := pOut;
WaitForMultipleObjects(nThread,@Handle[0],True,INFINITE);
for i := 0 to nThread-1 do
CloseHandle(Handle[i]);
end;
{$endif USETHREADSFORBIGAESBLOCKS}
{ AES-GCM Support }
const
// lookup table as used by mul_x/gf_mul/gf_mul_h
gft_le: array[byte] of word = (
$0000, $c201, $8403, $4602, $0807, $ca06, $8c04, $4e05,
$100e, $d20f, $940d, $560c, $1809, $da08, $9c0a, $5e0b,
$201c, $e21d, $a41f, $661e, $281b, $ea1a, $ac18, $6e19,
$3012, $f213, $b411, $7610, $3815, $fa14, $bc16, $7e17,
$4038, $8239, $c43b, $063a, $483f, $8a3e, $cc3c, $0e3d,
$5036, $9237, $d435, $1634, $5831, $9a30, $dc32, $1e33,
$6024, $a225, $e427, $2626, $6823, $aa22, $ec20, $2e21,
$702a, $b22b, $f429, $3628, $782d, $ba2c, $fc2e, $3e2f,
$8070, $4271, $0473, $c672, $8877, $4a76, $0c74, $ce75,
$907e, $527f, $147d, $d67c, $9879, $5a78, $1c7a, $de7b,
$a06c, $626d, $246f, $e66e, $a86b, $6a6a, $2c68, $ee69,
$b062, $7263, $3461, $f660, $b865, $7a64, $3c66, $fe67,
$c048, $0249, $444b, $864a, $c84f, $0a4e, $4c4c, $8e4d,
$d046, $1247, $5445, $9644, $d841, $1a40, $5c42, $9e43,
$e054, $2255, $6457, $a656, $e853, $2a52, $6c50, $ae51,
$f05a, $325b, $7459, $b658, $f85d, $3a5c, $7c5e, $be5f,
$00e1, $c2e0, $84e2, $46e3, $08e6, $cae7, $8ce5, $4ee4,
$10ef, $d2ee, $94ec, $56ed, $18e8, $dae9, $9ceb, $5eea,
$20fd, $e2fc, $a4fe, $66ff, $28fa, $eafb, $acf9, $6ef8,
$30f3, $f2f2, $b4f0, $76f1, $38f4, $faf5, $bcf7, $7ef6,
$40d9, $82d8, $c4da, $06db, $48de, $8adf, $ccdd, $0edc,
$50d7, $92d6, $d4d4, $16d5, $58d0, $9ad1, $dcd3, $1ed2,
$60c5, $a2c4, $e4c6, $26c7, $68c2, $aac3, $ecc1, $2ec0,
$70cb, $b2ca, $f4c8, $36c9, $78cc, $bacd, $fccf, $3ece,
$8091, $4290, $0492, $c693, $8896, $4a97, $0c95, $ce94,
$909f, $529e, $149c, $d69d, $9898, $5a99, $1c9b, $de9a,
$a08d, $628c, $248e, $e68f, $a88a, $6a8b, $2c89, $ee88,
$b083, $7282, $3480, $f681, $b884, $7a85, $3c87, $fe86,
$c0a9, $02a8, $44aa, $86ab, $c8ae, $0aaf, $4cad, $8eac,
$d0a7, $12a6, $54a4, $96a5, $d8a0, $1aa1, $5ca3, $9ea2,
$e0b5, $22b4, $64b6, $a6b7, $e8b2, $2ab3, $6cb1, $aeb0,
$f0bb, $32ba, $74b8, $b6b9, $f8bc, $3abd, $7cbf, $bebe);
procedure mul_x(var a: TAESBlock; const b: TAESBlock);
// {$ifdef HASINLINE}inline;{$endif} // inlining has no benefit here
var t: cardinal;
y: TWA4 absolute b;
const
MASK_80 = cardinal($80808080);
MASK_7F = cardinal($7f7f7f7f);
begin
t := gft_le[(y[3] shr 17) and MASK_80];
TWA4(a)[3] := ((y[3] shr 1) and MASK_7F) or (((y[3] shl 15) or (y[2] shr 17)) and MASK_80);
TWA4(a)[2] := ((y[2] shr 1) and MASK_7F) or (((y[2] shl 15) or (y[1] shr 17)) and MASK_80);
TWA4(a)[1] := ((y[1] shr 1) and MASK_7F) or (((y[1] shl 15) or (y[0] shr 17)) and MASK_80);
TWA4(a)[0] := (((y[0] shr 1) and MASK_7F) or ( (y[0] shl 15) and MASK_80)) xor t;
end;
procedure gf_mul(var a: TAESBlock; const b: TAESBlock);
var p: array[0..7] of TAESBlock;
x: TWA4;
t: cardinal;
i: PtrInt;
j: integer;
c: byte;
begin
p[0] := b;
for i := 1 to 7 do
mul_x(p[i], p[i-1]);
FillZero(TAESBlock(x));
for i:=0 to 15 do begin
c := a[15-i];
if i>0 then begin
// inlined mul_x8()
t := gft_le[x[3] shr 24];
x[3] := ((x[3] shl 8) or (x[2] shr 24));
x[2] := ((x[2] shl 8) or (x[1] shr 24));
x[1] := ((x[1] shl 8) or (x[0] shr 24));
x[0] := ((x[0] shl 8) xor t);
end;
for j:=0 to 7 do begin
if c and ($80 shr j) <> 0 then begin
x[3] := x[3] xor TWA4(p[j])[3];
x[2] := x[2] xor TWA4(p[j])[2];
x[1] := x[1] xor TWA4(p[j])[1];
x[0] := x[0] xor TWA4(p[j])[0];
end;
end;
end;
a := TAESBlock(x);
end;
{ TAESGCMEngine }
procedure TAESGCMEngine.Make4K_Table;
var j, k: PtrInt;
begin
gf_t4k[128] := ghash_h;
j := 64;
while j>0 do begin
mul_x(gf_t4k[j],gf_t4k[j+j]);
j := j shr 1;
end;
j := 2;
while j<256 do begin
for k := 1 to j-1 do
XorBlock16(@gf_t4k[k],@gf_t4k[j+k],@gf_t4k[j]);
inc(j,j);
end;
end;
procedure TAESGCMEngine.gf_mul_h(var a: TAESBlock);
var
x: TWA4;
i: PtrUInt;
t: cardinal;
p: PWA4;
{$ifdef CPUX86NOTPIC}
tab: TWordArray absolute gft_le;
{$else}
tab: PWordArray;
{$endif CPUX86NOTPIC}
begin
{$ifndef CPUX86NOTPIC}
tab := @gft_le;
{$endif CPUX86NOTPIC}
x := TWA4(gf_t4k[a[15]]);
for i := 14 downto 0 do begin
p := @gf_t4k[a[i]];
t := tab[x[3] shr 24];
// efficient mul_x8 and xor using pre-computed table entries
x[3] := ((x[3] shl 8) or (x[2] shr 24)) xor p^[3];
x[2] := ((x[2] shl 8) or (x[1] shr 24)) xor p^[2];
x[1] := ((x[1] shl 8) or (x[0] shr 24)) xor p^[1];
x[0] := ((x[0] shl 8) xor t) xor p^[0];
end;
a := TAESBlock(x);
end;
procedure GCM_IncCtr(var x: TAESBlock); {$ifdef HASINLINE} inline; {$endif}
begin
// in AES-GCM, CTR covers only 32 LSB Big-Endian bits, i.e. x[15]..x[12]
inc(x[15]);
if x[15]<>0 then
exit;
inc(x[14]);
if x[14]<>0 then
exit;
inc(x[13]);
if x[13]=0 then
inc(x[12]);
end;
procedure TAESGCMEngine.internal_crypt(ptp, ctp: PByte; ILen: PtrUInt);
var b_pos: PtrUInt;
begin
b_pos := blen;
inc(blen,ILen);
blen := blen and AESBlockMod;
if b_pos=0 then
b_pos := SizeOf(TAESBlock) else
while (ILen>0) and (b_pos<SizeOf(TAESBlock)) do begin
ctp^ := ptp^ xor TAESContext(actx).buf[b_pos];
inc(b_pos);
inc(ptp);
inc(ctp);
dec(ILen);
end;
while ILen>=SizeOf(TAESBlock) do begin
GCM_IncCtr(TAESContext(actx).IV);
actx.Encrypt(TAESContext(actx).IV,TAESContext(actx).buf); // maybe AES-NI
XorBlock16(pointer(ptp),pointer(ctp),@TAESContext(actx).buf);
inc(PAESBlock(ptp));
inc(PAESBlock(ctp));
dec(ILen,SizeOf(TAESBlock));
end;
while ILen>0 do begin
if b_pos=SizeOf(TAESBlock) then begin
GCM_IncCtr(TAESContext(actx).IV);
actx.Encrypt(TAESContext(actx).IV,TAESContext(actx).buf);
b_pos := 0;
end;
ctp^ := TAESContext(actx).buf[b_pos] xor ptp^;
inc(b_pos);
inc(ptp);
inc(ctp);
dec(ILen);
end;
end;
procedure TAESGCMEngine.internal_auth(ctp: PByte; ILen: PtrUInt;
var ghv: TAESBlock; var gcnt: TQWordRec);
var b_pos: PtrUInt;
begin
b_pos := gcnt.L and AESBlockMod;
inc(gcnt.V,ILen);
if (b_pos=0) and (gcnt.V<>0) then
gf_mul_h(ghv);
while (ILen>0) and (b_pos<SizeOf(TAESBlock)) do begin
ghv[b_pos] := ghv[b_pos] xor ctp^;
inc(b_pos);
inc(ctp);
dec(ILen);
end;
while ILen>=SizeOf(TAESBlock) do begin
gf_mul_h(ghv);
XorBlock16(@ghv,pointer(ctp));
inc(PAESBlock(ctp));
dec(ILen,SizeOf(TAESBlock));
end;
while ILen>0 do begin
if b_pos=SizeOf(TAESBlock) then begin
gf_mul_h(ghv);
b_pos := 0;
end;
ghv[b_pos] := ghv[b_pos] xor ctp^;
inc(b_pos);
inc(ctp);
dec(ILen);
end;
end;
function TAESGCMEngine.Init(const Key; KeyBits: PtrInt): boolean;
begin
FillcharFast(self,SizeOf(self),0);
result := actx.EncryptInit(Key,KeyBits);
if not result then
exit;
actx.Encrypt(ghash_h, ghash_h);
Make4K_Table;
end;
const
CTR_POS = 12;
function TAESGCMEngine.Reset(pIV: pointer; IV_len: PtrInt): boolean;
var i, n_pos: PtrInt;
begin
if (pIV=nil) or (IV_len=0) then begin
result := false;
exit;
end;
if IV_len=CTR_POS then begin
// Initialization Vector size matches perfect size of 12 bytes
MoveFast(pIV^,TAESContext(actx).IV,CTR_POS);
TWA4(TAESContext(actx).IV)[3] := $01000000;
end else begin
// Initialization Vector is otherwise computed from GHASH(IV,H)
n_pos := IV_len;
FillZero(TAESContext(actx).IV);
while n_pos>=SizeOf(TAESBlock) do begin
XorBlock16(@TAESContext(actx).IV,pIV);
inc(PAesBlock(pIV));
dec(n_pos,SizeOf(TAESBlock));
gf_mul_h(TAESContext(actx).IV);
end;
if n_pos>0 then begin
for i := 0 to n_pos-1 do
TAESContext(actx).IV[i] := TAESContext(actx).IV[i] xor PAESBlock(pIV)^[i];
gf_mul_h(TAESContext(actx).IV);
end;
n_pos := IV_len shl 3;
i := 15;
while n_pos>0 do begin
TAESContext(actx).IV[i] := TAESContext(actx).IV[i] xor byte(n_pos);
n_pos := n_pos shr 8;
dec(i);
end;
gf_mul_h(TAESContext(actx).IV);
end;
// reset internal state and counters
y0_val := TWA4(TAESContext(actx).IV)[3];
FillZero(aad_ghv);
FillZero(txt_ghv);
aad_cnt.V := 0;
atx_cnt.V := 0;
flags := [];
result := true;
end;
function TAESGCMEngine.Encrypt(ptp, ctp: Pointer; ILen: PtrInt): boolean;
begin
if ILen>0 then begin
if (ptp=nil) or (ctp=nil) or (flagFinalComputed in flags) then begin
result := false;
exit;
end;
if (ILen and AESBlockMod=0) and (blen=0) then begin
inc(atx_cnt.V,ILen);
ILen := ILen shr AESBlockShift;
repeat // loop optimized e.g. for PKCS7 padding
GCM_IncCtr(TAESContext(actx).IV);
actx.Encrypt(TAESContext(actx).IV,TAESContext(actx).buf); // maybe AES-NI
XorBlock16(ptp,ctp,@TAESContext(actx).buf);
gf_mul_h(txt_ghv);
XorBlock16(@txt_ghv,ctp);
inc(PAESBlock(ptp));
inc(PAESBlock(ctp));
dec(ILen);
until ILen=0;
end else begin // generic process in dual steps
internal_crypt(ptp,ctp,iLen);
internal_auth(ctp,ILen,txt_ghv,atx_cnt);
end;
end;
result := true;
end;
function TAESGCMEngine.Decrypt(ctp, ptp: Pointer; ILen: PtrInt;
ptag: pointer; tlen: PtrInt): boolean;
var tag: TAESBlock;
begin
result := false;
if ILen>0 then begin
if (ptp=nil) or (ctp=nil) or (flagFinalComputed in flags) then
exit;
if (ILen and AESBlockMod=0) and (blen=0) then begin
inc(atx_cnt.V,ILen);
ILen := ILen shr AESBlockShift;
repeat // loop optimized e.g. for PKCS7 padding
gf_mul_h(txt_ghv);
XorBlock16(@txt_ghv,ctp);
GCM_IncCtr(TAESContext(actx).IV);
actx.Encrypt(TAESContext(actx).IV,TAESContext(actx).buf); // maybe AES-NI
XorBlock16(ctp,ptp,@TAESContext(actx).buf);
inc(PAESBlock(ptp));
inc(PAESBlock(ctp));
dec(ILen);
until ILen=0;
if (ptag<>nil) and (tlen>0) then begin
Final(tag,{anddone=}false);
if not IsEqual(tag,ptag^,tlen) then
exit; // check authentication after single pass encryption + auth
end;
end else begin // generic process in dual steps
internal_auth(ctp,ILen,txt_ghv,atx_cnt);
if (ptag<>nil) and (tlen>0) then begin
Final(tag,{anddone=}false);
if not IsEqual(tag,ptag^,tlen) then
exit; // check authentication before encryption
end;
internal_crypt(ctp,ptp,iLen);
end;
end;
result := true;
end;
function TAESGCMEngine.Add_AAD(pAAD: pointer; aLen: PtrInt): boolean;
begin
if aLen>0 then begin
if (pAAD=nil) or (flagFinalComputed in flags) then begin
result := false;
exit;
end;
internal_auth(pAAD,aLen,aad_ghv,aad_cnt);
end;
result := true;
end;
function TAESGCMEngine.Final(out tag: TAESBlock; andDone: boolean): boolean;
var
tbuf: TAESBlock;
ln: cardinal;
begin
if not (flagFinalComputed in flags) then begin
include(flags,flagFinalComputed);
// compute GHASH(H, AAD, ctp)
gf_mul_h(aad_ghv);
gf_mul_h(txt_ghv);
// compute len(AAD) || len(ctp) with each len as 64-bit big-endian
ln := (atx_cnt.V+AESBlockMod) shr AESBlockShift;
if (aad_cnt.V>0) and (ln<>0) then begin
tbuf := ghash_h;
while ln<>0 do begin
if odd(ln) then
gf_mul(aad_ghv,tbuf);
ln := ln shr 1;
if ln<>0 then
gf_mul(tbuf,tbuf);
end;
end;
TWA4(tbuf)[0] := bswap32((aad_cnt.L shr 29) or (aad_cnt.H shl 3));
TWA4(tbuf)[1] := bswap32((aad_cnt.L shl 3));
TWA4(tbuf)[2] := bswap32((atx_cnt.L shr 29) or (atx_cnt.H shl 3));
TWA4(tbuf)[3] := bswap32((atx_cnt.L shl 3));
XorBlock16(@tbuf,@txt_ghv);
XorBlock16(@aad_ghv,@tbuf);
gf_mul_h(aad_ghv);
// compute E(K,Y0)
tbuf := TAESContext(actx).IV;
TWA4(tbuf)[3] := y0_val;
actx.Encrypt(tbuf);
// GMAC = GHASH(H, AAD, ctp) xor E(K,Y0)
XorBlock16(@aad_ghv,@tag,@tbuf);
if andDone then
Done;
result := true;
end else begin
Done;
result := false;
end;
end;
procedure TAESGCMEngine.Done;
begin
if flagFlushed in flags then
exit;
actx.Done;
include(flags,flagFlushed);
end;
function TAESGCMEngine.FullEncryptAndAuthenticate(const Key; KeyBits: PtrInt;
pIV: pointer; IV_len: PtrInt; pAAD: pointer; aLen: PtrInt; ptp, ctp: Pointer;
pLen: PtrInt; out tag: TAESBlock): boolean;
begin
result := Init(Key,KeyBits) and Reset(pIV,IV_len) and Add_AAD(pAAD,aLen) and
Encrypt(ptp,ctp,pLen) and Final(tag);
Done;
end;
function TAESGCMEngine.FullDecryptAndVerify(const Key; KeyBits: PtrInt;
pIV: pointer; IV_len: PtrInt; pAAD: pointer; aLen: PtrInt; ctp, ptp: Pointer;
pLen: PtrInt; ptag: pointer; tLen: PtrInt): boolean;
begin
result := Init(Key,KeyBits) and Reset(pIV,IV_len) and Add_AAD(pAAD,aLen) and
Decrypt(ctp,ptp,pLen,ptag,tlen);
Done;
end;
{ TSHA256 }
// under Win32, with a Core i7 CPU: pure pascal: 152ms - x86: 112ms
// under Win64, with a Core i7 CPU: pure pascal: 202ms - SSE4: 78ms
procedure Sha256ExpandMessageBlocks(W, Buf: PIntegerArray);
// Calculate "expanded message blocks"
{$ifdef AES_PASCAL}
var i: integer;
begin
// bswap256() instead of "for i := 0 to 15 do W[i]:= bswap32(Buf[i]);"
bswap256(@Buf[0],@W[0]);
bswap256(@Buf[8],@W[8]);
for i := 16 to 63 do
{$ifdef FPC} // uses faster built-in right rotate intrinsic
W[i] := (RorDWord(W[i-2],17)xor RorDWord(W[i-2],19)xor(W[i-2]shr 10))+W[i-7]+
(RorDWord(W[i-15],7)xor RorDWord(W[i-15],18)xor(W[i-15]shr 3))+W[i-16];
{$else}
W[i] := (((W[i-2]shr 17)or(W[i-2]shl 15))xor((W[i-2]shr 19)or(W[i-2]shl 13))
xor (W[i-2]shr 10))+W[i-7]+(((W[i-15]shr 7)or(W[i-15]shl 25))
xor ((W[i-15]shr 18)or(W[i-15]shl 14))xor(W[i-15]shr 3))+W[i-16];
{$endif}
end;
{$else}
{$ifdef CPUX86} {$ifdef FPC} nostackframe; assembler; {$endif}
asm // W=eax Buf=edx
push esi
push edi
push ebx
mov esi, eax
// part 1: W[i]:= RB(TW32Buf(Buf)[i])
mov eax, [edx]
mov ebx, [edx + 4]
bswap eax
bswap ebx
mov [esi], eax
mov [esi + 4], ebx
mov eax, [edx + 8]
mov ebx, [edx + 12]
bswap eax
bswap ebx
mov [esi + 8], eax
mov [esi + 12], ebx
mov eax, [edx + 16]
mov ebx, [edx + 20]
bswap eax
bswap ebx
mov [esi + 16], eax
mov [esi + 20], ebx
mov eax, [edx + 24]
mov ebx, [edx + 28]
bswap eax
bswap ebx
mov [esi + 24], eax
mov [esi + 28], ebx
mov eax, [edx + 32]
mov ebx, [edx + 36]
bswap eax
bswap ebx
mov [esi + 32], eax
mov [esi + 36], ebx
mov eax, [edx + 40]
mov ebx, [edx + 44]
bswap eax
bswap ebx
mov [esi + 40], eax
mov [esi + 44], ebx
mov eax, [edx + 48]
mov ebx, [edx + 52]
bswap eax
bswap ebx
mov [esi + 48], eax
mov [esi + 52], ebx
mov eax, [edx + 56]
mov ebx, [edx + 60]
bswap eax
bswap ebx
mov [esi + 56], eax
mov [esi + 60], ebx
lea esi, [esi + 64]
// part2: w[i]:= lrot_1(w[i-3] xor w[i-8] xor w[i-14] xor w[i-16])
mov ecx, 48
@@2: mov eax, [esi - 2 * 4] // w[i-2]
mov edi, [esi - 7 * 4] // w[i-7]
mov edx, eax
mov ebx, eax // sig1: rr17 xor rr19 xor srx,10
ror eax, 17
ror edx, 19
shr ebx, 10
xor eax, edx
xor eax, ebx
add edi, eax
mov eax, [esi - 15 * 4] // w[i-15]
mov ebx, eax // sig0: rr7 xor rr18 xor sr3
mov edx, eax
ror eax, 7
ror edx, 18
shr ebx, 3
xor eax, edx
xor eax, ebx
add eax, edi
add eax, [esi - 16 * 4] // w[i-16]
mov [esi], eax
add esi, 4
dec ecx
jnz @@2
pop ebx
pop edi
pop esi
end;
{$endif CPUX86}
{$ifdef CPUX64}
{$ifdef FPC}nostackframe; assembler; asm{$else}
asm // W=rcx Buf=rdx
.noframe
{$endif}
{$ifndef win64}
mov rdx, rsi
mov rcx, rdi
{$endif win64}
mov rax, rcx
push rsi
push rdi
push rbx
mov rsi, rax
// part 1: W[i]:= RB(TW32Buf(Buf)[i])
mov eax, [rdx]
mov ebx, [rdx + 4]
bswap eax
bswap ebx
mov [rsi], eax
mov [rsi + 4], ebx
mov eax, [rdx + 8]
mov ebx, [rdx + 12]
bswap eax
bswap ebx
mov [rsi + 8], eax
mov [rsi + 12], ebx
mov eax, [rdx + 16]
mov ebx, [rdx + 20]
bswap eax
bswap ebx
mov [rsi + 16], eax
mov [rsi + 20], ebx
mov eax, [rdx + 24]
mov ebx, [rdx + 28]
bswap eax
bswap ebx
mov [rsi + 24], eax
mov [rsi + 28], ebx
mov eax, [rdx + 32]
mov ebx, [rdx + 36]
bswap eax
bswap ebx
mov [rsi + 32], eax
mov [rsi + 36], ebx
mov eax, [rdx + 40]
mov ebx, [rdx + 44]
bswap eax
bswap ebx
mov [rsi + 40], eax
mov [rsi + 44], ebx
mov eax, [rdx + 48]
mov ebx, [rdx + 52]
bswap eax
bswap ebx
mov [rsi + 48], eax
mov [rsi + 52], ebx
mov eax, [rdx + 56]
mov ebx, [rdx + 60]
bswap eax
bswap ebx
mov [rsi + 56], eax
mov [rsi + 60], ebx
lea rsi, [rsi + 64]
// part2: W[i]:= LRot_1(W[i-3] xor W[i-8] xor W[i-14] xor W[i-16])
mov ecx, 48
@@2: mov eax, [rsi - 2 * 4] // W[i-2]
mov edi, [rsi - 7 * 4] // W[i-7]
mov edx, eax
mov ebx, eax // Sig1: RR17 xor RR19 xor SRx,10
ror eax, 17
ror edx, 19
shr ebx, 10
xor eax, edx
xor eax, ebx
add edi, eax
mov eax, [rsi - 15 * 4] // W[i-15]
mov ebx, eax // Sig0: RR7 xor RR18 xor SR3
mov edx, eax
ror eax, 7
ror edx, 18
shr ebx, 3
xor eax, edx
xor eax, ebx
add eax, edi
add eax, [rsi - 16 * 4] // W[i-16]
mov [rsi], eax
add rsi, 4
dec ecx
jnz @@2
pop rbx
pop rdi
pop rsi
end;
{$endif CPUX64}
{$endif AES_PASCAL}
const
K256: array[0..63] of cardinal = (
$428a2f98, $71374491, $b5c0fbcf, $e9b5dba5, $3956c25b, $59f111f1,
$923f82a4, $ab1c5ed5, $d807aa98, $12835b01, $243185be, $550c7dc3,
$72be5d74, $80deb1fe, $9bdc06a7, $c19bf174, $e49b69c1, $efbe4786,
$0fc19dc6, $240ca1cc, $2de92c6f, $4a7484aa, $5cb0a9dc, $76f988da,
$983e5152, $a831c66d, $b00327c8, $bf597fc7, $c6e00bf3, $d5a79147,
$06ca6351, $14292967, $27b70a85, $2e1b2138, $4d2c6dfc, $53380d13,
$650a7354, $766a0abb, $81c2c92e, $92722c85, $a2bfe8a1, $a81a664b,
$c24b8b70, $c76c51a3, $d192e819, $d6990624, $f40e3585, $106aa070,
$19a4c116, $1e376c08, $2748774c, $34b0bcb5, $391c0cb3, $4ed8aa4a,
$5b9cca4f, $682e6ff3, $748f82ee, $78a5636f, $84c87814, $8cc70208,
$90befffa, $a4506ceb, $bef9a3f7, $c67178f2);
{$ifdef CPUX64}
// optimized unrolled version from Intel's sha256_sse4.asm
// Original code is released as Copyright (c) 2012, Intel Corporation
var
K256AlignedStore: RawByteString;
K256Aligned: pointer; // movaps + paddd do expect 16 bytes alignment
const
STACK_SIZE = 32{$ifndef LINUX}+7*16{$endif};
procedure sha256_sse4(var input_data; var digest; num_blks: PtrUInt);
{$ifdef FPC}nostackframe; assembler; asm{$else}
asm // rcx=input_data rdx=digest r8=num_blks (Linux: rdi,rsi,rdx)
.noframe
{$endif FPC}
push rbx
{$ifdef LINUX}
mov r8, rdx
mov rcx, rdi
mov rdx, rsi
{$else}
push rsi // Win64 expects those registers to be preserved
push rdi
{$endif}
push rbp
push r13
push r14
push r15
sub rsp, STACK_SIZE
{$ifndef LINUX}
movaps [rsp + 20H], xmm6 // manual .PUSHNV for FPC compatibility
movaps [rsp + 30H], xmm7
movaps [rsp + 40H], xmm8
movaps [rsp + 50H], xmm9
movaps [rsp + 60H], xmm10
movaps [rsp + 70H], xmm11
movaps [rsp + 80H], xmm12
{$endif}
shl r8, 6
je @done
add r8, rcx
mov [rsp], r8
mov eax, [rdx]
mov ebx, [rdx + 4H]
mov edi, [rdx + 8H]
mov esi, [rdx + 0CH]
mov r8d, [rdx + 10H]
mov r9d, [rdx + 14H]
mov r10d, [rdx + 18H]
mov r11d, [rdx + 1CH]
movaps xmm12, [rip + @flip]
movaps xmm10, [rip + @00BA]
movaps xmm11, [rip + @DC00]
@loop0: mov rbp, [rip + K256Aligned]
movups xmm4, [rcx]
pshufb xmm4, xmm12
movups xmm5, [rcx + 10h]
pshufb xmm5, xmm12
movups xmm6, [rcx + 20h]
pshufb xmm6, xmm12
movups xmm7, [rcx + 30h]
pshufb xmm7, xmm12
mov [rsp + 8h], rcx
mov rcx, 3
@loop1: movaps xmm9, [rbp]
paddd xmm9, xmm4
movaps [rsp + 10h], xmm9
movaps xmm0, xmm7
mov r13d, r8d
ror r13d, 14
mov r14d, eax
palignr xmm0, xmm6, 04h
ror r14d, 9
xor r13d, r8d
mov r15d, r9d
ror r13d, 5
movaps xmm1, xmm5
xor r14d, eax
xor r15d, r10d
paddd xmm0, xmm4
xor r13d, r8d
and r15d, r8d
ror r14d, 11
palignr xmm1, xmm4, 04h
xor r14d, eax
ror r13d, 6
xor r15d, r10d
movaps xmm2, xmm1
ror r14d, 2
add r15d, r13d
add r15d, [rsp + 10h]
movaps xmm3, xmm1
mov r13d, eax
add r11d, r15d
mov r15d, eax
pslld xmm1, 25
or r13d, edi
add esi, r11d
and r15d, edi
psrld xmm2, 7
and r13d, ebx
add r11d, r14d
por xmm1, xmm2
or r13d, r15d
add r11d, r13d
movaps xmm2, xmm3
mov r13d, esi
mov r14d, r11d
movaps xmm8, xmm3
ror r13d, 14
xor r13d, esi
mov r15d, r8d
ror r14d, 9
pslld xmm3, 14
xor r14d, r11d
ror r13d, 5
xor r15d, r9d
psrld xmm2, 18
ror r14d, 11
xor r13d, esi
and r15d, esi
ror r13d, 6
pxor xmm1, xmm3
xor r14d, r11d
xor r15d, r9d
psrld xmm8, 3
add r15d, r13d
add r15d, [rsp + 14h]
ror r14d, 2
pxor xmm1, xmm2
mov r13d, r11d
add r10d, r15d
mov r15d, r11d
pxor xmm1, xmm8
or r13d, ebx
add edi, r10d
and r15d, ebx
pshufd xmm2, xmm7, 0fah
and r13d, eax
add r10d, r14d
paddd xmm0, xmm1
or r13d, r15d
add r10d, r13d
movaps xmm3, xmm2
mov r13d, edi
mov r14d, r10d
ror r13d, 14
movaps xmm8, xmm2
xor r13d, edi
ror r14d, 9
mov r15d, esi
xor r14d, r10d
ror r13d, 5
psrlq xmm2, 17
xor r15d, r8d
psrlq xmm3, 19
xor r13d, edi
and r15d, edi
psrld xmm8, 10
ror r14d, 11
xor r14d, r10d
xor r15d, r8d
ror r13d, 6
pxor xmm2, xmm3
add r15d, r13d
ror r14d, 2
add r15d, [rsp + 18h]
pxor xmm8, xmm2
mov r13d, r10d
add r9d, r15d
mov r15d, r10d
pshufb xmm8, xmm10
or r13d, eax
add ebx, r9d
and r15d, eax
paddd xmm0, xmm8
and r13d, r11d
add r9d, r14d
pshufd xmm2, xmm0, 50h
or r13d, r15d
add r9d, r13d
movaps xmm3, xmm2
mov r13d, ebx
ror r13d, 14
mov r14d, r9d
movaps xmm4, xmm2
ror r14d, 9
xor r13d, ebx
mov r15d, edi
ror r13d, 5
psrlq xmm2, 17
xor r14d, r9d
xor r15d, esi
psrlq xmm3, 19
xor r13d, ebx
and r15d, ebx
ror r14d, 11
psrld xmm4, 10
xor r14d, r9d
ror r13d, 6
xor r15d, esi
pxor xmm2, xmm3
ror r14d, 2
add r15d, r13d
add r15d, [rsp + 1ch]
pxor xmm4, xmm2
mov r13d, r9d
add r8d, r15d
mov r15d, r9d
pshufb xmm4, xmm11
or r13d, r11d
add eax, r8d
and r15d, r11d
paddd xmm4, xmm0
and r13d, r10d
add r8d, r14d
or r13d, r15d
add r8d, r13d
movaps xmm9, [rbp + 10h]
paddd xmm9, xmm5
movaps [rsp + 10h], xmm9
movaps xmm0, xmm4
mov r13d, eax
ror r13d, 14
mov r14d, r8d
palignr xmm0, xmm7, 04h
ror r14d, 9
xor r13d, eax
mov r15d, ebx
ror r13d, 5
movaps xmm1, xmm6
xor r14d, r8d
xor r15d, edi
paddd xmm0, xmm5
xor r13d, eax
and r15d, eax
ror r14d, 11
palignr xmm1, xmm5, 04h
xor r14d, r8d
ror r13d, 6
xor r15d, edi
movaps xmm2, xmm1
ror r14d, 2
add r15d, r13d
add r15d, [rsp + 10h]
movaps xmm3, xmm1
mov r13d, r8d
add esi, r15d
mov r15d, r8d
pslld xmm1, 25
or r13d, r10d
add r11d, esi
and r15d, r10d
psrld xmm2, 7
and r13d, r9d
add esi, r14d
por xmm1, xmm2
or r13d, r15d
add esi, r13d
movaps xmm2, xmm3
mov r13d, r11d
mov r14d, esi
movaps xmm8, xmm3
ror r13d, 14
xor r13d, r11d
mov r15d, eax
ror r14d, 9
pslld xmm3, 14
xor r14d, esi
ror r13d, 5
xor r15d, ebx
psrld xmm2, 18
ror r14d, 11
xor r13d, r11d
and r15d, r11d
ror r13d, 6
pxor xmm1, xmm3
xor r14d, esi
xor r15d, ebx
psrld xmm8, 3
add r15d, r13d
add r15d, [rsp + 14h]
ror r14d, 2
pxor xmm1, xmm2
mov r13d, esi
add edi, r15d
mov r15d, esi
pxor xmm1, xmm8
or r13d, r9d
add r10d, edi
and r15d, r9d
pshufd xmm2, xmm4, 0fah
and r13d, r8d
add edi, r14d
paddd xmm0, xmm1
or r13d, r15d
add edi, r13d
movaps xmm3, xmm2
mov r13d, r10d
mov r14d, edi
ror r13d, 14
movaps xmm8, xmm2
xor r13d, r10d
ror r14d, 9
mov r15d, r11d
xor r14d, edi
ror r13d, 5
psrlq xmm2, 17
xor r15d, eax
psrlq xmm3, 19
xor r13d, r10d
and r15d, r10d
psrld xmm8, 10
ror r14d, 11
xor r14d, edi
xor r15d, eax
ror r13d, 6
pxor xmm2, xmm3
add r15d, r13d
ror r14d, 2
add r15d, [rsp + 18h]
pxor xmm8, xmm2
mov r13d, edi
add ebx, r15d
mov r15d, edi
pshufb xmm8, xmm10
or r13d, r8d
add r9d, ebx
and r15d, r8d
paddd xmm0, xmm8
and r13d, esi
add ebx, r14d
pshufd xmm2, xmm0, 50h
or r13d, r15d
add ebx, r13d
movaps xmm3, xmm2
mov r13d, r9d
ror r13d, 14
mov r14d, ebx
movaps xmm5, xmm2
ror r14d, 9
xor r13d, r9d
mov r15d, r10d
ror r13d, 5
psrlq xmm2, 17
xor r14d, ebx
xor r15d, r11d
psrlq xmm3, 19
xor r13d, r9d
and r15d, r9d
ror r14d, 11
psrld xmm5, 10
xor r14d, ebx
ror r13d, 6
xor r15d, r11d
pxor xmm2, xmm3
ror r14d, 2
add r15d, r13d
add r15d, [rsp + 1ch]
pxor xmm5, xmm2
mov r13d, ebx
add eax, r15d
mov r15d, ebx
pshufb xmm5, xmm11
or r13d, esi
add r8d, eax
and r15d, esi
paddd xmm5, xmm0
and r13d, edi
add eax, r14d
or r13d, r15d
add eax, r13d
movaps xmm9, [rbp + 20h]
paddd xmm9, xmm6
movaps [rsp + 10h], xmm9
movaps xmm0, xmm5
mov r13d, r8d
ror r13d, 14
mov r14d, eax
palignr xmm0, xmm4, 04h
ror r14d, 9
xor r13d, r8d
mov r15d, r9d
ror r13d, 5
movaps xmm1, xmm7
xor r14d, eax
xor r15d, r10d
paddd xmm0, xmm6
xor r13d, r8d
and r15d, r8d
ror r14d, 11
palignr xmm1, xmm6, 04h
xor r14d, eax
ror r13d, 6
xor r15d, r10d
movaps xmm2, xmm1
ror r14d, 2
add r15d, r13d
add r15d, [rsp + 10h]
movaps xmm3, xmm1
mov r13d, eax
add r11d, r15d
mov r15d, eax
pslld xmm1, 25
or r13d, edi
add esi, r11d
and r15d, edi
psrld xmm2, 7
and r13d, ebx
add r11d, r14d
por xmm1, xmm2
or r13d, r15d
add r11d, r13d
movaps xmm2, xmm3
mov r13d, esi
mov r14d, r11d
movaps xmm8, xmm3
ror r13d, 14
xor r13d, esi
mov r15d, r8d
ror r14d, 9
pslld xmm3, 14
xor r14d, r11d
ror r13d, 5
xor r15d, r9d
psrld xmm2, 18
ror r14d, 11
xor r13d, esi
and r15d, esi
ror r13d, 6
pxor xmm1, xmm3
xor r14d, r11d
xor r15d, r9d
psrld xmm8, 3
add r15d, r13d
add r15d, [rsp + 14h]
ror r14d, 2
pxor xmm1, xmm2
mov r13d, r11d
add r10d, r15d
mov r15d, r11d
pxor xmm1, xmm8
or r13d, ebx
add edi, r10d
and r15d, ebx
pshufd xmm2, xmm5, 0fah
and r13d, eax
add r10d, r14d
paddd xmm0, xmm1
or r13d, r15d
add r10d, r13d
movaps xmm3, xmm2
mov r13d, edi
mov r14d, r10d
ror r13d, 14
movaps xmm8, xmm2
xor r13d, edi
ror r14d, 9
mov r15d, esi
xor r14d, r10d
ror r13d, 5
psrlq xmm2, 17
xor r15d, r8d
psrlq xmm3, 19
xor r13d, edi
and r15d, edi
psrld xmm8, 10
ror r14d, 11
xor r14d, r10d
xor r15d, r8d
ror r13d, 6
pxor xmm2, xmm3
add r15d, r13d
ror r14d, 2
add r15d, [rsp + 18h]
pxor xmm8, xmm2
mov r13d, r10d
add r9d, r15d
mov r15d, r10d
pshufb xmm8, xmm10
or r13d, eax
add ebx, r9d
and r15d, eax
paddd xmm0, xmm8
and r13d, r11d
add r9d, r14d
pshufd xmm2, xmm0, 50h
or r13d, r15d
add r9d, r13d
movaps xmm3, xmm2
mov r13d, ebx
ror r13d, 14
mov r14d, r9d
movaps xmm6, xmm2
ror r14d, 9
xor r13d, ebx
mov r15d, edi
ror r13d, 5
psrlq xmm2, 17
xor r14d, r9d
xor r15d, esi
psrlq xmm3, 19
xor r13d, ebx
and r15d, ebx
ror r14d, 11
psrld xmm6, 10
xor r14d, r9d
ror r13d, 6
xor r15d, esi
pxor xmm2, xmm3
ror r14d, 2
add r15d, r13d
add r15d, [rsp + 1ch]
pxor xmm6, xmm2
mov r13d, r9d
add r8d, r15d
mov r15d, r9d
pshufb xmm6, xmm11
or r13d, r11d
add eax, r8d
and r15d, r11d
paddd xmm6, xmm0
and r13d, r10d
add r8d, r14d
or r13d, r15d
add r8d, r13d
movaps xmm9, [rbp + 30h]
paddd xmm9, xmm7
movaps [rsp + 10h], xmm9
add rbp, 64
movaps xmm0, xmm6
mov r13d, eax
ror r13d, 14
mov r14d, r8d
palignr xmm0, xmm5, 04h
ror r14d, 9
xor r13d, eax
mov r15d, ebx
ror r13d, 5
movaps xmm1, xmm4
xor r14d, r8d
xor r15d, edi
paddd xmm0, xmm7
xor r13d, eax
and r15d, eax
ror r14d, 11
palignr xmm1, xmm7, 04h
xor r14d, r8d
ror r13d, 6
xor r15d, edi
movaps xmm2, xmm1
ror r14d, 2
add r15d, r13d
add r15d, [rsp + 10h]
movaps xmm3, xmm1
mov r13d, r8d
add esi, r15d
mov r15d, r8d
pslld xmm1, 25
or r13d, r10d
add r11d, esi
and r15d, r10d
psrld xmm2, 7
and r13d, r9d
add esi, r14d
por xmm1, xmm2
or r13d, r15d
add esi, r13d
movaps xmm2, xmm3
mov r13d, r11d
mov r14d, esi
movaps xmm8, xmm3
ror r13d, 14
xor r13d, r11d
mov r15d, eax
ror r14d, 9
pslld xmm3, 14
xor r14d, esi
ror r13d, 5
xor r15d, ebx
psrld xmm2, 18
ror r14d, 11
xor r13d, r11d
and r15d, r11d
ror r13d, 6
pxor xmm1, xmm3
xor r14d, esi
xor r15d, ebx
psrld xmm8, 3
add r15d, r13d
add r15d, [rsp + 14h]
ror r14d, 2
pxor xmm1, xmm2
mov r13d, esi
add edi, r15d
mov r15d, esi
pxor xmm1, xmm8
or r13d, r9d
add r10d, edi
and r15d, r9d
pshufd xmm2, xmm6, 0fah
and r13d, r8d
add edi, r14d
paddd xmm0, xmm1
or r13d, r15d
add edi, r13d
movaps xmm3, xmm2
mov r13d, r10d
mov r14d, edi
ror r13d, 14
movaps xmm8, xmm2
xor r13d, r10d
ror r14d, 9
mov r15d, r11d
xor r14d, edi
ror r13d, 5
psrlq xmm2, 17
xor r15d, eax
psrlq xmm3, 19
xor r13d, r10d
and r15d, r10d
psrld xmm8, 10
ror r14d, 11
xor r14d, edi
xor r15d, eax
ror r13d, 6
pxor xmm2, xmm3
add r15d, r13d
ror r14d, 2
add r15d, [rsp + 18h]
pxor xmm8, xmm2
mov r13d, edi
add ebx, r15d
mov r15d, edi
pshufb xmm8, xmm10
or r13d, r8d
add r9d, ebx
and r15d, r8d
paddd xmm0, xmm8
and r13d, esi
add ebx, r14d
pshufd xmm2, xmm0, 50h
or r13d, r15d
add ebx, r13d
movaps xmm3, xmm2
mov r13d, r9d
ror r13d, 14
mov r14d, ebx
movaps xmm7, xmm2
ror r14d, 9
xor r13d, r9d
mov r15d, r10d
ror r13d, 5
psrlq xmm2, 17
xor r14d, ebx
xor r15d, r11d
psrlq xmm3, 19
xor r13d, r9d
and r15d, r9d
ror r14d, 11
psrld xmm7, 10
xor r14d, ebx
ror r13d, 6
xor r15d, r11d
pxor xmm2, xmm3
ror r14d, 2
add r15d, r13d
add r15d, [rsp + 1ch]
pxor xmm7, xmm2
mov r13d, ebx
add eax, r15d
mov r15d, ebx
pshufb xmm7, xmm11
or r13d, esi
add r8d, eax
and r15d, esi
paddd xmm7, xmm0
and r13d, edi
add eax, r14d
or r13d, r15d
add eax, r13d
sub rcx, 1
jne @loop1
mov rcx, 2
@loop2: paddd xmm4, [rbp]
movaps [rsp + 10h], xmm4
mov r13d, r8d
ror r13d, 14
mov r14d, eax
xor r13d, r8d
ror r14d, 9
mov r15d, r9d
xor r14d, eax
ror r13d, 5
xor r15d, r10d
xor r13d, r8d
ror r14d, 11
and r15d, r8d
xor r14d, eax
ror r13d, 6
xor r15d, r10d
add r15d, r13d
ror r14d, 2
add r15d, [rsp + 10h]
mov r13d, eax
add r11d, r15d
mov r15d, eax
or r13d, edi
add esi, r11d
and r15d, edi
and r13d, ebx
add r11d, r14d
or r13d, r15d
add r11d, r13d
mov r13d, esi
ror r13d, 14
mov r14d, r11d
xor r13d, esi
ror r14d, 9
mov r15d, r8d
xor r14d, r11d
ror r13d, 5
xor r15d, r9d
xor r13d, esi
ror r14d, 11
and r15d, esi
xor r14d, r11d
ror r13d, 6
xor r15d, r9d
add r15d, r13d
ror r14d, 2
add r15d, [rsp + 14h]
mov r13d, r11d
add r10d, r15d
mov r15d, r11d
or r13d, ebx
add edi, r10d
and r15d, ebx
and r13d, eax
add r10d, r14d
or r13d, r15d
add r10d, r13d
mov r13d, edi
ror r13d, 14
mov r14d, r10d
xor r13d, edi
ror r14d, 9
mov r15d, esi
xor r14d, r10d
ror r13d, 5
xor r15d, r8d
xor r13d, edi
ror r14d, 11
and r15d, edi
xor r14d, r10d
ror r13d, 6
xor r15d, r8d
add r15d, r13d
ror r14d, 2
add r15d, [rsp + 18h]
mov r13d, r10d
add r9d, r15d
mov r15d, r10d
or r13d, eax
add ebx, r9d
and r15d, eax
and r13d, r11d
add r9d, r14d
or r13d, r15d
add r9d, r13d
mov r13d, ebx
ror r13d, 14
mov r14d, r9d
xor r13d, ebx
ror r14d, 9
mov r15d, edi
xor r14d, r9d
ror r13d, 5
xor r15d, esi
xor r13d, ebx
ror r14d, 11
and r15d, ebx
xor r14d, r9d
ror r13d, 6
xor r15d, esi
add r15d, r13d
ror r14d, 2
add r15d, [rsp + 1ch]
mov r13d, r9d
add r8d, r15d
mov r15d, r9d
or r13d, r11d
add eax, r8d
and r15d, r11d
and r13d, r10d
add r8d, r14d
or r13d, r15d
add r8d, r13d
paddd xmm5, [rbp + 10h]
movaps [rsp + 10h], xmm5
add rbp, 32
mov r13d, eax
ror r13d, 14
mov r14d, r8d
xor r13d, eax
ror r14d, 9
mov r15d, ebx
xor r14d, r8d
ror r13d, 5
xor r15d, edi
xor r13d, eax
ror r14d, 11
and r15d, eax
xor r14d, r8d
ror r13d, 6
xor r15d, edi
add r15d, r13d
ror r14d, 2
add r15d, [rsp + 10h]
mov r13d, r8d
add esi, r15d
mov r15d, r8d
or r13d, r10d
add r11d, esi
and r15d, r10d
and r13d, r9d
add esi, r14d
or r13d, r15d
add esi, r13d
mov r13d, r11d
ror r13d, 14
mov r14d, esi
xor r13d, r11d
ror r14d, 9
mov r15d, eax
xor r14d, esi
ror r13d, 5
xor r15d, ebx
xor r13d, r11d
ror r14d, 11
and r15d, r11d
xor r14d, esi
ror r13d, 6
xor r15d, ebx
add r15d, r13d
ror r14d, 2
add r15d, [rsp + 14h]
mov r13d, esi
add edi, r15d
mov r15d, esi
or r13d, r9d
add r10d, edi
and r15d, r9d
and r13d, r8d
add edi, r14d
or r13d, r15d
add edi, r13d
mov r13d, r10d
ror r13d, 14
mov r14d, edi
xor r13d, r10d
ror r14d, 9
mov r15d, r11d
xor r14d, edi
ror r13d, 5
xor r15d, eax
xor r13d, r10d
ror r14d, 11
and r15d, r10d
xor r14d, edi
ror r13d, 6
xor r15d, eax
add r15d, r13d
ror r14d, 2
add r15d, [rsp + 18h]
mov r13d, edi
add ebx, r15d
mov r15d, edi
or r13d, r8d
add r9d, ebx
and r15d, r8d
and r13d, esi
add ebx, r14d
or r13d, r15d
add ebx, r13d
mov r13d, r9d
ror r13d, 14
mov r14d, ebx
xor r13d, r9d
ror r14d, 9
mov r15d, r10d
xor r14d, ebx
ror r13d, 5
xor r15d, r11d
xor r13d, r9d
ror r14d, 11
and r15d, r9d
xor r14d, ebx
ror r13d, 6
xor r15d, r11d
add r15d, r13d
ror r14d, 2
add r15d, [rsp + 1ch]
mov r13d, ebx
add eax, r15d
mov r15d, ebx
or r13d, esi
add r8d, eax
and r15d, esi
and r13d, edi
add eax, r14d
or r13d, r15d
add eax, r13d
movaps xmm4, xmm6
movaps xmm5, xmm7
dec rcx
jne @loop2
add eax, [rdx]
mov [rdx], eax
add ebx, [rdx + 4H]
add edi, [rdx + 8H]
add esi, [rdx + 0CH]
add r8d, [rdx + 10H]
add r9d, [rdx + 14H]
add r10d, [rdx + 18H]
add r11d, [rdx + 1CH]
mov [rdx + 4H], ebx
mov [rdx + 8H], edi
mov [rdx + 0CH], esi
mov [rdx + 10H], r8d
mov [rdx + 14H], r9d
mov [rdx + 18H], r10d
mov [rdx + 1CH], r11d
mov rcx, [rsp + 8H]
add rcx, 64
cmp rcx, [rsp]
jne @loop0
@done: {$ifndef LINUX}
movaps xmm6, [rsp + 20H]
movaps xmm7, [rsp + 30H]
movaps xmm8, [rsp + 40H]
movaps xmm9, [rsp + 50H]
movaps xmm10, [rsp + 60H]
movaps xmm11, [rsp + 70H]
movaps xmm12, [rsp + 80H]
{$endif}
add rsp, STACK_SIZE
pop r15
pop r14
pop r13
pop rbp
{$ifndef LINUX}
pop rdi
pop rsi
{$endif}
pop rbx
ret
{$ifdef FPC} align 16 {$else} .align 16 {$endif}
@flip: dq $0405060700010203
dq $0C0D0E0F08090A0B
@00BA: dq $0B0A090803020100
dq $FFFFFFFFFFFFFFFF
@DC00: dq $FFFFFFFFFFFFFFFF
dq $0B0A090803020100
end;
{$endif CPUX64}
procedure Sha256CompressPas(var Hash: TSHAHash; Data: pointer);
// Actual hashing function
var H: TSHAHash;
W: array[0..63] of cardinal;
{$ifdef PUREPASCAL}
i: integer;
t1, t2: cardinal;
{$endif}
begin
// calculate "expanded message blocks"
Sha256ExpandMessageBlocks(@W,Data);
// assign old working hash to local variables A..H
H.A := Hash.A;
H.B := Hash.B;
H.C := Hash.C;
H.D := Hash.D;
H.E := Hash.E;
H.F := Hash.F;
H.G := Hash.G;
H.H := Hash.H;
{$ifdef PUREPASCAL}
// SHA-256 compression function
for i := 0 to high(W) do begin
{$ifdef FPC} // uses built-in right rotate intrinsic
t1 := H.H+(RorDWord(H.E,6) xor RorDWord(H.E,11) xor RorDWord(H.E,25))+
((H.E and H.F)xor(not H.E and H.G))+K256[i]+W[i];
t2 := (RorDWord(H.A,2) xor RorDWord(H.A,13) xor RorDWord(H.A,22))+
((H.A and H.B)xor(H.A and H.C)xor(H.B and H.C));
{$else}
t1 := H.H+(((H.E shr 6)or(H.E shl 26))xor((H.E shr 11)or(H.E shl 21))xor
((H.E shr 25)or(H.E shl 7)))+((H.E and H.F)xor(not H.E and H.G))+K256[i]+W[i];
t2 := (((H.A shr 2)or(H.A shl 30))xor((H.A shr 13)or(H.A shl 19))xor
((H.A shr 22)xor(H.A shl 10)))+((H.A and H.B)xor(H.A and H.C)xor(H.B and H.C));
{$endif}
H.H := H.G; H.G := H.F; H.F := H.E; H.E := H.D+t1;
H.D := H.C; H.C := H.B; H.B := H.A; H.A := t1+t2;
end;
{$else}
// SHA-256 compression function - optimized by A.B. for pipelined CPU
asm
push ebx
push esi
push edi
xor edi,edi // edi=i
// rolled version faster than the unrolled one (good pipelining work :)
@s: mov eax,[H].TSHAHash.E
mov ecx,eax
mov edx,eax
mov ebx,eax // ebx=E
ror eax,6
ror edx,11
ror ecx,25
xor eax,edx
mov edx,[H].TSHAHash.G
xor eax,ecx
mov ecx,[H].TSHAHash.H
add ecx,eax // T1=ecx
mov eax,[H].TSHAHash.F
mov [H].TSHAHash.H,edx
mov [H].TSHAHash.G,eax
xor eax,edx
mov [H].TSHAHash.F,ebx
and eax,ebx
xor eax,edx
add eax,dword ptr [K256+edi*4]
add eax,ecx
mov ecx,[H].TSHAHash.D
add eax,dword ptr [W+edi*4]
mov ebx,[H].TSHAHash.A
// eax= T1 := H + Sum1(E) +(((F xor G) and E) xor G)+K256[i]+W[i];
add ecx,eax
mov esi,eax // esi = T1
mov [H].TSHAHash.E,ecx // E := D + T1;
mov eax,ebx // Sum0(A)
mov edx,ebx
ror eax,2
mov ecx,ebx
ror edx,13
ror ecx,22
xor eax,edx
xor eax,ecx // eax = Sum0(A)
mov ecx,[H].TSHAHash.B
add esi,eax
mov eax,ebx // ebx=A
mov edx,ebx // eax=edx=A
or eax,ecx
and eax,[H].TSHAHash.C // eax = (A or B)and C
and edx,ecx
or eax,edx // eax = ((A or B)and C) or (A and B)
inc edi
add esi,eax // esi= T1+T2
mov [H].TSHAHash.A,esi // all these instructions are pipelined -> roll OK
mov eax,[H].TSHAHash.C // eax=C ecx=B ebx=A
mov [H].TSHAHash.B,ebx
mov [H].TSHAHash.C,ecx
mov [H].TSHAHash.D,eax
cmp edi,64
jnz @s
pop edi
pop esi
pop ebx
end;
{$endif PUREPASCAL}
// calculate new working hash
inc(Hash.A,H.A);
inc(Hash.B,H.B);
inc(Hash.C,H.C);
inc(Hash.D,H.D);
inc(Hash.E,H.E);
inc(Hash.F,H.F);
inc(Hash.G,H.G);
inc(Hash.H,H.H);
end;
procedure RawSha256Compress(var Hash; Data: pointer);
begin
{$ifdef CPUX64}
if K256AlignedStore<>'' then // use optimized Intel's sha256_sse4.asm
sha256_sse4(Data^,Hash,1) else
{$endif CPUX64}
Sha256CompressPas(TSHAHash(Hash),Data);
end;
procedure TSHA256.Final(out Digest: TSHA256Digest; NoInit: boolean);
// finalize SHA-256 calculation, clear context
var Data: TSHAContext absolute Context;
begin
// append bit '1' after Buffer
Data.Buffer[Data.Index] := $80;
FillcharFast(Data.Buffer[Data.Index+1],63-Data.Index,0);
// compress if more than 448 bits (no space for 64 bit length storage)
if Data.Index>=56 then begin
RawSha256Compress(Data.Hash,@Data.Buffer);
FillcharFast(Data.Buffer,56,0);
end;
// write 64 bit Buffer length into the last bits of the last block
// (in big endian format) and do a final compress
PInteger(@Data.Buffer[56])^ := bswap32(TQWordRec(Data.MLen).H);
PInteger(@Data.Buffer[60])^ := bswap32(TQWordRec(Data.MLen).L);
RawSha256Compress(Data.Hash,@Data.Buffer);
// Hash -> Digest to little endian format
bswap256(@Data.Hash,@Digest);
// clear Data and internally stored Digest
if not NoInit then
Init;
end;
function TSHA256.Final(NoInit: boolean): TSHA256Digest;
begin
Final(result,NoInit);
end;
procedure TSHA256.Full(Buffer: pointer; Len: integer; out Digest: TSHA256Digest);
begin
{$ifdef USEPADLOCK}
// Padlock need all data once -> Full() is OK, not successive Update()
if padlock_available then begin
Init; // for later Update use
{$ifdef PADLOCKDEBUG}write('padlock_phe_sha256 ');{$endif}
if padlock_phe_sha256(buffer,Len,Digest)=0 then
exit else
{$ifdef PADLOCKDEBUG}write(':ERROR ');{$endif}
end;
{$endif}
Init;
Update(Buffer,Len);
Final(Digest);
end;
procedure TSHA256.Init;
var Data: TSHAContext absolute Context;
begin
Data.Hash.A := $6a09e667;
Data.Hash.B := $bb67ae85;
Data.Hash.C := $3c6ef372;
Data.Hash.D := $a54ff53a;
Data.Hash.E := $510e527f;
Data.Hash.F := $9b05688c;
Data.Hash.G := $1f83d9ab;
Data.Hash.H := $5be0cd19;
FillcharFast(Data.MLen,sizeof(Data)-sizeof(Data.Hash),0);
end;
procedure TSHA256.Update(Buffer: pointer; Len: integer);
var Data: TSHAContext absolute Context;
aLen: integer;
begin
if Buffer=nil then exit; // avoid GPF
inc(Data.MLen,QWord(cardinal(Len)) shl 3);
{$ifdef CPUX64}
if (K256AlignedStore<>'') and (Data.Index=0) and (Len>=64) then begin
// use optimized Intel's sha256_sse4.asm for whole blocks
sha256_sse4(Buffer^,Data.Hash,Len shr 6);
inc(PByte(Buffer),Len);
Len := Len and 63;
dec(PByte(Buffer),Len);
end;
{$endif CPUX64}
while Len>0 do begin
aLen := 64-Data.Index;
if aLen<=Len then begin
if Data.Index<>0 then begin
MoveFast(Buffer^,Data.Buffer[Data.Index],aLen);
RawSha256Compress(Data.Hash,@Data.Buffer);
Data.Index := 0;
end else
RawSha256Compress(Data.Hash,Buffer); // avoid temporary copy
dec(Len,aLen);
inc(PByte(Buffer),aLen);
end else begin
MoveFast(Buffer^,Data.Buffer[Data.Index],Len);
inc(Data.Index,Len);
break;
end;
end;
end;
procedure TSHA256.Update(const Buffer: RawByteString);
begin
Update(pointer(Buffer),length(Buffer));
end;
procedure SHA256Weak(const s: RawByteString; out Digest: TSHA256Digest);
var L: integer;
SHA: TSHA256;
p: PAnsiChar;
tmp: array[0..255] of byte;
begin
L := length(s);
p := pointer(s);
if L<sizeof(tmp) then begin
FillcharFast(tmp,sizeof(tmp),L); // add some salt to unweak password
if L>0 then
MoveFast(p^,tmp,L);
SHA.Full(@tmp,sizeof(tmp),Digest);
end else
SHA.Full(p,L,Digest);
end;
{ common SHA384/SHA512 hashing kernel }
const
SHA512K: array[0..79] of QWord = (
QWord($428a2f98d728ae22),QWord($7137449123ef65cd),QWord($b5c0fbcfec4d3b2f),QWord($e9b5dba58189dbbc),
QWord($3956c25bf348b538),QWord($59f111f1b605d019),QWord($923f82a4af194f9b),QWord($ab1c5ed5da6d8118),
QWord($d807aa98a3030242),QWord($12835b0145706fbe),QWord($243185be4ee4b28c),QWord($550c7dc3d5ffb4e2),
QWord($72be5d74f27b896f),QWord($80deb1fe3b1696b1),QWord($9bdc06a725c71235),QWord($c19bf174cf692694),
QWord($e49b69c19ef14ad2),QWord($efbe4786384f25e3),QWord($0fc19dc68b8cd5b5),QWord($240ca1cc77ac9c65),
QWord($2de92c6f592b0275),QWord($4a7484aa6ea6e483),QWord($5cb0a9dcbd41fbd4),QWord($76f988da831153b5),
QWord($983e5152ee66dfab),QWord($a831c66d2db43210),QWord($b00327c898fb213f),QWord($bf597fc7beef0ee4),
QWord($c6e00bf33da88fc2),QWord($d5a79147930aa725),QWord($06ca6351e003826f),QWord($142929670a0e6e70),
QWord($27b70a8546d22ffc),QWord($2e1b21385c26c926),QWord($4d2c6dfc5ac42aed),QWord($53380d139d95b3df),
QWord($650a73548baf63de),QWord($766a0abb3c77b2a8),QWord($81c2c92e47edaee6),QWord($92722c851482353b),
QWord($a2bfe8a14cf10364),QWord($a81a664bbc423001),QWord($c24b8b70d0f89791),QWord($c76c51a30654be30),
QWord($d192e819d6ef5218),QWord($d69906245565a910),QWord($f40e35855771202a),QWord($106aa07032bbd1b8),
QWord($19a4c116b8d2d0c8),QWord($1e376c085141ab53),QWord($2748774cdf8eeb99),QWord($34b0bcb5e19b48a8),
QWord($391c0cb3c5c95a63),QWord($4ed8aa4ae3418acb),QWord($5b9cca4f7763e373),QWord($682e6ff3d6b2b8a3),
QWord($748f82ee5defb2fc),QWord($78a5636f43172f60),QWord($84c87814a1f0ab72),QWord($8cc702081a6439ec),
QWord($90befffa23631e28),QWord($a4506cebde82bde9),QWord($bef9a3f7b2c67915),QWord($c67178f2e372532b),
QWord($ca273eceea26619c),QWord($d186b8c721c0c207),QWord($eada7dd6cde0eb1e),QWord($f57d4f7fee6ed178),
QWord($06f067aa72176fba),QWord($0a637dc5a2c898a6),QWord($113f9804bef90dae),QWord($1b710b35131c471b),
QWord($28db77f523047d84),QWord($32caab7b40c72493),QWord($3c9ebe0a15c9bebc),QWord($431d67c49c100d4c),
QWord($4cc5d4becb3e42b6),QWord($597f299cfc657e2a),QWord($5fcb6fab3ad6faec),QWord($6c44198c4a475817));
procedure sha512_compresspas(var Hash: TSHA512Hash; Data: PQWordArray);
var a,b,c,d,e,f,g,h, temp1,temp2: QWord; // to use registers on CPU64
w: array[0..79] of QWord;
i: integer;
begin
bswap64array(Data,@w,16);
for i := 16 to 79 do
{$ifdef FPC} // uses faster built-in right rotate intrinsic
w[i] := (RorQWord(w[i-2],19) xor RorQWord(w[i-2],61) xor (w[i-2] shr 6)) +
w[i-7] + (RorQWord(w[i-15],1) xor RorQWord(w[i-15],8) xor (w[i-15] shr 7)) + w[i-16];
{$else}
w[i] := (((w[i-2] shr 19) or (w[i-2] shl 45)) xor ((w[i-2] shr 61) or (w[i-2] shl 3)) xor
(w[i-2] shr 6)) + w[i-7] + (((w[i-15] shr 1) or (w[i-15] shl 63)) xor
((w[i-15] shr 8) or (w[i-15] shl 56)) xor (w[i-15] shr 7)) + w[i-16];
{$endif}
a := Hash.a;
b := Hash.b;
c := Hash.c;
d := Hash.d;
e := Hash.e;
f := Hash.f;
g := Hash.g;
h := Hash.h;
for i := 0 to 79 do begin
{$ifdef FPC}
temp1 := h + (RorQWord(e,14) xor RorQWord(e,18) xor RorQWord(e,41)) +
((e and f) xor (not e and g)) + SHA512K[i] + w[i];
temp2 := (RorQWord(a,28) xor RorQWord(a,34) xor RorQWord(a,39)) +
((a and b) xor (a and c) xor (b and c));
{$else}
temp1 := h + (((e shr 14) or (e shl 50)) xor ((e shr 18) or (e shl 46)) xor
((e shr 41) or (e shl 23))) + ((e and f) xor (not e and g)) + SHA512K[i] + w[i];
temp2 := (((a shr 28) or (a shl 36)) xor ((a shr 34) or (a shl 30)) xor
((a shr 39) or (a shl 25))) + ((a and b) xor (a and c) xor (b and c));
{$endif}
h := g;
g := f;
f := e;
e := d + temp1;
d := c;
c := b;
b := a;
a := temp1 + temp2;
end;
inc(Hash.a,a);
inc(Hash.b,b);
inc(Hash.c,c);
inc(Hash.d,d);
inc(Hash.e,e);
inc(Hash.f,f);
inc(Hash.g,g);
inc(Hash.h,h);
end;
{$ifdef SHA512_X86} // optimized asm using SSE3 instructions for x86 32-bit
{$ifdef FPC}
{$ifdef MSWINDOWS}
{$L static\i386-win32\sha512-x86.o}
{$else}
{$L static/i386-linux/sha512-x86.o}
{$endif}
{$else}
{$L sha512-x86.obj}
{$endif}
{
SHA-512 hash in x86 assembly
Copyright (c) 2014 Project Nayuki. (MIT License)
https://www.nayuki.io/page/fast-sha2-hashes-in-x86-assembly
Permission is hereby granted, free of charge, to any person obtaining a copy of
this software and associated documentation files (the "Software"), to deal in
the Software without restriction, including without limitation the rights to
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
the Software, and to permit persons to whom the Software is furnished to do so,
subject to the following conditions:
- The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
- The Software is provided "as is", without warranty of any kind, express or
implied, including but not limited to the warranties of merchantability,
fitness for a particular purpose and noninfringement. In no event shall the
authors or copyright holders be liable for any claim, damages or other liability,
whether in an action of contract, tort or otherwise, arising from, out of or
in connection with the Software or the use or other dealings in the Software.
}
procedure sha512_compress(state: PQWord; block: PByteArray); cdecl; external;
{$endif SHA512_X86}
{$ifdef SHA512_X64} // optimized asm using SSE4 instructions for x64 64-bit
{$ifdef FPC}
{$ifdef MSWINDOWS}
{$L sha512-x64sse4.obj}
{$else}
{$L static/x86_64-linux/sha512-x64sse4.o}
{$endif}
{$else}
{$L sha512-x64sse4.obj}
{$endif}
procedure sha512_sse4(data, hash: pointer; blocks: Int64); {$ifdef FPC}cdecl;{$endif} external;
{$endif SHA512_X64}
procedure RawSha512Compress(var Hash; Data: pointer);
begin
{$ifdef SHA512_X86}
if cfSSSE3 in CpuFeatures then
sha512_compress(@Hash,Data) else
{$endif}
{$ifdef SHA512_X64}
if cfSSE41 in CpuFeatures then
sha512_sse4(Data,@Hash,1) else
{$endif}
sha512_compresspas(TSHA512Hash(Hash), Data);
end;
{ TSHA384 }
procedure TSHA384.Final(out Digest: TSHA384Digest; NoInit: boolean);
begin
Data[Index] := $80;
FillcharFast(Data[Index+1],127-Index,0);
if Index>=112 then begin
RawSha512Compress(Hash,@Data);
FillcharFast(Data,112,0);
end;
PQWord(@Data[112])^ := bswap64(MLen shr 61);
PQWord(@Data[120])^ := bswap64(MLen shl 3);
RawSha512Compress(Hash,@Data);
bswap64array(@Hash,@Digest,6);
if not NoInit then
Init;
end;
function TSHA384.Final(NoInit: boolean): TSHA384Digest;
begin
Final(result,NoInit);
end;
procedure TSHA384.Full(Buffer: pointer; Len: integer; out Digest: TSHA384Digest);
begin
Init;
Update(Buffer,Len); // final bytes
Final(Digest);
end;
procedure TSHA384.Init;
begin
Hash.a := QWord($cbbb9d5dc1059ed8);
Hash.b := QWord($629a292a367cd507);
Hash.c := QWord($9159015a3070dd17);
Hash.d := QWord($152fecd8f70e5939);
Hash.e := QWord($67332667ffc00b31);
Hash.f := QWord($8eb44a8768581511);
Hash.g := QWord($db0c2e0d64f98fa7);
Hash.h := QWord($47b5481dbefa4fa4);
MLen := 0;
Index := 0;
FillcharFast(Data,sizeof(Data),0);
end;
procedure TSHA384.Update(Buffer: pointer; Len: integer);
var aLen: integer;
begin
if (Buffer=nil) or (Len<=0) then exit; // avoid GPF
inc(MLen,Len);
repeat
aLen := sizeof(Data)-Index;
if aLen<=Len then begin
if Index<>0 then begin
MoveFast(Buffer^,Data[Index],aLen);
RawSha512Compress(Hash,@Data);
Index := 0;
end else // avoid temporary copy
RawSha512Compress(Hash,Buffer);
dec(Len,aLen);
inc(PByte(Buffer),aLen);
end else begin
MoveFast(Buffer^,Data[Index],Len);
inc(Index,Len);
break;
end;
until Len<=0;
end;
procedure TSHA384.Update(const Buffer: RawByteString);
begin
Update(pointer(Buffer),length(Buffer));
end;
{ TSHA512 }
procedure TSHA512.Final(out Digest: TSHA512Digest; NoInit: boolean);
begin
Data[Index] := $80;
FillcharFast(Data[Index+1],127-Index,0);
if Index>=112 then begin
RawSha512Compress(Hash,@Data);
FillcharFast(Data,112,0);
end;
PQWord(@Data[112])^ := bswap64(MLen shr 61);
PQWord(@Data[120])^ := bswap64(MLen shl 3);
RawSha512Compress(Hash,@Data);
bswap64array(@Hash,@Digest,8);
if not NoInit then
Init;
end;
function TSHA512.Final(NoInit: boolean): TSHA512Digest;
begin
Final(result,NoInit);
end;
procedure TSHA512.Full(Buffer: pointer; Len: integer; out Digest: TSHA512Digest);
begin
Init;
Update(Buffer,Len); // final bytes
Final(Digest);
end;
procedure TSHA512.Init;
begin
Hash.a := $6a09e667f3bcc908;
Hash.b := QWord($bb67ae8584caa73b);
Hash.c := $3c6ef372fe94f82b;
Hash.d := QWord($a54ff53a5f1d36f1);
Hash.e := $510e527fade682d1;
Hash.f := QWord($9b05688c2b3e6c1f);
Hash.g := $1f83d9abfb41bd6b;
Hash.h := $5be0cd19137e2179;
MLen := 0;
Index := 0;
FillcharFast(Data,sizeof(Data),0);
end;
procedure TSHA512.Update(Buffer: pointer; Len: integer);
var aLen: integer;
begin
if (Buffer=nil) or (Len<=0) then exit; // avoid GPF
inc(MLen,Len);
repeat
aLen := sizeof(Data)-Index;
if aLen<=Len then begin
if Index<>0 then begin
MoveFast(Buffer^,Data[Index],aLen);
RawSha512Compress(Hash,@Data);
Index := 0;
end else // avoid temporary copy
RawSha512Compress(Hash,Buffer);
dec(Len,aLen);
inc(PByte(Buffer),aLen);
end else begin
MoveFast(Buffer^,Data[Index],Len);
inc(Index,Len);
break;
end;
until Len<=0;
end;
procedure TSHA512.Update(const Buffer: RawByteString);
begin
Update(pointer(Buffer),length(Buffer));
end;
{ TSHA3 }
{ SHA-3 / Keccak original code (c) Wolfgang Ehrhardt under zlib license:
Permission is granted to anyone to use this software for any purpose,
including commercial applications, and to alter it and redistribute it
freely, subject to the following restrictions:
1. The origin of this software must not be misrepresented; you must not
claim that you wrote the original software. If you use this software in
a product, an acknowledgment in the product documentation would be
appreciated but is not required.
2. Altered source versions must be plainly marked as such, and must not be
misrepresented as being the original software.
3. This notice may not be removed or altered from any source distribution. }
const
cKeccakPermutationSize = 1600;
cKeccakMaximumRate = 1536;
cKeccakPermutationSizeInBytes = cKeccakPermutationSize div 8;
cKeccakMaximumRateInBytes = cKeccakMaximumRate div 8;
cKeccakNumberOfRounds = 24;
cRoundConstants: array[0..cKeccakNumberOfRounds-1] of QWord = (
QWord($0000000000000001), QWord($0000000000008082), QWord($800000000000808A),
QWord($8000000080008000), QWord($000000000000808B), QWord($0000000080000001),
QWord($8000000080008081), QWord($8000000000008009), QWord($000000000000008A),
QWord($0000000000000088), QWord($0000000080008009), QWord($000000008000000A),
QWord($000000008000808B), QWord($800000000000008B), QWord($8000000000008089),
QWord($8000000000008003), QWord($8000000000008002), QWord($8000000000000080),
QWord($000000000000800A), QWord($800000008000000A), QWord($8000000080008081),
QWord($8000000000008080), QWord($0000000080000001), QWord($8000000080008008));
type
{$ifdef USERECORDWITHMETHODS}TSHA3Context = record
{$else}TSHA3Context = object{$endif}
public
State: packed array[0..cKeccakPermutationSizeInBytes-1] of byte;
DataQueue: packed array[0..cKeccakMaximumRateInBytes-1] of byte;
Algo: TSHA3Algo;
Squeezing: boolean;
Rate: integer;
Capacity: integer;
BitsInQueue: integer;
BitsAvailableForSqueezing: integer;
procedure Init(aAlgo: TSHA3Algo);
procedure InitSponge(aRate, aCapacity: integer);
procedure AbsorbQueue;
procedure Absorb(data: PByteArray; databitlen: integer);
procedure AbsorbFinal(data: PByteArray; databitlen: integer);
procedure PadAndSwitchToSqueezingPhase;
procedure Squeeze(output: PByteArray; outputLength: integer);
procedure FinalBit_LSB(bits: byte; bitlen: integer;
hashval: Pointer; numbits: integer);
end;
PSHA3Context = ^TSHA3Context;
{$ifdef SHA3_PASCAL}
{$ifdef FPC} // RotL/RolQword is an intrinsic function under FPC :)
function RotL(const x: QWord; c: integer): QWord; inline;
begin
result := RolQword(x, c);
end;
function RotL1(const x: QWord): QWord; inline;
begin
result := RolQword(x);
end;
{$else}
function RotL(const x: QWord; c: integer): QWord; {$ifdef HASINLINE}inline;{$endif}
begin
result := (x shl c) or (x shr (64 - c));
end;
function RotL1(var x: QWord): QWord; {$ifdef HASINLINE}inline;{$endif}
begin
result := (x shl 1) or (x shr (64 - 1));
end;
{$endif FPC}
procedure KeccakPermutation(A: PQWordArray);
var
B: array[0..24] of QWord;
C0, C1, C2, C3, C4, D0, D1, D2, D3, D4: QWord;
i: integer;
begin
for i := 0 to 23 do begin
C0 := A[00] xor A[05] xor A[10] xor A[15] xor A[20];
C1 := A[01] xor A[06] xor A[11] xor A[16] xor A[21];
C2 := A[02] xor A[07] xor A[12] xor A[17] xor A[22];
C3 := A[03] xor A[08] xor A[13] xor A[18] xor A[23];
C4 := A[04] xor A[09] xor A[14] xor A[19] xor A[24];
D0 := RotL1(C0) xor C3;
D1 := RotL1(C1) xor C4;
D2 := RotL1(C2) xor C0;
D3 := RotL1(C3) xor C1;
D4 := RotL1(C4) xor C2;
B[00] := A[00] xor D1;
B[01] := RotL(A[06] xor D2, 44);
B[02] := RotL(A[12] xor D3, 43);
B[03] := RotL(A[18] xor D4, 21);
B[04] := RotL(A[24] xor D0, 14);
B[05] := RotL(A[03] xor D4, 28);
B[06] := RotL(A[09] xor D0, 20);
B[07] := RotL(A[10] xor D1, 3);
B[08] := RotL(A[16] xor D2, 45);
B[09] := RotL(A[22] xor D3, 61);
B[10] := RotL(A[01] xor D2, 1);
B[11] := RotL(A[07] xor D3, 6);
B[12] := RotL(A[13] xor D4, 25);
B[13] := RotL(A[19] xor D0, 8);
B[14] := RotL(A[20] xor D1, 18);
B[15] := RotL(A[04] xor D0, 27);
B[16] := RotL(A[05] xor D1, 36);
B[17] := RotL(A[11] xor D2, 10);
B[18] := RotL(A[17] xor D3, 15);
B[19] := RotL(A[23] xor D4, 56);
B[20] := RotL(A[02] xor D3, 62);
B[21] := RotL(A[08] xor D4, 55);
B[22] := RotL(A[14] xor D0, 39);
B[23] := RotL(A[15] xor D1, 41);
B[24] := RotL(A[21] xor D2, 2);
A[00] := B[00] xor ((not B[01]) and B[02]);
A[01] := B[01] xor ((not B[02]) and B[03]);
A[02] := B[02] xor ((not B[03]) and B[04]);
A[03] := B[03] xor ((not B[04]) and B[00]);
A[04] := B[04] xor ((not B[00]) and B[01]);
A[05] := B[05] xor ((not B[06]) and B[07]);
A[06] := B[06] xor ((not B[07]) and B[08]);
A[07] := B[07] xor ((not B[08]) and B[09]);
A[08] := B[08] xor ((not B[09]) and B[05]);
A[09] := B[09] xor ((not B[05]) and B[06]);
A[10] := B[10] xor ((not B[11]) and B[12]);
A[11] := B[11] xor ((not B[12]) and B[13]);
A[12] := B[12] xor ((not B[13]) and B[14]);
A[13] := B[13] xor ((not B[14]) and B[10]);
A[14] := B[14] xor ((not B[10]) and B[11]);
A[15] := B[15] xor ((not B[16]) and B[17]);
A[16] := B[16] xor ((not B[17]) and B[18]);
A[17] := B[17] xor ((not B[18]) and B[19]);
A[18] := B[18] xor ((not B[19]) and B[15]);
A[19] := B[19] xor ((not B[15]) and B[16]);
A[20] := B[20] xor ((not B[21]) and B[22]);
A[21] := B[21] xor ((not B[22]) and B[23]);
A[22] := B[22] xor ((not B[23]) and B[24]);
A[23] := B[23] xor ((not B[24]) and B[20]);
A[24] := B[24] xor ((not B[20]) and B[21]);
A[00] := A[00] xor cRoundConstants[i];
end;
end;
{$else SHA3_PASCAL}
{ - MMX 32-bit assembler version based on optimized SHA-3 kernel by Eric Grange
https://www.delphitools.info/2016/04/19/new-sha-3-permutation-kernel
- new x64 assembler version by Synopse }
procedure KeccakPermutationKernel(B, A, C: Pointer);
{$ifdef CPU32} // Eric Grange's MMX version (PIC-safe)
{$ifdef FPC}nostackframe; assembler;{$endif}
asm
add edx, 128
add eax, 128
movq mm1, [edx - 120]
movq mm4, [edx - 96]
movq mm3, [edx - 104]
pxor mm1, [edx - 80]
movq mm5, [edx + 16]
pxor mm1, [edx]
movq mm2, [edx - 112]
pxor mm1, [edx + 40]
pxor mm1, [edx - 40]
movq mm0, [edx - 128]
movq mm6, mm1
pxor mm4, [edx - 56]
movq [ecx + 8], mm1
psrlq mm6, 63
pxor mm4, [edx + 24]
pxor mm4, [edx + 64]
pxor mm4, [edx - 16]
psllq mm1, 1
pxor mm2, [edx + 48]
por mm1, mm6
movq mm6, [edx - 88]
pxor mm1, mm4
pxor mm2, [edx - 32]
pxor mm2, [edx - 72]
pxor mm6, mm1
movq mm7, mm6
psrlq mm7, 28
psllq mm6, 36
por mm6, mm7
pxor mm2, [edx + 8]
movq [eax], mm6
movq mm6, [edx + 32]
movq mm7, mm4
psrlq mm7, 63
psllq mm4, 1
pxor mm0, mm6
por mm4, mm7
pxor mm4, mm2
pxor mm5, mm4
movq mm7, mm5
pxor mm0, [edx - 8]
psllq mm5, 21
psrlq mm7, 43
pxor mm6, mm1
por mm5, mm7
movq [eax - 104], mm5
movq mm5, [edx - 48]
pxor mm0, mm5
movq mm7, mm6
psrlq mm7, 46
psllq mm6, 18
por mm6, mm7
movq [eax - 16], mm6
movq mm6, [edx + 56]
pxor mm5, mm1
movq mm7, mm5
pxor mm3, mm6
psllq mm5, 3
psrlq mm7, 61
pxor mm3, [edx + 16]
pxor mm3, [edx - 24]
por mm5, mm7
pxor mm6, mm4
pxor mm0, [edx - 88]
movq mm7, mm6
psrlq mm7, 8
movq [eax - 72], mm5
movq mm5, mm2
psllq mm2, 1
psllq mm6, 56
psrlq mm5, 63
por mm6, mm7
por mm2, mm5
pxor mm2, mm0
movq [eax + 24], mm6
movq mm5, [edx - 120]
movq mm6, mm0
psllq mm0, 1
pxor mm5, mm2
pxor mm3, [edx - 64]
psrlq mm6, 63
por mm0, mm6
movq mm6, [edx - 64]
movq mm7, mm5
psllq mm5, 1
psrlq mm7, 63
pxor mm6, mm4
por mm5, mm7
pxor mm0, mm3
movq mm7, mm6
movq [eax - 48], mm5
movq mm5, [edx]
psllq mm6, 55
psrlq mm7, 9
por mm6, mm7
movq [eax + 40], mm6
movq mm6, [edx - 40]
pxor mm5, mm2
movq mm7, mm5
psllq mm5, 45
psrlq mm7, 19
pxor mm6, mm2
por mm5, mm7
movq [eax - 64], mm5
movq mm5, [edx + 40]
movq mm7, mm6
pxor mm5, mm2
psllq mm6, 10
psrlq mm7, 54
por mm6, mm7
movq [eax + 8], mm6
movq mm6, [edx - 96]
movq mm7, mm3
psrlq mm7, 63
psllq mm3, 1
por mm3, mm7
movq mm7, mm5
psllq mm5, 2
psrlq mm7, 62
por mm5, mm7
movq [eax + 64], mm5
movq mm5, [edx + 24]
pxor mm6, mm0
movq mm7, mm6
psrlq mm7, 37
psllq mm6, 27
por mm6, mm7
movq [eax - 8], mm6
pxor mm5, mm0
movq mm6, [edx - 16]
movq mm7, mm5
psllq mm5, 8
pxor mm3, [ecx + 8]
psrlq mm7, 56
pxor mm6, mm0
por mm5, mm7
movq [eax - 24], mm5
movq mm7, mm6
psllq mm6, 39
movq mm5, [edx - 112]
psrlq mm7, 25
por mm6, mm7
movq [eax + 48], mm6
movq mm6, [edx - 24]
pxor mm5, mm3
movq mm7, mm5
psrlq mm7, 2
psllq mm5, 62
por mm5, mm7
movq [eax + 32], mm5
movq mm5, [edx - 104]
pxor mm6, mm4
movq mm7, mm6
psrlq mm7, 39
psllq mm6, 25
por mm6, mm7
pxor mm5, mm4
movq [eax - 32], mm6
movq mm6, [edx - 128]
pxor mm6, mm1
movq mm4, mm6
movq [eax - 128], mm6
movq mm4, mm6
movq mm6, [edx - 8]
movq mm7, mm5
psrlq mm7, 36
psllq mm5, 28
pxor mm6, mm1
por mm5, mm7
movq mm7, mm6
psrlq mm7, 23
movq mm1, mm5
movq [eax - 88], mm5
movq mm5, [edx - 56]
pxor mm5, mm0
psllq mm6, 41
por mm6, mm7
movq [eax + 56], mm6
movq mm6, [edx + 48]
pxor mm6, mm3
movq mm7, mm5
psrlq mm7, 44
psllq mm5, 20
por mm5, mm7
movq [eax - 80], mm5
pandn mm1, mm5
movq mm5, [edx - 32]
movq mm7, mm6
psrlq mm7, 3
psllq mm6, 61
por mm6, mm7
pxor mm1, mm6
movq [eax - 56], mm6
movq mm6, [edx + 8]
movq [edx - 56], mm1
movq mm1, [eax - 112]
pxor mm5, mm3
movq mm7, mm5
psllq mm5, 43
psrlq mm7, 21
pxor mm6, mm3
por mm5, mm7
movq mm1, mm5
movq mm5, [edx - 80]
pxor mm5, mm2
movq mm2, [eax - 104]
movq mm7, mm6
psrlq mm7, 49
psllq mm6, 15
por mm6, mm7
movq [eax + 16], mm6
movq mm6, [edx + 64]
movq [eax - 96], mm6
movq mm7, mm5
psrlq mm7, 20
psllq mm5, 44
pxor mm6, mm0
por mm5, mm7
movq mm7, mm6
psrlq mm7, 50
psllq mm6, 14
por mm6, mm7
pandn mm2, mm6
movq mm0, mm5
pandn mm0, mm1
pxor mm2, mm1
pandn mm1, [eax - 104]
movq [edx - 112], mm2
pandn mm4, mm5
pxor mm1, mm5
movq [eax - 120], mm5
movq mm2, [eax - 40]
movq [edx - 120], mm1
movq mm5, [edx - 72]
movq mm1, [eax - 64]
pxor mm4, mm6
movq [edx - 96], mm4
pxor mm5, mm3
movq mm4, [eax - 88]
movq mm7, mm5
movq mm3, mm6
pxor mm0, [eax - 128]
movq [edx - 128], mm0
movq mm6, [eax - 72]
psllq mm5, 6
psrlq mm7, 58
movq mm0, [eax - 56]
por mm5, mm7
movq mm2, mm5
movq mm5, [eax - 80]
movq mm7, mm1
pandn mm7, mm0
pxor mm7, mm6
movq [edx - 72], mm7
movq mm7, [eax - 72]
pandn mm6, mm1
pxor mm6, mm5
pandn mm0, mm4
pandn mm5, mm7
movq mm7, [eax]
pxor mm5, mm4
movq mm4, [eax - 24]
movq [edx - 80], mm6
movq mm6, [eax - 48]
movq [edx - 88], mm5
movq mm5, mm1
movq mm1, [eax - 16]
pxor mm0, mm5
movq mm5, mm1
pandn mm3, [eax - 128]
pxor mm3, [eax - 104]
movq [edx - 64], mm0
movq mm0, [eax + 8]
movq [edx - 104], mm3
movq mm3, [eax - 32]
pandn mm6, mm2
pxor mm6, mm5
movq [edx - 16], mm6
movq mm6, [eax + 56]
pandn mm3, mm4
pxor mm3, mm2
movq [edx - 40], mm3
movq mm3, [eax - 32]
pandn mm5, [eax - 48]
pxor mm5, mm4
movq [edx - 24], mm5
pandn mm7, mm0
movq mm5, [eax + 16]
pandn mm4, mm1
pxor mm4, mm3
movq [edx - 32], mm4
movq mm4, [eax + 40]
movq mm1, mm5
movq mm5, [eax + 48]
pandn mm5, mm6
pxor mm5, mm4
pandn mm2, mm3
movq mm3, [eax - 8]
movq [edx + 40], mm5
movq mm5, [eax + 24]
pxor mm7, mm3
movq [edx - 8], mm7
movq mm7, [eax + 64]
pxor mm2, [eax - 48]
movq [edx - 48], mm2
movq mm2, mm5
pandn mm2, mm3
pxor mm2, mm1
movq [edx + 16], mm2
pandn mm3, [eax]
movq mm2, mm5
movq mm5, [eax + 48]
pandn mm6, mm7
pxor mm6, mm5
movq [edx + 48], mm6
pandn mm1, mm2
movq mm6, [eax + 32]
pxor mm1, mm0
pxor mm3, mm2
movq [edx + 24], mm3
pandn mm0, [eax + 16]
pxor mm0, [eax]
movq mm3, mm4
movq [edx + 8], mm1
movq [edx], mm0
movq mm0, mm6
movq mm1, [eax + 56]
pandn mm4, mm5
pxor mm4, mm0
pandn mm0, mm3
pxor mm0, mm7
movq [edx + 32], mm4
pandn mm7, mm6
pxor mm7, mm1
movq [edx + 56], mm7
movq [edx + 64], mm0
{$else}
{$ifdef FPC}nostackframe; assembler; asm{$else}
// Synopse's x64 asm, optimized for both in+out-order pipelined CPUs
asm // input: rcx=B, rdx=A, r8=C (Linux: rdi,rsi,rdx)
.noframe
{$endif}{$ifndef win64}
mov r8, rdx
mov rdx, rsi
mov rcx, rdi
{$endif win64}
push rbx
push r12
push r13
push r14
add rdx, 128
add rcx, 128
// theta
mov r10, [rdx - 128]
mov r11, [rdx - 120]
mov r12, [rdx - 112]
mov r13, [rdx - 104]
mov r14, [rdx - 96]
xor r10, [rdx - 88]
xor r11, [rdx - 80]
xor r12, [rdx - 72]
xor r13, [rdx - 64]
xor r14, [rdx - 56]
xor r10, [rdx - 48]
xor r11, [rdx - 40]
xor r12, [rdx - 32]
xor r13, [rdx - 24]
xor r14, [rdx - 16]
xor r10, [rdx - 8]
xor r11, [rdx]
xor r12, [rdx + 8]
xor r13, [rdx + 16]
xor r14, [rdx + 24]
xor r10, [rdx + 32]
xor r11, [rdx + 40]
xor r12, [rdx + 48]
xor r13, [rdx + 56]
xor r14, [rdx + 64]
mov [r8], r10
mov [r8 + 8], r11
mov [r8 + 16], r12
mov [r8 + 24], r13
mov [r8 + 32], r14
rol r10, 1
rol r11, 1
rol r12, 1
rol r13, 1
rol r14, 1
xor r10, [r8 + 24]
xor r11, [r8 + 32]
xor r12, [r8]
xor r13, [r8 + 8]
xor r14, [r8 + 16]
// rho pi
mov rax, [rdx - 128]
mov r8, [rdx - 80]
mov r9, [rdx - 32]
mov rbx, [rdx + 16]
xor rax, r11
xor r8, r12
xor r9, r13
xor rbx, r14
rol r8, 44
rol r9, 43
rol rbx, 21
mov [rcx - 128], rax
mov [rcx - 120], r8
mov [rcx - 112], r9
mov [rcx - 104], rbx
mov rax, [rdx + 64]
mov r8, [rdx - 104]
mov r9, [rdx - 56]
mov rbx, [rdx - 48]
xor rax, r10
xor r8, r14
xor r9, r10
xor rbx, r11
rol rax, 14
rol r8, 28
rol r9, 20
rol rbx, 3
mov [rcx - 96], rax
mov [rcx - 88], r8
mov [rcx - 80], r9
mov [rcx - 72], rbx
mov rax, [rdx]
mov r8, [rdx + 48]
mov r9, [rdx - 120]
mov rbx, [rdx - 72]
xor rax, r12
xor r8, r13
xor r9, r12
xor rbx, r13
rol rax, 45
rol r8, 61
rol r9, 1
rol rbx, 6
mov [rcx - 64], rax
mov [rcx - 56], r8
mov [rcx - 48], r9
mov [rcx - 40], rbx
mov rax, [rdx - 24]
mov r8, [rdx + 24]
mov r9, [rdx + 32]
mov rbx, [rdx - 96]
xor rax, r14
xor r8, r10
xor r9, r11
xor rbx, r10
rol rax, 25
rol r8, 8
rol r9, 18
rol rbx, 27
mov [rcx - 32], rax
mov [rcx - 24], r8
mov [rcx - 16], r9
mov [rcx - 8], rbx
mov rax, [rdx - 88]
mov r8, [rdx - 40]
mov r9, [rdx + 8]
mov rbx, [rdx + 56]
xor rax, r11
xor r8, r12
xor r9, r13
xor rbx, r14
rol rax, 36
rol r8, 10
rol r9, 15
rol rbx, 56
mov [rcx], rax
mov [rcx + 8], r8
mov [rcx + 16], r9
mov [rcx + 24], rbx
mov rax, [rdx - 112]
mov r8, [rdx - 64]
mov r9, [rdx - 16]
mov rbx, [rdx - 8]
xor rax, r13
xor r8, r14
xor r9, r10
mov r10, [rdx + 40]
xor rbx, r11
rol rax, 62
rol r8, 55
xor r10, r12
rol r9, 39
rol rbx, 41
mov [rcx + 32], rax
mov [rcx + 40], r8
rol r10, 2
mov [rcx + 48], r9
mov [rcx + 56], rbx
mov [rcx + 64], r10
// chi
mov rax, [rcx - 120]
mov r8, [rcx - 112]
mov r9, [rcx - 104]
mov r10, [rcx - 96]
mov r11, [rcx - 128]
mov r12, [rcx - 80]
mov r13, [rcx - 72]
mov r14, [rcx - 64]
mov rbx, [rcx - 56]
not rax
not r8
not r9
not r10
not r11
not r12
not r13
not r14
not rbx
and rax, [rcx - 112]
and r8, [rcx - 104]
and r9, [rcx - 96]
and r10, [rcx - 128]
and r11, [rcx - 120]
and r12, [rcx - 72]
and r13, [rcx - 64]
and r14, [rcx - 56]
and rbx, [rcx - 88]
xor rax, [rcx - 128]
xor r8, [rcx - 120]
xor r9, [rcx - 112]
xor r10, [rcx - 104]
xor r11, [rcx - 96]
xor r12, [rcx - 88]
xor r13, [rcx - 80]
xor r14, [rcx - 72]
xor rbx, [rcx - 64]
mov [rdx - 128], rax
mov [rdx - 120], r8
mov [rdx - 112], r9
mov [rdx - 104], r10
mov [rdx - 96], r11
mov [rdx - 88], r12
mov [rdx - 80], r13
mov [rdx - 72], r14
mov [rdx - 64], rbx
mov rax, [rcx - 88]
mov rbx, [rcx - 40]
mov r8, [rcx - 32]
mov r9, [rcx - 24]
mov r10, [rcx - 16]
mov r11, [rcx - 48]
mov r12, [rcx]
mov r13, [rcx + 8]
mov r14, [rcx + 16]
not rax
not rbx
not r8
not r9
not r10
not r11
not r12
not r13
not r14
and rax, [rcx - 80]
and rbx, [rcx - 32]
and r8, [rcx - 24]
and r9, [rcx - 16]
and r10, [rcx - 48]
and r11, [rcx - 40]
and r12, [rcx + 8]
and r13, [rcx + 16]
and r14, [rcx + 24]
xor rax, [rcx - 56]
xor rbx, [rcx - 48]
xor r8, [rcx - 40]
xor r9, [rcx - 32]
xor r10, [rcx - 24]
xor r11, [rcx - 16]
xor r12, [rcx - 8]
xor r13, [rcx]
xor r14, [rcx + 8]
mov [rdx - 56], rax
mov [rdx - 48], rbx
mov [rdx - 40], r8
mov [rdx - 32], r9
mov [rdx - 24], r10
mov [rdx - 16], r11
mov [rdx - 8], r12
mov [rdx], r13
mov [rdx + 8], r14
mov rax, [rcx + 24]
mov rbx, [rcx - 8]
mov r8, [rcx + 40]
mov r9, [rcx + 48]
mov r10, [rcx + 56]
mov r11, [rcx + 64]
mov r12, [rcx + 32]
not rax
not rbx
not r8
not r9
not r10
not r11
not r12
and rax, [rcx - 8]
and rbx, [rcx]
and r8, [rcx + 48]
and r9, [rcx + 56]
and r10, [rcx + 64]
and r11, [rcx + 32]
and r12, [rcx + 40]
xor rax, [rcx + 16]
xor rbx, [rcx + 24]
xor r8, [rcx + 32]
xor r9, [rcx + 40]
xor r10, [rcx + 48]
xor r11, [rcx + 56]
xor r12, [rcx + 64]
mov [rdx + 16], rax
mov [rdx + 24], rbx
mov [rdx + 32], r8
mov [rdx + 40], r9
mov [rdx + 48], r10
mov [rdx + 56], r11
mov [rdx + 64], r12
pop r14
pop r13
pop r12
pop rbx
{$endif}
end;
procedure KeccakPermutation(A: PQWordArray);
var
B: array[0..24] of QWord;
C: array[0..4] of QWord;
i: integer;
begin
for i := 0 to 23 do begin
KeccakPermutationKernel(@B, A, @C);
A[00] := A[00] xor cRoundConstants[i];
end;
{$ifdef CPU32}
asm
emms // reset MMX after use
end;
{$endif}
end;
{$endif SHA3_PASCAL}
procedure TSHA3Context.Init(aAlgo: TSHA3Algo);
begin
case aAlgo of
SHA3_224:
InitSponge(1152, 448);
SHA3_256:
InitSponge(1088, 512);
SHA3_384:
InitSponge(832, 768);
SHA3_512:
InitSponge(576, 1024);
SHAKE_128:
InitSponge(1344, 256);
SHAKE_256:
InitSponge(1088, 512);
else
raise ESynCrypto.CreateUTF8('Unexpected TSHA3Context.Init(%)', [ord(aAlgo)]);
end;
Algo := aAlgo;
end;
procedure TSHA3Context.InitSponge(aRate, aCapacity: integer);
begin
if (aRate + aCapacity <> 1600) or (aRate <= 0) or (aRate >= 1600) or
((aRate and 63) <> 0) then
raise ESynCrypto.CreateUTF8('Unexpected TSHA3Context.Init(%,%)', [aRate, aCapacity]);
FillCharFast(self, sizeof(self), 0);
Rate := aRate;
Capacity := aCapacity;
end;
procedure TSHA3Context.AbsorbQueue;
begin
XorMemoryPtrInt(@State, @DataQueue, Rate shr {$ifdef CPU32}5{$else}6{$endif});
KeccakPermutation(@State);
end;
procedure TSHA3Context.Absorb(data: PByteArray; databitlen: integer);
var
i, j, wholeBlocks, partialBlock: integer;
partialByte: integer;
curData: pointer;
begin
if BitsInQueue and 7 <> 0 then
raise ESynCrypto.Create('TSHA3Context.Absorb: only last may contain partial');
if Squeezing then
raise ESynCrypto.Create('TSHA3Context.Absorb: too late for additional input');
i := 0;
while i < databitlen do begin
if (BitsInQueue = 0) and (databitlen >= Rate) and (i <= (databitlen - Rate)) then begin
wholeBlocks := (databitlen - i) div Rate;
curData := @data^[i shr 3];
for j := 1 to wholeBlocks do begin
XorMemoryPtrInt(@State, curData, Rate shr {$ifdef CPU32}5{$else}6{$endif});
KeccakPermutation(@State);
inc(PByte(curData), Rate shr 3);
end;
inc(i, wholeBlocks * Rate);
end
else begin
partialBlock := databitlen - i;
if partialBlock + BitsInQueue > Rate then
partialBlock := Rate - BitsInQueue;
partialByte := partialBlock and 7;
dec(partialBlock, partialByte);
MoveFast(data^[i shr 3], DataQueue[BitsInQueue shr 3], partialBlock shr 3);
inc(BitsInQueue, partialBlock);
inc(i, partialBlock);
if BitsInQueue = Rate then begin
AbsorbQueue;
BitsInQueue := 0;
end;
if partialByte > 0 then begin
DataQueue[BitsInQueue shr 3] := data^[i shr 3] and ((1 shl partialByte) - 1);
inc(BitsInQueue, partialByte);
inc(i, partialByte);
end;
end;
end;
end;
procedure TSHA3Context.AbsorbFinal(data: PByteArray; databitlen: integer);
var
lastByte: byte;
begin
if databitlen and 7 = 0 then
Absorb(data, databitlen)
else begin
Absorb(data, databitlen - (databitlen and 7));
// Align the last partial byte to the least significant bits
lastByte := data^[databitlen shr 3] shr (8 - (databitlen and 7));
Absorb(@lastByte, databitlen and 7);
end;
end;
procedure TSHA3Context.PadAndSwitchToSqueezingPhase;
var
i: integer;
begin // note: the bits are numbered from 0=LSB to 7=MSB
if BitsInQueue + 1 = Rate then begin
i := BitsInQueue shr 3;
DataQueue[i] := DataQueue[i] or (1 shl (BitsInQueue and 7));
AbsorbQueue;
FillCharFast(DataQueue, Rate shr 3, 0);
end
else begin
i := BitsInQueue shr 3;
FillCharFast(DataQueue[(BitsInQueue + 7) shr 3], Rate shr 3 - (BitsInQueue + 7) shr 3, 0);
DataQueue[i] := DataQueue[i] or (1 shl (BitsInQueue and 7));
end;
i := (Rate - 1) shr 3;
DataQueue[i] := DataQueue[i] or (1 shl ((Rate - 1) and 7));
AbsorbQueue;
MoveFast(State, DataQueue, Rate shr 3);
BitsAvailableForSqueezing := Rate;
Squeezing := true;
end;
procedure TSHA3Context.Squeeze(output: PByteArray; outputLength: integer);
var
i: integer;
partialBlock: integer;
begin
if not Squeezing then
PadAndSwitchToSqueezingPhase;
if outputLength and 7 <> 0 then
raise ESynCrypto.CreateUTF8('TSHA3Context.Squeeze(%?)', [outputLength]);
i := 0;
while i < outputLength do begin
if BitsAvailableForSqueezing = 0 then begin
KeccakPermutation(@State);
MoveFast(State, DataQueue, Rate shr 3);
BitsAvailableForSqueezing := Rate;
end;
partialBlock := BitsAvailableForSqueezing;
if partialBlock > outputLength - i then
partialBlock := outputLength - i;
MoveFast(DataQueue[(Rate - BitsAvailableForSqueezing) shr 3],
output^[i shr 3], partialBlock shr 3);
dec(BitsAvailableForSqueezing, partialBlock);
inc(i, partialBlock);
end;
end;
procedure TSHA3Context.FinalBit_LSB(bits: byte; bitlen: integer;
hashval: Pointer; numbits: integer);
var
ll: integer;
lw: word;
begin
bitlen := bitlen and 7;
if bitlen = 0 then
lw := 0
else
lw := bits and Pred(word(1) shl bitlen);
// 'append' (in LSB language) the domain separation bits
if Algo >= SHAKE_128 then begin
// SHAKE: append four bits 1111
lw := lw or (word($F) shl bitlen);
ll := bitlen + 4;
end
else begin
// SHA-3: append two bits 01
lw := lw or (word($2) shl bitlen);
ll := bitlen + 2;
end;
// update state with final bits
if ll < 9 then begin // 0..8 bits, one call to update
lw := lw shl (8 - ll);
AbsorbFinal(@lw, ll);
// squeeze the digits from the sponge
Squeeze(hashval, numbits);
end
else begin
// more than 8 bits, first a regular update with low byte
AbsorbFinal(@lw, 8);
// finally update remaining last bits
dec(ll, 8);
lw := lw shr ll;
AbsorbFinal(@lw, ll);
Squeeze(hashval, numbits);
end;
end;
procedure TSHA3.Init(Algo: TSHA3Algo);
begin
PSHA3Context(@Context)^.Init(Algo);
end;
function TSHA3.Algorithm: TSHA3Algo;
begin
result := PSHA3Context(@Context)^.Algo;
end;
procedure TSHA3.Update(const Buffer: RawByteString);
begin
if Buffer <> '' then
PSHA3Context(@Context)^.Absorb(pointer(Buffer), Length(Buffer) shl 3);
end;
procedure TSHA3.Update(Buffer: pointer; Len: integer);
begin
if Len > 0 then
PSHA3Context(@Context)^.Absorb(Buffer, Len shl 3);
end;
procedure TSHA3.Final(out Digest: THash256; NoInit: boolean);
begin
Final(@Digest, 256, NoInit);
end;
procedure TSHA3.Final(out Digest: THash512; NoInit: boolean);
begin
Final(@Digest, 512, NoInit);
end;
const
SHA3_DEF_LEN: array[TSHA3Algo] of integer = (224, 256, 384, 512, 256, 512);
procedure TSHA3.Final(Digest: pointer; DigestBits: integer; NoInit: boolean);
begin
if DigestBits = 0 then
DigestBits := SHA3_DEF_LEN[TSHA3Context(Context).Algo];
if TSHA3Context(Context).Squeezing then // used as Extendable-Output Function
PSHA3Context(@Context)^.Squeeze(Digest, DigestBits)
else
PSHA3Context(@Context)^.FinalBit_LSB(0, 0, Digest, DigestBits);
if not NoInit then
FillCharFast(Context, sizeof(Context), 0);
end;
function TSHA3.Final256(NoInit: boolean): THash256;
begin
Final(result,NoInit);
end;
function TSHA3.Final512(NoInit: boolean): THash512;
begin
Final(result,NoInit);
end;
procedure TSHA3.Full(Buffer: pointer; Len: integer; out Digest: THash256);
begin
Full(SHA3_256, Buffer, Len, @Digest, 256);
end;
procedure TSHA3.Full(Buffer: pointer; Len: integer; out Digest: THash512);
begin
Full(SHA3_512, Buffer, Len, @Digest, 512);
end;
procedure TSHA3.Full(Algo: TSHA3Algo; Buffer: pointer; Len: integer;
Digest: pointer; DigestBits: integer);
begin
Init(Algo);
Update(Buffer, Len);
Final(Digest, DigestBits);
end;
function TSHA3.FullStr(Algo: TSHA3Algo; Buffer: pointer; Len: integer;
DigestBits: integer): RawUTF8;
var
tmp: RawByteString;
begin
if DigestBits = 0 then
DigestBits := SHA3_DEF_LEN[Algo];
SetLength(tmp, DigestBits shr 3);
Full(Algo, Buffer, Len, pointer(tmp), DigestBits);
result := SynCommons.BinToHex(tmp);
FillZero(tmp);
end;
procedure TSHA3.Cypher(Key, Source, Dest: pointer; KeyLen, DataLen: integer;
Algo: TSHA3Algo);
begin
if DataLen <= 0 then
exit;
if Source = Dest then
raise ESynCrypto.Create('Unexpected TSHA3.Cypher(Source=Dest)');
Full(Algo, Key, KeyLen, Dest, DataLen shl 3);
XorMemory(Dest, Source, DataLen); // just as simple as that!
end;
function TSHA3.Cypher(const Key, Source: RawByteString; Algo: TSHA3Algo): RawByteString;
var
len: integer;
begin
len := length(Source);
SetString(result, nil, len);
Cypher(pointer(Key), pointer(Source), pointer(result), length(Key), len);
end;
procedure TSHA3.InitCypher(Key: pointer; KeyLen: integer; Algo: TSHA3Algo);
begin
Init(Algo);
Update(Key, KeyLen);
PSHA3Context(@Context)^.FinalBit_LSB(0, 0, nil, 0);
end;
procedure TSHA3.InitCypher(const Key: RawByteString; Algo: TSHA3Algo);
begin
InitCypher(pointer(Key), length(Key), Algo);
end;
procedure TSHA3.Cypher(Source, Dest: pointer; DataLen: integer);
begin
Final(Dest, DataLen shl 3, true); // in XOF mode
XorMemory(Dest, Source, DataLen);
end;
function TSHA3.Cypher(const Source: RawByteString): RawByteString;
var
len: integer;
begin
len := length(Source);
SetString(result, nil, len);
Cypher(pointer(Source), pointer(result), len);
end;
procedure TSHA3.Done;
begin
FillCharFast(self, sizeof(self), 0);
end;
function SHA3(Algo: TSHA3Algo; const s: RawByteString;
DigestBits: integer): RawUTF8;
begin
result := SHA3(algo, pointer(s), length(s), DigestBits);
end;
function SHA3(Algo: TSHA3Algo; Buffer: pointer; Len, DigestBits: integer): RawUTF8;
var
instance: TSHA3;
begin
result := instance.FullStr(algo, Buffer, Len, DigestBits);
end;
procedure PBKDF2_SHA3(algo: TSHA3Algo; const password,salt: RawByteString;
count: Integer; result: PByte; resultbytes: Integer);
var i: integer;
tmp: RawByteString;
mac: TSHA3;
first: TSHA3;
begin
if resultbytes<=0 then
resultbytes := SHA3_DEF_LEN[algo] shr 3;
SetLength(tmp,resultbytes);
first.Init(algo);
first.Update(password);
mac := first;
mac.Update(salt);
mac.Final(pointer(tmp),resultbytes shl 3,true);
MoveFast(pointer(tmp)^,result^,resultbytes);
for i := 2 to count do begin
mac := first;
mac.Update(pointer(tmp),resultbytes);
mac.Final(pointer(tmp),resultbytes shl 3,true);
XorMemory(pointer(result),pointer(tmp),resultbytes);
end;
FillcharFast(mac,sizeof(mac),0);
FillcharFast(first,sizeof(first),0);
FillZero(tmp);
end;
procedure PBKDF2_SHA3_Crypt(algo: TSHA3Algo; const password,salt: RawByteString;
count: Integer; var data: RawByteString);
var key: RawByteString;
len: integer;
begin
len := length(data);
SetLength(key,len);
PBKDF2_SHA3(algo,password,salt,count,pointer(key),len);
XorMemory(pointer(data),pointer(key),len);
FillZero(key);
end;
{ TSynHasher }
function TSynHasher.Init(aAlgo: THashAlgo): boolean;
begin
fAlgo := aAlgo;
result := true;
case aAlgo of
hfMD5: PMD5(@ctxt)^.Init;
hfSHA1: PSHA1(@ctxt)^.Init;
hfSHA256: PSHA256(@ctxt)^.Init;
hfSHA384: PSHA384(@ctxt)^.Init;
hfSHA512: PSHA512(@ctxt)^.Init;
hfSHA3_256: PSHA3(@ctxt)^.Init(SHA3_256);
hfSHA3_512: PSHA3(@ctxt)^.Init(SHA3_512);
else result := false;
end;
end;
procedure TSynHasher.Update(aBuffer: Pointer; aLen: integer);
begin
case fAlgo of
hfMD5: PMD5(@ctxt)^.Update(aBuffer^,aLen);
hfSHA1: PSHA1(@ctxt)^.Update(aBuffer,aLen);
hfSHA256: PSHA256(@ctxt)^.Update(aBuffer,aLen);
hfSHA384: PSHA384(@ctxt)^.Update(aBuffer,aLen);
hfSHA512: PSHA512(@ctxt)^.Update(aBuffer,aLen);
hfSHA3_256: PSHA3(@ctxt)^.Update(aBuffer,aLen);
hfSHA3_512: PSHA3(@ctxt)^.Update(aBuffer,aLen);
end;
end;
procedure TSynHasher.Update(const aBuffer: RawByteString);
begin
Update(pointer(aBuffer),length(aBuffer));
end;
function TSynHasher.Final: RawUTF8;
begin
case fAlgo of
hfMD5: result := MD5DigestToString(PMD5(@ctxt)^.Final);
hfSHA1: result := SHA1DigestToString(PSHA1(@ctxt)^.Final);
hfSHA256: result := SHA256DigestToString(PSHA256(@ctxt)^.Final);
hfSHA384: result := SHA384DigestToString(PSHA384(@ctxt)^.Final);
hfSHA512: result := SHA512DigestToString(PSHA512(@ctxt)^.Final);
hfSHA3_256: result := SHA256DigestToString(PSHA3(@ctxt)^.Final256);
hfSHA3_512: result := SHA512DigestToString(PSHA3(@ctxt)^.Final512);
end;
end;
function TSynHasher.Full(aAlgo: THashAlgo; aBuffer: Pointer; aLen: integer): RawUTF8;
begin
Init(aAlgo);
Update(aBuffer,aLen);
result := Final;
end;
function HashFull(aAlgo: THashAlgo; aBuffer: Pointer; aLen: integer): RawUTF8;
var hasher: TSynHasher;
begin
result := hasher.Full(aAlgo,aBuffer,aLen);
end;
function HashFile(const aFileName: TFileName; aAlgo: THashAlgo): RawUTF8;
var
hasher: TSynHasher;
temp: RawByteString;
F: THandle;
size: TQWordRec;
read: cardinal;
begin
result := '';
if (aFileName='') or not hasher.Init(aAlgo) then
exit;
F := FileOpenSequentialRead(aFileName);
if PtrInt(F)>=0 then
try
size.L := GetFileSize(F,@size.H);
SetLength(temp,1 shl 20);
while size.V>0 do begin
read := FileRead(F,pointer(temp)^,1 shl 20);
if read<=0 then
exit;
hasher.Update(pointer(temp),read);
dec(size.V,read);
end;
result := hasher.Final;
finally
FileClose(F);
end;
end;
procedure HashFile(const aFileName: TFileName; aAlgos: THashAlgos);
var data, hash: RawUTF8;
efn, fn: string;
a: THashAlgo;
begin
if aAlgos=[] then
exit;
efn := ExtractFileName(aFileName);
data := StringFromFile(aFileName);
if data<>'' then
for a := low(a) to high(a) do
if a in aAlgos then begin
FormatUTF8('% *%',[HashFull(a,pointer(data),length(data)),efn],hash);
FormatString('%.%',[efn,LowerCase(TrimLeftLowerCaseShort(ToText(a)))],fn);
FileFromString(hash,fn);
end;
end;
{ TSynSigner }
procedure TSynSigner.Init(aAlgo: TSignAlgo; aSecret: pointer; aSecretLen: integer);
const
SIGN_SIZE: array[TSignAlgo] of byte = (
20, 32, 48, 64, 28, 32, 48, 64, 32, 64);
SHA3_ALGO: array[saSha3224..saSha3S256] of TSHA3Algo = (
SHA3_224, SHA3_256, SHA3_384, SHA3_512, SHAKE_128, SHAKE_256);
begin
fAlgo := aAlgo;
fSignatureSize := SIGN_SIZE[fAlgo];
case fAlgo of
saSha1: PHMAC_SHA1(@ctxt)^.Init(aSecret,aSecretLen);
saSha256: PHMAC_SHA256(@ctxt)^.Init(aSecret,aSecretLen);
saSha384: PHMAC_SHA384(@ctxt)^.Init(aSecret,aSecretLen);
saSha512: PHMAC_SHA512(@ctxt)^.Init(aSecret,aSecretLen);
saSha3224..saSha3S256: begin
PSHA3(@ctxt)^.Init(SHA3_ALGO[fAlgo]);
PSHA3(@ctxt)^.Update(aSecret,aSecretLen); // HMAC pattern included in SHA-3
end;
end;
end;
procedure TSynSigner.Init(aAlgo: TSignAlgo; const aSecret: RawUTF8);
begin
Init(aAlgo,pointer(aSecret),length(aSecret));
end;
procedure TSynSigner.Init(aAlgo: TSignAlgo; const aSecret, aSalt: RawUTF8;
aSecretPBKDF2Rounds: integer; aPBKDF2Secret: PHash512Rec);
var temp: THash512Rec;
begin
if aSecretPBKDF2Rounds>1 then begin
PBKDF2(aAlgo,aSecret,aSalt,aSecretPBKDF2Rounds,temp);
Init(aAlgo,@temp,fSignatureSize);
if aPBKDF2Secret<>nil then
aPBKDF2Secret^ := temp;
FillZero(temp.b);
end else
Init(aAlgo,aSecret);
end;
procedure TSynSigner.Update(const aBuffer: RawByteString);
begin
Update(pointer(aBuffer),length(aBuffer));
end;
procedure TSynSigner.Update(aBuffer: pointer; aLen: integer);
begin
case fAlgo of
saSha1: PHMAC_SHA1(@ctxt)^.Update(aBuffer,aLen);
saSha256: PHMAC_SHA256(@ctxt)^.Update(aBuffer,aLen);
saSha384: PHMAC_SHA384(@ctxt)^.Update(aBuffer,aLen);
saSha512: PHMAC_SHA512(@ctxt)^.Update(aBuffer,aLen);
saSha3224..saSha3S256: PSHA3(@ctxt)^.Update(aBuffer,aLen);
end;
end;
procedure TSynSigner.Final(out aSignature: THash512Rec; aNoInit: boolean);
begin
case fAlgo of
saSha1: PHMAC_SHA1(@ctxt)^.Done(aSignature.b160,aNoInit);
saSha256: PHMAC_SHA256(@ctxt)^.Done(aSignature.Lo,aNoInit);
saSha384: PHMAC_SHA384(@ctxt)^.Done(aSignature.b384,aNoInit);
saSha512: PHMAC_SHA512(@ctxt)^.Done(aSignature.b,aNoInit);
saSha3224..saSha3S256: PSHA3(@ctxt)^.Final(@aSignature,fSignatureSize shl 3,aNoInit);
end;
end;
function TSynSigner.Final: RawUTF8;
var sig: THash512Rec;
begin
Final(sig);
result := BinToHexLower(@sig,fSignatureSize);
end;
function TSynSigner.Full(aAlgo: TSignAlgo; const aSecret: RawUTF8;
aBuffer: Pointer; aLen: integer): RawUTF8;
begin
Init(aAlgo,aSecret);
Update(aBuffer,aLen);
result := Final;
end;
function TSynSigner.Full(aAlgo: TSignAlgo; const aSecret, aSalt: RawUTF8;
aSecretPBKDF2Rounds: integer; aBuffer: Pointer; aLen: integer): RawUTF8;
begin
Init(aAlgo,aSecret,aSalt,aSecretPBKDF2Rounds);
Update(aBuffer,aLen);
result := Final;
end;
procedure TSynSigner.PBKDF2(aAlgo: TSignAlgo; const aSecret, aSalt: RawUTF8;
aSecretPBKDF2Rounds: integer; out aDerivatedKey: THash512Rec);
var iter: TSynSigner;
temp: THash512Rec;
i: integer;
begin
Init(aAlgo,aSecret);
iter := self;
iter.Update(aSalt);
if fAlgo<saSha3224 then
iter.Update(#0#0#0#1); // padding and XoF mode already part of SHA-3 process
iter.Final(aDerivatedKey,true);
if aSecretPBKDF2Rounds<2 then
exit;
temp := aDerivatedKey;
for i := 2 to aSecretPBKDF2Rounds do begin
iter := self;
iter.Update(@temp,fSignatureSize);
iter.Final(temp,true);
XorMemory(@aDerivatedKey,@temp,fSignatureSize);
end;
FillZero(temp.b);
FillCharFast(iter.ctxt,SizeOf(iter.ctxt),0);
FillCharFast(ctxt,SizeOf(ctxt),0);
end;
procedure TSynSigner.PBKDF2(const aParams: TSynSignerParams;
out aDerivatedKey: THash512Rec);
begin
PBKDF2(aParams.algo,aParams.secret,aParams.salt,aParams.rounds,aDerivatedKey);
end;
procedure TSynSigner.PBKDF2(aParamsJSON: PUTF8Char; aParamsJSONLen: integer;
out aDerivatedKey: THash512Rec; const aDefaultSalt: RawUTF8; aDefaultAlgo: TSignAlgo);
var tmp: TSynTempBuffer;
k: TSynSignerParams;
procedure SetDefault;
begin
k.algo := aDefaultAlgo;
k.secret := '';
k.salt := aDefaultSalt;
k.rounds := 1000;
end;
begin
SetDefault;
if (aParamsJSON=nil) or (aParamsJSONLen<=0) then
k.secret := aDefaultSalt else
if aParamsJSON[1]<>'{' then
FastSetString(k.secret,aParamsJSON,aParamsJSONLen) else begin
tmp.Init(aParamsJSON,aParamsJSONLen);
try
if (RecordLoadJSON(k,tmp.buf,TypeInfo(TSynSignerParams))=nil) or
(k.secret='') or (k.salt='') then begin
SetDefault;
FastSetString(k.secret,aParamsJSON,aParamsJSONLen);
end;
finally
FillCharFast(tmp.buf^,tmp.len,0);
tmp.Done;
end;
end;
PBKDF2(k.algo,k.secret,k.salt,k.rounds,aDerivatedKey);
FillZero(k.secret);
end;
procedure TSynSigner.PBKDF2(const aParamsJSON: RawUTF8; out aDerivatedKey: THash512Rec;
const aDefaultSalt: RawUTF8; aDefaultAlgo: TSignAlgo);
begin
PBKDF2(pointer(aParamsJSON),length(aParamsJSON),aDerivatedKey,aDefaultSalt,aDefaultAlgo);
end;
procedure TSynSigner.AssignTo(var aDerivatedKey: THash512Rec; out aAES: TAES; aEncrypt: boolean);
var ks: integer;
begin
case Algo of
saSha3S128: ks := 128; // truncate to Keccak sponge precision
saSha3S256: ks := 256;
else
case SignatureSize of
20: begin
ks := 128;
aDerivatedKey.i0 := aDerivatedKey.i0 xor aDerivatedKey.i4;
end;
28: ks := 192;
32: ks := 256;
48: begin
ks := 256;
aDerivatedKey.d0 := aDerivatedKey.d0 xor aDerivatedKey.d4;
aDerivatedKey.d1 := aDerivatedKey.d1 xor aDerivatedKey.d5;
end;
64: begin
ks := 256;
aDerivatedKey.d0 := aDerivatedKey.d0 xor aDerivatedKey.d4;
aDerivatedKey.d1 := aDerivatedKey.d1 xor aDerivatedKey.d5;
aDerivatedKey.d2 := aDerivatedKey.d0 xor aDerivatedKey.d6;
aDerivatedKey.d3 := aDerivatedKey.d1 xor aDerivatedKey.d7;
end;
else exit;
end;
end;
aAES.DoInit(aDerivatedKey,ks,aEncrypt);
FillZero(aDerivatedKey.b);
end;
procedure TSynSigner.Done;
begin
FillCharFast(self, SizeOf(self), 0);
end;
procedure AES(const Key; KeySize: cardinal; buffer: pointer; Len: Integer; Encrypt: boolean);
begin
AES(Key,KeySize,buffer,buffer,Len,Encrypt);
end;
procedure AES(const Key; KeySize: cardinal; bIn, bOut: pointer; Len: Integer; Encrypt: boolean);
var n: integer;
pIn, pOut: PAESBlock;
Crypt: TAES;
begin
if (bIn=nil) or (bOut=nil) then exit;
// 1. Init
n := Len shr AESBlockShift;
if n<0 then exit else
if n>0 then
if (KeySize>4) and not Crypt.DoInit(Key,KeySize,Encrypt) then
KeySize := 4; // if error in KeySize, use default fast XorOffset()
if KeySize=0 then begin // KeySize=0 -> no encryption -> direct copy
MoveFast(bIn^, bOut^, Len);
exit;
end;
if n<1 then begin // too small for AES -> XorOffset() remaining 0..15 bytes
MoveFast(bIn^, bOut^, Len);
XorOffset(bOut,0,Len);
exit;
end;
// 2. All full blocks, with AES
{$ifdef USETHREADSFORBIGAESBLOCKS}
pIn := bIn;
pOut := bOut;
Crypt.DoBlocksThread(pIn,pOut,n,Encrypt);
{$else}
Crypt.DoBlocks(bIn,bOut,pIn,pOut,n,Encrypt);
{$endif}
// 3. Last block, just XORed from Key
// assert(KeySize div 8>=AESBlockSize);
n := cardinal(Len) and AESBlockMod;
MoveFast(pIn^,pOut^,n); // pIn=pOut is tested in MoveFast()
XorOffset(pointer(pOut),Len-n,n);
Crypt.Done;
end;
const TmpSize = 65536;
// Tmp buffer for AESFull -> Xor Crypt is TmpSize-dependent / use XorBlock()
TmpSizeBlock = TmpSize shr AESBlockShift;
type
TTmp = array[0..TmpSizeBlock-1] of TAESBlock;
function AES(const Key; KeySize: cardinal; const s: RawByteString; Encrypt: boolean): RawByteString;
begin
SetString(result,nil,length(s));
if s<>'' then
AES(Key,KeySize,pointer(s),pointer(result),length(s),Encrypt);
end;
function AES(const Key; KeySize: cardinal; buffer: pointer; Len: cardinal; Stream: TStream; Encrypt: boolean): boolean; overload;
var buf: pointer;
last, b, n, i: cardinal;
Crypt: TAES;
begin
result := false;
if buffer=nil then exit;
if (KeySize>4) and not Crypt.DoInit(Key,KeySize,Encrypt) then
KeySize := 4; // if error in KeySize, use default fast XorOffset()
if KeySize=0 then begin // no Crypt -> direct write to dest Stream
Stream.WriteBuffer(buffer^,Len);
result := true;
exit;
end;
getmem(buf,TmpSize);
try
Last := Len and AESBlockMod;
n := Len-Last;
i := 0;
while n>0 do begin // crypt/uncrypt all AESBlocks
if n>TmpSize then
b := TmpSize else
b := n;
assert(b and AESBlockMod=0);
if KeySize=4 then begin
MoveFast(buffer^,buf^,b);
XorOffset(pointer(buf),i,b);
inc(i,b);
end else
Crypt.DoBlocks(buffer,buf,b shr AESBlockShift,Encrypt);
Stream.WriteBuffer(buf^,b);
inc(PByte(buffer),b);
dec(n,b);
end;
assert((KeySize>4)or(i=Len-Last));
if last>0 then begin // crypt/uncrypt (Xor) last 0..15 bytes
MoveFast(buffer^,buf^,Last);
XorOffset(pointer(buf),Len-Last,Last);
Stream.WriteBuffer(buf^,Last);
end;
result := true;
finally
freemem(buf);
end;
end;
function KeyFrom(const Key; KeySize: cardinal): cardinal;
begin
case KeySize div 8 of
0: result := 0;
1: result := PByte(@Key)^;
2,3: result := PWord(@Key)^;
else result := PInteger(@Key)^;
end;
end;
function TAESFullHeader.Calc(const Key; KeySize: cardinal): cardinal;
begin
result := Adler32Asm(KeySize,@Key,KeySize shr 3) xor Te0[OriginalLen and $FF]
xor Te1[SourceLen and $FF] xor Td0[SomeSalt and $7FF];
end;
function TAESFull.EncodeDecode(const Key; KeySize, inLen: cardinal; Encrypt: boolean;
inStream, outStream: TStream; bIn, bOut: pointer; OriginalLen: Cardinal=0): integer;
var Tmp: ^TTmp;
pIn, pOut: PAESBlock;
Crypt: TAES;
nBlock,
XorCod: cardinal;
procedure Read(Tmp: pointer; ByteCount: cardinal);
begin
if pIn=nil then
InStream.Read(Tmp^,ByteCount) else begin
MoveFast(pIn^,Tmp^,ByteCount);
inc(PByte(pIn),ByteCount);
end;
end;
procedure Write(Tmp: pointer; ByteCount: cardinal);
begin
if pOut=nil then
OutStream.WriteBuffer(Tmp^,ByteCount) else begin
MoveFast(Tmp^,pOut^,ByteCount);
inc(PByte(pOut),ByteCount);
end;
end;
procedure SetOutLen(Len: cardinal);
var P: cardinal;
begin
result := Len; // global EncodeDecode() result
if OutStream<>nil then begin
if OutStream.InheritsFrom(TMemoryStream) then
with TMemoryStream(OutStream) do begin
P := Seek(0,soCurrent);
Size := P+Len; // auto-reserve space (no Realloc:)
Seek(P+Len,soBeginning);
bOut := PAnsiChar(Memory)+P;
pOut := bOut;
OutStream := nil; // OutStream is slower and use no thread
end;
end else
if bOut=nil then begin
outStreamCreated := THeapMemoryStream.Create; // faster than TMemoryStream
outStreamCreated.Size := Len; // auto-reserve space (no Realloc:)
bOut := outStreamCreated.Memory;
pOut := bOut; // OutStream is slower and use no thread
end;
if KeySize=0 then exit; // no Tmp to be allocated on direct copy
{$ifdef USEPADLOCK} // PADLOCK prefers 16-bytes alignment
if (KeySize=32) or (InStream<>nil) or (OutStream<>nil) or
(PtrUInt(bIn) and $f<>0) or (PtrUInt(bOut) and $f<>0) then begin
New(Tmp);
// assert(PtrUInt(Tmp) and $F=0);
end;
{$else}
if (KeySize=32) or (InStream<>nil) or (OutStream<>nil) then
New(Tmp);
{$endif}
end;
procedure DoBlock(BlockCount: integer);
begin
if BlockCount=0 then
exit;
Read(Tmp,BlockCount shl AESBlockShift);
Crypt.DoBlocks(PAESBLock(Tmp),PAESBLock(Tmp),BlockCount,Encrypt);
Write(Tmp,BlockCount shl AESBlockShift);
end;
var n, LastLen: cardinal;
i: integer;
Last: TAESBlock;
begin
result := 0; // makes FixInsight happy
Tmp := nil;
outStreamCreated := nil;
Head.SourceLen := InLen;
nBlock := Head.SourceLen shr AESBlockShift;
if Encrypt and (OriginalLen<>0) then
Head.OriginalLen := OriginalLen else
Head.OriginalLen := InLen;
KeySize := KeySize div 8;
if not (KeySize in [0,4,16,24,32]) then
KeySize := 0 else // valid KeySize: 0=nothing, 32=xor, 128,192,256=AES
KeySize := KeySize*8;
XorCod := inLen;
if (inStream<>nil) and inStream.InheritsFrom(TMemoryStream) then begin
bIn := TMemoryStream(inStream).Memory;
inStream := nil;
end;
pIn := bIn;
pOut := bOut;
if (KeySize>=128) and not Crypt.DoInit(Key,KeySize,Encrypt) then
KeySize := 32;
if KeySize=32 then
XorCod := KeyFrom(Key,KeySize) xor XorCod else
if (KeySize=0) and (InStream=nil) then begin
SetOutLen(inLen);
Write(bIn,inLen); // no encryption -> direct write
exit;
end;
try
// 0. KeySize = 0:direct copy 32:XorBlock
if KeySize<128 then begin
SetOutLen(inLen);
assert(Tmp<>nil);
LastLen := inLen;
while LastLen<>0 do begin
if LastLen>TmpSize then
n := TmpSize else
n := LastLen;
Read(Tmp,n);
if KeySize>0 then
XorBlock(pointer(Tmp),n,XorCod);
Write(Tmp,n);
dec(LastLen,n);
end;
end else begin // now we do AES encryption:
// 1. Header process
if Encrypt then begin
// encrypt data
if (pIn=pOut) and (pIn<>nil) then begin
assert(false); // Head in pOut^ will overflow data in pIn^
result := 0;
exit;
end;
LastLen := inLen and AESBlockMod;
if LastLen=0 then
SetOutLen(inLen+sizeof(TAESBlock)) else
SetOutLen((nBlock+2)shl AESBlockShift);
Head.SomeSalt := random(MaxInt);
Head.HeaderCheck := Head.Calc(Key,KeySize);
Crypt.Encrypt(TAESBlock(Head));
Write(@Head,sizeof(Head));
end else begin
// uncrypt data
dec(nBlock); // Header is already done
Read(@Head,sizeof(Head));
Crypt.Decrypt(TAESBlock(Head));
with Head do begin
if HeaderCheck<>Head.Calc(Key,KeySize) then begin
result := -1;
exit; // wrong key
end;
SetOutLen(SourceLen);
LastLen := SourceLen and AESBlockMod;
end;
if LastLen<>0 then
dec(nBlock); // the very last block is for the very last bytes
end;
// 2. All full blocks, with AES
if Tmp=nil then begin
{$ifdef USETHREADSFORBIGAESBLOCKS} // Tmp is 64KB -> helpless Threads
Crypt.DoBlocksThread(pIn,pOut,nBlock,Encrypt);
{$else}
Crypt.DoBlocks(pIn,pOut,pIn,pOut,nBlock,Encrypt);
{$endif}
end else begin
for i := 1 to nBlock div TmpSizeBlock do
DoBlock(TmpSizeBlock);
DoBlock(nBlock mod TmpSizeBlock);
end;
// 3. Last block
if LastLen<>0 then
if Encrypt then begin
FillcharFast(Last,sizeof(TAESBlock),0);
Read(@Last,LastLen);
Crypt.Encrypt(Last);
Write(@Last,sizeof(TAESBlock));
end else begin
Read(@Last,sizeof(TAESBlock));
Crypt.Decrypt(Last);
Write(@Last,LastLen);
end;
Crypt.Done;
end;
finally
if Tmp<>nil then
Freemem(Tmp);
end;
end;
function AESFullKeyOK(const Key; KeySize: cardinal; buff: pointer): boolean;
// true if begining of buff contains true AESFull encrypted data with this Key
var Crypt: TAES;
Head: TAESFullHeader;
begin
if KeySize<128 then
result := true else
if not Crypt.DecryptInit(Key,KeySize) then
result := false else begin
Crypt.Decrypt(PAESBlock(buff)^,TAESBlock(Head));
result := Head.Calc(Key,KeySize)=Head.HeaderCheck;
Crypt.Done;
end;
end;
function AESFull(const Key; KeySize: cardinal; bIn, bOut: pointer; Len: integer;
Encrypt: boolean; OriginalLen: Cardinal=0): integer; overload;
// bOut must be at least bIn+32/Encrypt bIn-16/Decrypt -> returns outLength, <0 if error
var A: TAESFull;
begin
result := A.EncodeDecode(Key,KeySize,Len,Encrypt,nil,nil,bIn,bOut,OriginalLen);
end;
function AESFull(const Key; KeySize: cardinal; bIn: pointer; Len: Integer;
outStream: TStream; Encrypt: boolean; OriginalLen: Cardinal=0): boolean; // true is Key OK
// outStream will be larger/smaller than Len: this is a full AES version
// if not KeySize in [128,192,256] -> use very fast and Simple Xor Cypher
var A: TAESFull;
begin
result := A.EncodeDecode(Key,KeySize,
Len,Encrypt,nil,outStream,bIn,nil,OriginalLen)>=0;
end;
procedure AESSHA256(bIn, bOut: pointer; Len: integer; const Password: RawByteString; Encrypt: boolean);
var Digest: TSHA256Digest;
begin
SHA256Weak(Password,Digest);
AES(Digest,sizeof(Digest)*8,bIn,bOut,Len,Encrypt);
FillZero(Digest);
end;
function AESSHA256(const s, Password: RawByteString; Encrypt: boolean): RawByteString;
begin
SetString(result,nil,length(s));
AESSHA256(pointer(s),pointer(result),length(s),Password,Encrypt);
end;
procedure AESSHA256(Buffer: pointer; Len: integer; const Password: RawByteString; Encrypt: boolean);
// Encrypt/Decrypt Buffer with AES and SHA-256 password
begin
AESSHA256(Buffer,Buffer,Len,Password,Encrypt);
end;
procedure AESSHA256Full(bIn: pointer; Len: Integer; outStream: TStream; const Password: RawByteString; Encrypt: boolean);
// outStream will be larger/smaller than Len: this is a full AES version
var Digest: TSHA256Digest;
begin
SHA256Weak(Password,Digest);
AESFull(Digest,sizeof(Digest)*8,bIn,Len,outStream,Encrypt);
end;
function Adler32Pas(Adler: cardinal; p: pointer; Count: Integer): cardinal;
// simple Adler32 implementation (twice slower than Asm, but shorter code size)
var s1, s2: cardinal;
i, n: integer;
begin
s1 := LongRec(Adler).Lo;
s2 := LongRec(Adler).Hi;
while Count>0 do begin
if Count<5552 then
n := Count else
n := 5552;
for i := 1 to n do begin
inc(s1,PByte(p)^);
inc(PByte(p));
inc(s2,s1);
end;
s1 := s1 mod 65521;
s2 := s2 mod 65521;
dec(Count,n);
end;
result := (s1 and $ffff)+(s2 and $ffff) shl 16;
end;
function Adler32Asm(Adler: cardinal; p: pointer; Count: Integer): cardinal;
{$ifdef PUREPASCAL}
begin
result := Adler32Pas(Adler,p,Count);
end;
{$else} {$ifdef FPC} nostackframe; assembler; {$endif}
asm
push ebx
push esi
push edi
mov edi, eax
shr edi, 16
movzx ebx, ax
push ebp
mov esi, edx
test esi, esi
mov ebp, ecx
jne @31
mov eax, 1
jmp @32
@31: test ebp, ebp
jbe @34
@33: cmp ebp, 5552
jae @35
mov eax, ebp
jmp @36
@35: mov eax, 5552
@36: sub ebp, eax
cmp eax, 16
jl @38
xor edx, edx
xor ecx, ecx
@39: sub eax, 16
mov dl, [esi]
mov cl, [esi + 1]
add ebx, edx
add edi, ebx
add ebx, ecx
mov dl, [esi + 2]
add edi, ebx
add ebx, edx
mov cl, [esi + 3]
add edi, ebx
add ebx, ecx
mov dl, [esi + 4]
add edi, ebx
add ebx, edx
mov cl, [esi + 5]
add edi, ebx
add ebx, ecx
mov dl, [esi + 6]
add edi, ebx
add ebx, edx
mov cl, [esi + 7]
add edi, ebx
add ebx, ecx
mov dl, [esi + 8]
add edi, ebx
add ebx, edx
mov cl, [esi + 9]
add edi, ebx
add ebx, ecx
mov dl, [esi + 10]
add edi, ebx
add ebx, edx
mov cl, [esi + 11]
add edi, ebx
add ebx, ecx
mov dl, [esi + 12]
add edi, ebx
add ebx, edx
mov cl, [esi + 13]
add edi, ebx
add ebx, ecx
mov dl, [esi + 14]
add edi, ebx
add ebx, edx
mov cl, [esi + 15]
add edi, ebx
add ebx, ecx
add esi, 16
lea edi, [edi + ebx]
cmp eax, 16
jge @39
@38: test eax, eax
je @42
@43: movzx edx, byte ptr[esi]
add ebx, edx
dec eax
lea esi, [esi + 1]
lea edi, [edi + ebx]
jg @43
@42: mov ecx, 65521
mov eax, ebx
xor edx, edx
div ecx
mov ebx, edx
mov ecx, 65521
mov eax, edi
xor edx, edx
div ecx
test ebp, ebp
mov edi, edx
ja @33
@34: mov eax, edi
shl eax, 16
or eax, ebx
@32: pop ebp
pop edi
pop esi
pop ebx
end;
{$endif}
function Adler32SelfTest: boolean;
begin
result :=
{$ifndef PUREPASCAL}
(Adler32Asm(1,@Te0,sizeof(Te0))=$BCBEFE10) and
(Adler32Asm(7,@Te1,sizeof(Te1)-3)=$DA91FDBE) and
{$endif}
(Adler32Pas(1,@Te0,sizeof(Te0))=$BCBEFE10) and
(Adler32Pas(7,@Te1,sizeof(Te1)-3)=$DA91FDBE);
end;
{ TAESWriteStream }
constructor TAESWriteStream.Create(outStream: TStream; const Key; KeySize: cardinal);
begin
inherited Create;
if KeySize=0 then
NoCrypt := true else
AES.EncryptInit(Key,KeySize);
Dest := outStream;
end;
destructor TAESWriteStream.Destroy;
begin
Finish;
AES.Done;
inherited;
end;
procedure TAESWriteStream.Finish;
begin
if BufCount=0 then exit;
assert((BufCount<sizeof(TAESBlock)) and AES.Initialized and not NoCrypt);
XorOffset(@Buf,DestSize,BufCount);
Dest.WriteBuffer(Buf,BufCount);
BufCount := 0;
end;
function TAESWriteStream.Read(var Buffer; Count: Integer): Longint;
begin
raise ESynCrypto.CreateUTF8('Unexpected %.Read',[self]);
end;
function TAESWriteStream.Seek(Offset: Integer; Origin: Word): Longint;
begin
raise ESynCrypto.CreateUTF8('Unexpected %.Seek',[self]);
end;
function TAESWriteStream.Write(const Buffer; Count: Integer): Longint;
// most of the time, a 64KB-buffered compressor have BufCount=0
// will crypt 'const Buffer' memory in place -> use AFTER T*Compressor
var B: TByteArray absolute Buffer;
Len: integer;
begin
result := Count;
Adler := Adler32Asm(Adler,@Buffer,Count);
if not NoCrypt then // KeySize=0 -> save as-is
if not AES.Initialized then // if error in KeySize -> default fast XorOffset()
XorOffset(@B,DestSize,Count) else begin
if BufCount>0 then begin
Len := sizeof(TAESBlock)-BufCount;
if Len>Count then
Len := Count;
MoveFast(Buffer,Buf[BufCount],Len);
inc(BufCount,Len);
if BufCount<sizeof(TAESBlock) then
exit;
AES.Encrypt(Buf);
Dest.WriteBuffer(Buf,sizeof(TAESBlock));
inc(DestSize,sizeof(TAESBlock));
Dec(Count,Len);
AES.DoBlocks(@B[Len],@B[Len],cardinal(Count) shr AESBlockShift,true);
end else
AES.DoBlocks(@B,@B,cardinal(Count) shr AESBlockShift,true);
BufCount := cardinal(Count) and AESBlockMod;
if BufCount<>0 then begin
dec(Count,BufCount);
MoveFast(B[Count],Buf[0],BufCount);
end;
end;
Dest.WriteBuffer(Buffer,Count);
inc(DestSize,Count);
end;
procedure XorBlock(p: PIntegerArray; Count, Cod: integer);
// very fast Xor() according to Cod - not Compression or Stream compatible
var i: integer;
begin
for i := 1 to Count shr 4 do begin // proceed through 16 bytes blocs
Cod := (Cod shl 11) xor integer(Td0[cod shr 21]); // shr 21 -> 8*[byte] of cardinal
p^[0] := p^[0] xor Cod;
p^[1] := p^[1] xor Cod;
p^[2] := p^[2] xor Cod;
p^[3] := p^[3] xor Cod;
inc(PByte(p),16);
end;
Cod := (Cod shl 11) xor integer(Td0[cod shr 21]);
for i := 1 to (Count and AESBlockMod)shr 2 do begin // last 4 bytes blocs
p^[0] := p^[0] xor Cod;
inc(PByte(p),4);
end;
for i := 1 to Count and 3 do begin
PByte(p)^ := PByte(p)^ xor byte(Cod);
inc(PByte(p));
end;
end;
procedure XorOffset(P: PByteArray; Index,Count: integer);
// XorOffset: fast and simple Cypher using Index (=Position in Dest Stream):
// Compression not OK -> apply after compress (e.g. TBZCompressor.withXor=true)
var Len: integer;
begin
if Count>0 then
repeat
Index := Index and $1FFF;
Len := $2000-Index;
if Len>Count then
Len := Count;
XorMemory(P,@Xor32Byte[Index],Len);
inc(P,Len);
inc(Index,Len);
Dec(Count,Len);
until Count=0;
end;
procedure XorConst(P: PIntegerArray; Count: integer);
// XorConst: fast Cypher changing by Count value
// (compression OK):
var i: integer;
Code: integer;
begin // 1 to 3 bytes may stay unencrypted: not relevant
Code := integer(Td0[Count and $3FF]);
for i := 1 to (Count shr 4) do begin
P^[0] := P^[0] xor Code;
P^[1] := P^[1] xor Code;
P^[2] := P^[2] xor Code;
P^[3] := P^[3] xor Code;
inc(PByte(P),16);
end;
for i := 0 to ((Count and AESBlockMod)shr 2)-1 do // last 4 bytes blocs
P^[i] := P^[i] xor Code;
end;
{ TMD5 }
procedure MD5Transform(var buf: TMD5Buf; const in_: TMD5In);
// see https://synopse.info/forum/viewtopic.php?id=4369 for asm numbers
{$ifdef CPUX64}
{
MD5_Transform-x64
MD5 transform routine optimized for x64 processors
Copyright 2018 Ritlabs, SRL
The 64-bit version is written by Maxim Masiutin <max@ritlabs.com>
The main advantage of this 64-bit version is that it loads 64 bytes of hashed
message into 8 64-bit registers (RBP, R8, R9, R10, R11, R12, R13, R14) at the
beginning, to avoid excessive memory load operations througout the routine.
MD5_Transform-x64 is released under a dual license, and you may choose to use
it under either the Mozilla Public License 2.0 (MPL 2.1, available from
https://www.mozilla.org/en-US/MPL/2.0/) or the GNU Lesser General Public
License Version 3, dated 29 June 2007 (LGPL 3, available from
https://www.gnu.org/licenses/lgpl.html).
MD5_Transform-x64 is based on Peter Sawatzki's code.
Taken from https://github.com/maximmasiutin/MD5_Transform-x64
}
{$ifdef FPC}nostackframe; assembler; asm{$else}
asm // W=rcx Buf=rdx
.noframe
{$endif}
{$ifndef win64}
mov rdx, rsi
mov rcx, rdi
{$endif win64}
push rbx
push rsi
push rdi
push rbp
push r12
push r13
push r14
mov r14, rdx
mov rsi, rcx
push rsi
mov eax, dword ptr [rsi]
mov ebx, dword ptr [rsi+4H]
mov ecx, dword ptr [rsi+8H]
mov edx, dword ptr [rsi+0CH]
mov rbp, qword ptr [r14]
add eax, -680876936
add eax, ebp
mov esi, ebx
not esi
and esi, edx
mov edi, ecx
and edi, ebx
or esi, edi
add eax, esi
rol eax, 7
add eax, ebx
ror rbp, 32
add edx, -389564586
add edx, ebp
mov esi, eax
not esi
and esi, ecx
mov edi, ebx
and edi, eax
or esi, edi
add edx, esi
rol edx, 12
add edx, eax
mov r8, qword ptr [r14+8H]
add ecx, 606105819
add ecx, r8d
mov esi, edx
not esi
and esi, ebx
mov edi, eax
and edi, edx
or esi, edi
add ecx, esi
rol ecx, 17
add ecx, edx
ror r8, 32
add ebx, -1044525330
add ebx, r8d
mov esi, ecx
not esi
and esi, eax
mov edi, edx
and edi, ecx
or esi, edi
add ebx, esi
rol ebx, 22
add ebx, ecx
mov r9, qword ptr [r14+10H]
add eax, -176418897
add eax, r9d
mov esi, ebx
not esi
and esi, edx
mov edi, ecx
and edi, ebx
or esi, edi
add eax, esi
rol eax, 7
add eax, ebx
ror r9, 32
add edx, 1200080426
add edx, r9d
mov esi, eax
not esi
and esi, ecx
mov edi, ebx
and edi, eax
or esi, edi
add edx, esi
rol edx, 12
add edx, eax
mov r10, qword ptr [r14+18H]
add ecx, -1473231341
add ecx, r10d
mov esi, edx
not esi
and esi, ebx
mov edi, eax
and edi, edx
or esi, edi
add ecx, esi
rol ecx, 17
add ecx, edx
ror r10, 32
add ebx, -45705983
add ebx, r10d
mov esi, ecx
not esi
and esi, eax
mov edi, edx
and edi, ecx
or esi, edi
add ebx, esi
rol ebx, 22
add ebx, ecx
mov r11, qword ptr [r14+20H]
add eax, 1770035416
add eax, r11d
mov esi, ebx
not esi
and esi, edx
mov edi, ecx
and edi, ebx
or esi, edi
add eax, esi
rol eax, 7
add eax, ebx
ror r11, 32
add edx, -1958414417
add edx, r11d
mov esi, eax
not esi
and esi, ecx
mov edi, ebx
and edi, eax
or esi, edi
add edx, esi
rol edx, 12
add edx, eax
mov r12, qword ptr [r14+28H]
add ecx, -42063
add ecx, r12d
mov esi, edx
not esi
and esi, ebx
mov edi, eax
and edi, edx
or esi, edi
add ecx, esi
rol ecx, 17
add ecx, edx
ror r12, 32
add ebx, -1990404162
add ebx, r12d
mov esi, ecx
not esi
and esi, eax
mov edi, edx
and edi, ecx
or esi, edi
add ebx, esi
rol ebx, 22
add ebx, ecx
mov r13, qword ptr [r14+30H]
add eax, 1804603682
add eax, r13d
mov esi, ebx
not esi
and esi, edx
mov edi, ecx
and edi, ebx
or esi, edi
add eax, esi
rol eax, 7
add eax, ebx
ror r13, 32
add edx, -40341101
add edx, r13d
mov esi, eax
not esi
and esi, ecx
mov edi, ebx
and edi, eax
or esi, edi
add edx, esi
rol edx, 12
add edx, eax
mov r14, qword ptr [r14+38H]
add ecx, -1502002290
add ecx, r14d
mov esi, edx
not esi
and esi, ebx
mov edi, eax
and edi, edx
or esi, edi
add ecx, esi
rol ecx, 17
add ecx, edx
ror r14, 32
add ebx, 1236535329
add ebx, r14d
mov esi, ecx
not esi
and esi, eax
mov edi, edx
and edi, ecx
or esi, edi
add ebx, esi
rol ebx, 22
add ebx, ecx
add eax, -165796510
add eax, ebp
mov esi, edx
not esi
and esi, ecx
mov edi, edx
and edi, ebx
or esi, edi
add eax, esi
rol eax, 5
add eax, ebx
ror r10, 32
add edx, -1069501632
add edx, r10d
mov esi, ecx
not esi
and esi, ebx
mov edi, ecx
and edi, eax
or esi, edi
add edx, esi
rol edx, 9
add edx, eax
add ecx, 643717713
add ecx, r12d
mov esi, ebx
not esi
and esi, eax
mov edi, ebx
and edi, edx
or esi, edi
add ecx, esi
rol ecx, 14
add ecx, edx
ror rbp, 32
add ebx, -373897302
add ebx, ebp
mov esi, eax
not esi
and esi, edx
mov edi, eax
and edi, ecx
or esi, edi
add ebx, esi
rol ebx, 20
add ebx, ecx
add eax, -701558691
add eax, r9d
mov esi, edx
not esi
and esi, ecx
mov edi, edx
and edi, ebx
or esi, edi
add eax, esi
rol eax, 5
add eax, ebx
ror r12, 32
add edx, 38016083
add edx, r12d
mov esi, ecx
not esi
and esi, ebx
mov edi, ecx
and edi, eax
or esi, edi
add edx, esi
rol edx, 9
add edx, eax
add ecx, -660478335
add ecx, r14d
mov esi, ebx
not esi
and esi, eax
mov edi, ebx
and edi, edx
or esi, edi
add ecx, esi
rol ecx, 14
add ecx, edx
ror r9, 32
add ebx, -405537848
add ebx, r9d
mov esi, eax
not esi
and esi, edx
mov edi, eax
and edi, ecx
or esi, edi
add ebx, esi
rol ebx, 20
add ebx, ecx
add eax, 568446438
add eax, r11d
mov esi, edx
not esi
and esi, ecx
mov edi, edx
and edi, ebx
or esi, edi
add eax, esi
rol eax, 5
add eax, ebx
ror r14, 32
add edx, -1019803690
add edx, r14d
mov esi, ecx
not esi
and esi, ebx
mov edi, ecx
and edi, eax
or esi, edi
add edx, esi
rol edx, 9
add edx, eax
add ecx, -187363961
add ecx, r8d
mov esi, ebx
not esi
and esi, eax
mov edi, ebx
and edi, edx
or esi, edi
add ecx, esi
rol ecx, 14
add ecx, edx
ror r11, 32
add ebx, 1163531501
add ebx, r11d
mov esi, eax
not esi
and esi, edx
mov edi, eax
and edi, ecx
or esi, edi
add ebx, esi
rol ebx, 20
add ebx, ecx
add eax, -1444681467
add eax, r13d
mov esi, edx
not esi
and esi, ecx
mov edi, edx
and edi, ebx
or esi, edi
add eax, esi
rol eax, 5
add eax, ebx
ror r8, 32
add edx, -51403784
add edx, r8d
mov esi, ecx
not esi
and esi, ebx
mov edi, ecx
and edi, eax
or esi, edi
add edx, esi
rol edx, 9
add edx, eax
ror r10, 32
add ecx, 1735328473
add ecx, r10d
mov esi, ebx
not esi
and esi, eax
mov edi, ebx
and edi, edx
or esi, edi
add ecx, esi
rol ecx, 14
add ecx, edx
ror r13, 32
add ebx, -1926607734
add ebx, r13d
mov esi, eax
not esi
and esi, edx
mov edi, eax
and edi, ecx
or esi, edi
add ebx, esi
rol ebx, 20
add ebx, ecx
ror r9, 32
add eax, -378558
add eax, r9d
mov esi, edx
xor esi, ecx
xor esi, ebx
add eax, esi
rol eax, 4
add eax, ebx
add edx, -2022574463
add edx, r11d
mov esi, ecx
xor esi, ebx
xor esi, eax
add edx, esi
rol edx, 11
add edx, eax
ror r12, 32
add ecx, 1839030562
add ecx, r12d
mov esi, ebx
xor esi, eax
xor esi, edx
add ecx, esi
rol ecx, 16
add ecx, edx
add ebx, -35309556
add ebx, r14d
mov esi, eax
xor esi, edx
xor esi, ecx
add ebx, esi
rol ebx, 23
add ebx, ecx
ror rbp, 32
add eax, -1530992060
add eax, ebp
mov esi, edx
xor esi, ecx
xor esi, ebx
add eax, esi
rol eax, 4
add eax, ebx
ror r9, 32
add edx, 1272893353
add edx, r9d
mov esi, ecx
xor esi, ebx
xor esi, eax
add edx, esi
rol edx, 11
add edx, eax
add ecx, -155497632
add ecx, r10d
mov esi, ebx
xor esi, eax
xor esi, edx
add ecx, esi
rol ecx, 16
add ecx, edx
ror r12, 32
add ebx, -1094730640
add ebx, r12d
mov esi, eax
xor esi, edx
xor esi, ecx
add ebx, esi
rol ebx, 23
add ebx, ecx
ror r13, 32
add eax, 681279174
add eax, r13d
mov esi, edx
xor esi, ecx
xor esi, ebx
add eax, esi
rol eax, 4
add eax, ebx
ror rbp, 32
add edx, -358537222
add edx, ebp
mov esi, ecx
xor esi, ebx
xor esi, eax
add edx, esi
rol edx, 11
add edx, eax
ror r8, 32
add ecx, -722521979
add ecx, r8d
mov esi, ebx
xor esi, eax
xor esi, edx
add ecx, esi
rol ecx, 16
add ecx, edx
ror r10, 32
add ebx, 76029189
add ebx, r10d
mov esi, eax
xor esi, edx
xor esi, ecx
add ebx, esi
rol ebx, 23
add ebx, ecx
ror r11, 32
add eax, -640364487
add eax, r11d
mov esi, edx
xor esi, ecx
xor esi, ebx
add eax, esi
rol eax, 4
add eax, ebx
ror r13, 32
add edx, -421815835
add edx, r13d
mov esi, ecx
xor esi, ebx
xor esi, eax
add edx, esi
rol edx, 11
add edx, eax
ror r14, 32
add ecx, 530742520
add ecx, r14d
mov esi, ebx
xor esi, eax
xor esi, edx
add ecx, esi
rol ecx, 16
add ecx, edx
ror r8, 32
add ebx, -995338651
add ebx, r8d
mov esi, eax
xor esi, edx
xor esi, ecx
add ebx, esi
rol ebx, 23
add ebx, ecx
add eax, -198630844
add eax, ebp
mov esi, edx
not esi
or esi, ebx
xor esi, ecx
add eax, esi
rol eax, 6
add eax, ebx
ror r10, 32
add edx, 1126891415
add edx, r10d
mov esi, ecx
not esi
or esi, eax
xor esi, ebx
add edx, esi
rol edx, 10
add edx, eax
ror r14, 32
add ecx, -1416354905
add ecx, r14d
mov esi, ebx
not esi
or esi, edx
xor esi, eax
add ecx, esi
rol ecx, 15
add ecx, edx
ror r9, 32
add ebx, -57434055
add ebx, r9d
mov esi, eax
not esi
or esi, ecx
xor esi, edx
add ebx, esi
rol ebx, 21
add ebx, ecx
add eax, 1700485571
add eax, r13d
mov esi, edx
not esi
or esi, ebx
xor esi, ecx
add eax, esi
rol eax, 6
add eax, ebx
ror r8, 32
add edx, -1894986606
add edx, r8d
mov esi, ecx
not esi
or esi, eax
xor esi, ebx
add edx, esi
rol edx, 10
add edx, eax
add ecx, -1051523
add ecx, r12d
mov esi, ebx
not esi
or esi, edx
xor esi, eax
add ecx, esi
rol ecx, 15
add ecx, edx
ror rbp, 32
add ebx, -2054922799
add ebx, ebp
mov esi, eax
not esi
or esi, ecx
xor esi, edx
add ebx, esi
rol ebx, 21
add ebx, ecx
ror r11, 32
add eax, 1873313359
add eax, r11d
mov esi, edx
not esi
or esi, ebx
xor esi, ecx
add eax, esi
rol eax, 6
add eax, ebx
ror r14, 32
add edx, -30611744
add edx, r14d
mov esi, ecx
not esi
or esi, eax
xor esi, ebx
add edx, esi
rol edx, 10
add edx, eax
ror r10, 32
add ecx, -1560198380
add ecx, r10d
mov esi, ebx
not esi
or esi, edx
xor esi, eax
add ecx, esi
rol ecx, 15
add ecx, edx
ror r13, 32
add ebx, 1309151649
add ebx, r13d
mov esi, eax
not esi
or esi, ecx
xor esi, edx
add ebx, esi
rol ebx, 21
add ebx, ecx
ror r9, 32
add eax, -145523070
add eax, r9d
mov esi, edx
not esi
or esi, ebx
xor esi, ecx
add eax, esi
rol eax, 6
add eax, ebx
ror r12, 32
add edx, -1120210379
add edx, r12d
mov esi, ecx
not esi
or esi, eax
xor esi, ebx
add edx, esi
rol edx, 10
add edx, eax
ror r8, 32
add ecx, 718787259
add ecx, r8d
mov esi, ebx
not esi
or esi, edx
xor esi, eax
add ecx, esi
rol ecx, 15
add ecx, edx
ror r11, 32
add ebx, -343485551
add ebx, r11d
mov esi, eax
not esi
or esi, ecx
xor esi, edx
add ebx, esi
rol ebx, 21
add ebx, ecx
pop rsi
add dword ptr [rsi], eax
add dword ptr [rsi+4H], ebx
add dword ptr [rsi+8H], ecx
add dword ptr [rsi+0CH], edx
pop r14
pop r13
pop r12
pop rbp
pop rdi
pop rsi
pop rbx
end;
{$else}
{$ifdef PUREPASCAL}
var a,b,c,d: cardinal; // unrolled -> compiler will only use cpu registers :)
// the code below is very fast, and can be compared proudly against C or ASM
begin
a := buf[0];
b := buf[1];
c := buf[2];
d := buf[3];
{$ifdef FPC} // uses faster built-in right rotate intrinsic
inc(a,in_[0]+$d76aa478+(d xor(b and(c xor d)))); a := RolDWord(a,7)+b;
inc(d,in_[1]+$e8c7b756+(c xor(a and(b xor c)))); d := RolDWord(d,12)+a;
inc(c,in_[2]+$242070db+(b xor(d and(a xor b)))); c := RolDWord(c,17)+d;
inc(b,in_[3]+$c1bdceee+(a xor(c and(d xor a)))); b := RolDWord(b,22)+c;
inc(a,in_[4]+$f57c0faf+(d xor(b and(c xor d)))); a := RolDWord(a,7)+b;
inc(d,in_[5]+$4787c62a+(c xor(a and(b xor c)))); d := RolDWord(d,12)+a;
inc(c,in_[6]+$a8304613+(b xor(d and(a xor b)))); c := RolDWord(c,17)+d;
inc(b,in_[7]+$fd469501+(a xor(c and(d xor a)))); b := RolDWord(b,22)+c;
inc(a,in_[8]+$698098d8+(d xor(b and(c xor d)))); a := RolDWord(a,7)+b;
inc(d,in_[9]+$8b44f7af+(c xor(a and(b xor c)))); d := RolDWord(d,12)+a;
inc(c,in_[10]+$ffff5bb1+(b xor(d and(a xor b)))); c := RolDWord(c,17)+d;
inc(b,in_[11]+$895cd7be+(a xor(c and(d xor a)))); b := RolDWord(b,22)+c;
inc(a,in_[12]+$6b901122+(d xor(b and(c xor d)))); a := RolDWord(a,7)+b;
inc(d,in_[13]+$fd987193+(c xor(a and(b xor c)))); d := RolDWord(d,12)+a;
inc(c,in_[14]+$a679438e+(b xor(d and(a xor b)))); c := RolDWord(c,17)+d;
inc(b,in_[15]+$49b40821+(a xor(c and(d xor a)))); b := RolDWord(b,22)+c;
inc(a,in_[1]+$f61e2562+(c xor(d and(b xor c)))); a := RolDWord(a,5)+b;
inc(d,in_[6]+$c040b340+(b xor(c and(a xor b)))); d := RolDWord(d,9)+a;
inc(c,in_[11]+$265e5a51+(a xor(b and(d xor a)))); c := RolDWord(c,14)+d;
inc(b,in_[0]+$e9b6c7aa+(d xor(a and(c xor d)))); b := RolDWord(b,20)+c;
inc(a,in_[5]+$d62f105d+(c xor(d and(b xor c)))); a := RolDWord(a,5)+b;
inc(d,in_[10]+$02441453+(b xor(c and(a xor b)))); d := RolDWord(d,9)+a;
inc(c,in_[15]+$d8a1e681+(a xor(b and(d xor a)))); c := RolDWord(c,14)+d;
inc(b,in_[4]+$e7d3fbc8+(d xor(a and(c xor d)))); b := RolDWord(b,20)+c;
inc(a,in_[9]+$21e1cde6+(c xor(d and(b xor c)))); a := RolDWord(a,5)+b;
inc(d,in_[14]+$c33707d6+(b xor(c and(a xor b)))); d := RolDWord(d,9)+a;
inc(c,in_[3]+$f4d50d87+(a xor(b and(d xor a)))); c := RolDWord(c,14)+d;
inc(b,in_[8]+$455a14ed+(d xor(a and(c xor d)))); b := RolDWord(b,20)+c;
inc(a,in_[13]+$a9e3e905+(c xor(d and(b xor c)))); a := RolDWord(a,5)+b;
inc(d,in_[2]+$fcefa3f8+(b xor(c and(a xor b)))); d := RolDWord(d,9)+a;
inc(c,in_[7]+$676f02d9+(a xor(b and(d xor a)))); c := RolDWord(c,14)+d;
inc(b,in_[12]+$8d2a4c8a+(d xor(a and(c xor d)))); b := RolDWord(b,20)+c;
inc(a,in_[5]+$fffa3942+(b xor c xor d)); a := RolDWord(a,4)+b;
inc(d,in_[8]+$8771f681+(a xor b xor c)); d := RolDWord(d,11)+a;
inc(c,in_[11]+$6d9d6122+(d xor a xor b)); c := RolDWord(c,16)+d;
inc(b,in_[14]+$fde5380c+(c xor d xor a)); b := RolDWord(b,23)+c;
inc(a,in_[1]+$a4beea44+(b xor c xor d)); a := RolDWord(a,4)+b;
inc(d,in_[4]+$4bdecfa9+(a xor b xor c)); d := RolDWord(d,11)+a;
inc(c,in_[7]+$f6bb4b60+(d xor a xor b)); c := RolDWord(c,16)+d;
inc(b,in_[10]+$bebfbc70+(c xor d xor a)); b := RolDWord(b,23)+c;
inc(a,in_[13]+$289b7ec6+(b xor c xor d)); a := RolDWord(a,4)+b;
inc(d,in_[0]+$eaa127fa+(a xor b xor c)); d := RolDWord(d,11)+a;
inc(c,in_[3]+$d4ef3085+(d xor a xor b)); c := RolDWord(c,16)+d;
inc(b,in_[6]+$04881d05+(c xor d xor a)); b := RolDWord(b,23)+c;
inc(a,in_[9]+$d9d4d039+(b xor c xor d)); a := RolDWord(a,4)+b;
inc(d,in_[12]+$e6db99e5+(a xor b xor c)); d := RolDWord(d,11)+a;
inc(c,in_[15]+$1fa27cf8+(d xor a xor b)); c := RolDWord(c,16)+d;
inc(b,in_[2]+$c4ac5665+(c xor d xor a)); b := RolDWord(b,23)+c;
inc(a,in_[0]+$f4292244+(c xor(b or(not d)))); a := RolDWord(a,6)+b;
inc(d,in_[7]+$432aff97+(b xor(a or(not c)))); d := RolDWord(d,10)+a;
inc(c,in_[14]+$ab9423a7+(a xor(d or(not b)))); c := RolDWord(c,15)+d;
inc(b,in_[5]+$fc93a039+(d xor(c or(not a)))); b := RolDWord(b,21)+c;
inc(a,in_[12]+$655b59c3+(c xor(b or(not d)))); a := RolDWord(a,6)+b;
inc(d,in_[3]+$8f0ccc92+(b xor(a or(not c)))); d := RolDWord(d,10)+a;
inc(c,in_[10]+$ffeff47d+(a xor(d or(not b)))); c := RolDWord(c,15)+d;
inc(b,in_[1]+$85845dd1+(d xor(c or(not a)))); b := RolDWord(b,21)+c;
inc(a,in_[8]+$6fa87e4f+(c xor(b or(not d)))); a := RolDWord(a,6)+b;
inc(d,in_[15]+$fe2ce6e0+(b xor(a or(not c)))); d := RolDWord(d,10)+a;
inc(c,in_[6]+$a3014314+(a xor(d or(not b)))); c := RolDWord(c,15)+d;
inc(b,in_[13]+$4e0811a1+(d xor(c or(not a)))); b := RolDWord(b,21)+c;
inc(a,in_[4]+$f7537e82+(c xor(b or(not d)))); a := RolDWord(a,6)+b;
inc(d,in_[11]+$bd3af235+(b xor(a or(not c)))); d := RolDWord(d,10)+a;
inc(c,in_[2]+$2ad7d2bb+(a xor(d or(not b)))); c := RolDWord(c,15)+d;
inc(b,in_[9]+$eb86d391+(d xor(c or(not a)))); b := RolDWord(b,21)+c;
{$else}
inc(a,in_[0]+$d76aa478+(d xor(b and(c xor d)))); a := ((a shl 7)or(a shr(32-7)))+b;
inc(d,in_[1]+$e8c7b756+(c xor(a and(b xor c)))); d := ((d shl 12)or(d shr(32-12)))+a;
inc(c,in_[2]+$242070db+(b xor(d and(a xor b)))); c := ((c shl 17)or(c shr(32-17)))+d;
inc(b,in_[3]+$c1bdceee+(a xor(c and(d xor a)))); b := ((b shl 22)or(b shr(32-22)))+c;
inc(a,in_[4]+$f57c0faf+(d xor(b and(c xor d)))); a := ((a shl 7)or(a shr(32-7)))+b;
inc(d,in_[5]+$4787c62a+(c xor(a and(b xor c)))); d := ((d shl 12)or(d shr(32-12)))+a;
inc(c,in_[6]+$a8304613+(b xor(d and(a xor b)))); c := ((c shl 17)or(c shr(32-17)))+d;
inc(b,in_[7]+$fd469501+(a xor(c and(d xor a)))); b := ((b shl 22)or(b shr(32-22)))+c;
inc(a,in_[8]+$698098d8+(d xor(b and(c xor d)))); a := ((a shl 7)or(a shr(32-7)))+b;
inc(d,in_[9]+$8b44f7af+(c xor(a and(b xor c)))); d := ((d shl 12)or(d shr(32-12)))+a;
inc(c,in_[10]+$ffff5bb1+(b xor(d and(a xor b)))); c := ((c shl 17)or(c shr(32-17)))+d;
inc(b,in_[11]+$895cd7be+(a xor(c and(d xor a)))); b := ((b shl 22)or(b shr(32-22)))+c;
inc(a,in_[12]+$6b901122+(d xor(b and(c xor d)))); a := ((a shl 7)or(a shr(32-7)))+b;
inc(d,in_[13]+$fd987193+(c xor(a and(b xor c)))); d := ((d shl 12)or(d shr(32-12)))+a;
inc(c,in_[14]+$a679438e+(b xor(d and(a xor b)))); c := ((c shl 17)or(c shr(32-17)))+d;
inc(b,in_[15]+$49b40821+(a xor(c and(d xor a)))); b := ((b shl 22)or(b shr(32-22)))+c;
inc(a,in_[1]+$f61e2562+(c xor(d and(b xor c)))); a := ((a shl 5)or(a shr(32-5)))+b;
inc(d,in_[6]+$c040b340+(b xor(c and(a xor b)))); d := ((d shl 9)or(d shr(32-9)))+a;
inc(c,in_[11]+$265e5a51+(a xor(b and(d xor a)))); c := ((c shl 14)or(c shr(32-14)))+d;
inc(b,in_[0]+$e9b6c7aa+(d xor(a and(c xor d)))); b := ((b shl 20)or(b shr(32-20)))+c;
inc(a,in_[5]+$d62f105d+(c xor(d and(b xor c)))); a := ((a shl 5)or(a shr(32-5)))+b;
inc(d,in_[10]+$02441453+(b xor(c and(a xor b)))); d := ((d shl 9)or(d shr(32-9)))+a;
inc(c,in_[15]+$d8a1e681+(a xor(b and(d xor a)))); c := ((c shl 14)or(c shr(32-14)))+d;
inc(b,in_[4]+$e7d3fbc8+(d xor(a and(c xor d)))); b := ((b shl 20)or(b shr(32-20)))+c;
inc(a,in_[9]+$21e1cde6+(c xor(d and(b xor c)))); a := ((a shl 5)or(a shr(32-5)))+b;
inc(d,in_[14]+$c33707d6+(b xor(c and(a xor b)))); d := ((d shl 9)or(d shr(32-9)))+a;
inc(c,in_[3]+$f4d50d87+(a xor(b and(d xor a)))); c := ((c shl 14)or(c shr(32-14)))+d;
inc(b,in_[8]+$455a14ed+(d xor(a and(c xor d)))); b := ((b shl 20)or(b shr(32-20)))+c;
inc(a,in_[13]+$a9e3e905+(c xor(d and(b xor c)))); a := ((a shl 5)or(a shr(32-5)))+b;
inc(d,in_[2]+$fcefa3f8+(b xor(c and(a xor b)))); d := ((d shl 9)or(d shr(32-9)))+a;
inc(c,in_[7]+$676f02d9+(a xor(b and(d xor a)))); c := ((c shl 14)or(c shr(32-14)))+d;
inc(b,in_[12]+$8d2a4c8a+(d xor(a and(c xor d)))); b := ((b shl 20)or(b shr(32-20)))+c;
inc(a,in_[5]+$fffa3942+(b xor c xor d)); a := ((a shl 4)or(a shr(32-4)))+b;
inc(d,in_[8]+$8771f681+(a xor b xor c)); d := ((d shl 11)or(d shr(32-11)))+a;
inc(c,in_[11]+$6d9d6122+(d xor a xor b)); c := ((c shl 16)or(c shr(32-16)))+d;
inc(b,in_[14]+$fde5380c+(c xor d xor a)); b := ((b shl 23)or(b shr(32-23)))+c;
inc(a,in_[1]+$a4beea44+(b xor c xor d)); a := ((a shl 4)or(a shr(32-4)))+b;
inc(d,in_[4]+$4bdecfa9+(a xor b xor c)); d := ((d shl 11)or(d shr(32-11)))+a;
inc(c,in_[7]+$f6bb4b60+(d xor a xor b)); c := ((c shl 16)or(c shr(32-16)))+d;
inc(b,in_[10]+$bebfbc70+(c xor d xor a)); b := ((b shl 23)or(b shr(32-23)))+c;
inc(a,in_[13]+$289b7ec6+(b xor c xor d)); a := ((a shl 4)or(a shr(32-4)))+b;
inc(d,in_[0]+$eaa127fa+(a xor b xor c)); d := ((d shl 11)or(d shr(32-11)))+a;
inc(c,in_[3]+$d4ef3085+(d xor a xor b)); c := ((c shl 16)or(c shr(32-16)))+d;
inc(b,in_[6]+$04881d05+(c xor d xor a)); b := ((b shl 23)or(b shr(32-23)))+c;
inc(a,in_[9]+$d9d4d039+(b xor c xor d)); a := ((a shl 4)or(a shr(32-4)))+b;
inc(d,in_[12]+$e6db99e5+(a xor b xor c)); d := ((d shl 11)or(d shr(32-11)))+a;
inc(c,in_[15]+$1fa27cf8+(d xor a xor b)); c := ((c shl 16)or(c shr(32-16)))+d;
inc(b,in_[2]+$c4ac5665+(c xor d xor a)); b := ((b shl 23)or(b shr(32-23)))+c;
inc(a,in_[0]+$f4292244+(c xor(b or(not d)))); a := ((a shl 6)or(a shr(32-6)))+b;
inc(d,in_[7]+$432aff97+(b xor(a or(not c)))); d := ((d shl 10)or(d shr(32-10)))+a;
inc(c,in_[14]+$ab9423a7+(a xor(d or(not b)))); c := ((c shl 15)or(c shr(32-15)))+d;
inc(b,in_[5]+$fc93a039+(d xor(c or(not a)))); b := ((b shl 21)or(b shr(32-21)))+c;
inc(a,in_[12]+$655b59c3+(c xor(b or(not d)))); a := ((a shl 6)or(a shr(32-6)))+b;
inc(d,in_[3]+$8f0ccc92+(b xor(a or(not c)))); d := ((d shl 10)or(d shr(32-10)))+a;
inc(c,in_[10]+$ffeff47d+(a xor(d or(not b)))); c := ((c shl 15)or(c shr(32-15)))+d;
inc(b,in_[1]+$85845dd1+(d xor(c or(not a)))); b := ((b shl 21)or(b shr(32-21)))+c;
inc(a,in_[8]+$6fa87e4f+(c xor(b or(not d)))); a := ((a shl 6)or(a shr(32-6)))+b;
inc(d,in_[15]+$fe2ce6e0+(b xor(a or(not c)))); d := ((d shl 10)or(d shr(32-10)))+a;
inc(c,in_[6]+$a3014314+(a xor(d or(not b)))); c := ((c shl 15)or(c shr(32-15)))+d;
inc(b,in_[13]+$4e0811a1+(d xor(c or(not a)))); b := ((b shl 21)or(b shr(32-21)))+c;
inc(a,in_[4]+$f7537e82+(c xor(b or(not d)))); a := ((a shl 6)or(a shr(32-6)))+b;
inc(d,in_[11]+$bd3af235+(b xor(a or(not c)))); d := ((d shl 10)or(d shr(32-10)))+a;
inc(c,in_[2]+$2ad7d2bb+(a xor(d or(not b)))); c := ((c shl 15)or(c shr(32-15)))+d;
inc(b,in_[9]+$eb86d391+(d xor(c or(not a)))); b := ((b shl 21)or(b shr(32-21)))+c;
{$endif}
inc(buf[0],a);
inc(buf[1],b);
inc(buf[2],c);
inc(buf[3],d);
end;
{$else PUREPASCAL}
{
MD5_386.Asm - 386 optimized helper routine for calculating
MD Message-Digest values
written 2/2/94 by Peter Sawatzki
Buchenhof 3, D58091 Hagen, Germany Fed Rep
Peter@Sawatzki.de http://www.sawatzki.de
original C Source was found in Dr. Dobbs Journal Sep 91
MD5 algorithm from RSA Data Security, Inc.
Taken from https://github.com/maximmasiutin/MD5_Transform-x64
} {$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=buf:TMD5Buf edx=in_:TMD5In
push ebx
push esi
push edi
push ebp
mov ebp, edx
push eax
mov edx, dword ptr [eax+0CH]
mov ecx, dword ptr [eax+8H]
mov ebx, dword ptr [eax+4H]
mov eax, dword ptr [eax]
add eax, dword ptr [ebp]
add eax, -680876936
mov esi, ebx
not esi
and esi, edx
mov edi, ecx
and edi, ebx
or esi, edi
add eax, esi
rol eax, 7
add eax, ebx
add edx, dword ptr [ebp+4H]
add edx, -389564586
mov esi, eax
not esi
and esi, ecx
mov edi, ebx
and edi, eax
or esi, edi
add edx, esi
rol edx, 12
add edx, eax
add ecx, dword ptr [ebp+8H]
add ecx, 606105819
mov esi, edx
not esi
and esi, ebx
mov edi, eax
and edi, edx
or esi, edi
add ecx, esi
rol ecx, 17
add ecx, edx
add ebx, dword ptr [ebp+0CH]
add ebx, -1044525330
mov esi, ecx
not esi
and esi, eax
mov edi, edx
and edi, ecx
or esi, edi
add ebx, esi
rol ebx, 22
add ebx, ecx
add eax, dword ptr [ebp+10H]
add eax, -176418897
mov esi, ebx
not esi
and esi, edx
mov edi, ecx
and edi, ebx
or esi, edi
add eax, esi
rol eax, 7
add eax, ebx
add edx, dword ptr [ebp+14H]
add edx, 1200080426
mov esi, eax
not esi
and esi, ecx
mov edi, ebx
and edi, eax
or esi, edi
add edx, esi
rol edx, 12
add edx, eax
add ecx, dword ptr [ebp+18H]
add ecx, -1473231341
mov esi, edx
not esi
and esi, ebx
mov edi, eax
and edi, edx
or esi, edi
add ecx, esi
rol ecx, 17
add ecx, edx
add ebx, dword ptr [ebp+1CH]
add ebx, -45705983
mov esi, ecx
not esi
and esi, eax
mov edi, edx
and edi, ecx
or esi, edi
add ebx, esi
rol ebx, 22
add ebx, ecx
add eax, dword ptr [ebp+20H]
add eax, 1770035416
mov esi, ebx
not esi
and esi, edx
mov edi, ecx
and edi, ebx
or esi, edi
add eax, esi
rol eax, 7
add eax, ebx
add edx, dword ptr [ebp+24H]
add edx, -1958414417
mov esi, eax
not esi
and esi, ecx
mov edi, ebx
and edi, eax
or esi, edi
add edx, esi
rol edx, 12
add edx, eax
add ecx, dword ptr [ebp+28H]
add ecx, -42063
mov esi, edx
not esi
and esi, ebx
mov edi, eax
and edi, edx
or esi, edi
add ecx, esi
rol ecx, 17
add ecx, edx
add ebx, dword ptr [ebp+2CH]
add ebx, -1990404162
mov esi, ecx
not esi
and esi, eax
mov edi, edx
and edi, ecx
or esi, edi
add ebx, esi
rol ebx, 22
add ebx, ecx
add eax, dword ptr [ebp+30H]
add eax, 1804603682
mov esi, ebx
not esi
and esi, edx
mov edi, ecx
and edi, ebx
or esi, edi
add eax, esi
rol eax, 7
add eax, ebx
add edx, dword ptr [ebp+34H]
add edx, -40341101
mov esi, eax
not esi
and esi, ecx
mov edi, ebx
and edi, eax
or esi, edi
add edx, esi
rol edx, 12
add edx, eax
add ecx, dword ptr [ebp+38H]
add ecx, -1502002290
mov esi, edx
not esi
and esi, ebx
mov edi, eax
and edi, edx
or esi, edi
add ecx, esi
rol ecx, 17
add ecx, edx
add ebx, dword ptr [ebp+3CH]
add ebx, 1236535329
mov esi, ecx
not esi
and esi, eax
mov edi, edx
and edi, ecx
or esi, edi
add ebx, esi
rol ebx, 22
add ebx, ecx
add eax, dword ptr [ebp+4H]
add eax, -165796510
mov esi, edx
not esi
and esi, ecx
mov edi, edx
and edi, ebx
or esi, edi
add eax, esi
rol eax, 5
add eax, ebx
add edx, dword ptr [ebp+18H]
add edx, -1069501632
mov esi, ecx
not esi
and esi, ebx
mov edi, ecx
and edi, eax
or esi, edi
add edx, esi
rol edx, 9
add edx, eax
add ecx, dword ptr [ebp+2CH]
add ecx, 643717713
mov esi, ebx
not esi
and esi, eax
mov edi, ebx
and edi, edx
or esi, edi
add ecx, esi
rol ecx, 14
add ecx, edx
add ebx, dword ptr [ebp]
add ebx, -373897302
mov esi, eax
not esi
and esi, edx
mov edi, eax
and edi, ecx
or esi, edi
add ebx, esi
rol ebx, 20
add ebx, ecx
add eax, dword ptr [ebp+14H]
add eax, -701558691
mov esi, edx
not esi
and esi, ecx
mov edi, edx
and edi, ebx
or esi, edi
add eax, esi
rol eax, 5
add eax, ebx
add edx, dword ptr [ebp+28H]
add edx, 38016083
mov esi, ecx
not esi
and esi, ebx
mov edi, ecx
and edi, eax
or esi, edi
add edx, esi
rol edx, 9
add edx, eax
add ecx, dword ptr [ebp+3CH]
add ecx, -660478335
mov esi, ebx
not esi
and esi, eax
mov edi, ebx
and edi, edx
or esi, edi
add ecx, esi
rol ecx, 14
add ecx, edx
add ebx, dword ptr [ebp+10H]
add ebx, -405537848
mov esi, eax
not esi
and esi, edx
mov edi, eax
and edi, ecx
or esi, edi
add ebx, esi
rol ebx, 20
add ebx, ecx
add eax, dword ptr [ebp+24H]
add eax, 568446438
mov esi, edx
not esi
and esi, ecx
mov edi, edx
and edi, ebx
or esi, edi
add eax, esi
rol eax, 5
add eax, ebx
add edx, dword ptr [ebp+38H]
add edx, -1019803690
mov esi, ecx
not esi
and esi, ebx
mov edi, ecx
and edi, eax
or esi, edi
add edx, esi
rol edx, 9
add edx, eax
add ecx, dword ptr [ebp+0CH]
add ecx, -187363961
mov esi, ebx
not esi
and esi, eax
mov edi, ebx
and edi, edx
or esi, edi
add ecx, esi
rol ecx, 14
add ecx, edx
add ebx, dword ptr [ebp+20H]
add ebx, 1163531501
mov esi, eax
not esi
and esi, edx
mov edi, eax
and edi, ecx
or esi, edi
add ebx, esi
rol ebx, 20
add ebx, ecx
add eax, dword ptr [ebp+34H]
add eax, -1444681467
mov esi, edx
not esi
and esi, ecx
mov edi, edx
and edi, ebx
or esi, edi
add eax, esi
rol eax, 5
add eax, ebx
add edx, dword ptr [ebp+8H]
add edx, -51403784
mov esi, ecx
not esi
and esi, ebx
mov edi, ecx
and edi, eax
or esi, edi
add edx, esi
rol edx, 9
add edx, eax
add ecx, dword ptr [ebp+1CH]
add ecx, 1735328473
mov esi, ebx
not esi
and esi, eax
mov edi, ebx
and edi, edx
or esi, edi
add ecx, esi
rol ecx, 14
add ecx, edx
add ebx, dword ptr [ebp+30H]
add ebx, -1926607734
mov esi, eax
not esi
and esi, edx
mov edi, eax
and edi, ecx
or esi, edi
add ebx, esi
rol ebx, 20
add ebx, ecx
add eax, dword ptr [ebp+14H]
add eax, -378558
mov esi, edx
xor esi, ecx
xor esi, ebx
add eax, esi
rol eax, 4
add eax, ebx
add edx, dword ptr [ebp+20H]
add edx, -2022574463
mov esi, ecx
xor esi, ebx
xor esi, eax
add edx, esi
rol edx, 11
add edx, eax
add ecx, dword ptr [ebp+2CH]
add ecx, 1839030562
mov esi, ebx
xor esi, eax
xor esi, edx
add ecx, esi
rol ecx, 16
add ecx, edx
add ebx, dword ptr [ebp+38H]
add ebx, -35309556
mov esi, eax
xor esi, edx
xor esi, ecx
add ebx, esi
rol ebx, 23
add ebx, ecx
add eax, dword ptr [ebp+4H]
add eax, -1530992060
mov esi, edx
xor esi, ecx
xor esi, ebx
add eax, esi
rol eax, 4
add eax, ebx
add edx, dword ptr [ebp+10H]
add edx, 1272893353
mov esi, ecx
xor esi, ebx
xor esi, eax
add edx, esi
rol edx, 11
add edx, eax
add ecx, dword ptr [ebp+1CH]
add ecx, -155497632
mov esi, ebx
xor esi, eax
xor esi, edx
add ecx, esi
rol ecx, 16
add ecx, edx
add ebx, dword ptr [ebp+28H]
add ebx, -1094730640
mov esi, eax
xor esi, edx
xor esi, ecx
add ebx, esi
rol ebx, 23
add ebx, ecx
add eax, dword ptr [ebp+34H]
add eax, 681279174
mov esi, edx
xor esi, ecx
xor esi, ebx
add eax, esi
rol eax, 4
add eax, ebx
add edx, dword ptr [ebp]
add edx, -358537222
mov esi, ecx
xor esi, ebx
xor esi, eax
add edx, esi
rol edx, 11
add edx, eax
add ecx, dword ptr [ebp+0CH]
add ecx, -722521979
mov esi, ebx
xor esi, eax
xor esi, edx
add ecx, esi
rol ecx, 16
add ecx, edx
add ebx, dword ptr [ebp+18H]
add ebx, 76029189
mov esi, eax
xor esi, edx
xor esi, ecx
add ebx, esi
rol ebx, 23
add ebx, ecx
add eax, dword ptr [ebp+24H]
add eax, -640364487
mov esi, edx
xor esi, ecx
xor esi, ebx
add eax, esi
rol eax, 4
add eax, ebx
add edx, dword ptr [ebp+30H]
add edx, -421815835
mov esi, ecx
xor esi, ebx
xor esi, eax
add edx, esi
rol edx, 11
add edx, eax
add ecx, dword ptr [ebp+3CH]
add ecx, 530742520
mov esi, ebx
xor esi, eax
xor esi, edx
add ecx, esi
rol ecx, 16
add ecx, edx
add ebx, dword ptr [ebp+8H]
add ebx, -995338651
mov esi, eax
xor esi, edx
xor esi, ecx
add ebx, esi
rol ebx, 23
add ebx, ecx
add eax, dword ptr [ebp]
add eax, -198630844
mov esi, edx
not esi
or esi, ebx
xor esi, ecx
add eax, esi
rol eax, 6
add eax, ebx
add edx, dword ptr [ebp+1CH]
add edx, 1126891415
mov esi, ecx
not esi
or esi, eax
xor esi, ebx
add edx, esi
rol edx, 10
add edx, eax
add ecx, dword ptr [ebp+38H]
add ecx, -1416354905
mov esi, ebx
not esi
or esi, edx
xor esi, eax
add ecx, esi
rol ecx, 15
add ecx, edx
add ebx, dword ptr [ebp+14H]
add ebx, -57434055
mov esi, eax
not esi
or esi, ecx
xor esi, edx
add ebx, esi
rol ebx, 21
add ebx, ecx
add eax, dword ptr [ebp+30H]
add eax, 1700485571
mov esi, edx
not esi
or esi, ebx
xor esi, ecx
add eax, esi
rol eax, 6
add eax, ebx
add edx, dword ptr [ebp+0CH]
add edx, -1894986606
mov esi, ecx
not esi
or esi, eax
xor esi, ebx
add edx, esi
rol edx, 10
add edx, eax
add ecx, dword ptr [ebp+28H]
add ecx, -1051523
mov esi, ebx
not esi
or esi, edx
xor esi, eax
add ecx, esi
rol ecx, 15
add ecx, edx
add ebx, dword ptr [ebp+4H]
add ebx, -2054922799
mov esi, eax
not esi
or esi, ecx
xor esi, edx
add ebx, esi
rol ebx, 21
add ebx, ecx
add eax, dword ptr [ebp+20H]
add eax, 1873313359
mov esi, edx
not esi
or esi, ebx
xor esi, ecx
add eax, esi
rol eax, 6
add eax, ebx
add edx, dword ptr [ebp+3CH]
add edx, -30611744
mov esi, ecx
not esi
or esi, eax
xor esi, ebx
add edx, esi
rol edx, 10
add edx, eax
add ecx, dword ptr [ebp+18H]
add ecx, -1560198380
mov esi, ebx
not esi
or esi, edx
xor esi, eax
add ecx, esi
rol ecx, 15
add ecx, edx
add ebx, dword ptr [ebp+34H]
add ebx, 1309151649
mov esi, eax
not esi
or esi, ecx
xor esi, edx
add ebx, esi
rol ebx, 21
add ebx, ecx
add eax, dword ptr [ebp+10H]
add eax, -145523070
mov esi, edx
not esi
or esi, ebx
xor esi, ecx
add eax, esi
rol eax, 6
add eax, ebx
add edx, dword ptr [ebp+2CH]
add edx, -1120210379
mov esi, ecx
not esi
or esi, eax
xor esi, ebx
add edx, esi
rol edx, 10
add edx, eax
add ecx, dword ptr [ebp+8H]
add ecx, 718787259
mov esi, ebx
not esi
or esi, edx
xor esi, eax
add ecx, esi
rol ecx, 15
add ecx, edx
add ebx, dword ptr [ebp+24H]
add ebx, -343485551
mov esi, eax
not esi
or esi, ecx
xor esi, edx
add ebx, esi
rol ebx, 21
add ebx, ecx
pop esi
add dword ptr [esi], eax
add dword ptr [esi+4H], ebx
add dword ptr [esi+8H], ecx
add dword ptr [esi+0CH], edx
pop ebp
pop edi
pop esi
pop ebx
end;
{$endif PUREPASCAL}
{$endif CPUX64}
procedure RawMd5Compress(var Hash; Data: pointer);
begin
MD5Transform(TMD5Buf(Hash), PMD5In(Data)^);
end;
function TMD5.Final: TMD5Digest;
begin
Finalize;
result := TMD5Digest(buf);
end;
procedure TMD5.Final(out result: TMD5Digest);
begin
Finalize;
result := TMD5Digest(buf);
end;
procedure TMD5.Finalize;
var count: Integer;
p: ^Byte;
begin
count := bytes[0] and $3f; // number of pending bytes in
p := @in_;
Inc(p,count);
// Set the first char of padding to 0x80. There is always room
p^ := $80;
Inc(p);
// Bytes of padding needed to make 56 bytes (-8..55)
count := 55-count;
if count<0 then begin // Padding forces an extra block
FillcharFast(p^,count+8,0);
MD5Transform(buf,in_);
p := @in_;
count := 56;
end;
FillcharFast(p^,count,0);
// Append length in bits and transform
in_[14] := bytes[0] shl 3;
in_[15] := (bytes[1] shl 3) or (bytes[0] shr 29);
MD5Transform(buf,in_);
end;
procedure TMD5.Full(Buffer: pointer; Len: integer; out Digest: TMD5Digest);
begin
buf[0] := $67452301;
buf[1] := $efcdab89;
buf[2] := $98badcfe;
buf[3] := $10325476;
bytes[0] := Len;
while Len>=SizeOf(TMD5In) do begin
MD5Transform(buf,PMD5In(Buffer)^);
inc(PMD5In(Buffer));
dec(Len,SizeOf(TMD5In));
end;
MoveFast(Buffer^,in_,Len);
Buffer := PAnsiChar(@in_)+Len;
PByte(Buffer)^ := $80;
inc(PByte(Buffer));
Len := 55-Len;
if Len>=0 then
FillcharFast(Buffer^,Len,0) else begin
FillcharFast(Buffer^,Len+8,0);
MD5Transform(buf,in_);
FillcharFast(in_,56,0);
end;
Len := bytes[0];
in_[14] := Len shl 3;
in_[15] := Len shr 29;
MD5Transform(buf,in_);
Digest := TMD5Digest(buf);
end;
procedure TMD5.Init;
begin
buf[0] := $67452301;
buf[1] := $efcdab89;
buf[2] := $98badcfe;
buf[3] := $10325476;
bytes[0] := 0;
bytes[1] := 0;
end;
procedure TMD5.Update(const buffer; len: Cardinal);
var p: ^TMD5In;
t: cardinal;
i: integer;
begin
if len=0 then
exit;
p := @buffer;
// Update byte count
t := bytes[0];
Inc(bytes[0],len);
if bytes[0]<t then
Inc(bytes[1]); // 64 bit carry from low to high
t := 64-(t and 63); // space available in in_ (at least 1)
if t>len then begin
MoveFast(p^,Pointer(PtrUInt(@in_)+64-t)^,len);
exit;
end;
// First chunk is an odd size
MoveFast(p^,Pointer(PtrUInt(@in_)+64-t)^,t);
MD5Transform(buf,in_);
inc(PByte(p),t);
dec(len,t);
// Process data in 64-byte chunks
for i := 1 to len shr 6 do begin
MD5Transform(buf,p^);
inc(p);
end;
// Handle any remaining bytes of data.
MoveFast(p^,in_,len and 63);
end;
procedure TMD5.Update(const Buffer: RawByteString);
begin
Update(pointer(Buffer)^,length(Buffer));
end;
function MD5Buf(const Buffer; Len: Cardinal): TMD5Digest;
var MD5: TMD5;
begin
MD5.Full(@Buffer,Len,result);
end;
function htdigest(const user, realm, pass: RawByteString): RawUTF8;
// apache-compatible: agent007:download area:8364d0044ef57b3defcfa141e8f77b65
// hash=`echo -n "$user:$realm:$pass" | md5sum | cut -b -32`
// echo "$user:$realm:$hash"
var tmp: RawByteString;
begin
tmp := user+':'+realm+':';
result := tmp+MD5(tmp+pass);
end;
function MD5SelfTest: boolean;
begin
result := (htdigest('agent007','download area','secret')=
'agent007:download area:8364d0044ef57b3defcfa141e8f77b65') and
(MD5('')='d41d8cd98f00b204e9800998ecf8427e') and
(MD5('a')='0cc175b9c0f1b6a831c399e269772661') and
(MD5('ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789')=
'd174ab98d277d9f5a5611c2c9f419d9f');
end;
{ TSHA1 }
// TSHAContext = Hash,MLen,Buffer,Index
procedure sha1Compress(var Hash: TSHAHash; Data: PByteArray);
var A, B, C, D, E, X: cardinal;
W: array[0..79] of cardinal;
i: integer;
begin
// init W[] + A..E
bswap256(@Data[0],@W[0]);
bswap256(@Data[32],@W[8]);
for i := 16 to 79 do begin
X := W[i-3] xor W[i-8] xor W[i-14] xor W[i-16];
W[i] := (X shl 1) or (X shr 31);
end;
A := Hash.A;
B := Hash.B;
C := Hash.C;
D := Hash.D;
E := Hash.E;
// unrolled loop -> all is computed in cpu registers
// note: FPC detects "(A shl 5) or (A shr 27)" pattern into "RolDWord(A,5)" :)
Inc(E,((A shl 5) or (A shr 27)) + (D xor (B and (C xor D))) + $5A827999 + W[ 0]); B:= (B shl 30) or (B shr 2);
Inc(D,((E shl 5) or (E shr 27)) + (C xor (A and (B xor C))) + $5A827999 + W[ 1]); A:= (A shl 30) or (A shr 2);
Inc(C,((D shl 5) or (D shr 27)) + (B xor (E and (A xor B))) + $5A827999 + W[ 2]); E:= (E shl 30) or (E shr 2);
Inc(B,((C shl 5) or (C shr 27)) + (A xor (D and (E xor A))) + $5A827999 + W[ 3]); D:= (D shl 30) or (D shr 2);
Inc(A,((B shl 5) or (B shr 27)) + (E xor (C and (D xor E))) + $5A827999 + W[ 4]); C:= (C shl 30) or (C shr 2);
Inc(E,((A shl 5) or (A shr 27)) + (D xor (B and (C xor D))) + $5A827999 + W[ 5]); B:= (B shl 30) or (B shr 2);
Inc(D,((E shl 5) or (E shr 27)) + (C xor (A and (B xor C))) + $5A827999 + W[ 6]); A:= (A shl 30) or (A shr 2);
Inc(C,((D shl 5) or (D shr 27)) + (B xor (E and (A xor B))) + $5A827999 + W[ 7]); E:= (E shl 30) or (E shr 2);
Inc(B,((C shl 5) or (C shr 27)) + (A xor (D and (E xor A))) + $5A827999 + W[ 8]); D:= (D shl 30) or (D shr 2);
Inc(A,((B shl 5) or (B shr 27)) + (E xor (C and (D xor E))) + $5A827999 + W[ 9]); C:= (C shl 30) or (C shr 2);
Inc(E,((A shl 5) or (A shr 27)) + (D xor (B and (C xor D))) + $5A827999 + W[10]); B:= (B shl 30) or (B shr 2);
Inc(D,((E shl 5) or (E shr 27)) + (C xor (A and (B xor C))) + $5A827999 + W[11]); A:= (A shl 30) or (A shr 2);
Inc(C,((D shl 5) or (D shr 27)) + (B xor (E and (A xor B))) + $5A827999 + W[12]); E:= (E shl 30) or (E shr 2);
Inc(B,((C shl 5) or (C shr 27)) + (A xor (D and (E xor A))) + $5A827999 + W[13]); D:= (D shl 30) or (D shr 2);
Inc(A,((B shl 5) or (B shr 27)) + (E xor (C and (D xor E))) + $5A827999 + W[14]); C:= (C shl 30) or (C shr 2);
Inc(E,((A shl 5) or (A shr 27)) + (D xor (B and (C xor D))) + $5A827999 + W[15]); B:= (B shl 30) or (B shr 2);
Inc(D,((E shl 5) or (E shr 27)) + (C xor (A and (B xor C))) + $5A827999 + W[16]); A:= (A shl 30) or (A shr 2);
Inc(C,((D shl 5) or (D shr 27)) + (B xor (E and (A xor B))) + $5A827999 + W[17]); E:= (E shl 30) or (E shr 2);
Inc(B,((C shl 5) or (C shr 27)) + (A xor (D and (E xor A))) + $5A827999 + W[18]); D:= (D shl 30) or (D shr 2);
Inc(A,((B shl 5) or (B shr 27)) + (E xor (C and (D xor E))) + $5A827999 + W[19]); C:= (C shl 30) or (C shr 2);
Inc(E,((A shl 5) or (A shr 27)) + (B xor C xor D) + $6ED9EBA1 + W[20]); B:= (B shl 30) or (B shr 2);
Inc(D,((E shl 5) or (E shr 27)) + (A xor B xor C) + $6ED9EBA1 + W[21]); A:= (A shl 30) or (A shr 2);
Inc(C,((D shl 5) or (D shr 27)) + (E xor A xor B) + $6ED9EBA1 + W[22]); E:= (E shl 30) or (E shr 2);
Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $6ED9EBA1 + W[23]); D:= (D shl 30) or (D shr 2);
Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $6ED9EBA1 + W[24]); C:= (C shl 30) or (C shr 2);
Inc(E,((A shl 5) or (A shr 27)) + (B xor C xor D) + $6ED9EBA1 + W[25]); B:= (B shl 30) or (B shr 2);
Inc(D,((E shl 5) or (E shr 27)) + (A xor B xor C) + $6ED9EBA1 + W[26]); A:= (A shl 30) or (A shr 2);
Inc(C,((D shl 5) or (D shr 27)) + (E xor A xor B) + $6ED9EBA1 + W[27]); E:= (E shl 30) or (E shr 2);
Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $6ED9EBA1 + W[28]); D:= (D shl 30) or (D shr 2);
Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $6ED9EBA1 + W[29]); C:= (C shl 30) or (C shr 2);
Inc(E,((A shl 5) or (A shr 27)) + (B xor C xor D) + $6ED9EBA1 + W[30]); B:= (B shl 30) or (B shr 2);
Inc(D,((E shl 5) or (E shr 27)) + (A xor B xor C) + $6ED9EBA1 + W[31]); A:= (A shl 30) or (A shr 2);
Inc(C,((D shl 5) or (D shr 27)) + (E xor A xor B) + $6ED9EBA1 + W[32]); E:= (E shl 30) or (E shr 2);
Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $6ED9EBA1 + W[33]); D:= (D shl 30) or (D shr 2);
Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $6ED9EBA1 + W[34]); C:= (C shl 30) or (C shr 2);
Inc(E,((A shl 5) or (A shr 27)) + (B xor C xor D) + $6ED9EBA1 + W[35]); B:= (B shl 30) or (B shr 2);
Inc(D,((E shl 5) or (E shr 27)) + (A xor B xor C) + $6ED9EBA1 + W[36]); A:= (A shl 30) or (A shr 2);
Inc(C,((D shl 5) or (D shr 27)) + (E xor A xor B) + $6ED9EBA1 + W[37]); E:= (E shl 30) or (E shr 2);
Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $6ED9EBA1 + W[38]); D:= (D shl 30) or (D shr 2);
Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $6ED9EBA1 + W[39]); C:= (C shl 30) or (C shr 2);
Inc(E,((A shl 5) or (A shr 27)) + ((B and C) or (D and (B or C))) + $8F1BBCDC + W[40]); B:= (B shl 30) or (B shr 2);
Inc(D,((E shl 5) or (E shr 27)) + ((A and B) or (C and (A or B))) + $8F1BBCDC + W[41]); A:= (A shl 30) or (A shr 2);
Inc(C,((D shl 5) or (D shr 27)) + ((E and A) or (B and (E or A))) + $8F1BBCDC + W[42]); E:= (E shl 30) or (E shr 2);
Inc(B,((C shl 5) or (C shr 27)) + ((D and E) or (A and (D or E))) + $8F1BBCDC + W[43]); D:= (D shl 30) or (D shr 2);
Inc(A,((B shl 5) or (B shr 27)) + ((C and D) or (E and (C or D))) + $8F1BBCDC + W[44]); C:= (C shl 30) or (C shr 2);
Inc(E,((A shl 5) or (A shr 27)) + ((B and C) or (D and (B or C))) + $8F1BBCDC + W[45]); B:= (B shl 30) or (B shr 2);
Inc(D,((E shl 5) or (E shr 27)) + ((A and B) or (C and (A or B))) + $8F1BBCDC + W[46]); A:= (A shl 30) or (A shr 2);
Inc(C,((D shl 5) or (D shr 27)) + ((E and A) or (B and (E or A))) + $8F1BBCDC + W[47]); E:= (E shl 30) or (E shr 2);
Inc(B,((C shl 5) or (C shr 27)) + ((D and E) or (A and (D or E))) + $8F1BBCDC + W[48]); D:= (D shl 30) or (D shr 2);
Inc(A,((B shl 5) or (B shr 27)) + ((C and D) or (E and (C or D))) + $8F1BBCDC + W[49]); C:= (C shl 30) or (C shr 2);
Inc(E,((A shl 5) or (A shr 27)) + ((B and C) or (D and (B or C))) + $8F1BBCDC + W[50]); B:= (B shl 30) or (B shr 2);
Inc(D,((E shl 5) or (E shr 27)) + ((A and B) or (C and (A or B))) + $8F1BBCDC + W[51]); A:= (A shl 30) or (A shr 2);
Inc(C,((D shl 5) or (D shr 27)) + ((E and A) or (B and (E or A))) + $8F1BBCDC + W[52]); E:= (E shl 30) or (E shr 2);
Inc(B,((C shl 5) or (C shr 27)) + ((D and E) or (A and (D or E))) + $8F1BBCDC + W[53]); D:= (D shl 30) or (D shr 2);
Inc(A,((B shl 5) or (B shr 27)) + ((C and D) or (E and (C or D))) + $8F1BBCDC + W[54]); C:= (C shl 30) or (C shr 2);
Inc(E,((A shl 5) or (A shr 27)) + ((B and C) or (D and (B or C))) + $8F1BBCDC + W[55]); B:= (B shl 30) or (B shr 2);
Inc(D,((E shl 5) or (E shr 27)) + ((A and B) or (C and (A or B))) + $8F1BBCDC + W[56]); A:= (A shl 30) or (A shr 2);
Inc(C,((D shl 5) or (D shr 27)) + ((E and A) or (B and (E or A))) + $8F1BBCDC + W[57]); E:= (E shl 30) or (E shr 2);
Inc(B,((C shl 5) or (C shr 27)) + ((D and E) or (A and (D or E))) + $8F1BBCDC + W[58]); D:= (D shl 30) or (D shr 2);
Inc(A,((B shl 5) or (B shr 27)) + ((C and D) or (E and (C or D))) + $8F1BBCDC + W[59]); C:= (C shl 30) or (C shr 2);
Inc(E,((A shl 5) or (A shr 27)) + (B xor C xor D) + $CA62C1D6 + W[60]); B:= (B shl 30) or (B shr 2);
Inc(D,((E shl 5) or (E shr 27)) + (A xor B xor C) + $CA62C1D6 + W[61]); A:= (A shl 30) or (A shr 2);
Inc(C,((D shl 5) or (D shr 27)) + (E xor A xor B) + $CA62C1D6 + W[62]); E:= (E shl 30) or (E shr 2);
Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $CA62C1D6 + W[63]); D:= (D shl 30) or (D shr 2);
Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $CA62C1D6 + W[64]); C:= (C shl 30) or (C shr 2);
Inc(E,((A shl 5) or (A shr 27)) + (B xor C xor D) + $CA62C1D6 + W[65]); B:= (B shl 30) or (B shr 2);
Inc(D,((E shl 5) or (E shr 27)) + (A xor B xor C) + $CA62C1D6 + W[66]); A:= (A shl 30) or (A shr 2);
Inc(C,((D shl 5) or (D shr 27)) + (E xor A xor B) + $CA62C1D6 + W[67]); E:= (E shl 30) or (E shr 2);
Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $CA62C1D6 + W[68]); D:= (D shl 30) or (D shr 2);
Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $CA62C1D6 + W[69]); C:= (C shl 30) or (C shr 2);
Inc(E,((A shl 5) or (A shr 27)) + (B xor C xor D) + $CA62C1D6 + W[70]); B:= (B shl 30) or (B shr 2);
Inc(D,((E shl 5) or (E shr 27)) + (A xor B xor C) + $CA62C1D6 + W[71]); A:= (A shl 30) or (A shr 2);
Inc(C,((D shl 5) or (D shr 27)) + (E xor A xor B) + $CA62C1D6 + W[72]); E:= (E shl 30) or (E shr 2);
Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $CA62C1D6 + W[73]); D:= (D shl 30) or (D shr 2);
Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $CA62C1D6 + W[74]); C:= (C shl 30) or (C shr 2);
Inc(E,((A shl 5) or (A shr 27)) + (B xor C xor D) + $CA62C1D6 + W[75]); B:= (B shl 30) or (B shr 2);
Inc(D,((E shl 5) or (E shr 27)) + (A xor B xor C) + $CA62C1D6 + W[76]); A:= (A shl 30) or (A shr 2);
Inc(C,((D shl 5) or (D shr 27)) + (E xor A xor B) + $CA62C1D6 + W[77]); E:= (E shl 30) or (E shr 2);
Inc(B,((C shl 5) or (C shr 27)) + (D xor E xor A) + $CA62C1D6 + W[78]); D:= (D shl 30) or (D shr 2);
Inc(A,((B shl 5) or (B shr 27)) + (C xor D xor E) + $CA62C1D6 + W[79]); C:= (C shl 30) or (C shr 2);
// Calculate new working hash
inc(Hash.A,A);
inc(Hash.B,B);
inc(Hash.C,C);
inc(Hash.D,D);
inc(Hash.E,E);
end;
procedure RawSha1Compress(var Hash; Data: pointer);
begin
sha1Compress(TSHAHash(Hash), Data);
end;
procedure TSHA1.Final(out Digest: TSHA1Digest; NoInit: boolean);
var Data: TSHAContext absolute Context;
begin
// 1. append bit '1' after Buffer
Data.Buffer[Data.Index] := $80;
FillcharFast(Data.Buffer[Data.Index+1],63-Data.Index,0);
// 2. Compress if more than 448 bits, (no room for 64 bit length
if Data.Index>=56 then begin
sha1Compress(Data.Hash,@Data.Buffer);
FillcharFast(Data.Buffer,56,0);
end;
// Write 64 bit Buffer length into the last bits of the last block
// (in big endian format) and do a final compress
PCardinal(@Data.Buffer[56])^ := bswap32(TQWordRec(Data.MLen).H);
PCardinal(@Data.Buffer[60])^ := bswap32(TQWordRec(Data.MLen).L);
sha1Compress(Data.Hash,@Data.Buffer);
// Hash -> Digest to little endian format
bswap160(@Data.Hash,@Digest);
// Clear Data
if not NoInit then
Init;
end;
function TSHA1.Final(NoInit: boolean): TSHA1Digest;
begin
Final(result,NoInit);
end;
procedure TSHA1.Full(Buffer: pointer; Len: integer; out Digest: TSHA1Digest);
begin
{$ifdef USEPADLOCK}
// Padlock need all data once -> Full() is OK, not successive Update()
if padlock_available then begin
Init; // for later Update use
{$ifdef PADLOCKDEBUG}write('padlock_phe_sha1 ');{$endif}
if padlock_phe_sha1(buffer,Len,Digest)=0 then
exit else
{$ifdef PADLOCKDEBUG}write(':ERROR ');{$endif}
end;
{$endif}
Init;
Update(Buffer,Len);
Final(Digest);
end;
procedure TSHA1.Init;
var Data: TSHAContext absolute Context;
begin
Data.Hash.A := $67452301;
Data.Hash.B := $EFCDAB89;
Data.Hash.C := $98BADCFE;
Data.Hash.D := $10325476;
Data.Hash.E := $C3D2E1F0;
FillcharFast(Data.MLen,sizeof(Data)-sizeof(Data.Hash),0);
end;
procedure TSHA1.Update(Buffer: pointer; Len: integer);
var Data: TSHAContext absolute Context;
aLen: integer;
begin
if Buffer=nil then exit; // avoid GPF
inc(Data.MLen,QWord(Cardinal(Len)) shl 3);
while Len>0 do begin
aLen := sizeof(Data.Buffer)-Data.Index;
if aLen<=Len then begin
if Data.Index<>0 then begin
MoveFast(buffer^,Data.Buffer[Data.Index],aLen);
sha1Compress(Data.Hash,@Data.Buffer);
Data.Index := 0;
end else
sha1Compress(Data.Hash,Buffer); // avoid temporary copy
dec(Len,aLen);
inc(PByte(buffer),aLen);
end else begin
MoveFast(buffer^,Data.Buffer[Data.Index],Len);
inc(Data.Index,Len);
break;
end;
end;
end;
procedure TSHA1.Update(const Buffer: RawByteString);
begin
Update(pointer(Buffer),length(Buffer));
end;
{ TAESAbstract }
var
aesivctr: array[boolean] of TAESLocked;
procedure AESIVCtrEncryptDecrypt(const BI; var BO; DoEncrypt: boolean);
begin
if aesivctr[DoEncrypt]=nil then begin
GarbageCollectorFreeAndNil(aesivctr[DoEncrypt],TAESLocked.Create);
with aesivctr[DoEncrypt].fAES do
if DoEncrypt then
EncryptInit(AESIVCTR_KEY,128) else
DecryptInit(AESIVCTR_KEY,128);
end;
with aesivctr[DoEncrypt] do begin
fSafe^.Lock;
TAESContext(fAES.Context).DoBlock(fAES.Context,BI,BO);
fSafe^.UnLock;
end;
end;
constructor TAESAbstract.Create(const aKey; aKeySize: cardinal);
begin
if (aKeySize<>128) and (aKeySize<>192) and (aKeySize<>256) then
raise ESynCrypto.CreateUTF8('%.Create(aKeySize=%): 128/192/256 required',[self,aKeySize]);
fKeySize := aKeySize;
fKeySizeBytes := fKeySize shr 3;
MoveFast(aKey,fKey,fKeySizeBytes);
end;
procedure TAESAbstract.SetIVCTR;
var tmp: PShortString; // temp variable to circumvent FPC bug
begin
repeat
TAESPRNG.Main.FillRandom(TAESBLock(fIVCTR)); // set nonce + ctr
until fIVCTR.nonce<>0;
tmp := ClassNameShort(self);
fIVCtr.magic := crc32c($aba5aba5,@tmp^[2],6); // TAESECB_API -> 'AESECB'
end;
constructor TAESAbstract.Create(const aKey: THash128);
begin
Create(aKey,128);
end;
constructor TAESAbstract.Create(const aKey: THash256);
begin
Create(aKey,256);
end;
constructor TAESAbstract.CreateTemp(aKeySize: cardinal);
var tmp: THash256;
begin
TAESPRNG.Main.FillRandom(tmp);
Create(tmp,aKeySize);
FillZero(tmp);
end;
constructor TAESAbstract.CreateFromSha256(const aKey: RawUTF8);
var Digest: TSHA256Digest;
begin
SHA256Weak(aKey,Digest);
Create(Digest,256);
FillZero(Digest);
end;
constructor TAESAbstract.CreateFromPBKDF2(const aKey: RawUTF8; const aSalt: RawByteString;
aRounds: Integer);
var Digest: TSHA256Digest;
begin
PBKDF2_HMAC_SHA256(aKey,aSalt,aRounds,Digest,ToText(ClassType));
Create(Digest,256);
FillZero(Digest);
end;
destructor TAESAbstract.Destroy;
begin
inherited Destroy;
FillZero(fKey);
end;
function TAESAbstract.AlgoName: TShort16;
const TXT: array[2..4] of array[0..7] of AnsiChar = (#9'aes128',#9'aes192',#9'aes256');
var s: PShortString;
begin
if (self=nil) or (KeySize=0) then
result[0] := #0 else begin
PInt64(@result)^ := PInt64(@TXT[KeySize shr 6])^;
s := ClassNameShort(self);
if s^[0]<#7 then
result[0] := #6 else begin
result[7] := NormToLower[s^[5]]; // TAESCBC -> 'aes128cbc'
result[8] := NormToLower[s^[6]];
result[9] := NormToLower[s^[7]];
end;
end;
end;
procedure TAESAbstract.SetIVHistory(aDepth: integer);
begin
fIVHistoryDec.Init(aDepth,aDepth);
end;
function TAESAbstract.EncryptPKCS7(const Input: RawByteString;
IVAtBeginning: boolean): RawByteString;
begin
SetString(result,nil,EncryptPKCS7Length(length(Input),IVAtBeginning));
EncryptPKCS7Buffer(Pointer(Input),pointer(result),
length(Input),length(result),IVAtBeginning);
end;
function TAESAbstract.EncryptPKCS7(const Input: TBytes;
IVAtBeginning: boolean): TBytes;
begin
result := nil;
SetLength(result,EncryptPKCS7Length(length(Input),IVAtBeginning));
EncryptPKCS7Buffer(Pointer(Input),pointer(result),
length(Input),length(result),IVAtBeginning);
end;
function TAESAbstract.EncryptPKCS7Length(InputLen: cardinal;
IVAtBeginning: boolean): cardinal;
begin
result := InputLen+sizeof(TAESBlock)-(InputLen and AESBlockMod);
if IVAtBeginning then
inc(Result,sizeof(TAESBlock));
end;
function TAESAbstract.EncryptPKCS7Buffer(Input,Output: Pointer; InputLen,OutputLen: cardinal;
IVAtBeginning: boolean): boolean;
var padding, ivsize: cardinal;
begin
padding := sizeof(TAESBlock)-(InputLen and AESBlockMod);
if IVAtBeginning then
ivsize := sizeof(TAESBlock) else
ivsize := 0;
if OutputLen<>ivsize+InputLen+padding then begin
result := false;
exit;
end;
if IVAtBeginning then begin
if fIVReplayAttackCheck<>repNoCheck then begin
if fIVCTR.nonce=0 then
SetIVCTR;
AESIVCtrEncryptDecrypt(fIVCTR,fIV,true); // PRNG from fixed secret
inc(fIVCTR.ctr); // replay attack protection
end else
TAESPRNG.Main.FillRandom(fIV); // PRNG from real entropy
PAESBlock(Output)^ := fIV;
end;
MoveFast(Input^,PByteArray(Output)^[ivsize],InputLen);
FillcharFast(PByteArray(Output)^[ivsize+InputLen],padding,padding);
Inc(PByte(Output),ivsize);
Encrypt(Output,Output,InputLen+padding);
result := true;
end;
function TAESAbstract.DecryptPKCS7Len(var InputLen,ivsize: Integer;
Input: pointer; IVAtBeginning, RaiseESynCryptoOnError: boolean): boolean;
var ctr: TAESIVCTR;
begin
result := true;
if (InputLen<sizeof(TAESBlock)) or (InputLen and AESBlockMod<>0) then
if RaiseESynCryptoOnError then
raise ESynCrypto.CreateUTF8('%.DecryptPKCS7: Invalid InputLen=%',[self,InputLen]) else
result := false;
if result and IVAtBeginning then begin
if (fIVReplayAttackCheck<>repNoCheck) and (fIVCTRState<>ctrNotUsed) then begin
if fIVCTR.nonce=0 then
SetIVCTR;
AESIVCtrEncryptDecrypt(Input^,ctr,false);
if fIVCTRState=ctrUnknown then
if ctr.magic=fIVCTR.magic then begin
fIVCTR := ctr;
fIVCTRState := ctrUsed;
inc(fIVCTR.ctr);
end else
if fIVReplayAttackCheck=repMandatory then
if RaiseESynCryptoOnError then
raise ESynCrypto.CreateUTF8('%.DecryptPKCS7: IVCTR is not handled '+
'on encryption',[self]) else
result := false else begin
fIVCTRState := ctrNotused;
if fIVHistoryDec.Depth=0 then
SetIVHistory(64); // naive but efficient fallback
end else
if IsEqual(TAESBlock(ctr),TAESBlock(fIVCTR)) then
inc(fIVCTR.ctr) else
if RaiseESynCryptoOnError then
raise ESynCrypto.CreateUTF8('%.DecryptPKCS7: wrong IVCTR %/% %/% -> '+
'potential replay attack',[self,ctr.magic,fIVCTR.magic,ctr.ctr,fIVCTR.ctr]) else
result := false;
end;
fIV := PAESBlock(Input)^;
if result and (fIVHistoryDec.Depth>0) and not fIVHistoryDec.Add(fIV) then
if RaiseESynCryptoOnError then
raise ESynCrypto.CreateUTF8('%.DecryptPKCS7: duplicated IV=% -> '+
'potential replay attack',[self,AESBlockToShortString(fIV)]) else
result := false;
dec(InputLen,sizeof(TAESBlock));
ivsize := sizeof(TAESBlock);
end else
ivsize := 0;
end;
function TAESAbstract.DecryptPKCS7Buffer(Input: Pointer; InputLen: integer;
IVAtBeginning, RaiseESynCryptoOnError: boolean): RawByteString;
var ivsize,padding: integer;
tmp: array[0..1023] of AnsiChar;
P: PAnsiChar;
begin
result := '';
if not DecryptPKCS7Len(InputLen,ivsize,Input,IVAtBeginning,RaiseESynCryptoOnError) then
exit;
if InputLen<sizeof(tmp) then
P := @tmp else begin
SetString(result,nil,InputLen);
P := pointer(result);
end;
Decrypt(@PByteArray(Input)^[ivsize],P,InputLen);
padding := ord(P[InputLen-1]); // result[1..len]
if padding>sizeof(TAESBlock) then
if RaiseESynCryptoOnError then
raise ESynCrypto.CreateUTF8('%.DecryptPKCS7: Invalid Input',[self]) else
result := '' else
if P=@tmp then
SetString(result,P,InputLen-padding) else
SetLength(result,InputLen-padding); // fast in-place resize
end;
function TAESAbstract.DecryptPKCS7(const Input: RawByteString;
IVAtBeginning, RaiseESynCryptoOnError: boolean): RawByteString;
begin
result := DecryptPKCS7Buffer(pointer(Input),length(Input),IVAtBeginning,RaiseESynCryptoOnError);
end;
function TAESAbstract.DecryptPKCS7(const Input: TBytes;
IVAtBeginning, RaiseESynCryptoOnError: boolean): TBytes;
var len,ivsize,padding: integer;
begin
result := nil;
len := length(Input);
if not DecryptPKCS7Len(len,ivsize,pointer(Input),IVAtBeginning,RaiseESynCryptoOnError) then
exit;
SetLength(result,len);
Decrypt(@PByteArray(Input)^[ivsize],pointer(result),len);
padding := result[len-1]; // result[0..len-1]
if padding>sizeof(TAESBlock) then
if RaiseESynCryptoOnError then
raise ESynCrypto.CreateUTF8('%.DecryptPKCS7: Invalid Input',[self]) else
result := nil else
SetLength(result,len-padding); // fast in-place resize
end;
function TAESAbstract.MACSetNonce(const aKey: THash256; aAssociated: pointer;
aAssociatedLen: integer): boolean;
begin
result := false;
end;
function TAESAbstract.MACGetLast(out aCRC: THash256): boolean;
begin
result := false;
end;
function TAESAbstract.MACEquals(const aCRC: THash256): boolean;
var mac: THash256;
begin
result := MACGetLast(mac) and IsEqual(mac,aCRC);
end;
function TAESAbstract.MACCheckError(aEncrypted: pointer; Count: cardinal): boolean;
begin
result := false;
end;
function TAESAbstract.MACAndCrypt(const Data: RawByteString; Encrypt: boolean): RawByteString;
type
TCryptData = packed record
nonce,mac: THash256;
crc: cardinal; // crc32c(nonce+mac) to avoid naive fuzzing
data: RawByteString;
end;
PCryptData = ^TCryptData;
const
VERSION = 1;
CRCSIZ = sizeof(THash256)*2;
SIZ = CRCSIZ+sizeof(cardinal);
var rec: TCryptData;
len: integer;
pcd: PCryptData absolute Data;
P: PAnsiChar;
begin
result := ''; // e.g. MACSetNonce not supported
try
if Encrypt then begin
TAESPRNG.Main.FillRandom(rec.nonce);
if not MACSetNonce(rec.nonce) then
exit;
rec.Data := EncryptPKCS7(Data,{IVAtBeginning=}true);
if not MACGetLast(rec.mac) then
exit;
rec.crc := crc32c(VERSION,@rec.nonce,CRCSIZ);
result := RecordSave(rec,TypeInfo(TCryptData));
end else begin
if (length(Data)<=SIZ) or (pcd^.crc<>crc32c(VERSION,pointer(pcd),CRCSIZ)) then
exit;
P := @pcd^.data; // inlined RecordLoad() for safety
len := FromVarUInt32(PByte(P));
if length(Data)-len<>P-pointer(Data) then
exit; // avoid buffer overflow
if MACSetNonce(pcd^.nonce) then
result := DecryptPKCS7Buffer(P,len,true,false);
if result<>'' then
if not MACEquals(pcd^.mac) then begin
FillZero(result);
result := '';
end;
end;
finally
FillZero(rec.data);
end;
end;
class function TAESAbstract.MACEncrypt(const Data: RawByteString; const Key: THash256;
Encrypt: boolean): RawByteString;
var aes: TAESAbstract;
begin
aes := Create(Key);
try
result := aes.MACAndCrypt(Data,Encrypt);
finally
aes.Free;
end;
end;
class function TAESAbstract.MACEncrypt(const Data: RawByteString; const Key: THash128;
Encrypt: boolean): RawByteString;
var aes: TAESAbstract;
begin
aes := Create(Key);
try
result := aes.MACAndCrypt(Data,Encrypt);
finally
aes.Free;
end;
end;
class function TAESAbstract.SimpleEncrypt(const Input,Key: RawByteString;
Encrypt, IVAtBeginning, RaiseESynCryptoOnError: boolean): RawByteString;
var instance: TAESAbstract;
begin
instance := CreateFromSha256(Key);
try
if Encrypt then
result := instance.EncryptPKCS7(Input,IVAtBeginning) else
result := instance.DecryptPKCS7(Input,IVAtBeginning,RaiseESynCryptoOnError);
finally
instance.Free;
end;
end;
class function TAESAbstract.SimpleEncrypt(const Input: RawByteString; const Key;
KeySize: integer; Encrypt, IVAtBeginning, RaiseESynCryptoOnError: boolean): RawByteString;
var instance: TAESAbstract;
begin
instance := Create(Key,KeySize);
try
if Encrypt then
result := instance.EncryptPKCS7(Input,IVAtBeginning) else
result := instance.DecryptPKCS7(Input,IVAtBeginning,RaiseESynCryptoOnError);
finally
instance.Free;
end;
end;
class function TAESAbstract.SimpleEncryptFile(const InputFile, OutputFile: TFileName;
const Key: RawByteString; Encrypt, IVAtBeginning,RaiseESynCryptoOnError: boolean): boolean;
var src,dst: RawByteString;
begin
result := false;
src := StringFromFile(InputFile);
if src<>'' then begin
dst := SimpleEncrypt(src,Key,Encrypt,IVAtBeginning,RaiseESynCryptoOnError);
if dst<>'' then
result := FileFromString(dst,OutputFile);
end;
end;
class function TAESAbstract.SimpleEncryptFile(const InputFile, Outputfile: TFileName;
const Key; KeySize: integer; Encrypt, IVAtBeginning, RaiseESynCryptoOnError: boolean): boolean;
var src,dst: RawByteString;
begin
result := false;
src := StringFromFile(InputFile);
if src<>'' then begin
dst := SimpleEncrypt(src,Key,KeySize,Encrypt,IVAtBeginning,RaiseESynCryptoOnError);
if dst<>'' then
result := FileFromString(dst,OutputFile);
end;
end;
function TAESAbstract.Clone: TAESAbstract;
begin
result := TAESAbstractClass(ClassType).Create(fKey,fKeySize);
result.IVHistoryDepth := IVHistoryDepth;
result.IVReplayAttackCheck := IVReplayAttackCheck;
end;
function TAESAbstract.CloneEncryptDecrypt: TAESAbstract;
begin
result := Clone;
end;
{ TAESAbstractSyn }
destructor TAESAbstractSyn.Destroy;
begin
inherited Destroy;
AES.Done; // mandatory for Padlock - also fill buffer with 0 for safety
FillZero(fCV); // may contain sensitive data on some modes
FillZero(fIV);
end;
function TAESAbstractSyn.Clone: TAESAbstract;
begin
if (fIVHistoryDec.Count<>0) {$ifdef USEPADLOCK} or
TAESContext(AES).initialized and (TAESContext(AES).ViaCtx<>nil){$endif} then
result := inherited Clone else begin
result := NewInstance as TAESAbstractSyn;
MoveFast(pointer(self)^,pointer(result)^,InstanceSize);
end;
end;
procedure TAESAbstractSyn.Decrypt(BufIn, BufOut: pointer; Count: cardinal);
begin
fIn := BufIn;
fOut := BufOut;
fCV := fIV;
end;
procedure TAESAbstractSyn.DecryptInit;
begin
if AES.DecryptInit(fKey,fKeySize) then
fAESInit := initDecrypt else
raise ESynCrypto.CreateUTF8('%.DecryptInit',[self]);
end;
procedure TAESAbstractSyn.Encrypt(BufIn, BufOut: pointer; Count: cardinal);
begin
fIn := BufIn;
fOut := BufOut;
fCV := fIV;
end;
procedure TAESAbstractSyn.EncryptInit;
begin
if AES.EncryptInit(fKey,fKeySize) then
fAESInit := initEncrypt else
raise ESynCrypto.CreateUTF8('%.EncryptInit',[self]);
end;
procedure TAESAbstractSyn.TrailerBytes(count: cardinal);
begin
if fAESInit<>initEncrypt then
EncryptInit;
TAESContext(AES.Context).DoBlock(AES.Context,fCV,fCV);
XorMemory(pointer(fOut),pointer(fIn),@fCV,count);
end;
{ TAESECB }
procedure TAESECB.Decrypt(BufIn, BufOut: pointer; Count: cardinal);
var i: integer;
begin
inherited; // CV := IV + set fIn,fOut
if fAESInit<>initDecrypt then
DecryptInit;
for i := 1 to Count shr 4 do begin
TAESContext(AES.Context).DoBlock(AES.Context,fIn^,fOut^);
inc(fIn);
inc(fOut);
end;
Count := Count and AESBlockMod;
if Count<>0 then
TrailerBytes(Count);
end;
procedure TAESECB.Encrypt(BufIn, BufOut: pointer; Count: cardinal);
var i: integer;
begin
inherited; // CV := IV + set fIn,fOut
if fAESInit<>initEncrypt then
EncryptInit;
for i := 1 to Count shr 4 do begin
TAESContext(AES.Context).DoBlock(AES.Context,fIn^,fOut^);
inc(fIn);
inc(fOut);
end;
Count := Count and AESBlockMod;
if Count<>0 then
TrailerBytes(Count);
end;
{ TAESCBC }
procedure TAESCBC.Decrypt(BufIn, BufOut: pointer; Count: cardinal);
var i: integer;
tmp: TAESBlock;
begin
inherited; // CV := IV + set fIn,fOut
if Count>=sizeof(TAESBlock) then begin
if fAESInit<>initDecrypt then
DecryptInit;
for i := 1 to Count shr 4 do begin
tmp := fIn^;
TAESContext(AES.Context).DoBlock(AES.Context,fIn^,fOut^);
XorBlock16(pointer(fOut),pointer(@fCV));
fCV := tmp;
inc(fIn);
inc(fOut);
end;
end;
Count := Count and AESBlockMod;
if Count<>0 then
TrailerBytes(Count);
end;
procedure TAESCBC.Encrypt(BufIn, BufOut: pointer; Count: cardinal);
var i: integer;
begin
inherited; // CV := IV + set fIn,fOut
if fAESInit<>initEncrypt then
EncryptInit;
for i := 1 to Count shr 4 do begin
XorBlock16(pointer(fIn),pointer(fOut),pointer(@fCV));
TAESContext(AES.Context).DoBlock(AES.Context,fOut^,fOut^);
fCV := fOut^;
inc(fIn);
inc(fOut);
end;
Count := Count and AESBlockMod;
if Count<>0 then
TrailerBytes(Count);
end;
{ TAESAbstractEncryptOnly }
constructor TAESAbstractEncryptOnly.Create(const aKey; aKeySize: cardinal);
begin
inherited Create(aKey,aKeySize);
EncryptInit; // as expected by overriden Encrypt/Decrypt methods below
end;
function TAESAbstractEncryptOnly.CloneEncryptDecrypt: TAESAbstract;
begin
result := self;
end;
{ TAESCFB }
{$ifdef USEAESNI32}
procedure AesNiTrailer; // = TAESAbstractSyn.EncryptTrailer from AES-NI asm
{$ifdef FPC} nostackframe; assembler; {$endif}
asm // eax=TAESContext ecx=len xmm7=CV esi=BufIn edi=BufOut
call dword ptr [eax].TAESContext.AesNi32 // = AES.Encrypt(fCV,fCV)
lea edx, [eax].TAESContext.buf // used as temporary buffer
movups [edx], xmm7
cld
@s: lodsb
xor al, [edx] // = XorMemory(pointer(fOut),pointer(fIn),@fCV,len);
inc edx
stosb
dec ecx
jnz @s
end;
{$endif}
procedure TAESCFB.Decrypt(BufIn, BufOut: pointer; Count: cardinal);
var i: integer;
tmp: TAESBlock;
begin
{$ifdef USEAESNI32}
if Assigned(TAESContext(AES.Context).AesNi32) then
asm
push esi
push edi
mov eax, self
mov ecx, count
mov esi, BufIn
mov edi, BufOut
movups xmm7, dqword ptr[eax].TAESCFB.fIV
lea eax, [eax].TAESCFB.AES
push ecx
shr ecx, 4
jz @z
@s: call dword ptr[eax].TAESContext.AesNi32 // AES.Encrypt(fCV,fCV)
movups xmm0, dqword ptr[esi]
movaps xmm1, xmm0
pxor xmm0, xmm7
movaps xmm7, xmm1 // fCV := fIn
movups dqword ptr[edi], xmm0 // fOut := fIn xor fCV
dec ecx
lea esi, [esi + 16]
lea edi, [edi + 16]
jnz @s
@z: pop ecx
and ecx, 15
jz @0
call AesNiTrailer
@0: pop edi
pop esi
pxor xmm7, xmm7 // for safety
end else
{$endif} begin
inherited; // CV := IV + set fIn,fOut
for i := 1 to Count shr 4 do begin
tmp := fIn^;
TAESContext(AES.Context).DoBlock(AES.Context,fCV,fCV);
XorBlock16(pointer(fIn),pointer(fOut),pointer(@fCV));
fCV := tmp;
inc(fIn);
inc(fOut);
end;
Count := Count and AESBlockMod;
if Count<>0 then
TrailerBytes(Count);
end;
end;
procedure TAESCFB.Encrypt(BufIn, BufOut: pointer; Count: cardinal);
var i: integer;
begin
{$ifdef USEAESNI32}
if Assigned(TAESContext(AES.Context).AesNi32) then
asm
push esi
push edi
mov eax, self
mov ecx, count
mov esi, BufIn
mov edi, BufOut
movups xmm7, dqword ptr[eax].TAESCFB.fIV
lea eax, [eax].TAESCFB.AES
push ecx
shr ecx, 4
jz @z
@s: call dword ptr[eax].TAESContext.AesNi32 // AES.Encrypt(fCV,fCV)
movups xmm0, dqword ptr[esi]
pxor xmm7, xmm0
movups dqword ptr[edi], xmm7 // fOut := fIn xor fCV
dec ecx
lea esi, [esi + 16]
lea edi, [edi + 16]
jnz @s
@z: pop ecx
and ecx, 15
jz @0
call AesNiTrailer
@0: pop edi
pop esi
pxor xmm7, xmm7 // for safety
end else
{$endif} begin
inherited; // CV := IV + set fIn,fOut
for i := 1 to Count shr 4 do begin
TAESContext(AES.Context).DoBlock(AES.Context,fCV,fCV);
XorBlock16(pointer(fIn),pointer(fOut),pointer(@fCV));
fCV := fOut^;
inc(fIn);
inc(fOut);
end;
Count := Count and AESBlockMod;
if Count<>0 then
TrailerBytes(Count);
end;
end;
{ TAESAbstractAEAD }
destructor TAESAbstractAEAD.Destroy;
begin
inherited Destroy;
FillCharFast(fMacKey,sizeof(fMacKey),0);
FillCharFast(fMac,sizeof(fMac),0);
end;
function TAESAbstractAEAD.MACSetNonce(const aKey: THash256; aAssociated: pointer;
aAssociatedLen: integer): boolean;
var rec: THash256Rec absolute aKey;
begin
// safe seed for plain text crc, before AES encryption
// from TECDHEProtocol.SetKey, aKey is a public nonce to avoid replay attacks
fMACKey.plain := rec.Lo;
XorBlock16(@fMACKey.plain,@rec.Hi);
// neutral seed for encrypted crc, to check for errors, with no compromission
if (aAssociated<>nil) and (aAssociatedLen>0) then
crc128c(aAssociated,aAssociatedLen,fMACKey.encrypted) else
FillcharFast(fMACKey.encrypted,sizeof(THash128),255);
result := true;
end;
function TAESAbstractAEAD.MACGetLast(out aCRC: THash256): boolean;
var rec: THash256Rec absolute aCRC;
begin
// encrypt the plain text crc, to perform message authentication and integrity
AES.Encrypt(fMAC.plain,rec.Lo);
// store the encrypted text crc, to check for errors, with no compromission
rec.Hi := fMAC.encrypted;
result := true;
end;
function TAESAbstractAEAD.MACCheckError(aEncrypted: pointer; Count: cardinal): boolean;
var crc: THash128;
begin
result := false;
if (Count<32) or (Count and AESBlockMod<>0) then
exit;
crc := fMACKey.encrypted;
crcblocks(@crc,aEncrypted,Count shr 4-2);
result := IsEqual(crc,PHash128(@PByteArray(aEncrypted)[Count-sizeof(crc)])^);
end;
{ TAESCFBCRC }
procedure TAESCFBCRC.Decrypt(BufIn, BufOut: pointer; Count: cardinal);
var i: integer;
tmp: TAESBlock;
begin
if Count=0 then
exit;
fMAC := fMACKey; // reuse the same key until next MACSetNonce()
{$ifdef USEAESNI32}
if Assigned(TAESContext(AES.Context).AesNi32) and (Count and AESBlockMod=0) then
asm
push ebx
push esi
push edi
mov ebx, self
mov esi, BufIn
mov edi, BufOut
movups xmm7, dqword ptr[ebx].TAESCFBCRC.fIV
@s: lea eax, [ebx].TAESCFBCRC.fMAC.encrypted
mov edx, esi
call crcblock // using SSE4.2 or fast tables
lea eax, [ebx].TAESCFBCRC.AES
call dword ptr[eax].TAESContext.AesNi32 // AES.Encrypt(fCV,fCV)
movups xmm0, dqword ptr[esi]
movaps xmm1, xmm0
pxor xmm0, xmm7
movaps xmm7, xmm1 // fCV := fIn
movups dqword ptr[edi], xmm0 // fOut := fIn xor fCV
lea eax, [ebx].TAESCFBCRC.fMAC.plain
mov edx, edi
call crcblock
sub dword ptr[count], 16
lea esi, [esi + 16]
lea edi, [edi + 16]
ja @s
@z: pop edi
pop esi
pop ebx
pxor xmm7, xmm7 // for safety
end else
{$endif} begin
inherited; // CV := IV + set fIn,fOut
for i := 1 to Count shr 4 do begin
tmp := fIn^;
crcblock(@fMAC.encrypted,pointer(fIn)); // fIn may be = fOut
TAESContext(AES.Context).DoBlock(AES.Context,fCV,fCV);
XorBlock16(pointer(fIn),pointer(fOut),pointer(@fCV));
fCV := tmp;
crcblock(@fMAC.plain,pointer(fOut));
inc(fIn);
inc(fOut);
end;
Count := Count and AESBlockMod;
if Count<>0 then begin
TrailerBytes(Count);
with fMAC do // includes trailing bytes to the plain crc
PCardinal(@plain)^ := crc32c(PCardinal(@plain)^,pointer(fOut),Count);
end;
end;
end;
procedure TAESCFBCRC.Encrypt(BufIn, BufOut: pointer; Count: cardinal);
var i: integer;
begin
if Count=0 then
exit;
fMAC := fMACKey; // reuse the same key until next MACSetNonce()
{$ifdef USEAESNI32}
if Assigned(TAESContext(AES.Context).AesNi32) and (Count and AESBlockMod=0) then
asm
push ebx
push esi
push edi
mov ebx, self
mov esi, BufIn
mov edi, BufOut
movups xmm7, dqword ptr[ebx].TAESCFBCRC.fIV
@s: lea eax, [ebx].TAESCFBCRC.fMAC.plain
mov edx, esi
call crcblock
lea eax, [ebx].TAESCFBCRC.AES
call dword ptr[eax].TAESContext.AesNi32 // AES.Encrypt(fCV,fCV)
movups xmm0, dqword ptr[esi]
pxor xmm7, xmm0
movups dqword ptr[edi], xmm7 // fOut := fIn xor fCV + fCV := fOut^
lea eax, [ebx].TAESCFBCRC.fMAC.encrypted
mov edx, edi
call crcblock
sub dword ptr[count], 16
lea esi, [esi + 16]
lea edi, [edi + 16]
ja @s
pop edi
pop esi
pop ebx
pxor xmm7, xmm7 // for safety
end else
{$endif} begin
inherited; // CV := IV + set fIn,fOut
for i := 1 to Count shr 4 do begin
TAESContext(AES.Context).DoBlock(AES.Context,fCV,fCV);
crcblock(@fMAC.plain,pointer(fIn)); // fOut may be = fIn
XorBlock16(pointer(fIn),pointer(fOut),pointer(@fCV));
fCV := fOut^;
crcblock(@fMAC.encrypted,pointer(fOut));
inc(fIn);
inc(fOut);
end;
Count := Count and AESBlockMod;
if Count<>0 then begin
with fMAC do // includes trailing bytes to the plain crc
PCardinal(@plain)^ := crc32c(PCardinal(@plain)^,pointer(fIn),Count);
TrailerBytes(Count);
end;
end;
end;
{ TAESOFBCRC }
procedure TAESOFBCRC.Decrypt(BufIn, BufOut: pointer; Count: cardinal);
var i: integer;
begin
if Count=0 then
exit;
fMAC := fMACKey; // reuse the same key until next MACSetNonce()
{$ifdef USEAESNI32}
if Assigned(TAESContext(AES.Context).AesNi32) and (Count and AESBlockMod=0) then
asm
push ebx
push esi
push edi
mov ebx, self
mov esi, BufIn
mov edi, BufOut
movups xmm7, dqword ptr[ebx].TAESOFBCRC.fIV
@s: lea eax, [ebx].TAESOFBCRC.fMAC.encrypted
mov edx, esi
call crcblock
lea eax, [ebx].TAESOFBCRC.AES
call dword ptr[eax].TAESContext.AesNi32 // AES.Encrypt(fCV,fCV)
movups xmm0, dqword ptr[esi]
pxor xmm0, xmm7
movups dqword ptr[edi], xmm0 // fOut := fIn xor fCV
lea eax, [ebx].TAESOFBCRC.fMAC.plain
mov edx, edi
call crcblock
sub dword ptr[count], 16
lea esi, [esi + 16]
lea edi, [edi + 16]
ja @s
pop edi
pop esi
pop ebx
pxor xmm7, xmm7 // for safety
end else
{$endif} begin
inherited Encrypt(BufIn,BufOut,Count); // CV := IV + set fIn,fOut
for i := 1 to Count shr 4 do begin
TAESContext(AES.Context).DoBlock(AES.Context,fCV,fCV);
crcblock(@fMAC.encrypted,pointer(fIn)); // fOut may be = fIn
XorBlock16(pointer(fIn),pointer(fOut),pointer(@fCV));
crcblock(@fMAC.plain,pointer(fOut));
inc(fIn);
inc(fOut);
end;
Count := Count and AESBlockMod;
if Count<>0 then begin
TrailerBytes(Count);
with fMAC do // includes trailing bytes to the plain crc
PCardinal(@plain)^ := crc32c(PCardinal(@plain)^,pointer(fOut),Count);
end;
end;
end;
procedure TAESOFBCRC.Encrypt(BufIn, BufOut: pointer; Count: cardinal);
var i: integer;
begin
if Count=0 then
exit;
fMAC := fMACKey; // reuse the same key until next MACSetNonce()
{$ifdef USEAESNI32}
if Assigned(TAESContext(AES.Context).AesNi32) and (Count and AESBlockMod=0) then
asm
push ebx
push esi
push edi
mov ebx, self
mov esi, BufIn
mov edi, BufOut
movups xmm7, dqword ptr[ebx].TAESOFBCRC.fIV
@s: lea eax, [ebx].TAESOFBCRC.fMAC.plain
mov edx, esi
call crcblock
lea eax, [ebx].TAESOFBCRC.AES
call dword ptr[eax].TAESContext.AesNi32 // AES.Encrypt(fCV,fCV)
movups xmm0, dqword ptr[esi]
pxor xmm0, xmm7
movups dqword ptr[edi], xmm0 // fOut := fIn xor fCV
lea eax, [ebx].TAESOFBCRC.fMAC.encrypted
mov edx, edi
call crcblock
sub dword ptr[count], 16
lea esi, [esi + 16]
lea edi, [edi + 16]
ja @s
pop edi
pop esi
pop ebx
pxor xmm7, xmm7 // for safety
end else
{$endif} begin
inherited Encrypt(BufIn,BufOut,Count); // CV := IV + set fIn,fOut
for i := 1 to Count shr 4 do begin
TAESContext(AES.Context).DoBlock(AES.Context,fCV,fCV);
crcblock(@fMAC.plain,pointer(fIn)); // fOut may be = fIn
XorBlock16(pointer(fIn),pointer(fOut),pointer(@fCV));
crcblock(@fMAC.encrypted,pointer(fOut));
inc(fIn);
inc(fOut);
end;
Count := Count and AESBlockMod;
if Count<>0 then begin
with fMAC do // includes trailing bytes to the plain crc
PCardinal(@plain)^ := crc32c(PCardinal(@plain)^,pointer(fIn),Count);
TrailerBytes(Count);
end;
end;
end;
{ TAESOFB }
{$ifdef USEAESNI64}
procedure AesNiEncryptOFB_128(self: TAESOFB; source, dest: pointer; blockcount: PtrUInt);
{$ifdef FPC} nostackframe; assembler; asm {$else} asm .noframe {$endif}
test blockcount, blockcount
jz @z
movups xmm7, dqword ptr[self].TAESOFB.fIV // xmm7 = fCV
lea self, [self].TAESOFB.AES
movups xmm0, dqword ptr[self + 16 * 0]
movups xmm1, dqword ptr[self + 16 * 1]
movups xmm2, dqword ptr[self + 16 * 2]
movups xmm3, dqword ptr[self + 16 * 3]
movups xmm4, dqword ptr[self + 16 * 4]
movups xmm5, dqword ptr[self + 16 * 5]
movups xmm6, dqword ptr[self + 16 * 6]
movups xmm8, dqword ptr[self + 16 * 7]
movups xmm9, dqword ptr[self + 16 * 8]
movups xmm10, dqword ptr[self + 16 * 9]
movups xmm11, dqword ptr[self + 16 * 10]
{$ifdef FPC} align 16 {$else} .align 16 {$endif}
@s: movups xmm15, dqword ptr[source]
pxor xmm7, xmm0
aesenc xmm7, xmm1
aesenc xmm7, xmm2
aesenc xmm7, xmm3
aesenc xmm7, xmm4
aesenc xmm7, xmm5
aesenc xmm7, xmm6
aesenc xmm7, xmm8
aesenc xmm7, xmm9
aesenc xmm7, xmm10
aesenclast xmm7, xmm11
pxor xmm15, xmm7
movups dqword ptr[dest], xmm15 // fOut := fIn xor fCV
add source, 16
add dest, 16
dec blockcount
jnz @s
@z:
end;
procedure AesNiEncryptOFB_256(self: TAESOFB; source, dest: pointer; blockcount: PtrUInt);
{$ifdef FPC} nostackframe; assembler; asm {$else} asm .noframe {$endif}
test blockcount, blockcount
jz @z
movups xmm7, dqword ptr[self].TAESOFB.fIV // xmm7 = fCV
lea self, [self].TAESOFB.AES
movups xmm0, dqword ptr[self + 16 * 0]
movups xmm1, dqword ptr[self + 16 * 1]
movups xmm2, dqword ptr[self + 16 * 2]
movups xmm3, dqword ptr[self + 16 * 3]
movups xmm4, dqword ptr[self + 16 * 4]
movups xmm5, dqword ptr[self + 16 * 5]
movups xmm6, dqword ptr[self + 16 * 6]
movups xmm8, dqword ptr[self + 16 * 7]
movups xmm9, dqword ptr[self + 16 * 8]
movups xmm10, dqword ptr[self + 16 * 9]
movups xmm11, dqword ptr[self + 16 * 10]
movups xmm12, dqword ptr[self + 16 * 11]
movups xmm13, dqword ptr[self + 16 * 12]
movups xmm14, dqword ptr[self + 16 * 13]
add self, 16 * 14
{$ifdef FPC} align 16 {$else} .align 16 {$endif}
@s: movups xmm15, dqword ptr[self]
pxor xmm7, xmm0
aesenc xmm7, xmm1
aesenc xmm7, xmm2
aesenc xmm7, xmm3
aesenc xmm7, xmm4
aesenc xmm7, xmm5
aesenc xmm7, xmm6
aesenc xmm7, xmm8
aesenc xmm7, xmm9
aesenc xmm7, xmm10
aesenc xmm7, xmm11
aesenc xmm7, xmm12
aesenc xmm7, xmm13
aesenc xmm7, xmm14
aesenclast xmm7, xmm15
movups xmm15, dqword ptr[source]
pxor xmm15, xmm7
movups dqword ptr[dest], xmm15 // fOut := fIn xor fCV
add source, 16
add dest, 16
dec blockcount
jnz @s
@z:
end;
{$endif USEAESNI64}
procedure TAESOFB.Decrypt(BufIn, BufOut: pointer; Count: cardinal);
begin
Encrypt(BufIn, BufOut, Count); // by definition
end;
procedure TAESOFB.Encrypt(BufIn, BufOut: pointer; Count: cardinal);
var i: integer;
begin
{$ifdef USEAESNI64}
if (Count and AESBlockMod=0) and (cfAESNI in CpuFeatures) then
with TAESContext(AES.Context) do
case KeyBits of
128: begin
AesNiEncryptOFB_128(self,BufIn,BufOut,Count shr 4);
exit;
end;
256: begin
AesNiEncryptOFB_256(self,BufIn,BufOut,Count shr 4);
exit;
end;
end;
{$endif USEAESNI64}
{$ifdef USEAESNI32}
if Assigned(TAESContext(AES.Context).AesNi32) then
asm
push esi
push edi
mov eax, self
mov ecx, count
mov esi, BufIn
mov edi, BufOut
movups xmm7, dqword ptr[eax].TAESOFB.fIV // xmm7 = fCV
lea eax, [eax].TAESOFB.AES
push ecx
shr ecx, 4
jz @z
@s: call dword ptr[eax].TAESContext.AesNi32 // AES.Encrypt(fCV,fCV)
movups xmm0, dqword ptr[esi]
pxor xmm0, xmm7
movups dqword ptr[edi], xmm0 // fOut := fIn xor fCV
dec ecx
lea esi, [esi + 16]
lea edi, [edi + 16]
jnz @s
@z: pop ecx
and ecx, 15
jz @0
call AesNiTrailer
@0: pop edi
pop esi
pxor xmm7, xmm7 // for safety
end else
{$endif} begin
inherited; // CV := IV + set fIn,fOut
for i := 1 to Count shr 4 do begin
TAESContext(AES.Context).DoBlock(AES.Context,fCV,fCV);
XorBlock16(pointer(fIn),pointer(fOut),pointer(@fCV));
inc(fIn);
inc(fOut);
end;
Count := Count and AESBlockMod;
if Count<>0 then
TrailerBytes(Count);
end;
end;
{ TAESCTR }
constructor TAESCTR.Create(const aKey; aKeySize: cardinal);
begin
inherited Create(aKey, aKeySize);
fCTROffset := 7; // counter is in the lower 64 bits, nonce in the upper 64 bits
end;
function TAESCTR.ComposeIV(Nonce, Counter: PAESBlock; NonceLen, CounterLen: integer;
LSBCounter: boolean): boolean;
begin
result := (NonceLen + CounterLen = 16) and (CounterLen > 0);
if result then
if LSBCounter then begin
MoveFast(Nonce[0], fIV[0], NonceLen);
MoveFast(Counter[0], fIV[NonceLen], CounterLen);
fCTROffset := 15;
fCTROffsetMin := 16-CounterLen;
end else begin
MoveFast(Counter[0], fIV[0], CounterLen);
MoveFast(Nonce[0], fIV[CounterLen], NonceLen);
fCTROffset := CounterLen-1;
fCTROffsetMin := 0;
end;
end;
function TAESCTR.ComposeIV(const Nonce, Counter: TByteDynArray;
LSBCounter: boolean): boolean;
begin
result := ComposeIV(pointer(Nonce), pointer(Counter),
length(Nonce), length(Counter), LSBCounter);
end;
procedure TAESCTR.Encrypt(BufIn, BufOut: pointer; Count: cardinal);
var i: integer;
offs: PtrInt;
tmp: TAESBlock;
begin
inherited; // CV := IV + set fIn,fOut
for i := 1 to Count shr 4 do begin
TAESContext(AES.Context).DoBlock(AES.Context,fCV,tmp);
offs := fCTROffset;
inc(fCV[offs]);
if fCV[offs]=0 then // manual big-endian increment
repeat
dec(offs);
inc(fCV[offs]);
if (fCV[offs]<>0) or (offs=fCTROffsetMin) then
break;
until false;
XorBlock16(pointer(fIn),pointer(fOut),pointer(@tmp));
inc(fIn);
inc(fOut);
end;
Count := Count and AESBlockMod;
if Count<>0 then begin
TAESContext(AES.Context).DoBlock(AES.Context,fCV,tmp);
XorMemory(pointer(fOut),pointer(fIn),@tmp,Count);
end;
end;
procedure TAESCTR.Decrypt(BufIn, BufOut: pointer; Count: cardinal);
begin
Encrypt(BufIn, BufOut, Count); // by definition
end;
{ TAESGCM }
constructor TAESGCM.Create(const aKey; aKeySize: cardinal);
begin
inherited Create(aKey,aKeySize); // set fKey/fKeySize
if not fAES.Init(aKey,aKeySize) then
raise ESynCrypto.CreateUTF8('%.Create(keysize=%) failed',[self,aKeySize]);
end;
function TAESGCM.Clone: TAESAbstract;
begin
result := NewInstance as TAESGCM;
result.fKey := fKey;
result.fKeySize := fKeySize;
result.fKeySizeBytes := fKeySizeBytes;
TAESGCM(result).fAES := fAES; // reuse the very same TAESGCMEngine memory
end;
destructor TAESGCM.Destroy;
begin
inherited Destroy;
fAES.Done;
FillZero(fIV);
end;
procedure TAESGCM.Encrypt(BufIn, BufOut: pointer; Count: cardinal);
begin
if fContext<>ctxEncrypt then
if fContext=ctxNone then begin
fAES.Reset(@fIV,CTR_POS); // caller should have set the IV
fContext := ctxEncrypt;
end else
raise ESynCrypto.CreateUTF8('%.Encrypt after Decrypt',[self]);
if not fAES.Encrypt(BufIn,BufOut,Count) then
raise ESynCrypto.CreateUTF8('%.Encrypt called after GCM final state',[self]);
end;
procedure TAESGCM.Decrypt(BufIn, BufOut: pointer; Count: cardinal);
begin
if fContext<>ctxDecrypt then
if fContext=ctxNone then begin
fAES.Reset(@fIV,CTR_POS);
fContext := ctxDecrypt;
end else
raise ESynCrypto.CreateUTF8('%.Decrypt after Encrypt',[self]);
if not fAES.Decrypt(BufIn,BufOut,Count) then
raise ESynCrypto.CreateUTF8('%.Decrypt called after GCM final state',[self]);
end;
function TAESGCM.MACSetNonce(const aKey: THash256; aAssociated: pointer;
aAssociatedLen: integer): boolean;
begin
if fContext<>ctxNone then begin
result := false; // should be called before Encrypt/Decrypt
exit;
end;
// aKey is ignored since not used during GMAC computation
if (aAssociated<>nil) and (aAssociatedLen>0) then
fAES.Add_AAD(aAssociated,aAssociatedLen);
result := true;
end;
function TAESGCM.MACGetLast(out aCRC: THash256): boolean;
begin
if fContext=ctxNone then begin
result := false; // should be called after Encrypt/Decrypt
exit;
end;
fAES.Final(THash256Rec(aCRC).Lo,{forreuse:anddone=}false);
FillZero(THash256Rec(aCRC).Hi); // upper 128-bit are not used
fContext := ctxNone; // allow reuse of this fAES instance
result := true;
end;
function TAESGCM.MACCheckError(aEncrypted: pointer; Count: cardinal): boolean;
begin
result := true; // AES-GCM requires the IV to be set -> will be checked later
end;
{$ifdef MSWINDOWS}
type
HCRYPTPROV = pointer;
HCRYPTKEY = pointer;
HCRYPTHASH = pointer;
{$ifdef USERECORDWITHMETHODS}TCryptLibrary = record
{$else}TCryptLibrary = object{$endif}
public
AcquireContextA: function(var phProv: HCRYPTPROV; pszContainer: PAnsiChar;
pszProvider: PAnsiChar; dwProvType: DWORD; dwFlags: DWORD): BOOL; stdcall;
ReleaseContext: function(hProv: HCRYPTPROV; dwFlags: PtrUInt): BOOL; stdcall;
ImportKey: function(hProv: HCRYPTPROV; pbData: pointer; dwDataLen: DWORD;
hPubKey: HCRYPTKEY; dwFlags: DWORD; var phKey: HCRYPTKEY): BOOL; stdcall;
SetKeyParam: function(hKey: HCRYPTKEY; dwParam: DWORD; pbData: pointer;
dwFlags: DWORD): BOOL; stdcall;
DestroyKey: function(hKey: HCRYPTKEY): BOOL; stdcall;
Encrypt: function(hKey: HCRYPTKEY; hHash: HCRYPTHASH; Final: BOOL;
dwFlags: DWORD; pbData: pointer; var pdwDataLen: DWORD; dwBufLen: DWORD): BOOL; stdcall;
Decrypt: function(hKey: HCRYPTKEY; hHash: HCRYPTHASH; Final: BOOL;
dwFlags: DWORD; pbData: pointer; var pdwDataLen: DWORD): BOOL; stdcall;
GenRandom: function(hProv: HCRYPTPROV; dwLen: DWORD; pbBuffer: Pointer): BOOL; stdcall;
Tested: boolean;
Handle: THandle;
function Available: boolean;
end;
const
HCRYPTPROV_NOTTESTED = HCRYPTPROV(-1);
PROV_RSA_FULL = 1;
CRYPT_VERIFYCONTEXT = DWORD($F0000000);
var
CryptoAPI: TCryptLibrary;
function TCryptLibrary.Available: boolean;
procedure Acquire;
const NAMES: array[0..7] of PChar = (
'CryptAcquireContextA','CryptReleaseContext',
'CryptImportKey','CryptSetKeyParam','CryptDestroyKey',
'CryptEncrypt','CryptDecrypt','CryptGenRandom');
var P: PPointer;
i: integer;
begin
Tested := true;
Handle := GetModuleHandle('advapi32.dll');
if Handle<>0 then begin
P := @@AcquireContextA;
for i := 0 to high(NAMES) do begin
P^ := GetProcAddress(Handle,NAMES[i]);
if P^=nil then begin
PPointer(@@AcquireContextA)^ := nil;
break;
end;
inc(P);
end;
end;
end;
begin
if not Tested then
Acquire;
result := Assigned(AcquireContextA);
end;
{$ifdef USE_PROV_RSA_AES}
var
CryptoAPIAESProvider: HCRYPTPROV = HCRYPTPROV_NOTTESTED;
const
PROV_RSA_AES = 24;
CRYPT_NEWKEYSET = 8;
PLAINTEXTKEYBLOB = 8;
CUR_BLOB_VERSION = 2;
KP_IV = 1;
KP_MODE = 4;
CALG_AES_128 = $660E;
CALG_AES_192 = $660F;
CALG_AES_256 = $6610;
CRYPT_MODE_CBC = 1;
CRYPT_MODE_ECB = 2;
CRYPT_MODE_OFB = 3;
CRYPT_MODE_CFB = 4;
CRYPT_MODE_CTS = 5;
procedure EnsureCryptoAPIAESProviderAvailable;
begin
if CryptoAPIAESProvider=nil then
raise ESynCrypto.Create('PROV_RSA_AES provider not installed') else
if CryptoAPIAESProvider=HCRYPTPROV_NOTTESTED then begin
CryptoAPIAESProvider := nil;
if CryptoAPI.Available then begin
if not CryptoAPI.AcquireContextA(CryptoAPIAESProvider,nil,nil,PROV_RSA_AES,0) then
if (HRESULT(GetLastError)<>NTE_BAD_KEYSET) or not CryptoAPI.AcquireContextA(
CryptoAPIAESProvider,nil,nil,PROV_RSA_AES,CRYPT_NEWKEYSET) then
raise ESynCrypto.CreateLastOSError('in AcquireContext',[]);
end;
end;
end;
{ TAESAbstract_API }
constructor TAESAbstract_API.Create(const aKey; aKeySize: cardinal);
begin
EnsureCryptoAPIAESProviderAvailable;
inherited Create(aKey,aKeySize); // check and set fKeySize[Bytes]
InternalSetMode;
fKeyHeader.bType := PLAINTEXTKEYBLOB;
fKeyHeader.bVersion := CUR_BLOB_VERSION;
case fKeySize of
128: fKeyHeader.aiKeyAlg := CALG_AES_128;
192: fKeyHeader.aiKeyAlg := CALG_AES_192;
256: fKeyHeader.aiKeyAlg := CALG_AES_256;
end;
fKeyHeader.dwKeyLength := fKeySizeBytes;
fKeyHeaderKey := fKey;
end;
destructor TAESAbstract_API.Destroy;
begin
if fKeyCryptoAPI<>nil then
CryptoAPI.DestroyKey(fKeyCryptoAPI);
FillCharFast(fKeyHeaderKey,sizeof(fKeyHeaderKey),0);
inherited;
end;
procedure TAESAbstract_API.EncryptDecrypt(BufIn, BufOut: pointer; Count: cardinal;
DoEncrypt: boolean);
var n: Cardinal;
begin
if Count=0 then
exit; // nothing to do
if fKeyCryptoAPI<>nil then begin
CryptoAPI.DestroyKey(fKeyCryptoAPI);
fKeyCryptoAPI := nil;
end;
if not CryptoAPI.ImportKey(CryptoAPIAESProvider,
@fKeyHeader,sizeof(fKeyHeader)+fKeySizeBytes,nil,0,fKeyCryptoAPI) then
raise ESynCrypto.CreateLastOSError('in CryptImportKey for %',[self]);
if not CryptoAPI.SetKeyParam(fKeyCryptoAPI,KP_IV,@fIV,0) then
raise ESynCrypto.CreateLastOSError('in CryptSetKeyParam(KP_IV) for %',[self]);
if not CryptoAPI.SetKeyParam(fKeyCryptoAPI,KP_MODE,@fInternalMode,0) then
raise ESynCrypto.CreateLastOSError('in CryptSetKeyParam(KP_MODE,%) for %',[fInternalMode,self]);
if BufOut<>BufIn then
MoveFast(BufIn^,BufOut^,Count);
n := Count and not AESBlockMod;
if DoEncrypt then begin
if not CryptoAPI.Encrypt(fKeyCryptoAPI,nil,false,0,BufOut,n,Count) then
raise ESynCrypto.CreateLastOSError('in Encrypt() for %',[self]);
end else
if not CryptoAPI.Decrypt(fKeyCryptoAPI,nil,false,0,BufOut,n) then
raise ESynCrypto.CreateLastOSError('in Decrypt() for %',[self]);
dec(Count,n);
if Count>0 then // remaining bytes will be XORed with the supplied IV
XorMemory(@PByteArray(BufOut)[n],@PByteArray(BufIn)[n],@fIV,Count);
end;
procedure TAESAbstract_API.Encrypt(BufIn, BufOut: pointer; Count: cardinal);
begin
EncryptDecrypt(BufIn,BufOut,Count,true);
end;
procedure TAESAbstract_API.Decrypt(BufIn, BufOut: pointer; Count: cardinal);
begin
EncryptDecrypt(BufIn,BufOut,Count,false);
end;
{ TAESECB_API }
procedure TAESECB_API.InternalSetMode;
begin
fInternalMode := CRYPT_MODE_ECB;
end;
{ TAESCBC_API }
procedure TAESCBC_API.InternalSetMode;
begin
fInternalMode := CRYPT_MODE_CBC;
end;
{ TAESCFB_API }
procedure TAESCFB_API.InternalSetMode;
begin
raise ESynCrypto.CreateUTF8('%: CRYPT_MODE_CFB does not work',[self]);
fInternalMode := CRYPT_MODE_CFB;
end;
{ TAESOFB_API }
procedure TAESOFB_API.InternalSetMode;
begin
raise ESynCrypto.CreateUTF8('%: CRYPT_MODE_OFB not implemented by PROV_RSA_AES',[self]);
fInternalMode := CRYPT_MODE_OFB;
end;
{$endif USE_PROV_RSA_AES}
{$endif MSWINDOWS}
{ TAESLocked }
destructor TAESLocked.Destroy;
begin
inherited Destroy;
fAES.Done; // mandatory for Padlock - also fill AES buffer with 0 for safety
end;
{ TAESPRNG }
constructor TAESPRNG.Create(PBKDF2Rounds, ReseedAfterBytes, AESKeySize: integer);
begin
inherited Create;
if PBKDF2Rounds<2 then
PBKDF2Rounds := 2;
fSeedPBKDF2Rounds := PBKDF2Rounds;
fSeedAfterBytes := ReseedAfterBytes;
fAESKeySize := AESKeySize;
Seed;
end;
procedure FillSystemRandom(Buffer: PByteArray; Len: integer; AllowBlocking: boolean);
var fromos: boolean;
i: integer;
{$ifdef LINUX}
dev: integer;
{$endif}
{$ifdef MSWINDOWS}
prov: HCRYPTPROV;
{$endif}
tmp: array[byte] of byte;
begin
fromos := false;
{$ifdef LINUX}
dev := FileOpen('/dev/urandom',fmOpenRead);
if (dev<=0) and AllowBlocking then
dev := FileOpen('/dev/random',fmOpenRead);
if dev>0 then
try
i := Len;
if i>32 then
i := 32; // up to 256 bits - see "man urandom" Usage paragraph
fromos := (FileRead(dev,Buffer[0],i)=i) and (Len<=32); // will XOR up to Len
finally
FileClose(dev);
end;
{$endif LINUX}
{$ifdef MSWINDOWS}
if CryptoAPI.Available then
if CryptoAPI.AcquireContextA(prov,nil,nil,PROV_RSA_FULL,CRYPT_VERIFYCONTEXT) then begin
fromos := CryptoAPI.GenRandom(prov,len,Buffer);
CryptoAPI.ReleaseContext(prov,0);
end;
{$endif MSWINDOWS}
if fromos then
exit;
i := Len;
repeat // call Random32() (=RdRand32 or Lecuyer) as fallback/padding
SynCommons.FillRandom(@tmp,SizeOf(tmp) shr 2);
if i<=SizeOf(tmp) then begin
XorMemory(@Buffer^[Len-i],@tmp,i);
break;
end;
XorMemoryPtrInt(@Buffer^[Len-i],@tmp,SizeOf(tmp) shr {$ifdef CPU32}2{$else}3{$endif});
dec(i,SizeOf(tmp));
until false;
end;
{$ifdef DELPHI5OROLDER} // not defined in SysUtils.pas
function CreateGuid(out guid: TGUID): HResult; stdcall;
external 'ole32.dll' name 'CoCreateGuid';
{$endif}
class function TAESPRNG.GetEntropy(Len: integer; SystemOnly: boolean): RawByteString;
var ext: TSynExtended;
data: THash512Rec;
fromos, version: RawByteString;
sha3: TSHA3;
procedure sha3update;
var g: TGUID;
begin
SynCommons.FillRandom(@data.Hi,8); // QueryPerformanceCounter+8*Random32
sha3.Update(@data,sizeof(data));
CreateGUID(g); // not random, but genuine (at least on Windows)
sha3.Update(@g,sizeof(g));
end;
begin
QueryPerformanceCounter(data.d0); // data.d1 = some bytes on stack
try
// retrieve some initial entropy from OS
SetLength(fromos,Len);
FillSystemRandom(pointer(fromos),len,{allowblocking=}SystemOnly);
if SystemOnly then begin
result := fromos;
fromos := '';
exit;
end;
// xor some explicit entropy - it won't hurt
sha3.Init(SHAKE_256); // used in XOF mode for variable-length output
sha3update;
data.h1 := ExeVersion.Hash.b;
version := RecordSave(ExeVersion,TypeInfo(TExeVersion));
sha3.Update(version); // exe and host/user info
ext := NowUTC;
sha3.Update(@ext,sizeof(ext));
sha3update;
ext := Random; // why not?
sha3.Update(@ext,sizeof(ext));
data.i0 := integer(HInstance); // override data.d0d1/h0
data.i1 := integer(GetCurrentThreadId);
data.i2 := integer(MainThreadID);
data.i3 := integer(UnixMSTimeUTCFast);
SleepHiRes(0); // force non deterministic time shift
sha3update;
sha3.Update(OSVersionText);
sha3.Update(@SystemInfo,sizeof(SystemInfo));
result := sha3.Cypher(fromos); // = XOR entropy using SHA-3 in XOF mode
finally
sha3.Done;
FillZero(fromos);
end;
end;
procedure TAESPRNG.Seed;
var key: THash512Rec;
entropy: RawByteString;
begin
try
entropy := GetEntropy(128); // 128 bytes is the HMAC_SHA512 key block size
PBKDF2_HMAC_SHA512(entropy,ExeVersion.User,fSeedPBKDF2Rounds,key.b);
fSafe^.Lock;
try
fAES.EncryptInit(key.Lo,fAESKeySize);
crcblocks(@fCTR,@key.Hi,2);
fBytesSinceSeed := 0;
finally
fSafe^.UnLock;
end;
finally
FillZero(key.b); // avoid the key appear in clear on stack
FillZero(entropy);
end;
end;
procedure TAESPRNG.IncrementCTR;
begin
{$ifdef CPU64}
inc(fCTR.Lo);
if fCTR.Lo=0 then
inc(fCTR.Hi);
{$else}
inc(fCTR.i0);
if fCTR.i0=0 then begin
inc(fCTR.i1);
if fCTR.i1=0 then begin
inc(fCTR.i2);
if fCTR.i2=0 then
inc(fCTR.i3);
end;
end;
{$endif}
end;
procedure TAESPRNG.FillRandom(out Block: TAESBlock);
begin
if fBytesSinceSeed>fSeedAfterBytes then
Seed;
fSafe^.Lock;
TAESContext(fAES.Context).DoBlock(fAES.Context,fCTR.b,Block);
IncrementCTR;
inc(fBytesSinceSeed,SizeOf(Block));
inc(fTotalBytes,SizeOf(Block));
fSafe^.UnLock;
end;
procedure TAESPRNG.FillRandom(out Buffer: THash256);
begin
FillRandom(@Buffer,sizeof(Buffer));
end;
procedure TAESPRNG.FillRandom(Buffer: pointer; Len: integer);
var buf: ^TAESBlock absolute Buffer;
rnd: TAESBLock;
i: integer;
begin
if Len<=0 then
exit;
if fBytesSinceSeed>fSeedAfterBytes then
Seed;
fSafe^.Lock;
for i := 1 to Len shr 4 do begin
TAESContext(fAES.Context).DoBlock(fAES.Context,fCTR.b,buf^);
IncrementCTR;
inc(buf);
end;
inc(fBytesSinceSeed,Len);
inc(fTotalBytes,Len);
Len := Len and AESBlockMod;
if Len>0 then begin
TAESContext(fAES.Context).DoBlock(fAES.Context,fCTR.b,rnd);
IncrementCTR;
MoveFast(rnd,buf^,Len);
end;
fSafe^.UnLock;
end;
function TAESPRNG.FillRandom(Len: integer): RawByteString;
begin
SetString(result,nil,Len);
FillRandom(pointer(result),Len);
end;
function TAESPRNG.FillRandomBytes(Len: integer): TBytes;
begin
if Len<>length(result) then
result := nil;
SetLength(result,Len);
FillRandom(pointer(result),Len);
end;
function TAESPRNG.FillRandomHex(Len: integer): RawUTF8;
var bin: pointer;
begin
FastSetString(result,nil,Len*2);
if Len=0 then
exit;
bin := @PByteArray(result)[Len]; // temporary store random bytes at the end
FillRandom(bin,Len);
SynCommons.BinToHex(bin,pointer(result),Len);
end;
function TAESPRNG.Random32: cardinal;
var block: THash128Rec;
begin
FillRandom(block.b);
result := block.c0; // no need to XOR with c1, c2, c3 with a permutation algo
end;
function TAESPRNG.Random32(max: cardinal): cardinal;
var block: THash128Rec;
begin
FillRandom(block.b);
result := (Qword(block.c0)*max) shr 32; // no need to XOR with c1, c2, c3
end;
function TAESPRNG.Random64: QWord;
var block: THash128Rec;
begin
FillRandom(block.b);
result := block.L; // no need to XOR with H
end;
function Hash128ToExt({$ifdef FPC}constref{$else}const{$endif} r: THash128): TSynExtended;
const
COEFF64: TSynExtended = (1.0/$80000000)/$100000000; // 2^-63
begin
result := (THash128Rec(r).Lo and $7fffffffffffffff)*COEFF64;
end;
function Hash128ToDouble({$ifdef FPC}constref{$else}const{$endif} r: THash128): double;
const
COEFF64: double = (1.0/$80000000)/$100000000; // 2^-63
begin
result := (THash128Rec(r).Lo and $7fffffffffffffff)*COEFF64;
end;
function Hash128ToSingle({$ifdef FPC}constref{$else}const{$endif} r: THash128): double;
const
COEFF64: single = (1.0/$80000000)/$100000000; // 2^-63
begin
result := (THash128Rec(r).Lo and $7fffffffffffffff)*COEFF64;
end;
function TAESPRNG.RandomExt: TSynExtended;
var block: THash128;
begin
FillRandom(block);
result := Hash128ToExt(block);
end;
function TAESPRNG.RandomDouble: double;
var block: THash128;
begin
FillRandom(block);
result := Hash128ToDouble(block);
end;
function TAESPRNG.RandomPassword(Len: integer): RawUTF8;
const CHARS: array[0..127] of AnsiChar =
'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789'+
':bcd.fgh(jklmn)pqrst?vwxyz+BCD%FGH!JKLMN/PQRST@VWX#Z$.:()?%!-+*/@#';
var i: integer;
haspunct: boolean;
P: PAnsiChar;
begin
repeat
result := FillRandom(Len);
haspunct := false;
P := pointer(result);
for i := 1 to Len do begin
P^ := CHARS[ord(P^) mod sizeof(CHARS)];
if not haspunct and
not (ord(P^) in [ord('A')..ord('Z'),ord('a')..ord('z'),ord('0')..ord('9')]) then
haspunct := true;
inc(P);
end;
until (Len<=4) or (haspunct and (LowerCase(result)<>result));
end;
procedure SetMainAESPRNG;
begin
GlobalLock;
if MainAESPRNG=nil then
GarbageCollectorFreeAndNil(MainAESPRNG, TAESPRNG.Create);
GlobalUnLock;
end;
class function TAESPRNG.Main: TAESPRNG;
begin
if MainAESPRNG=nil then
SetMainAESPRNG;
result := MainAESPRNG;
end;
procedure AFDiffusion(buf,rnd: pointer; size: cardinal);
var sha: TSHA256;
dig: TSHA256Digest;
last, iv: cardinal;
i: integer;
begin
XorMemory(buf,rnd,size);
sha.Init;
last := size div SizeOf(dig);
for i := 0 to last-1 do begin
iv := bswap32(i); // host byte order independent hash IV (as in TKS1/LUKS)
sha.Update(@iv,SizeOf(iv));
sha.Update(buf,SizeOf(dig));
sha.Final(PSHA256Digest(buf)^);
inc(PByte(buf),SizeOf(dig));
end;
dec(size,last*SizeOf(dig));
if size=0 then
exit;
iv := bswap32(last);
sha.Update(@iv,SizeOf(iv));
sha.Update(buf,size);
sha.Final(dig);
MoveSmall(@dig,buf,size);
end;
function TAESPRNG.AFSplit(const Buffer; BufferBytes, StripesCount: integer): RawByteString;
var dst: pointer;
tmp: TByteDynArray;
i: integer;
begin
result := '';
if self<>nil then
SetLength(result,BufferBytes*(StripesCount+1));
if result='' then
exit;
dst := pointer(result);
SetLength(tmp,BufferBytes);
for i := 1 to StripesCount do begin
FillRandom(dst,BufferBytes);
AFDiffusion(pointer(tmp),dst,BufferBytes);
inc(PByte(dst),BufferBytes);
end;
XorMemory(dst,@Buffer,pointer(tmp),BufferBytes);
end;
function TAESPRNG.AFSplit(const Buffer: RawByteString; StripesCount: integer): RawByteString;
begin
result := AFSplit(pointer(Buffer)^,length(Buffer),StripesCount);
end;
class function TAESPRNG.AFUnsplit(const Split: RawByteString;
out Buffer; BufferBytes: integer): boolean;
var len: cardinal;
i: integer;
src: pointer;
tmp: TByteDynArray;
begin
len := length(Split);
result := (len<>0) and (len mod cardinal(BufferBytes)=0);
if not result then
exit;
src := pointer(Split);
SetLength(tmp,BufferBytes);
for i := 2 to len div cardinal(BufferBytes) do begin
AFDiffusion(pointer(tmp),src,BufferBytes);
inc(PByte(src),BufferBytes);
end;
XorMemory(@Buffer,src,pointer(tmp),BufferBytes);
end;
class function TAESPRNG.AFUnsplit(const Split: RawByteString;
StripesCount: integer): RawByteString;
var len: cardinal;
begin
result := '';
len := length(Split);
if (len=0) or (len mod cardinal(StripesCount+1)<>0) then
exit;
len := len div cardinal(StripesCount+1);
SetLength(result,len);
if not AFUnsplit(Split,pointer(result)^,len) then
result := '';
end;
class procedure TAESPRNG.Fill(Buffer: pointer; Len: integer);
begin
Main.FillRandom(Buffer,Len);
end;
class procedure TAESPRNG.Fill(out Block: TAESBlock);
begin
Main.FillRandom(Block);
end;
class procedure TAESPRNG.Fill(out Block: THash256);
begin
Main.FillRandom(Block);
end;
class function TAESPRNG.Fill(Len: integer): RawByteString;
begin
result := Main.FillRandom(Len);
end;
class function TAESPRNG.Bytes(Len: integer): TBytes;
begin
result := Main.FillRandomBytes(Len);
end;
{ TAESPRNGSystem }
constructor TAESPRNGSystem.Create;
begin
inherited Create(0,0);
end;
procedure TAESPRNGSystem.FillRandom(out Block: TAESBlock);
begin
FillRandom(@Block,sizeof(Block));
end;
procedure TAESPRNGSystem.FillRandom(Buffer: pointer; Len: integer);
begin
FillSystemRandom(Buffer,Len,false);
end;
procedure TAESPRNGSystem.Seed;
begin // do nothing
end;
{ TRC4 }
procedure TRC4.Init(const aKey; aKeyLen: integer);
var i,k: integer;
j,tmp: PtrInt;
begin
if aKeyLen<=0 then
raise ESynCrypto.CreateUTF8('TRC4.Init(invalid aKeyLen=%)',[aKeyLen]);
dec(aKeyLen);
for i := 0 to high(state) do
state[i] := i;
j := 0;
k := 0;
for i := 0 to high(state) do begin
j := (j+state[i]+TByteArray(aKey)[k]) and $ff;
tmp := state[i];
state[i] := state[j];
state[j] := tmp;
if k>=aKeyLen then // avoid slow mod operation within loop
k := 0 else
inc(k);
end;
currI := 0;
currJ := 0;
end;
procedure TRC4.InitSHA3(const aKey; aKeyLen: integer);
var sha: TSHA3;
dig: array[byte] of byte; // max RC4 state size is 256 bytes
begin
sha.Full(SHAKE_128,@aKey,aKeyLen,@dig,SizeOf(dig)shl 3); // XOF mode
Init(dig,SizeOf(dig));
FillCharFast(dig,SizeOf(dig),0);
Drop(3072);
end;
procedure TRC4.EncryptBuffer(BufIn, BufOut: PByte; Count: cardinal);
var i,j,ki,kj: PtrInt;
by4: array[0..3] of byte;
begin
i := currI;
j := currJ;
while Count>3 do begin
dec(Count,4);
i := (i+1) and $ff;
ki := State[i];
j := (j+ki) and $ff;
kj := (ki+State[j]) and $ff;
State[i] := State[j];
i := (i+1) and $ff;
State[j] := ki;
ki := State[i];
by4[0] := State[kj];
j := (j+ki) and $ff;
kj := (ki+State[j]) and $ff;
State[i] := State[j];
i := (i+1) and $ff;
State[j] := ki;
by4[1] := State[kj];
ki := State[i];
j := (j+ki) and $ff;
kj := (ki+State[j]) and $ff;
State[i] := State[j];
i := (i+1) and $ff;
State[j] := ki;
by4[2] := State[kj];
ki := State[i];
j := (j+ki) and $ff;
kj := (ki+State[j]) and $ff;
State[i] := State[j];
State[j] := ki;
by4[3] := State[kj];
PCardinal(BufOut)^ := PCardinal(BufIn)^ xor cardinal(by4);
inc(BufIn,4);
inc(BufOut,4);
end;
while Count>0 do begin
dec(Count);
i := (i+1) and $ff;
ki := State[i];
j := (j+ki) and $ff;
kj := (ki+State[j]) and $ff;
State[i] := State[j];
State[j] := ki;
BufOut^ := BufIn^ xor State[kj];
inc(BufIn);
inc(BufOut);
end;
currI := i;
currJ := j;
end;
procedure TRC4.Encrypt(const BufIn; var BufOut; Count: cardinal);
begin
EncryptBuffer(@BufIn,@BufOut,Count);
end;
procedure TRC4.Drop(Count: cardinal);
var i,j,ki: PtrInt;
begin
i := currI;
j := currJ;
while Count>0 do begin
dec(Count);
i := (i+1) and $ff;
ki := state[i];
j := (j+ki) and $ff;
state[i] := state[j];
state[j] := ki;
end;
currI := i;
currJ := j;
end;
function RC4SelfTest: boolean;
const
Key: array[0..4] of byte = ($61,$8A,$63,$D2,$FB);
InDat: array[0..4] of byte = ($DC,$EE,$4C,$F9,$2C);
OutDat: array[0..4] of byte = ($F1,$38,$29,$C9,$DE);
Test1: array[0..7] of byte = ($01,$23,$45,$67,$89,$ab,$cd,$ef);
Res1: array[0..7] of byte = ($75,$b7,$87,$80,$99,$e0,$c5,$96);
Key2: array[0..3] of byte = ($ef,$01,$23,$45);
Test2: array[0..9] of byte = (0,0,0,0,0,0,0,0,0,0);
Res2: array[0..9] of byte = ($d6,$a1,$41,$a7,$ec,$3c,$38,$df,$bd,$61);
var RC4: TRC4;
Dat: array[0..9] of byte;
Backup: TRC4;
begin
RC4.Init(Test1,8);
RC4.Encrypt(Test1,Dat,8);
result := CompareMem(@Dat,@Res1,sizeof(Res1));
RC4.Init(Key2,4);
RC4.Encrypt(Test2,Dat,10);
result := result and CompareMem(@Dat,@Res2,sizeof(Res2));
RC4.Init(Key,sizeof(Key));
RC4.Encrypt(InDat,Dat,sizeof(InDat));
result := result and CompareMem(@Dat,@OutDat,sizeof(OutDat));
RC4.Init(Key,sizeof(Key));
Backup := RC4;
RC4.Encrypt(InDat,Dat,sizeof(InDat));
result := result and CompareMem(@Dat,@OutDat,sizeof(OutDat));
RC4 := Backup;
RC4.Encrypt(InDat,Dat,sizeof(InDat));
result := result and CompareMem(@Dat,@OutDat,sizeof(OutDat));
RC4 := Backup;
RC4.Encrypt(OutDat,Dat,sizeof(InDat));
result := result and CompareMem(@Dat,@InDat,sizeof(OutDat));
end;
procedure CompressShaAesSetKey(const Key: RawByteString; AesClass: TAESAbstractClass);
begin
if Key='' then
FillZero(CompressShaAesKey) else
SHA256Weak(Key,CompressShaAesKey);
end;
function CompressShaAes(var DataRawByteString; Compress: boolean): AnsiString;
var Data: RawByteString absolute DataRawByteString;
begin
if (Data<>'') and (CompressShaAesClass<>nil) then
try
with CompressShaAesClass.Create(CompressShaAesKey,256) do
try
if Compress then begin
CompressSynLZ(Data,true);
Data := EncryptPKCS7(Data,{IVAtBeginning=}true);
end else begin
Data := DecryptPKCS7(Data,{IVAtBeginning=}true);
if CompressSynLZ(Data,false)='' then begin
result := '';
exit; // invalid content
end;
end;
finally
Free;
end;
except
on Exception do begin // e.g. ESynCrypto in DecryptPKCS7(Data)
result := '';
exit; // invalid content
end;
end;
result := 'synshaaes'; // mark success
end;
{ THash128History }
procedure THash128History.Init(size, maxsize: integer);
begin
Depth := maxsize;
SetLength(Previous,size);
Count := 0;
Index := 0;
end;
function THash128History.Exists(const hash: THash128): boolean;
begin
if Count = 0 then
result := false else
result := Hash128Index(pointer(Previous),Count,@hash)>=0;
end;
function THash128History.Add(const hash: THash128): boolean;
var n: integer;
begin
result := Hash128Index(pointer(Previous),Count,@hash)<0;
if not result then
exit;
Previous[Index].b := hash;
inc(Index);
if Index>=length(Previous) then
if Index=Depth then
Index := 0 else begin
n := NextGrow(Index);
if n>=Depth then
n := Depth;
SetLength(Previous,n);
end;
if Count<Depth then
inc(Count);
end;
{$ifdef MSWINDOWS}
type
{$ifdef FPC}
{$PACKRECORDS C} // mandatory under Win64
{$endif}
DATA_BLOB = record
cbData: DWORD;
pbData: PAnsiChar;
end;
PDATA_BLOB = ^DATA_BLOB;
{$ifdef FPC}
{$PACKRECORDS DEFAULT}
{$endif}
const
CRYPTPROTECT_UI_FORBIDDEN = $1;
CRYPTDLL = 'Crypt32.dll';
function CryptProtectData(const DataIn: DATA_BLOB; szDataDescr: PWideChar;
OptionalEntropy: PDATA_BLOB; Reserved, PromptStruct: Pointer; dwFlags: DWORD;
var DataOut: DATA_BLOB): BOOL; stdcall; external CRYPTDLL name 'CryptProtectData';
function CryptUnprotectData(const DataIn: DATA_BLOB; szDataDescr: PWideChar;
OptionalEntropy: PDATA_BLOB; Reserved, PromptStruct: Pointer; dwFlags: DWORD;
var DataOut: DATA_BLOB): Bool; stdcall; external CRYPTDLL name 'CryptUnprotectData';
function CryptDataForCurrentUserDPAPI(const Data,AppSecret: RawByteString; Encrypt: boolean): RawByteString;
var src,dst,ent: DATA_BLOB;
e: PDATA_BLOB;
ok: boolean;
begin
src.pbData := pointer(Data);
src.cbData := length(Data);
if AppSecret<>'' then begin
ent.pbData := pointer(AppSecret);
ent.cbData := length(AppSecret);
e := @ent;
end else
e := nil;
if Encrypt then
ok := CryptProtectData(src,nil,e,nil,nil,CRYPTPROTECT_UI_FORBIDDEN,dst) else
ok := CryptUnprotectData(src,nil,e,nil,nil,CRYPTPROTECT_UI_FORBIDDEN,dst);
if ok then begin
SetString(result,dst.pbData,dst.cbData);
LocalFree(HLOCAL(dst.pbData));
end else
result := '';
end;
{$endif MSWINDOWS}
var
__h: THash256;
__hmac: THMAC_SHA256; // initialized from CryptProtectDataEntropy salt
procedure read__h__hmac;
var keyfile: TFileName;
instance: THash256;
key,key2,appsec: RawByteString;
begin
__hmac.Init(@CryptProtectDataEntropy,32);
SetString(appsec,PAnsiChar(@CryptProtectDataEntropy),32);
PBKDF2_HMAC_SHA256(appsec,ExeVersion.User,100,instance);
FillZero(appsec);
appsec := BinToBase64URI(@instance,15); // local file has 21 chars length
FormatString({$ifdef MSWINDOWS}'%_%'{$else}'%.syn-%'{$endif},
[GetSystemPath(spUserData),appsec], string(keyfile)); // .* files are hidden under Linux
SetString(appsec,PAnsiChar(@instance[15]),17); // use remaining bytes as key
try
key := StringFromFile(keyfile);
if key<>'' then begin
try
key2 := TAESCFB.SimpleEncrypt(key,appsec,false,true);
except
key2 := ''; // handle decryption error
end;
FillZero(key);
{$ifdef MSWINDOWS}
key := CryptDataForCurrentUserDPAPI(key2,appsec,false);
{$else}
key := key2;
{$endif}
if TAESPRNG.AFUnsplit(key,__h,sizeof(__h)) then
exit; // successfully extracted secret key in __h
end;
if FileExists(keyfile) then // allow rewrite of invalid local file
{$ifdef MSWINDOWS}
SetFileAttributes(pointer(keyfile),FILE_ATTRIBUTE_NORMAL);
{$else}
{$ifdef FPC}fpchmod{$else}chmod{$endif}(pointer(keyfile),S_IRUSR or S_IWUSR);
{$endif}
TAESPRNG.Main.FillRandom(__h);
key := TAESPRNG.Main.AFSplit(__h,sizeof(__h),126);
{$ifdef MSWINDOWS} // 4KB local file, DPAPI-cyphered but with no DPAPI BLOB layout
key2 := CryptDataForCurrentUserDPAPI(key,appsec,true);
FillZero(key);
{$else} // 4KB local chmod 400 hidden file in $HOME folder under Linux/POSIX
key2 := key;
{$endif}
key := TAESCFB.SimpleEncrypt(key2,appsec,true,true);
if not FileFromString(key,keyfile) then
ESynCrypto.CreateUTF8('Unable to write %',[keyfile]);
{$ifdef MSWINDOWS}
SetFileAttributes(pointer(keyfile),FILE_ATTRIBUTE_HIDDEN or FILE_ATTRIBUTE_READONLY);
{$else}
{$ifdef FPC}fpchmod{$else}chmod{$endif}(pointer(keyfile),S_IRUSR);
{$endif}
finally
FillZero(key);
FillZero(key2);
FillZero(appsec);
FillZero(instance);
end;
end;
function CryptDataForCurrentUser(const Data,AppSecret: RawByteString; Encrypt: boolean): RawByteString;
var hmac: THMAC_SHA256;
secret: THash256;
begin
result := '';
if Data='' then
exit;
if IsZero(__h) then
read__h__hmac;
try
hmac := __hmac; // thread-safe reuse of CryptProtectDataEntropy salt
hmac.Update(AppSecret);
hmac.Update(__h);
hmac.Done(secret);
result := TAESCFBCRC.MACEncrypt(Data,secret,Encrypt);
finally
FillZero(secret);
end;
end;
{ TProtocolNone }
function TProtocolNone.ProcessHandshake(
const MsgIn: RawUTF8; out MsgOut: RawUTF8): TProtocolResult;
begin
result := sprUnsupported;
end;
function TProtocolNone.Decrypt(const aEncrypted: RawByteString;
out aPlain: RawByteString): TProtocolResult;
begin
aPlain := aEncrypted;
result := sprSuccess;
end;
procedure TProtocolNone.Encrypt(const aPlain: RawByteString;
out aEncrypted: RawByteString);
begin
aEncrypted := aPlain;
end;
function TProtocolNone.Clone: IProtocol;
begin
result := TProtocolNone.Create;
end;
{ TProtocolAES }
constructor TProtocolAES.Create(aClass: TAESAbstractClass; const aKey;
aKeySize: cardinal; aIVReplayAttackCheck: TAESIVReplayAttackCheck);
begin
inherited Create;
fAES[false] := aClass.Create(aKey,aKeySize);
fAES[false].IVReplayAttackCheck := aIVReplayAttackCheck;
fAES[true] := fAES[false].Clone;
end;
constructor TProtocolAES.CreateFrom(aAnother: TProtocolAES);
begin
inherited Create;
fAES[false] := aAnother.fAES[false].Clone;
fAES[true] := fAES[false].Clone;
end;
destructor TProtocolAES.Destroy;
begin
fAES[false].Free;
fAES[true].Free;
inherited Destroy;
end;
function TProtocolAES.ProcessHandshake(
const MsgIn: RawUTF8; out MsgOut: RawUTF8): TProtocolResult;
begin
result := sprUnsupported;
end;
function TProtocolAES.Decrypt(const aEncrypted: RawByteString;
out aPlain: RawByteString): TProtocolResult;
begin
fSafe.Lock;
try
try
aPlain := fAES[false].DecryptPKCS7(aEncrypted,{iv=}true,{raise=}false);
if aPlain='' then
result := sprBadRequest else
result := sprSuccess;
except
result := sprInvalidMAC;
end;
finally
fSafe.UnLock;
end;
end;
procedure TProtocolAES.Encrypt(const aPlain: RawByteString;
out aEncrypted: RawByteString);
begin
fSafe.Lock;
try
aEncrypted := fAES[true].EncryptPKCS7(aPlain,{IVAtBeginning=}true);
finally
fSafe.UnLock;
end;
end;
function TProtocolAES.Clone: IProtocol;
begin
result := TProtocolAESClass(ClassType).CreateFrom(self);
end;
{$ifndef NOVARIANTS}
{ TJWTAbstract }
constructor TJWTAbstract.Create(const aAlgorithm: RawUTF8;
aClaims: TJWTClaims; const aAudience: array of RawUTF8; aExpirationMinutes: integer;
aIDIdentifier: TSynUniqueIdentifierProcess; aIDObfuscationKey: RawUTF8);
begin
if aAlgorithm='' then
raise EJWTException.CreateUTF8('%.Create(algo?)',[self]);
inherited Create;
if high(aAudience)>=0 then begin
fAudience := TRawUTF8DynArrayFrom(aAudience);
include(aClaims,jrcAudience);
end;
if aExpirationMinutes>0 then begin
include(aClaims,jrcExpirationTime);
fExpirationSeconds := aExpirationMinutes*60;
end else
exclude(aClaims,jrcExpirationTime);
fAlgorithm := aAlgorithm;
fClaims := aClaims;
if jrcJwtID in aClaims then
fIDGen := TSynUniqueIdentifierGenerator.Create(aIDIdentifier,aIDObfuscationKey);
if fHeader='' then
FormatUTF8('{"alg":"%","typ":"JWT"}',[aAlgorithm],fHeader);
fHeaderB64 := BinToBase64URI(fHeader)+'.';
fCacheResults := [jwtValid];
end;
destructor TJWTAbstract.Destroy;
begin
fIDGen.Free;
fCache.Free;
inherited;
end;
const
JWT_MAXSIZE = 4096; // coherent with HTTP headers limitations
function TJWTAbstract.Compute(const DataNameValue: array of const;
const Issuer, Subject, Audience: RawUTF8; NotBefore: TDateTime;
ExpirationMinutes: integer; Signature: PRawUTF8): RawUTF8;
var payload, headpayload, signat: RawUTF8;
begin
result := '';
if self=nil then
exit;
payload := PayloadToJSON(DataNameValue,Issuer,Subject,Audience,NotBefore,ExpirationMinutes);
headpayload := fHeaderB64+BinToBase64URI(payload);
signat := ComputeSignature(headpayload);
result := headpayload+'.'+signat;
if length(result)>JWT_MAXSIZE then
raise EJWTException.CreateUTF8('%.Compute oversize: len=%',[self,length(result)]);
if Signature<>nil then
Signature^ := signat;
end;
function TJWTAbstract.ComputeAuthorizationHeader(const DataNameValue: array of const;
const Issuer, Subject, Audience: RawUTF8; NotBefore: TDateTime;
ExpirationMinutes: integer): RawUTF8;
begin
if self=nil then
result := '' else
result := 'Bearer '+
Compute(DataNameValue,Issuer,Subject,Audience,NotBefore,ExpirationMinutes);
end;
function TJWTAbstract.PayloadToJSON(const DataNameValue: array of const;
const Issuer, Subject, Audience: RawUTF8; NotBefore: TDateTime;
ExpirationMinutes: cardinal): RawUTF8;
procedure RaiseMissing(c: TJWTClaim);
begin
raise EJWTException.CreateUTF8('%.PayloadJSON: missing %', [self, ToText(c)^]);
end;
var payload: TDocVariantData;
begin
result := '';
payload.InitObject(DataNameValue,JSON_OPTIONS_FAST);
if jrcIssuer in fClaims then
if Issuer='' then
RaiseMissing(jrcIssuer) else
payload.AddValueFromText(JWT_CLAIMS_TEXT[jrcIssuer],Issuer,true);
if jrcSubject in fClaims then
if Subject='' then
RaiseMissing(jrcSubject) else
payload.AddValueFromText(JWT_CLAIMS_TEXT[jrcSubject],Subject,true);
if jrcAudience in fClaims then
if Audience='' then
RaiseMissing(jrcAudience) else
if Audience[1]='[' then
payload.AddOrUpdateValue(JWT_CLAIMS_TEXT[jrcAudience],_JsonFast(Audience)) else
payload.AddValueFromText(JWT_CLAIMS_TEXT[jrcAudience],Audience,true);
if jrcNotBefore in fClaims then
if NotBefore<=0 then
payload.AddOrUpdateValue(JWT_CLAIMS_TEXT[jrcNotBefore],UnixTimeUTC) else
payload.AddOrUpdateValue(JWT_CLAIMS_TEXT[jrcNotBefore],DateTimeToUnixTime(NotBefore));
if jrcIssuedAt in fClaims then
payload.AddOrUpdateValue(JWT_CLAIMS_TEXT[jrcIssuedAt],UnixTimeUTC);
if jrcExpirationTime in fClaims then begin
if ExpirationMinutes=0 then
ExpirationMinutes := fExpirationSeconds else
ExpirationMinutes := ExpirationMinutes*60;
payload.AddOrUpdateValue(JWT_CLAIMS_TEXT[jrcExpirationTime],UnixTimeUTC+ExpirationMinutes);
end;
if jrcJwtID in fClaims then
if joNoJwtIDGenerate in fOptions then begin
if payload.GetValueIndex(JWT_CLAIMS_TEXT[jrcJwtID])<0 then
exit; // not generated, but should be supplied
end else
payload.AddValueFromText(JWT_CLAIMS_TEXT[jrcJwtID],fIDGen.ToObfuscated(fIDGen.ComputeNew));
result := payload.ToJSON;
end;
procedure TJWTAbstract.SetCacheTimeoutSeconds(value: integer);
begin
fCacheTimeoutSeconds := value;
FreeAndNil(fCache);
if (value>0) and (fCacheResults<>[]) then
fCache := TSynDictionary.Create(TypeInfo(TRawUTF8DynArray),
TypeInfo(TJWTContentDynArray),false,value);
end;
procedure TJWTAbstract.Verify(const Token: RawUTF8; out JWT: TJWTContent;
ExcludedClaims: TJWTClaims);
var headpayload: RawUTF8;
signature: RawByteString;
fromcache: boolean;
begin
JWT.result := jwtNoToken;
if (self=nil) or (fCache=nil) then
fromcache := false else begin
fromcache := fCache.FindAndCopy(Token,JWT);
fCache.DeleteDeprecated;
end;
if not fromcache then
Parse(Token,JWT,headpayload,signature,ExcludedClaims);
if JWT.result in [jwtValid,jwtNotBeforeFailed] then
if CheckAgainstActualTimestamp(JWT) and not fromcache then
CheckSignature(headpayload,signature,JWT); // depending on the algorithm used
if not fromcache and (self<>nil) and (fCache<>nil) and (JWT.result in fCacheResults) then
fCache.Add(Token,JWT);
end;
function TJWTAbstract.Verify(const Token: RawUTF8): TJWTResult;
var jwt: TJWTContent;
begin
Verify(Token,jwt);
result := jwt.result;
end;
function TJWTAbstract.CheckAgainstActualTimestamp(var JWT: TJWTContent): boolean;
var nowunix, unix: cardinal;
begin
if [jrcExpirationTime,jrcNotBefore,jrcIssuedAt]*JWT.claims<>[] then begin
result := false;
nowunix := UnixTimeUTC; // validate against actual timestamp
if jrcExpirationTime in JWT.claims then
if not ToCardinal(JWT.reg[jrcExpirationTime],unix) or (nowunix>unix) then begin
JWT.result := jwtExpired;
exit;
end;
if jrcNotBefore in JWT.claims then
if not ToCardinal(JWT.reg[jrcNotBefore],unix) or (nowunix<unix) then begin
JWT.result := jwtNotBeforeFailed;
exit;
end;
if jrcIssuedAt in JWT.claims then // allow 1 minute time lap between nodes
if not ToCardinal(JWT.reg[jrcIssuedAt],unix) or (unix>nowunix+60) then begin
JWT.result := jwtInvalidIssuedAt;
exit;
end;
end;
result := true;
JWT.result := jwtValid;
end;
procedure TJWTAbstract.Parse(const Token: RawUTF8; var JWT: TJWTContent;
out headpayload: RawUTF8; out signature: RawByteString; excluded: TJWTClaims);
var payloadend,j,toklen,c,cap,headerlen,len,a: integer;
P: PUTF8Char;
N,V: PUTF8Char;
wasString: boolean;
EndOfObject: AnsiChar;
claim: TJWTClaim;
requiredclaims: TJWTClaims;
id: TSynUniqueIdentifierBits;
value: variant;
payload: RawUTF8;
head: array[0..1] of TValuePUTF8Char;
aud: TDocVariantData;
tok: PAnsiChar absolute Token;
begin
// 0. initialize parsing
Finalize(JWT.reg);
JWT.data.InitFast(0,dvObject); // custom claims
byte(JWT.claims) := 0;
word(JWT.audience) := 0;
toklen := length(Token);
if (toklen=0) or (self=nil) then begin
JWT.result := jwtNoToken;
exit;
end;
// 1. validate the header (including algorithm "alg" verification)
JWT.result := jwtInvalidAlgorithm;
if joHeaderParse in fOptions then begin // slower parsing
headerlen := PosExChar('.',Token);
if (headerlen=0) or (headerlen>512) then
exit;
Base64URIToBin(tok,headerlen-1,signature);
JSONDecode(pointer(signature),['alg','typ'],@head);
if not head[0].Idem(fAlgorithm) or
((head[1].Value<>nil) and not head[1].Idem('JWT')) then
exit;
end else begin // fast direct compare of fHeaderB64 (including "alg")
headerlen := length(fHeaderB64);
if (toklen<=headerlen) or not CompareMem(pointer(fHeaderB64),tok,headerlen) then
exit;
end;
// 2. extract the payload
JWT.result := jwtWrongFormat;
if toklen>JWT_MAXSIZE Then
exit;
payloadend := PosEx('.',Token,headerlen+1);
if (payloadend=0) or (payloadend-headerlen>2700) then
exit;
Base64URIToBin(tok+payloadend,toklen-payloadend,signature);
if (signature='') and (payloadend<>toklen) then
exit;
JWT.result := jwtInvalidPayload;
Base64URIToBin(tok+headerlen,payloadend-headerlen-1,RawByteString(payload));
if payload='' then
exit;
// 3. decode the payload into JWT.reg[]/JWT.claims (known) and JWT.data (custom)
P := GotoNextNotSpace(pointer(payload));
if P^<>'{' then
exit;
P := GotoNextNotSpace(P+1);
cap := JSONObjectPropCount(P);
if cap<0 then
exit;
requiredclaims := fClaims - excluded;
if cap>0 then
repeat
N := GetJSONPropName(P);
if N=nil then
exit;
V := GetJSONFieldOrObjectOrArray(P,@wasstring,@EndOfObject,true);
len := StrLen(N);
if (len=3) and (V<>nil) then begin
c := PInteger(N)^;
for claim := low(claim) to high(claim) do
if PInteger(JWT_CLAIMS_TEXT[claim])^=c then begin
if V^=#0 then
exit;
include(JWT.claims,claim);
if not(claim in fClaims) and not(joAllowUnexpectedClaims in fOptions) then begin
JWT.result := jwtUnexpectedClaim;
exit;
end;
FastSetString(JWT.reg[claim],V,StrLen(V));
if claim in requiredclaims then
case claim of
jrcJwtID:
if not(joNoJwtIDCheck in fOptions) then
if not fIDGen.FromObfuscated(JWT.reg[jrcJwtID],id.Value) or
(id.CreateTimeUnix<UNIXTIME_MINIMAL) then begin
JWT.result := jwtInvalidID;
exit;
end;
jrcAudience:
if JWT.reg[jrcAudience][1]='[' then begin
aud.InitJSON(JWT.reg[jrcAudience],JSON_OPTIONS_FAST);
if aud.Count=0 then
exit;
for j := 0 to aud.Count-1 do begin
a := FindRawUTF8(fAudience,VariantToUTF8(aud.Values[j]));
if a<0 then begin
JWT.result := jwtUnknownAudience;
if not (joAllowUnexpectedAudience in fOptions) then
exit;
end else
include(JWT.audience,a);
end;
aud.Clear;
end else begin
a := FindRawUTF8(fAudience,JWT.reg[jrcAudience]);
if a<0 then begin
JWT.result := jwtUnknownAudience;
if not (joAllowUnexpectedAudience in fOptions) then
exit;
end else
include(JWT.audience,a);
end;
end;
len := 0; // don't add to JWT.data
dec(cap);
break;
end;
if len=0 then
continue;
end;
GetVariantFromJSON(V,wasString,value,@JSON_OPTIONS[true],joDoubleInData in fOptions);
if JWT.data.Count=0 then
JWT.data.Capacity := cap;
JWT.data.AddValue(N,len,value)
until (EndOfObject='}') or (P=nil);
if JWT.data.Count>0 then
JWT.data.Capacity := JWT.data.Count;
if requiredclaims-JWT.claims<>[] then
JWT.result := jwtMissingClaim else begin
FastSetString(headpayload,tok,payloadend-1);
JWT.result := jwtValid;
end;
end;
function TJWTAbstract.VerifyAuthorizationHeader(const HttpAuthorizationHeader: RawUTF8;
out JWT: TJWTContent): boolean;
begin
if (cardinal(length(HttpAuthorizationHeader)-10)>4096) or
not IdemPChar(pointer(HttpAuthorizationHeader), 'BEARER ') then
JWT.result := jwtWrongFormat else
Verify(copy(HttpAuthorizationHeader,8,maxInt),JWT);
result := JWT.result=jwtValid;
end;
class function TJWTAbstract.VerifyPayload(const Token, ExpectedSubject, ExpectedIssuer,
ExpectedAudience: RawUTF8; Expiration: PUnixTime; Signature: PRawUTF8; Payload: PVariant;
IgnoreTime: boolean; NotBeforeDelta: TUnixTime): TJWTResult;
var P,B: PUTF8Char;
V: array[0..4] of TValuePUTF8Char;
now, time: PtrUInt;
text: RawUTF8;
begin
result := jwtInvalidAlgorithm;
B := pointer(Token);
P := PosChar(B,'.');
if P=nil then
exit;
if self<>TJWTAbstract then begin
text := Base64URIToBin(PAnsiChar(B),P-B);
if not IdemPropNameU(copy(ToText(self),5,10),JSONDecode(text,'alg')) then
exit;
end;
B := P+1;
P := PosChar(B,'.');
result := jwtInvalidSignature;
if P=nil then
exit;
result := jwtInvalidPayload;
text := Base64URIToBin(PAnsiChar(B),P-B);
if text='' then
exit;
if Payload<>nil then
_Json(text,Payload^,JSON_OPTIONS_FAST);
JSONDecode(pointer(text),['iss','aud','exp','nbf','sub'],@V,true);
result := jwtUnexpectedClaim;
if ((ExpectedSubject<>'') and not V[4].Idem(ExpectedSubject)) or
((ExpectedIssuer<>'') and not V[0].Idem(ExpectedIssuer)) then
exit;
result := jwtUnknownAudience;
if (ExpectedAudience<>'') and not V[1].Idem(ExpectedAudience) then
exit;
if Expiration<>nil then
Expiration^ := 0;
if (V[2].Value<>nil) or (V[3].Value<>nil) then begin
now := UnixTimeUTC;
if V[2].Value<>nil then begin
time := V[2].ToCardinal;
result := jwtExpired;
if not IgnoreTime and (now>time) then
exit;
if Expiration<>nil then
Expiration^ := time;
end;
if not IgnoreTime and (V[3].Value<>nil) then begin
time := V[3].ToCardinal;
result := jwtNotBeforeFailed;
if (time=0) or (now+PtrUInt(NotBeforeDelta)<time) then
exit;
end;
end;
inc(P);
if Signature<>nil then
FastSetString(Signature^,P,StrLen(P));
result := jwtValid;
end;
{ TJWTNone }
constructor TJWTNone.Create(aClaims: TJWTClaims;
const aAudience: array of RawUTF8; aExpirationMinutes: integer;
aIDIdentifier: TSynUniqueIdentifierProcess; aIDObfuscationKey: RawUTF8);
begin
fHeader := '{"alg":"none"}'; // "typ":"JWT" is optional, so we save a few bytes
inherited Create('none',aClaims,aAudience,aExpirationMinutes,
aIDIdentifier,aIDObfuscationKey);
end;
procedure TJWTNone.CheckSignature(const headpayload: RawUTF8; const signature: RawByteString;
var JWT: TJWTContent);
begin
if signature='' then // JWA defined empty string for "none" JWS
JWT.result := jwtValid else
JWT.result := jwtInvalidSignature;
end;
function TJWTNone.ComputeSignature(const headpayload: RawUTF8): RawUTF8;
begin
result := '';
end;
{ TJWTSynSignerAbstract }
constructor TJWTSynSignerAbstract.Create(const aSecret: RawUTF8;
aSecretPBKDF2Rounds: integer; aClaims: TJWTClaims; const aAudience: array of RawUTF8;
aExpirationMinutes: integer; aIDIdentifier: TSynUniqueIdentifierProcess;
aIDObfuscationKey: RawUTF8; aPBKDF2Secret: PHash512Rec);
var algo: TSignAlgo;
begin
algo := GetAlgo;
inherited Create(JWT_TEXT[algo],aClaims,aAudience,
aExpirationMinutes,aIDIdentifier,aIDObfuscationKey);
if (aSecret<>'') and (aSecretPBKDF2Rounds>0) then
fSignPrepared.Init(algo,aSecret,fHeaderB64,aSecretPBKDF2Rounds,aPBKDF2Secret) else
fSignPrepared.Init(algo,aSecret);
end;
procedure TJWTSynSignerAbstract.CheckSignature(const headpayload: RawUTF8;
const signature: RawByteString; var JWT: TJWTContent);
var signer: TSynSigner;
temp: THash512Rec;
begin
JWT.result := jwtInvalidSignature;
if length(signature)<>SignatureSize then
exit;
signer := fSignPrepared; // thread-safe re-use of prepared TSynSigner
signer.Update(pointer(headpayload),length(headpayload));
signer.Final(temp);
{ writeln('payload=',headpayload);
writeln('sign=',bintohex(@temp,SignatureSize));
writeln('expected=',bintohex(pointer(signature),SignatureSize)); }
if CompareMem(@temp,pointer(signature),SignatureSize) then
JWT.result := jwtValid;
end;
function TJWTSynSignerAbstract.ComputeSignature(const headpayload: RawUTF8): RawUTF8;
var signer: TSynSigner;
temp: THash512Rec;
begin
signer := fSignPrepared;
signer.Update(pointer(headpayload),length(headpayload));
signer.Final(temp);
result := BinToBase64URI(@temp,SignatureSize);
end;
destructor TJWTSynSignerAbstract.Destroy;
begin
FillCharFast(fSignPrepared,SizeOf(fSignPrepared),0);
inherited Destroy;
end;
{ TJWTHS256 }
function TJWTHS256.GetAlgo: TSignAlgo;
begin
result := saSha256;
end;
{ TJWTHS384 }
function TJWTHS384.GetAlgo: TSignAlgo;
begin
result := saSha384;
end;
{ TJWTHS512 }
function TJWTHS512.GetAlgo: TSignAlgo;
begin
result := saSha512;
end;
{ TJWTS3224 }
function TJWTS3224.GetAlgo: TSignAlgo;
begin
result := saSha3224;
end;
{ TJWTS3256 }
function TJWTS3256.GetAlgo: TSignAlgo;
begin
result := saSha3256;
end;
{ TJWTS3384 }
function TJWTS3384.GetAlgo: TSignAlgo;
begin
result := saSha3384;
end;
{ TJWTS3512 }
function TJWTS3512.GetAlgo: TSignAlgo;
begin
result := saSha3512;
end;
{ TJWTS3S128 }
function TJWTS3S128.GetAlgo: TSignAlgo;
begin
result := saSha3S128;
end;
{ TJWTS3S256 }
function TJWTS3S256.GetAlgo: TSignAlgo;
begin
result := saSha3S256;
end;
var
_TJWTResult: array[TJWTResult] of PShortString;
_TJWTClaim: array[TJWTClaim] of PShortString;
function ToText(res: TJWTResult): PShortString;
begin
result := _TJWTResult[res];
end;
function ToCaption(res: TJWTResult): string;
begin
GetCaptionFromTrimmed(_TJWTResult[res],result);
end;
function ToText(claim: TJWTClaim): PShortString;
begin
result := _TJWTClaim[claim];
end;
function ToText(claims: TJWTClaims): ShortString;
begin
GetSetNameShort(TypeInfo(TJWTClaims),claims,result);
end;
{$endif NOVARIANTS}
{$ifdef CRC32C_X64}
{ ISCSI CRC 32 Implementation with crc32 and pclmulqdq Instruction
Copyright(c) 2011-2015 Intel Corporation All rights reserved.
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.
* Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in
the documentation and/or other materials provided with the
distribution.
* Neither the name of Intel Corporation nor the names of its
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
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 COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICESLOSS OF USE,
DATA, OR PROFITSOR 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. }
{$ifdef FPC}
{$ifdef MSWINDOWS}
{$L crc32c64.obj}
{$else}
{$L static/x86_64-linux/crc32c64.o}
{$endif}
{$else}
{$L crc32c64.obj}
{$endif}
// defined in SynCrypto.pas, not in SynCommons.pas, to avoid .o/.obj dependencies
function crc32_iscsi_01(buf: PAnsiChar; len: PtrUInt; crc: cardinal): cardinal; {$ifdef FPC}cdecl;{$endif} external;
function crc32c_sse42_aesni(crc: PtrUInt; buf: PAnsiChar; len: PtrUInt): cardinal;
{$ifdef FPC}nostackframe; assembler; asm{$else}asm .noframe {$endif}
mov rax, crc
mov rcx, len
not eax
test buf, buf
jz @z
cmp len, 64
jb @sml
// our call: rcx/rdi=crc rdx/rsi=buf r8/rdx=len
// iscsi_01: rcx/rdi=buf rdx/rsi=len r8/rdx=crc
mov crc, buf
mov buf, len
mov len, rax
call crc32_iscsi_01
@z: not eax
ret
@sml: shr len, 3
jz @2
{$ifdef FPC} align 16
@s: crc32 rax, qword [buf] // hash 8 bytes per loop
{$else} @s: db $F2,$48,$0F,$38,$F1,$02 // circumvent Delphi inline asm compiler bug
{$endif}add buf, 8
dec len
jnz @s
@2: test cl, 4
jz @3
crc32 eax, dword ptr[buf]
add buf, 4
@3: test cl, 2
jz @1
crc32 eax, word ptr[buf]
add buf, 2
@1: test cl, 1
jz @0
crc32 eax, byte ptr[buf]
@0: not eax
end;
{$endif CRC32C_X64}
initialization
ComputeAesStaticTables;
{$ifdef USEPADLOCK}
PadlockInit;
{$endif USEPADLOCK}
{$ifdef CPUX64}
{$ifdef CRC32C_X64} // use SSE4.2+pclmulqdq instructions
if (cfSSE42 in CpuFeatures) and (cfAesNi in CpuFeatures) then
crc32c := @crc32c_sse42_aesni;
{$endif CRC32C_X64}
if cfSSE41 in CpuFeatures then begin // optimized Intel's sha256_sse4.asm
if K256AlignedStore='' then
GetMemAligned(K256AlignedStore,@K256,SizeOf(K256),K256Aligned);
if PtrUInt(K256Aligned) and 15<>0 then
K256AlignedStore := ''; // if not properly aligned -> fallback to pascal
end;
{$endif CPUX64}
TTextWriter.RegisterCustomJSONSerializerFromTextSimpleType(TypeInfo(TSignAlgo));
TTextWriter.RegisterCustomJSONSerializerFromText(TypeInfo(TSynSignerParams),
'algo:TSignAlgo secret,salt:RawUTF8 rounds:integer');
{$ifndef NOVARIANTS}
GetEnumNames(TypeInfo(TJWTResult),@_TJWTResult);
GetEnumNames(TypeInfo(TJWTClaim),@_TJWTClaim);
{$endif NOVARIANTS}
assert(sizeof(TMD5Buf)=sizeof(TMD5Digest));
assert(sizeof(TAESContext)=AESContextSize);
assert(AESContextSize<=300); // see synsqlite3.c KEYLENGTH
assert(sizeof(TSHAContext)=SHAContextSize);
assert(sizeof(TSHA3Context)=SHA3ContextSize);
assert(1 shl AESBlockShift=sizeof(TAESBlock));
assert(sizeof(TAESFullHeader)=sizeof(TAESBlock));
assert(sizeof(TAESIVCTR)=sizeof(TAESBlock));
assert(sizeof(TSHA256)=sizeof(TSHA1));
assert(sizeof(TSHA512)>sizeof(TSHA256));
assert(sizeof(TSHA3)>sizeof(TSHA512));
assert(sizeof(TSHA3)>sizeof(THMAC_SHA512));
finalization
{$ifdef USEPADLOCKDLL}
if PadLockLibHandle<>0 then
FreeLibrary(PadLockLibHandle); // same on Win+Linux, thanks to SysUtils
{$endif USEPADLOCKDLL}
FillZero(__h);
{$ifdef MSWINDOWS}
if CryptoAPI.Handle<>0 then begin
{$ifdef USE_PROV_RSA_AES}
if (CryptoAPIAESProvider<>nil) and (CryptoAPIAESProvider<>HCRYPTPROV_NOTTESTED) then
CryptoAPI.ReleaseContext(CryptoAPIAESProvider,0);
{$endif USE_PROV_RSA_AES}
FreeLibrary(CryptoAPI.Handle);
end;
{$endif MSWINDOWS}
end.
Reference in New Issue View Git Blame Copy Permalink