diff --git a/basis/checksums/common/common.factor b/basis/checksums/common/common.factor index 0ae4328446..01cc2cb739 100644 --- a/basis/checksums/common/common.factor +++ b/basis/checksums/common/common.factor @@ -9,6 +9,9 @@ SYMBOL: bytes-read : calculate-pad-length ( length -- length' ) [ 56 < 55 119 ? ] keep - ; +: calculate-pad-length-long ( length -- length' ) + [ 112 < 111 249 ? ] keep - ; + : pad-last-block ( str big-endian? length -- str ) [ [ % ] 2dip HEX: 80 , diff --git a/basis/checksums/sha2/sha2-tests.factor b/basis/checksums/sha2/sha2-tests.factor index 1476f04e75..f224d497a6 100644 --- a/basis/checksums/sha2/sha2-tests.factor +++ b/basis/checksums/sha2/sha2-tests.factor @@ -34,3 +34,9 @@ IN: checksums.sha2.tests "12345678901234567890123456789012345678901234567890123456789012345678901234567890" sha-256 test-checksum ] unit-test + + + + +[ "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909" ] +[ "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" sha-512 test-checksum ] unit-test diff --git a/basis/checksums/sha2/sha2.factor b/basis/checksums/sha2/sha2.factor index 6a695b0965..1abed088a3 100644 --- a/basis/checksums/sha2/sha2.factor +++ b/basis/checksums/sha2/sha2.factor @@ -6,9 +6,31 @@ sbufs strings combinators.smart math.ranges fry combinators accessors locals ; IN: checksums.sha2 - first3 ; inline -: pad-initial-bytes ( string -- padded-string ) +GENERIC: pad-initial-bytes ( string sha2 -- padded-string ) + +M: sha2-short pad-initial-bytes ( string sha2 -- padded-string ) + drop dup [ HEX: 80 , length - [ HEX: 3f bitand calculate-pad-length 0 % ] + [ 64 mod calculate-pad-length 0 % ] [ 3 shift 8 >be % ] bi ] "" make append ; +M: sha2-long pad-initial-bytes ( string sha2 -- padded-string ) + drop dup [ + HEX: 80 , + length + [ 128 mod calculate-pad-length-long 0 % ] + [ 3 shift 16 >be % ] bi + ] "" make append ; + : seq>byte-array ( seq n -- string ) '[ _ >be ] map B{ } join ; @@ -179,7 +216,7 @@ ALIAS: K-512 K-384 : prepare-message-schedule ( seq sha2 -- w-seq ) [ word-size>> [ be> ] map ] [ - block-size>> 0 pad-tail 16 64 [a,b) over + block-size>> [ 0 pad-tail 16 ] keep [a,b) over '[ _ process-M-256 ] each ] bi ; inline @@ -199,25 +236,9 @@ ALIAS: K-512 K-384 ] each ; : byte-array>sha2 ( bytes state -- ) - [ [ pad-initial-bytes ] [ block-size>> ] bi* ] + [ [ pad-initial-bytes ] [ nip block-size>> ] 2bi ] [ sha2-steps ] bi ; -PRIVATE> - -SINGLETON: sha-224 -SINGLETON: sha-256 -SINGLETON: sha-384 -SINGLETON: sha-512 - -INSTANCE: sha-224 checksum -INSTANCE: sha-256 checksum -INSTANCE: sha-384 checksum -INSTANCE: sha-512 checksum - -TUPLE: sha2-state K H word-size block-size ; - -TUPLE: sha-224-state < sha2-state ; - : ( -- sha2-state ) sha-224-state new K-256 >>K @@ -225,8 +246,6 @@ TUPLE: sha-224-state < sha2-state ; 4 >>word-size 64 >>block-size ; -TUPLE: sha-256-state < sha2-state ; - : ( -- sha2-state ) sha-256-state new K-256 >>K @@ -234,6 +253,22 @@ TUPLE: sha-256-state < sha2-state ; 4 >>word-size 64 >>block-size ; +: ( -- sha2-state ) + sha-384-state new + K-384 >>K + initial-H-384 >>H + 8 >>word-size + 80 >>block-size ; + +: ( -- sha2-state ) + sha-512-state new + K-512 >>K + initial-H-512 >>H + 8 >>word-size + 80 >>block-size ; + +PRIVATE> + M: sha-224 checksum-bytes drop [ byte-array>sha2 ] @@ -243,3 +278,13 @@ M: sha-256 checksum-bytes drop [ byte-array>sha2 ] [ H>> 4 seq>byte-array ] bi ; + +M: sha-384 checksum-bytes + drop + [ byte-array>sha2 ] + [ H>> 6 head 8 seq>byte-array ] bi ; + +M: sha-512 checksum-bytes + drop + [ byte-array>sha2 ] + [ H>> 8 seq>byte-array ] bi ;