From 052a0931d3cb0773d079effca272cf7c865f9f28 Mon Sep 17 00:00:00 2001 From: "U-C4\\Administrator" Date: Sun, 10 May 2009 20:42:20 -0500 Subject: [PATCH 01/18] moving md5 state to a tuple, redoing hmac --- .../checksums}/hmac/authors.txt | 0 .../checksums}/hmac/hmac-tests.factor | 20 ++-- basis/checksums/hmac/hmac.factor | 49 +++++++++ basis/checksums/md5/md5.factor | 102 +++++++++++------- extra/crypto/hmac/hmac.factor | 55 ---------- 5 files changed, 125 insertions(+), 101 deletions(-) rename {extra/crypto => basis/checksums}/hmac/authors.txt (100%) rename {extra/crypto => basis/checksums}/hmac/hmac-tests.factor (56%) create mode 100755 basis/checksums/hmac/hmac.factor delete mode 100755 extra/crypto/hmac/hmac.factor diff --git a/extra/crypto/hmac/authors.txt b/basis/checksums/hmac/authors.txt similarity index 100% rename from extra/crypto/hmac/authors.txt rename to basis/checksums/hmac/authors.txt diff --git a/extra/crypto/hmac/hmac-tests.factor b/basis/checksums/hmac/hmac-tests.factor similarity index 56% rename from extra/crypto/hmac/hmac-tests.factor rename to basis/checksums/hmac/hmac-tests.factor index 274e99d2f6..9541ca2f26 100755 --- a/extra/crypto/hmac/hmac-tests.factor +++ b/basis/checksums/hmac/hmac-tests.factor @@ -1,38 +1,42 @@ USING: kernel io strings byte-arrays sequences namespaces math -parser crypto.hmac tools.test ; -IN: crypto.hmac.tests +parser checksums.hmac tools.test checksums.md5 checksums.sha1 +checksums.sha2 ; +IN: checksums.hmac.tests [ "\u000092\u000094rz68\u0000bb\u00001c\u000013\u0000f4\u00008e\u0000f8\u000015\u00008b\u0000fc\u00009d" ] [ - 16 11 "Hi There" sequence>md5-hmac >string ] unit-test + 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?" sequence>md5-hmac >string ] unit-test +[ "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 sequence>md5-hmac >string + 50 HEX: dd md5 hmac-bytes >string ] unit-test [ "g[\u00000b:\eM\u0000dfN\u000012Hr\u0000dal/c+\u0000fe\u0000d9W\u0000e9" ] [ - 16 11 "Hi There" sequence>sha1-hmac >string + 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?" sequence>sha1-hmac >string + "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 sequence>sha1-hmac >string + 50 HEX: dd sha1 hmac-bytes >string ] unit-test + +[ "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7" ] +[ HEX: b 20 sha-256 hmac-bytes >string ] unit-test diff --git a/basis/checksums/hmac/hmac.factor b/basis/checksums/hmac/hmac.factor new file mode 100755 index 0000000000..7350a02573 --- /dev/null +++ b/basis/checksums/hmac/hmac.factor @@ -0,0 +1,49 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays checksums checksums.md5 checksums.md5.private +checksums.sha1 combinators fry io io.binary io.encodings.binary +io.files io.streams.byte-array kernel math math.vectors memoize +sequences ; +IN: checksums.hmac + +sha1 get-sha1 + initialize-sha1 + [ process-sha1-block ] + [ process-sha1-block ] bi* get-sha1 ; + +: md5-hmac ( Ko Ki stream -- 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: opad ( -- seq ) 64 HEX: 5c ; + +MEMO: ipad ( -- seq ) 64 HEX: 36 ; + +: init-K ( K -- o i ) + 64 0 pad-tail + [ opad seq-bitxor ] + [ ipad seq-bitxor ] bi ; + +PRIVATE> + +: hmac ( K stream checksum -- value ) + ; + +:: hmac-stream ( K stream checksum -- value ) + K init-K :> i :> o + stream checksum checksum-stream ; + +: hmac-file ( K path checksum -- value ) + [ binary ] dip hmac-stream ; + +: hmac-bytes ( K path checksum -- value ) + [ binary ] dip hmac-stream ; diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor index 29620b089d..eda977203a 100644 --- a/basis/checksums/md5/md5.factor +++ b/basis/checksums/md5/md5.factor @@ -3,57 +3,53 @@ 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 +TUPLE: md5-state bytes-read a b c d old-a old-b old-c old-d ; + +: ( -- md5-state ) + md5-state new + 0 >>bytes-read + HEX: 67452301 [ >>a ] [ >>old-a ] bi + HEX: efcdab89 [ >>b ] [ >>old-b ] bi + HEX: 98badcfe [ >>c ] [ >>old-c ] bi + HEX: 10325476 [ >>d ] [ >>old-d ] bi ; > ] [ ] [ old-a>> ] tri [ w+ ] change-a (>>old-a) ] + [ [ b>> ] [ ] [ old-b>> ] tri [ w+ ] change-b (>>old-b) ] + [ [ c>> ] [ ] [ old-c>> ] tri [ w+ ] change-c (>>old-c) ] + [ [ d>> ] [ ] [ old-d>> ] tri [ w+ ] change-d (>>old-d) ] + [ ] + } cleave ; + +: md5-state>bytes ( md5-state -- str ) + [ { [ a>> ] [ b>> ] [ c>> ] [ d>> ] } cleave ] output>array + [ 4 >le ] map B{ } concat-as ; : T ( N -- Y ) sin abs 32 2^ * >integer ; foldable -: 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 ; -: 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 ; : H ( X Y Z -- HXYZ ) #! H(X,Y,Z) = X xor Y xor Z bitxor bitxor ; -: 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 ; CONSTANT: S11 7 CONSTANT: S12 12 @@ -72,6 +68,35 @@ CONSTANT: S42 10 CONSTANT: S43 15 CONSTANT: S44 21 + + + +SYMBOLS: a b c d old-a old-b old-c old-d ; + +: 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 + MACRO: with-md5-round ( ops func -- ) '[ [ _ (ABCD) ] compose ] map '[ _ cleave ] ; @@ -173,9 +198,10 @@ MACRO: with-md5-round ( ops func -- ) [ (process-md5-block) ] each ] if ; -: stream>md5 ( -- ) - 64 read [ process-md5-block ] keep - length 64 = [ stream>md5 ] when ; +: stream>md5 ( stream -- ) + 64 over stream-read + [ process-md5-block ] [ length 64 = ] bi + [ stream>md5 ] [ drop ] if ; : get-md5 ( -- str ) [ a b c d ] [ get 4 >le ] map concat >byte-array ; @@ -186,5 +212,5 @@ SINGLETON: md5 INSTANCE: md5 stream-checksum -M: md5 checksum-stream ( stream -- byte-array ) - drop [ initialize-md5 stream>md5 get-md5 ] with-input-stream ; +M: md5 checksum-stream + drop initialize-md5 stream>md5 get-md5 ; 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 ; From 6dabec9ed8b7f42a688ba9d0ba7b5b5d33fc3729 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 10 May 2009 23:06:33 -0500 Subject: [PATCH 02/18] md5 stores state in a tuple now --- basis/checksums/md5/md5.factor | 132 ++++++++++++++------------------- 1 file changed, 57 insertions(+), 75 deletions(-) diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor index eda977203a..bf43805df2 100644 --- a/basis/checksums/md5/md5.factor +++ b/basis/checksums/md5/md5.factor @@ -7,49 +7,40 @@ io.encodings.binary math.bitwise checksums accessors checksums.common checksums.stream combinators combinators.smart ; IN: checksums.md5 -TUPLE: md5-state bytes-read a b c d old-a old-b old-c old-d ; +TUPLE: md5-state bytes-read state old-state ; : ( -- md5-state ) md5-state new 0 >>bytes-read - HEX: 67452301 [ >>a ] [ >>old-a ] bi - HEX: efcdab89 [ >>b ] [ >>old-b ] bi - HEX: 98badcfe [ >>c ] [ >>old-c ] bi - HEX: 10325476 [ >>d ] [ >>old-d ] bi ; + { HEX: 67452301 HEX: efcdab89 HEX: 98badcfe HEX: 10325476 } + [ clone >>state ] [ clone >>old-state ] bi ; > ] [ ] [ old-a>> ] tri [ w+ ] change-a (>>old-a) ] - [ [ b>> ] [ ] [ old-b>> ] tri [ w+ ] change-b (>>old-b) ] - [ [ c>> ] [ ] [ old-c>> ] tri [ w+ ] change-c (>>old-c) ] - [ [ d>> ] [ ] [ old-d>> ] tri [ w+ ] change-d (>>old-d) ] - [ ] - } cleave ; +: v-w+ ( v1 v2 -- v3 ) [ w+ ] 2map ; -: md5-state>bytes ( md5-state -- str ) - [ { [ a>> ] [ b>> ] [ c>> ] [ d>> ] } cleave ] output>array - [ 4 >le ] map B{ } concat-as ; +: update-md5-state ( md5-state -- ) + [ state>> ] [ old-state>> v-w+ dup clone ] [ ] tri + [ (>>old-state) ] [ (>>state) ] bi ; : T ( N -- Y ) sin abs 32 2^ * >integer ; foldable :: F ( X Y Z -- FXYZ ) #! F(X,Y,Z) = XY v not(X) Z - X Y bitand X bitnot Z bitand bitor ; + X Y bitand X bitnot Z bitand bitor ; inline :: G ( X Y Z -- GXYZ ) #! G(X,Y,Z) = XZ v Y not(Z) - X Z bitand Y Z bitnot bitand bitor ; + 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) = Y xor (X v not(Z)) - Z bitnot X bitor Y bitxor ; + Z bitnot X bitor Y bitxor ; inline CONSTANT: S11 7 CONSTANT: S12 12 @@ -68,39 +59,27 @@ CONSTANT: S42 10 CONSTANT: S43 15 CONSTANT: S44 21 +CONSTANT: a 0 +CONSTANT: b 1 +CONSTANT: c 2 +CONSTANT: d 3 - - -SYMBOLS: a b c d old-a old-b old-c old-d ; - -: 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 -- ) +:: (ABCD) ( x V a b c d k s i quot -- ) #! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s) - a [ - b get c get d get func call w+ + a V [ + b V nth-unsafe + c V nth-unsafe + d V nth-unsafe quot call w+ k x nth-unsafe w+ i T w+ s bitroll-32 - b get w+ - ] change ; inline + b V nth-unsafe w+ + ] change-nth ; inline -MACRO: with-md5-round ( ops func -- ) - '[ [ _ (ABCD) ] compose ] map '[ _ cleave ] ; +MACRO: with-md5-round ( ops quot -- ) + '[ [ _ (ABCD) ] compose ] map '[ _ 2cleave ] ; -: (process-md5-block-F) ( block -- ) +: (process-md5-block-F) ( block v -- ) { [ a b c d 0 S11 1 ] [ d a b c 1 S12 2 ] @@ -118,9 +97,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 ] @@ -138,9 +117,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 ] @@ -158,9 +137,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 ] @@ -178,33 +157,36 @@ 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) +: (process-md5-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 + nip update-md5-state + ] 2bi ; + +:: process-md5-block ( block state -- ) + block length + [ state [ + ] change-bytes-read drop ] [ 64 = ] bi [ + block state (process-md5-block) + ] [ + block f state bytes-read>> pad-last-block + [ state (process-md5-block) ] each ] if ; -: stream>md5 ( stream -- ) - 64 over stream-read - [ process-md5-block ] [ length 64 = ] bi - [ stream>md5 ] [ drop ] if ; +:: stream>md5 ( stream state -- ) + 64 stream stream-read + [ state process-md5-block ] [ length 64 = ] bi + [ stream state stream>md5 ] when ; -: get-md5 ( -- str ) - [ a b c d ] [ get 4 >le ] map concat >byte-array ; +: get-md5 ( md5-state -- bytes ) + state>> [ 4 >le ] map B{ } concat-as ; PRIVATE> @@ -213,4 +195,4 @@ SINGLETON: md5 INSTANCE: md5 stream-checksum M: md5 checksum-stream - drop initialize-md5 stream>md5 get-md5 ; + drop [ stream>md5 ] [ get-md5 ] bi ; From bee3c05fe9fe4327228e68901c24021bfc65115f Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 11 May 2009 11:37:21 -0500 Subject: [PATCH 03/18] working on checksums --- basis/checksums/hmac/hmac.factor | 16 ++++++++++------ basis/checksums/md5/md5.factor | 31 ++++++++++++++++++++++--------- 2 files changed, 32 insertions(+), 15 deletions(-) diff --git a/basis/checksums/hmac/hmac.factor b/basis/checksums/hmac/hmac.factor index 7350a02573..fd7f6ef3a1 100755 --- a/basis/checksums/hmac/hmac.factor +++ b/basis/checksums/hmac/hmac.factor @@ -8,6 +8,7 @@ IN: checksums.hmac sha1 get-sha1 @@ -15,12 +16,13 @@ IN: checksums.hmac [ process-sha1-block ] [ process-sha1-block ] bi* get-sha1 ; -: md5-hmac ( Ko Ki stream -- hmac ) + : md5-hmac ( Ko Ki stream -- 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 ; @@ -35,12 +37,14 @@ MEMO: ipad ( -- seq ) 64 HEX: 36 ; PRIVATE> -: hmac ( K stream checksum -- value ) - ; - :: hmac-stream ( K stream checksum -- value ) - K init-K :> i :> o - stream checksum checksum-stream ; + K init-K :> Ki :> Ko + checksum initialize-checksum + Ki add-bytes + stream add-stream finish-checksum + checksum initialize-checksum + Ko add-bytes swap add-bytes + finish-checksum ; : hmac-file ( K path checksum -- value ) [ binary ] dip hmac-stream ; diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor index bf43805df2..abdc3504cc 100644 --- a/basis/checksums/md5/md5.factor +++ b/basis/checksums/md5/md5.factor @@ -13,7 +13,7 @@ TUPLE: md5-state bytes-read state old-state ; md5-state new 0 >>bytes-read { HEX: 67452301 HEX: efcdab89 HEX: 98badcfe HEX: 10325476 } - [ clone >>state ] [ clone >>old-state ] bi ; + [ clone >>state ] [ >>old-state ] bi ; > ] [ old-state>> v-w+ dup clone ] [ ] tri - [ (>>old-state) ] [ (>>state) ] bi ; + [ (>>old-state) ] [ (>>state) ] bi ; inline : T ( N -- Y ) - sin abs 32 2^ * >integer ; foldable + sin abs 32 2^ * >integer ; inline :: F ( X Y Z -- FXYZ ) #! F(X,Y,Z) = XY v not(X) Z @@ -179,15 +179,15 @@ MACRO: with-md5-round ( ops quot -- ) block f state bytes-read>> pad-last-block [ state (process-md5-block) ] each ] if ; - -:: stream>md5 ( stream state -- ) - 64 stream stream-read - [ state process-md5-block ] [ length 64 = ] bi - [ stream state stream>md5 ] when ; : get-md5 ( md5-state -- bytes ) state>> [ 4 >le ] map B{ } concat-as ; +:: stream>md5 ( state stream -- ) + 64 stream stream-read + [ state process-md5-block ] [ length 64 = ] bi + [ state stream stream>md5 ] when ; + PRIVATE> SINGLETON: md5 @@ -195,4 +195,17 @@ SINGLETON: md5 INSTANCE: md5 stream-checksum M: md5 checksum-stream - drop [ stream>md5 ] [ get-md5 ] bi ; + drop [ ] dip [ stream>md5 ] [ drop get-md5 ] 2bi ; + +GENERIC: initialize-checksum ( checksum -- state ) +GENERIC# add-bytes 1 ( state bytes -- state ) +GENERIC# add-stream 1 ( state stream -- state ) +GENERIC: finish-checksum ( state -- bytes ) + +M: md5 initialize-checksum drop ; + +M: md5-state finish-checksum get-md5 ; + +M: md5-state add-bytes over [ binary stream>md5 ] dip ; + +M: md5-state add-stream over [ stream>md5 ] dip ; From 89ccc4b00acddacca2545ef05e2f924f88ecfe36 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 16 May 2009 08:46:41 -0500 Subject: [PATCH 04/18] throw exceptions on png types we dont support --- basis/compression/inflate/inflate.factor | 4 ++- basis/images/png/png.factor | 32 ++++++++++++++++++++++-- 2 files changed, 33 insertions(+), 3 deletions(-) diff --git a/basis/compression/inflate/inflate.factor b/basis/compression/inflate/inflate.factor index 3e67b11cc7..3fe07b5994 100755 --- a/basis/compression/inflate/inflate.factor +++ b/basis/compression/inflate/inflate.factor @@ -200,7 +200,9 @@ PRIVATE> : reverse-png-filter ( lines -- filtered ) dup first [ 0 ] replicate prefix [ { 0 0 } prepend ] map - 2 clump [ first2 dup [ third ] [ 0 2 rot set-nth ] bi png-unfilter-line ] map concat ; + 2 clump [ + first2 dup [ third ] [ 0 2 rot set-nth ] bi png-unfilter-line + ] map concat ; : zlib-inflate ( bytes -- bytes ) bs: diff --git a/basis/images/png/png.factor b/basis/images/png/png.factor index bf13c43546..c5b84de221 100755 --- a/basis/images/png/png.factor +++ b/basis/images/png/png.factor @@ -65,14 +65,42 @@ ERROR: bad-checksum ; : zlib-data ( png-image -- bytes ) chunks>> [ type>> "IDAT" = ] find nip data>> ; -: decode-png ( image -- image ) +ERROR: unknown-color-type n ; +ERROR: unimplemented-color-type image ; + +: inflate-data ( image -- bytes ) + zlib-data zlib-inflate ; + +: decode-greyscale ( image -- image ) + unimplemented-color-type ; + +: decode-truecolor ( image -- image ) { - [ zlib-data zlib-inflate ] + [ inflate-data ] [ dim>> first 3 * 1 + group reverse-png-filter ] [ swap >byte-array >>bitmap drop ] [ RGB >>component-order drop ] [ ] } cleave ; + +: decode-indexed-color ( image -- image ) + unimplemented-color-type ; + +: decode-greyscale-alpha ( image -- image ) + unimplemented-color-type ; + +: decode-truecolor-alpha ( image -- image ) + unimplemented-color-type ; + +: decode-png ( image -- image ) + dup color-type>> { + { 0 [ decode-greyscale ] } + { 2 [ decode-truecolor ] } + { 3 [ decode-indexed-color ] } + { 4 [ decode-greyscale-alpha ] } + { 6 [ decode-truecolor-alpha ] } + [ unknown-color-type ] + } case ; : load-png ( path -- image ) [ binary ] [ file-info size>> ] bi From e87021401683eba532fa1fa0b3ac054a98bcadf4 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 16 May 2009 13:03:09 -0500 Subject: [PATCH 05/18] working on checksums --- basis/checksums/hmac/hmac.factor | 2 +- basis/checksums/md5/md5.factor | 48 +++++++------------------------- core/checksums/checksums.factor | 34 ++++++++++++++++++++-- 3 files changed, 43 insertions(+), 41 deletions(-) diff --git a/basis/checksums/hmac/hmac.factor b/basis/checksums/hmac/hmac.factor index fd7f6ef3a1..17b391f215 100755 --- a/basis/checksums/hmac/hmac.factor +++ b/basis/checksums/hmac/hmac.factor @@ -49,5 +49,5 @@ PRIVATE> : hmac-file ( K path checksum -- value ) [ binary ] dip hmac-stream ; -: hmac-bytes ( K path checksum -- value ) +: hmac-bytes ( K seq checksum -- value ) [ binary ] dip hmac-stream ; diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor index abdc3504cc..ee00817ea5 100644 --- a/basis/checksums/md5/md5.factor +++ b/basis/checksums/md5/md5.factor @@ -7,11 +7,13 @@ io.encodings.binary math.bitwise checksums accessors checksums.common checksums.stream combinators combinators.smart ; IN: checksums.md5 -TUPLE: md5-state bytes-read state old-state ; +SINGLETON: md5 +INSTANCE: md5 stream-checksum + +TUPLE: md5-state < checksum-state state old-state ; : ( -- md5-state ) - md5-state new - 0 >>bytes-read + 64 md5-state new-checksum-state { HEX: 67452301 HEX: efcdab89 HEX: 98badcfe HEX: 10325476 } [ clone >>state ] [ >>old-state ] bi ; @@ -159,7 +161,7 @@ MACRO: with-md5-round ( ops quot -- ) [ b c d a 9 S44 64 ] } [ I ] with-md5-round ; inline -: (process-md5-block) ( block state -- ) +M: md5-state checksum-block ( block state -- ) [ [ 4 [ le> ] map ] [ state>> ] bi* { [ (process-md5-block-F) ] @@ -171,41 +173,11 @@ MACRO: with-md5-round ( ops quot -- ) nip update-md5-state ] 2bi ; -:: process-md5-block ( block state -- ) - block length - [ state [ + ] change-bytes-read drop ] [ 64 = ] bi [ - block state (process-md5-block) - ] [ - block f state bytes-read>> pad-last-block - [ state (process-md5-block) ] each - ] if ; - -: get-md5 ( md5-state -- bytes ) +: md5-state>checksum ( md5-state -- bytes ) state>> [ 4 >le ] map B{ } concat-as ; -:: stream>md5 ( state stream -- ) - 64 stream stream-read - [ state process-md5-block ] [ length 64 = ] bi - [ state stream stream>md5 ] when ; +M: md5-state get-checksum ( md5-state -- bytes ) + clone [ bytes>> f ] [ bytes-read>> pad-last-block ] [ ] tri + [ [ checksum-block ] curry each ] [ md5-state>checksum ] bi ; PRIVATE> - -SINGLETON: md5 - -INSTANCE: md5 stream-checksum - -M: md5 checksum-stream - drop [ ] dip [ stream>md5 ] [ drop get-md5 ] 2bi ; - -GENERIC: initialize-checksum ( checksum -- state ) -GENERIC# add-bytes 1 ( state bytes -- state ) -GENERIC# add-stream 1 ( state stream -- state ) -GENERIC: finish-checksum ( state -- bytes ) - -M: md5 initialize-checksum drop ; - -M: md5-state finish-checksum get-md5 ; - -M: md5-state add-bytes over [ binary stream>md5 ] dip ; - -M: md5-state add-stream over [ stream>md5 ] dip ; diff --git a/core/checksums/checksums.factor b/core/checksums/checksums.factor index 82918b6f81..4f12f5b45d 100644 --- a/core/checksums/checksums.factor +++ b/core/checksums/checksums.factor @@ -1,11 +1,41 @@ ! 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 ; IN: checksums MIXIN: checksum +TUPLE: checksum-state bytes-read block-size bytes ; + +: new-checksum-state ( block-size class -- checksum-state ) + new + swap >>block-size + 0 >>bytes-read + V{ } clone >>bytes ; inline + +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 ; + +: add-checksum-stream ( checksum-state stream -- checksum-state ) + [ + [ '[ [ _ ] dip add-checksum-bytes drop ] 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 ) From d1468a33d1a7385ade48fb4efb947ad4050867b2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 16 May 2009 15:17:20 -0500 Subject: [PATCH 06/18] dont use fry in core --- core/checksums/checksums.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/core/checksums/checksums.factor b/core/checksums/checksums.factor index 4f12f5b45d..27ee6a3435 100644 --- a/core/checksums/checksums.factor +++ b/core/checksums/checksums.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: accessors io io.backend io.files kernel math math.parser -sequences vectors io.encodings.binary ; +sequences vectors io.encodings.binary quotations ; IN: checksums MIXIN: checksum @@ -30,7 +30,7 @@ GENERIC: get-checksum ( checksum -- value ) : add-checksum-stream ( checksum-state stream -- checksum-state ) [ - [ '[ [ _ ] dip add-checksum-bytes drop ] each-block ] keep + [ [ swap add-checksum-bytes drop ] curry each-block ] keep ] with-input-stream ; : add-checksum-file ( checksum-state path -- checksum-state ) From 0bdccdb7acbcac5f6d8f0339d39cdb380c4709a8 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 16 May 2009 18:00:56 -0500 Subject: [PATCH 07/18] checksums work now --- basis/checksums/md5/md5-tests.factor | 21 ++++++++++++++++++ basis/checksums/md5/md5.factor | 32 ++++++++++++++++++---------- core/checksums/checksums.factor | 6 +++++- 3 files changed, 47 insertions(+), 12 deletions(-) diff --git a/basis/checksums/md5/md5-tests.factor b/basis/checksums/md5/md5-tests.factor index 8e314f7c28..db15540f43 100644 --- a/basis/checksums/md5/md5-tests.factor +++ b/basis/checksums/md5/md5-tests.factor @@ -8,3 +8,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 ee00817ea5..97a263bab5 100644 --- a/basis/checksums/md5/md5.factor +++ b/basis/checksums/md5/md5.factor @@ -8,11 +8,12 @@ checksums.common checksums.stream combinators combinators.smart ; IN: checksums.md5 SINGLETON: md5 + INSTANCE: md5 stream-checksum TUPLE: md5-state < checksum-state state old-state ; -: ( -- md5-state ) +: ( -- md5 ) 64 md5-state new-checksum-state { HEX: 67452301 HEX: efcdab89 HEX: 98badcfe HEX: 10325476 } [ clone >>state ] [ >>old-state ] bi ; @@ -21,7 +22,7 @@ TUPLE: md5-state < checksum-state state old-state ; : v-w+ ( v1 v2 -- v3 ) [ w+ ] 2map ; -: update-md5-state ( md5-state -- ) +: update-md5 ( md5 -- ) [ state>> ] [ old-state>> v-w+ dup clone ] [ ] tri [ (>>old-state) ] [ (>>state) ] bi ; inline @@ -69,13 +70,13 @@ CONSTANT: d 3 :: (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-unsafe - c V nth-unsafe - d V nth-unsafe quot call w+ - k x nth-unsafe w+ + 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-unsafe w+ + b V nth w+ ] change-nth ; inline MACRO: with-md5-round ( ops quot -- ) @@ -170,14 +171,23 @@ M: md5-state checksum-block ( block state -- ) [ (process-md5-block-I) ] } 2cleave ] [ - nip update-md5-state + nip update-md5 ] 2bi ; -: md5-state>checksum ( md5-state -- bytes ) +: md5>checksum ( md5 -- bytes ) state>> [ 4 >le ] map B{ } concat-as ; -M: md5-state get-checksum ( md5-state -- bytes ) +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-state>checksum ] bi ; + [ [ checksum-block ] curry each ] [ md5>checksum ] bi ; + +M: md5 checksum-stream ( stream checksum -- byte-array ) + drop + [ ] dip add-checksum-stream get-checksum ; PRIVATE> diff --git a/core/checksums/checksums.factor b/core/checksums/checksums.factor index 27ee6a3435..0910a3efac 100644 --- a/core/checksums/checksums.factor +++ b/core/checksums/checksums.factor @@ -14,6 +14,10 @@ TUPLE: checksum-state bytes-read block-size bytes ; 0 >>bytes-read V{ } clone >>bytes ; inline +M: checksum-state clone + call-next-method + [ clone ] change-bytes ; + GENERIC: checksum-block ( bytes checksum -- ) GENERIC: get-checksum ( checksum -- value ) @@ -26,7 +30,7 @@ GENERIC: get-checksum ( checksum -- value ) over [ checksum-block ] [ [ 64 + ] change-bytes-read drop ] bi ] dip - ] while >vector >>bytes ; + ] while >vector [ >>bytes ] [ length [ + ] curry change-bytes-read ] bi ; : add-checksum-stream ( checksum-state stream -- checksum-state ) [ From c8e0b049a841fee7b851486bafc9a4f0f6558dcc Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 17 May 2009 10:10:14 -0500 Subject: [PATCH 08/18] fix a bug in inflate -- length table was one entry too short --- basis/compression/inflate/inflate.factor | 25 ++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) 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 ; From b2ac4396c1f78e81dec1f9413e63e617573e2e0c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 17 May 2009 11:03:04 -0500 Subject: [PATCH 09/18] sha2 now uses the incremental checksum protocol --- basis/checksums/md5/md5-tests.factor | 4 +- basis/checksums/sha2/sha2.factor | 101 +++++++++++++-------------- 2 files changed, 51 insertions(+), 54 deletions(-) diff --git a/basis/checksums/md5/md5-tests.factor b/basis/checksums/md5/md5-tests.factor index db15540f43..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 diff --git a/basis/checksums/sha2/sha2.factor b/basis/checksums/sha2/sha2.factor index 12e32f6c69..509b047d2e 100644 --- a/basis/checksums/sha2/sha2.factor +++ b/basis/checksums/sha2/sha2.factor @@ -3,16 +3,16 @@ 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 ; +accessors locals checksums.stream multiline ; IN: checksums.sha2 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: sha2-state < checksum-state K H word-size ; TUPLE: sha2-short < sha2-state ; @@ -22,6 +22,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 ; + ( -- sha2-state ) + 64 sha-224-state new-checksum-state + K-256 >>K + initial-H-224 >>H + 4 >>word-size ; + +: ( -- sha2-state ) + 64 sha-256-state new-checksum-state + K-256 >>K + initial-H-256 >>H + 4 >>word-size ; + : s0-256 ( x -- x' ) [ [ -7 bitroll-32 ] @@ -172,7 +189,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 +198,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,23 +218,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 ; @@ -257,7 +257,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 -- ) @@ -268,39 +268,34 @@ M: sha2-long pad-initial-bytes ( string sha2 -- padded-string ) ] each cloned-H sha2 H>> [ w+ ] 2map sha2 (>>H) ; 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 ; +: sha-224>checksum ( sha2 -- bytes ) + H>> 7 head 4 seq>byte-array ; -: ( -- sha2-state ) - sha-224-state new - K-256 >>K - initial-H-224 >>H - 4 >>word-size - 64 >>block-size ; +: sha-256>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 ; +: 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 ; From f1f1a26b6069a4006c9133a6f7d14cc76b2db380 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 17 May 2009 12:45:20 -0500 Subject: [PATCH 10/18] working on hmac --- basis/checksums/hmac/hmac-tests.factor | 11 ++++-- basis/checksums/hmac/hmac.factor | 47 ++++++++++---------------- basis/checksums/md5/md5.factor | 5 ++- basis/checksums/sha2/sha2-tests.factor | 2 -- basis/checksums/sha2/sha2.factor | 10 ++++-- core/checksums/checksums.factor | 5 +-- 6 files changed, 41 insertions(+), 39 deletions(-) diff --git a/basis/checksums/hmac/hmac-tests.factor b/basis/checksums/hmac/hmac-tests.factor index 9541ca2f26..8835bed981 100755 --- a/basis/checksums/hmac/hmac-tests.factor +++ b/basis/checksums/hmac/hmac-tests.factor @@ -1,6 +1,6 @@ USING: kernel io strings byte-arrays sequences namespaces math parser checksums.hmac tools.test checksums.md5 checksums.sha1 -checksums.sha2 ; +checksums.sha2 checksums ; IN: checksums.hmac.tests [ @@ -39,4 +39,11 @@ IN: checksums.hmac.tests ] unit-test [ "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7" ] -[ HEX: b 20 sha-256 hmac-bytes >string ] unit-test +[ 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 index 17b391f215..538dfc92c8 100755 --- a/basis/checksums/hmac/hmac.factor +++ b/basis/checksums/hmac/hmac.factor @@ -3,48 +3,35 @@ USING: arrays checksums checksums.md5 checksums.md5.private checksums.sha1 combinators fry io io.binary io.encodings.binary io.files io.streams.byte-array kernel math math.vectors memoize -sequences ; +sequences locals accessors ; IN: checksums.hmac sha1 get-sha1 - initialize-sha1 - [ process-sha1-block ] - [ process-sha1-block ] bi* get-sha1 ; - - : md5-hmac ( Ko Ki stream -- 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: opad ( -- seq ) 64 HEX: 5c ; +: opad ( checksum-state -- seq ) block-size>> HEX: 5c ; -MEMO: ipad ( -- seq ) 64 HEX: 36 ; +: ipad ( checksum-state -- seq ) block-size>> HEX: 36 ; -: init-K ( K -- o i ) - 64 0 pad-tail - [ opad seq-bitxor ] - [ ipad seq-bitxor ] bi ; +:: 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 init-K :> Ki :> Ko - checksum initialize-checksum - Ki add-bytes - stream add-stream finish-checksum - checksum initialize-checksum - Ko add-bytes swap add-bytes - finish-checksum ; + 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 ; diff --git a/basis/checksums/md5/md5.factor b/basis/checksums/md5/md5.factor index 97a263bab5..026df34012 100644 --- a/basis/checksums/md5/md5.factor +++ b/basis/checksums/md5/md5.factor @@ -14,10 +14,13 @@ INSTANCE: md5 stream-checksum TUPLE: md5-state < checksum-state state old-state ; : ( -- md5 ) - 64 md5-state new-checksum-state + 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 ; + ( -- sha2-state ) - 64 sha-224-state new-checksum-state + sha-224-state new-checksum-state + 64 >>block-size K-256 >>K initial-H-224 >>H 4 >>word-size ; : ( -- sha2-state ) - 64 sha-256-state new-checksum-state + sha-256-state new-checksum-state + 64 >>block-size K-256 >>K initial-H-256 >>H 4 >>word-size ; +M: sha-224 initialize-checksum-state drop ; + +M: sha-256 initialize-checksum-state drop ; + : s0-256 ( x -- x' ) [ [ -7 bitroll-32 ] diff --git a/core/checksums/checksums.factor b/core/checksums/checksums.factor index 0910a3efac..1d57823e18 100644 --- a/core/checksums/checksums.factor +++ b/core/checksums/checksums.factor @@ -8,9 +8,8 @@ MIXIN: checksum TUPLE: checksum-state bytes-read block-size bytes ; -: new-checksum-state ( block-size class -- checksum-state ) +: new-checksum-state ( class -- checksum-state ) new - swap >>block-size 0 >>bytes-read V{ } clone >>bytes ; inline @@ -18,6 +17,8 @@ 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 ) From 8b37eced0511d98c89d138215f5d876befac8b33 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 17 May 2009 13:36:53 -0500 Subject: [PATCH 11/18] use literal-arrays --- basis/images/bitmap/bitmap-tests.factor | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) 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 From ee6a8e78e7ae37b4dc22d10a59bb3bef8fe34520 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 17 May 2009 13:49:56 -0500 Subject: [PATCH 12/18] generalize sha1-interleave and move it to its own vocabulary --- basis/checksums/interleave/authors.txt | 1 + .../interleave/interleave-tests.factor | 19 +++++++++++++++++++ basis/checksums/interleave/interleave.factor | 17 +++++++++++++++++ 3 files changed, 37 insertions(+) create mode 100644 basis/checksums/interleave/authors.txt create mode 100644 basis/checksums/interleave/interleave-tests.factor create mode 100644 basis/checksums/interleave/interleave.factor 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..060d35936f --- /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.sha1 ; +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 ; From e342082722c40f5a5f9f97378022b0f27b590cb6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 17 May 2009 17:50:31 -0500 Subject: [PATCH 13/18] fix sha1 --- basis/checksums/adler-32/adler-32.factor | 2 +- basis/checksums/hmac/hmac-tests.factor | 4 +- .../interleave/interleave-tests.factor | 2 +- basis/checksums/sha1/authors.txt | 1 - basis/checksums/sha1/sha1-docs.factor | 11 -- basis/checksums/sha1/sha1-tests.factor | 14 -- basis/checksums/sha1/sha1.factor | 134 ------------------ basis/checksums/sha1/summary.txt | 1 - basis/checksums/sha2/sha2-tests.factor | 7 + basis/checksums/sha2/sha2.factor | 114 ++++++++++++++- 10 files changed, 120 insertions(+), 170 deletions(-) delete mode 100755 basis/checksums/sha1/authors.txt delete mode 100644 basis/checksums/sha1/sha1-docs.factor delete mode 100644 basis/checksums/sha1/sha1-tests.factor delete mode 100644 basis/checksums/sha1/sha1.factor delete mode 100644 basis/checksums/sha1/summary.txt 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/hmac/hmac-tests.factor b/basis/checksums/hmac/hmac-tests.factor index 8835bed981..02dfc271a4 100755 --- a/basis/checksums/hmac/hmac-tests.factor +++ b/basis/checksums/hmac/hmac-tests.factor @@ -1,6 +1,6 @@ USING: kernel io strings byte-arrays sequences namespaces math -parser checksums.hmac tools.test checksums.md5 checksums.sha1 -checksums.sha2 checksums ; +parser checksums.hmac tools.test checksums.md5 checksums.sha2 +checksums ; IN: checksums.hmac.tests [ diff --git a/basis/checksums/interleave/interleave-tests.factor b/basis/checksums/interleave/interleave-tests.factor index 060d35936f..14dddaafab 100644 --- a/basis/checksums/interleave/interleave-tests.factor +++ b/basis/checksums/interleave/interleave-tests.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: tools.test checksums.interleave checksums.sha1 ; +USING: tools.test checksums.interleave checksums.sha2 ; IN: checksums.interleave.tests [ diff --git a/basis/checksums/sha1/authors.txt b/basis/checksums/sha1/authors.txt deleted file mode 100755 index 7c1b2f2279..0000000000 --- a/basis/checksums/sha1/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Doug Coleman 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-tests.factor b/basis/checksums/sha2/sha2-tests.factor index 010ca96d4f..fa01796ae9 100644 --- a/basis/checksums/sha2/sha2-tests.factor +++ b/basis/checksums/sha2/sha2-tests.factor @@ -5,6 +5,13 @@ IN: checksums.sha2.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" diff --git a/basis/checksums/sha2/sha2.factor b/basis/checksums/sha2/sha2.factor index 8992299db0..6c799d7e6e 100644 --- a/basis/checksums/sha2/sha2.factor +++ b/basis/checksums/sha2/sha2.factor @@ -3,15 +3,39 @@ 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 checksums.stream multiline ; +accessors locals checksums.stream multiline literals +generalizations ; IN: checksums.sha2 +SINGLETON: sha1 +INSTANCE: sha1 stream-checksum + SINGLETON: sha-224 SINGLETON: sha-256 INSTANCE: sha-224 stream-checksum INSTANCE: sha-256 stream-checksum +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 ; @@ -121,6 +145,13 @@ CONSTANT: K-384 ALIAS: K-512 K-384 +: ( -- 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 @@ -135,6 +166,8 @@ ALIAS: K-512 K-384 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 ; @@ -224,9 +257,6 @@ M: sha-256 initialize-checksum-state drop ; GENERIC: pad-initial-bytes ( string sha2 -- padded-string ) -: seq>byte-array ( seq n -- string ) - '[ _ >be ] map B{ } join ; - :: T1-256 ( n M H sha2 -- T1 ) n M nth n sha2 K>> nth + @@ -272,12 +302,18 @@ GENERIC: 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 M: sha2-short checksum-block [ prepare-message-schedule ] [ [ block-size>> ] [ H>> clone ] [ ] tri process-chunk ] bi ; +: seq>byte-array ( seq n -- string ) + '[ _ >be ] map B{ } join ; + +: sha1>checksum ( sha2 -- bytes ) + H>> 4 seq>byte-array ; + : sha-224>checksum ( sha2 -- bytes ) H>> 7 head 4 seq>byte-array ; @@ -305,3 +341,71 @@ M: sha-224 checksum-stream ( stream checksum -- byte-array ) 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 ; From b352bbdc12908cab034cc78bb3cd83c3fd38ee16 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 17 May 2009 17:58:36 -0500 Subject: [PATCH 14/18] move sha1 and sha2 to checksums.sha, update usages --- basis/checksums/hmac/hmac-tests.factor | 3 +-- basis/checksums/hmac/hmac.factor | 7 +++---- .../interleave/interleave-tests.factor | 2 +- basis/checksums/openssl/openssl-docs.factor | 2 +- basis/checksums/{sha2 => sha}/authors.txt | 0 basis/checksums/sha/sha-docs.factor | 18 ++++++++++++++++++ .../sha2-tests.factor => sha/sha-tests.factor} | 4 ++-- .../{sha2/sha2.factor => sha/sha.factor} | 2 +- basis/checksums/sha/summary.txt | 1 + basis/checksums/sha2/sha2-docs.factor | 11 ----------- basis/checksums/sha2/summary.txt | 1 - basis/furnace/auth/auth-docs.factor | 2 +- basis/furnace/auth/auth.factor | 2 +- basis/uuid/uuid.factor | 3 +-- core/checksums/checksums-docs.factor | 3 +-- extra/benchmark/sha1/sha1.factor | 2 +- extra/ecdsa/ecdsa-tests.factor | 4 ++-- 17 files changed, 35 insertions(+), 32 deletions(-) rename basis/checksums/{sha2 => sha}/authors.txt (100%) create mode 100644 basis/checksums/sha/sha-docs.factor rename basis/checksums/{sha2/sha2-tests.factor => sha/sha-tests.factor} (97%) rename basis/checksums/{sha2/sha2.factor => sha/sha.factor} (99%) create mode 100644 basis/checksums/sha/summary.txt delete mode 100644 basis/checksums/sha2/sha2-docs.factor delete mode 100644 basis/checksums/sha2/summary.txt diff --git a/basis/checksums/hmac/hmac-tests.factor b/basis/checksums/hmac/hmac-tests.factor index 02dfc271a4..ffae146614 100755 --- a/basis/checksums/hmac/hmac-tests.factor +++ b/basis/checksums/hmac/hmac-tests.factor @@ -1,5 +1,5 @@ USING: kernel io strings byte-arrays sequences namespaces math -parser checksums.hmac tools.test checksums.md5 checksums.sha2 +parser checksums.hmac tools.test checksums.md5 checksums.sha checksums ; IN: checksums.hmac.tests @@ -46,4 +46,3 @@ IN: checksums.hmac.tests "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 index 538dfc92c8..b163766016 100755 --- a/basis/checksums/hmac/hmac.factor +++ b/basis/checksums/hmac/hmac.factor @@ -1,9 +1,8 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays checksums checksums.md5 checksums.md5.private -checksums.sha1 combinators fry io io.binary io.encodings.binary -io.files io.streams.byte-array kernel math math.vectors memoize -sequences locals accessors ; +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 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 97% rename from basis/checksums/sha2/sha2-tests.factor rename to basis/checksums/sha/sha-tests.factor index fa01796ae9..b70b5e7ba2 100644 --- a/basis/checksums/sha2/sha2-tests.factor +++ b/basis/checksums/sha/sha-tests.factor @@ -1,6 +1,6 @@ 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 ; diff --git a/basis/checksums/sha2/sha2.factor b/basis/checksums/sha/sha.factor similarity index 99% rename from basis/checksums/sha2/sha2.factor rename to basis/checksums/sha/sha.factor index 6c799d7e6e..287c39b2a1 100644 --- a/basis/checksums/sha2/sha2.factor +++ b/basis/checksums/sha/sha.factor @@ -5,7 +5,7 @@ io.binary math.bitwise checksums checksums.common sbufs strings combinators.smart math.ranges fry combinators accessors locals checksums.stream multiline literals generalizations ; -IN: checksums.sha2 +IN: checksums.sha SINGLETON: sha1 INSTANCE: sha1 stream-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/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/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/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/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/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 From bd8673f766b98b89ed31afc8248530e1e13bd04e Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 17 May 2009 18:05:46 -0500 Subject: [PATCH 15/18] fix multiple using warning in stage1, core can't use io.encodings.binary --- core/bootstrap/stage1.factor | 8 ++++---- core/checksums/checksums.factor | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/core/bootstrap/stage1.factor b/core/bootstrap/stage1.factor index 088a8a6320..c7be17e38d 100644 --- a/core/bootstrap/stage1.factor +++ b/core/bootstrap/stage1.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2004, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays debugger generic hashtables io assocs kernel.private -kernel math memory namespaces make parser prettyprint sequences -vectors words system splitting init io.files vocabs vocabs.loader -debugger continuations ; +USING: arrays assocs continuations debugger generic hashtables +init io io.files kernel kernel.private make math memory +namespaces parser prettyprint sequences splitting system +vectors vocabs vocabs.loader words ; QUALIFIED: bootstrap.image.private IN: bootstrap.stage1 diff --git a/core/checksums/checksums.factor b/core/checksums/checksums.factor index 1d57823e18..9d40521fc8 100644 --- a/core/checksums/checksums.factor +++ b/core/checksums/checksums.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2008 Slava Pestov ! See http://factorcode.org/license.txt for BSD license. USING: accessors io io.backend io.files kernel math math.parser -sequences vectors io.encodings.binary quotations ; +sequences vectors quotations ; IN: checksums MIXIN: checksum @@ -39,7 +39,7 @@ GENERIC: get-checksum ( checksum -- value ) ] with-input-stream ; : add-checksum-file ( checksum-state path -- checksum-state ) - binary add-checksum-stream ; + normalize-path (file-reader) add-checksum-stream ; GENERIC: checksum-bytes ( bytes checksum -- value ) From 70020d59bd879f2da83fbe3e519e871ef59b1a94 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 17 May 2009 18:41:15 -0500 Subject: [PATCH 16/18] add some unit tests testing get-checksum --- basis/checksums/sha/sha-tests.factor | 27 +++++++++++++++++++++++++-- 1 file changed, 25 insertions(+), 2 deletions(-) diff --git a/basis/checksums/sha/sha-tests.factor b/basis/checksums/sha/sha-tests.factor index b70b5e7ba2..be431af311 100644 --- a/basis/checksums/sha/sha-tests.factor +++ b/basis/checksums/sha/sha-tests.factor @@ -1,5 +1,6 @@ -USING: arrays kernel math namespaces sequences tools.test -checksums.sha checksums ; +USING: arrays checksums checksums.sha checksums.sha.private +io.encodings.binary io.streams.byte-array kernel math +namespaces sequences tools.test ; IN: checksums.sha.tests : test-checksum ( text identifier -- checksum ) @@ -45,3 +46,25 @@ IN: checksums.sha.tests ! [ "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909" ] ! [ "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" sha-512 test-checksum ] unit-test + +[ + t +] [ + "asdf" binary add-checksum-stream + [ get-checksum ] [ get-checksum ] bi = +] unit-test + +[ + t +] [ + "asdf" binary add-checksum-stream + [ get-checksum ] [ get-checksum ] bi = +] unit-test + +[ + t +] [ + "asdf" binary add-checksum-stream + [ get-checksum ] [ get-checksum ] bi = +] unit-test + From 02b769475bfbc1009fb6d2098801a4e4670b0e84 Mon Sep 17 00:00:00 2001 From: "U-C4\\Administrator" Date: Sun, 17 May 2009 20:29:32 -0500 Subject: [PATCH 17/18] fix duplicate using lines --- basis/cpu/x86/64/64.factor | 2 +- basis/io/backend/windows/windows.factor | 6 +++--- core/classes/predicate/predicate-docs.factor | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index ad1b487e44..b77539b7e7 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays kernel math namespaces make sequences system layouts alien alien.c-types alien.accessors alien.structs -slots splitting assocs combinators make locals cpu.x86.assembler +slots splitting assocs combinators locals cpu.x86.assembler cpu.x86 cpu.architecture compiler.constants compiler.codegen compiler.codegen.fixup compiler.cfg.instructions compiler.cfg.builder diff --git a/basis/io/backend/windows/windows.factor b/basis/io/backend/windows/windows.factor index 9f5c00cc5f..2e9aac2ac9 100755 --- a/basis/io/backend/windows/windows.factor +++ b/basis/io/backend/windows/windows.factor @@ -2,9 +2,9 @@ ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types arrays destructors io io.backend io.buffers io.files io.ports io.binary io.timeouts system -windows.errors strings kernel math namespaces sequences -windows.errors windows.kernel32 windows.shell32 windows.types -windows.winsock splitting continuations math.bitwise accessors ; +strings kernel math namespaces sequences windows.errors +windows.kernel32 windows.shell32 windows.types windows.winsock +splitting continuations math.bitwise accessors ; IN: io.backend.windows : set-inherit ( handle ? -- ) diff --git a/core/classes/predicate/predicate-docs.factor b/core/classes/predicate/predicate-docs.factor index 3ea0a24674..552ff209b8 100644 --- a/core/classes/predicate/predicate-docs.factor +++ b/core/classes/predicate/predicate-docs.factor @@ -1,6 +1,6 @@ USING: generic help.markup help.syntax kernel kernel.private namespaces sequences words arrays layouts help effects math -layouts classes.private classes compiler.units ; +classes.private classes compiler.units ; IN: classes.predicate ARTICLE: "predicates" "Predicate classes" From 349adff19eef71e7e0d5830ad4329a675b0417af Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 17 May 2009 20:32:43 -0500 Subject: [PATCH 18/18] fix checksum test -- short circuit so correct error is reported --- basis/checksums/openssl/openssl-tests.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/basis/checksums/openssl/openssl-tests.factor b/basis/checksums/openssl/openssl-tests.factor index 253069c952..2a160e1486 100644 --- a/basis/checksums/openssl/openssl-tests.factor +++ b/basis/checksums/openssl/openssl-tests.factor @@ -1,6 +1,6 @@ +USING: accessors byte-arrays checksums checksums.openssl +combinators.short-circuit kernel system tools.test ; IN: checksums.openssl.tests -USING: byte-arrays checksums.openssl checksums tools.test -accessors kernel system ; [ B{ 201 238 222 100 92 200 182 188 138 255 129 163 115 88 240 136 } @@ -22,7 +22,7 @@ accessors kernel system ; "Bad checksum test" >byte-array "no such checksum" checksum-bytes -] [ [ unknown-digest? ] [ name>> "no such checksum" = ] bi and ] +] [ { [ unknown-digest? ] [ name>> "no such checksum" = ] } 1&& ] must-fail-with [ ] [ image openssl-sha1 checksum-file drop ] unit-test