From 6dabec9ed8b7f42a688ba9d0ba7b5b5d33fc3729 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 10 May 2009 23:06:33 -0500 Subject: [PATCH] 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 ;