├── LICENSE ├── README.md ├── bitsy.fun └── bitsy.f90 /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014 Mikael Leetmaa 2 | 3 | This software is provided 'as-is', without any express or implied 4 | warranty. In no event will the authors be held liable for any damages 5 | arising from the use of this software. 6 | 7 | Permission is granted to anyone to use this software for any purpose, 8 | including commercial applications, and to alter it and redistribute it 9 | freely, subject to the following restrictions: 10 | 11 | 1. The origin of this software must not be misrepresented; you must not 12 | claim that you wrote the original software. If you use this software 13 | in a product, an acknowledgment in the product documentation would be 14 | appreciated but is not required. 15 | 16 | 2. Altered source versions must be plainly marked as such, and must not be 17 | misrepresented as being the original software. 18 | 19 | 3. This notice may not be removed or altered from any source 20 | distribution. 21 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | bitsy.f90 2 | ========== 3 | A fortran module for SHA-256 hashing. 4 | 5 | Compile and test 6 | ----------------- 7 | To run the unit-tests install 'funit' [http://nasarb.rubyforge.org/][1] and run with something like: 8 | 9 | FC="gfortran -fno-range-check -O3" funit 10 | 11 | The '-fno-range-check' flag is required since the fortran standard otherwise doesn't allow us to work with all bits in the integers (as if they were unsigned). 12 | 13 | Note 14 | ------ 15 | The quick and dirty routine (dirtys_sha256) operates on whatever bits that come in, without swapping to big-endian words, and does therefore not pas any of the standard tests - but works at roughly twice the speed. Use this if you want a good hash function but don't care about following the SHA-256 standard specifications. 16 | 17 | Note that this code will not produce the same results on big-endian machines and the module was only tested on a little-endian Ubuntu LTS 12.04 system using gfortran 4.6.3. 18 | 19 | 20 | If you found this useful, please let me know. 21 | 22 | Mikael Leetmaa 23 | 24 | [1]: http://nasarb.rubyforge.org/ 25 | 26 | -------------------------------------------------------------------------------- /bitsy.fun: -------------------------------------------------------------------------------- 1 | ! TEST SUITE FOR THE bitsy SHA-256 FORTRAN IMPLEMENTATION 2 | ! Author: Mikael Leetmaa 3 | ! Date: 05 Jan 2014 4 | test_suite bitsy 5 | 6 | integer(kind=4) :: ipad1, ipad2, ipad3, ipad4, ipad5, ipad6 7 | integer(kind=4) :: shftc4_r2, shftc4_l12 8 | integer(kind=4) :: shft5_r8, shft5_l11 9 | integer(kind=4) :: abc_bin, a_bin, empty_str_bin, empty_bin 10 | integer(kind=4) :: abc_bin_flip, a_bin_flip, empty_str_bin_flip 11 | integer(kind=4) :: abc_bin_ref, abc_bin_swap 12 | 13 | integer(kind=4) :: cabc_bin, abca_bin, bcab_bin, ca_one_zero 14 | integer(kind=4) :: cabc_bin_flip, abca_bin_flip, bcab_bin_flip, ca_one_zero_flip 15 | integer(kind=4) :: big_endian_464, little_endian_464 16 | 17 | data ipad1 / b'00000000000000000000000000000011' / 18 | data ipad2 / b'11111111111111111111111111111111' / 19 | data ipad3 / b'10010000101001110011001110010011' / 20 | data ipad4 / b'11001001101001110011001110010011' / 21 | data ipad5 / b'10000001101001010011000110100001' / 22 | data ipad6 / b'11000000000000000000000000000000' / 23 | 24 | data shftc4_r2 / b'11110010011010011100110011100100' / 25 | data shftc4_l12 / b'01110011001110010011110010011010' / 26 | data shft5_r8 / b'00000000100000011010010100110001' / 27 | data shft5_l11 / b'00101001100011010000100000000000' / 28 | data abc_bin / b'00000001011000110110001001100001' / 29 | data a_bin / b'00000000000000000000000101100001' / 30 | data empty_str_bin / b'00000000000000000000000000000001' / 31 | data empty_bin / b'00000000000000000000000000000000' / 32 | data abc_bin_flip / b'01100001011000100110001110000000' / 33 | data empty_str_bin_flip / b'10000000000000000000000000000000' / 34 | data a_bin_flip / b'01100001100000000000000000000000' / 35 | 36 | data abca_bin / b'01100001011000110110001001100001' / 37 | data bcab_bin / b'01100010011000010110001101100010' / 38 | data cabc_bin / b'01100011011000100110000101100011' / 39 | data ca_one_zero / b'00000000000000010110000101100011' / 40 | data big_endian_464 / b'11010000000000010000000000000000' / 41 | data little_endian_464 / b'00000000000000000000000111010000' / 42 | 43 | data abc_bin_ref / b'00000001011000110110001001100001' / 44 | data abc_bin_swap / b'01100001011000100110001100000001' / 45 | 46 | data abca_bin_flip / b'01100001011000100110001101100001' / 47 | data bcab_bin_flip / b'01100010011000110110000101100010' / 48 | data cabc_bin_flip / b'01100011011000010110001001100011' / 49 | data ca_one_zero_flip / b'01100011011000011000000000000000' / 50 | 51 | ! Test the swap function. 52 | test test_swap32 53 | Assert_Equal(swap32(abc_bin), abc_bin_swap) 54 | Assert_Equal(abc_bin, abc_bin_ref) 55 | end test 56 | 57 | ! Make sure the intrinsic ishftc function does what we think. 58 | test test_ishftc 59 | integer(kind=4) :: a 60 | a = ishftc(ipad4, -2) 61 | Assert_Equal(a, shftc4_r2) 62 | a = ishftc(ipad4, 12) 63 | Assert_Equal(a, shftc4_l12) 64 | end test 65 | 66 | ! Make sure the intrinsic ishft function does what we think. 67 | test test_ishft 68 | integer(kind=4) :: a 69 | a = ishft(ipad5, -8) 70 | Assert_Equal(a, shft5_r8) 71 | a = ishft(ipad5, 11) 72 | Assert_Equal(a, shft5_l11) 73 | end test 74 | 75 | ! Test the message padding. 76 | test pad_message1 77 | character(len=1000) :: str 78 | integer(kind=4) :: inp(16) 79 | integer(kind=8) :: length 80 | integer :: pos0, break 81 | integer :: swap = 1 82 | 83 | ! Set the message to "". 84 | str = "" 85 | pos0 = 1 86 | break = 0 87 | length = 0 88 | call consume_chunk(str, length, inp, pos0, break, swap) 89 | 90 | ! Check the first word. 91 | Assert_Equal(inp(1), empty_str_bin_flip) 92 | 93 | ! Set the message to "abc". 94 | str = "abc" 95 | pos0 = 1 96 | break = 0 97 | length = 3 98 | call consume_chunk(str, length, inp, pos0, break, swap) 99 | 100 | ! Check the first word. 101 | Assert_Equal(inp(1), abc_bin_flip) 102 | 103 | ! Set the message to "a". 104 | str = "a" 105 | pos0 = 1 106 | break = 0 107 | length = 1 108 | call consume_chunk(str, length, inp, pos0, break, swap) 109 | 110 | ! Check the first word. 111 | Assert_Equal(inp(1), a_bin_flip) 112 | 113 | end test 114 | 115 | ! Test the message padding. 116 | test pad_message2 117 | character(len=1024) :: str 118 | integer(kind=4) :: inp(16) 119 | integer(kind=8) :: length 120 | integer :: pos0, break 121 | integer :: swap = 1 122 | 123 | ! Set the message. 124 | str = "abcabcabcabcabcaabcabcabcabcabcaabcabcabcabcabcaabcabcabca" 125 | 126 | pos0 = 1 127 | break = 0 128 | length = 58 129 | call consume_chunk(str, length, inp, pos0, break, swap) 130 | 131 | ! Check the whole message. 132 | Assert_Equal(inp(1), abca_bin_flip) 133 | Assert_Equal(inp(2), bcab_bin_flip) 134 | Assert_Equal(inp(3), cabc_bin_flip) 135 | Assert_Equal(inp(4), abca_bin_flip) 136 | Assert_Equal(inp(5), abca_bin_flip) 137 | Assert_Equal(inp(6), bcab_bin_flip) 138 | Assert_Equal(inp(7), cabc_bin_flip) 139 | Assert_Equal(inp(8), abca_bin_flip) 140 | Assert_Equal(inp(9), abca_bin_flip) 141 | Assert_Equal(inp(10), bcab_bin_flip) 142 | Assert_Equal(inp(11), cabc_bin_flip) 143 | Assert_Equal(inp(12), abca_bin_flip) 144 | Assert_Equal(inp(13), abca_bin_flip) 145 | Assert_Equal(inp(14), bcab_bin_flip) 146 | Assert_Equal(inp(15), ca_one_zero_flip) 147 | Assert_Equal(inp(16), empty_bin) 148 | 149 | call consume_chunk(str, length, inp, pos0, break, swap) 150 | 151 | Assert_Equal(inp(1), empty_bin) 152 | Assert_Equal(inp(2), empty_bin) 153 | Assert_Equal(inp(3), empty_bin) 154 | Assert_Equal(inp(4), empty_bin) 155 | Assert_Equal(inp(5), empty_bin) 156 | Assert_Equal(inp(6), empty_bin) 157 | Assert_Equal(inp(7), empty_bin) 158 | Assert_Equal(inp(8), empty_bin) 159 | Assert_Equal(inp(9), empty_bin) 160 | Assert_Equal(inp(10), empty_bin) 161 | Assert_Equal(inp(11), empty_bin) 162 | Assert_Equal(inp(12), empty_bin) 163 | Assert_Equal(inp(13), empty_bin) 164 | Assert_Equal(inp(14), empty_bin) 165 | Assert_Equal(inp(15), empty_bin) 166 | Assert_Equal(inp(16), little_endian_464) 167 | 168 | end test 169 | 170 | ! Test the ch function. 171 | test test_ch 172 | integer(kind=4) :: e, f, g 173 | integer(kind=4) :: aa, bb, cc 174 | e = ipad1 175 | f = ipad2 176 | g = ipad3 177 | aa = iand(not(e),g) 178 | bb = iand(e,f) 179 | Assert_Equal(ieor(aa,bb), maj(e,f,g)) 180 | end test 181 | 182 | ! Test the maj function. 183 | test test_maj 184 | integer(kind=4) :: a, b, c 185 | integer(kind=4) :: aa, bb, cc 186 | 187 | a = ipad1 188 | b = ipad2 189 | c = ipad3 190 | aa = iand(a,b) 191 | bb = iand(a,c) 192 | cc = iand(b,c) 193 | Assert_Equal(ieor(aa, ieor(bb, cc)), maj(a,b,c)) 194 | 195 | a = ipad2 196 | b = ipad3 197 | c = ipad4 198 | aa = iand(a,b) 199 | bb = iand(a,c) 200 | cc = iand(b,c) 201 | Assert_Equal(ieor(aa, ieor(bb, cc)), maj(a,b,c)) 202 | 203 | a = ipad3 204 | b = ipad4 205 | c = ipad5 206 | aa = iand(a,b) 207 | bb = iand(a,c) 208 | cc = iand(b,c) 209 | Assert_Equal(ieor(aa, ieor(bb, cc)), maj(a,b,c)) 210 | 211 | a = ipad4 212 | b = ipad5 213 | c = ipad6 214 | aa = iand(a,b) 215 | bb = iand(a,c) 216 | cc = iand(b,c) 217 | Assert_Equal(ieor(aa, ieor(bb, cc)), maj(a,b,c)) 218 | 219 | end test 220 | 221 | ! Test the major sigma-0 function. 222 | test test_cs0 223 | integer(kind=4) :: a, b, c 224 | a = ishftc(ipad1, -2) 225 | b = ishftc(ipad1, -13) 226 | c = ishftc(ipad1, -22) 227 | Assert_Equal(ieor(a, ieor(b, c)), cs0(ipad1)) 228 | 229 | a = ishftc(ipad2, -2) 230 | b = ishftc(ipad2, -13) 231 | c = ishftc(ipad2, -22) 232 | Assert_Equal(ieor(a, ieor(b, c)), cs0(ipad2)) 233 | 234 | a = ishftc(ipad3, -2) 235 | b = ishftc(ipad3, -13) 236 | c = ishftc(ipad3, -22) 237 | Assert_Equal(ieor(a, ieor(b, c)), cs0(ipad3)) 238 | 239 | a = ishftc(ipad4, -2) 240 | b = ishftc(ipad4, -13) 241 | c = ishftc(ipad4, -22) 242 | Assert_Equal(ieor(a, ieor(b, c)), cs0(ipad4)) 243 | 244 | a = ishftc(ipad5, -2) 245 | b = ishftc(ipad5, -13) 246 | c = ishftc(ipad5, -22) 247 | Assert_Equal(ieor(a, ieor(b, c)), cs0(ipad5)) 248 | 249 | a = ishftc(ipad6, -2) 250 | b = ishftc(ipad6, -13) 251 | c = ishftc(ipad6, -22) 252 | Assert_Equal(ieor(a, ieor(b, c)), cs0(ipad6)) 253 | end test 254 | 255 | ! Test the major sigma-1 function. 256 | test test_cs1 257 | integer(kind=4) :: a, b, c 258 | a = ishftc(ipad1, -6) 259 | b = ishftc(ipad1, -11) 260 | c = ishftc(ipad1, -25) 261 | Assert_Equal(ieor(a, ieor(b, c)), cs1(ipad1)) 262 | 263 | a = ishftc(ipad2, -6) 264 | b = ishftc(ipad2, -11) 265 | c = ishftc(ipad2, -25) 266 | Assert_Equal(ieor(a, ieor(b, c)), cs1(ipad2)) 267 | 268 | a = ishftc(ipad3, -6) 269 | b = ishftc(ipad3, -11) 270 | c = ishftc(ipad3, -25) 271 | Assert_Equal(ieor(a, ieor(b, c)), cs1(ipad3)) 272 | 273 | a = ishftc(ipad4, -6) 274 | b = ishftc(ipad4, -11) 275 | c = ishftc(ipad4, -25) 276 | Assert_Equal(ieor(a, ieor(b, c)), cs1(ipad4)) 277 | 278 | a = ishftc(ipad5, -6) 279 | b = ishftc(ipad5, -11) 280 | c = ishftc(ipad5, -25) 281 | Assert_Equal(ieor(a, ieor(b, c)), cs1(ipad5)) 282 | 283 | a = ishftc(ipad6, -6) 284 | b = ishftc(ipad6, -11) 285 | c = ishftc(ipad6, -25) 286 | Assert_Equal(ieor(a, ieor(b, c)), cs1(ipad6)) 287 | 288 | end test 289 | 290 | ! Test the minor sigma-0 function. 291 | test test_ms0 292 | integer(kind=4) :: a, b, c 293 | 294 | a = ishftc(ipad1, -7) 295 | b = ishftc(ipad1, -18) 296 | c = ishft(ipad1, -3) 297 | Assert_Equal(ieor(a, ieor(b, c)), ms0(ipad1)) 298 | 299 | a = ishftc(ipad2, -7) 300 | b = ishftc(ipad2, -18) 301 | c = ishft(ipad2, -3) 302 | Assert_Equal(ieor(a, ieor(b, c)), ms0(ipad2)) 303 | 304 | a = ishftc(ipad3, -7) 305 | b = ishftc(ipad3, -18) 306 | c = ishft(ipad3, -3) 307 | Assert_Equal(ieor(a, ieor(b, c)), ms0(ipad3)) 308 | 309 | a = ishftc(ipad4, -7) 310 | b = ishftc(ipad4, -18) 311 | c = ishft(ipad4, -3) 312 | Assert_Equal(ieor(a, ieor(b, c)), ms0(ipad4)) 313 | 314 | a = ishftc(ipad5, -7) 315 | b = ishftc(ipad5, -18) 316 | c = ishft(ipad5, -3) 317 | Assert_Equal(ieor(a, ieor(b, c)), ms0(ipad5)) 318 | 319 | a = ishftc(ipad6, -7) 320 | b = ishftc(ipad6, -18) 321 | c = ishft(ipad6, -3) 322 | Assert_Equal(ieor(a, ieor(b, c)), ms0(ipad6)) 323 | 324 | end test 325 | 326 | ! Test the minor sigma-1 function. 327 | test test_ms1 328 | integer(kind=4) :: a, b, c 329 | 330 | a = ishftc(ipad1, -17) 331 | b = ishftc(ipad1, -19) 332 | c = ishft(ipad1, -10) 333 | Assert_Equal(ieor(a, ieor(b, c)), ms1(ipad1)) 334 | 335 | a = ishftc(ipad2, -17) 336 | b = ishftc(ipad2, -19) 337 | c = ishft(ipad2, -10) 338 | Assert_Equal(ieor(a, ieor(b, c)), ms1(ipad2)) 339 | 340 | a = ishftc(ipad3, -17) 341 | b = ishftc(ipad3, -19) 342 | c = ishft(ipad3, -10) 343 | Assert_Equal(ieor(a, ieor(b, c)), ms1(ipad3)) 344 | 345 | a = ishftc(ipad4, -17) 346 | b = ishftc(ipad4, -19) 347 | c = ishft(ipad4, -10) 348 | Assert_Equal(ieor(a, ieor(b, c)), ms1(ipad4)) 349 | 350 | a = ishftc(ipad5, -17) 351 | b = ishftc(ipad5, -19) 352 | c = ishft(ipad5, -10) 353 | Assert_Equal(ieor(a, ieor(b, c)), ms1(ipad5)) 354 | 355 | a = ishftc(ipad6, -17) 356 | b = ishftc(ipad6, -19) 357 | c = ishft(ipad6, -10) 358 | Assert_Equal(ieor(a, ieor(b, c)), ms1(ipad6)) 359 | 360 | end test 361 | 362 | ! Test the sha256 function with a set of reference strings. 363 | test test_sha256_1 364 | character(len=1000000) :: str 365 | str = "" 366 | Assert_Equal(sha256(str), "E3B0C44298FC1C149AFBF4C8996FB92427AE41E4649B934CA495991B7852B855") 367 | end test 368 | 369 | test test_sha256_2 370 | character(len=1000000) :: str 371 | str = "abc" 372 | Assert_Equal(sha256(str), "BA7816BF8F01CFEA414140DE5DAE2223B00361A396177A9CB410FF61F20015AD") 373 | end test 374 | 375 | test test_sha256_3 376 | character(len=1000000) :: str 377 | str = "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" 378 | Assert_Equal(sha256(str), "248D6A61D20638B8E5C026930C3E6039A33CE45964FF2167F6ECEDD419DB06C1") 379 | end test 380 | 381 | test test_sha256_4 382 | character(len=1000000) :: str 383 | str = "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" 384 | Assert_Equal(sha256(str), "CF5B16A778AF8380036CE59E7B0492370B249B11E8F07A51AFAC45037AFEE9D1") 385 | end test 386 | 387 | test test_sha256_5 388 | character(len=1000000) :: str 389 | character(len=64) :: ref 390 | integer :: i 391 | do i=1,1000000 392 | str(i:i) = "a" 393 | end do 394 | Assert_Equal(sha256(str), "CDC76E5C9914FB9281A1C7E284D73E67F1809A48A497200E046D39CCC7112CD0") 395 | ! Check the quick and dirty implementation as well. 396 | ref = "69E3FACD5F08321F78117BD53476E5321845433356F106E7013E68EC367F3017" 397 | Assert_Equal(dirty_sha256(str), ref) 398 | end test 399 | 400 | test test_sha256_6 401 | character(len=1000000) :: str 402 | str = "message digest" 403 | Assert_Equal(sha256(str), "F7846F55CF23E14EEBEAB5B4E1550CAD5B509E3348FBC4EFA3A1413D393CB650") 404 | end test 405 | 406 | test test_sha256_7 407 | character(len=1000000) :: str 408 | str = "secure hash algorithm" 409 | Assert_Equal(sha256(str), "F30CEB2BB2829E79E4CA9753D35A8ECC00262D164CC077080295381CBD643F0D") 410 | end test 411 | 412 | test test_sha256_8 413 | character(len=1000000) :: str 414 | str = "SHA256 is considered to be safe" 415 | Assert_Equal(sha256(str), "6819D915C73F4D1E77E4E1B52D1FA0F9CF9BEAEAD3939F15874BD988E2A23630") 416 | end test 417 | 418 | test test_sha256_9 419 | character(len=1000000) :: str 420 | str = "For this sample, this 63-byte string will be used as input data" 421 | Assert_Equal(sha256(str), "F08A78CBBAEE082B052AE0708F32FA1E50C5C421AA772BA5DBB406A2EA6BE342") 422 | end test 423 | 424 | test test_sha256_10 425 | character(len=1000000) :: str 426 | str = "This is exactly 64 bytes long, not counting the terminating byte" 427 | Assert_Equal(sha256(str), "AB64EFF7E88E2E46165E29F2BCE41826BD4C7B3552F6B382A9E7D3AF47C245F8") 428 | end test 429 | 430 | test test_sha256_11 431 | character(16777216*64) :: str 432 | integer :: i 433 | do i=1,16777216 434 | str(1+(i-1)*64:i*64) = "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmno" 435 | end do 436 | Assert_Equal(sha256(str), "50E72A0E26442FE2552DC3938AC58658228C0CBFB1D2CA872AE435266FCD055E") 437 | end test 438 | 439 | end test_suite 440 | -------------------------------------------------------------------------------- /bitsy.f90: -------------------------------------------------------------------------------- 1 | !> Module for SHA-256 hashing in fortran. 2 | !! 3 | !! @author Mikael Leetmaa 4 | !! @data 05 Jan 2014 5 | !! 6 | module bitsy 7 | use iso_c_binding 8 | 9 | ! Never use implicit declarations. 10 | implicit none 11 | 12 | ! Keep private what we can. 13 | private 14 | 15 | ! Defines the public interface. 16 | public sha256 17 | public dirty_sha256 18 | 19 | ! Public for the sake of unit-testing. 20 | public sha256b 21 | public ms0 22 | public ms1 23 | public cs0 24 | public cs1 25 | public maj 26 | public ch 27 | public swap32 28 | public swap64 29 | public swap64a 30 | public consume_chunk 31 | 32 | contains 33 | 34 | !> SHA-256 interface function. 35 | !! @param str : (in) The message to digest. 36 | !! @return : The SHA-256 digest as a string of length 64. 37 | function sha256(str) 38 | implicit none 39 | ! ----------------------------------- 40 | ! Define the interface. 41 | character(len=64) :: sha256 42 | character(len=*), intent(in) :: str 43 | ! ----------------------------------- 44 | ! Call the work horse with proper bit swapping. 45 | sha256 = sha256b(str, 1) 46 | end function sha256 47 | 48 | !> Quick and dirty SHA-256 interface function (no bit-swapping). 49 | !! @param str : (in) The message to digest. 50 | !! @return : The SHA-256 digest as a string of length 64. 51 | function dirty_sha256(str) 52 | implicit none 53 | ! ----------------------------------- 54 | ! Define the interface. 55 | character(len=64) :: dirty_sha256 56 | character(len=*), intent(in) :: str 57 | ! ----------------------------------- 58 | ! Call the work horse - no bit swapping. 59 | dirty_sha256 = sha256b(str, 0) 60 | end function dirty_sha256 61 | 62 | !> Calculate the SHA-256 hash of the incomming string. 63 | !! @param str : (in) The message to take digest. 64 | !! @param swap : (in) Flag to indicate if swapping to big-endian 65 | !! input (swap=1) should be used. swap=1 is needed 66 | !! for the routine to pass the standard tests, but 67 | !! decreases speed with a factor 2. 68 | !! @return : The SHA-256 digest as a string of length 64. 69 | function sha256b(str, swap) 70 | implicit none 71 | ! ----------------------------------- 72 | ! Define the interface. 73 | character(len=64) :: sha256b 74 | character(len=*), intent(in) :: str 75 | integer, intent(in) :: swap 76 | ! ----------------------------------- 77 | 78 | ! Helper variables. 79 | integer(kind=c_int64_t) :: length 80 | integer(kind=c_int32_t) :: temp1 81 | integer(kind=c_int32_t) :: temp2 82 | integer(kind=c_int32_t) :: i 83 | integer :: break 84 | integer :: pos0 85 | 86 | ! Parameters for the cruncher. 87 | integer(kind=c_int32_t) :: h0_ref(8) 88 | integer(kind=c_int32_t) :: k0_ref(64) 89 | 90 | ! Work areas. 91 | integer(kind=c_int32_t) :: h0(8) 92 | integer(kind=c_int32_t) :: k0(64) 93 | integer(kind=c_int32_t) :: a0(8) 94 | integer(kind=c_int32_t) :: w0(64) 95 | 96 | ! Set the initial data. 97 | data (h0_ref(i),i=1,8)/& 98 | & z'6a09e667', z'bb67ae85', z'3c6ef372', z'a54ff53a', z'510e527f', z'9b05688c', z'1f83d9ab', z'5be0cd19'/ 99 | 100 | data (k0_ref(i), i=1,64)/& 101 | & z'428a2f98', z'71374491', z'b5c0fbcf', z'e9b5dba5', z'3956c25b', z'59f111f1', z'923f82a4', z'ab1c5ed5',& 102 | & z'd807aa98', z'12835b01', z'243185be', z'550c7dc3', z'72be5d74', z'80deb1fe', z'9bdc06a7', z'c19bf174',& 103 | & z'e49b69c1', z'efbe4786', z'0fc19dc6', z'240ca1cc', z'2de92c6f', z'4a7484aa', z'5cb0a9dc', z'76f988da',& 104 | & z'983e5152', z'a831c66d', z'b00327c8', z'bf597fc7', z'c6e00bf3', z'd5a79147', z'06ca6351', z'14292967',& 105 | & z'27b70a85', z'2e1b2138', z'4d2c6dfc', z'53380d13', z'650a7354', z'766a0abb', z'81c2c92e', z'92722c85',& 106 | & z'a2bfe8a1', z'a81a664b', z'c24b8b70', z'c76c51a3', z'd192e819', z'd6990624', z'f40e3585', z'106aa070',& 107 | & z'19a4c116', z'1e376c08', z'2748774c', z'34b0bcb5', z'391c0cb3', z'4ed8aa4a', z'5b9cca4f', z'682e6ff3',& 108 | & z'748f82ee', z'78a5636f', z'84c87814', z'8cc70208', z'90befffa', z'a4506ceb', z'bef9a3f7', z'c67178f2'/ 109 | 110 | h0 = h0_ref 111 | k0 = k0_ref 112 | ! ----------------------------------- 113 | ! Function body implementation. 114 | 115 | break = 0 116 | pos0 = 1 117 | length = len(trim(str)) 118 | 119 | do while (break .ne. 1) 120 | 121 | ! Get the next 16 32bit words to consume. 122 | call consume_chunk(str, length, w0(1:16), pos0, break, swap) 123 | 124 | ! Extend the first 16 words to fill the work schedule array. 125 | do i=17,64 126 | w0(i) = ms1(w0(i-2)) + w0(i-16) + ms0(w0(i-15)) + w0(i-7) 127 | end do 128 | 129 | ! Initialize the workin variables with the current version of the hash. 130 | a0 = h0 131 | 132 | ! Run the compression loop. 133 | do i=1,64 134 | 135 | temp1 = a0(8) + cs1(a0(5)) + ch(a0(5),a0(6),a0(7)) + k0(i) + w0(i) 136 | temp2 = cs0(a0(1)) + maj(a0(1),a0(2),a0(3)) 137 | 138 | a0(8) = a0(7) 139 | a0(7) = a0(6) 140 | a0(6) = a0(5) 141 | a0(5) = a0(4) + temp1 142 | a0(4) = a0(3) 143 | a0(3) = a0(2) 144 | a0(2) = a0(1) 145 | a0(1) = temp1 + temp2 146 | 147 | end do 148 | 149 | ! Update the state. 150 | h0 = h0 + a0 151 | 152 | end do 153 | 154 | ! Write the result to the output variable. 155 | write(sha256b,'(8z8.8)') h0(1), h0(2), h0(3), h0(4), h0(5), h0(6), h0(7), h0(8) 156 | 157 | end function sha256b 158 | 159 | !> Swap the byte order on a 32bit integer. 160 | !! @param inp : (in) The integer to byte swap. 161 | !! @return : The byte swapped integer. 162 | function swap32(inp) 163 | implicit none 164 | ! ----------------------------------- 165 | ! Define the interface. 166 | integer(kind=c_int32_t) :: swap32 167 | integer(kind=c_int32_t), intent(in) :: inp 168 | ! ----------------------------------- 169 | call mvbits(inp, 24, 8, swap32, 0) 170 | call mvbits(inp, 16, 8, swap32, 8) 171 | call mvbits(inp, 8, 8, swap32, 16) 172 | call mvbits(inp, 0, 8, swap32, 24) 173 | end function swap32 174 | 175 | !> Swap the byte order on a 64 bit integer. 176 | !! @param inp : (in) The integer to byte swap. 177 | !! @return : The byte swapped integer. 178 | function swap64(inp) 179 | implicit none 180 | ! ----------------------------------- 181 | ! Define the interface. 182 | integer(kind=c_int64_t) :: swap64 183 | integer(kind=c_int64_t), intent(in) :: inp 184 | ! ----------------------------------- 185 | call mvbits(inp, 56, 8, swap64, 0) 186 | call mvbits(inp, 48, 8, swap64, 8) 187 | call mvbits(inp, 40, 8, swap64, 16) 188 | call mvbits(inp, 32, 8, swap64, 24) 189 | call mvbits(inp, 24, 8, swap64, 32) 190 | call mvbits(inp, 16, 8, swap64, 40) 191 | call mvbits(inp, 8, 8, swap64, 48) 192 | call mvbits(inp, 0, 8, swap64, 56) 193 | end function swap64 194 | 195 | !> Swap the byte order on a 64bit integer as if 196 | !! each half was a 32bit integer to swap. 197 | !! @param inp : (in) The integer to byte swap. 198 | !! @return : The byte swapped integer. 199 | function swap64a(inp) 200 | implicit none 201 | ! ----------------------------------- 202 | ! Define the interface. 203 | integer(kind=c_int64_t) :: swap64a 204 | integer(kind=c_int64_t), intent(in) :: inp 205 | ! ----------------------------------- 206 | call mvbits(inp, 0, 8, swap64a, 32) 207 | call mvbits(inp, 8, 8, swap64a, 40) 208 | call mvbits(inp, 16, 8, swap64a, 48) 209 | call mvbits(inp, 24, 8, swap64a, 56) 210 | call mvbits(inp, 32, 8, swap64a, 0) 211 | call mvbits(inp, 40, 8, swap64a, 8) 212 | call mvbits(inp, 48, 8, swap64a, 16) 213 | call mvbits(inp, 56, 8, swap64a, 24) 214 | end function swap64a 215 | 216 | !> The 'ch' function in SHA-2. 217 | !! @param a : (in) The a input integer. 218 | !! @param b : (in) The b input integer. 219 | !! @param c : (in) The c input integer. 220 | !! @return : ch(a,b,c), see the code. 221 | function ch(a, b, c) 222 | ! ----------------------------------- 223 | ! Define the interface. 224 | integer(kind=c_int32_t) :: ch 225 | integer(kind=c_int32_t), intent(in) :: a 226 | integer(kind=c_int32_t), intent(in) :: b 227 | integer(kind=c_int32_t), intent(in) :: c 228 | ! ----------------------------------- 229 | ch = ieor(iand(a, b), (iand(not(a), c))) 230 | end function ch 231 | 232 | !> The 'maj' function in SHA-2. 233 | !! @param a : (in) The a input integer. 234 | !! @param b : (in) The b input integer. 235 | !! @param c : (in) The c input integer. 236 | !! @return : maj(a,b,c), see the code. 237 | function maj(a, b, c) 238 | ! ----------------------------------- 239 | ! Define the interface. 240 | integer(kind=c_int32_t) :: maj 241 | integer(kind=c_int32_t), intent(in) :: a 242 | integer(kind=c_int32_t), intent(in) :: b 243 | integer(kind=c_int32_t), intent(in) :: c 244 | ! ----------------------------------- 245 | maj = ieor(iand(a, b), ieor(iand(a, c), iand(b, c))) 246 | end function maj 247 | 248 | !> The '\Sigma_0' function in SHA-2. 249 | !! @param a : (in) The a input integer. 250 | !! @return : cs0(a), see the code. 251 | function cs0(a) 252 | implicit none 253 | ! ----------------------------------- 254 | ! Define the interface. 255 | integer(kind=c_int32_t) :: cs0 256 | integer(kind=c_int32_t), intent(in) :: a 257 | ! ----------------------------------- 258 | cs0 = ieor(ishftc(a, -2), ieor(ishftc(a, -13), ishftc(a, -22))) 259 | end function cs0 260 | 261 | !> The '\Sigma_1' function in SHA-2. 262 | !! @param a : (in) The a input integer. 263 | !! @return : cs1(a), see the code. 264 | function cs1(a) 265 | implicit none 266 | ! ----------------------------------- 267 | ! Define the interface. 268 | integer(kind=c_int32_t) :: cs1 269 | integer(kind=c_int32_t), intent(in) :: a 270 | ! ----------------------------------- 271 | cs1 = ieor(ishftc(a, -6), ieor(ishftc(a, -11), ishftc(a, -25))) 272 | end function cs1 273 | 274 | !> The '\sigma_0' function in SHA-2. 275 | !! @param a : (in) The a input integer. 276 | !! @return : ms0(a), see the code. 277 | function ms0(a) 278 | implicit none 279 | ! ----------------------------------- 280 | ! Define the interface. 281 | integer(kind=c_int32_t) :: ms0 282 | integer(kind=c_int32_t), intent(in) :: a 283 | ! ----------------------------------- 284 | ms0 = ieor(ishftc(a, -7), ieor(ishftc(a, -18), ishft(a, -3))) 285 | end function ms0 286 | 287 | !> The '\sigma_1' function in SHA-2. 288 | !! @param a : (in) The a input integer. 289 | !! @return : ms1(a), see the code. 290 | function ms1(a) 291 | implicit none 292 | ! ----------------------------------- 293 | ! Define the interface. 294 | integer(kind=c_int32_t) :: ms1 295 | integer(kind=c_int32_t), intent(in) :: a 296 | ! ----------------------------------- 297 | ms1 = ieor(ishftc(a, -17), ieor(ishftc(a, -19), ishft(a, -10))) 298 | end function ms1 299 | 300 | !> Copy 16 32bit words of data from str(pos0) to inp(1:16). The 301 | !! data is padded a requiered by the SHA-256 algorithm. 302 | !! @param str : (in) The message to take a chunk from. 303 | !! @param length : (in) The length of the message in 8bit words. 304 | !! @param inp : (inout) The work area to copy the data to. 305 | !! @param pos0 : (inout) Variable to store the start of the next chunk. 306 | !! @param break : (inout) Indicates the position in the work flow. 307 | !! break=0 on entry -> continue to consume a chunk, pad if needed. 308 | !! break=2 on entry -> continue to consume, padding was allready done. 309 | !! break=1 one exit -> the last chunk was consumed. 310 | !! @param swap : (in) Flag to indicate if swapping to big-endian 311 | !! input (swap=1) should be used. swap=1 is needed 312 | !! for the routine to pass the standard tests, but 313 | !! decreases speed with a factor 2. 314 | subroutine consume_chunk(str, length, inp, pos0, break, swap) 315 | implicit none 316 | ! ----------------------------------- 317 | ! Define the interface. 318 | character(len=*), intent(in) :: str 319 | integer(kind=c_int64_t), intent(in) :: length 320 | integer(kind=c_int32_t), intent(inout) :: inp(*) 321 | integer, intent(inout) :: pos0 322 | integer, intent(inout) :: break 323 | integer, intent(in) :: swap 324 | ! ----------------------------------- 325 | ! Internal variables. 326 | character(len=4) :: last_word 327 | integer(kind=c_int64_t) :: rest 328 | integer(kind=c_int32_t) :: to_pad 329 | integer(kind=c_int32_t) :: leftover 330 | integer(kind=c_int32_t) :: space_left 331 | integer(kind=c_int32_t) :: zero 332 | integer(kind=c_int8_t) :: ipad0 333 | integer(kind=c_int8_t) :: ipad1 334 | integer(kind=c_int8_t) :: i 335 | data zero / b'00000000000000000000000000000000'/ 336 | data ipad0 / b'00000000' / 337 | data ipad1 / b'10000000' / 338 | 339 | ! Calculate the rest. 340 | rest = length - pos0 + 1 341 | 342 | ! If we are far from the end. 343 | if (rest .ge. 64) then 344 | 345 | ! Copy the data over. 346 | inp(1:16) = transfer(str(pos0:pos0+64-1), inp(1:16)) 347 | 348 | ! Big-endian. 349 | if (swap .eq. 1) then 350 | do i=1,16 351 | inp(i) = swap32(inp(i)) 352 | end do 353 | end if 354 | 355 | ! Increment the starting position for the next roundx. 356 | pos0 = pos0 + 64 357 | 358 | else 359 | ! Space left in the input chunk. 360 | space_left = 16 361 | 362 | ! number of leftover full 32bit words. 363 | leftover = rest/4 364 | 365 | ! Copy any leftovers. 366 | if (leftover .gt. 0) then 367 | inp(1:leftover) = transfer(str(pos0:pos0+leftover*4-1), inp(1:16)) 368 | 369 | ! Big-endian. 370 | if (swap .eq. 1) then 371 | do i=1,leftover 372 | inp(i) = swap32(inp(i)) 373 | end do 374 | end if 375 | 376 | ! Increment the starting position. 377 | pos0 = pos0 + leftover*4 378 | rest = length - pos0 + 1 379 | space_left = space_left - leftover 380 | 381 | end if 382 | 383 | if (space_left .gt. 0) then 384 | 385 | if (break .ne. 2) then 386 | ! Add any remaining incomplete 32bit word. 387 | if (rest .gt. 0) then 388 | last_word(1:rest) = str(pos0:pos0+rest-1) 389 | ! Increment the pos0. 390 | pos0 = pos0 + rest 391 | end if 392 | 393 | ! Add the '10000000' padding. 394 | last_word(rest+1:rest+1) = transfer(ipad1, last_word(1:1)) 395 | 396 | ! Add zeros for a full 32bit word. 397 | to_pad = 4 - rest - 1 398 | do i=1,to_pad 399 | last_word(rest+1+i:rest+1+i) = transfer(ipad0, last_word(1:1)) 400 | end do 401 | 402 | ! Copy the last full (padded) word over. 403 | inp(17-space_left) = transfer(last_word(1:4), inp(1)) 404 | 405 | if (swap .eq. 1) then 406 | inp(17-space_left) = swap32(inp(17-space_left)) 407 | end if 408 | 409 | ! Decrement the space left. 410 | space_left = space_left - 1 411 | 412 | ! Set the flag to indicate that we have padded. 413 | break = 2 414 | 415 | end if 416 | 417 | ! If not enough space to finnish, add zeros. 418 | if (space_left .eq. 1) then 419 | inp(16) = zero 420 | space_left = 0 421 | end if 422 | 423 | rest = 0 424 | 425 | end if 426 | 427 | ! Continue with the last part if there is enough space left. 428 | if ((rest .eq. 0) .and. (space_left .ge. 2)) then 429 | 430 | ! Add zeros until 64 bits left. 431 | do while (space_left .gt. 2) 432 | inp(17-space_left) = zero 433 | space_left = space_left - 1 434 | end do 435 | 436 | ! Add the two last 32bit words. 437 | inp(15:16) = transfer(swap64a(length*8), inp(15:16)) 438 | 439 | ! Set break flag indicating we are done with the whole message. 440 | break = 1 441 | 442 | end if 443 | 444 | end if 445 | 446 | end subroutine consume_chunk 447 | 448 | end module bitsy 449 | 450 | --------------------------------------------------------------------------------