diff --git a/basis/checksums/adler-32/adler-32.factor b/basis/checksums/adler-32/adler-32.factor index d5e153ba99..f66860dc63 100644 --- a/basis/checksums/adler-32/adler-32.factor +++ b/basis/checksums/adler-32/adler-32.factor @@ -10,6 +10,6 @@ CONSTANT: adler-32-modulus 65521 M: adler-32 checksum-bytes ( bytes checksum -- value ) drop - [ sum 1+ ] + [ sum 1 + ] [ [ dup length [1,b] v. ] [ length ] bi + ] bi [ adler-32-modulus mod ] bi@ 16 shift bitor ; diff --git a/basis/checksums/sha1/authors.txt b/basis/checksums/hmac/authors.txt similarity index 100% rename from basis/checksums/sha1/authors.txt rename to basis/checksums/hmac/authors.txt diff --git a/basis/checksums/hmac/hmac-tests.factor b/basis/checksums/hmac/hmac-tests.factor new file mode 100755 index 0000000000..ffae146614 --- /dev/null +++ b/basis/checksums/hmac/hmac-tests.factor @@ -0,0 +1,48 @@ +USING: kernel io strings byte-arrays sequences namespaces math +parser checksums.hmac tools.test checksums.md5 checksums.sha +checksums ; +IN: checksums.hmac.tests + +[ + "\u000092\u000094rz68\u0000bb\u00001c\u000013\u0000f4\u00008e\u0000f8\u000015\u00008b\u0000fc\u00009d" +] [ + 16 11 "Hi There" md5 hmac-bytes >string ] unit-test + +[ "u\u00000cx>j\u0000b0\u0000b5\u000003\u0000ea\u0000a8n1\n]\u0000b78" ] +[ "Jefe" "what do ya want for nothing?" md5 hmac-bytes >string ] unit-test + +[ + "V\u0000be4R\u00001d\u000014L\u000088\u0000db\u0000b8\u0000c73\u0000f0\u0000e8\u0000b3\u0000f6" +] +[ + 16 HEX: aa + 50 HEX: dd md5 hmac-bytes >string +] unit-test + +[ + "g[\u00000b:\eM\u0000dfN\u000012Hr\u0000dal/c+\u0000fe\u0000d9W\u0000e9" +] [ + 16 11 "Hi There" sha1 hmac-bytes >string +] unit-test + +[ + "\u0000ef\u0000fc\u0000dfj\u0000e5\u0000eb/\u0000a2\u0000d2t\u000016\u0000d5\u0000f1\u000084\u0000df\u00009c%\u00009a|y" +] [ + "Jefe" "what do ya want for nothing?" sha1 hmac-bytes >string +] unit-test + +[ + "\u0000d70YM\u000016~5\u0000d5\u000095o\u0000d8\0=\r\u0000b3\u0000d3\u0000f4m\u0000c7\u0000bb" +] [ + 16 HEX: aa + 50 HEX: dd sha1 hmac-bytes >string +] unit-test + +[ "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7" ] +[ 20 HEX: b "Hi There" sha-256 hmac-bytes hex-string ] unit-test + +[ "167f928588c5cc2eef8e3093caa0e87c9ff566a14794aa61648d81621a2a40c6" ] +[ + "JefeJefeJefeJefeJefeJefeJefeJefe" + "what do ya want for nothing?" sha-256 hmac-bytes hex-string +] unit-test diff --git a/basis/checksums/hmac/hmac.factor b/basis/checksums/hmac/hmac.factor new file mode 100755 index 0000000000..b163766016 --- /dev/null +++ b/basis/checksums/hmac/hmac.factor @@ -0,0 +1,39 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays checksums combinators fry io io.binary +io.encodings.binary io.files io.streams.byte-array kernel +locals math math.vectors memoize sequences ; +IN: checksums.hmac + +> HEX: 5c ; + +: ipad ( checksum-state -- seq ) block-size>> HEX: 36 ; + +:: init-K ( K checksum checksum-state -- o i ) + checksum-state block-size>> K length < + [ K checksum checksum-bytes ] [ K ] if + checksum-state block-size>> 0 pad-tail + [ checksum-state opad seq-bitxor ] + [ checksum-state ipad seq-bitxor ] bi ; + +PRIVATE> + +:: hmac-stream ( K stream checksum -- value ) + K checksum dup initialize-checksum-state + dup :> checksum-state + init-K :> Ki :> Ko + checksum-state Ki add-checksum-bytes + stream add-checksum-stream get-checksum + checksum initialize-checksum-state + Ko add-checksum-bytes swap add-checksum-bytes + get-checksum ; + +: hmac-file ( K path checksum -- value ) + [ binary ] dip hmac-stream ; + +: hmac-bytes ( K seq checksum -- value ) + [ binary ] dip hmac-stream ; diff --git a/basis/checksums/interleave/authors.txt b/basis/checksums/interleave/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /dev/null +++ b/basis/checksums/interleave/authors.txt @@ -0,0 +1 @@ +Doug Coleman \ No newline at end of file diff --git a/basis/checksums/interleave/interleave-tests.factor b/basis/checksums/interleave/interleave-tests.factor new file mode 100644 index 0000000000..9a66e5e316 --- /dev/null +++ b/basis/checksums/interleave/interleave-tests.factor @@ -0,0 +1,19 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test checksums.interleave checksums.sha ; +IN: checksums.interleave.tests + +[ + B{ + 59 155 253 205 75 163 94 115 208 42 227 92 181 19 60 232 + 119 65 178 131 210 48 241 230 204 216 30 156 4 215 80 84 93 + 206 44 1 18 128 150 153 + } +] [ + B{ + 102 83 241 12 26 250 181 76 97 200 37 117 168 74 254 48 216 + 170 26 58 150 150 179 24 153 146 191 225 203 127 166 167 + } + sha1 interleaved-checksum +] unit-test + diff --git a/basis/checksums/interleave/interleave.factor b/basis/checksums/interleave/interleave.factor new file mode 100644 index 0000000000..caef033ec6 --- /dev/null +++ b/basis/checksums/interleave/interleave.factor @@ -0,0 +1,17 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: assocs checksums grouping kernel locals math sequences ; +IN: checksums.interleave + +: seq>2seq ( seq -- seq1 seq2 ) + #! { abcdefgh } -> { aceg } { bdfh } + 2 group flip [ { } { } ] [ first2 ] if-empty ; + +: 2seq>seq ( seq1 seq2 -- seq ) + #! { aceg } { bdfh } -> { abcdefgh } + [ zip concat ] keep like ; + +:: interleaved-checksum ( bytes checksum -- seq ) + bytes [ zero? ] trim-head + dup length odd? [ rest-slice ] when + seq>2seq [ checksum checksum-bytes ] bi@ 2seq>seq ; diff --git a/basis/checksums/md5/md5-tests.factor b/basis/checksums/md5/md5-tests.factor index 8e314f7c28..b7f388c002 100644 --- a/basis/checksums/md5/md5-tests.factor +++ b/basis/checksums/md5/md5-tests.factor @@ -1,4 +1,6 @@ -USING: kernel math namespaces checksums checksums.md5 tools.test byte-arrays ; +USING: byte-arrays checksums checksums.md5 io.encodings.binary +io.streams.byte-array kernel math namespaces tools.test ; + [ "d41d8cd98f00b204e9800998ecf8427e" ] [ "" >byte-array md5 checksum-bytes hex-string ] unit-test [ "0cc175b9c0f1b6a831c399e269772661" ] [ "a" >byte-array md5 checksum-bytes hex-string ] unit-test @@ -8,3 +10,24 @@ USING: kernel math namespaces checksums checksums.md5 tools.test byte-arrays ; [ "d174ab98d277d9f5a5611c2c9f419d9f" ] [ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" >byte-array md5 checksum-bytes hex-string ] unit-test [ "57edf4a22be3c955ac49da2e2107b67a" ] [ "12345678901234567890123456789012345678901234567890123456789012345678901234567890" >byte-array md5 checksum-bytes hex-string ] unit-test + +[ + t +] [ + "asdf" add-checksum-bytes + [ get-checksum ] [ get-checksum ] bi = +] unit-test + +[ + t +] [ + "" add-checksum-bytes + [ get-checksum ] [ get-checksum ] bi = +] unit-test + +[ + t +] [ + "asdf" binary add-checksum-stream + [ get-checksum ] [ get-checksum ] bi = +] unit-test diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor index 29620b089d..026df34012 100644 --- a/basis/checksums/md5/md5.factor +++ b/basis/checksums/md5/md5.factor @@ -3,57 +3,50 @@ USING: kernel io io.binary io.files io.streams.byte-array math math.functions math.parser namespaces splitting grouping strings sequences byte-arrays locals sequences.private macros fry -io.encodings.binary math.bitwise checksums -checksums.common checksums.stream combinators ; +io.encodings.binary math.bitwise checksums accessors +checksums.common checksums.stream combinators combinators.smart ; IN: checksums.md5 -! See http://www.faqs.org/rfcs/rfc1321.html +SINGLETON: md5 + +INSTANCE: md5 stream-checksum + +TUPLE: md5-state < checksum-state state old-state ; + +: ( -- md5 ) + md5-state new-checksum-state + 64 >>block-size + { HEX: 67452301 HEX: efcdab89 HEX: 98badcfe HEX: 10325476 } + [ clone >>state ] [ >>old-state ] bi ; + +M: md5 initialize-checksum-state drop ; > ] [ old-state>> v-w+ dup clone ] [ ] tri + [ (>>old-state) ] [ (>>state) ] bi ; inline : T ( N -- Y ) - sin abs 32 2^ * >integer ; foldable + sin abs 32 2^ * >integer ; inline -: initialize-md5 ( -- ) - 0 bytes-read set - HEX: 67452301 dup a set old-a set - HEX: efcdab89 dup b set old-b set - HEX: 98badcfe dup c set old-c set - HEX: 10325476 dup d set old-d set ; - -: update-md ( -- ) - old-a a update-old-new - old-b b update-old-new - old-c c update-old-new - old-d d update-old-new ; - -:: (ABCD) ( x a b c d k s i func -- ) - #! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s) - a [ - b get c get d get func call w+ - k x nth-unsafe w+ - i T w+ - s bitroll-32 - b get w+ - ] change ; inline - -: F ( X Y Z -- FXYZ ) +:: F ( X Y Z -- FXYZ ) #! F(X,Y,Z) = XY v not(X) Z - pick bitnot bitand [ bitand ] [ bitor ] bi* ; + X Y bitand X bitnot Z bitand bitor ; inline -: G ( X Y Z -- GXYZ ) +:: G ( X Y Z -- GXYZ ) #! G(X,Y,Z) = XZ v Y not(Z) - dup bitnot rot bitand [ bitand ] [ bitor ] bi* ; + X Z bitand Y Z bitnot bitand bitor ; inline : H ( X Y Z -- HXYZ ) #! H(X,Y,Z) = X xor Y xor Z - bitxor bitxor ; + bitxor bitxor ; inline -: I ( X Y Z -- IXYZ ) +:: I ( X Y Z -- IXYZ ) #! I(X,Y,Z) = Y xor (X v not(Z)) - rot swap bitnot bitor bitxor ; + Z bitnot X bitor Y bitxor ; inline CONSTANT: S11 7 CONSTANT: S12 12 @@ -72,10 +65,27 @@ CONSTANT: S42 10 CONSTANT: S43 15 CONSTANT: S44 21 -MACRO: with-md5-round ( ops func -- ) - '[ [ _ (ABCD) ] compose ] map '[ _ cleave ] ; +CONSTANT: a 0 +CONSTANT: b 1 +CONSTANT: c 2 +CONSTANT: d 3 -: (process-md5-block-F) ( block -- ) +:: (ABCD) ( x V a b c d k s i quot -- ) + #! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s) + a V [ + b V nth + c V nth + d V nth quot call w+ + k x nth w+ + i T w+ + s bitroll-32 + b V nth w+ + ] change-nth ; inline + +MACRO: with-md5-round ( ops quot -- ) + '[ [ _ (ABCD) ] compose ] map '[ _ 2cleave ] ; + +: (process-md5-block-F) ( block v -- ) { [ a b c d 0 S11 1 ] [ d a b c 1 S12 2 ] @@ -93,9 +103,9 @@ MACRO: with-md5-round ( ops func -- ) [ d a b c 13 S12 14 ] [ c d a b 14 S13 15 ] [ b c d a 15 S14 16 ] - } [ F ] with-md5-round ; + } [ F ] with-md5-round ; inline -: (process-md5-block-G) ( block -- ) +: (process-md5-block-G) ( block v -- ) { [ a b c d 1 S21 17 ] [ d a b c 6 S22 18 ] @@ -113,9 +123,9 @@ MACRO: with-md5-round ( ops func -- ) [ d a b c 2 S22 30 ] [ c d a b 7 S23 31 ] [ b c d a 12 S24 32 ] - } [ G ] with-md5-round ; + } [ G ] with-md5-round ; inline -: (process-md5-block-H) ( block -- ) +: (process-md5-block-H) ( block v -- ) { [ a b c d 5 S31 33 ] [ d a b c 8 S32 34 ] @@ -133,9 +143,9 @@ MACRO: with-md5-round ( ops func -- ) [ d a b c 12 S32 46 ] [ c d a b 15 S33 47 ] [ b c d a 2 S34 48 ] - } [ H ] with-md5-round ; + } [ H ] with-md5-round ; inline -: (process-md5-block-I) ( block -- ) +: (process-md5-block-I) ( block v -- ) { [ a b c d 0 S41 49 ] [ d a b c 7 S42 50 ] @@ -153,38 +163,34 @@ MACRO: with-md5-round ( ops func -- ) [ d a b c 11 S42 62 ] [ c d a b 2 S43 63 ] [ b c d a 9 S44 64 ] - } [ I ] with-md5-round ; + } [ I ] with-md5-round ; inline -: (process-md5-block) ( block -- ) - 4 [ le> ] map { - [ (process-md5-block-F) ] - [ (process-md5-block-G) ] - [ (process-md5-block-H) ] - [ (process-md5-block-I) ] - } cleave - - update-md ; - -: process-md5-block ( str -- ) - dup length [ bytes-read [ + ] change ] keep 64 = [ - (process-md5-block) +M: md5-state checksum-block ( block state -- ) + [ + [ 4 [ le> ] map ] [ state>> ] bi* { + [ (process-md5-block-F) ] + [ (process-md5-block-G) ] + [ (process-md5-block-H) ] + [ (process-md5-block-I) ] + } 2cleave ] [ - f bytes-read get pad-last-block - [ (process-md5-block) ] each - ] if ; - -: stream>md5 ( -- ) - 64 read [ process-md5-block ] keep - length 64 = [ stream>md5 ] when ; + nip update-md5 + ] 2bi ; -: get-md5 ( -- str ) - [ a b c d ] [ get 4 >le ] map concat >byte-array ; +: md5>checksum ( md5 -- bytes ) + state>> [ 4 >le ] map B{ } concat-as ; + +M: md5-state clone ( md5 -- new-md5 ) + call-next-method + [ clone ] change-state + [ clone ] change-old-state ; + +M: md5-state get-checksum ( md5 -- bytes ) + clone [ bytes>> f ] [ bytes-read>> pad-last-block ] [ ] tri + [ [ checksum-block ] curry each ] [ md5>checksum ] bi ; + +M: md5 checksum-stream ( stream checksum -- byte-array ) + drop + [ ] dip add-checksum-stream get-checksum ; PRIVATE> - -SINGLETON: md5 - -INSTANCE: md5 stream-checksum - -M: md5 checksum-stream ( stream -- byte-array ) - drop [ initialize-md5 stream>md5 get-md5 ] with-input-stream ; diff --git a/basis/checksums/openssl/openssl-docs.factor b/basis/checksums/openssl/openssl-docs.factor index b0cc8f9e53..27df72c4ea 100644 --- a/basis/checksums/openssl/openssl-docs.factor +++ b/basis/checksums/openssl/openssl-docs.factor @@ -32,6 +32,6 @@ ARTICLE: "checksums.openssl" "OpenSSL checksums" "An example where we compute the SHA1 checksum of a string using the OpenSSL implementation of SHA1:" { $example "USING: byte-arrays checksums checksums.openssl ;" "\"hello world\" >byte-array openssl-sha1 checksum-bytes hex-string ." "\"2aae6c35c94fcfb415dbe95f408b9ce91ee846ed\"" } "If we use the Factor implementation, we get the same result, just slightly slower:" -{ $example "USING: byte-arrays checksums checksums.sha1 ;" "\"hello world\" >byte-array sha1 checksum-bytes hex-string ." "\"2aae6c35c94fcfb415dbe95f408b9ce91ee846ed\"" } ; +{ $example "USING: byte-arrays checksums checksums.sha ;" "\"hello world\" >byte-array sha1 checksum-bytes hex-string ." "\"2aae6c35c94fcfb415dbe95f408b9ce91ee846ed\"" } ; ABOUT: "checksums.openssl" diff --git a/basis/checksums/sha2/authors.txt b/basis/checksums/sha/authors.txt similarity index 100% rename from basis/checksums/sha2/authors.txt rename to basis/checksums/sha/authors.txt diff --git a/basis/checksums/sha/sha-docs.factor b/basis/checksums/sha/sha-docs.factor new file mode 100644 index 0000000000..780c2b39d8 --- /dev/null +++ b/basis/checksums/sha/sha-docs.factor @@ -0,0 +1,18 @@ +USING: help.markup help.syntax ; +IN: checksums.sha + +HELP: sha-224 +{ $class-description "SHA-224 checksum algorithm." } ; + +HELP: sha-256 +{ $class-description "SHA-256 checksum algorithm." } ; + +ARTICLE: "checksums.sha" "SHA-2 checksum" +"The SHA family of checksum algorithms are one-way hashes useful for checksumming data. SHA-1 is considered insecure, while SHA-2 It is generally considered to be pretty strong." $nl +"SHA-2 checksums:" +{ $subsection sha-224 } +{ $subsection sha-256 } +"SHA-1 checksum:" +{ $subsection sha1 } ; + +ABOUT: "checksums.sha" diff --git a/basis/checksums/sha2/sha2-tests.factor b/basis/checksums/sha/sha-tests.factor similarity index 70% rename from basis/checksums/sha2/sha2-tests.factor rename to basis/checksums/sha/sha-tests.factor index c14ea5a98d..b70b5e7ba2 100644 --- a/basis/checksums/sha2/sha2-tests.factor +++ b/basis/checksums/sha/sha-tests.factor @@ -1,10 +1,17 @@ USING: arrays kernel math namespaces sequences tools.test -checksums.sha2 checksums ; -IN: checksums.sha2.tests +checksums.sha checksums ; +IN: checksums.sha.tests : test-checksum ( text identifier -- checksum ) checksum-bytes hex-string ; +[ "a9993e364706816aba3e25717850c26c9cd0d89d" ] [ "abc" sha1 checksum-bytes hex-string ] unit-test +[ "84983e441c3bd26ebaae4aa1f95129e5e54670f1" ] [ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" sha1 checksum-bytes hex-string ] unit-test +! [ "34aa973cd4c4daa4f61eeb2bdbad27316534016f" ] [ 1000000 CHAR: a fill string>sha1str ] unit-test ! takes a long time... +[ "dea356a2cddd90c7a7ecedc5ebb563934f460452" ] [ "0123456701234567012345670123456701234567012345670123456701234567" +10 swap concat sha1 checksum-bytes hex-string ] unit-test + + [ "75388b16512776cc5dba5da1fd890150b0c6455cb4f58b1952522525" ] [ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" @@ -36,7 +43,5 @@ IN: checksums.sha2.tests ] unit-test - - ! [ "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909" ] ! [ "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" sha-512 test-checksum ] unit-test diff --git a/basis/checksums/sha2/sha2.factor b/basis/checksums/sha/sha.factor similarity index 66% rename from basis/checksums/sha2/sha2.factor rename to basis/checksums/sha/sha.factor index 12e32f6c69..287c39b2a1 100644 --- a/basis/checksums/sha2/sha2.factor +++ b/basis/checksums/sha/sha.factor @@ -3,16 +3,40 @@ USING: kernel splitting grouping math sequences namespaces make io.binary math.bitwise checksums checksums.common sbufs strings combinators.smart math.ranges fry combinators -accessors locals ; -IN: checksums.sha2 +accessors locals checksums.stream multiline literals +generalizations ; +IN: checksums.sha + +SINGLETON: sha1 +INSTANCE: sha1 stream-checksum SINGLETON: sha-224 SINGLETON: sha-256 -INSTANCE: sha-224 checksum -INSTANCE: sha-256 checksum +INSTANCE: sha-224 stream-checksum +INSTANCE: sha-256 stream-checksum -TUPLE: sha2-state K H word-size block-size ; +TUPLE: sha1-state < checksum-state K H W word-size ; + +CONSTANT: initial-H-sha1 + { + HEX: 67452301 + HEX: efcdab89 + HEX: 98badcfe + HEX: 10325476 + HEX: c3d2e1f0 + } + +CONSTANT: K-sha1 + $[ + 20 HEX: 5a827999 + 20 HEX: 6ed9eba1 + 20 HEX: 8f1bbcdc + 20 HEX: ca62c1d6 + 4 { } nappend-as + ] + +TUPLE: sha2-state < checksum-state K H word-size ; TUPLE: sha2-short < sha2-state ; @@ -22,6 +46,11 @@ TUPLE: sha-224-state < sha2-short ; TUPLE: sha-256-state < sha2-short ; +M: sha2-state clone + call-next-method + [ clone ] change-H + [ clone ] change-K ; + ( -- sha1-state ) + sha1-state new-checksum-state + 64 >>block-size + K-sha1 >>K + initial-H-sha1 >>H + 4 >>word-size ; + +: ( -- sha2-state ) + sha-224-state new-checksum-state + 64 >>block-size + K-256 >>K + initial-H-224 >>H + 4 >>word-size ; + +: ( -- sha2-state ) + sha-256-state new-checksum-state + 64 >>block-size + K-256 >>K + initial-H-256 >>H + 4 >>word-size ; + +M: sha1 initialize-checksum-state drop ; + +M: sha-224 initialize-checksum-state drop ; + +M: sha-256 initialize-checksum-state drop ; + : s0-256 ( x -- x' ) [ [ -7 bitroll-32 ] @@ -172,7 +228,7 @@ ALIAS: K-512 K-384 [ -41 bitroll-64 ] tri ] [ bitxor ] reduce-outputs ; inline -: process-M-256 ( n seq -- ) +: prepare-M-256 ( n seq -- ) { [ [ 16 - ] dip nth ] [ [ 15 - ] dip nth s0-256 ] @@ -181,7 +237,7 @@ ALIAS: K-512 K-384 [ ] } 2cleave set-nth ; inline -: process-M-512 ( n seq -- ) +: prepare-M-512 ( n seq -- ) { [ [ 16 - ] dip nth ] [ [ 15 - ] dip nth s0-512 ] @@ -201,26 +257,6 @@ ALIAS: K-512 K-384 GENERIC: pad-initial-bytes ( string sha2 -- padded-string ) -M: sha2-short pad-initial-bytes ( string sha2 -- padded-string ) - drop - dup [ - HEX: 80 , - length - [ 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 8 >be % ] bi - ] "" make append ; - -: seq>byte-array ( seq n -- string ) - '[ _ >be ] map B{ } join ; - :: T1-256 ( n M H sha2 -- T1 ) n M nth n sha2 K>> nth + @@ -257,7 +293,7 @@ M: sha2-long pad-initial-bytes ( string sha2 -- padded-string ) [ word-size>> [ be> ] map ] [ block-size>> [ 0 pad-tail 16 ] keep [a,b) over - '[ _ process-M-256 ] each + '[ _ prepare-M-256 ] each ] bi ; inline :: process-chunk ( M block-size cloned-H sha2 -- ) @@ -266,41 +302,110 @@ M: sha2-long pad-initial-bytes ( string sha2 -- padded-string ) cloned-H T2-256 cloned-H update-H ] each - cloned-H sha2 H>> [ w+ ] 2map sha2 (>>H) ; inline + sha2 [ cloned-H [ w+ ] 2map ] change-H drop ; inline -: sha2-steps ( sliced-groups state -- ) - '[ - _ - [ prepare-message-schedule ] - [ [ block-size>> ] [ H>> clone ] [ ] tri process-chunk ] bi - ] each ; +M: sha2-short checksum-block + [ prepare-message-schedule ] + [ [ block-size>> ] [ H>> clone ] [ ] tri process-chunk ] bi ; -: byte-array>sha2 ( bytes state -- ) - [ [ pad-initial-bytes ] [ nip block-size>> ] 2bi ] - [ sha2-steps ] bi ; +: seq>byte-array ( seq n -- string ) + '[ _ >be ] map B{ } join ; -: ( -- sha2-state ) - sha-224-state new - K-256 >>K - initial-H-224 >>H - 4 >>word-size - 64 >>block-size ; +: sha1>checksum ( sha2 -- bytes ) + H>> 4 seq>byte-array ; -: ( -- sha2-state ) - sha-256-state new - K-256 >>K - initial-H-256 >>H - 4 >>word-size - 64 >>block-size ; +: sha-224>checksum ( sha2 -- bytes ) + H>> 7 head 4 seq>byte-array ; + +: sha-256>checksum ( sha2 -- bytes ) + H>> 4 seq>byte-array ; + +: pad-last-short-block ( state -- ) + [ bytes>> t ] [ bytes-read>> pad-last-block ] [ ] tri + [ checksum-block ] curry each ; PRIVATE> -M: sha-224 checksum-bytes - drop - [ byte-array>sha2 ] - [ H>> 7 head 4 seq>byte-array ] bi ; +M: sha-224-state get-checksum + clone + [ pad-last-short-block ] [ sha-224>checksum ] bi ; -M: sha-256 checksum-bytes - drop - [ byte-array>sha2 ] - [ H>> 4 seq>byte-array ] bi ; +M: sha-256-state get-checksum + clone + [ pad-last-short-block ] [ sha-256>checksum ] bi ; + +M: sha-224 checksum-stream ( stream checksum -- byte-array ) + drop + [ ] dip add-checksum-stream get-checksum ; + +M: sha-256 checksum-stream ( stream checksum -- byte-array ) + drop + [ ] dip add-checksum-stream get-checksum ; + + + +: sha1-W ( t seq -- ) + { + [ [ 3 - ] dip nth ] + [ [ 8 - ] dip nth bitxor ] + [ [ 14 - ] dip nth bitxor ] + [ [ 16 - ] dip nth bitxor 1 bitroll-32 ] + [ ] + } 2cleave set-nth ; + +: prepare-sha1-message-schedule ( seq -- w-seq ) + 4 [ be> ] map + 80 0 pad-tail 16 80 [a,b) over + '[ _ sha1-W ] each ; inline + +: sha1-f ( B C D n -- f_nbcd ) + 20 /i + { + { 0 [ [ over bitnot ] dip bitand [ bitand ] dip bitor ] } + { 1 [ bitxor bitxor ] } + { 2 [ 2dup bitand [ pick bitand [ bitand ] dip ] dip bitor bitor ] } + { 3 [ bitxor bitxor ] } + } case ; + +:: inner-loop ( n H W K -- temp ) + a H nth :> A + b H nth :> B + c H nth :> C + d H nth :> D + e H nth :> E + [ + A 5 bitroll-32 + + B C D n sha1-f + + E + + n K nth + + n W nth + ] sum-outputs 32 bits ; + +:: process-sha1-chunk ( bytes H W K state -- ) + 80 [ + H W K inner-loop + d H nth e H set-nth + c H nth d H set-nth + b H nth 30 bitroll-32 c H set-nth + a H nth b H set-nth + a H set-nth + ] each + state [ H [ w+ ] 2map ] change-H drop ; inline + +M:: sha1-state checksum-block ( bytes state -- ) + bytes prepare-sha1-message-schedule state (>>W) + + bytes + state [ H>> clone ] [ W>> ] [ K>> ] tri state process-sha1-chunk ; + +M: sha1-state get-checksum + clone + [ pad-last-short-block ] [ sha-256>checksum ] bi ; + +M: sha1 checksum-stream ( stream checksum -- byte-array ) + drop + [ ] dip add-checksum-stream get-checksum ; diff --git a/basis/checksums/sha/summary.txt b/basis/checksums/sha/summary.txt new file mode 100644 index 0000000000..2dd351af0b --- /dev/null +++ b/basis/checksums/sha/summary.txt @@ -0,0 +1 @@ +SHA checksum algorithms diff --git a/basis/checksums/sha1/sha1-docs.factor b/basis/checksums/sha1/sha1-docs.factor deleted file mode 100644 index 2c9093865f..0000000000 --- a/basis/checksums/sha1/sha1-docs.factor +++ /dev/null @@ -1,11 +0,0 @@ -USING: help.markup help.syntax ; -IN: checksums.sha1 - -HELP: sha1 -{ $class-description "SHA1 checksum algorithm." } ; - -ARTICLE: "checksums.sha1" "SHA1 checksum" -"The SHA1 checksum algorithm implements a one-way hash function. It is generally considered to be stronger than MD5, however there is a known algorithm for finding collisions more effectively than a brute-force search (" { $url "http://www.schneier.com/blog/archives/2005/02/sha1_broken.html" } ")." -{ $subsection sha1 } ; - -ABOUT: "checksums.sha1" diff --git a/basis/checksums/sha1/sha1-tests.factor b/basis/checksums/sha1/sha1-tests.factor deleted file mode 100644 index 808d37d1e4..0000000000 --- a/basis/checksums/sha1/sha1-tests.factor +++ /dev/null @@ -1,14 +0,0 @@ -USING: arrays kernel math namespaces sequences tools.test checksums checksums.sha1 ; - -[ "a9993e364706816aba3e25717850c26c9cd0d89d" ] [ "abc" sha1 checksum-bytes hex-string ] unit-test -[ "84983e441c3bd26ebaae4aa1f95129e5e54670f1" ] [ "abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq" sha1 checksum-bytes hex-string ] unit-test -! [ "34aa973cd4c4daa4f61eeb2bdbad27316534016f" ] [ 1000000 CHAR: a fill string>sha1str ] unit-test ! takes a long time... -[ "dea356a2cddd90c7a7ecedc5ebb563934f460452" ] [ "0123456701234567012345670123456701234567012345670123456701234567" -10 swap concat sha1 checksum-bytes hex-string ] unit-test - -[ - ";\u00009b\u0000fd\u0000cdK\u0000a3^s\u0000d0*\u0000e3\\\u0000b5\u000013<\u0000e8wA\u0000b2\u000083\u0000d20\u0000f1\u0000e6\u0000cc\u0000d8\u00001e\u00009c\u000004\u0000d7PT]\u0000ce,\u000001\u000012\u000080\u000096\u000099" -] [ - "\u000066\u000053\u0000f1\u00000c\u00001a\u0000fa\u0000b5\u00004c\u000061\u0000c8\u000025\u000075\u0000a8\u00004a\u0000fe\u000030\u0000d8\u0000aa\u00001a\u00003a\u000096\u000096\u0000b3\u000018\u000099\u000092\u0000bf\u0000e1\u0000cb\u00007f\u0000a6\u0000a7" - sha1-interleave -] unit-test diff --git a/basis/checksums/sha1/sha1.factor b/basis/checksums/sha1/sha1.factor deleted file mode 100644 index 707aa66ba6..0000000000 --- a/basis/checksums/sha1/sha1.factor +++ /dev/null @@ -1,134 +0,0 @@ -! Copyright (C) 2006, 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: arrays combinators kernel io io.encodings.binary io.files -io.streams.byte-array math.vectors strings namespaces -make math parser sequences assocs grouping vectors io.binary -hashtables math.bitwise checksums checksums.common -checksums.stream ; -IN: checksums.sha1 - -! Implemented according to RFC 3174. - -SYMBOLS: h0 h1 h2 h3 h4 A B C D E w K ; - -: get-wth ( n -- wth ) w get nth ; inline -: shift-wth ( n -- x ) get-wth 1 bitroll-32 ; inline - -: initialize-sha1 ( -- ) - 0 bytes-read set - HEX: 67452301 dup h0 set A set - HEX: efcdab89 dup h1 set B set - HEX: 98badcfe dup h2 set C set - HEX: 10325476 dup h3 set D set - HEX: c3d2e1f0 dup h4 set E set - [ - 20 HEX: 5a827999 % - 20 HEX: 6ed9eba1 % - 20 HEX: 8f1bbcdc % - 20 HEX: ca62c1d6 % - ] { } make K set ; - -! W(t) = S^1(W(t-3) XOR W(t-8) XOR W(t-14) XOR W(t-16)) -: sha1-W ( t -- W_t ) - dup 3 - get-wth - over 8 - get-wth bitxor - over 14 - get-wth bitxor - swap 16 - get-wth bitxor 1 bitroll-32 ; - -! f(t;B,C,D) = (B AND C) OR ((NOT B) AND D) ( 0 <= t <= 19) -! f(t;B,C,D) = B XOR C XOR D (20 <= t <= 39) -! f(t;B,C,D) = (B AND C) OR (B AND D) OR (C AND D) (40 <= t <= 59) -! f(t;B,C,D) = B XOR C XOR D (60 <= t <= 79) -: sha1-f ( B C D t -- f_tbcd ) - 20 /i - { - { 0 [ [ over bitnot ] dip bitand [ bitand ] dip bitor ] } - { 1 [ bitxor bitxor ] } - { 2 [ 2dup bitand [ pick bitand [ bitand ] dip ] dip bitor bitor ] } - { 3 [ bitxor bitxor ] } - } case ; - -: nth-int-be ( string n -- int ) - 4 * dup 4 + rot be> ; inline - -: make-w ( str -- ) - #! compute w, steps a-b of RFC 3174, section 6.1 - 16 [ nth-int-be w get push ] with each - 16 80 dup [ sha1-W w get push ] each ; - -: init-letters ( -- ) - ! step c of RFC 3174, section 6.1 - h0 get A set - h1 get B set - h2 get C set - h3 get D set - h4 get E set ; - -: inner-loop ( n -- temp ) - ! TEMP = S^5(A) + f(t;B,C,D) + E + W(t) + K(t); - [ - [ B get C get D get ] keep sha1-f , - dup get-wth , - K get nth , - A get 5 bitroll-32 , - E get , - ] { } make sum 32 bits ; inline - -: set-vars ( temp -- ) - ! E = D; D = C; C = S^30(B); B = A; A = TEMP; - D get E set - C get D set - B get 30 bitroll-32 C set - A get B set - A set ; - -: calculate-letters ( -- ) - ! step d of RFC 3174, section 6.1 - 80 [ inner-loop set-vars ] each ; - -: update-hs ( -- ) - ! step e of RFC 3174, section 6.1 - A h0 update-old-new - B h1 update-old-new - C h2 update-old-new - D h3 update-old-new - E h4 update-old-new ; - -: (process-sha1-block) ( str -- ) - 80 w set make-w init-letters calculate-letters update-hs ; - -: process-sha1-block ( str -- ) - dup length [ bytes-read [ + ] change ] keep 64 = [ - (process-sha1-block) - ] [ - t bytes-read get pad-last-block - [ (process-sha1-block) ] each - ] if ; - -: stream>sha1 ( -- ) - 64 read [ process-sha1-block ] keep - length 64 = [ stream>sha1 ] when ; - -: get-sha1 ( -- str ) - [ [ h0 h1 h2 h3 h4 ] [ get 4 >be % ] each ] "" make ; - -SINGLETON: sha1 - -INSTANCE: sha1 stream-checksum - -M: sha1 checksum-stream ( stream -- sha1 ) - drop [ initialize-sha1 stream>sha1 get-sha1 ] with-input-stream ; - -: seq>2seq ( seq -- seq1 seq2 ) - #! { abcdefgh } -> { aceg } { bdfh } - 2 group flip [ { } { } ] [ first2 ] if-empty ; - -: 2seq>seq ( seq1 seq2 -- seq ) - #! { aceg } { bdfh } -> { abcdefgh } - [ zip concat ] keep like ; - -: sha1-interleave ( string -- seq ) - [ zero? ] trim-head - dup length odd? [ rest ] when - seq>2seq [ sha1 checksum-bytes ] bi@ - 2seq>seq ; diff --git a/basis/checksums/sha1/summary.txt b/basis/checksums/sha1/summary.txt deleted file mode 100644 index d8da1df0aa..0000000000 --- a/basis/checksums/sha1/summary.txt +++ /dev/null @@ -1 +0,0 @@ -SHA1 checksum algorithm diff --git a/basis/checksums/sha2/sha2-docs.factor b/basis/checksums/sha2/sha2-docs.factor deleted file mode 100644 index 6a128552fd..0000000000 --- a/basis/checksums/sha2/sha2-docs.factor +++ /dev/null @@ -1,11 +0,0 @@ -USING: help.markup help.syntax ; -IN: checksums.sha2 - -HELP: sha-256 -{ $class-description "SHA-256 checksum algorithm." } ; - -ARTICLE: "checksums.sha2" "SHA2 checksum" -"The SHA2 checksum algorithm implements a one-way hash function. It is generally considered to be pretty strong." -{ $subsection sha-256 } ; - -ABOUT: "checksums.sha2" diff --git a/basis/checksums/sha2/summary.txt b/basis/checksums/sha2/summary.txt deleted file mode 100644 index 04365d439f..0000000000 --- a/basis/checksums/sha2/summary.txt +++ /dev/null @@ -1 +0,0 @@ -SHA2 checksum algorithm diff --git a/basis/compression/inflate/inflate.factor b/basis/compression/inflate/inflate.factor index 3fe07b5994..7cb43ac68f 100755 --- a/basis/compression/inflate/inflate.factor +++ b/basis/compression/inflate/inflate.factor @@ -75,18 +75,20 @@ CONSTANT: length-table 19 23 27 31 35 43 51 59 67 83 99 115 - 131 163 195 227 + 131 163 195 227 258 } CONSTANT: dist-table - { 1 2 3 4 - 5 7 9 13 - 17 25 33 49 - 65 97 129 193 - 257 385 513 769 - 1025 1537 2049 3073 - 4097 6145 8193 12289 - 16385 24577 } + { + 1 2 3 4 + 5 7 9 13 + 17 25 33 49 + 65 97 129 193 + 257 385 513 769 + 1025 1537 2049 3073 + 4097 6145 8193 12289 + 16385 24577 + } : nth* ( n seq -- elt ) [ length 1- swap - ] [ nth ] bi ; @@ -156,7 +158,7 @@ CONSTANT: dist-table [ 1 bitstream bs:read 0 = ] [ bitstream - 2 bitstream bs:read ! B + 2 bitstream bs:read { { 0 [ inflate-raw ] } { 1 [ inflate-static ] } @@ -206,6 +208,5 @@ PRIVATE> : zlib-inflate ( bytes -- bytes ) bs: - [ check-zlib-header ] - [ inflate-loop ] bi + [ check-zlib-header ] [ inflate-loop ] bi inflate-lz77 ; diff --git a/basis/furnace/auth/auth-docs.factor b/basis/furnace/auth/auth-docs.factor index 3f1bcb6085..efd6a52ef0 100644 --- a/basis/furnace/auth/auth-docs.factor +++ b/basis/furnace/auth/auth-docs.factor @@ -1,6 +1,6 @@ USING: assocs classes help.markup help.syntax kernel quotations strings words words.symbol furnace.auth.providers.db -checksums.sha2 furnace.auth.providers math byte-arrays +checksums.sha furnace.auth.providers math byte-arrays http multiline ; IN: furnace.auth diff --git a/basis/furnace/auth/auth.factor b/basis/furnace/auth/auth.factor index b9c961941c..831ec7f8fc 100644 --- a/basis/furnace/auth/auth.factor +++ b/basis/furnace/auth/auth.factor @@ -3,7 +3,7 @@ USING: accessors assocs namespaces kernel sequences sets destructors combinators fry logging io.encodings.utf8 io.encodings.string io.binary random -checksums checksums.sha2 urls +checksums checksums.sha urls html.forms http.server http.server.filters diff --git a/basis/images/bitmap/bitmap-tests.factor b/basis/images/bitmap/bitmap-tests.factor index 29ba3b9b80..ea8b0d4c0c 100644 --- a/basis/images/bitmap/bitmap-tests.factor +++ b/basis/images/bitmap/bitmap-tests.factor @@ -17,9 +17,9 @@ CONSTANT: test-41 "vocab:images/test-images/41red24bit.bmp" CONSTANT: test-42 "vocab:images/test-images/42red24bit.bmp" CONSTANT: test-43 "vocab:images/test-images/43red24bit.bmp" -{ - $ test-bitmap8 - $ test-bitmap24 +${ + test-bitmap8 + test-bitmap24 "vocab:ui/render/test/reference.bmp" } [ [ ] swap [ load-image drop ] curry unit-test ] each @@ -34,11 +34,11 @@ CONSTANT: test-43 "vocab:images/test-images/43red24bit.bmp" [ t ] [ - { - $ test-40 - $ test-41 - $ test-42 - $ test-43 - $ test-bitmap24 + ${ + test-40 + test-41 + test-42 + test-43 + test-bitmap24 } [ test-bitmap-save ] all? ] unit-test diff --git a/basis/uuid/uuid.factor b/basis/uuid/uuid.factor index 2fd6ffdaec..4d284a1a40 100644 --- a/basis/uuid/uuid.factor +++ b/basis/uuid/uuid.factor @@ -1,7 +1,6 @@ ! Copyright (C) 2008 John Benediktsson ! See http://factorcode.org/license.txt for BSD license - -USING: byte-arrays checksums checksums.md5 checksums.sha1 +USING: byte-arrays checksums checksums.md5 checksums.sha kernel math math.parser math.ranges random unicode.case sequences strings system io.binary ; diff --git a/core/checksums/checksums-docs.factor b/core/checksums/checksums-docs.factor index 6ef0e85025..a05bf3a685 100644 --- a/core/checksums/checksums-docs.factor +++ b/core/checksums/checksums-docs.factor @@ -47,8 +47,7 @@ $nl "Checksum implementations:" { $subsection "checksums.crc32" } { $vocab-subsection "MD5 checksum" "checksums.md5" } -{ $vocab-subsection "SHA1 checksum" "checksums.sha1" } -{ $vocab-subsection "SHA2 checksum" "checksums.sha2" } +{ $vocab-subsection "SHA checksums" "checksums.sha" } { $vocab-subsection "Adler-32 checksum" "checksums.adler-32" } { $vocab-subsection "OpenSSL checksums" "checksums.openssl" } ; diff --git a/core/checksums/checksums.factor b/core/checksums/checksums.factor index 82918b6f81..1d57823e18 100644 --- a/core/checksums/checksums.factor +++ b/core/checksums/checksums.factor @@ -1,11 +1,46 @@ ! Copyright (c) 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. -USING: sequences math.parser io io.backend io.files -kernel ; +USING: accessors io io.backend io.files kernel math math.parser +sequences vectors io.encodings.binary quotations ; IN: checksums MIXIN: checksum +TUPLE: checksum-state bytes-read block-size bytes ; + +: new-checksum-state ( class -- checksum-state ) + new + 0 >>bytes-read + V{ } clone >>bytes ; inline + +M: checksum-state clone + call-next-method + [ clone ] change-bytes ; + +GENERIC: initialize-checksum-state ( class -- checksum-state ) + +GENERIC: checksum-block ( bytes checksum -- ) + +GENERIC: get-checksum ( checksum -- value ) + +: add-checksum-bytes ( checksum-state data -- checksum-state ) + over bytes>> [ push-all ] keep + [ dup length pick block-size>> >= ] + [ + 64 cut-slice [ + over [ checksum-block ] + [ [ 64 + ] change-bytes-read drop ] bi + ] dip + ] while >vector [ >>bytes ] [ length [ + ] curry change-bytes-read ] bi ; + +: add-checksum-stream ( checksum-state stream -- checksum-state ) + [ + [ [ swap add-checksum-bytes drop ] curry each-block ] keep + ] with-input-stream ; + +: add-checksum-file ( checksum-state path -- checksum-state ) + binary add-checksum-stream ; + GENERIC: checksum-bytes ( bytes checksum -- value ) GENERIC: checksum-stream ( stream checksum -- value ) diff --git a/extra/benchmark/sha1/sha1.factor b/extra/benchmark/sha1/sha1.factor index c1a7af2966..481bc31eb2 100644 --- a/extra/benchmark/sha1/sha1.factor +++ b/extra/benchmark/sha1/sha1.factor @@ -1,4 +1,4 @@ -USING: checksums checksums.sha1 sequences byte-arrays kernel ; +USING: checksums checksums.sha sequences byte-arrays kernel ; IN: benchmark.sha1 : sha1-file ( -- ) diff --git a/extra/crypto/hmac/authors.txt b/extra/crypto/hmac/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/extra/crypto/hmac/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman diff --git a/extra/crypto/hmac/hmac-tests.factor b/extra/crypto/hmac/hmac-tests.factor deleted file mode 100755 index 274e99d2f6..0000000000 --- a/extra/crypto/hmac/hmac-tests.factor +++ /dev/null @@ -1,38 +0,0 @@ -USING: kernel io strings byte-arrays sequences namespaces math -parser crypto.hmac tools.test ; -IN: crypto.hmac.tests - -[ - "\u000092\u000094rz68\u0000bb\u00001c\u000013\u0000f4\u00008e\u0000f8\u000015\u00008b\u0000fc\u00009d" -] [ - 16 11 "Hi There" sequence>md5-hmac >string ] unit-test - -[ "u\u00000cx>j\u0000b0\u0000b5\u000003\u0000ea\u0000a8n1\n]\u0000b78" ] -[ "Jefe" "what do ya want for nothing?" sequence>md5-hmac >string ] unit-test - -[ - "V\u0000be4R\u00001d\u000014L\u000088\u0000db\u0000b8\u0000c73\u0000f0\u0000e8\u0000b3\u0000f6" -] -[ - 16 HEX: aa - 50 HEX: dd sequence>md5-hmac >string -] unit-test - -[ - "g[\u00000b:\eM\u0000dfN\u000012Hr\u0000dal/c+\u0000fe\u0000d9W\u0000e9" -] [ - 16 11 "Hi There" sequence>sha1-hmac >string -] unit-test - -[ - "\u0000ef\u0000fc\u0000dfj\u0000e5\u0000eb/\u0000a2\u0000d2t\u000016\u0000d5\u0000f1\u000084\u0000df\u00009c%\u00009a|y" -] [ - "Jefe" "what do ya want for nothing?" sequence>sha1-hmac >string -] unit-test - -[ - "\u0000d70YM\u000016~5\u0000d5\u000095o\u0000d8\0=\r\u0000b3\u0000d3\u0000f4m\u0000c7\u0000bb" -] [ - 16 HEX: aa - 50 HEX: dd sequence>sha1-hmac >string -] unit-test diff --git a/extra/crypto/hmac/hmac.factor b/extra/crypto/hmac/hmac.factor deleted file mode 100755 index 9a668aa23a..0000000000 --- a/extra/crypto/hmac/hmac.factor +++ /dev/null @@ -1,55 +0,0 @@ -! Copyright (C) 2008 Doug Coleman. -! See http://factorcode.org/license.txt for BSD license. -USING: arrays combinators checksums checksums.md5 -checksums.sha1 checksums.md5.private io io.binary io.files -io.streams.byte-array kernel math math.vectors memoize sequences -io.encodings.binary ; -IN: crypto.hmac - -sha1 get-sha1 - initialize-sha1 - [ process-sha1-block ] - [ process-sha1-block ] bi* get-sha1 ; - -: md5-hmac ( Ko Ki -- hmac ) - initialize-md5 process-md5-block - stream>md5 get-md5 - initialize-md5 - [ process-md5-block ] - [ process-md5-block ] bi* get-md5 ; - -: seq-bitxor ( seq seq -- seq ) - [ bitxor ] 2map ; - -MEMO: ipad ( -- seq ) 64 HEX: 36 ; - -MEMO: opad ( -- seq ) 64 HEX: 5c ; - -: init-hmac ( K -- o i ) - 64 0 pad-tail - [ opad seq-bitxor ] - [ ipad seq-bitxor ] bi ; - -PRIVATE> - -: stream>sha1-hmac ( K stream -- hmac ) - [ init-hmac sha1-hmac ] with-input-stream ; - -: file>sha1-hmac ( K path -- hmac ) - binary stream>sha1-hmac ; - -: sequence>sha1-hmac ( K sequence -- hmac ) - binary stream>sha1-hmac ; - -: stream>md5-hmac ( K stream -- hmac ) - [ init-hmac md5-hmac ] with-input-stream ; - -: file>md5-hmac ( K path -- hmac ) - binary stream>md5-hmac ; - -: sequence>md5-hmac ( K sequence -- hmac ) - binary stream>md5-hmac ; diff --git a/extra/ecdsa/ecdsa-tests.factor b/extra/ecdsa/ecdsa-tests.factor index b319fa297b..2d9cda1460 100644 --- a/extra/ecdsa/ecdsa-tests.factor +++ b/extra/ecdsa/ecdsa-tests.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Maxim Savchenko ! See http://factorcode.org/license.txt for BSD license. -USING: namespaces ecdsa tools.test checksums checksums.sha2 ; +USING: namespaces ecdsa tools.test checksums checksums.sha ; IN: ecdsa.tests SYMBOLS: priv-key pub-key signature ; @@ -27,4 +27,4 @@ SYMBOLS: priv-key pub-key signature ; message sha-256 checksum-bytes signature get pub-key get "prime256v1" [ set-public-key ecdsa-verify ] with-ec -] unit-test \ No newline at end of file +] unit-test