├── .gitignore ├── Documentation ├── Scrypt - relationship to PBKDF2.svg └── Scrypt - relationship to PBKDF2.vsd ├── Images ├── Effect of parameters on calculation time.PNG ├── Operation.png ├── Overview.PNG ├── Scrypt Overview.png ├── ScryptBlockDiagram.png └── ScryptBlockDiagram1.png ├── README.md ├── SCrypt.pas ├── SCryptTests.pas └── UNLICENSE /.gitignore: -------------------------------------------------------------------------------- 1 | Images/Scrypt Overview.svg 2 | Images/Scrypt Overview.pdf 3 | Images/Android Lollipop Full Disk Encryptionl.png 4 | Images/Operation.svg -------------------------------------------------------------------------------- /Documentation/Scrypt - relationship to PBKDF2.svg: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 50 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | Page-1 70 | 71 | 72 | 73 | 74 | Sheet.15 75 | 76 | 77 | 78 | 79 | 81 | 82 | 83 | 84 | 85 | 86 | Process 87 | PBKDF2sha256 Desired bytes = 64*r*N*p e.g. 64*8*16384*1 = 8 MB 88 | 89 | 91 | 93 | 95 | 97 | 99 | 101 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | 111 | 112 | 113 | 114 | 115 | 117 | 118 | 119 | 120 | PBKDF2sha256Desired bytes = 64*r*N*pe.g. 64*8*16384*1 = 8 MB 129 | 130 | Rounded rectangle 131 | Parameters N=16384, r=8, p=1 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 141 | 144 | 145 | 147 | ParametersN=16384,r=8, p=1 152 | 153 | Process.5 154 | Password “correct horse battery staple” 155 | 156 | 158 | 160 | 162 | 164 | 166 | 168 | 171 | 172 | 173 | 174 | 175 | 176 | 177 | 178 | 179 | 180 | 181 | 182 | 184 | 185 | 186 | 187 | Passwordcorrect horse battery staple 190 | 191 | Process.1 192 | Salt “seasalt” 193 | 194 | 196 | 198 | 200 | 202 | 204 | 206 | 209 | 210 | 211 | 212 | 213 | 214 | 215 | 216 | 217 | 218 | 219 | 220 | 222 | 223 | 224 | 225 | Saltseasalt 227 | 228 | Subprocess 229 | ROMix N iterations, p times 230 | 231 | 233 | 235 | 237 | 239 | 241 | 243 | 246 | 247 | 248 | 249 | 250 | 251 | 252 | 253 | 254 | 255 | 256 | 257 | 258 | 260 | 261 | 262 | 263 | 264 | 265 | 266 | 267 | 268 | 269 | ROMixN iterations, p times 272 | 273 | Process.10 274 | PBKDF2sha256 desired bytes e.g. 16 bytes 275 | 276 | 278 | 280 | 282 | 284 | 286 | 288 | 291 | 292 | 293 | 294 | 295 | 296 | 297 | 298 | 299 | 300 | 301 | 302 | 304 | 305 | 306 | 307 | PBKDF2sha256desired bytese.g. 16 bytes 312 | 313 | Dynamic connector.11 314 | Salt 315 | 316 | 317 | 318 | 319 | 320 | 321 | 322 | 323 | Salt 324 | 325 | Process.13 326 | Derived bytes (e.g. 256 bit) 327 | 328 | 330 | 332 | 334 | 336 | 338 | 340 | 343 | 344 | 345 | 346 | 347 | 348 | 349 | 350 | 351 | 352 | 353 | 354 | 356 | 357 | 358 | 359 | Derived bytes(e.g. 256 bit) 361 | 362 | Dynamic connector.14 363 | 364 | 365 | 366 | 367 | 368 | 369 | 370 | Dynamic connector 371 | 372 | 373 | 374 | 375 | 376 | 377 | 378 | Dynamic connector.4 379 | 380 | 381 | 382 | 383 | 384 | 385 | 386 | Dynamic connector.7 387 | 388 | 389 | 390 | 391 | 392 | 393 | 394 | Dynamic connector.9 395 | 396 | 397 | 398 | 399 | 400 | 401 | 402 | Dynamic connector.12 403 | 404 | 405 | 406 | 407 | 408 | 409 | 410 | 411 | -------------------------------------------------------------------------------- /Documentation/Scrypt - relationship to PBKDF2.vsd: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JackTrapper/scrypt-for-delphi/f5d05ba4f735e407dd00cc8a54388b82da2d182d/Documentation/Scrypt - relationship to PBKDF2.vsd -------------------------------------------------------------------------------- /Images/Effect of parameters on calculation time.PNG: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JackTrapper/scrypt-for-delphi/f5d05ba4f735e407dd00cc8a54388b82da2d182d/Images/Effect of parameters on calculation time.PNG -------------------------------------------------------------------------------- /Images/Operation.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JackTrapper/scrypt-for-delphi/f5d05ba4f735e407dd00cc8a54388b82da2d182d/Images/Operation.png -------------------------------------------------------------------------------- /Images/Overview.PNG: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JackTrapper/scrypt-for-delphi/f5d05ba4f735e407dd00cc8a54388b82da2d182d/Images/Overview.PNG -------------------------------------------------------------------------------- /Images/Scrypt Overview.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JackTrapper/scrypt-for-delphi/f5d05ba4f735e407dd00cc8a54388b82da2d182d/Images/Scrypt Overview.png -------------------------------------------------------------------------------- /Images/ScryptBlockDiagram.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JackTrapper/scrypt-for-delphi/f5d05ba4f735e407dd00cc8a54388b82da2d182d/Images/ScryptBlockDiagram.png -------------------------------------------------------------------------------- /Images/ScryptBlockDiagram1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JackTrapper/scrypt-for-delphi/f5d05ba4f735e407dd00cc8a54388b82da2d182d/Images/ScryptBlockDiagram1.png -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Scrypt for Delphi 2 | ================= 3 | 4 | [Scrypt](http://en.wikipedia.org/wiki/Scrypt) is a key derivation function. It is designed to take a password (and some salt), and generate a desired number of pseudo-random bytes. 5 | 6 | ![overview](./Images/Scrypt%20Overview.png) 7 | 8 | The generated bytes are usually then used as a symmetric encryption key. SCrypt is similar to [PBKDF2](http://en.wikipedia.org/wiki/PBKDF2), except that it is *memory-hard*, making it difficult to parallelize in hardware. It was first [described by Colin Percival in 2012](http://www.tarsnap.com/scrypt/scrypt.pdf) for the Tarsnap online backup service. 9 | 10 | 11 | Sample Usage 12 | ---------------- 13 | 14 | To generate 16 bytes (e.g. AES-128 key) from a password, and using default cost factors: 15 | 16 | secretKey := TScrypt.GetBytes('correct horse battery staple', 'seasalt', 16); //returns 16 bytes (128 bits) 17 | 18 | To specify custom Scrypt parameters: 19 | 20 | secretKey := TScrypt.GetBytes('correct horse battery staple', 'seasalt', {N=2^}14}, {r=}8, {p=}1, 32); //returns 32 bytes (256 bits) 21 | 22 | Password Hashing 23 | -------------- 24 | 25 | The `TScrypt` class also supports being used for password hashing (i.e. storage and verification of passwords). 26 | 27 | - To hash a password: 28 | 29 | hash := TScrypt.HashPassword('correct battery horse staple'); //using default cost factors 30 | 31 | - To hash a password specifying your own cost factors: 32 | 33 | hash := TScrypt.HashPassword('correct battery horse staple', 14, 8, 1); //N=2^14, r=8, p=1 34 | 35 | - To verify a password: 36 | 37 | isPasswordValid := TScrypt.CheckPassword('correct battery horse stapler', expectedHash, {out}passwordRehashNeeded); 38 | 39 | 40 | By convention TScrypt outputs a password hash as string in the form: 41 | 42 | $s1$NNrrpp$salt$hash 43 | $s1$131003$aXzuBr2qvisBj/bl7vr2pe$ksOS0sSZD38pZ8Nr/Zucq6fZrSLrQJTwXMmpSRvK4fGmyHg/ivJnd/dTDMICZO3uVvCxL/tQqjlLCK6bfz31Ju 44 | 45 | The parts of the string are: 46 | 47 | | Value | Meaning | Notes | 48 | |-------|---------|-------| 49 | | s1 | Hash algorithm | "s1" = current version of Scrypt | 50 | | N | Hex encoded log2(N) | Default is 14 (i.e. 2^14) iterations | 51 | | rr | Hex encoded Block Size | 1-255 | 52 | | pp | Hex encoded Parallelization Factor | 1-255 | 53 | | salt | base64 encoded salt | 0-16 bytes decoded | 54 | | hash | base64 encoded hash | 64-bytes | 55 | 56 | Because the three scrypt parameters are stored in the returned string, scrypt password hashes are backwards and forwards compatible with changing the factors. It also makes Scrypt extraordinarily convenient, in that a random salt is automatically generated and stored for you (you don't have to worry about storing it in a database or retrieving it). 57 | 58 | Scrypt Operation 59 | ================ 60 | 61 | Scrypt uses three parameters to tune CPU and memory usage: 62 | 63 | - **CostFactor**: determines how many blocks will have to be allocated in memory (the memory hard factor). 64 | 65 | # of blocks = *"cost"* = N = 2^costFactor 66 | Memory required =cost*blockSize = 2^costFactor * blockSize 67 | 68 | - **BlockSizeFactor**: determines the size of a *block* (`r`) 69 | 70 | BlockSize = blockSizeFactor * 128 bytes 71 | 72 | - **ParallelizationFactor**: determines how many independant calculations have to be performed (`p`) 73 | 74 | The default parameters given in the original whitepaper are: 75 | 76 | - **CostFactor (cf)**: 14 (N = 214 = 16,384) 77 | - **Block Size Factor (r)**: 1 (blockSize = 1*128 bytes) 78 | - **Parallelization Factor (p)**: 1 79 | 80 | Note: Most scrypt documentation uses **Cost (N)**, which is a large value and a power of two. We adopt the BCrypt convention of expressing a **Cost Factor**, which is the log_2(Cost). 81 | 82 | Algorithm 83 | ========== 84 | 85 | Scrypt uses the standard PBDKF2 function to generate the desired number of bytes. The password fed to PBKDF2 is the user password. The virtue of Scrypt is its expensive generation of the salt to be fed into PBKDF2: 86 | 87 | ![operation](./Images/ScryptBlockDiagram.png) 88 | 89 | 90 | 91 | Created by Ian Boyd, 4/9/2015, and released into the [public domain](http://unlicense.org/) 92 | -------------------------------------------------------------------------------- /SCrypt.pas: -------------------------------------------------------------------------------- 1 | unit SCrypt; 2 | 3 | (* 4 | Sample Usage 5 | ============ 6 | 7 | //Hash a password 8 | hash := TSCrypt.HashPassword('correct horse battery staple'); 9 | 10 | //Check if password matches previous hash 11 | isValid := TScrypt.CheckPassword('correct horse battery staple', hash); 12 | 13 | //Derive an encryption key from a password 14 | secretKey := TScrypt.GetBytes('correct horse battery staple', 'seasalt', 16); //returns 16 bytes (128 bits) 15 | secretKey := TScrypt.GetBytes('correct horse battery staple', 'seasalt', {r=}1, {N=}128}, {p=}8, 32); //returns 32 bytes (256 bits) 16 | 17 | 18 | 19 | Remarks 20 | ======= 21 | 22 | scrypt is a key-derivation function. 23 | Key derivation functions are used to derive an encryption key from a password. 24 | 25 | To generate 16 bytes (128 bits) of key material, with automatically determined parameters, use: 26 | 27 | secretKey := TScrypt.GetBytes('correct horse battery staple', 'seasalt', 16); //returns 16 bytes (128 bits) 28 | 29 | If you know what values of the scrypt N (CostFactor), r (block size), and p (parallelization factor) parameters you want, 30 | you can specify them: 31 | 32 | secretKey := TScrypt.GetBytes('correct horse battery staple', 'seasalt', {N=}14, {r=}8, {p=}1, 32); //returns 32 bytes (256 bits) 33 | 34 | where 35 | BlockSize (r) = 8 36 | CostFactor (N) = 14 (i.e. 2^14 = 16,384 iterations) 37 | ParallelizationFactor (p) = 1 38 | DesiredBytes = 32 (256 bits) 39 | 40 | Otherwise scrypt does a speed/memory test to determine the most appropriate parameters. 41 | 42 | Password Hashing 43 | ================ 44 | 45 | SCrypt has also been used as password hashing algorithm. 46 | In order to make password storage easier, we generate the salt and store it with the returned string. 47 | This is similar to what OpenBSD has done with BCrypt. 48 | The downside is that there is no standard format out there for SCrypt representation of password hashes. 49 | 50 | hash := TSCrypt.HashPassword('correct horse battery staple'); 51 | 52 | will return string in the format of: 53 | 54 | $s0$NNNNrrpp$salt$key 55 | 56 | s0 - version 0 of the format with 128-bit salt and 256-bit derived key 57 | params - 32-bit hex integer containing log2(N) (16 bits), r (8 bits), and p (8 bits) 58 | salt - 24 base64-encoded characters of salt (128 bits ==> 16 bytes ==> 24 characters) 59 | key - 44 base64-encoded characters derived key (256 bits ==> 32 bytes ==> 44 characters) 60 | 61 | Example for password of "secret": 62 | 63 | $s0$e0801$epIxT/h6HbbwHaehFnh/bw==$7H0vsXlY8UxxyW/BWx/9GuY7jEvGjT71GFd6O4SZND0= 64 | 65 | CostFactor = 0xE0 = 14 ==> N = 2^14 = 16,384 66 | r = 0x08 = 8 67 | p = 0x01 = 1 68 | salt = epIxT/h6HbbwHaehFnh/bw== 69 | key = 7H0vsXlY8UxxyW/BWx/9GuY7jEvGjT71GFd6O4SZND0= 70 | 71 | Version History 72 | =============== 73 | 74 | Version 1.7 20200122 75 | - Fix: use-after-free bug, which should have been class method call. 76 | Version 1.6 20180913 77 | - Added: Use SASL StringPrep to prepare a user's passphrase for hashing (e.g. apply appropriate NFC unicode normal form, canonicalize all spaces characters to the standard space character) 78 | - Change: Change from using TULargeInteger to ULARGE_INTEGER. 79 | Delphi 10.2 changed the definition of TULargeInteger from the structure to UInt64. 80 | We use the structure for backwards compatiblity. 81 | Version 1.5 20160603 82 | - Change: CheckPassword to take a boolean out parameter "PasswordRehashNeeded". PasswordRehashNeeded will contain true 83 | if you should call HashPassword again while you have the user's password handy. 84 | If computing power can now compute the hash in less than 250ms, it's time to use rehash te password. 85 | Or if the scrypt version or hash string format has changed, and we want you to use HashPassword to get a new format. 86 | - Added: HashPassword (the version where you let scrypt determine the parameters) will now do a mini benchmark 87 | (like Bcrypt for Delphi and canonical tarsnap scrypt does). The benchmark will try to ensure that scrypt 88 | runs in no less than 250ms (ideally 500ms). But under no circumstances will the benchmark drop below the 89 | default N=14,r=8,p=1. If the benchmark says that will take over 500ms to run, then that's the way it will be. 90 | The benchmark will only ever *increase* runtime over the default, never decrease it. 91 | 92 | Version 1.4 20160528 93 | - Switched password hashing Base64 to use standard Base64 rather than OpenBSD's custom Base64 that BCrypt uses 94 | - Hashing now compatible with wg/scrypt (added test to match their documented example) 95 | - Standard base64 hashing keeps trailing == padding (BCrypt's custom Base64 stripped it) 96 | - Removed unused variant of Salsa20 - the in-place is the only one used 97 | - tried to make scrypt work on non-MSWINDOWS (e.g. use of ComObj and ActiveX for bestcrypt and capi) 98 | - moved CreateObject to public rather than protected (no longer need cracker class to get at it). 99 | It exists so people can use it; but i'm not sure how i feel about it being truly public. 100 | - Fixed range-check bug when passing empty salt to PBKDF2 101 | 102 | Version 1.3 20160509 103 | - made compatible with Delphi 5/7 104 | - Change some array indexing to use pointer offsets instead; the unnecessary bounds checking was getting confused 105 | - Refactored core method to reinforce the idea that Scrypt is just simply PBKDF2 (with some fancy salt) 106 | Version 1.2 20150510 107 | - Use Cryptography Next Generation (Cng) API for SHA256 (requires Windows Vista or later) 108 | - Will still fallback to SHA256 CryptoApi CSP (Windows 2000) when on Windows platform 109 | - still falls back to internal PurePascal implementation if not WINDOWS 110 | - Changed the strings to pass to TScrypt.GetHashAlgorithm 111 | - Calling TScrypt.GetHashAlgoritm with "SHA1" or "SHA256" will now choose the best algorithm implementation 112 | - Pass "SHA1PurePascal" or "SHA256PurePascal" to specifically get the pure pascal versions 113 | - FIX: HashPassword overload that takes custom cost parameters was using stack garbage for salt 114 | 115 | Version 1.1 20150415 116 | - Support for actually verifying a password hash 117 | - 43% faster due to optimizations in XorBlock and Salsa20 118 | - TODO: Do the same thing canonical scrypt.c does, and do a benchmark before generation to determine parameters. 119 | 120 | Version 1.0 20150408 121 | - Inital release. Public domain. Ian Boyd. 122 | This is free and unencumbered software released into the public domain. 123 | Anyone is free to copy, modify, publish, use, compile, sell, or 124 | distribute this software, either in source code form or as a compiled 125 | binary, for any purpose, commercial or non-commercial, and by any means. 126 | For more information, please refer to 127 | 128 | Benchmarks 129 | ========== 130 | 131 | 20150412 Delphi XE6, Release, 32-bit, Intel i5-2500 132 | 133 | | N | r=1 | r=2 | r=3 | r=4 | r=5 | r=6 | r=7 | r=8 | r=9 | r=10 | r=11 | r=12 | r=13 | r=14 | r=15 | r=16 | 134 | |----|------|--------|--------|--------|--------|--------|---------|---------|---------|---------|--------|--------|---------|---------|---------|---------| 135 | | 1 | 0.2 | 0.2 | 0.2 | 0.2 | 0.2 | 0.2 | 0.3 | 0.3 | 0.3 | 0.3 | 0.4 | 0.4 | 0.4 | 0.5 | 1.3 | 1.2 | 136 | | 2 | 0.2 | 0.2 | 0.2 | 0.2 | 0.2 | 0.3 | 0.3 | 0.3 | 0.3 | 0.4 | 0.4 | 0.4 | 0.4 | 0.5 | 0.5 | 0.5 | 137 | | 3 | 0.2 | 0.2 | 0.2 | 0.2 | 0.2 | 0.3 | 0.3 | 0.3 | 0.4 | 0.4 | 0.4 | 0.4 | 0.5 | 0.5 | 0.5 | 0.5 | 138 | | 4 | 0.2 | 0.2 | 0.2 | 0.3 | 0.3 | 1.1 | 0.4 | 1.3 | 0.6 | 0.7 | 0.6 | 0.6 | 0.7 | 0.7 | 0.7 | 0.8 | 139 | | 5 | 0.2 | 0.2 | 0.3 | 0.4 | 0.4 | 0.4 | 0.5 | 0.6 | 0.6 | 0.7 | 0.8 | 0.8 | 0.9 | 0.9 | 1.0 | 1.0 | 140 | | 6 | 0.2 | 0.3 | 0.4 | 0.5 | 0.6 | 0.7 | 0.9 | 0.9 | 1.0 | 1.1 | 1.2 | 1.3 | 1.4 | 1.4 | 1.6 | 1.8 | 141 | | 7 | 0.4 | 0.5 | 0.8 | 0.9 | 1.1 | 1.2 | 1.4 | 1.8 | 1.8 | 2.0 | 2.2 | 2.3 | 2.5 | 2.8 | 2.8 | 3.1 | 142 | | 8 | 0.6 | 1.0 | 1.3 | 1.6 | 2.0 | 2.4 | 2.7 | 3.1 | 3.5 | 3.8 | 4.2 | 7.2 | 4.5 | 4.8 | 5.5 | 6.9 | 143 | | 9 | 1.1 | 1.7 | 3.1 | 6.0 | 6.2 | 4.3 | 5.2 | 5.6 | 6.3 | 6.9 | 9.5 | 11.2 | 11.5 | 9.4 | 11.8 | 10.8 | 144 | | 10 | 2.0 | 3.2 | 4.8 | 6.2 | 7.8 | 8.5 | 9.6 | 11.3 | 15.7 | 18.4 | 21.1 | 21.0 | 20.9 | 20.1 | 22.9 | 23.1 | 145 | | 11 | 4.0 | 6.6 | 9.1 | 18.8 | 15.4 | 16.9 | 19.5 | 27.4 | 32.6 | 27.5 | 29.9 | 34.4 | 38.1 | 45.7 | 41.6 | 48.1 | 146 | | 12 | 7.6 | 14.0 | 19.9 | 25.3 | 30.0 | 34.1 | 41.6 | 49.4 | 61.9 | 58.8 | 63.5 | 73.6 | 74.6 | 83.0 | 86.4 | 92.5 | 147 | | 13 | 15.3 | 27.4 | 44.4 | 52.3 | 66.7 | 80.7 | 81.3 | 97.1 | 112.3 | 126.1 | 129.1 | 143.8 | 159.3 | 164.4 | 171.1 | 175.2 | 148 | | 14 | 37.3 | 51.3 | 75.4 | 101.9 | 130.5 | 149.5 | 184.1 | 195.7 | 219.6 | 258.3 | 250.7 | 280.6 | 305.9 | 324.9 | 360.2 | 370.2 | 149 | | 15 | 70.3 | 118.3 | 158.4 | 196.5 | 258.6 | 315.7 | 355.7 | 393.2 | 472.8 | 501.7 | 540.8 | 619.8 | 662.0 | 685.8 | 729.9 | 791.3 | 150 | | 16 | #N/A | 229.2 | 305.8 | 430.2 | 521.8 | 624.7 | 700.9 | 823.3 | 909.2 | 1013.5 | 1056.3 | 1190.5 | 1318.4 | 1412.5 | 1501.5 | 1583.2 | 151 | | 17 | #N/A | 505.1 | 691.5 | 845.0 | 1010.6 | 1243.0 | 1455.5 | 1602.0 | 1798.4 | 2031.1 | 2233.9 | 2436.9 | 2698.8 | 2856.4 | 3043.1 | 3240.8 | 152 | | 18 | #N/A | 1003.6 | 1415.8 | 1797.0 | 2218.8 | 2597.6 | 2995.2 | 3375.1 | 3749.6 | 4074.9 | 4360.2 | 4655.6 | 5746.6 | 5987.7 | 5804.7 | 6181.3 | 153 | | 19 | #N/A | 1911.7 | 2598.0 | 3296.0 | 4151.7 | 4880.7 | 5901.3 | 6304.4 | 7150.6 | 8091.7 | 8964.8 | 9909.5 | 10450.6 | 11452.8 | 12200.7 | 12931.8 | 154 | | 20 | #N/A | 4006.3 | 5673.7 | 7117.5 | 8781.7 | 9939.3 | 12146.8 | 13136.7 | 14539.6 | 16785.1 | #mem | #mem | #mem | #mem | #mem | #N/A | 155 | 156 | Delphi is limited to allocating $7FFFFFFF bytes when using GetMem or SetLength. 157 | (GetMem and SetLength are defined as taking a 32-bit integer, even in 64-bit applications) 158 | 159 | This means that N=20,r=16 requires 128*16*2^20 = 0x80000000 bytes of memory. 160 | 161 | This exceeds the amount you can ask for in an 32-bit Integer. 162 | 163 | In practice, your limit in a 32-bit process will be lower, given the 2GB limit of virtual address space, 164 | and that there are other things already in your address space (e.g. your application, dlls). 165 | 166 | 167 | References 168 | ============== 169 | The scrypt Password-Based Key Derivation Function 170 | http://tools.ietf.org/html/draft-josefsson-scrypt-kdf-02 171 | 172 | Java implementation of scrypt 173 | https://github.com/wg/scrypt 174 | 175 | Scrypt For Node/IO 176 | https://github.com/barrysteyn/node-scrypt 177 | *) 178 | 179 | {$IFDEF CONDITIONALEXPRESSIONS} 180 | {$IF CompilerVersion >= 15} //15 = Delphi 7 181 | {$DEFINE COMPILER_7_UP} 182 | {$IFEND} 183 | {$IF CompilerVersion = 15} //15 = Delphi 7 184 | {$DEFINE COMPILER_7} 185 | {$DEFINE COMPILER_7_DOWN} 186 | {$IFEND} 187 | {$ELSE} 188 | {$IFDEF VER130} //Delphi 5 189 | {$DEFINE COMPILER_7_DOWN} 190 | {$DEFINE COMPILER_5_DOWN} 191 | {$DEFINE COMPILER_5} 192 | {$DEFINE MSWINDOWS} //Delphi 5 didn't define MSWINDOWS back then. And there was no other platform 193 | {$ENDIF} 194 | {$ENDIF} 195 | 196 | interface 197 | 198 | uses 199 | SysUtils 200 | {$IFDEF COMPILER_7_UP}, Types{$ENDIF}; 201 | 202 | {$IFNDEF UNICODE} 203 | type 204 | UnicodeString = WideString; 205 | {$ENDIF} 206 | 207 | {$IFDEF COMPILER_7} //Delphi 7 208 | type 209 | TBytes = Types.TByteDynArray; //TByteDynArray wasn't added until around Delphi 7. Sometime later it moved to SysUtils. 210 | {$ENDIF} 211 | {$IFDEF COMPILER_5} //Delphi 5 212 | type 213 | TBytes = array of Byte; //for old-fashioned Delphi 5, we have to do it ourselves 214 | IInterface = IUnknown; 215 | TStringDynArray = array of String; 216 | EOSError = EWin32Error; 217 | const 218 | RaiseLastOSError: procedure = SysUtils.RaiseLastWin32Error; //First appeared in Delphi 7 219 | {$ENDIF} 220 | 221 | type 222 | //As basic of a Hash interface as you can get 223 | IHashAlgorithm = interface(IInterface) 224 | ['{985B0964-C47A-4212-ADAA-C57B26F02CCD}'] 225 | function GetBlockSize: Integer; 226 | function GetDigestSize: Integer; 227 | 228 | { Methods } 229 | procedure HashData(const Buffer; BufferLen: Integer); 230 | function Finalize: TBytes; 231 | 232 | { Properties } 233 | property BlockSize: Integer read GetBlockSize; 234 | property DigestSize: Integer read GetDigestSize; 235 | end; 236 | 237 | IHmacAlgorithm = interface(IInterface) 238 | ['{815787A8-D5E7-41C0-9F23-DF30D1532C49}'] 239 | function GetDigestSize: Integer; 240 | function HashData(const Key; KeyLen: Integer; const Data; DataLen: Integer): TBytes; 241 | property DigestSize: Integer read GetDigestSize; 242 | end; 243 | 244 | IPBKDF2Algorithm = interface(IInterface) 245 | ['{93BB60D0-2C87-46CB-8A2A-A711F0BBEF0D}'] 246 | function GetBytes(const Password: UnicodeString; const Salt; const SaltLength: Integer; IterationCount, DesiredBytes: Integer): TBytes; 247 | end; 248 | 249 | TScrypt = class(TObject) 250 | protected 251 | procedure BurnBytes(var data: TBytes); 252 | procedure BurnString(var s: UnicodeString); 253 | class function StringToUtf8(Source: UnicodeString): TBytes; 254 | class function PasswordStringPrep(Source: UnicodeString): string; 255 | 256 | class function Base64Encode(const data: array of Byte): string; 257 | class function Base64Decode(const s: string): TBytes; 258 | 259 | class function Tokenize(const s: string; Delimiter: Char): TStringDynArray; 260 | function GenerateSalt: TBytes; 261 | 262 | class procedure XorBlockInPlace(var A; const B; Length: Integer); 263 | 264 | function PBKDF2(const Password: UnicodeString; const Salt; const SaltLength: Integer; IterationCount, DesiredBytes: Integer): TBytes; 265 | 266 | procedure Salsa20InPlace(var Input); //four round version of Salsa20, termed Salsa20/8 267 | function BlockMix(const B: array of Byte): TBytes; //mixes r 128-byte blocks 268 | function ROMix(const B; BlockSize, CostFactor: Cardinal): TBytes; 269 | 270 | function GenerateScryptSalt(const Passphrase: UnicodeString; const Salt: array of Byte; const CostFactor, BlockSizeFactor, ParallelizationFactor: Integer): TBytes; 271 | function DeriveBytes(const Passphrase: UnicodeString; const Salt: array of Byte; const CostFactor, BlockSizeFactor, ParallelizationFactor: Integer; DesiredBytes: Integer): TBytes; 272 | 273 | procedure GetDefaultParameters(out CostFactor, BlockSizeFactor, ParallelizationFactor: Cardinal); 274 | function TryParseHashString(HashString: string; out CostFactor, BlockSizeFactor, ParallelizationFactor: Cardinal; out Salt: TBytes; out Data: TBytes): Boolean; 275 | function FormatPasswordHash(const costFactor, blockSizeFactor, parallelizationFactor: Integer; const Salt, DerivedBytes: array of Byte): string; 276 | public 277 | constructor Create; 278 | 279 | //Get a number of bytes using the default Cost and Parallelization factors 280 | class function GetBytes(const Passphrase: UnicodeString; const Salt: UnicodeString; nDesiredBytes: Integer): TBytes; overload; 281 | 282 | //Get a number of bytes, specifying the desired cost and parallelization factor 283 | class function GetBytes(const Passphrase: UnicodeString; const Salt: UnicodeString; CostFactor, BlockSizeFactor, ParallelizationFactor: Cardinal; DesiredBytes: Integer): TBytes; overload; 284 | 285 | { 286 | Scrypt is not meant for password storage; it is meant for key generation. 287 | But people can still use it for password hashing. 288 | Unlike Bcrypt, there is no standard representation for passwords hashed with Scrypt. 289 | So we can make one, and provide the function to validate it 290 | } 291 | class function HashPassword(const Passphrase: UnicodeString): string; overload; 292 | class function HashPassword(const Passphrase: UnicodeString; CostFactor, BlockSizeFactor, ParallelizationFactor: Cardinal): string; overload; 293 | class function CheckPassword(const Passphrase: UnicodeString; ExpectedHashString: string; out PasswordRehashNeeded: Boolean): Boolean; 294 | 295 | { 296 | Let people have access to our hash functions. They've been tested and verified, and they work well. 297 | Besides, we have HMAC and PBKDF2. That's gotta be useful for someone. 298 | } 299 | class function CreateObject(ObjectName: string): IInterface; 300 | end; 301 | 302 | EScryptException = class(Exception); 303 | 304 | implementation 305 | 306 | {$IFDEF UnitTests} 307 | {$DEFINE ScryptUnitTests} 308 | {$ENDIF} 309 | 310 | {$IFDEF NoScryptUnitTests} 311 | {$UNDEF ScryptUnitTests} 312 | {$ENDIF} 313 | 314 | uses 315 | {$IFDEF ScryptUnitTests}ScryptTests,{$ENDIF} 316 | {$IFDEF MSWINDOWS}Windows, ComObj, ActiveX,{$ENDIF} 317 | Math; 318 | 319 | {$IFDEF COMPILER_7_DOWN} 320 | function MAKELANGID(p, s: WORD): WORD; 321 | begin 322 | Result := WORD(s shl 10) or p; 323 | end; 324 | 325 | function CharInSet(C: AnsiChar; const CharSet: TSysCharSet): Boolean; overload; 326 | begin 327 | Result := C in CharSet; 328 | end; 329 | 330 | type 331 | UInt64 = Int64; 332 | PUInt64 = ^UInt64; 333 | {$ENDIF} 334 | 335 | const 336 | SCRYPT_HASH_LEN = 64; //This can be user defined - but this is the reference size 337 | 338 | //The normal Base64 alphabet 339 | Base64EncodeTable: array[0..63] of Char = 340 | { 0:} 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'+ 341 | {26:} 'abcdefghijklmnopqrstuvwxyz'+ 342 | {52:} '0123456789+/'; 343 | 344 | Base64DecodeTable: array[#0..#127] of Integer = ( 345 | { 0:} -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, // ________________ 346 | { 16:} -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, // ________________ 347 | { 32:} -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 62, -1, -1, -1, 63, // _______________/ 348 | { 48:} 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, -1, -1, -1, -1, -1, -1, // 0123456789______ 349 | { 64:} -1, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, // _ABCDEFGHIJKLMNO 350 | { 80:} 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, -1, -1, -1, -1, -1, // PQRSTUVWXYZ_____ 351 | { 96:} -1, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, // _abcdefghijklmno 352 | {113:} 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, -1, -1, -1, -1, -1); // pqrstuvwxyz_____ 353 | 354 | //Unix password file use non-standard base64 alphabet 355 | BsdBase64EncodeTable: array[0..63] of Char = 356 | { 0:} './'+ 357 | { 2:} 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'+ 358 | {28:} 'abcdefghijklmnopqrstuvwxyz'+ 359 | {54:} '0123456789'; 360 | 361 | BsdBase64DecodeTable: array[#0..#127] of Integer = ( 362 | { 0:} -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, // ________________ 363 | { 16:} -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, // ________________ 364 | { 32:} -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 0, 1, // ______________./ 365 | { 48:} 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, -1, -1, -1, -1, -1, -1, // 0123456789______ 366 | { 64:} -1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, // _ABCDEFGHIJKLMNO 367 | { 80:} 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, -1, -1, -1, -1, -1, // PQRSTUVWXYZ_____ 368 | { 96:} -1, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, // _abcdefghijklmno 369 | {113:} 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, -1, -1, -1, -1, -1); // pqrstuvwxyz_____ 370 | 371 | 372 | type 373 | PLongWordArray = ^TLongWordArray_Unsafe; 374 | TLongWordArray_Unsafe = array[0..79] of LongWord; //SHA uses an array of 80 elements 375 | 376 | const 377 | //Cryptography Service Provider (CSP) items 378 | CALG_SHA1 = $00008004; 379 | CALG_SHA_256 = $0000800c; 380 | 381 | type 382 | //Cryptography Next Generation (Cng) items 383 | BCRYPT_HANDLE = THandle; 384 | BCRYPT_ALG_HANDLE = THandle; 385 | BCRYPT_KEY_HANDLE = THandle; 386 | BCRYPT_HASH_HANDLE = THandle; 387 | NTSTATUS = Cardinal; 388 | 389 | const 390 | // Microsoft built-in providers. (OpenAlgorithmProvider.pszImplementation) 391 | MS_PRIMITIVE_PROVIDER: UnicodeString = 'Microsoft Primitive Provider'; 392 | MS_PLATFORM_CRYPTO_PROVIDER: UnicodeString = 'Microsoft Platform Crypto Provider'; //i.e. TPM 393 | 394 | // OpenAlgorithmProvider.AlgorithmID 395 | BCRYPT_SHA256_ALGORITHM = 'SHA256'; 396 | 397 | // OpenAlgorithmProvider.dwFlags 398 | BCRYPT_ALG_HANDLE_HMAC_FLAG = $00000008; 399 | 400 | // BCryptGetProperty property name 401 | BCRYPT_OBJECT_LENGTH: UnicodeString = 'ObjectLength'; 402 | 403 | var 404 | _BCryptInitialized: Boolean = False; 405 | _BCryptAvailable: Boolean = False; 406 | _BCryptOpenAlgorithmProvider: function(out hAlgorithm: BCRYPT_ALG_HANDLE; pszAlgId, pszImplementation: PWideChar; dwFlags: Cardinal): NTSTATUS; stdcall; 407 | _BCryptCloseAlgorithmProvider: function(hAlgorithm: BCRYPT_ALG_HANDLE; dwFlags: Cardinal): NTSTATUS; stdcall; 408 | _BCryptGetProperty: function(hObject: BCRYPT_HANDLE; pszProperty: PWideChar; {out}pbOutput: Pointer; cbOutput: Cardinal; out cbResult: Cardinal; dwFlags: Cardinal): NTSTATUS; stdcall; 409 | _BCryptCreateHash: function(hAlgorithm: BCRYPT_ALG_HANDLE; out hHash: BCRYPT_HASH_HANDLE; pbHashObject: Pointer; cbHashObject: Cardinal; pbSecret: Pointer; cbSecret: Cardinal; dwFlags: DWORD): NTSTATUS; stdcall; 410 | _BCryptHashData: function(hHash: BCRYPT_HASH_HANDLE; pbInput: Pointer; cbInput: Cardinal; dwFlags: Cardinal): NTSTATUS; stdcall; 411 | _BCryptFinishHash: function(hHash: BCRYPT_HASH_HANDLE; pbOutput: Pointer; cbOutput: Cardinal; dwFlags: Cardinal): NTSTATUS; stdcall; 412 | _BCryptDestroyHash: function(hHash: BCRYPT_HASH_HANDLE): NTSTATUS; stdcall; 413 | _BCryptGenRandom: function({In_opt}hAlgorithm: BCRYPT_ALG_HANDLE; {Inout}pbBuffer: Pointer; cbBuffer: Cardinal; dwFlags: Cardinal): NTSTATUS; stdcall; 414 | _BCryptDeriveKeyPBKDF2: function(hPrf: BCRYPT_ALG_HANDLE; pbPassword: Pointer; cbPassword: Cardinal; pbSalt: Pointer; cbSalt: Cardinal; cIterations: UInt64; pbDerivedKey: Pointer; cbDerivedKey: Cardinal; dwFlags: Cardinal): NTSTATUS; stdcall; 415 | 416 | function FormatNTStatusMessage(const NTStatusMessage: NTSTATUS): string; 417 | var 418 | Buffer: PChar; 419 | Len: Integer; 420 | Hand: HMODULE; 421 | begin 422 | { 423 | KB259693: How to translate NTSTATUS error codes to message strings 424 | 425 | Obtain the formatted message for the given Win32 ErrorCode 426 | Let the OS initialize the Buffer variable. Need to LocalFree it afterward. 427 | } 428 | Hand := SafeLoadLibrary('ntdll.dll'); 429 | 430 | Len := FormatMessage( 431 | FORMAT_MESSAGE_ALLOCATE_BUFFER or 432 | FORMAT_MESSAGE_FROM_SYSTEM or 433 | // FORMAT_MESSAGE_IGNORE_INSERTS or 434 | // FORMAT_MESSAGE_ARGUMENT_ARRAY or 435 | FORMAT_MESSAGE_FROM_HMODULE, 436 | Pointer(Hand), 437 | NTStatusMessage, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), 438 | @Buffer, 0, nil); 439 | try 440 | //Remove the undesired line breaks and '.' char 441 | while (Len > 0) and (CharInSet(Buffer[Len - 1], [#0..#32, '.'])) do Dec(Len); 442 | //Convert to Delphi string 443 | SetString(Result, Buffer, Len); 444 | finally 445 | //Free the OS allocated memory block 446 | LocalFree(HLOCAL(Buffer)); 447 | end; 448 | FreeLibrary(Hand); 449 | end; 450 | 451 | procedure NTStatusCheck(Status: NTSTATUS); 452 | const 453 | SNTError = 'NT Error 0x%.8x: %s'; 454 | begin 455 | if (Status and $80000000) = 0 then //00: success, 01:information, 10: warning, 11: error 456 | Exit; 457 | 458 | raise EOleSysError.CreateFmt(SNTError, [ 459 | HResultFromNT(Status), 460 | FormatNTStatusMessage(Status) 461 | ]); 462 | end; 463 | 464 | function RRot32(const X: LongWord; const c: Byte): LongWord; //inline; 465 | begin 466 | //Any use of assembly is dwarfed by the fact that ASM functions cannot be inlined 467 | //Which forces a function call. Which drops us from 82MB/s -> 50 MB/s 468 | Result := (X shr c) or (X shl (32-c)); 469 | end; 470 | 471 | function LRot32(X: LongWord; c: Byte): LongWord; //inline; 472 | {IFDEF PUREPASCAL} 473 | begin 474 | Result := (X shl c) or (X shr (32-c)); 475 | {ELSE !PUREPASCAL} 476 | (* {$IFDEF CPUX86} 477 | asm 478 | MOV cl, c; 479 | ROL eax, cl; 480 | {$ENDIF CPUX86} 481 | {$IFDEF CPUX64} 482 | //http://blogs.msdn.com/b/oldnewthing/archive/2004/01/14/58579.aspx 483 | //In x64 calling convention the first four parameters are passed in rcx, rdx, r8, r9 484 | //Return value is in RAX 485 | asm 486 | MOV eax, ecx; //store result in eax 487 | MOV cl, c; //rol left only supports from rolling from cl 488 | ROL eax, cl; 489 | {$ENDIF} 490 | *) 491 | {ENDIF !PUREPASCAL} 492 | end; 493 | 494 | function ByteSwap(const X: Cardinal): Cardinal; //inline; 495 | begin 496 | { 497 | Reverses the byte order of a 32-bit register. 498 | } 499 | Result := 500 | ( X shr 24) or 501 | ((X shr 8) and $00FF00) or 502 | ((X shl 8) and $FF0000) or 503 | ( X shl 24); 504 | end; 505 | 506 | procedure RaiseOSError(ErrorCode: DWORD; Msg: string); 507 | var 508 | ex: EOSError; 509 | begin 510 | ex := EOSError.Create(Msg); 511 | ex.ErrorCode := error; 512 | raise Ex; 513 | end; 514 | 515 | type 516 | HCRYPTPROV = THandle; 517 | HCRYPTHASH = THandle; 518 | HCRYPTKEY = THandle; 519 | ALG_ID = LongWord; //unsigned int 520 | 521 | 522 | { SHA1 implemented in PurePascal} 523 | type 524 | TSHA1 = class(TInterfacedObject, IHashAlgorithm) 525 | private 526 | FInitialized: Boolean; 527 | FHashLength: ULARGE_INTEGER; //Number of bits put into the hash 528 | FHashBuffer: array[0..63] of Byte; //one step before W0..W15 529 | FHashBufferIndex: Integer; //Current position in HashBuffer 530 | FABCDEBuffer: array[0..4] of LongWord; //working hash buffer is 160 bits (20 bytes) 531 | procedure Compress; 532 | procedure UpdateLen(NumBytes: LongWord); 533 | procedure Burn; 534 | protected 535 | procedure HashCore(const Data; DataLen: Integer); 536 | function HashFinal: TBytes; 537 | 538 | function GetBlockSize: Integer; 539 | function GetDigestSize: Integer; 540 | 541 | procedure Initialize; 542 | public 543 | constructor Create; 544 | 545 | procedure HashData(const Buffer; BufferLen: Integer); 546 | function Finalize: TBytes; 547 | 548 | procedure SelfTest; 549 | end; 550 | 551 | { 552 | SHA-1 implemented by Microsoft Crypto Service Provider (CSP) 553 | } 554 | TCspHash = class(TInterfacedObject, IHashAlgorithm) 555 | private 556 | FProvider: HCRYPTPROV; 557 | FAlgorithmID: Cardinal; //CALG_SHA1, CALG_SHA256 558 | FBlockSize: Integer; //CSP doesn't provide a way to get the block size of a hash 559 | FHash: HCRYPTHASH; 560 | protected 561 | function GetBlockSize: Integer; //SHA-1 compresses in blocks of 64 bytes 562 | function GetDigestSize: Integer; //SHA-1 digest is 20 bytes (160 bits) 563 | 564 | procedure Initialize; 565 | procedure Burn; 566 | procedure HashCore(const Data; DataLen: Integer); 567 | function HashFinal: TBytes; 568 | public 569 | constructor Create(AlgorithmID: Cardinal; BlockSize: Integer); 570 | destructor Destroy; override; 571 | 572 | procedure HashData(const Buffer; BufferLen: Integer); 573 | function Finalize: TBytes; 574 | end; 575 | 576 | { 577 | Hash algorithms provided by the Microsoft Cryptography Next Generation (Cng) Provider 578 | } 579 | TCngHash = class(TInterfacedObject, IHashAlgorithm, IHmacAlgorithm) 580 | private 581 | FHmacKey: TBytes; 582 | FAlgorithm: BCRYPT_ALG_HANDLE; 583 | FAlgorithmBlockSize: Integer; 584 | FAlgorithmDigestSize: Integer; 585 | FHashObjectBuffer: TBytes; 586 | FHash: BCRYPT_HASH_HANDLE; 587 | class function GetBcryptAlgorithmBlockSize(Algorithm: BCRYPT_ALG_HANDLE): Integer; 588 | class function GetBcryptAlgorithmDigestSize(Algorithm: BCRYPT_ALG_HANDLE): Integer; 589 | protected 590 | procedure RequireBCrypt; 591 | function GetBlockSize: Integer; //e.g. SHA-1 compresses in blocks of 64 bytes 592 | function GetDigestSize: Integer; //e.g. SHA-1 digest is 20 bytes (160 bits) 593 | 594 | class function InitializeBCrypt: Boolean; 595 | 596 | procedure Initialize; 597 | procedure Burn; 598 | procedure HashCore(Hash: BCRYPT_HASH_HANDLE; const Data; DataLen: Integer); 599 | function HashFinal(Hash: BCRYPT_HASH_HANDLE): TBytes; 600 | public 601 | constructor Create(AlgorithmID: string; HmacMode: Boolean; Provider: PWideChar=nil); overload; 602 | constructor Create(const AlgorithmID: UnicodeString; HmacKey: TBytes); overload; 603 | destructor Destroy; override; 604 | 605 | class function IsAvailable: Boolean; 606 | 607 | { IHashAlgorithm } 608 | procedure HashData(const Buffer; BufferLen: Integer); overload; inline; 609 | function Finalize: TBytes; 610 | 611 | { IHmacAlgoritm } 612 | function HashData(const Key; KeyLen: Integer; const Data; DataLen: Integer): TBytes; overload; 613 | end; 614 | 615 | { 616 | SHA256 implemented in Pascal 617 | } 618 | type 619 | TSHA256 = class(TInterfacedObject, IHashAlgorithm) 620 | private 621 | FInitialized: Boolean; 622 | FHashLength: ULARGE_INTEGER; //Number of bits put into the hash 623 | FHashBuffer: array[0..63] of Byte; //one step before W0..W15 624 | FHashBufferIndex: Integer; //Current position in HashBuffer 625 | FCurrentHash: array[0..7] of LongWord; 626 | procedure Compress; 627 | procedure UpdateLen(NumBytes: LongWord); 628 | procedure Burn; 629 | protected 630 | function GetBlockSize: Integer; 631 | function GetDigestSize: Integer; 632 | 633 | procedure HashCore(const Data; DataLen: Integer); 634 | function HashFinal: TBytes; 635 | 636 | procedure Initialize; 637 | public 638 | constructor Create; 639 | 640 | procedure HashData(const Buffer; BufferLen: Integer); 641 | function Finalize: TBytes; 642 | end; 643 | 644 | { 645 | SHA-256 implemented by Microsoft Crypto Service Provider (CSP) 646 | } 647 | THmac = class(TInterfacedObject, IHmacAlgorithm) 648 | private 649 | FHash: IHashAlgorithm; 650 | protected 651 | function GetDigestSize: Integer; 652 | public 653 | constructor Create(Hash: IHashAlgorithm); 654 | function HashData(const Key; KeyLen: Integer; const Data; DataLen: Integer): TBytes; 655 | end; 656 | 657 | TRfc2898DeriveBytes = class(TInterfacedObject, IPBKDF2Algorithm) 658 | private 659 | FHMAC: IHmacAlgorithm; 660 | public 661 | constructor Create(HMAC: IHmacAlgorithm); 662 | function GetBytes(const Password: UnicodeString; const Salt; const SaltLength: Integer; IterationCount, DesiredBytes: Integer): TBytes; 663 | end; 664 | 665 | TBCryptDeriveKeyPBKDF2 = class(TInterfacedObject, IPBKDF2Algorithm) 666 | private 667 | FAlgorithm: BCRYPT_ALG_HANDLE; 668 | public 669 | constructor Create(const AlgorithmID: UnicodeString; const Provider: PWideChar); 670 | 671 | function GetBytes(const Password: UnicodeString; const Salt; const SaltLength: Integer; IterationCount, DesiredBytes: Integer): TBytes; 672 | end; 673 | 674 | { TScrypt } 675 | 676 | class function TScrypt.GetBytes(const Passphrase, Salt: UnicodeString; nDesiredBytes: Integer): TBytes; 677 | var 678 | scrypt: TScrypt; 679 | costFactor, blockSizeFactor, parallelizationFactor: Cardinal; 680 | begin 681 | scrypt := TScrypt.Create; 682 | try 683 | scrypt.GetDefaultParameters({out}costFactor, {out}blockSizeFactor, {out}parallelizationFactor); 684 | finally 685 | scrypt.Free; 686 | end; 687 | 688 | Result := TScrypt.GetBytes(Passphrase, Salt, costFactor, blockSizeFactor, parallelizationFactor, nDesiredBytes); 689 | end; 690 | 691 | procedure TScrypt.GetDefaultParameters(out CostFactor, BlockSizeFactor, ParallelizationFactor: Cardinal); 692 | const 693 | N_interactive = 14; //14 ==> 2^14 = 16,384 694 | // N_sensitive = 20; //20 ==> 2^20 = 1,048,576 695 | r = 8; 696 | p = 1; 697 | var 698 | t1, t2, freq: Int64; 699 | duration: Real; 700 | testCostFactor: Cardinal; 701 | begin 702 | { 703 | The time to run a full scrypt is linear in memory used; although CPU is slightly faster with doubled r over doubled N. 704 | 705 | Canonical scrypt runs a benchmark with N=14, r=1 (i.e. 128*1*2^14 = 128*1*16384 = 2MB) 706 | We'll do a 2MB benchmark, but using r=8, N=11 (i.e. 128*8*2^11 = 128*8* 2048 = 2MB) 707 | 708 | The target for a normal user is 250-500 ms 709 | 710 | | N | r | Time (ms) | Memory | 711 | |----|----|------------|---------| 712 | | 14 | 8 | 196.2 ms | 16 MB | <-- "normal" 713 | | 14 | 9 | 258.5 ms | 18 MB | 714 | | 14 | 10 | 265.8 ms | 20 MB | 715 | | 14 | 11 | 309.2 ms | 22 MB | 716 | | 14 | 12 | 320.2 ms | 24 MB | 717 | | 14 | 13 | 326.4 ms | 26 MB | 718 | | 14 | 14 | 346.1 ms | 28 MB | 719 | | 14 | 15 | 381.4 ms | 30 MB | 720 | | 14 | 16 | 418.9 ms | 32 MB | 721 | 722 | | 15 | 5 | 290.0 ms | 20 MB | 723 | | 15 | 6 | 331.6 ms | 24 MB | 724 | | 15 | 7 | 388.5 ms | 28 MB | 725 | | 15 | 8 | 427.6 ms | 32 MB | 726 | | 15 | 9 | 475.1 ms | 36 MB | 727 | 728 | | 16 | 2 | 236.3 ms | 16 MB | 729 | | 16 | 3 | 337.3 ms | 24 MB | 730 | | 16 | 4 | 436.7 ms | 32 MB | 731 | 732 | | 17 | 2 | 492.6 ms | 32 MB | 733 | 734 | | 18 | 2 | 982.1 ms | 64 MB | 735 | | 19 | 2 | 1977.1 ms | 128 MB | 736 | | 20 | 2 | 3972.0 ms | 256 MB | 737 | 738 | | 20 | 8 | 12838.9 ms | 1024 MB | 739 | 740 | Android disk encryption defaults are: 741 | 742 | - N=32767 (cost factor 15, 2^15 = 32767) 743 | - r=8 (block size is 8*128 = 1024 bytes) 744 | - p=2 (parallelaization factor) 745 | } 746 | 747 | CostFactor := 14; //i.e. 2^14 = 16,384 iterations, and randomly access 2^14*8*128 = 16 MB of RAM during the calculation 748 | BlockSizefactor := 8; //will operate on 8*128 = 1,024 byte blocks 749 | ParallelizationFactor := 1; 750 | 751 | //Benchmark the current computer, and see if it could be faster than 250ms to compute a hash 752 | testCostFactor := 11; 753 | QueryPerformanceCounter(t1); 754 | TScrypt.HashPassword('Benchmark', testCostFactor, 8, 1); 755 | QueryPerformanceCounter(t2); 756 | if not QueryPerformanceFrequency({var}freq) then Exit; 757 | 758 | duration := (t2-t1)/freq*1000; 759 | 760 | //Each single increase in CostFactor will double the execution time. 761 | //We don't want the execution time to exceed 500ms 762 | while (duration < 250) do 763 | begin 764 | duration := duration*2; 765 | testCostFactor := testCostFactor+1; 766 | end; 767 | 768 | //And we certainly won't go any lower than the default 14,8,1 (anyone remember 8,N,1 anymore?) 769 | if testCostFactor > CostFactor then 770 | begin 771 | OutputDebugString(PChar(Format('Increasing scrypt cost factor from default %d up to %d', [CostFactor, testCostFactor]))); 772 | CostFactor := testCostFactor; 773 | end; 774 | end; 775 | 776 | class function TScrypt.Base64Decode(const s: string): TBytes; 777 | 778 | function Char64(character: Char): Integer; 779 | begin 780 | if (Ord(character) > Length(Base64DecodeTable)) then 781 | begin 782 | Result := -1; 783 | Exit; 784 | end; 785 | 786 | Result := Base64DecodeTable[character]; 787 | end; 788 | 789 | procedure Append(value: Byte); 790 | var 791 | i: Integer; 792 | begin 793 | i := Length(Result); 794 | SetLength(Result, i+1); 795 | Result[i] := value; 796 | end; 797 | 798 | var 799 | i: Integer; 800 | len: Integer; 801 | c1, c2, c3, c4: Integer; 802 | begin 803 | SetLength(Result, 0); 804 | 805 | len := Length(s); 806 | i := 1; 807 | while i <= len do 808 | begin 809 | // We'll need to have at least 2 character to form one byte. 810 | // Anything less is invalid 811 | if (i+1) > len then 812 | raise EScryptException.Create('Invalid base64 hash string'); 813 | 814 | c1 := Char64(s[i ]); 815 | c2 := Char64(s[i+1]); 816 | c3 := -1; 817 | c4 := -1; 818 | if (i+2) <= len then 819 | begin 820 | c3 := Char64(s[i+2]); 821 | if (i+3) <= len then 822 | c4 := Char64(s[i+3]); 823 | end; 824 | Inc(i, 4); 825 | 826 | if (c1 = -1) or (c2 = -1) then 827 | raise EScryptException.Create('Invalid base64 hash string'); 828 | 829 | //Now we have at least one byte in c1|c2 830 | // c1 = ..111111 831 | // c2 = ..112222 832 | Append( ((c1 and $3f) shl 2) or (c2 shr 4) ); 833 | 834 | if (c3 = -1) then 835 | Exit; 836 | 837 | //Now we have the next byte in c2|c3 838 | // c2 = ..112222 839 | // c3 = ..222233 840 | Append( ((c2 and $0f) shl 4) or (c3 shr 2) ); 841 | 842 | //If there's a 4th caracter, then we can use c3|c4 to form the third byte 843 | if (c4 = -1) then 844 | Exit; 845 | 846 | //Now we have the next byte in c3|c4 847 | // c3 = ..222233 848 | // c4 = ..333333 849 | Append( ((c3 and $03) shl 6) or c4 ); 850 | end; 851 | end; 852 | 853 | class function TScrypt.Base64Encode(const data: array of Byte): string; 854 | 855 | const 856 | b64: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'; 857 | 858 | function EncodePacket(b1, b2, b3: Byte; Len: Integer): string; 859 | begin 860 | { 861 | 11111111 22222222 33333333 862 | \____/\_____/\_____/\____/ 863 | | | | | 864 | c1 c2 c3 c4 865 | } 866 | Result := '===='; 867 | 868 | Result[1] := Base64EncodeTable[b1 shr 2]; 869 | Result[2] := Base64EncodeTable[((b1 and $03) shl 4) or (b2 shr 4)]; 870 | if Len < 2 then Exit; 871 | 872 | Result[3] := Base64EncodeTable[((b2 and $0f) shl 2) or (b3 shr 6)]; 873 | if Len < 3 then Exit; 874 | 875 | Result[4] := Base64EncodeTable[b3 and $3f]; 876 | end; 877 | 878 | var 879 | i: Integer; 880 | len: Integer; 881 | b1, b2: Integer; 882 | begin 883 | Result := ''; 884 | 885 | len := Length(data); 886 | if len = 0 then 887 | Exit; 888 | 889 | //encode whole 3-byte chunks TV4S 6ytw fsfv kgY8 jIuc Drjc 8deX 1s. 890 | i := Low(data); 891 | while len >= 3 do 892 | begin 893 | Result := Result+EncodePacket(data[i], data[i+1], data[i+2], 3); 894 | Inc(i, 3); 895 | Dec(len, 3); 896 | end; 897 | 898 | if len = 0 then 899 | Exit; 900 | 901 | //encode partial final chunk 902 | Assert(len < 3); 903 | if len >= 1 then 904 | b1 := data[i] 905 | else 906 | b1 := 0; 907 | if len >= 2 then 908 | b2 := data[i+1] 909 | else 910 | b2 := 0; 911 | Result := Result+EncodePacket(b1, b2, 0, len); 912 | end; 913 | 914 | function TScrypt.BlockMix(const B: array of Byte): TBytes; 915 | var 916 | r: Integer; 917 | X: array[0..15] of LongWord; 918 | i: Integer; 919 | Y: TBytes; 920 | ne, no: Integer; //index even, index odd 921 | begin 922 | { 923 | Mix r 128-byte blocks (which is equivalent of saying 2r 64-byte blocks) 924 | } 925 | //Make sure we actually have an even multiple of 128 bytes 926 | if Length(B) mod 128 <> 0 then 927 | raise EScryptException.Create(''); 928 | r := Length(B) div 128; 929 | 930 | SetLength(Y, 128*r); 931 | 932 | //X <- B[2*r-1] 933 | //Copy last 64-byte block into X. 934 | Move(B[64*(2*r-1)], X[0], 64); 935 | 936 | 937 | for i := 0 to 2*r-1 do 938 | begin 939 | //T = X xor B[i] 940 | TScrypt.XorBlockInPlace(X[0], B[64*i], 64); 941 | 942 | //X = Salsa (T) 943 | Self.Salsa20InPlace(X[0]); 944 | 945 | //Y[i] = X 946 | Move(X[0], Y[64*i], 64); 947 | end; 948 | 949 | { 950 | Result = Y[0],Y[2],Y[4], ..., Y[2*r-2], Y[1],Y[3],Y[5], ..., Y[2*r-1] 951 | 952 | Result[ 0] := Y[ 0]; 953 | Result[ 1] := Y[ 2]; 954 | Result[ 2] := Y[ 4]; 955 | Result[ 3] := Y[ 6]; 956 | Result[ 4] := Y[ 8]; 957 | Result[ 5] := Y[10]; 958 | Result[ 6] := Y[ 1]; 959 | Result[ 7] := Y[ 3]; 960 | Result[ 8] := Y[ 5]; 961 | Result[ 9] := Y[ 7]; 962 | Result[10] := Y[ 9]; 963 | Result[11] := Y[11]; 964 | 965 | Result[ 0] := Y[ 0]; 966 | Result[ 6] := Y[ 1]; 967 | Result[ 1] := Y[ 2]; 968 | Result[ 7] := Y[ 3]; 969 | Result[ 2] := Y[ 4]; 970 | Result[ 8] := Y[ 5]; 971 | Result[ 3] := Y[ 6]; 972 | Result[ 9] := Y[ 7]; 973 | Result[ 4] := Y[ 8]; 974 | Result[10] := Y[ 9]; 975 | Result[ 5] := Y[10]; 976 | Result[11] := Y[11]; 977 | 978 | } 979 | SetLength(Result, Length(B)); 980 | i := 0; 981 | ne := 0; 982 | no := r; 983 | while (i <= 2*r-1) do 984 | begin 985 | Move(Y[64*(i )], Result[64*ne], 64); 986 | Move(Y[64*(i+1)], Result[64*no], 64); 987 | Inc(ne, 1); 988 | Inc(no, 1); 989 | Inc(i, 2); 990 | end; 991 | end; 992 | 993 | procedure TScrypt.BurnBytes(var data: TBytes); 994 | begin 995 | if Length(data) <= 0 then 996 | Exit; 997 | 998 | FillChar(data[Low(data)], Length(data), 0); 999 | SetLength(data, 0); 1000 | end; 1001 | 1002 | procedure TScrypt.BurnString(var s: UnicodeString); 1003 | begin 1004 | if Length(s) > 0 then 1005 | begin 1006 | UniqueString({var}s); //We can't FillChar the string if it's shared, or its in the constant data page 1007 | FillChar(s[1], Length(s), 0); 1008 | s := ''; 1009 | end; 1010 | end; 1011 | 1012 | class function TScrypt.CheckPassword(const Passphrase: UnicodeString; ExpectedHashString: string; out PasswordRehashNeeded: Boolean): Boolean; 1013 | var 1014 | scrypt: TScrypt; 1015 | costFactor, blockSizeFactor, parallelizationFactor: Cardinal; 1016 | salt, expected, actual: TBytes; 1017 | t1, t2, freq: Int64; 1018 | duration: Real; 1019 | preparedPassword: UnicodeString; 1020 | const 1021 | SCouldNotParsePassword = 'Could not parse expected password hash'; 1022 | begin 1023 | { 1024 | Validate the supplied password against the saved hash. 1025 | 1026 | Returns 1027 | True: If the password is valid 1028 | False: If the password is invalid 1029 | 1030 | PasswordRehashNeeded 1031 | Contains true if the user's password should be re-hashed and the new hash stored in the database. 1032 | The typical reason for rehashing is that the hash took less than the minimum 250ms to compute. The target is 250-500ms. 1033 | Another reason would be if the scrypt version has been updated, and the stored hash needs to be updated to the new 1034 | version. 1035 | 1036 | Contains false if the password does not need to be rehashed. 1037 | } 1038 | Result := False; 1039 | PasswordRehashNeeded := False; 1040 | scrypt := TScrypt.Create; 1041 | try 1042 | if not scrypt.TryParseHashString(ExpectedHashString, {out}costFactor, blockSizeFactor, parallelizationFactor, salt, expected) then 1043 | raise EScryptException.Create(SCouldNotParsePassword); 1044 | try 1045 | preparedPassword := TScrypt.PasswordStringPrep(Passphrase); 1046 | QueryPerformanceCounter(t1); 1047 | actual := scrypt.DeriveBytes(preparedPassword, salt, costFactor, blockSizeFactor, parallelizationFactor, Length(expected)); 1048 | QueryPerformanceCounter(t2); 1049 | 1050 | if Length(actual) <> Length(expected) then 1051 | Exit; 1052 | 1053 | Result := CompareMem(@expected[0], @actual[0], Length(expected)); 1054 | 1055 | if Result then 1056 | begin 1057 | //Only advertise a rehash being needed if they got the correct password. 1058 | //Don't want someone blindly re-hashing with a bad password because they forgot to check the result, 1059 | //or because they decided to handle "PasswordRehashNeeded" first. 1060 | if QueryPerformanceFrequency(freq) then 1061 | begin 1062 | duration := (t2-t1)/freq * 1000; //ms 1063 | if duration < 250 then 1064 | PasswordRehashNeeded := True; 1065 | end; 1066 | end; 1067 | finally 1068 | scrypt.BurnBytes(actual); 1069 | scrypt.BurnBytes(expected); 1070 | scrypt.BurnString(preparedPassword); 1071 | end; 1072 | finally 1073 | scrypt.Free; 1074 | end; 1075 | end; 1076 | 1077 | function TScrypt.DeriveBytes(const Passphrase: UnicodeString; const Salt: array of Byte; const CostFactor, 1078 | BlockSizeFactor, ParallelizationFactor: Integer; DesiredBytes: Integer): TBytes; 1079 | var 1080 | saltEx: TBytes; 1081 | begin 1082 | //Step 1. Use Scrypt to generate expensive salt 1083 | saltEx := Self.GenerateScryptSalt(Passphrase, Salt, CostFactor, BlockSizeFactor, ParallelizationFactor); 1084 | 1085 | //Step 2. Use PBDKF2 with our password, but use B as the salt 1086 | Result := Self.PBKDF2(Passphrase, Pointer(saltEx)^, Length(saltEx), 1, DesiredBytes); 1087 | end; 1088 | 1089 | function TScrypt.FormatPasswordHash(const costFactor, blockSizeFactor, parallelizationFactor: Integer; const Salt, 1090 | DerivedBytes: array of Byte): string; 1091 | const 1092 | SCRYPT_MCF_ID = '$s1'; 1093 | var 1094 | parameters: Cardinal; 1095 | begin 1096 | { 1097 | We will use libscrypt's format 1098 | 1099 | Modular Crypt Format support for scrypt 1100 | https://github.com/jvarho/pylibscrypt/blob/master/pylibscrypt/mcf.py 1101 | 1102 | Compatible with libscrypt scrypt_mcf_check also supports the $7$ format. 1103 | 1104 | libscrypt format: 1105 | 1106 | $s1$NNrrpp$salt$hash 1107 | NN - hex encoded N log2 (two hex digits) 1108 | rr - hex encoded r in 1-255 1109 | pp - hex encoded p in 1-255 1110 | salt - base64 encoded salt 1-16 bytes decoded 1111 | hash - base64 encoded 64-byte scrypt hash 1112 | } 1113 | if (CostFactor < 1) or (CostFactor > 255) then 1114 | raise EScryptException.CreateFmt('Invalid CostFactor %d', [CostFactor]); 1115 | if (BlockSizeFactor < 1) or (BlockSizeFactor > 255) then 1116 | raise EScryptException.CreateFmt('Invalid BlockSizeFactor %d', [BlockSizeFactor]); 1117 | if (ParallelizationFactor < 1) or (ParallelizationFactor > 255) then 1118 | raise EScryptException.CreateFmt('Invalid ParallelizationFactor %d', [ParallelizationFactor]); 1119 | 1120 | parameters := (CostFactor shl 16) 1121 | or (BlockSizeFactor shl 8) 1122 | or (ParallelizationFactor); 1123 | 1124 | //$s1$0e0801$TWlzcyB5b3UgS2lyc3Rlbg==$SXQncyBkb2Vzbid0IHdvcmsgb3V0IGZvciBldmVyeW9uZS5Ob3QgZXZlcnlvbmUgZ2V0cyB0byBiZSBsb3ZlZA== 1125 | 1126 | Result := SCRYPT_MCF_ID+ 1127 | '$'+IntToHex(parameters, 6)+ 1128 | '$'+Self.Base64Encode(Salt)+ 1129 | '$'+Self.Base64Encode(DerivedBytes); 1130 | end; 1131 | 1132 | constructor TScrypt.Create; 1133 | begin 1134 | inherited Create; 1135 | end; 1136 | 1137 | class function TScrypt.CreateObject(ObjectName: string): IInterface; 1138 | const 1139 | BCRYPT_SHA1_ALGORITHM = 'SHA1'; 1140 | BCRYPT_SHA256_ALGORITHM = 'SHA256'; 1141 | 1142 | SUnknownAlgorithm = 'Unknown algorithm "%s" requested'; 1143 | 1144 | function IsAlgo(s: string): Boolean; 1145 | begin 1146 | Result := AnsiSameText(ObjectName, s); 1147 | end; 1148 | begin 1149 | { 1150 | We contain a number of hash algorithms. 1151 | It might be nice to let people outside us to get ahold of them. 1152 | 1153 | ObjectName can be one of the following strings 1154 | 1155 | | ObjectName | Description | Returned Interface | 1156 | |----------------------------|-------------------------------------|---------------------| 1157 | | 'SHA1' | SHA-1, best implementation | IHashAlgorithm | 1158 | | 'SHA1.Cng' | SHA-1, Crypto Next Gen (Cng) | IHashAlgorithm | 1159 | | 'SHA1.Csp' | SHA-1, Crypto API | IHashAlgorithm | 1160 | | 'SHA1.PurePascal' | SHA-1, pure pascal | IHashAlgorithm | 1161 | 1162 | | 'SHA256' | SHA256, best implementation | IHashAlgorithm | 1163 | | 'SHA256.Cng' | SHA256, Crypto Next Gen (Cng) | IHashAlgorithm | 1164 | | 'SHA256.Csp' | SHA256, Crypto API | IHashAlgorithm | 1165 | | 'SHA256.PurePascal | SHA256, pure pascal | IHashAlgorithm | 1166 | 1167 | | 'HMAC.SHA1' | HMAC-SHA1 | IHmacAlgorithm | 1168 | | 'HMAC.SHA1.Cng' | HMAC-SHA1, Crypto Next Gen | IHmacAlgorithm | 1169 | | 'HMAC.SHA1.PurePascal' | HMAC-SHA1, pure pascal | IHmacAlgorithm | 1170 | 1171 | | 'HMAC.SHA2561' | HMAC-SHA256 | IHmacAlgorithm | 1172 | | 'HMAC.SHA256.Cng' | HMAC-SHA256, Crypto Next Gen | IHmacAlgorithm | 1173 | | 'HMAC.SHA256.PurePascal' | HMAC-SHA256, pure pascal | IHmacAlgorithm | 1174 | 1175 | | 'PBKDF2.SHA1' | PBKDF-SHA1, best implementation | IPBKDF2Algorithm | 1176 | | 'PBKDF2.SHA1.Cng' | PBKDF-SHA1, Crypto Next Gen (Cng) | IPBKDF2Algorithm | 1177 | | 'PBKDF2.SHA1.PurePascal' | PBKDF-SHA1, Pure pascal | IPBKDF2Algorithm | 1178 | 1179 | | 'PBKDF2.SHA256' | PBKDF-SHA256, best implementation | IPBKDF2Algorithm | 1180 | | 'PBKDF2.SHA256.Cng' | PBKDF-SHA256, Crypto Next Gen (Cng) | IPBKDF2Algorithm | 1181 | | 'PBKDF2.SHA256.PurePascal' | PBKDF-SHA256, Pure pascal | IPBKDF2Algorithm | 1182 | 1183 | } 1184 | if IsAlgo('SHA1') then 1185 | begin 1186 | {$IFDEF MSWINDOWS} 1187 | //Microsoft SHA1 Cng and CSP versions are about 87% faster than our "PurePascal" versions 1188 | if TCngHash.IsAvailable then 1189 | ObjectName := 'SHA1.Cng' 1190 | else 1191 | ObjectName := 'SHA1.Csp'; 1192 | {$ELSE} 1193 | ObjectName := 'SHA1.PurePascal'; 1194 | {$ENDIF} 1195 | Result := TScrypt.CreateObject(ObjectName); 1196 | Exit; 1197 | end; 1198 | 1199 | if IsAlgo('SHA256') then 1200 | begin 1201 | {$IFDEF MSWINDOWS} 1202 | //Microsoft SHA256 Cng and CSP versions are about 87% faster than our "PurePascal" versions 1203 | if TCngHash.IsAvailable then 1204 | ObjectName := 'SHA256.Cng' 1205 | else 1206 | ObjectName := 'SHA256.Csp'; 1207 | {$ELSE} 1208 | ObjectName := 'SHA256.PurePascal'; 1209 | {$ENDIF} 1210 | Result := TScrypt.CreateObject(ObjectName); 1211 | Exit; 1212 | end; 1213 | 1214 | if IsAlgo('HMAC.SHA1') then 1215 | begin 1216 | {$IFDEF MSWINDOWS} 1217 | //Microsoft Cng provides a full HMAC implementation using SHA-1 1218 | if TCngHash.IsAvailable then 1219 | ObjectName := 'HMAC.SHA1.Cng' 1220 | else 1221 | ObjectName := 'HMAC.SHA1.PurePascal'; 1222 | {$ELSE} 1223 | ObjectName := 'HMAC.SHA1.PurePascal'; 1224 | {$ENDIF} 1225 | Result := TScrypt.CreateObject(ObjectName); 1226 | Exit; 1227 | end; 1228 | 1229 | if IsAlgo('HMAC.SHA256') then 1230 | begin 1231 | {$IFDEF MSWINDOWS} 1232 | //Microsoft Cng provides a full HMAC implementation using SHA256 1233 | if TCngHash.IsAvailable then 1234 | ObjectName := 'HMAC.SHA256.Cng' 1235 | else 1236 | ObjectName := 'HMAC.SHA256.PurePascal'; 1237 | {$ELSE} 1238 | ObjectName := 'HMAC.SHA256.PurePascal'; 1239 | {$ENDIF} 1240 | Result := TScrypt.CreateObject(ObjectName); 1241 | Exit; 1242 | end; 1243 | 1244 | 1245 | { SHA1 } 1246 | if IsAlgo('SHA1.PurePascal') then Result := TSHA1.Create 1247 | else if IsAlgo('SHA1.Csp') then Result := TCspHash.Create(CALG_SHA1, 64) 1248 | else if IsAlgo('SHA1.Cng') then Result := TCngHash.Create(BCRYPT_SHA1_ALGORITHM, False) 1249 | 1250 | { SHA256 } 1251 | else if IsAlgo('SHA256.PurePascal') then Result := TSHA256.Create 1252 | else if IsAlgo('SHA256.Csp') then Result := TCspHash.Create(CALG_SHA_256, 64) 1253 | else if IsAlgo('SHA256.Cng') then Result := TCngHash.Create(BCRYPT_SHA256_ALGORITHM, False) 1254 | 1255 | { HMAC - SHA1 } 1256 | else if IsAlgo('HMAC.SHA1.PurePascal') then Result := THmac.Create(TSHA1.Create) 1257 | else if IsAlgo('HMAC.SHA1.csp') then Result := THmac.Create(TCspHash.Create(CALG_SHA1, 64)) 1258 | else if IsAlgo('HMAC.SHA1.Cng') then Result := TCngHash.Create(BCRYPT_SHA1_ALGORITHM, True) 1259 | 1260 | { HMAC - SHA256 } 1261 | else if IsAlgo('HMAC.SHA256.PurePascal') then Result := THmac.Create(TSHA256.Create) 1262 | else if IsAlgo('HMAC.SHA256.csp') then Result := THmac.Create(TCspHash.Create(CALG_SHA_256, 64)) 1263 | else if IsAlgo('HMAC.SHA256.Cng') then Result := TCngHash.Create(BCRYPT_SHA256_ALGORITHM, True) 1264 | 1265 | { PBKDF2 - SHA1 } 1266 | else if IsAlgo('PBKDF2.SHA1') then 1267 | begin 1268 | if TCngHash.IsAvailable then 1269 | Result := TScrypt.CreateObject('PBKDF2.SHA1.Cng') 1270 | else 1271 | Result := TScrypt.CreateObject('PBKDF2.SHA1.PurePascal'); 1272 | end 1273 | else if IsAlgo('PBKDF2.SHA1.PurePascal') then Result := TRfc2898DeriveBytes.Create(THmac.Create(TSHA1.Create)) 1274 | else if IsAlgo('PBKDF2.SHA1.Cng') then Result := TBCryptDeriveKeyPBKDF2.Create(BCRYPT_SHA1_ALGORITHM, nil) 1275 | 1276 | { PBKDF2 - SHA256 } 1277 | else if IsAlgo('PBKDF2.SHA256') then 1278 | begin 1279 | if TCngHash.IsAvailable then 1280 | Result := TScrypt.CreateObject('PBKDF2.SHA256.Cng') 1281 | else 1282 | Result := TScrypt.CreateObject('PBKDF2.SHA256.PurePascal'); 1283 | end 1284 | else if IsAlgo('PBKDF2.SHA256.PurePascal') then Result := TRfc2898DeriveBytes.Create(THmac.Create(TSHA256.Create)) 1285 | else if IsAlgo('PBKDF2.SHA256.Cng') then Result := TBCryptDeriveKeyPBKDF2.Create(BCRYPT_SHA256_ALGORITHM, nil) 1286 | 1287 | else 1288 | raise Exception.CreateFmt(SUnknownAlgorithm, [ObjectName]); 1289 | end; 1290 | 1291 | function TScrypt.GenerateSalt: TBytes; 1292 | var 1293 | type4Uuid: TGUID; 1294 | salt: TBytes; 1295 | const 1296 | SCRYPT_SALT_LEN = 16; //This is just a recommended size 1297 | begin 1298 | //Salt is a 128-bit (16 byte) random value 1299 | SetLength(salt, SCRYPT_SALT_LEN); 1300 | 1301 | //Type 4 UUID (RFC 4122) is a handy source of (almost) 128-bits of random data (actually 120 bits) 1302 | //But the security doesn't come from the salt being secret, it comes from the salt being different each time 1303 | OleCheck(CoCreateGUID(type4Uuid)); 1304 | 1305 | Move(type4Uuid.D1, salt[0], SCRYPT_SALT_LEN); //i.e. move 16 bytes 1306 | 1307 | Result := salt; 1308 | end; 1309 | 1310 | function TScrypt.GenerateScryptSalt(const Passphrase: UnicodeString; const Salt: array of Byte; const CostFactor, 1311 | BlockSizeFactor, ParallelizationFactor: Integer): TBytes; 1312 | var 1313 | B: TBytes; 1314 | i: Integer; //UInt64; 20180913 It can't *literally* be a UInt64. 1315 | blockSize: Integer; 1316 | blockIndex: Integer; 1317 | T: TBytes; 1318 | begin 1319 | blockSize := 128*BlockSizeFactor; 1320 | 1321 | //Step 1. Use PBKDF2 to generate the initial blocks 1322 | B := Self.PBKDF2(Passphrase, Addr(salt)^, Length(salt), 1, ParallelizationFactor*blockSize); 1323 | 1324 | //Step 2. Run RoMix on each block 1325 | { 1326 | Each each ROMix operation can run in parallal on each block. 1327 | But the downside is that each ROMix itself will consume blockSize*Cost memory. 1328 | 1329 | LiteCoin uses 1330 | Cost: 1,024 (costFactor=10 ==> 2^10 = 1024) 1331 | blockSize: 128 bytes (r=1) 1332 | parallelizationFactor: 1 (p=1) 1333 | 1334 | B: [128] 1335 | } 1336 | i := 0; 1337 | SetLength(T, 0); //to shut up the compiler's "Variable 'T' might not have been initialized". It's because secretly a return value is actually a var parameter. 1338 | while i < ParallelizationFactor do 1339 | begin 1340 | //B[i] <- ROMix(B[i]) 1341 | blockIndex := i*blockSize; 1342 | T := Self.ROMix(B[blockIndex], blockSize, CostFactor); 1343 | Move(T[0], B[blockIndex], blockSize); 1344 | Inc(i); 1345 | end; 1346 | 1347 | Result := B; 1348 | end; 1349 | 1350 | class function TScrypt.GetBytes(const Passphrase, Salt: UnicodeString; CostFactor, BlockSizeFactor, ParallelizationFactor: Cardinal; DesiredBytes: Integer): TBytes; 1351 | var 1352 | preparedPassword: UnicodeString; 1353 | saltUtf8: TBytes; 1354 | scrypt: TScrypt; 1355 | begin 1356 | { 1357 | BlockSize = BlockSizeFactor*128 bytes 1358 | Iterations = 2^CostFactor 1359 | 1360 | Memory requirement: BlockSize * Iterations = 128*BlockSizeFactor*(2^CostFactor) 1361 | } 1362 | preparedPassword := TScrypt.PasswordStringPrep(Passphrase); 1363 | saltUtf8 := TScrypt.StringToUtf8(Salt); 1364 | 1365 | scrypt := TScrypt.Create; 1366 | try 1367 | Result := scrypt.DeriveBytes(preparedPassword, saltUtf8, CostFactor, BlockSizeFactor, ParallelizationFactor, DesiredBytes); 1368 | finally 1369 | scrypt.Free; 1370 | end; 1371 | end; 1372 | 1373 | class function TScrypt.HashPassword(const Passphrase: UnicodeString): string; 1374 | var 1375 | costFactor: Cardinal; 1376 | blockSizeFactor: Cardinal; 1377 | parallelizationFactor: Cardinal; 1378 | scrypt: TScrypt; 1379 | begin 1380 | { 1381 | Generate a password hash, letting TScrypt decide the best parameters. 1382 | 1383 | Password hash is returned as a string of the form: 1384 | 1385 | $s1$NNrrpp$salt$hash 1386 | NN - hex encoded N log2 (two hex digits) 1387 | rr - hex encoded r in 1-255 1388 | pp - hex encoded p in 1-255 1389 | salt - base64 encoded salt 1-16 bytes decoded 1390 | hash - base64 encoded 64-byte scrypt hash 1391 | 1392 | For example. 1393 | Password: "correct horse battery staple" 1394 | Hash: "$s1$0E0801$G34Rvmk2DSkp9sFJyyM49O$z3XxEUNlHDhq2nCR1Yh4tqKCelFQ9gnFNgtmgoBJHW4zeAIDoAjV5zcOLYk5lLqoGEFQNQ6YoOvXHAlVjPJS9e" 1395 | 1396 | CostFactor: 0x0E (14), Cost=2^14 = 16384 1397 | BlockSizeFacdtor: 0x08, BlockSize = 128*8 = 1,024 bytes 1398 | Parallelization Factor: 0x1 1399 | Salt (base64): G34Rvmk2DSkp9sFJyyM49O 1400 | Password (base64): z3XxEUNlHDhq2nCR1Yh4tqKCelFQ9gnFNgtmgoBJHW4zeAIDoAjV5zcOLYk5lLqoGEFQNQ6YoOvXHAlVjPJS9e 1401 | } 1402 | scrypt := TScrypt.Create; 1403 | try 1404 | scrypt.GetDefaultParameters({out}costFactor, {out}blockSizeFactor, {out}parallelizationFactor); 1405 | finally 1406 | scrypt.Free; 1407 | end; 1408 | 1409 | Result := TScrypt.HashPassword(Passphrase, costFactor, blockSizeFactor, parallelizationFactor); 1410 | end; 1411 | 1412 | class function TScrypt.HashPassword(const Passphrase: UnicodeString; CostFactor, BlockSizeFactor, ParallelizationFactor: Cardinal): string; 1413 | var 1414 | scrypt: TScrypt; 1415 | salt, derivedBytes: TBytes; 1416 | preparedPassword: UnicodeString; 1417 | begin 1418 | { 1419 | Hash the password, using the supplied parameters. 1420 | 1421 | CostFactor: log2(N), N = 2^costFactor 1422 | BlockSizeFactor: r 1423 | ParallelizationFactor: p 1424 | 1425 | Password hash is returned as a string of the form: 1426 | 1427 | $s1$NNrrpp$salt$hash 1428 | NN - hex encoded cost factor (i.e. log2(N) ) (two hex digits) 1429 | rr - hex encoded r in 1-255 1430 | pp - hex encoded p in 1-255 1431 | salt - base64 encoded salt 1-16 bytes decoded 1432 | hash - base64 encoded 64-byte scrypt hash 1433 | 1434 | For example. 1435 | Password: "correct horse battery staple" 1436 | Hash: "$s1$0E0801$G34Rvmk2DSkp9sFJyyM49O$z3XxEUNlHDhq2nCR1Yh4tqKCelFQ9gnFNgtmgoBJHW4zeAIDoAjV5zcOLYk5lLqoGEFQNQ6YoOvXHAlVjPJS9e" 1437 | 1438 | CostFactor: 0x0E (14), Cost=2^14 = 16384 1439 | BlockSizeFacdtor: 0x08, BlockSize = 128 * 8 = 1,024 bytes 1440 | Parallelization Factor: 0x1 1441 | Salt (base64): G34Rvmk2DSkp9sFJyyM49O 1442 | Password (base64): z3XxEUNlHDhq2nCR1Yh4tqKCelFQ9gnFNgtmgoBJHW4zeAIDoAjV5zcOLYk5lLqoGEFQNQ6YoOvXHAlVjPJS9e 1443 | 1444 | Background 1445 | =========== 1446 | 1447 | Someone already decided on a standard string way to represent scrypt passwords. 1448 | https://github.com/wg/scrypt 1449 | 1450 | We'll gravitate to any existing standard we can find 1451 | 1452 | $s0$params$salt$key 1453 | s0 - version 0 of the format with 128-bit salt and 256-bit derived key 1454 | params - 32-bit hex integer containing log2(N) (16 bits), r (8 bits), and p (8 bits) 1455 | salt - base64-encoded salt 1456 | key - base64-encoded derived key 1457 | 1458 | Example: 1459 | 1460 | $s0$e0801$epIxT/h6HbbwHaehFnh/bw==$7H0vsXlY8UxxyW/BWx/9GuY7jEvGjT71GFd6O4SZND0= 1461 | 1462 | passwd = "secret" 1463 | N = 16384 1464 | r = 8 1465 | p = 1 1466 | 1467 | There is another standard out there, published by the guy who authored the rfc. 1468 | 1469 | Unix crypt using scrypt 1470 | https://gitorious.org/scrypt/ietf-scrypt/raw/7c4a7c47d32a5dbfd43b1223e4b9ac38bfe6f8a0:unix-scrypt.txt 1471 | 1472 | > This document specify a new Unix crypt method based on the scrypt 1473 | > password-based key derivation function. It uses the 1474 | 1475 | $$$ 1476 | 1477 | convention introduced with the old MD5-based solution and also used by 1478 | the more recent SHA-256/SHA-512 mechanism specified here: 1479 | 1480 | http://www.akkadia.org/drepper/sha-crypt.html 1481 | 1482 | The scrypt method uses the following value: 1483 | 1484 | ID | Method 1485 | ------------------------------- 1486 | 7 | scrypt 1487 | 1488 | The scrypt method requires three parameters in the SALT value: N, r 1489 | and p which are expressed like this: 1490 | 1491 | N=,r=,p=

$ 1492 | 1493 | where N, r and p are unsigned decimal numbers that are used as the 1494 | scrypt parameters. 1495 | 1496 | The PWD part is the password string, and the size is fixed to 86 1497 | characters which corresponds to 64 bytes base64 encoded. 1498 | 1499 | To compute the PWD part, run the scrypt algorithm with the password, 1500 | salt, parameters to generate 64 bytes and base64 encode it. 1501 | 1502 | And then theres: 1503 | https://github.com/jvarho/pylibscrypt/blob/master/pylibscrypt/mcf.py 1504 | 1505 | Modular Crypt Format support for scrypt 1506 | 1507 | Compatible with libscrypt scrypt_mcf_check also supports the $7$ format. 1508 | 1509 | Which is the format i chose 1510 | } 1511 | scrypt := TScrypt.Create; 1512 | try 1513 | salt := scrypt.GenerateSalt; 1514 | 1515 | preparedPassword := TScrypt.PasswordStringPrep(Passphrase); 1516 | try 1517 | derivedBytes := scrypt.DeriveBytes(preparedPassword, salt, costFactor, blockSizeFactor, ParallelizationFactor, SCRYPT_HASH_LEN); 1518 | finally 1519 | scrypt.BurnString({var}preparedPassword); 1520 | end; 1521 | 1522 | Result := scrypt.FormatPasswordHash(costFactor, blockSizeFactor, ParallelizationFactor, salt, derivedBytes); 1523 | finally 1524 | scrypt.Free; 1525 | end; 1526 | end; 1527 | 1528 | (*function TScrypt.HMAC(const Hash: IHashAlgorithm; const Key; KeyLen: Integer; const Data; DataLen: Integer): TBytes; 1529 | var 1530 | oKeyPad, iKeyPad: TBytes; 1531 | i, n: Integer; 1532 | digest: TBytes; 1533 | blockSize: Integer; 1534 | 1535 | type 1536 | PUInt64Array = ^TUInt64Array_Unsafe; 1537 | TUInt64Array_Unsafe = array[0..MaxInt div 16] of UInt64; 1538 | 1539 | begin 1540 | { 1541 | Implementation of RFC2104 HMAC: Keyed-Hashing for Message Authentication 1542 | 1543 | Tested with known test vectors from RFC2202: Test Cases for HMAC-MD5 and HMAC-SHA-1 1544 | } 1545 | blockSize := Hash.BlockSize; 1546 | 1547 | // Clear pads 1548 | SetLength(oKeyPad, blockSize); //elements will be initialized to zero by SetLength 1549 | SetLength(iKeyPad, blockSize); //elements will be initialized to zero by SetLength 1550 | 1551 | // if key is longer than blocksize: reset it to key=Hash(key) 1552 | if KeyLen > blockSize then 1553 | begin 1554 | Hash.HashData(Key, KeyLen); 1555 | digest := Hash.Finalize; 1556 | 1557 | //Store hashed key in pads 1558 | Move(digest[0], iKeyPad[0], Length(digest)); //remaining bytes will remain zero 1559 | Move(digest[0], oKeyPad[0], Length(digest)); //remaining bytes will remain zero 1560 | end 1561 | else 1562 | begin 1563 | //Store original key in pads 1564 | Move(Key, iKeyPad[0], KeyLen); //remaining bytes will remain zero 1565 | Move(Key, oKeyPad[0], KeyLen); //remaining bytes will remain zero 1566 | end; 1567 | 1568 | { 1569 | Xor key with ipad and ipod constants 1570 | iKeyPad = key xor 0x36 1571 | oKeyPad = key xor 0x5c 1572 | 1573 | DONE: Unroll this to blockSize div 4 xor's of $5c5c5c5c and $36363636 1574 | } 1575 | n := blockSize div SizeOf(UInt64); 1576 | for i := 0 to n-1 do 1577 | PUInt64Array(@oKeyPad[0])[i] := PUInt64Array(@oKeyPad[0])[i] xor UInt64($5c5c5c5c5c5c5c5c); 1578 | for i := 0 to n-1 do 1579 | PUInt64Array(@iKeyPad[0])[i] := PUInt64Array(@iKeyPad[0])[i] xor UInt64($3636363636363636); 1580 | n := blockSize mod SizeOf(UInt64); 1581 | if n <> 0 then 1582 | begin 1583 | //This should never happen in practice. 1584 | //Hash block sizes are going to be multiple of 8 bytes 1585 | for i := blockSize-1-n to blockSize-1 do 1586 | begin 1587 | oKeyPad[i] := oKeyPad[i] xor $5c; 1588 | iKeyPad[i] := iKeyPad[i] xor $36; 1589 | end; 1590 | end; 1591 | 1592 | { 1593 | Result := hash(oKeyPad || hash(iKeyPad || message)) 1594 | } 1595 | // Perform inner hash: digest = Hash(iKeyPad || data) 1596 | SetLength(iKeyPad, blockSize+DataLen); 1597 | Move(data, iKeyPad[blockSize], DataLen); 1598 | Hash.HashData(iKeyPad[0], Length(iKeyPad)); 1599 | digest := Hash.Finalize; 1600 | 1601 | // perform outer hash: result = Hash(oKeyPad || digest) 1602 | SetLength(oKeyPad, blockSize+Length(digest)); 1603 | Move(digest[0], oKeyPad[blockSize], Length(digest)); 1604 | Hash.HashData(oKeyPad[0], Length(oKeyPad)); 1605 | Result := Hash.Finalize; 1606 | end;*) 1607 | 1608 | function TScrypt.PBKDF2(const Password: UnicodeString; const Salt; const SaltLength: Integer; IterationCount, DesiredBytes: Integer): TBytes; 1609 | var 1610 | rfc: IPBKDF2Algorithm; 1611 | begin 1612 | rfc := Self.CreateObject('PBKDF2.SHA256') as IPBKDF2Algorithm; 1613 | Result := rfc.GetBytes(Password, Salt, SaltLength, IterationCount, DesiredBytes); 1614 | end; 1615 | 1616 | function TScrypt.ROMix(const B; BlockSize, CostFactor: Cardinal): TBytes; 1617 | var 1618 | r: Cardinal; 1619 | N: UInt64; 1620 | X: TBytes; 1621 | V: TBytes; 1622 | i: Cardinal; 1623 | //j: UInt64; 1624 | j: LongWord; 1625 | T: TBytes; 1626 | const 1627 | SInvalidBlockLength = 'ROMix input is not multiple of 128-bytes'; 1628 | SInvalidCostFactorTooLow = 'CostFactor %d must be greater than zero'; 1629 | SInvalidCostFactorArgument = 'CostFactor %d must be less than 16r (%d)'; 1630 | begin 1631 | { 1632 | B: block of r*128 bytes. 1633 | For example, r=5 ==> block size is 5*128 = 640 bytes 1634 | 1635 | B: [640 bytes] 1636 | 1637 | Cost: 2^CostFactor. Number of copies of B we will be working with 1638 | 1639 | For example, CostFactor=3 ==> Cost = 2^3 = 6 1640 | 1641 | V: [640 bytes][640 bytes][640 bytes][640 bytes][640 bytes][640 bytes] 1642 | V0 V1 V2 V3 V4 V5 1643 | 1644 | LiteCoin, for example, uses a blocksize of 128 (r=1) 1645 | and Cost of 1024: 1646 | 1647 | V: [128][128][128]...[128] 128KB total 1648 | V0 V1 V2 V1024 1649 | } 1650 | if BlockSize mod 128 <> 0 then 1651 | raise EScryptException.Create(SInvalidBlockLength); 1652 | r := BlockSize div 128; 1653 | 1654 | { 1655 | Cost (N) = 2^CostFactor (we specify cost factor like BCrypt does, as a the exponent of a two) 1656 | 1657 | SCrypt rule dictates: 1658 | 1659 | N < 2^(128*r/8) 1660 | N < 2^(16r) 1661 | 1662 | 2^CostFactor < 2^(16r) 1663 | 1664 | CostFactor < 16r 1665 | } 1666 | if CostFactor <= 0 then 1667 | raise EScryptException.CreateFmt(SInvalidCostFactorTooLow, [CostFactor]); 1668 | if CostFactor >= (16*r) then 1669 | raise EScryptException.CreateFmt(SInvalidCostFactorArgument, [CostFactor, 16*r]); 1670 | 1671 | //N <- 2^CostFactor 1672 | N := (1 shl CostFactor); 1673 | 1674 | //Delphi's GetMem and SetLength are limited to signed 32-bits (<21474836468) 1675 | //That means that N*r*128 < 21474836468 1676 | if (Int64(N)*Int64(r)*128) >= $7FFFFFFF then 1677 | raise EScryptException.CreateFmt('Parameters N (%d) and r (%d) use exceed available memory usage (%d bytes)', [N, r, Int64(N)*r*128]); 1678 | 1679 | //Step 1: X <- B 1680 | SetLength(X, BlockSize); 1681 | Move(B, X[0], BlockSize); 1682 | 1683 | //Step 2 - Create N copies of B 1684 | //V <- N copies of B 1685 | SetLength(V, BlockSize*N); 1686 | for i := 0 to N-1 do 1687 | begin 1688 | //V[i] <- X 1689 | Move(X[0], V[BlockSize*i], BlockSize); 1690 | 1691 | //X <- BlockMix(X) 1692 | X := Self.BlockMix(X); //first iteration values match the BlockMix test vectors 1693 | end; 1694 | 1695 | //Step 3 1696 | SetLength(T, BlockSize); 1697 | for i := 0 to N-1 do 1698 | begin 1699 | //j <- Integerify(X) mod N 1700 | 1701 | //Convert first 8-bytes of the *last* 64-byte block of X to a UInt64, assuming little endian (Intel) format 1702 | //j := PUInt64(@X[BlockSize-64])^; //0xE2B6E8D50510A964 = 16,336,500,699,943,709,028 1703 | //j := j and (N-1); //because N is a power of 2 (N == 2^costFactor), an optimization is simple bitmasking 1704 | 1705 | j := PLongWord(@X[BlockSize-64])^; //0xE2B6E8D50510A964 = 16,336,500,699,943,709,028 1706 | j := j and (N-1); //because N is a power of 2 (N == 2^costFactor), an optimization is simple bitmasking 1707 | 1708 | //T <- X xor V[j] 1709 | //X <- BlockMix(T) 1710 | Move(V[BlockSize*j], T[0], BlockSize); 1711 | TScrypt.XorBlockInPlace(T[0], X[0], BlockSize); 1712 | X := Self.BlockMix(T); 1713 | end; 1714 | 1715 | Result := X; 1716 | end; 1717 | 1718 | {$OVERFLOWCHECKS OFF} 1719 | procedure TScrypt.Salsa20InPlace(var Input); 1720 | var 1721 | i: Integer; 1722 | Result: PLongWordArray; 1723 | x00, x01, x02, x03, 1724 | x04, x05, x06, x07, 1725 | x08, x09, x10, x11, 1726 | x12, x13, x14, x15: LongWord; 1727 | begin 1728 | { 1729 | The 64-byte input x to Salsa20 is viewed in little-endian form as 16 UInt32's 1730 | } 1731 | //Storing array values in local variables can avoid array bounds checking and indirection lookups every time, giving 4.4% performance boost 1732 | { 1733 | | | Overall | 1734 | |-------|----------------| 1735 | | Array | 7,783.063 ms | 1736 | | Vars | 7,439.332 ms | 1737 | } 1738 | x00 := PLongWordArray(@Input)[0]; 1739 | x01 := PLongWordArray(@Input)[1]; 1740 | x02 := PLongWordArray(@Input)[2]; 1741 | x03 := PLongWordArray(@Input)[3]; 1742 | x04 := PLongWordArray(@Input)[4]; 1743 | x05 := PLongWordArray(@Input)[5]; 1744 | x06 := PLongWordArray(@Input)[6]; 1745 | x07 := PLongWordArray(@Input)[7]; 1746 | x08 := PLongWordArray(@Input)[8]; 1747 | x09 := PLongWordArray(@Input)[9]; 1748 | x10 := PLongWordArray(@Input)[10]; 1749 | x11 := PLongWordArray(@Input)[11]; 1750 | x12 := PLongWordArray(@Input)[12]; 1751 | x13 := PLongWordArray(@Input)[13]; 1752 | x14 := PLongWordArray(@Input)[14]; 1753 | x15 := PLongWordArray(@Input)[15]; 1754 | 1755 | //It's a four round algorithm; when the documentation says it's 8 round. 1756 | for i := 0 to 3 do 1757 | begin 1758 | { 1759 | Reordering the assignments from the RFC gives us a free 27.4% speedup. 1760 | It works because there are operations that can be done that do not (yet) depend on the previous result. 1761 | So while one execution unit is calculating the sum+LRot+Xor of one tuple, 1762 | we can go ahead and start calculating on a different tuple. 1763 | 1764 | | | Overall | 1765 | |------------|---------------| 1766 | | Original | 11,264.682 ms | 1767 | | Rearranged | 7,783.063 ms | 1768 | 1769 | TODO: Figure out a SIMD way to do these four parallel constructs in parallel. 1770 | } 1771 | 1772 | { 1773 | Mix DWORDs together between chunks 1774 | <--- 256 bits---> <----- 256 bits -----> 1775 | <128 b> <128 b> <128 bit> <128 bits > 1776 | [ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 ] 1777 | a b D A b c B c d a C d 1778 | a C d a b D A b c B c d 1779 | B c d a C d a b D A b c 1780 | A b c B c d a C d a b D 1781 | } 1782 | //First DWORD 1783 | x04 := x04 xor LRot32(x00+x12, 7); 1784 | x09 := x09 xor LRot32(x05+x01, 7); 1785 | x14 := x14 xor LRot32(x10+x06, 7); 1786 | x03 := x03 xor LRot32(x15+x11, 7); 1787 | 1788 | //Second DWORD 1789 | x08 := x08 xor LRot32(x04+x00, 9); 1790 | x13 := x13 xor LRot32(x09+x05, 9); 1791 | x02 := x02 xor LRot32(x14+x10, 9); 1792 | x07 := x07 xor LRot32(x03+x15, 9); 1793 | 1794 | //Third DWORD 1795 | x12 := x12 xor LRot32(x08+x04,13); 1796 | x01 := x01 xor LRot32(x13+x09,13); 1797 | x06 := x06 xor LRot32(x02+x14,13); 1798 | x11 := x11 xor LRot32(x07+x03,13); 1799 | 1800 | //Fourth DWORD 1801 | x00 := x00 xor LRot32(x12+x08,18); 1802 | x05 := x05 xor LRot32(x01+x13,18); 1803 | x10 := x10 xor LRot32(x06+x02,18); 1804 | x15 := x15 xor LRot32(x11+x07,18); 1805 | 1806 | { 1807 | Mix the DWORDs within each 16 byte set. 1808 | 1809 | [ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 ] 1810 | a A a b b B c c C D d d 1811 | a a A b b B C c c d D d 1812 | a a A B b b c C c d d D 1813 | A a a b B b c c C d d D 1814 | } 1815 | //Calculate first DWORD within each chunk 1816 | x01 := x01 xor LRot32(x00+x03, 7); 1817 | x06 := x06 xor LRot32(x05+x04, 7); 1818 | x11 := x11 xor LRot32(x10+x09, 7); 1819 | x12 := x12 xor LRot32(x15+x14, 7); 1820 | 1821 | //Calculate second DWORD within each chunk 1822 | x02 := x02 xor LRot32(x01+x00, 9); 1823 | x07 := x07 xor LRot32(x06+x05, 9); 1824 | x08 := x08 xor LRot32(x11+x10, 9); 1825 | x13 := x13 xor LRot32(x12+x15, 9); 1826 | 1827 | //Calculate third DWORD within each chunk 1828 | x03 := x03 xor LRot32(x02+x01,13); 1829 | x04 := x04 xor LRot32(x07+x06,13); 1830 | x09 := x09 xor LRot32(x08+x11,13); 1831 | x14 := x14 xor LRot32(x13+x12,13); 1832 | 1833 | //Calculate fourth DWORD within each chunk 1834 | x00 := x00 xor LRot32(x03+x02,18); 1835 | x05 := x05 xor LRot32(x04+x07,18); 1836 | x10 := x10 xor LRot32(x09+x08,18); 1837 | x15 := x15 xor LRot32(x14+x13,18); 1838 | end; 1839 | 1840 | //Result <- Input + X; 1841 | Result := PLongWordArray(@Input); 1842 | Result[ 0] := Result[ 0] + X00; 1843 | Result[ 1] := Result[ 1] + X01; 1844 | Result[ 2] := Result[ 2] + X02; 1845 | Result[ 3] := Result[ 3] + X03; 1846 | Result[ 4] := Result[ 4] + X04; 1847 | Result[ 5] := Result[ 5] + X05; 1848 | Result[ 6] := Result[ 6] + X06; 1849 | Result[ 7] := Result[ 7] + X07; 1850 | Result[ 8] := Result[ 8] + X08; 1851 | Result[ 9] := Result[ 9] + X09; 1852 | Result[10] := Result[10] + X10; 1853 | Result[11] := Result[11] + X11; 1854 | Result[12] := Result[12] + X12; 1855 | Result[13] := Result[13] + X13; 1856 | Result[14] := Result[14] + X14; 1857 | Result[15] := Result[15] + X15; 1858 | end; 1859 | 1860 | class function TScrypt.StringToUtf8(Source: UnicodeString): TBytes; 1861 | var 1862 | strLen: Integer; 1863 | dw: DWORD; 1864 | const 1865 | CodePage = CP_UTF8; 1866 | SLenError = '[StringToUtf8] Could not get length of destination string. Error %d (%s)'; 1867 | SConvertStringError = '[StringToUtf8] Could not convert utf16 to utf8 string. Error %d (%s)'; 1868 | begin 1869 | SetLength(Result, 0); 1870 | 1871 | if Length(Source) = 0 then 1872 | Exit; 1873 | 1874 | // Determine real size of destination string, in bytes 1875 | strLen := WideCharToMultiByte(CP_UTF8, 0, 1876 | PWideChar(Source), Length(Source), //Source 1877 | nil, 0, //Destination 1878 | nil, nil); 1879 | if strLen = 0 then 1880 | begin 1881 | dw := GetLastError; 1882 | raise EConvertError.CreateFmt(SLenError, [dw, SysErrorMessage(dw)]); 1883 | end; 1884 | 1885 | // Allocate memory for destination string 1886 | SetLength(Result, strLen); 1887 | 1888 | // Convert source UTF-16 string (WideString) to the destination using the code-page 1889 | strLen := WideCharToMultiByte(CodePage, 0, 1890 | PWideChar(Source), Length(Source), //Source 1891 | PAnsiChar(Result), strLen, //Destination 1892 | nil, nil); 1893 | if strLen = 0 then 1894 | begin 1895 | dw := GetLastError; 1896 | raise EConvertError.CreateFmt(SConvertStringError, [dw, SysErrorMessage(dw)]); 1897 | end; 1898 | end; 1899 | 1900 | {$OVERFLOWCHECKS ON} 1901 | 1902 | class function TScrypt.PasswordStringPrep(Source: UnicodeString): string; 1903 | var 1904 | strLen: Integer; 1905 | dw: DWORD; 1906 | i: Integer; 1907 | const 1908 | CodePage = CP_UTF8; 1909 | SLenError = '[PasswordStringPrep] Could not get length of destination string. Error %d (%s)'; 1910 | SConvertStringError = '[PasswordStringPrep] Could not convert utf16 to utf8 string. Error %d (%s)'; 1911 | begin 1912 | Result := ''; 1913 | if Length(Source) = 0 then 1914 | Exit; 1915 | 1916 | { 1917 | NIST Special Publication 800-63-3B (Digital Authentication Guideline - Authentication and Lifecycle Management) 1918 | https://pages.nist.gov/800-63-3/sp800-63b.html 1919 | 1920 | Reminds us to normalize the string (using either NFKC or NFKD). 1921 | - K (Compatibility normalization): decomposes ligatures into base compatibilty characters 1922 | - C (Composition): adds character+diacritic into single code point (if possible) 1923 | - D (Decomposition): separates an accented character into the letter and the diacritic 1924 | 1925 | SASLprep (RFC4013) agrees, saying to use NFKC: 1926 | 1927 | 2.2. Normalization 1928 | 1929 | This profile specifies using Unicode normalization form KC, as described in Section 4 of [StringPrep]. 1930 | 1931 | StringPrep (rfc3454, Preparation of Internationalized Strings ("stringprep")) both specified NFKC: 1932 | 1933 | 4. Normalization 1934 | 1935 | The output of the mapping step is optionally normalized using one of 1936 | the Unicode normalization forms, as described in [UAX15]. A profile 1937 | can specify one of two options for Unicode normalization: 1938 | 1939 | - no normalization 1940 | 1941 | - Unicode normalization with form KC 1942 | 1943 | 1944 | Composition means combining diacritics into base characters 1945 | 1946 | Before: Noe¨l 1947 | After: Noël 1948 | 1949 | 1950 | But 1951 | RFC4013 - SASLprep: Stringprep Profile for User Names and Passwords (NFKC) 1952 | 1953 | was obsoleted by 1954 | 1955 | RFC7613 - Preparation, Enforcement, and Comparison of Internationalized Strings Representing Usernames and Passwords 1956 | 1957 | and reverses earlier RFC, and specifies NFC: 1958 | 1959 | 4.2.2. Enforcement 1960 | 1961 | An entity that performs enforcement according to this profile MUST 1962 | prepare a string as described in Section 4.2.1 and MUST also apply 1963 | the rules specified below for the OpaqueString profile (these rules 1964 | MUST be applied in the order shown): 1965 | 1966 | 1. Width-Mapping Rule: Fullwidth and halfwidth characters MUST NOT 1967 | be mapped to their decomposition mappings (see Unicode Standard 1968 | Annex #11 [UAX11]). 1969 | 1970 | 2. Additional Mapping Rule: Any instances of non-ASCII space MUST be 1971 | mapped to ASCII space (U+0020); a non-ASCII space is any Unicode 1972 | code point having a Unicode general category of "Zs" (with the 1973 | exception of U+0020). 1974 | 1975 | 3. Case-Mapping Rule: Uppercase and titlecase characters MUST NOT be 1976 | mapped to their lowercase equivalents. 1977 | 1978 | 4. Normalization Rule: Unicode Normalization Form C (NFC) MUST be 1979 | applied to all characters. 1980 | 1981 | This was probably mainly done because Compatibility Composition leads to data loss. From Microsoft: 1982 | 1983 | [Using Unicode Normalization to Represent Strings](https://msdn.microsoft.com/en-us/library/windows/desktop/dd374126.aspx) 1984 | -------------------- 1985 | 1986 | Forms KC and KD are similar to forms C and D, respectively, but these "compatibility forms" have additional 1987 | mappings of compatible characters to the basic form of each character. Such mappings can cause minor 1988 | character variations to be lost. They combine certain characters that are visually distinct. For example, 1989 | they combine full-width and half-width characters with the same semantic meaning, or different forms of the 1990 | same Arabic letter, or the ligature "fi" (U+FB01) and the character pair "fi" (U+0066 U+0069). They also 1991 | combine some characters that might sometimes have a different semantic meaning, such as a digit written 1992 | as a superscript, as a subscript, or enclosed in a circle. 1993 | 1994 | **Because of this information loss, forms KC and KD generally should not be used as canonical forms of strings,** 1995 | but they are useful for certain applications. 1996 | 1997 | Form KC is a composed form and form KD is a decomposed form. The application can go back and forth between 1998 | forms KC and KD, but there is no consistent way to go from form KC or KD back to the original string, 1999 | even if the original string is in form C or D. 2000 | 2001 | Windows, Microsoft applications, and the .NET Framework generally generate characters in form C using normal 2002 | input methods. For most purposes on Windows, form C is the preferred form. For example, characters in form 2003 | C are produced by Windows keyboard input. However, characters imported from the Web and other platforms can 2004 | introduce other normalization forms into the data stream. 2005 | 2006 | This loss of data when using KC is evident in RFC7613's requirement: 2007 | 2008 | ...halfwidth characters MUST NOT be mapped to their decomposition mappings... 2009 | 2010 | Using Form NFKC causes the half-width character 2011 | 2012 | U+FFC3 HALFWIDTH HANGUL LETTER AE UTF8 0xEF 0xBF 0x83 2013 | 2014 | to be mapped to: 2015 | 2016 | U+1162 HANGUL JUNGSEONG AE UTF8 0xE1 0x85 0xA2 2017 | 2018 | 2019 | Spaces 2020 | ====== 2021 | 2022 | RFC7613 (Preparation, Enforcement, and Comparison of Internationalized Strings Representing Usernames and Passwords) 2023 | 2024 | (like RFC4013 that it obsoletes) 2025 | 2026 | also reminds us to normalize all the differnet unicode space characters into the standard single U+0020 SPACE: 2027 | 2028 | 2. Additional Mapping Rule: Any instances of non-ASCII space MUST be mapped to ASCII space (U+0020); 2029 | a non-ASCII space is any Unicode code point having a Unicode general category of "Zs" 2030 | (with the exception of U+0020). 2031 | 2032 | U+0020 SPACE 2033 | U+00A0 NO-BREAK SPACE 2034 | U+1680 OGHAM SPACE MARK 2035 | U+2000 EN QUAD 2036 | U+2001 EM QUAD 2037 | U+2002 EN SPACE 2038 | U+2003 EM SPACE 2039 | U+2004 THREE-PER-EM SPACE 2040 | U+2005 FOUR-PER-EM SPACE 2041 | U+2006 SIX-PER-EM SPACE 2042 | U+2007 FIGURE SPACE 2043 | U+2008 PUNCTUATION SPACE 2044 | U+2009 THIN SPACE 2045 | U+200A HAIR SPACE 2046 | U+202F NARROW NO-BREAK SPACE 2047 | U+205F MEDIUM MATHEMATICAL SPACE 2048 | U+3000 IDEOGRAPHIC SPACE 2049 | 2050 | This is handled by NFC. 2051 | } 2052 | 2053 | //Convert any spaces (Unicode category Z) into canonical U+0020 2054 | for i := 1 to Length(Source) do 2055 | begin 2056 | case Word(Source[i]) of 2057 | $00A0, $1680, $2000, $2001, $2002, $2003, $2004, $2005, $2006, $2007, $2008, $2009, $200A, $202F, $205F, $3000: 2058 | begin 2059 | Source[i] := #$0020; 2060 | end; 2061 | end; 2062 | end; 2063 | 2064 | //We use concrete variable for length, because i've seen it return asking for 64 bytes for a 6 byte string 2065 | // normalizedLength := NormalizeString(5, PWideChar(Source), Length(Source), nil, 0); 2066 | strLen := FoldString(MAP_PRECOMPOSED, PWideChar(Source), Length(Source), nil, 0); 2067 | if strLen = 0 then 2068 | begin 2069 | dw := GetLastError; 2070 | raise EConvertError.CreateFmt(SLenError, [dw, SysErrorMessage(dw)]); 2071 | end; 2072 | 2073 | // Allocate memory for destination string 2074 | SetLength(Result, strLen); 2075 | 2076 | // Now do it for real 2077 | // normalizedLength := NormalizeString(5, PWideChar(Source), Length(Source), PWideChar(normalized), Length(normalized)); 2078 | strLen := FoldString(MAP_PRECOMPOSED, PWideChar(Source), Length(Source), PWideChar(Result), Length(Result)); 2079 | if strLen = 0 then 2080 | begin 2081 | dw := GetLastError; 2082 | raise EConvertError.CreateFmt(SLenError, [dw, SysErrorMessage(dw)]); 2083 | end; 2084 | end; 2085 | 2086 | class function TScrypt.Tokenize(const s: string; Delimiter: Char): TStringDynArray; 2087 | var 2088 | iLength: integer; 2089 | i: integer; 2090 | szOutput: string; 2091 | n: Integer; 2092 | begin 2093 | iLength := Length(s); 2094 | 2095 | SetLength(Result, 0); 2096 | 2097 | for i := 1 to iLength do 2098 | begin 2099 | if s[i] = Delimiter then 2100 | begin 2101 | n := Length(Result); 2102 | SetLength(Result, n+1); 2103 | Result[n] := szOutput; 2104 | szOutput := ''; 2105 | end 2106 | else 2107 | szOutput := szOutput + s[i]; 2108 | end; 2109 | 2110 | if szOutput <> '' then 2111 | begin 2112 | n := Length(Result); 2113 | SetLength(Result, n+1); 2114 | Result[n] := szOutput; 2115 | end; 2116 | end; 2117 | 2118 | function TScrypt.TryParseHashString(HashString: string; out CostFactor, BlockSizeFactor, ParallelizationFactor: Cardinal; 2119 | out Salt: TBytes; out Data: TBytes): Boolean; 2120 | var 2121 | tokens: TStringDynArray; 2122 | parameters: Cardinal; 2123 | begin 2124 | Result := False; 2125 | 2126 | if HashString = '' then 2127 | Exit; //raise EScryptException.Create('HashString cannot be empty'); 2128 | 2129 | { 2130 | There are a number of different standards out there. 2131 | 2132 | $s1$NNrrpp$salt$hash 2133 | $s0$NNrrpp$salt$key 2134 | $7$N=14,r=4,p=1$epIxT/h6HbbwHaehFnh/bw==$MTIzNDU2Nzg5MDEyMzQ1Njc4OTAxMjM0NTY3ODkwMTIzNDU2Nzg5MDEyMzQ1Njc4OTAxMjM0NTY3ODkwMTIzNA== 2135 | $7$Nrrrrrpppppsalt$hash 2136 | } 2137 | //All versions start with a "$" 2138 | if HashString[1] <> '$' then 2139 | Exit; //raise EScryptException.Create('HashString must start with ''$'''); 2140 | 2141 | //All versions will have five tokens 2142 | SetLength(tokens, 0); //Variable 'tokens' might not have been initialized 2143 | tokens := Self.Tokenize(HashString, '$'); 2144 | //tokens[0] ==> "" (the space before the first $) 2145 | //tokens[1] ==> "s01" 2146 | //tokens[2] ==> parameters 2147 | //tokens[3] ==> salt 2148 | //tokens[4] ==> derived bytes 2149 | if Length(tokens) < 5 then 2150 | Exit; //raise EScryptException.CreateFmt('HashString string did not contain five tokens (%d)', [Length(tokens)]); 2151 | 2152 | if AnsiSameText(tokens[1], 's1') then 2153 | begin 2154 | { 2155 | Modular Crypt Format support for scrypt 2156 | https://github.com/jvarho/pylibscrypt/blob/master/pylibscrypt/mcf.py 2157 | 2158 | Compatible with libscrypt scrypt_mcf_check also supports the $7$ format. 2159 | 2160 | libscrypt format: 2161 | 2162 | $s1$NNrrpp$salt$hash 2163 | NN - hex encoded N log2 (two hex digits) 2164 | rr - hex encoded r in 1-255 2165 | pp - hex encoded p in 1-255 2166 | salt - base64 encoded salt 1-16 bytes decoded 2167 | hash - base64 encoded 64-byte scrypt hash 2168 | } 2169 | parameters := Cardinal(StrToInt('0x'+tokens[2])); 2170 | CostFactor := (parameters and $FFFF0000) shr 16; 2171 | BlockSizeFactor := (parameters and $0000FF00) shr 8; 2172 | ParallelizationFactor := (parameters and $000000FF); 2173 | 2174 | Salt := TScrypt.Base64Decode(tokens[3]); 2175 | Data := TScrypt.Base64Decode(tokens[4]); 2176 | 2177 | Result := True; 2178 | end 2179 | else if AnsiSameText(tokens[1], 's0') then 2180 | begin 2181 | { 2182 | Java implementation of scrypt (Lambdaworks OSS) 2183 | https://github.com/wg/scrypt 2184 | 2185 | $s0$params$salt$key 2186 | 2187 | s0 - version 0 of the format with 128-bit salt and 256-bit derived key 2188 | params - 32-bit hex integer containing log2(N) (16 bits), r (8 bits), and p (8 bits) 2189 | salt - base64-encoded salt 2190 | key - base64-encoded derived key 2191 | 2192 | Example: 2193 | 2194 | $s0$e0801$epIxT/h6HbbwHaehFnh/bw==$7H0vsXlY8UxxyW/BWx/9GuY7jEvGjT71GFd6O4SZND0= 2195 | 2196 | passwd = "secret" 2197 | N = 16384 2198 | r = 8 2199 | p = 1 2200 | } 2201 | parameters := Cardinal(StrToInt('0x'+tokens[2])); 2202 | CostFactor := (parameters and $FFFF0000) shr 16; 2203 | BlockSizeFactor := (parameters and $0000FF00) shr 8; 2204 | ParallelizationFactor := (parameters and $000000FF); 2205 | 2206 | Salt := TScrypt.Base64Decode(tokens[3]); 2207 | Data := TScrypt.Base64Decode(tokens[4]); 2208 | 2209 | Result := True; 2210 | end 2211 | else if AnsiSameText(tokens[1], '7') then 2212 | begin 2213 | { 2214 | Unix crypt using scrypt 2215 | https://gitorious.org/scrypt/ietf-scrypt/raw/7c4a7c47d32a5dbfd43b1223e4b9ac38bfe6f8a0:unix-scrypt.txt 2216 | ----------------------- 2217 | 2218 | $7$N=14,r=4,p=1$epIxT/h6HbbwHaehFnh/bw==$MTIzNDU2Nzg5MDEyMzQ1Njc4OTAxMjM0NTY3ODkwMTIzNDU2Nzg5MDEyMzQ1Njc4OTAxMjM0NTY3ODkwMTIzNA== 2219 | 2220 | This document specify a new Unix crypt method based on the scrypt 2221 | password-based key derivation function. It uses the 2222 | 2223 | $$$ 2224 | 2225 | convention introduced with the old MD5-based solution and also used by 2226 | the more recent SHA-256/SHA-512 mechanism specified here: 2227 | 2228 | http://www.akkadia.org/drepper/sha-crypt.html 2229 | 2230 | The scrypt method uses the following value: 2231 | 2232 | ID | Method 2233 | ------------------------------- 2234 | 7 | scrypt 2235 | 2236 | The scrypt method requires three parameters in the SALT value: N, r 2237 | and p which are expressed like this: 2238 | 2239 | N=,r=,p=

$ 2240 | 2241 | where N, r and p are unsigned decimal numbers that are used as the 2242 | scrypt parameters. 2243 | 2244 | The PWD part is the password string, and the size is fixed to 86 2245 | characters which corresponds to 64 bytes base64 encoded. 2246 | 2247 | To compute the PWD part, run the scrypt algorithm with the password, 2248 | salt, parameters to generate 64 bytes and base64 encode it. 2249 | } 2250 | end 2251 | else if AnsiSameText(tokens[1], '7') then 2252 | begin 2253 | { 2254 | $7$ format 2255 | https://github.com/jvarho/pylibscrypt/blob/master/pylibscrypt/mcf.py 2256 | 2257 | $7$Nrrrrrpppppsalt$hash 2258 | N - crypt base64 N log2 2259 | rrrrr - crypt base64 r (little-endian 30 bits) 2260 | ppppp - crypt base64 p (little-endian 30 bits) 2261 | salt - raw salt (0-43 bytes that should be limited to crypt base64) 2262 | hash - crypt base64 encoded 32-byte scrypt hash (43 bytes) 2263 | 2264 | (crypt base64 is base64 with the alphabet: ./0-9A-Za-z) 2265 | 2266 | This is a brain-dead format that needs to be uninvented. 2267 | } 2268 | end 2269 | else 2270 | begin 2271 | //We don't know what it is. Tell the caller about it 2272 | raise EScryptException.CreateFmt('Unknown scrypt hash format "%s"', [tokens[1]]); 2273 | end; 2274 | end; 2275 | 2276 | class procedure TScrypt.XorBlockInPlace(var A; const B; Length: Integer); 2277 | var 2278 | i: Integer; 2279 | blocks: Integer; 2280 | n: Integer; 2281 | 2282 | type 2283 | PUInt64Array = ^TUInt64Array_Unsafe; 2284 | TUInt64Array_Unsafe = array[0..MaxInt div 16] of UInt64; 2285 | 2286 | begin 2287 | //DONE: Unroll to 8-byte chunks 2288 | //TODO: Detect 128-bit or 256-bit SIMD available, and unroll to XOR 16 or 32 bytes at at time. 2289 | { 2290 | Unrolling XOR to operate on 8 bytes at a time, rather than 1 byte at a time, 2291 | gives a 5.3x speedup in the XORing operation, and a 1.6x speedup (35.7%) overall. 2292 | 2293 | | SIMD | Time in XOR | Overall time | 2294 | |---------|--------------|---------------| 2295 | | 1 byte | 8,682.402 ms | 17,511.904 ms | 2296 | | 8 bytes | 1,631.759 ms | 11,253.510 ms | 2297 | 2298 | Note: Inlining this function has no performance improvement (if anything its 0.0007% slower) 2299 | } 2300 | blocks := Length div SizeOf(UInt64); //optimizes to "shr 3" anyway 2301 | for i := 0 to blocks-1 do 2302 | PUInt64Array(@A)[i] := PUInt64Array(@A)[i] xor PUInt64Array(@B)[i]; 2303 | 2304 | //Finish up any remaining. This will never happen in practice; because 64 bytes is always a multiple of 8 bytes 2305 | if (Length mod SizeOf(UInt64)) <> 0 then 2306 | begin 2307 | n := blocks*SizeOf(UInt64); 2308 | for i := n to Length-1 do 2309 | PByteArray(@A)[i] := PByteArray(@A)[i] xor PByteArray(@B)[i]; 2310 | end; 2311 | end; 2312 | 2313 | { TSHA1 } 2314 | 2315 | constructor TSHA1.Create; 2316 | begin 2317 | inherited Create; 2318 | 2319 | Initialize; 2320 | end; 2321 | 2322 | function TSHA1.Finalize: TBytes; 2323 | begin 2324 | Result := Self.HashFinal; 2325 | // Self.Initialize; HashFinal does the burn 2326 | end; 2327 | 2328 | procedure TSHA1.Burn; 2329 | begin 2330 | //Empty the hash buffer 2331 | FHashLength.QuadPart := 0; 2332 | FHashBufferIndex := 0; 2333 | FillChar(FHashBuffer[0], Length(FHashBuffer), 0); 2334 | 2335 | //And reset the current state of the hash to the default starting values 2336 | FABCDEBuffer[0] := $67452301; 2337 | FABCDEBuffer[1] := $EFCDAB89; 2338 | FABCDEBuffer[2] := $98BADCFE; 2339 | FABCDEBuffer[3] := $10325476; 2340 | FABCDEBuffer[4] := $C3D2E1F0; 2341 | 2342 | FInitialized := True; 2343 | end; 2344 | 2345 | procedure TSHA1.Compress; 2346 | {Call this when the HashBuffer is full, and can now be dealt with} 2347 | var 2348 | A, B, C, D, E: LongWord; //temporary buffer storage#1 2349 | TEMP: LongWord; //temporary buffer for a single Word 2350 | Wt: array[0..79] of LongWord; //temporary buffer storage#2 2351 | W: PLongWordArray; 2352 | i: integer; //counter 2353 | 2354 | // function LRot32_5(const X: LongWord): LongWord; inline; 2355 | // begin 2356 | // Result := (X shl 5) or (X shr 27); 2357 | // end; 2358 | begin 2359 | {Reset HashBuffer index since it can now be reused 2360 | (well, not _now_, but after .Compress} 2361 | FHashBufferIndex := 0; 2362 | 2363 | W := PLongWordArray(@Wt[0]); //9.02% speedup by defeating range checking 2364 | 2365 | {Move HashBuffer into W, and change the Endian order} 2366 | i := 0; 2367 | while (i < 16) do 2368 | begin 2369 | //TODO: This can be vectorized 2370 | W[i ] := ByteSwap(PLongWordArray(@FHashBuffer[0])[i ]); 2371 | W[i+1] := ByteSwap(PLongWordArray(@FHashBuffer[0])[i+1]); 2372 | W[i+2] := ByteSwap(PLongWordArray(@FHashBuffer[0])[i+2]); 2373 | W[i+3] := ByteSwap(PLongWordArray(@FHashBuffer[0])[i+3]); 2374 | Inc(i, 4); 2375 | end; 2376 | 2377 | {Step B in 'FIPS PUB 180-1' 2378 | - Calculate the rest of Wt 2379 | 2380 | 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 2381 | * * * * = 2382 | * * * * = 2383 | * * * * = 2384 | } 2385 | //160.5 MB/s 2386 | // for i := 16 to 79 do 2387 | // W[i] := LRot32(W[i-3] xor W[i- 8] xor W[i-14] xor W[i-16], 1); //164 MB/s 2388 | 2389 | { 2390 | https://software.intel.com/en-us/articles/improving-the-performance-of-the-secure-hash-algorithm-1/ 2391 | https://blogs.oracle.com/DanX/entry/optimizing_solaris_x86_sha_1 2392 | } 2393 | //159.5 MB/s 2394 | { for i := 16 to 31 do 2395 | W[i] := LRot32(W[i-3] xor W[i- 8] xor W[i-14] xor W[i-16], 1); //164 MB/s 2396 | for i := 32 to 79 do 2397 | W[i] := LRot32(W[i-6] xor W[i-16] xor W[i-28] xor W[i-32], 2); //168 MB/s} 2398 | 2399 | 2400 | //176 MB/s 2401 | while (i < 32) do //16..31, 16 calculations, 2 at at time = 8 loops 2402 | begin 2403 | //This represents the form that can be vectorized: Two independant calculations at a time 2404 | W[i ] := LRot32(W[i-3] xor W[i-8] xor W[i-14] xor W[i-16], 1); 2405 | W[i+1] := LRot32(W[i-2] xor W[i-7] xor W[i-13] xor W[i-15], 1); //Delphi is unable to optimize -3+1 or 1-3 as -2 2406 | Inc(i, 2); 2407 | end; 2408 | while (i < 80) do //32..79, 48 calculations, 6 at a time = 8 loops 2409 | begin 2410 | //This represents the form that can be vectorized: Six independant calcuations at a time 2411 | W[i ] := LRot32(W[i-6] xor W[i-16] xor W[i-28] xor W[i-32], 2); 2412 | W[i+1] := LRot32(W[i-5] xor W[i-15] xor W[i-27] xor W[i-31], 2); 2413 | W[i+2] := LRot32(W[i-4] xor W[i-14] xor W[i-26] xor W[i-30], 2); 2414 | W[i+3] := LRot32(W[i-3] xor W[i-13] xor W[i-25] xor W[i-29], 2); 2415 | W[i+4] := LRot32(W[i-2] xor W[i-12] xor W[i-24] xor W[i-28], 2); 2416 | W[i+5] := LRot32(W[i-1] xor W[i-11] xor W[i-23] xor W[i-27], 2); 2417 | Inc(i, 6) 2418 | end; 2419 | 2420 | {Step C in 'FIPS PUB 180-1' 2421 | - Copy the CurrentHash into the ABCDE buffer} 2422 | A := FABCDEBuffer[0]; 2423 | B := FABCDEBuffer[1]; 2424 | C := FABCDEBuffer[2]; 2425 | D := FABCDEBuffer[3]; 2426 | E := FABCDEBuffer[4]; 2427 | 2428 | {Step D in 'FIPS PUB 180-1} 2429 | //These calculations are 15% faster if the XOR and ROT happen at the end of each assignment. 2430 | //I don't know why; but we are where we are. 2431 | {t=0..19 uses fa} 2432 | for i := 0 to 19 do 2433 | begin 2434 | {$Q-} 2435 | TEMP := $5A827999 + E + W[i] + (D xor (B and (C xor D))) + ((A shl 5) or (A shr 27)); 2436 | E := D; 2437 | D := C; 2438 | C := LRot32(B, 30); 2439 | B := A; 2440 | A := TEMP; 2441 | end; 2442 | 2443 | {t=20..39 uses fb} 2444 | for i := 20 to 39 do 2445 | begin 2446 | {$Q-} 2447 | TEMP := $6ED9EBA1 + E + W[i] + (B xor C xor D) + ((A shl 5) or (A shr 27)); 2448 | E := D; 2449 | D := C; 2450 | C := LRot32(B, 30); 2451 | B := A; 2452 | A := TEMP; 2453 | end; 2454 | 2455 | {t=40..59 uses fc} 2456 | for i := 40 to 59 do 2457 | begin 2458 | {$Q-} 2459 | TEMP := $8F1BBCDC + E + W[i] + ((B and C) or (D and (B or C))) + ((A shl 5) or (A shr 27)); 2460 | E := D; 2461 | D := C; 2462 | C := LRot32(B, 30); 2463 | B := A; 2464 | A := TEMP; 2465 | end; 2466 | 2467 | {t60..79 uses fd} 2468 | for i := 60 to 79 do 2469 | begin 2470 | {$Q-} 2471 | TEMP := $CA62C1D6 + E + W[i] + (B xor C xor D) + ((A shl 5) or (A shr 27)); 2472 | E := D; 2473 | D := C; 2474 | C := LRot32(B, 30); 2475 | B := A; 2476 | A := TEMP; 2477 | end; 2478 | 2479 | {Step E in 'FIPS PUB 180-1' 2480 | - Update the Current hash values} 2481 | FABCDEBuffer[0] := FABCDEBuffer[0] + A; 2482 | FABCDEBuffer[1] := FABCDEBuffer[1] + B; 2483 | FABCDEBuffer[2] := FABCDEBuffer[2] + C; 2484 | FABCDEBuffer[3] := FABCDEBuffer[3] + D; 2485 | FABCDEBuffer[4] := FABCDEBuffer[4] + E; 2486 | 2487 | {Clear out W and the HashBuffer} 2488 | //14% faster by not doing these here 2489 | // FillChar(W[0], SizeOf(W), 0); we don't *need* to empty W. 2490 | // FillChar(FHashBuffer[0], SizeOf(FHashBuffer), 0); //HashFinal takes care of this 2491 | end; 2492 | 2493 | function TSHA1.GetBlockSize: Integer; 2494 | begin 2495 | Result := 64; //block size of SHA1 is 64 bytes (512 bits) 2496 | end; 2497 | 2498 | function TSHA1.GetDigestSize: Integer; 2499 | begin 2500 | Result := 20; //SHA-1 digest size is 160 bits (20 bytes) 2501 | end; 2502 | 2503 | procedure TSHA1.HashCore(const Data; DataLen: Integer); 2504 | // Updates the state of the hash object so a correct hash value is returned at 2505 | // the end of the data stream. 2506 | var 2507 | bytesRemainingInHashBuffer: Integer; 2508 | dummySize: Integer; 2509 | // buffer: PByteArray; 2510 | buffer: PByte; 2511 | //dataOffset: Integer; 2512 | begin 2513 | { Parameters 2514 | array input for which to compute the hash code. 2515 | ibStart offset into the byte array from which to begin using data. 2516 | cbSize number of bytes in the byte array to use as data.} 2517 | if not FInitialized then 2518 | raise EScryptException.Create('SHA1 not initialized'); 2519 | 2520 | if (DataLen = 0) then 2521 | Exit; 2522 | 2523 | //buffer := PByteArray(@Data); 2524 | buffer := PByte(@Data); 2525 | //dataOffset := 0; 2526 | 2527 | dummySize := DataLen; 2528 | UpdateLen(dummySize); //Update the Len variables given size 2529 | 2530 | while dummySize > 0 do 2531 | begin 2532 | bytesRemainingInHashBuffer := Length(FHashBuffer) - FHashBufferIndex; 2533 | {HashBufferIndex is the next location to write to in hashbuffer 2534 | Sizeof(HasBuffer) - HashBufferIndex = space left in HashBuffer} 2535 | {cbSize is the number of bytes coming in from the user} 2536 | if bytesRemainingInHashBuffer <= dummySize then 2537 | begin 2538 | {If there is enough data left in the buffer to fill the HashBuffer 2539 | then copy enough to fill the HashBuffer} 2540 | //Move(buffer[dataOffset], FHashBuffer[FHashBufferIndex], bytesRemainingInHashBuffer); 2541 | Move(buffer^, FHashBuffer[FHashBufferIndex], bytesRemainingInHashBuffer); 2542 | Dec(dummySize, bytesRemainingInHashBuffer); 2543 | //Inc(dataOffset, bytesRemainingInHashBuffer); 2544 | Inc(buffer, bytesRemainingInHashBuffer); 2545 | Self.Compress; 2546 | end 2547 | else 2548 | begin 2549 | { 2550 | 20070508 Ian Boyd 2551 | If the input length was not an even multiple of HashBufferSize (64 bytes i think), 2552 | then there was a buffer overrun. Rather than Moving and incrementing by DummySize 2553 | it was using cbSize, which is the size of the original buffer 2554 | } 2555 | //If there isn't enough data to fill the HashBuffer... 2556 | //...copy as much as possible from the buffer into HashBuffer... 2557 | //Move(buffer[dataOffset], FHashBuffer[FHashBufferIndex], dummySize); 2558 | Move(buffer^, FHashBuffer[FHashBufferIndex], dummySize); 2559 | //then move the HashBuffer Index to the next empty spot in HashBuffer 2560 | Inc(FHashBufferIndex, dummySize); 2561 | //And shrink the size in the buffer to zero 2562 | dummySize := 0; 2563 | end; 2564 | end; 2565 | end; 2566 | 2567 | procedure TSHA1.HashData(const Buffer; BufferLen: Integer); 2568 | begin 2569 | Self.HashCore(Buffer, BufferLen); 2570 | end; 2571 | 2572 | function TSHA1.HashFinal: TBytes; 2573 | { This method finalizes any partial computation and returns the correct hash 2574 | value for the data stream.} 2575 | type 2576 | TLongWordBuffer = array[0..15] of LongWord; 2577 | begin 2578 | {The final act is to tack on the size of the message} 2579 | 2580 | {Tack on the final bit 1 to the end of the data} 2581 | FHashBuffer[FHashBufferIndex] := $80; 2582 | 2583 | //Zero out the byes from the $80 marker to the end of the buffer 2584 | FillChar(FHashBuffer[FHashBufferIndex+1], 63-FHashBufferIndex, 0); 2585 | 2586 | 2587 | {[56] is the start of the 2nd last word in HashBuffer} 2588 | {if we are at (or past) it, then there isn't enough room for the whole 2589 | message length (64-bits i.e. 2 words) to be added in} 2590 | {The HashBuffer can essentially be considered full (even if the Index is not 2591 | all the way to the end), since it the remaining zeros are prescribed padding 2592 | anyway} 2593 | if FHashBufferIndex >= 56 then 2594 | begin 2595 | Compress; 2596 | FillChar(FHashBuffer[0], 64, 0); 2597 | end; 2598 | 2599 | {Write in LenHi (it needs it's endian order changed)} 2600 | {LenHi is the high order word of the Length of the message in bits} 2601 | TLongWordBuffer(FHashBuffer)[14] := ByteSwap(FHashLength.HighPart); 2602 | 2603 | {[60] is the last word in HashBuffer} 2604 | {Write in LenLo (it needs it's endian order changed)} 2605 | {LenLo is the low order word of the length of the message} 2606 | TLongWordBuffer(FHashBuffer)[15] := ByteSwap(FHashLength.LowPart); 2607 | 2608 | {The hashbuffer should now be filled up} 2609 | Compress; 2610 | 2611 | {Finalize the hash value into CurrentHash} 2612 | SetLength(Result, Self.GetDigestSize); 2613 | PLongWordArray(Result)[0] := ByteSwap(FABCDEBuffer[0]); 2614 | PLongWordArray(Result)[1] := ByteSwap(FABCDEBuffer[1]); 2615 | PLongWordArray(Result)[2] := ByteSwap(FABCDEBuffer[2]); 2616 | PLongWordArray(Result)[3] := ByteSwap(FABCDEBuffer[3]); 2617 | PLongWordArray(Result)[4] := ByteSwap(FABCDEBuffer[4]); 2618 | 2619 | {Burn all the temporary areas} 2620 | Burn; 2621 | end; 2622 | 2623 | procedure TSHA1.Initialize; 2624 | begin 2625 | Self.Burn; 2626 | end; 2627 | 2628 | procedure TSHA1.SelfTest; 2629 | begin 2630 | //call the selftest contained in the other unit 2631 | end; 2632 | 2633 | procedure TSHA1.UpdateLen(NumBytes: LongWord); 2634 | //Len is the number of bytes in input buffer 2635 | //This is eventually used to pad out the final message block with 2636 | // the number of bits in the block (a 64-bit number) 2637 | begin 2638 | //the HashLength is in BITS, so multiply NumBytes by 8 2639 | Inc(FHashLength.QuadPart, NumBytes * 8); 2640 | end; 2641 | 2642 | { TSHA2_256 } 2643 | 2644 | procedure TSHA256.Burn; 2645 | begin 2646 | FHashLength.QuadPart := 0; 2647 | 2648 | FillChar(FHashBuffer[0], Length(FHashBuffer), 0); 2649 | FHashBufferIndex := 0; 2650 | 2651 | FCurrentHash[0] := $6a09e667; 2652 | FCurrentHash[1] := $bb67ae85; 2653 | FCurrentHash[2] := $3c6ef372; 2654 | FCurrentHash[3] := $a54ff53a; 2655 | FCurrentHash[4] := $510e527f; 2656 | FCurrentHash[5] := $9b05688c; 2657 | FCurrentHash[6] := $1f83d9ab; 2658 | FCurrentHash[7] := $5be0cd19; 2659 | 2660 | FInitialized := True; 2661 | end; 2662 | 2663 | procedure TSHA256.Compress; 2664 | {Call this when the HashBuffer is full, and can now be dealt with} 2665 | var 2666 | a, b, c, d, e, f, g, h: LongWord; //temporary buffer storage#1 2667 | t: Integer; 2668 | s0, s1: LongWord; 2669 | temp1, temp2: LongWord; //temporary buffer for a single Word 2670 | Wt: array[0..79] of LongWord; //temporary buffer storage#2 2671 | // tCount: integer; //counter 2672 | W: PLongWordArray; 2673 | 2674 | const 2675 | K: array[0..63] of LongWord = ( 2676 | $428a2f98, $71374491, $b5c0fbcf, $e9b5dba5, $3956c25b, $59f111f1, $923f82a4, $ab1c5ed5, 2677 | $d807aa98, $12835b01, $243185be, $550c7dc3, $72be5d74, $80deb1fe, $9bdc06a7, $c19bf174, 2678 | $e49b69c1, $efbe4786, $0fc19dc6, $240ca1cc, $2de92c6f, $4a7484aa, $5cb0a9dc, $76f988da, 2679 | $983e5152, $a831c66d, $b00327c8, $bf597fc7, $c6e00bf3, $d5a79147, $06ca6351, $14292967, 2680 | $27b70a85, $2e1b2138, $4d2c6dfc, $53380d13, $650a7354, $766a0abb, $81c2c92e, $92722c85, 2681 | $a2bfe8a1, $a81a664b, $c24b8b70, $c76c51a3, $d192e819, $d6990624, $f40e3585, $106aa070, 2682 | $19a4c116, $1e376c08, $2748774c, $34b0bcb5, $391c0cb3, $4ed8aa4a, $5b9cca4f, $682e6ff3, 2683 | $748f82ee, $78a5636f, $84c87814, $8cc70208, $90befffa, $a4506ceb, $bef9a3f7, $c67178f2 2684 | ); 2685 | 2686 | begin 2687 | W := PLongWordArray(@Wt[0]); 2688 | 2689 | {1. Prepare the message schedule W from the block we're processing. Start with the first 16 bytes} 2690 | //Move(FHashBuffer[0], W[0], SizeOf(FHashBuffer) ); 2691 | for t := 0 to 15 do 2692 | begin 2693 | W[t] := ByteSwap(PLongWord(@FHashBuffer[t*4])^); 2694 | // W[tCount] := ByteSwap(W[tCount]); 2695 | end; 2696 | 2697 | { Calculate the rest of W (16..79) } 2698 | for t := 16 to 79 do 2699 | begin 2700 | s0 := RRot32(W[t-15], 7) xor RRot32(W[t-15], 18) xor (W[t-15] shr 3); //s0(W[t-15]); 2701 | s1 := RRot32(W[t- 2], 17) xor RRot32(W[t- 2], 19) xor (W[t- 2] shr 10); //s1(W[t-2]); 2702 | W[t]:= W[t-16] + s0 + W[t-7] + s1; 2703 | end; 2704 | 2705 | {2. Initialize working variables a..h by copying CurrentHash into working variables } 2706 | a := FCurrentHash[0]; 2707 | b := FCurrentHash[1]; 2708 | c := FCurrentHash[2]; 2709 | d := FCurrentHash[3]; 2710 | e := FCurrentHash[4]; 2711 | f := FCurrentHash[5]; 2712 | g := FCurrentHash[6]; 2713 | h := FCurrentHash[7]; 2714 | 2715 | {3. } 2716 | for t := 0 to 63 do 2717 | begin 2718 | {$Q-} 2719 | //S0, ch, maj, S1, temp1, temp2, 79.5 MB/s 2720 | //ch, S0, maj, S1, temp1, temp2: 78.5 MB/s 2721 | //S0, S1, ch, maj, temp1, temp2: 74.8 MB/s 2722 | { S0 := RRot32(a, 2) xor RRot32(a, 13) xor RRot32(a, 22); //S0(a) 2723 | ch := (e and f) xor ((not e) and g); //Choose(e,f,g) 2724 | maj := (a and b) xor (a and c) xor (b and c); //Majority(a,b,c) 2725 | S1 := RRot32(e, 6) xor RRot32(e, 11) xor RRot32(e, 25); //S1(e) 2726 | temp1 := h + S1 + ch + K[t] + W[t]; 2727 | temp2 := S0 + maj;} 2728 | 2729 | //83.2 MB/s 2730 | 2731 | temp1 := h + (RRot32(e, 6) xor RRot32(e, 11) xor RRot32(e, 25)) + ((e and f) xor ((not e) and g)) + K[t] + W[t]; 2732 | 2733 | h := g; 2734 | g := f; 2735 | f := e; 2736 | e := d + temp1; 2737 | d := c; 2738 | 2739 | temp2 := (RRot32(a, 2) xor RRot32(a, 13) xor RRot32(a, 22)) + ((a and b) xor (a and c) xor (b and c)); 2740 | 2741 | c := b; 2742 | b := a; 2743 | a := temp1 + temp2; 2744 | end; 2745 | 2746 | { Update the current hash values} 2747 | FCurrentHash[0] := FCurrentHash[0] + a; 2748 | FCurrentHash[1] := FCurrentHash[1] + b; 2749 | FCurrentHash[2] := FCurrentHash[2] + c; 2750 | FCurrentHash[3] := FCurrentHash[3] + d; 2751 | FCurrentHash[4] := FCurrentHash[4] + e; 2752 | FCurrentHash[5] := FCurrentHash[5] + f; 2753 | FCurrentHash[6] := FCurrentHash[6] + g; 2754 | FCurrentHash[7] := FCurrentHash[7] + h; 2755 | 2756 | {Reset HashBuffer index since it can now be reused} 2757 | FHashBufferIndex := 0; 2758 | FillChar(FHashBuffer[0], Length(FHashBuffer), 0); //empty the buffer for the next set of writes 2759 | end; 2760 | 2761 | constructor TSHA256.Create; 2762 | begin 2763 | inherited Create; 2764 | 2765 | Initialize; 2766 | end; 2767 | 2768 | function TSHA256.Finalize: TBytes; 2769 | begin 2770 | Result := Self.HashFinal; 2771 | // Self.Initialize; HashFinal does the burn and reset 2772 | end; 2773 | 2774 | function TSHA256.GetBlockSize: Integer; 2775 | begin 2776 | Result := 64; //block size of SHA2-256 is 512 bits 2777 | end; 2778 | 2779 | function TSHA256.GetDigestSize: Integer; 2780 | begin 2781 | Result := 32; //digest size of SHA2-256 is 256 bits (32 bytes) 2782 | end; 2783 | 2784 | procedure TSHA256.HashCore(const Data; DataLen: Integer); 2785 | // Updates the state of the hash object so a correct hash value is returned at 2786 | // the end of the data stream. 2787 | var 2788 | bytesRemainingInHashBuffer: Integer; 2789 | dummySize: Integer; 2790 | buffer: PByte; 2791 | //dataOffset: Integer; 2792 | begin 2793 | { Parameters 2794 | array input for which to compute the hash code. 2795 | ibStart offset into the byte array from which to begin using data. 2796 | cbSize number of bytes in the byte array to use as data.} 2797 | if not FInitialized then 2798 | raise EScryptException.Create('SHA1 not initialized'); 2799 | 2800 | if (DataLen = 0) then 2801 | Exit; 2802 | 2803 | buffer := PByte(@Data); 2804 | //dataOffset := 0; 2805 | 2806 | dummySize := DataLen; 2807 | UpdateLen(dummySize); //Update the Len variables given size 2808 | 2809 | while dummySize > 0 do 2810 | begin 2811 | bytesRemainingInHashBuffer := Length(FHashBuffer) - FHashBufferIndex; 2812 | {HashBufferIndex is the next location to write to in hashbuffer 2813 | Sizeof(HasBuffer) - HashBufferIndex = space left in HashBuffer} 2814 | {cbSize is the number of bytes coming in from the user} 2815 | if bytesRemainingInHashBuffer <= dummySize then 2816 | begin 2817 | {If there is enough data left in the buffer to fill the HashBuffer 2818 | then copy enough to fill the HashBuffer} 2819 | Move(buffer^, FHashBuffer[FHashBufferIndex], bytesRemainingInHashBuffer); 2820 | Dec(dummySize, bytesRemainingInHashBuffer); 2821 | Inc(buffer, bytesRemainingInHashBuffer); 2822 | Compress; 2823 | end 2824 | else 2825 | begin 2826 | { 20070508 Ian Boyd 2827 | If the input length was not an even multiple of HashBufferSize (64 bytes i think), then 2828 | there was a buffer overrun. Rather than Moving and incrementing by DummySize 2829 | it was using cbSize, which is the size of the original buffer} 2830 | 2831 | {If there isn't enough data to fill the HashBuffer...} 2832 | {...copy as much as possible from the buffer into HashBuffer...} 2833 | Move(buffer^, FHashBuffer[FHashBufferIndex], dummySize); 2834 | {then move the HashBuffer Index to the next empty spot in HashBuffer} 2835 | Inc(FHashBufferIndex, dummySize); 2836 | {And shrink the size in the buffer to zero} 2837 | dummySize := 0; 2838 | end; 2839 | end; 2840 | end; 2841 | 2842 | procedure TSHA256.HashData(const Buffer; BufferLen: Integer); 2843 | begin 2844 | Self.HashCore(Buffer, BufferLen); 2845 | end; 2846 | 2847 | function TSHA256.HashFinal: TBytes; 2848 | { This method finalizes any partial computation and returns the correct hash 2849 | value for the data stream.} 2850 | type 2851 | TLongWordBuffer = array[0..15] of LongWord; 2852 | begin 2853 | {The final act is to tack on the size of the message} 2854 | 2855 | {Tack on the final bit 1 to the end of the data} 2856 | FHashBuffer[FHashBufferIndex] := $80; 2857 | 2858 | {[56] is the start of the 2nd last word in HashBuffer} 2859 | {if we are at (or past) it, then there isn't enough room for the whole 2860 | message length (64-bits i.e. 2 words) to be added in} 2861 | {The HashBuffer can essentially be considered full (even if the Index is not 2862 | all the way to the end), since it the remaining zeros are prescribed padding 2863 | anyway} 2864 | if FHashBufferIndex >= 56 then 2865 | Compress; 2866 | 2867 | {Write in LenHi (it needs it's endian order changed)} 2868 | {LenHi is the high order word of the Length of the message in bits} 2869 | TLongWordBuffer(FHashBuffer)[14] := ByteSwap(FHashLength.HighPart); 2870 | 2871 | {[60] is the last word in HashBuffer} 2872 | {Write in LenLo (it needs it's endian order changed)} 2873 | {LenLo is the low order word of the length of the message} 2874 | TLongWordBuffer(FHashBuffer)[15] := ByteSwap(FHashLength.LowPart); 2875 | 2876 | {The hashbuffer should now be filled up} 2877 | Compress; 2878 | 2879 | {Finalize the hash value into CurrentHash} 2880 | SetLength(Result, Self.GetDigestSize); 2881 | PLongWordArray(Result)[0]:= ByteSwap(FCurrentHash[0]); 2882 | PLongWordArray(Result)[1]:= ByteSwap(FCurrentHash[1]); 2883 | PLongWordArray(Result)[2]:= ByteSwap(FCurrentHash[2]); 2884 | PLongWordArray(Result)[3]:= ByteSwap(FCurrentHash[3]); 2885 | PLongWordArray(Result)[4]:= ByteSwap(FCurrentHash[4]); 2886 | PLongWordArray(Result)[5]:= ByteSwap(FCurrentHash[5]); 2887 | PLongWordArray(Result)[6]:= ByteSwap(FCurrentHash[6]); 2888 | PLongWordArray(Result)[7]:= ByteSwap(FCurrentHash[7]); 2889 | 2890 | {Burn all the temporary areas} 2891 | Burn; 2892 | end; 2893 | 2894 | procedure TSHA256.Initialize; 2895 | begin 2896 | Self.Burn; 2897 | 2898 | FInitialized := True; 2899 | end; 2900 | 2901 | procedure TSHA256.UpdateLen(NumBytes: LongWord); 2902 | //Len is the number of bytes in input buffer 2903 | //This is eventually used to pad out the final message block with 2904 | // the number of bits in the block (a 64-bit number) 2905 | begin 2906 | //the HashLength is in BITS, so multiply NumBytes by 8 2907 | Inc(FHashLength.QuadPart, NumBytes * 8); 2908 | end; 2909 | 2910 | { TSHA256CryptoServiceProvider } 2911 | 2912 | const 2913 | advapi32 = 'advapi32.dll'; 2914 | const 2915 | PROV_RSA_AES = 24; //Provider type; from WinCrypt.h 2916 | MS_ENH_RSA_AES_PROV_W: UnicodeString = 'Microsoft Enhanced RSA and AES Cryptographic Provider'; //Provider name 2917 | MS_ENH_RSA_AES_PROV_XP_W: UnicodeString = 'Microsoft Enhanced RSA and AES Cryptographic Provider (Prototype)'; //Provider name 2918 | // dwFlags definitions for CryptAcquireContext 2919 | CRYPT_VERIFYCONTEXT = $F0000000; 2920 | 2921 | // dwParam 2922 | KP_IV = 1; // Initialization vector 2923 | KP_MODE = 4; // Mode of the cipher 2924 | 2925 | // KP_MODE 2926 | CRYPT_MODE_CBC = 1; // Cipher block chaining 2927 | CRYPT_MODE_ECB = 2; // Electronic code book 2928 | CRYPT_MODE_OFB = 3; // Output feedback mode 2929 | CRYPT_MODE_CFB = 4; // Cipher feedback mode 2930 | CRYPT_MODE_CTS = 5; // Ciphertext stealing mode 2931 | CRYPT_MODE_CBCI = 6; // ANSI CBC Interleaved 2932 | CRYPT_MODE_CFBP = 7; // ANSI CFB Pipelined 2933 | CRYPT_MODE_OFBP = 8; // ANSI OFB Pipelined 2934 | CRYPT_MODE_CBCOFM = 9; // ANSI CBC + OF Masking 2935 | CRYPT_MODE_CBCOFMI = 10; // ANSI CBC + OFM Interleaved 2936 | 2937 | HP_HASHVAL = $0002; 2938 | HP_HASHSIZE = $0004; 2939 | 2940 | PLAINTEXTKEYBLOB = $8; 2941 | CUR_BLOB_VERSION = 2; 2942 | 2943 | ALG_CLASS_DATA_ENCRYPT = (3 shl 13); 2944 | ALG_TYPE_BLOCK = (3 shl 9); 2945 | ALG_SID_AES_128 = 14; 2946 | ALG_SID_AES_256 = 16; 2947 | 2948 | CALG_AES_128 = (ALG_CLASS_DATA_ENCRYPT or ALG_TYPE_BLOCK or ALG_SID_AES_128); 2949 | CALG_AES_256 = (ALG_CLASS_DATA_ENCRYPT or ALG_TYPE_BLOCK or ALG_SID_AES_256); 2950 | 2951 | function CryptAcquireContext(out phProv: HCRYPTPROV; pszContainer: PWideChar; pszProvider: PWideChar; dwProvType: DWORD; dwFlags: DWORD): BOOL; stdcall; external advapi32 name 'CryptAcquireContextW'; 2952 | function CryptReleaseContext(hProv: HCRYPTPROV; dwFlags: DWORD): BOOL; stdcall; external advapi32; 2953 | function CryptGenRandom(hProv: HCRYPTPROV; dwLen: DWORD; pbBuffer: Pointer): BOOL; stdcall; external advapi32; 2954 | function CryptCreateHash(hProv: HCRYPTPROV; Algid: ALG_ID; hKey: HCRYPTKEY; dwFlags: DWORD; out hHash: HCRYPTHASH): BOOL; stdcall; external advapi32; 2955 | function CryptHashData(hHash: HCRYPTHASH; pbData: PByte; dwDataLen: DWORD; dwFlags: DWORD): BOOL; stdcall; external advapi32; 2956 | function CryptGetHashParam(hHash: HCRYPTHASH; dwParam: DWORD; pbData: PByte; var dwDataLen: DWORD; dwFlags: DWORD): BOOL; stdcall; external advapi32; 2957 | function CryptDestroyHash(hHash: HCRYPTHASH): BOOL; stdcall; external advapi32; 2958 | 2959 | //function CryptImportKey(hProv: HCRYPTPROV; pbData: PByte; dwDataLen: DWORD; hPubKey: HCRYPTKEY; dwFlags: DWORD; out phKey: HCRYPTKEY): BOOL; stdcall; external advapi32; 2960 | //function CryptSetKeyParam(hKey: HCRYPTKEY; dwParam: DWORD; pbData: PByte; dwFlags: DWORD): BOOL; stdcall; external advapi32; 2961 | //function CryptDestroyKey(hKey: HCRYPTKEY): BOOL; stdcall; external advapi32; 2962 | //function CryptEncrypt(hKey: HCRYPTKEY; hHash: HCRYPTHASH; Final: BOOL; dwFlags: DWORD; pbData: PByte; var pdwDataLen: DWORD; dwBufLen: DWORD): BOOL; stdcall; external advapi32; 2963 | //function CryptDecrypt(hKey: HCRYPTKEY; hHash: HCRYPTHASH; Final: BOOL; dwFlags: DWORD; pbData: PByte; var pdwDataLen: DWORD): BOOL; stdcall; external advapi32; 2964 | 2965 | 2966 | { TSHA1csp } 2967 | 2968 | procedure TCspHash.Burn; 2969 | var 2970 | le: DWORD; 2971 | begin 2972 | if FHash = 0 then 2973 | Exit; 2974 | 2975 | try 2976 | if not CryptDestroyHash(FHash) then 2977 | begin 2978 | le := GetLastError; 2979 | RaiseOSError(le, Format('Could not destroy current hash provider: %s (%d)', [SysErrorMessage(le), le])); 2980 | Exit; 2981 | end; 2982 | finally 2983 | FHash := 0; 2984 | end; 2985 | end; 2986 | 2987 | constructor TCspHash.Create(AlgorithmID: Cardinal; BlockSize: Integer); 2988 | var 2989 | providerName: UnicodeString; 2990 | provider: HCRYPTPROV; 2991 | le: DWORD; 2992 | const 2993 | PROV_RSA_AES = 24; //Provider type; from WinCrypt.h 2994 | // MS_ENH_RSA_AES_PROV_W: UnicodeString = 'Microsoft Enhanced RSA and AES Cryptographic Provider'; //Provider name 2995 | // MS_ENH_RSA_AES_PROV_XP_W: UnicodeString = 'Microsoft Enhanced RSA and AES Cryptographic Provider (Prototype)'; //Provider name 2996 | 2997 | begin 2998 | inherited Create; 2999 | 3000 | { 3001 | Set ProviderName to either 3002 | providerName = "Microsoft Enhanced RSA and AES Cryptographic Provider" 3003 | providerName = "Microsoft Enhanced RSA and AES Cryptographic Provider (Prototype)" //Windows XP and earlier 3004 | } 3005 | { providerName := MS_ENH_RSA_AES_PROV_W; 3006 | //Before Vista it was a prototype provider 3007 | if (Win32MajorVersion < 6) then //6.0 was Vista and Server 2008 3008 | providerName := MS_ENH_RSA_AES_PROV_XP_W;} 3009 | 3010 | // if not CryptAcquireContext(provider, nil, PWideChar(providerName), PROV_RSA_AES, CRYPT_VERIFYCONTEXT) then 3011 | if not CryptAcquireContext({out}provider, nil, nil, PROV_RSA_AES, CRYPT_VERIFYCONTEXT) then 3012 | begin 3013 | le := GetLastError; 3014 | RaiseOSError(le, Format('Could not acquire context to provider "%s" (Win32MajorVersion=%d)', 3015 | [providerName, Win32MajorVersion])); 3016 | end; 3017 | 3018 | FProvider := provider; 3019 | FAlgorithmID := AlgorithmID; 3020 | FBlockSize := BlockSize; //SHA1: 64 bytes, SHA256: 64 bytes 3021 | 3022 | Self.Initialize; 3023 | end; 3024 | 3025 | destructor TCspHash.Destroy; 3026 | begin 3027 | { 3028 | //If there is a hash, we must destroy it before releasing the context (the hash keeps an internal reference to the provider, 3029 | which would become invalid and possibly crash) 3030 | https://blogs.msdn.microsoft.com/oldnewthing/20160127-00/?p=92934 3031 | } 3032 | Self.Burn; 3033 | 3034 | if FProvider <> 0 then 3035 | begin 3036 | CryptReleaseContext(FProvider, 0); 3037 | FProvider := 0; 3038 | end; 3039 | 3040 | inherited; 3041 | end; 3042 | 3043 | function TCspHash.Finalize: TBytes; 3044 | begin 3045 | Result := Self.HashFinal; 3046 | Self.Initialize; //Get ready for another round of hashing 3047 | end; 3048 | 3049 | function TCspHash.GetBlockSize: Integer; 3050 | begin 3051 | // Result := 64; //block size of SHA1 is 64 bytes (512 bits) 3052 | Result := FBlockSize; //64 for SHA1, 64 for SHA256 3053 | end; 3054 | 3055 | function TCspHash.GetDigestSize: Integer; 3056 | var 3057 | dataLen: Cardinal; 3058 | begin 3059 | // Result := 20; //digest size of SHA-1 is 160 bits (20 bytes) 3060 | 3061 | //Works. But strictly speaking you must first call HP_HASHSIZE with nil, 3062 | //in order to find out you must pass it a 4-byte integer to hold the resulting size 3063 | // dataLen := SizeOf(Result); 3064 | // if not CryptGetHashParam(FHash, HP_HASHSIZE, @Result, dataLen, 0) then 3065 | // RaiseLastOSError; 3066 | 3067 | //Fails with 234 (More data is available) 3068 | // if not CryptGetHashParam(FHash, HP_HASHVAL, @Result, dataLen, 0) then 3069 | // RaiseLastOSError; 3070 | 3071 | //https://blogs.msdn.microsoft.com/oldnewthing/20160128-00/?p=92941 3072 | //Use nil, and HP_HASHVAL will work 3073 | if not CryptGetHashParam(FHash, HP_HASHVAL, nil, {var}dataLen, 0) then 3074 | RaiseLastOSError; 3075 | 3076 | Result := Integer(dataLen); 3077 | end; 3078 | 3079 | procedure TCspHash.HashCore(const Data; DataLen: Integer); 3080 | var 3081 | le: DWORD; 3082 | begin 3083 | if (FHash = 0) then 3084 | raise Exception.Create('TCspHash is not initialized'); 3085 | 3086 | if not CryptHashData(FHash, PByte(@Data), DataLen, 0) then 3087 | begin 3088 | le := GetLastError; 3089 | raise Exception.CreateFmt('Error hashing data: %s (%d)', [SysErrorMessage(le), le]); 3090 | end; 3091 | end; 3092 | 3093 | procedure TCspHash.HashData(const Buffer; BufferLen: Integer); 3094 | begin 3095 | Self.HashCore(Buffer, BufferLen); 3096 | end; 3097 | 3098 | function TCspHash.HashFinal: TBytes; 3099 | var 3100 | digestSize: DWORD; 3101 | le: DWORD; 3102 | begin 3103 | digestSize := Self.GetDigestSize; 3104 | SetLength(Result, digestSize); 3105 | 3106 | if not CryptGetHashParam(FHash, HP_HASHVAL, @Result[0], digestSize, 0) then 3107 | begin 3108 | le := GetLastError; 3109 | raise Exception.CreateFmt('Could not get Hash value from CSP: %s (%d)', [SysErrorMessage(le), le]); 3110 | end; 3111 | end; 3112 | 3113 | procedure TCspHash.Initialize; 3114 | var 3115 | le: DWORD; 3116 | hash: THandle; 3117 | const 3118 | SCouldNotCreate = 'Could not create hash: %s (0x%.8x)'; 3119 | begin 3120 | Self.Burn; 3121 | 3122 | if not CryptCreateHash(FProvider, FAlgorithmID, 0, 0, {out}hash) then 3123 | begin 3124 | le := GetLastError; 3125 | RaiseOSError(le, Format(SCouldNotCreate, [SysErrorMessage(le), le])); 3126 | Exit; 3127 | end; 3128 | 3129 | FHash := hash; 3130 | end; 3131 | 3132 | { TSHA1Cng } 3133 | 3134 | procedure TCngHash.Burn; 3135 | begin 3136 | if FHash <> 0 then 3137 | begin 3138 | _BCryptDestroyHash(FHash); 3139 | FHash := 0; 3140 | ZeroMemory(@FHashObjectBuffer[0], Length(FHashObjectBuffer)); 3141 | end; 3142 | end; 3143 | 3144 | constructor TCngHash.Create(const AlgorithmID: UnicodeString; HmacKey: TBytes); 3145 | begin 3146 | { 3147 | BCrypt hash algorithm identifiers: 3148 | 3149 | - 'md2' 3150 | - 'md4' 3151 | - 'md5' 3152 | - 'sha1' 3153 | - 'sha256' 3154 | - 'sha384' 3155 | - 'sha512' 3156 | } 3157 | Self.Create(AlgorithmID, True); 3158 | 3159 | FHmacKey := HmacKey; 3160 | end; 3161 | 3162 | destructor TCngHash.Destroy; 3163 | begin 3164 | Self.Burn; 3165 | 3166 | if FAlgorithm <> 0 then 3167 | begin 3168 | _BCryptCloseAlgorithmProvider(FAlgorithm, 0); 3169 | FAlgorithm := 0; 3170 | end; 3171 | 3172 | inherited; 3173 | end; 3174 | 3175 | function TCngHash.Finalize: TBytes; 3176 | begin 3177 | Result := Self.HashFinal(FHash); 3178 | 3179 | Self.Burn; 3180 | end; 3181 | 3182 | function TCngHash.GetBlockSize: Integer; 3183 | begin 3184 | Result := FAlgorithmBlockSize; 3185 | end; 3186 | 3187 | function TCngHash.GetDigestSize: Integer; 3188 | begin 3189 | Result := FAlgorithmDigestSize; 3190 | end; 3191 | 3192 | constructor TCngHash.Create(AlgorithmID: string; HmacMode: Boolean; Provider: PWideChar=nil); 3193 | var 3194 | nts: NTSTATUS; 3195 | algorithm: BCRYPT_ALG_HANDLE; 3196 | objectLength: DWORD; 3197 | bytesReceived: Cardinal; 3198 | dwFlags: Cardinal; 3199 | begin 3200 | inherited Create; 3201 | { 3202 | BCrypt hash algorithm identifiers: 3203 | 3204 | - 'md2' 3205 | - 'md4' 3206 | - 'md5' 3207 | - 'sha1' 3208 | - 'sha256' 3209 | - 'sha384' 3210 | - 'sha512' 3211 | } 3212 | Self.RequireBCrypt; 3213 | 3214 | dwFlags := 0; 3215 | if HmacMode then 3216 | dwFlags := BCRYPT_ALG_HANDLE_HMAC_FLAG; 3217 | 3218 | nts := _BCryptOpenAlgorithmProvider({out}algorithm, 3219 | PWideChar(AlgorithmID), //Algorithm: e.g. BCRYPT_SHA1_ALGORITHM ("SHA1") 3220 | Provider, //Provider. nil ==> default 3221 | dwFlags 3222 | ); 3223 | NTStatusCheck(nts); 3224 | 3225 | FAlgorithm := algorithm; 3226 | 3227 | //Get Algorithm block size 3228 | FAlgorithmBlockSize := TCngHash.GetBcryptAlgorithmBlockSize(FAlgorithm); 3229 | FAlgorithmDigestSize := TCngHash.GetBcryptAlgorithmDigestSize(FAlgorithm); 3230 | 3231 | //Get the length of the hash data object, so we can provide the required buffer 3232 | nts := _BCryptGetProperty(algorithm, PWideChar(BCRYPT_OBJECT_LENGTH), @objectLength, SizeOf(objectLength), {out}bytesReceived, 0); 3233 | NTStatusCheck(nts); 3234 | 3235 | SetLength(FHashObjectBuffer, objectLength); 3236 | 3237 | // Self.Initialize; delay initializtion until needed; giving them the opportunity to change the hmac key after construction 3238 | end; 3239 | 3240 | class function TCngHash.GetBcryptAlgorithmBlockSize(Algorithm: BCRYPT_HASH_HANDLE): Integer; 3241 | const 3242 | BCRYPT_HASH_BLOCK_LENGTH: WideString = 'HashBlockLength'; 3243 | var 3244 | blockSize: DWORD; 3245 | bytesReceived: Cardinal; 3246 | nts: NTSTATUS; 3247 | begin 3248 | //Get the hash block size 3249 | nts := _BCryptGetProperty(Algorithm, PWideChar(BCRYPT_HASH_BLOCK_LENGTH), @blockSize, SizeOf(blockSize), {out}bytesReceived, 0); 3250 | NTStatusCheck(nts); 3251 | 3252 | Result := Integer(blockSize); 3253 | end; 3254 | 3255 | class function TCngHash.GetBcryptAlgorithmDigestSize(Algorithm: BCRYPT_ALG_HANDLE): Integer; 3256 | const 3257 | BCRYPT_HASH_LENGTH = 'HashDigestLength'; 3258 | var 3259 | digestSize: DWORD; 3260 | bytesReceived: Cardinal; 3261 | nts: NTSTATUS; 3262 | begin 3263 | //Get the length of the hash digest 3264 | nts := _BCryptGetProperty(Algorithm, BCRYPT_HASH_LENGTH, @digestSize, SizeOf(digestSize), {out}bytesReceived, 0); 3265 | NTStatusCheck(nts); 3266 | 3267 | Result := Integer(digestSize); 3268 | end; 3269 | 3270 | procedure TCngHash.HashCore(Hash: BCRYPT_HASH_HANDLE; const Data; DataLen: Integer); 3271 | var 3272 | hr: NTSTATUS; 3273 | begin 3274 | hr := _BCryptHashData(Hash, Pointer(@Data), DataLen, 0); 3275 | NTStatusCheck(hr); 3276 | end; 3277 | 3278 | function TCngHash.HashData(const Key; KeyLen: Integer; const Data; DataLen: Integer): TBytes; 3279 | var 3280 | hmacKey: TBytes; 3281 | begin 3282 | SetLength(hmacKey, KeyLen); 3283 | if KeyLen > 0 then 3284 | Move(Key, hmacKey[0], KeyLen); 3285 | FHmacKey := hmacKey; 3286 | 3287 | Self.HashData(Data, DataLen); 3288 | Result := Self.Finalize; 3289 | end; 3290 | 3291 | procedure TCngHash.HashData(const Buffer; BufferLen: Integer); 3292 | begin 3293 | Self.Initialize; 3294 | Self.HashCore(FHash, Buffer, BufferLen); 3295 | end; 3296 | 3297 | function TCngHash.HashFinal(Hash: BCRYPT_HASH_HANDLE): TBytes; 3298 | var 3299 | digestSize: DWORD; 3300 | hr: NTSTATUS; 3301 | begin 3302 | digestSize := Self.GetDigestSize; 3303 | SetLength(Result, digestSize); 3304 | 3305 | hr :=_BCryptFinishHash(Hash, @Result[0], digestSize, 0); 3306 | NTStatusCheck(hr); 3307 | end; 3308 | 3309 | procedure TCngHash.Initialize; 3310 | var 3311 | pbSecret: Pointer; 3312 | cbSecret: Integer; 3313 | hash: BCRYPT_HASH_HANDLE; 3314 | hr: NTSTATUS; 3315 | begin 3316 | if FHash = 0 then 3317 | begin 3318 | pbSecret := nil; 3319 | cbSecret := 0; 3320 | if Length(FHmacKey) > 0 then 3321 | begin 3322 | pbSecret := Pointer(@FHmacKey[0]); 3323 | cbSecret := Length(FHmacKey); 3324 | end; 3325 | hr := _BCryptCreateHash(FAlgorithm, {out}hash, @FHashObjectBuffer[0], Length(FHashObjectBuffer), pbSecret, cbSecret, 0); 3326 | NTStatusCheck(hr); 3327 | 3328 | FHash := hash; 3329 | end; 3330 | end; 3331 | 3332 | class function TCngHash.InitializeBCrypt: Boolean; 3333 | var 3334 | moduleHandle: HMODULE; 3335 | available: Boolean; 3336 | 3337 | function GetProcedureAddress(procedureName: AnsiString; var FunctionFound: Boolean): Pointer; 3338 | begin 3339 | Result := GetProcAddress(moduleHandle, PAnsiChar(procedureName)); 3340 | if Result = nil then 3341 | FunctionFound := False; 3342 | end; 3343 | const 3344 | BCrypt = 'BCrypt.dll'; 3345 | begin 3346 | if (not _BCryptInitialized) then 3347 | begin 3348 | moduleHandle := SafeLoadLibrary(PChar(BCrypt)); 3349 | if moduleHandle <> 0 then 3350 | begin 3351 | available := True; 3352 | 3353 | _BCryptOpenAlgorithmProvider := GetProcedureAddress('BCryptOpenAlgorithmProvider', available); 3354 | _BCryptCloseAlgorithmProvider := GetProcedureAddress('BCryptCloseAlgorithmProvider', available); 3355 | _BCryptGenRandom := GetProcedureAddress('BCryptGenRandom', available); 3356 | _BCryptCreateHash := GetProcedureAddress('BCryptCreateHash', available); 3357 | _BCryptHashData := GetProcedureAddress('BCryptHashData', available); 3358 | _BCryptFinishHash := GetProcedureAddress('BCryptFinishHash', available); 3359 | _BCryptDestroyHash := GetProcedureAddress('BCryptDestroyHash', available); 3360 | _BCryptGetProperty := GetProcedureAddress('BCryptGetProperty', available); 3361 | _BCryptDeriveKeyPBKDF2 := GetProcedureAddress('BCryptDeriveKeyPBKDF2', available); 3362 | 3363 | _BCryptAvailable := available; 3364 | end; 3365 | _BCryptInitialized := True; 3366 | end; 3367 | 3368 | Result := _BCryptAvailable; 3369 | end; 3370 | 3371 | class function TCngHash.IsAvailable: Boolean; 3372 | begin 3373 | Result := TCngHash.InitializeBCrypt; 3374 | end; 3375 | 3376 | procedure TCngHash.RequireBCrypt; 3377 | begin 3378 | if not TCngHash.InitializeBCrypt then 3379 | raise Exception.Create('BCrypt not available. Requires Windows Vista or greater'); 3380 | end; 3381 | 3382 | { THmac } 3383 | 3384 | constructor THmac.Create(Hash: IHashAlgorithm); 3385 | begin 3386 | inherited Create; 3387 | 3388 | FHash := Hash; 3389 | end; 3390 | 3391 | function THmac.GetDigestSize: Integer; 3392 | begin 3393 | Result := FHash.DigestSize; 3394 | end; 3395 | 3396 | function THmac.HashData(const Key; KeyLen: Integer; const Data; DataLen: Integer): TBytes; 3397 | var 3398 | oKeyPad, iKeyPad: TBytes; 3399 | i, n: Integer; 3400 | digest: TBytes; 3401 | blockSize: Integer; 3402 | 3403 | type 3404 | PUInt64Array = ^TUInt64Array_Unsafe; 3405 | TUInt64Array_Unsafe = array[0..MaxInt div 16] of UInt64; 3406 | 3407 | begin 3408 | { 3409 | Implementation of RFC2104 HMAC: Keyed-Hashing for Message Authentication 3410 | 3411 | Tested with known test vectors from RFC2202: Test Cases for HMAC-MD5 and HMAC-SHA-1 3412 | } 3413 | blockSize := FHash.BlockSize; 3414 | 3415 | // Clear pads 3416 | SetLength(oKeyPad, blockSize); //elements will be initialized to zero by SetLength 3417 | SetLength(iKeyPad, blockSize); //elements will be initialized to zero by SetLength 3418 | 3419 | // if key is longer than blocksize: reset it to key=Hash(key) 3420 | if KeyLen > blockSize then 3421 | begin 3422 | FHash.HashData(Key, KeyLen); 3423 | digest := FHash.Finalize; 3424 | 3425 | //Store hashed key in pads 3426 | Move(digest[0], iKeyPad[0], Length(digest)); //remaining bytes will remain zero 3427 | Move(digest[0], oKeyPad[0], Length(digest)); //remaining bytes will remain zero 3428 | end 3429 | else 3430 | begin 3431 | //Store original key in pads 3432 | Move(Key, iKeyPad[0], KeyLen); //remaining bytes will remain zero 3433 | Move(Key, oKeyPad[0], KeyLen); //remaining bytes will remain zero 3434 | end; 3435 | 3436 | { 3437 | Xor key with ipad and ipod constants 3438 | iKeyPad = key xor 0x36 3439 | oKeyPad = key xor 0x5c 3440 | 3441 | DONE: Unroll this to blockSize div 4 xor's of $5c5c5c5c and $36363636 3442 | } 3443 | n := blockSize div SizeOf(UInt64); 3444 | for i := 0 to n-1 do 3445 | PUInt64Array(@oKeyPad[0])[i] := PUInt64Array(@oKeyPad[0])[i] xor UInt64($5c5c5c5c5c5c5c5c); 3446 | for i := 0 to n-1 do 3447 | PUInt64Array(@iKeyPad[0])[i] := PUInt64Array(@iKeyPad[0])[i] xor UInt64($3636363636363636); 3448 | n := blockSize mod SizeOf(UInt64); 3449 | if n <> 0 then 3450 | begin 3451 | //This should never happen in practice. 3452 | //Hash block sizes are going to be multiple of 8 bytes 3453 | for i := blockSize-1-n to blockSize-1 do 3454 | begin 3455 | oKeyPad[i] := oKeyPad[i] xor $5c; 3456 | iKeyPad[i] := iKeyPad[i] xor $36; 3457 | end; 3458 | end; 3459 | 3460 | { 3461 | Result := hash(oKeyPad || hash(iKeyPad || message)) 3462 | } 3463 | // Perform inner hash: digest = Hash(iKeyPad || data) 3464 | SetLength(iKeyPad, blockSize+DataLen); 3465 | Move(data, iKeyPad[blockSize], DataLen); 3466 | FHash.HashData(iKeyPad[0], Length(iKeyPad)); 3467 | digest := FHash.Finalize; 3468 | 3469 | // perform outer hash: result = Hash(oKeyPad || digest) 3470 | SetLength(oKeyPad, blockSize+Length(digest)); 3471 | Move(digest[0], oKeyPad[blockSize], Length(digest)); 3472 | FHash.HashData(oKeyPad[0], Length(oKeyPad)); 3473 | Result := FHash.Finalize; 3474 | end; 3475 | 3476 | { TRfc2898DeriveBytes } 3477 | 3478 | constructor TRfc2898DeriveBytes.Create(HMAC: IHmacAlgorithm); 3479 | begin 3480 | inherited Create; 3481 | 3482 | FHMAC := HMAC; 3483 | end; 3484 | 3485 | function TRfc2898DeriveBytes.GetBytes(const Password: UnicodeString; const Salt; const SaltLength: Integer; 3486 | IterationCount, DesiredBytes: Integer): TBytes; 3487 | var 3488 | Ti: TBytes; 3489 | V: TBytes; 3490 | U: TBytes; 3491 | hLen: Integer; //HMAC size in bytes 3492 | cbSalt: Integer; 3493 | l, r, i, j: Integer; 3494 | dwULen: DWORD; 3495 | derivedKey: TBytes; 3496 | passwordBytes: TBytes; 3497 | begin 3498 | { 3499 | Password-Based Key Derivation Function 2 3500 | 3501 | Implementation of RFC2898 3502 | PKCS #5: Password-Based Cryptography Specification Version 2.0 3503 | http://tools.ietf.org/html/rfc2898 3504 | 3505 | Given an arbitrary "password" string, and optionally some salt, PasswordKeyDeriveBytes 3506 | can generate n bytes, suitable for use as a cryptographic key. 3507 | 3508 | e.g. AES commonly uses 128-bit (16 byte) or 256-bit (32 byte) keys. 3509 | 3510 | Tested with test vectors from RFC6070 3511 | PKCS #5: Password-Based Key Derivation Function 2 (PBKDF2) Test Vectors 3512 | http://tools.ietf.org/html/rfc6070 3513 | } 3514 | // if DerivedKeyLength > 2^32*hLen then 3515 | // raise Exception.Create('Derived key too long'); 3516 | 3517 | if FHMAC = nil then 3518 | raise EScryptException.Create('No HMAC algorithm supplied'); 3519 | 3520 | hLen := FHMAC.DigestSize; 3521 | 3522 | l := Ceil(DesiredBytes / hLen); 3523 | r := DesiredBytes - (l-1)*hLen; 3524 | 3525 | cbSalt := SaltLength; 3526 | 3527 | SetLength(Ti, hLen); 3528 | SetLength(V, hLen); 3529 | SetLength(U, Max(cbSalt+4, hLen)); 3530 | 3531 | SetLength(derivedKey, DesiredBytes); 3532 | 3533 | passwordBytes := TScrypt.StringToUtf8(Password); 3534 | 3535 | for i := 1 to l do 3536 | begin 3537 | ZeroMemory(@Ti[0], hLen); 3538 | for j := 1 to IterationCount do 3539 | begin 3540 | if j = 1 then 3541 | begin 3542 | //It's the first iteration, construct the input for the hmac function 3543 | if cbSalt > 0 then 3544 | Move(Salt, u[0], cbSalt); 3545 | U[cbSalt] := Byte((i and $FF000000) shr 24); 3546 | U[cbSalt+ 1] := Byte((i and $00FF0000) shr 16); 3547 | U[cbSalt+ 2] := Byte((i and $0000FF00) shr 8); 3548 | U[cbSalt+ 3] := Byte((i and $000000FF) ); 3549 | dwULen := cbSalt + 4; 3550 | end 3551 | else 3552 | begin 3553 | Move(V[0], U[0], hLen); //memcpy(U, V, hlen); 3554 | dwULen := hLen; 3555 | end; 3556 | 3557 | //Run Password and U through HMAC to get digest V 3558 | V := FHMAC.HashData(passwordBytes[0], Length(passwordBytes), U[0], dwULen); 3559 | 3560 | //Ti <- Ti xor V 3561 | TScrypt.XorBlockInPlace({var}Ti[0], V[0], hlen); 3562 | end; 3563 | 3564 | if (i <> l) then 3565 | begin 3566 | Move(Ti[0], derivedKey[(i-1)*hLen], hLen); //memcpy(derivedKey[(i-1) * hlen], Ti, hlen); 3567 | end 3568 | else 3569 | begin 3570 | // Take only the first r bytes 3571 | Move(Ti[0], derivedKey[(i-1)*hLen], r); //memcpy(derivedKey[(i-1) * hlen], Ti, r); 3572 | end; 3573 | end; 3574 | 3575 | Result := derivedKey; 3576 | end; 3577 | 3578 | { TBCryptDeriveKeyPBKDF2 } 3579 | 3580 | constructor TBCryptDeriveKeyPBKDF2.Create(const AlgorithmID: UnicodeString; const Provider: PWideChar); 3581 | var 3582 | hr: NTSTATUS; 3583 | alg: BCRYPT_ALG_HANDLE; 3584 | begin 3585 | inherited Create; 3586 | 3587 | hr := _BCryptOpenAlgorithmProvider({out}alg, PWideChar(AlgorithmID), Provider, BCRYPT_ALG_HANDLE_HMAC_FLAG); 3588 | NTStatusCheck(hr); 3589 | 3590 | FAlgorithm := alg; 3591 | end; 3592 | 3593 | function TBCryptDeriveKeyPBKDF2.GetBytes(const Password: UnicodeString; const Salt; const SaltLength: Integer; 3594 | IterationCount, DesiredBytes: Integer): TBytes; 3595 | var 3596 | utf8Password: TBytes; 3597 | hr: NTSTATUS; 3598 | begin 3599 | SetLength(Result, DesiredBytes); 3600 | 3601 | utf8Password := TScrypt.StringToUtf8(Password); //needs to be before following Exit to avoid "'utf8Password' might not have been initialized" compiler bug 3602 | 3603 | if DesiredBytes = 0 then 3604 | Exit; 3605 | 3606 | 3607 | hr := _BCryptDeriveKeyPBKDF2(FAlgorithm, 3608 | Pointer(utf8Password), Length(utf8Password), 3609 | @Salt, SaltLength, 3610 | IterationCount, 3611 | Pointer(Result), Length(Result), 3612 | 0); 3613 | NTStatusCheck(hr); 3614 | end; 3615 | 3616 | end. 3617 | -------------------------------------------------------------------------------- /SCryptTests.pas: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/JackTrapper/scrypt-for-delphi/f5d05ba4f735e407dd00cc8a54388b82da2d182d/SCryptTests.pas -------------------------------------------------------------------------------- /UNLICENSE: -------------------------------------------------------------------------------- 1 | This is free and unencumbered software released into the public domain. 2 | 3 | Anyone is free to copy, modify, publish, use, compile, sell, or 4 | distribute this software, either in source code form or as a compiled 5 | binary, for any purpose, commercial or non-commercial, and by any 6 | means. 7 | 8 | In jurisdictions that recognize copyright laws, the author or authors 9 | of this software dedicate any and all copyright interest in the 10 | software to the public domain. We make this dedication for the benefit 11 | of the public at large and to the detriment of our heirs and 12 | successors. We intend this dedication to be an overt act of 13 | relinquishment in perpetuity of all present and future rights to this 14 | software under copyright law. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 19 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR 20 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 21 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 22 | OTHER DEALINGS IN THE SOFTWARE. 23 | 24 | For more information, please refer to 25 | 26 | --------------------------------------------------------------------------------