/// cryptographic cross-platform units // - this unit is a part of the freeware Synopse mORMot framework, // licensed under a MPL/GPL/LGPL tri-license; version 1.18 unit SynCrossPlatformCrypto; { This file is part of Synopse mORMot framework. Synopse mORMot framework. Copyright (C) 2020 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) 2020 the Initial Developer. All Rights Reserved. Contributor(s): 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 ***** Should compile with Delphi for any platform (including NextGen for mobiles), with FPC 2.7 or Kylix, and with SmartMobileStudio 2.1.1 } {$ifdef DWSCRIPT} // always defined since SMS 1.1.2 {$define ISDWS} // e.g. for SmartMobileStudio or Delphi Web Script {$define ISSMS} // for SmartMobileStudio {$else} {$i SynCrossPlatform.inc} // define e.g. HASINLINE {$endif} interface {$ifdef ISDWS} uses SmartCL.System; {$else} uses SysUtils, Classes; {$endif} type {$ifdef ISDWS} hash32 = integer; {$else} hash32 = cardinal; {$endif} var /// table used by crc32() function // - table content is created from code in initialization section below {$ifdef ISDWS} crc32tab: array of hash32; {$else} crc32tab: array[byte] of hash32; {$endif} {$ifndef ISDWS} /// compute the zlib/deflate crc32 hash value on a supplied buffer function crc32(aCrc32: hash32; const buf: array of byte): hash32; {$endif} /// compute the zlib/deflate crc32 hash value on a supplied ASCII-7 buffer function crc32ascii(aCrc32: hash32; const buf: string): hash32; type /// internal buffer for SHA256 hashing TSHA256Buffer = array[0..63] of hash32; /// internal work buffer for SHA256 hashing TSHAHash = record A,B,C,D,E,F,G,H: hash32; end; /// class for SHA256 hashing TSHA256 = class private // Working hash Hash: TSHAHash; // 64bit msg length MLen: integer; // Block buffer Buffer: TSHA256Buffer; // Index in buffer Index: integer; // used by Update and Finalize procedure Compress; public /// initialize SHA256 context for hashing constructor Create; {$ifndef ISDWS} /// update the SHA256 context with some data procedure Update(const buf: array of byte); overload; {$endif} /// update the SHA256 context with 8 bit ascii data (e.g. UTF-8) procedure Update(const ascii: string); overload; /// finalize and compute the resulting SHA256 hash Digest of all data // affected to Update() method // - returns the data as Hexadecimal function Finalize: string; end; {$ifndef ISDWS} /// compute SHA256 hexa digest of a supplied buffer function SHA256(const buf: array of byte): string; overload; {$endif} /// compute SHA256 hexa digest of a supplied 8 bit ascii data (e.g. UTF-8) function SHA256(const buf: string): string; overload; implementation {$ifdef ISDWS} function shr0(c: hash32): hash32; inline; begin {$ifdef ISSMS} // circumvent DWS compiler bug asm @result = @c >>> 0; end; {$else} result := c shr 0; {$endif} end; {$else} type // no-operation for unmanaged Delphi shr0 = hash32; {$endif} procedure InitCrc32Tab; var i,n,crc: hash32; begin for i := 0 to 255 do begin crc := i; for n := 1 to 8 do if (crc and 1)<>0 then // $edb88320 from polynomial p=(0,1,2,4,5,7,8,10,11,12,16,22,23,26) crc := shr0((crc shr 1) xor $edb88320) else crc := crc shr 1; {$ifndef ISSMS} crc32tab[i] := crc; {$else} crc32tab.push(crc); {$endif} end; end; function crc32ascii(aCrc32: hash32; const buf: string): hash32; var i: integer; begin result := shr0(not aCRC32); for i := 1 to length(buf) do result := crc32tab[(result xor ord(buf[i])) and $ff] xor (result shr 8); result := shr0(not result); end; {$ifndef ISDWS} function crc32(aCrc32: hash32; const buf: array of byte): hash32; var i: integer; begin result := shr0(not aCRC32); for i := 0 to length(buf)-1 do result := crc32tab[(result xor buf[i]) and $ff] xor (result shr 8); result := shr0(not result); end; {$endif ISDWS} const K: TSHA256Buffer = ( $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); procedure TSHA256.Compress; var W: TSHA256Buffer; H: TSHAHash; i: integer; t1, t2: hash32; begin H := Hash; for i := 0 to 15 do W[i]:= shr0((Buffer[i*4] shl 24)or(Buffer[i*4+1] shl 16)or (Buffer[i*4+2] shl 8)or Buffer[i*4+3]); for i := 16 to 63 do W[i] := shr0((((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]); for i := 0 to high(W) do begin t1 := shr0(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))+K[i]+W[i]); t2 := shr0((((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))); H.H := H.G; H.G := H.F; H.F := H.E; H.E := shr0(H.D+t1); H.D := H.C; H.C := H.B; H.B := H.A; H.A := shr0(t1+t2); end; Hash.A := shr0(Hash.A+H.A); Hash.B := shr0(Hash.B+H.B); Hash.C := shr0(Hash.C+H.C); Hash.D := shr0(Hash.D+H.D); Hash.E := shr0(Hash.E+H.E); Hash.F := shr0(Hash.F+H.F); Hash.G := shr0(Hash.G+H.G); Hash.H := shr0(Hash.H+H.H); end; constructor TSHA256.Create; begin Hash.A := $6a09e667; Hash.B := $bb67ae85; Hash.C := $3c6ef372; Hash.D := $a54ff53a; Hash.E := $510e527f; Hash.F := $9b05688c; Hash.G := $1f83d9ab; Hash.H := $5be0cd19; end; {$ifndef ISDWS} procedure TSHA256.Update(const buf: array of byte); var Len, aLen, i: integer; DataNdx: integer; begin Len := length(buf); DataNdx := 0; inc(MLen,Len shl 3); while Len>0 do begin aLen := 64-Index; if aLen<=Len then begin for i := 0 to aLen-1 do Buffer[Index+i] := buf[DataNdx+i]; dec(Len,aLen); inc(DataNdx,aLen); Compress; Index:= 0; end else begin for i := 0 to Len-1 do Buffer[Index+i] := buf[DataNdx+i]; inc(Index,Len); break; end; end; end; {$endif ISDWS} procedure TSHA256.Update(const ascii: string); var Len, aLen, i: integer; DataNdx: integer; begin Len := length(ascii); DataNdx := 1; inc(MLen,Len shl 3); while Len>0 do begin aLen := 64-Index; if aLen<=Len then begin for i := 0 to aLen-1 do Buffer[Index+i] := ord(ascii[DataNdx+i]); dec(Len,aLen); inc(DataNdx,aLen); Compress; Index:= 0; end else begin for i := 0 to Len-1 do Buffer[Index+i] := ord(ascii[DataNdx+i]); inc(Index,Len); break; end; end; end; function TSHA256.Finalize: string; var i: integer; begin // Message padding // 1. append bit '1' after Buffer Buffer[Index]:= $80; for i := Index+1 to 63 do Buffer[i] := 0; // 2. Compress if more than 448 bits, (no room for 64 bit length) if Index>=56 then begin Compress; for i := 0 to 59 do Buffer[i] := 0; end; // Write 64 bit Buffer length into the last bits of the last block // (in big endian format) and do a final compress Buffer[60] := (MLen and $ff000000)shr 24; Buffer[61] := (MLen and $ff0000)shr 16; Buffer[62] := (MLen and $ff00)shr 8; Buffer[63] := MLen and $ff; Compress; // Hash -> Digest to big endian format result := LowerCase(IntToHex(Hash.A,8)+IntToHex(Hash.B,8)+IntToHex(Hash.C,8)+ IntToHex(Hash.D,8)+IntToHex(Hash.E,8)+IntToHex(Hash.F,8)+IntToHex(Hash.G,8)+ IntToHex(Hash.H,8)); end; {$ifndef ISDWS} function SHA256(const buf: array of byte): string; var SHA: TSHA256; begin SHA := TSHA256.Create; try SHA.Update(buf); result := SHA.Finalize; finally SHA.Free; end; end; {$endif} function SHA256(const buf: string): string; var SHA: TSHA256; begin SHA := TSHA256.Create; try SHA.Update(buf); result := SHA.Finalize; finally SHA.Free; end; end; initialization InitCrc32Tab; end.