Merge branch 'checksums'
commit
400317affc
|
@ -10,6 +10,6 @@ CONSTANT: adler-32-modulus 65521
|
||||||
|
|
||||||
M: adler-32 checksum-bytes ( bytes checksum -- value )
|
M: adler-32 checksum-bytes ( bytes checksum -- value )
|
||||||
drop
|
drop
|
||||||
[ sum 1+ ]
|
[ sum 1 + ]
|
||||||
[ [ dup length [1,b] <reversed> v. ] [ length ] bi + ] bi
|
[ [ dup length [1,b] <reversed> v. ] [ length ] bi + ] bi
|
||||||
[ adler-32-modulus mod ] bi@ 16 shift bitor ;
|
[ adler-32-modulus mod ] bi@ 16 shift bitor ;
|
||||||
|
|
|
@ -0,0 +1,48 @@
|
||||||
|
USING: kernel io strings byte-arrays sequences namespaces math
|
||||||
|
parser checksums.hmac tools.test checksums.md5 checksums.sha
|
||||||
|
checksums ;
|
||||||
|
IN: checksums.hmac.tests
|
||||||
|
|
||||||
|
[
|
||||||
|
"\u000092\u000094rz68\u0000bb\u00001c\u000013\u0000f4\u00008e\u0000f8\u000015\u00008b\u0000fc\u00009d"
|
||||||
|
] [
|
||||||
|
16 11 <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?" 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> md5 hmac-bytes >string
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
"g[\u00000b:\eM\u0000dfN\u000012Hr\u0000dal/c+\u0000fe\u0000d9W\u0000e9"
|
||||||
|
] [
|
||||||
|
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?" 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> sha1 hmac-bytes >string
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ "b0344c61d8db38535ca8afceaf0bf12b881dc200c9833da726e9376c2e32cff7" ]
|
||||||
|
[ 20 HEX: b <string> "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
|
|
@ -0,0 +1,39 @@
|
||||||
|
! Copyright (C) 2008 Doug Coleman.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: accessors arrays checksums combinators fry io io.binary
|
||||||
|
io.encodings.binary io.files io.streams.byte-array kernel
|
||||||
|
locals math math.vectors memoize sequences ;
|
||||||
|
IN: checksums.hmac
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: seq-bitxor ( seq seq -- seq ) [ bitxor ] 2map ;
|
||||||
|
|
||||||
|
: opad ( checksum-state -- seq ) block-size>> HEX: 5c <array> ;
|
||||||
|
|
||||||
|
: ipad ( checksum-state -- seq ) block-size>> HEX: 36 <array> ;
|
||||||
|
|
||||||
|
:: init-K ( K checksum checksum-state -- o i )
|
||||||
|
checksum-state block-size>> K length <
|
||||||
|
[ K checksum checksum-bytes ] [ K ] if
|
||||||
|
checksum-state block-size>> 0 pad-tail
|
||||||
|
[ checksum-state opad seq-bitxor ]
|
||||||
|
[ checksum-state ipad seq-bitxor ] bi ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
:: hmac-stream ( K stream checksum -- value )
|
||||||
|
K checksum dup initialize-checksum-state
|
||||||
|
dup :> checksum-state
|
||||||
|
init-K :> Ki :> Ko
|
||||||
|
checksum-state Ki add-checksum-bytes
|
||||||
|
stream add-checksum-stream get-checksum
|
||||||
|
checksum initialize-checksum-state
|
||||||
|
Ko add-checksum-bytes swap add-checksum-bytes
|
||||||
|
get-checksum ;
|
||||||
|
|
||||||
|
: hmac-file ( K path checksum -- value )
|
||||||
|
[ binary <file-reader> ] dip hmac-stream ;
|
||||||
|
|
||||||
|
: hmac-bytes ( K seq checksum -- value )
|
||||||
|
[ binary <byte-reader> ] dip hmac-stream ;
|
|
@ -0,0 +1 @@
|
||||||
|
Doug Coleman
|
|
@ -0,0 +1,19 @@
|
||||||
|
! Copyright (C) 2009 Doug Coleman.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: tools.test checksums.interleave checksums.sha ;
|
||||||
|
IN: checksums.interleave.tests
|
||||||
|
|
||||||
|
[
|
||||||
|
B{
|
||||||
|
59 155 253 205 75 163 94 115 208 42 227 92 181 19 60 232
|
||||||
|
119 65 178 131 210 48 241 230 204 216 30 156 4 215 80 84 93
|
||||||
|
206 44 1 18 128 150 153
|
||||||
|
}
|
||||||
|
] [
|
||||||
|
B{
|
||||||
|
102 83 241 12 26 250 181 76 97 200 37 117 168 74 254 48 216
|
||||||
|
170 26 58 150 150 179 24 153 146 191 225 203 127 166 167
|
||||||
|
}
|
||||||
|
sha1 interleaved-checksum
|
||||||
|
] unit-test
|
||||||
|
|
|
@ -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 ;
|
|
@ -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
|
[ "d41d8cd98f00b204e9800998ecf8427e" ] [ "" >byte-array md5 checksum-bytes hex-string ] unit-test
|
||||||
[ "0cc175b9c0f1b6a831c399e269772661" ] [ "a" >byte-array md5 checksum-bytes hex-string ] unit-test
|
[ "0cc175b9c0f1b6a831c399e269772661" ] [ "a" >byte-array md5 checksum-bytes hex-string ] unit-test
|
||||||
|
@ -8,3 +10,24 @@ USING: kernel math namespaces checksums checksums.md5 tools.test byte-arrays ;
|
||||||
[ "d174ab98d277d9f5a5611c2c9f419d9f" ] [ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" >byte-array md5 checksum-bytes hex-string ] unit-test
|
[ "d174ab98d277d9f5a5611c2c9f419d9f" ] [ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" >byte-array md5 checksum-bytes hex-string ] unit-test
|
||||||
[ "57edf4a22be3c955ac49da2e2107b67a" ] [ "12345678901234567890123456789012345678901234567890123456789012345678901234567890" >byte-array md5 checksum-bytes hex-string ] unit-test
|
[ "57edf4a22be3c955ac49da2e2107b67a" ] [ "12345678901234567890123456789012345678901234567890123456789012345678901234567890" >byte-array md5 checksum-bytes hex-string ] unit-test
|
||||||
|
|
||||||
|
|
||||||
|
[
|
||||||
|
t
|
||||||
|
] [
|
||||||
|
<md5-state> "asdf" add-checksum-bytes
|
||||||
|
[ get-checksum ] [ get-checksum ] bi =
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
t
|
||||||
|
] [
|
||||||
|
<md5-state> "" add-checksum-bytes
|
||||||
|
[ get-checksum ] [ get-checksum ] bi =
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[
|
||||||
|
t
|
||||||
|
] [
|
||||||
|
<md5-state> "asdf" binary <byte-reader> add-checksum-stream
|
||||||
|
[ get-checksum ] [ get-checksum ] bi =
|
||||||
|
] unit-test
|
||||||
|
|
|
@ -3,57 +3,50 @@
|
||||||
USING: kernel io io.binary io.files io.streams.byte-array math
|
USING: kernel io io.binary io.files io.streams.byte-array math
|
||||||
math.functions math.parser namespaces splitting grouping strings
|
math.functions math.parser namespaces splitting grouping strings
|
||||||
sequences byte-arrays locals sequences.private macros fry
|
sequences byte-arrays locals sequences.private macros fry
|
||||||
io.encodings.binary math.bitwise checksums
|
io.encodings.binary math.bitwise checksums accessors
|
||||||
checksums.common checksums.stream combinators ;
|
checksums.common checksums.stream combinators combinators.smart ;
|
||||||
IN: checksums.md5
|
IN: checksums.md5
|
||||||
|
|
||||||
! See http://www.faqs.org/rfcs/rfc1321.html
|
SINGLETON: md5
|
||||||
|
|
||||||
|
INSTANCE: md5 stream-checksum
|
||||||
|
|
||||||
|
TUPLE: md5-state < checksum-state state old-state ;
|
||||||
|
|
||||||
|
: <md5-state> ( -- md5 )
|
||||||
|
md5-state new-checksum-state
|
||||||
|
64 >>block-size
|
||||||
|
{ HEX: 67452301 HEX: efcdab89 HEX: 98badcfe HEX: 10325476 }
|
||||||
|
[ clone >>state ] [ >>old-state ] bi ;
|
||||||
|
|
||||||
|
M: md5 initialize-checksum-state drop <md5-state> ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
SYMBOLS: a b c d old-a old-b old-c old-d ;
|
: v-w+ ( v1 v2 -- v3 ) [ w+ ] 2map ;
|
||||||
|
|
||||||
|
: update-md5 ( md5 -- )
|
||||||
|
[ state>> ] [ old-state>> v-w+ dup clone ] [ ] tri
|
||||||
|
[ (>>old-state) ] [ (>>state) ] bi ; inline
|
||||||
|
|
||||||
: T ( N -- Y )
|
: T ( N -- Y )
|
||||||
sin abs 32 2^ * >integer ; foldable
|
sin abs 32 2^ * >integer ; inline
|
||||||
|
|
||||||
: initialize-md5 ( -- )
|
:: F ( X Y Z -- FXYZ )
|
||||||
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) = XY v not(X) Z
|
#! F(X,Y,Z) = XY v not(X) Z
|
||||||
pick bitnot bitand [ bitand ] [ bitor ] bi* ;
|
X Y bitand X bitnot Z bitand bitor ; inline
|
||||||
|
|
||||||
: G ( X Y Z -- GXYZ )
|
:: G ( X Y Z -- GXYZ )
|
||||||
#! G(X,Y,Z) = XZ v Y not(Z)
|
#! G(X,Y,Z) = XZ v Y not(Z)
|
||||||
dup bitnot rot bitand [ bitand ] [ bitor ] bi* ;
|
X Z bitand Y Z bitnot bitand bitor ; inline
|
||||||
|
|
||||||
: H ( X Y Z -- HXYZ )
|
: H ( X Y Z -- HXYZ )
|
||||||
#! H(X,Y,Z) = X xor Y xor Z
|
#! H(X,Y,Z) = X xor Y xor Z
|
||||||
bitxor bitxor ;
|
bitxor bitxor ; inline
|
||||||
|
|
||||||
: I ( X Y Z -- IXYZ )
|
:: I ( X Y Z -- IXYZ )
|
||||||
#! I(X,Y,Z) = Y xor (X v not(Z))
|
#! I(X,Y,Z) = Y xor (X v not(Z))
|
||||||
rot swap bitnot bitor bitxor ;
|
Z bitnot X bitor Y bitxor ; inline
|
||||||
|
|
||||||
CONSTANT: S11 7
|
CONSTANT: S11 7
|
||||||
CONSTANT: S12 12
|
CONSTANT: S12 12
|
||||||
|
@ -72,10 +65,27 @@ CONSTANT: S42 10
|
||||||
CONSTANT: S43 15
|
CONSTANT: S43 15
|
||||||
CONSTANT: S44 21
|
CONSTANT: S44 21
|
||||||
|
|
||||||
MACRO: with-md5-round ( ops func -- )
|
CONSTANT: a 0
|
||||||
'[ [ _ (ABCD) ] compose ] map '[ _ cleave ] ;
|
CONSTANT: b 1
|
||||||
|
CONSTANT: c 2
|
||||||
|
CONSTANT: d 3
|
||||||
|
|
||||||
: (process-md5-block-F) ( block -- )
|
:: (ABCD) ( x V a b c d k s i quot -- )
|
||||||
|
#! a = b + ((a + F(b,c,d) + X[k] + T[i]) <<< s)
|
||||||
|
a V [
|
||||||
|
b V nth
|
||||||
|
c V nth
|
||||||
|
d V nth quot call w+
|
||||||
|
k x nth w+
|
||||||
|
i T w+
|
||||||
|
s bitroll-32
|
||||||
|
b V nth w+
|
||||||
|
] change-nth ; inline
|
||||||
|
|
||||||
|
MACRO: with-md5-round ( ops quot -- )
|
||||||
|
'[ [ _ (ABCD) ] compose ] map '[ _ 2cleave ] ;
|
||||||
|
|
||||||
|
: (process-md5-block-F) ( block v -- )
|
||||||
{
|
{
|
||||||
[ a b c d 0 S11 1 ]
|
[ a b c d 0 S11 1 ]
|
||||||
[ d a b c 1 S12 2 ]
|
[ d a b c 1 S12 2 ]
|
||||||
|
@ -93,9 +103,9 @@ MACRO: with-md5-round ( ops func -- )
|
||||||
[ d a b c 13 S12 14 ]
|
[ d a b c 13 S12 14 ]
|
||||||
[ c d a b 14 S13 15 ]
|
[ c d a b 14 S13 15 ]
|
||||||
[ b c d a 15 S14 16 ]
|
[ 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 ]
|
[ a b c d 1 S21 17 ]
|
||||||
[ d a b c 6 S22 18 ]
|
[ d a b c 6 S22 18 ]
|
||||||
|
@ -113,9 +123,9 @@ MACRO: with-md5-round ( ops func -- )
|
||||||
[ d a b c 2 S22 30 ]
|
[ d a b c 2 S22 30 ]
|
||||||
[ c d a b 7 S23 31 ]
|
[ c d a b 7 S23 31 ]
|
||||||
[ b c d a 12 S24 32 ]
|
[ 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 ]
|
[ a b c d 5 S31 33 ]
|
||||||
[ d a b c 8 S32 34 ]
|
[ d a b c 8 S32 34 ]
|
||||||
|
@ -133,9 +143,9 @@ MACRO: with-md5-round ( ops func -- )
|
||||||
[ d a b c 12 S32 46 ]
|
[ d a b c 12 S32 46 ]
|
||||||
[ c d a b 15 S33 47 ]
|
[ c d a b 15 S33 47 ]
|
||||||
[ b c d a 2 S34 48 ]
|
[ 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 ]
|
[ a b c d 0 S41 49 ]
|
||||||
[ d a b c 7 S42 50 ]
|
[ d a b c 7 S42 50 ]
|
||||||
|
@ -153,38 +163,34 @@ MACRO: with-md5-round ( ops func -- )
|
||||||
[ d a b c 11 S42 62 ]
|
[ d a b c 11 S42 62 ]
|
||||||
[ c d a b 2 S43 63 ]
|
[ c d a b 2 S43 63 ]
|
||||||
[ b c d a 9 S44 64 ]
|
[ b c d a 9 S44 64 ]
|
||||||
} [ I ] with-md5-round ;
|
} [ I ] with-md5-round ; inline
|
||||||
|
|
||||||
: (process-md5-block) ( block -- )
|
M: md5-state checksum-block ( block state -- )
|
||||||
4 <groups> [ le> ] map {
|
[
|
||||||
[ (process-md5-block-F) ]
|
[ 4 <groups> [ le> ] map ] [ state>> ] bi* {
|
||||||
[ (process-md5-block-G) ]
|
[ (process-md5-block-F) ]
|
||||||
[ (process-md5-block-H) ]
|
[ (process-md5-block-G) ]
|
||||||
[ (process-md5-block-I) ]
|
[ (process-md5-block-H) ]
|
||||||
} cleave
|
[ (process-md5-block-I) ]
|
||||||
|
} 2cleave
|
||||||
update-md ;
|
|
||||||
|
|
||||||
: process-md5-block ( str -- )
|
|
||||||
dup length [ bytes-read [ + ] change ] keep 64 = [
|
|
||||||
(process-md5-block)
|
|
||||||
] [
|
] [
|
||||||
f bytes-read get pad-last-block
|
nip update-md5
|
||||||
[ (process-md5-block) ] each
|
] 2bi ;
|
||||||
] if ;
|
|
||||||
|
|
||||||
: stream>md5 ( -- )
|
|
||||||
64 read [ process-md5-block ] keep
|
|
||||||
length 64 = [ stream>md5 ] when ;
|
|
||||||
|
|
||||||
: get-md5 ( -- str )
|
: md5>checksum ( md5 -- bytes )
|
||||||
[ a b c d ] [ get 4 >le ] map concat >byte-array ;
|
state>> [ 4 >le ] map B{ } concat-as ;
|
||||||
|
|
||||||
|
M: md5-state clone ( md5 -- new-md5 )
|
||||||
|
call-next-method
|
||||||
|
[ clone ] change-state
|
||||||
|
[ clone ] change-old-state ;
|
||||||
|
|
||||||
|
M: md5-state get-checksum ( md5 -- bytes )
|
||||||
|
clone [ bytes>> f ] [ bytes-read>> pad-last-block ] [ ] tri
|
||||||
|
[ [ checksum-block ] curry each ] [ md5>checksum ] bi ;
|
||||||
|
|
||||||
|
M: md5 checksum-stream ( stream checksum -- byte-array )
|
||||||
|
drop
|
||||||
|
[ <md5-state> ] dip add-checksum-stream get-checksum ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
SINGLETON: md5
|
|
||||||
|
|
||||||
INSTANCE: md5 stream-checksum
|
|
||||||
|
|
||||||
M: md5 checksum-stream ( stream -- byte-array )
|
|
||||||
drop [ initialize-md5 stream>md5 get-md5 ] with-input-stream ;
|
|
||||||
|
|
|
@ -32,6 +32,6 @@ ARTICLE: "checksums.openssl" "OpenSSL checksums"
|
||||||
"An example where we compute the SHA1 checksum of a string using the OpenSSL implementation of SHA1:"
|
"An example where we compute the SHA1 checksum of a string using the OpenSSL implementation of SHA1:"
|
||||||
{ $example "USING: byte-arrays checksums checksums.openssl ;" "\"hello world\" >byte-array openssl-sha1 checksum-bytes hex-string ." "\"2aae6c35c94fcfb415dbe95f408b9ce91ee846ed\"" }
|
{ $example "USING: byte-arrays checksums checksums.openssl ;" "\"hello world\" >byte-array openssl-sha1 checksum-bytes hex-string ." "\"2aae6c35c94fcfb415dbe95f408b9ce91ee846ed\"" }
|
||||||
"If we use the Factor implementation, we get the same result, just slightly slower:"
|
"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"
|
ABOUT: "checksums.openssl"
|
||||||
|
|
|
@ -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"
|
|
@ -1,10 +1,17 @@
|
||||||
USING: arrays kernel math namespaces sequences tools.test
|
USING: arrays kernel math namespaces sequences tools.test
|
||||||
checksums.sha2 checksums ;
|
checksums.sha checksums ;
|
||||||
IN: checksums.sha2.tests
|
IN: checksums.sha.tests
|
||||||
|
|
||||||
: test-checksum ( text identifier -- checksum )
|
: test-checksum ( text identifier -- checksum )
|
||||||
checksum-bytes hex-string ;
|
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 <array> concat sha1 checksum-bytes hex-string ] unit-test
|
||||||
|
|
||||||
|
|
||||||
[ "75388b16512776cc5dba5da1fd890150b0c6455cb4f58b1952522525" ]
|
[ "75388b16512776cc5dba5da1fd890150b0c6455cb4f58b1952522525" ]
|
||||||
[
|
[
|
||||||
"abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
|
"abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
|
||||||
|
@ -36,7 +43,5 @@ IN: checksums.sha2.tests
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
! [ "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909" ]
|
! [ "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909" ]
|
||||||
! [ "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" sha-512 test-checksum ] unit-test
|
! [ "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" sha-512 test-checksum ] unit-test
|
|
@ -3,16 +3,40 @@
|
||||||
USING: kernel splitting grouping math sequences namespaces make
|
USING: kernel splitting grouping math sequences namespaces make
|
||||||
io.binary math.bitwise checksums checksums.common
|
io.binary math.bitwise checksums checksums.common
|
||||||
sbufs strings combinators.smart math.ranges fry combinators
|
sbufs strings combinators.smart math.ranges fry combinators
|
||||||
accessors locals ;
|
accessors locals checksums.stream multiline literals
|
||||||
IN: checksums.sha2
|
generalizations ;
|
||||||
|
IN: checksums.sha
|
||||||
|
|
||||||
|
SINGLETON: sha1
|
||||||
|
INSTANCE: sha1 stream-checksum
|
||||||
|
|
||||||
SINGLETON: sha-224
|
SINGLETON: sha-224
|
||||||
SINGLETON: sha-256
|
SINGLETON: sha-256
|
||||||
|
|
||||||
INSTANCE: sha-224 checksum
|
INSTANCE: sha-224 stream-checksum
|
||||||
INSTANCE: sha-256 checksum
|
INSTANCE: sha-256 stream-checksum
|
||||||
|
|
||||||
TUPLE: sha2-state K H word-size block-size ;
|
TUPLE: sha1-state < checksum-state K H W word-size ;
|
||||||
|
|
||||||
|
CONSTANT: initial-H-sha1
|
||||||
|
{
|
||||||
|
HEX: 67452301
|
||||||
|
HEX: efcdab89
|
||||||
|
HEX: 98badcfe
|
||||||
|
HEX: 10325476
|
||||||
|
HEX: c3d2e1f0
|
||||||
|
}
|
||||||
|
|
||||||
|
CONSTANT: K-sha1
|
||||||
|
$[
|
||||||
|
20 HEX: 5a827999 <repetition>
|
||||||
|
20 HEX: 6ed9eba1 <repetition>
|
||||||
|
20 HEX: 8f1bbcdc <repetition>
|
||||||
|
20 HEX: ca62c1d6 <repetition>
|
||||||
|
4 { } nappend-as
|
||||||
|
]
|
||||||
|
|
||||||
|
TUPLE: sha2-state < checksum-state K H word-size ;
|
||||||
|
|
||||||
TUPLE: sha2-short < sha2-state ;
|
TUPLE: sha2-short < sha2-state ;
|
||||||
|
|
||||||
|
@ -22,6 +46,11 @@ TUPLE: sha-224-state < sha2-short ;
|
||||||
|
|
||||||
TUPLE: sha-256-state < sha2-short ;
|
TUPLE: sha-256-state < sha2-short ;
|
||||||
|
|
||||||
|
M: sha2-state clone
|
||||||
|
call-next-method
|
||||||
|
[ clone ] change-H
|
||||||
|
[ clone ] change-K ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
CONSTANT: a 0
|
CONSTANT: a 0
|
||||||
|
@ -116,6 +145,33 @@ CONSTANT: K-384
|
||||||
|
|
||||||
ALIAS: K-512 K-384
|
ALIAS: K-512 K-384
|
||||||
|
|
||||||
|
: <sha1-state> ( -- sha1-state )
|
||||||
|
sha1-state new-checksum-state
|
||||||
|
64 >>block-size
|
||||||
|
K-sha1 >>K
|
||||||
|
initial-H-sha1 >>H
|
||||||
|
4 >>word-size ;
|
||||||
|
|
||||||
|
: <sha-224-state> ( -- sha2-state )
|
||||||
|
sha-224-state new-checksum-state
|
||||||
|
64 >>block-size
|
||||||
|
K-256 >>K
|
||||||
|
initial-H-224 >>H
|
||||||
|
4 >>word-size ;
|
||||||
|
|
||||||
|
: <sha-256-state> ( -- sha2-state )
|
||||||
|
sha-256-state new-checksum-state
|
||||||
|
64 >>block-size
|
||||||
|
K-256 >>K
|
||||||
|
initial-H-256 >>H
|
||||||
|
4 >>word-size ;
|
||||||
|
|
||||||
|
M: sha1 initialize-checksum-state drop <sha1-state> ;
|
||||||
|
|
||||||
|
M: sha-224 initialize-checksum-state drop <sha-224-state> ;
|
||||||
|
|
||||||
|
M: sha-256 initialize-checksum-state drop <sha-256-state> ;
|
||||||
|
|
||||||
: s0-256 ( x -- x' )
|
: s0-256 ( x -- x' )
|
||||||
[
|
[
|
||||||
[ -7 bitroll-32 ]
|
[ -7 bitroll-32 ]
|
||||||
|
@ -172,7 +228,7 @@ ALIAS: K-512 K-384
|
||||||
[ -41 bitroll-64 ] tri
|
[ -41 bitroll-64 ] tri
|
||||||
] [ bitxor ] reduce-outputs ; inline
|
] [ bitxor ] reduce-outputs ; inline
|
||||||
|
|
||||||
: process-M-256 ( n seq -- )
|
: prepare-M-256 ( n seq -- )
|
||||||
{
|
{
|
||||||
[ [ 16 - ] dip nth ]
|
[ [ 16 - ] dip nth ]
|
||||||
[ [ 15 - ] dip nth s0-256 ]
|
[ [ 15 - ] dip nth s0-256 ]
|
||||||
|
@ -181,7 +237,7 @@ ALIAS: K-512 K-384
|
||||||
[ ]
|
[ ]
|
||||||
} 2cleave set-nth ; inline
|
} 2cleave set-nth ; inline
|
||||||
|
|
||||||
: process-M-512 ( n seq -- )
|
: prepare-M-512 ( n seq -- )
|
||||||
{
|
{
|
||||||
[ [ 16 - ] dip nth ]
|
[ [ 16 - ] dip nth ]
|
||||||
[ [ 15 - ] dip nth s0-512 ]
|
[ [ 15 - ] dip nth s0-512 ]
|
||||||
|
@ -201,26 +257,6 @@ ALIAS: K-512 K-384
|
||||||
|
|
||||||
GENERIC: pad-initial-bytes ( string sha2 -- padded-string )
|
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 <string> % ]
|
|
||||||
[ 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 <string> % ]
|
|
||||||
[ 3 shift 8 >be % ] bi
|
|
||||||
] "" make append ;
|
|
||||||
|
|
||||||
: seq>byte-array ( seq n -- string )
|
|
||||||
'[ _ >be ] map B{ } join ;
|
|
||||||
|
|
||||||
:: T1-256 ( n M H sha2 -- T1 )
|
:: T1-256 ( n M H sha2 -- T1 )
|
||||||
n M nth
|
n M nth
|
||||||
n sha2 K>> nth +
|
n sha2 K>> nth +
|
||||||
|
@ -257,7 +293,7 @@ M: sha2-long pad-initial-bytes ( string sha2 -- padded-string )
|
||||||
[ word-size>> <sliced-groups> [ be> ] map ]
|
[ word-size>> <sliced-groups> [ be> ] map ]
|
||||||
[
|
[
|
||||||
block-size>> [ 0 pad-tail 16 ] keep [a,b) over
|
block-size>> [ 0 pad-tail 16 ] keep [a,b) over
|
||||||
'[ _ process-M-256 ] each
|
'[ _ prepare-M-256 ] each
|
||||||
] bi ; inline
|
] bi ; inline
|
||||||
|
|
||||||
:: process-chunk ( M block-size cloned-H sha2 -- )
|
:: process-chunk ( M block-size cloned-H sha2 -- )
|
||||||
|
@ -266,41 +302,110 @@ M: sha2-long pad-initial-bytes ( string sha2 -- padded-string )
|
||||||
cloned-H T2-256
|
cloned-H T2-256
|
||||||
cloned-H update-H
|
cloned-H update-H
|
||||||
] each
|
] each
|
||||||
cloned-H sha2 H>> [ w+ ] 2map sha2 (>>H) ; inline
|
sha2 [ cloned-H [ w+ ] 2map ] change-H drop ; inline
|
||||||
|
|
||||||
: sha2-steps ( sliced-groups state -- )
|
M: sha2-short checksum-block
|
||||||
'[
|
[ prepare-message-schedule ]
|
||||||
_
|
[ [ block-size>> ] [ H>> clone ] [ ] tri process-chunk ] bi ;
|
||||||
[ prepare-message-schedule ]
|
|
||||||
[ [ block-size>> ] [ H>> clone ] [ ] tri process-chunk ] bi
|
|
||||||
] each ;
|
|
||||||
|
|
||||||
: byte-array>sha2 ( bytes state -- )
|
: seq>byte-array ( seq n -- string )
|
||||||
[ [ pad-initial-bytes ] [ nip block-size>> ] 2bi <sliced-groups> ]
|
'[ _ >be ] map B{ } join ;
|
||||||
[ sha2-steps ] bi ;
|
|
||||||
|
|
||||||
: <sha-224-state> ( -- sha2-state )
|
: sha1>checksum ( sha2 -- bytes )
|
||||||
sha-224-state new
|
H>> 4 seq>byte-array ;
|
||||||
K-256 >>K
|
|
||||||
initial-H-224 >>H
|
|
||||||
4 >>word-size
|
|
||||||
64 >>block-size ;
|
|
||||||
|
|
||||||
: <sha-256-state> ( -- sha2-state )
|
: sha-224>checksum ( sha2 -- bytes )
|
||||||
sha-256-state new
|
H>> 7 head 4 seq>byte-array ;
|
||||||
K-256 >>K
|
|
||||||
initial-H-256 >>H
|
: sha-256>checksum ( sha2 -- bytes )
|
||||||
4 >>word-size
|
H>> 4 seq>byte-array ;
|
||||||
64 >>block-size ;
|
|
||||||
|
: pad-last-short-block ( state -- )
|
||||||
|
[ bytes>> t ] [ bytes-read>> pad-last-block ] [ ] tri
|
||||||
|
[ checksum-block ] curry each ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
M: sha-224 checksum-bytes
|
M: sha-224-state get-checksum
|
||||||
drop <sha-224-state>
|
clone
|
||||||
[ byte-array>sha2 ]
|
[ pad-last-short-block ] [ sha-224>checksum ] bi ;
|
||||||
[ H>> 7 head 4 seq>byte-array ] bi ;
|
|
||||||
|
|
||||||
M: sha-256 checksum-bytes
|
M: sha-256-state get-checksum
|
||||||
drop <sha-256-state>
|
clone
|
||||||
[ byte-array>sha2 ]
|
[ pad-last-short-block ] [ sha-256>checksum ] bi ;
|
||||||
[ H>> 4 seq>byte-array ] bi ;
|
|
||||||
|
M: sha-224 checksum-stream ( stream checksum -- byte-array )
|
||||||
|
drop
|
||||||
|
[ <sha-224-state> ] dip add-checksum-stream get-checksum ;
|
||||||
|
|
||||||
|
M: sha-256 checksum-stream ( stream checksum -- byte-array )
|
||||||
|
drop
|
||||||
|
[ <sha-256-state> ] 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 <sliced-groups> [ 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
|
||||||
|
[ <sha1-state> ] dip add-checksum-stream get-checksum ;
|
|
@ -0,0 +1 @@
|
||||||
|
SHA checksum algorithms
|
|
@ -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"
|
|
|
@ -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 <array> 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
|
|
|
@ -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 <array> %
|
|
||||||
20 HEX: 6ed9eba1 <array> %
|
|
||||||
20 HEX: 8f1bbcdc <array> %
|
|
||||||
20 HEX: ca62c1d6 <array> %
|
|
||||||
] { } 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 <slice> 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 <slice> [ 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 <vector> 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 ;
|
|
|
@ -1 +0,0 @@
|
||||||
SHA1 checksum algorithm
|
|
|
@ -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"
|
|
|
@ -1 +0,0 @@
|
||||||
SHA2 checksum algorithm
|
|
|
@ -75,18 +75,20 @@ CONSTANT: length-table
|
||||||
19 23 27 31
|
19 23 27 31
|
||||||
35 43 51 59
|
35 43 51 59
|
||||||
67 83 99 115
|
67 83 99 115
|
||||||
131 163 195 227
|
131 163 195 227 258
|
||||||
}
|
}
|
||||||
|
|
||||||
CONSTANT: dist-table
|
CONSTANT: dist-table
|
||||||
{ 1 2 3 4
|
{
|
||||||
5 7 9 13
|
1 2 3 4
|
||||||
17 25 33 49
|
5 7 9 13
|
||||||
65 97 129 193
|
17 25 33 49
|
||||||
257 385 513 769
|
65 97 129 193
|
||||||
1025 1537 2049 3073
|
257 385 513 769
|
||||||
4097 6145 8193 12289
|
1025 1537 2049 3073
|
||||||
16385 24577 }
|
4097 6145 8193 12289
|
||||||
|
16385 24577
|
||||||
|
}
|
||||||
|
|
||||||
: nth* ( n seq -- elt )
|
: nth* ( n seq -- elt )
|
||||||
[ length 1- swap - ] [ nth ] bi ;
|
[ length 1- swap - ] [ nth ] bi ;
|
||||||
|
@ -156,7 +158,7 @@ CONSTANT: dist-table
|
||||||
[ 1 bitstream bs:read 0 = ]
|
[ 1 bitstream bs:read 0 = ]
|
||||||
[
|
[
|
||||||
bitstream
|
bitstream
|
||||||
2 bitstream bs:read ! B
|
2 bitstream bs:read
|
||||||
{
|
{
|
||||||
{ 0 [ inflate-raw ] }
|
{ 0 [ inflate-raw ] }
|
||||||
{ 1 [ inflate-static ] }
|
{ 1 [ inflate-static ] }
|
||||||
|
@ -206,6 +208,5 @@ PRIVATE>
|
||||||
|
|
||||||
: zlib-inflate ( bytes -- bytes )
|
: zlib-inflate ( bytes -- bytes )
|
||||||
bs:<lsb0-bit-reader>
|
bs:<lsb0-bit-reader>
|
||||||
[ check-zlib-header ]
|
[ check-zlib-header ] [ inflate-loop ] bi
|
||||||
[ inflate-loop ] bi
|
|
||||||
inflate-lz77 ;
|
inflate-lz77 ;
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: assocs classes help.markup help.syntax kernel
|
USING: assocs classes help.markup help.syntax kernel
|
||||||
quotations strings words words.symbol furnace.auth.providers.db
|
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 ;
|
http multiline ;
|
||||||
IN: furnace.auth
|
IN: furnace.auth
|
||||||
|
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
USING: accessors assocs namespaces kernel sequences sets
|
USING: accessors assocs namespaces kernel sequences sets
|
||||||
destructors combinators fry logging
|
destructors combinators fry logging
|
||||||
io.encodings.utf8 io.encodings.string io.binary random
|
io.encodings.utf8 io.encodings.string io.binary random
|
||||||
checksums checksums.sha2 urls
|
checksums checksums.sha urls
|
||||||
html.forms
|
html.forms
|
||||||
http.server
|
http.server
|
||||||
http.server.filters
|
http.server.filters
|
||||||
|
|
|
@ -17,9 +17,9 @@ CONSTANT: test-41 "vocab:images/test-images/41red24bit.bmp"
|
||||||
CONSTANT: test-42 "vocab:images/test-images/42red24bit.bmp"
|
CONSTANT: test-42 "vocab:images/test-images/42red24bit.bmp"
|
||||||
CONSTANT: test-43 "vocab:images/test-images/43red24bit.bmp"
|
CONSTANT: test-43 "vocab:images/test-images/43red24bit.bmp"
|
||||||
|
|
||||||
{
|
${
|
||||||
$ test-bitmap8
|
test-bitmap8
|
||||||
$ test-bitmap24
|
test-bitmap24
|
||||||
"vocab:ui/render/test/reference.bmp"
|
"vocab:ui/render/test/reference.bmp"
|
||||||
} [ [ ] swap [ load-image drop ] curry unit-test ] each
|
} [ [ ] swap [ load-image drop ] curry unit-test ] each
|
||||||
|
|
||||||
|
@ -34,11 +34,11 @@ CONSTANT: test-43 "vocab:images/test-images/43red24bit.bmp"
|
||||||
[
|
[
|
||||||
t
|
t
|
||||||
] [
|
] [
|
||||||
{
|
${
|
||||||
$ test-40
|
test-40
|
||||||
$ test-41
|
test-41
|
||||||
$ test-42
|
test-42
|
||||||
$ test-43
|
test-43
|
||||||
$ test-bitmap24
|
test-bitmap24
|
||||||
} [ test-bitmap-save ] all?
|
} [ test-bitmap-save ] all?
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
! Copyright (C) 2008 John Benediktsson
|
! Copyright (C) 2008 John Benediktsson
|
||||||
! See http://factorcode.org/license.txt for BSD license
|
! See http://factorcode.org/license.txt for BSD license
|
||||||
|
USING: byte-arrays checksums checksums.md5 checksums.sha
|
||||||
USING: byte-arrays checksums checksums.md5 checksums.sha1
|
|
||||||
kernel math math.parser math.ranges random unicode.case
|
kernel math math.parser math.ranges random unicode.case
|
||||||
sequences strings system io.binary ;
|
sequences strings system io.binary ;
|
||||||
|
|
||||||
|
|
|
@ -47,8 +47,7 @@ $nl
|
||||||
"Checksum implementations:"
|
"Checksum implementations:"
|
||||||
{ $subsection "checksums.crc32" }
|
{ $subsection "checksums.crc32" }
|
||||||
{ $vocab-subsection "MD5 checksum" "checksums.md5" }
|
{ $vocab-subsection "MD5 checksum" "checksums.md5" }
|
||||||
{ $vocab-subsection "SHA1 checksum" "checksums.sha1" }
|
{ $vocab-subsection "SHA checksums" "checksums.sha" }
|
||||||
{ $vocab-subsection "SHA2 checksum" "checksums.sha2" }
|
|
||||||
{ $vocab-subsection "Adler-32 checksum" "checksums.adler-32" }
|
{ $vocab-subsection "Adler-32 checksum" "checksums.adler-32" }
|
||||||
{ $vocab-subsection "OpenSSL checksums" "checksums.openssl" } ;
|
{ $vocab-subsection "OpenSSL checksums" "checksums.openssl" } ;
|
||||||
|
|
||||||
|
|
|
@ -1,11 +1,46 @@
|
||||||
! Copyright (c) 2008 Slava Pestov
|
! Copyright (c) 2008 Slava Pestov
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: sequences math.parser io io.backend io.files
|
USING: accessors io io.backend io.files kernel math math.parser
|
||||||
kernel ;
|
sequences vectors io.encodings.binary quotations ;
|
||||||
IN: checksums
|
IN: checksums
|
||||||
|
|
||||||
MIXIN: checksum
|
MIXIN: checksum
|
||||||
|
|
||||||
|
TUPLE: checksum-state bytes-read block-size bytes ;
|
||||||
|
|
||||||
|
: new-checksum-state ( class -- checksum-state )
|
||||||
|
new
|
||||||
|
0 >>bytes-read
|
||||||
|
V{ } clone >>bytes ; inline
|
||||||
|
|
||||||
|
M: checksum-state clone
|
||||||
|
call-next-method
|
||||||
|
[ clone ] change-bytes ;
|
||||||
|
|
||||||
|
GENERIC: initialize-checksum-state ( class -- checksum-state )
|
||||||
|
|
||||||
|
GENERIC: checksum-block ( bytes checksum -- )
|
||||||
|
|
||||||
|
GENERIC: get-checksum ( checksum -- value )
|
||||||
|
|
||||||
|
: add-checksum-bytes ( checksum-state data -- checksum-state )
|
||||||
|
over bytes>> [ push-all ] keep
|
||||||
|
[ dup length pick block-size>> >= ]
|
||||||
|
[
|
||||||
|
64 cut-slice [
|
||||||
|
over [ checksum-block ]
|
||||||
|
[ [ 64 + ] change-bytes-read drop ] bi
|
||||||
|
] dip
|
||||||
|
] while >vector [ >>bytes ] [ length [ + ] curry change-bytes-read ] bi ;
|
||||||
|
|
||||||
|
: add-checksum-stream ( checksum-state stream -- checksum-state )
|
||||||
|
[
|
||||||
|
[ [ swap add-checksum-bytes drop ] curry each-block ] keep
|
||||||
|
] with-input-stream ;
|
||||||
|
|
||||||
|
: add-checksum-file ( checksum-state path -- checksum-state )
|
||||||
|
binary <file-reader> add-checksum-stream ;
|
||||||
|
|
||||||
GENERIC: checksum-bytes ( bytes checksum -- value )
|
GENERIC: checksum-bytes ( bytes checksum -- value )
|
||||||
|
|
||||||
GENERIC: checksum-stream ( stream checksum -- value )
|
GENERIC: checksum-stream ( stream checksum -- value )
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
USING: checksums checksums.sha1 sequences byte-arrays kernel ;
|
USING: checksums checksums.sha sequences byte-arrays kernel ;
|
||||||
IN: benchmark.sha1
|
IN: benchmark.sha1
|
||||||
|
|
||||||
: sha1-file ( -- )
|
: sha1-file ( -- )
|
||||||
|
|
|
@ -1 +0,0 @@
|
||||||
Doug Coleman
|
|
|
@ -1,38 +0,0 @@
|
||||||
USING: kernel io strings byte-arrays sequences namespaces math
|
|
||||||
parser crypto.hmac tools.test ;
|
|
||||||
IN: crypto.hmac.tests
|
|
||||||
|
|
||||||
[
|
|
||||||
"\u000092\u000094rz68\u0000bb\u00001c\u000013\u0000f4\u00008e\u0000f8\u000015\u00008b\u0000fc\u00009d"
|
|
||||||
] [
|
|
||||||
16 11 <string> "Hi There" sequence>md5-hmac >string ] unit-test
|
|
||||||
|
|
||||||
[ "u\u00000cx>j\u0000b0\u0000b5\u000003\u0000ea\u0000a8n1\n]\u0000b78" ]
|
|
||||||
[ "Jefe" "what do ya want for nothing?" sequence>md5-hmac >string ] unit-test
|
|
||||||
|
|
||||||
[
|
|
||||||
"V\u0000be4R\u00001d\u000014L\u000088\u0000db\u0000b8\u0000c73\u0000f0\u0000e8\u0000b3\u0000f6"
|
|
||||||
]
|
|
||||||
[
|
|
||||||
16 HEX: aa <string>
|
|
||||||
50 HEX: dd <repetition> sequence>md5-hmac >string
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[
|
|
||||||
"g[\u00000b:\eM\u0000dfN\u000012Hr\u0000dal/c+\u0000fe\u0000d9W\u0000e9"
|
|
||||||
] [
|
|
||||||
16 11 <string> "Hi There" sequence>sha1-hmac >string
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[
|
|
||||||
"\u0000ef\u0000fc\u0000dfj\u0000e5\u0000eb/\u0000a2\u0000d2t\u000016\u0000d5\u0000f1\u000084\u0000df\u00009c%\u00009a|y"
|
|
||||||
] [
|
|
||||||
"Jefe" "what do ya want for nothing?" sequence>sha1-hmac >string
|
|
||||||
] unit-test
|
|
||||||
|
|
||||||
[
|
|
||||||
"\u0000d70YM\u000016~5\u0000d5\u000095o\u0000d8\0=\r\u0000b3\u0000d3\u0000f4m\u0000c7\u0000bb"
|
|
||||||
] [
|
|
||||||
16 HEX: aa <string>
|
|
||||||
50 HEX: dd <repetition> sequence>sha1-hmac >string
|
|
||||||
] unit-test
|
|
|
@ -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 ;
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2009 Maxim Savchenko
|
! Copyright (C) 2009 Maxim Savchenko
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! 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
|
IN: ecdsa.tests
|
||||||
|
|
||||||
SYMBOLS: priv-key pub-key signature ;
|
SYMBOLS: priv-key pub-key signature ;
|
||||||
|
@ -27,4 +27,4 @@ SYMBOLS: priv-key pub-key signature ;
|
||||||
message sha-256 checksum-bytes
|
message sha-256 checksum-bytes
|
||||||
signature get pub-key get
|
signature get pub-key get
|
||||||
"prime256v1" [ set-public-key ecdsa-verify ] with-ec
|
"prime256v1" [ set-public-key ecdsa-verify ] with-ec
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
Loading…
Reference in New Issue