/// 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) 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) 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: // following the expected pattern: // $ Authorization: Bearer // - 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 // - 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 // - 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: // - 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 inil 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 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 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 L0 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'{' 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 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 BufCount0 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 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]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 (InputLen0) 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 InputLensizeof(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'' 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 (nowunixnowunix+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.CreateTimeUnix0 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)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.