moving md5 state to a tuple, redoing hmac
U-C4\Administrator
parent
1e0ed4f4de
commit
052a0931d3
|
|
@ -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 <string> "Hi There" sequence>md5-hmac >string ] unit-test
|
||||
16 11 <string> "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 <string>
|
||||
50 HEX: dd <repetition> sequence>md5-hmac >string
|
||||
50 HEX: dd <repetition> md5 hmac-bytes >string
|
||||
] unit-test
|
||||
|
||||
[
|
||||
"g[\u00000b:\eM\u0000dfN\u000012Hr\u0000dal/c+\u0000fe\u0000d9W\u0000e9"
|
||||
] [
|
||||
16 11 <string> "Hi There" sequence>sha1-hmac >string
|
||||
16 11 <string> "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 <string>
|
||||
50 HEX: dd <repetition> sequence>sha1-hmac >string
|
||||
50 HEX: dd <repetition> sha1 hmac-bytes >string
|
||||
] unit-test
|
||||
|
||||
[ "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7" ]
|
||||
[ HEX: b 20 <string> sha-256 hmac-bytes >string ] unit-test
|
||||
|
|
@ -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
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: sha1-hmac ( Ko Ki stream -- hmac )
|
||||
initialize-sha1 process-sha1-block
|
||||
stream>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 <array> ;
|
||||
|
||||
MEMO: ipad ( -- seq ) 64 HEX: 36 <array> ;
|
||||
|
||||
: 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 <file-reader> ] dip hmac-stream ;
|
||||
|
||||
: hmac-bytes ( K path checksum -- value )
|
||||
[ binary <byte-reader> ] dip hmac-stream ;
|
||||
|
|
@ -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 )
|
||||
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 ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
SYMBOLS: a b c d old-a old-b old-c old-d ;
|
||||
: update-md5-state ( md5-state -- md5-state )
|
||||
{
|
||||
[ [ a>> ] [ ] [ 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 ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: sha1-hmac ( Ko Ki -- hmac )
|
||||
initialize-sha1 process-sha1-block
|
||||
stream>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 <array> ;
|
||||
|
||||
MEMO: opad ( -- seq ) 64 HEX: 5c <array> ;
|
||||
|
||||
: 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 <file-reader> stream>sha1-hmac ;
|
||||
|
||||
: sequence>sha1-hmac ( K sequence -- hmac )
|
||||
binary <byte-reader> stream>sha1-hmac ;
|
||||
|
||||
: stream>md5-hmac ( K stream -- hmac )
|
||||
[ init-hmac md5-hmac ] with-input-stream ;
|
||||
|
||||
: file>md5-hmac ( K path -- hmac )
|
||||
binary <file-reader> stream>md5-hmac ;
|
||||
|
||||
: sequence>md5-hmac ( K sequence -- hmac )
|
||||
binary <byte-reader> stream>md5-hmac ;
|
||||
Loading…
Reference in New Issue