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 ;