Merge branch 'master' of git://factorcode.org/git/factor
Slava Pestov
commit
8714aa48c5
basis
checksums
adler-32
compression/inflate
cpu/x86/64
furnace/auth
images
bitmap
png
io/backend/windows
uuid
core
bootstrap
classes/predicate
extra
|
|
@ -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] <reversed> v. ] [ length ] bi + ] bi
|
||||
[ 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
|
||||
[ "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
|
||||
[ "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
|
||||
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
|
||||
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
|
||||
|
||||
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 )
|
||||
sin abs 32 2^ * >integer ; foldable
|
||||
sin abs 32 2^ * >integer ; inline
|
||||
|
||||
: 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 ; inline
|
||||
|
||||
: 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 ; 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 -- IXYZ )
|
||||
#! 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: S12 12
|
||||
|
|
@ -72,10 +65,27 @@ CONSTANT: S42 10
|
|||
CONSTANT: S43 15
|
||||
CONSTANT: S44 21
|
||||
|
||||
MACRO: with-md5-round ( ops func -- )
|
||||
'[ [ _ (ABCD) ] compose ] map '[ _ cleave ] ;
|
||||
CONSTANT: a 0
|
||||
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 ]
|
||||
[ d a b c 1 S12 2 ]
|
||||
|
|
@ -93,9 +103,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 ]
|
||||
|
|
@ -113,9 +123,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 ]
|
||||
|
|
@ -133,9 +143,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 ]
|
||||
|
|
@ -153,38 +163,34 @@ 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 <groups> [ 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)
|
||||
M: md5-state checksum-block ( block state -- )
|
||||
[
|
||||
[ 4 <groups> [ 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
|
||||
] if ;
|
||||
|
||||
: stream>md5 ( -- )
|
||||
64 read [ process-md5-block ] keep
|
||||
length 64 = [ stream>md5 ] when ;
|
||||
nip update-md5
|
||||
] 2bi ;
|
||||
|
||||
: get-md5 ( -- str )
|
||||
[ a b c d ] [ get 4 >le ] map concat >byte-array ;
|
||||
: md5>checksum ( md5 -- bytes )
|
||||
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>
|
||||
|
||||
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:"
|
||||
{ $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:"
|
||||
{ $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"
|
||||
|
|
|
|||
|
|
@ -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" <openssl-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
|
||||
|
|
|
|||
|
|
@ -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,18 @@
|
|||
USING: arrays kernel math namespaces sequences tools.test
|
||||
checksums.sha2 checksums ;
|
||||
IN: checksums.sha2.tests
|
||||
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 )
|
||||
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" ]
|
||||
[
|
||||
"abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
|
||||
|
|
@ -36,7 +44,27 @@ IN: checksums.sha2.tests
|
|||
] unit-test
|
||||
|
||||
|
||||
|
||||
|
||||
! [ "8e959b75dae313da8cf4f72814fc143f8f7779c6eb9f7fa17299aeadb6889018501d289e4900f7e4331b99dec4b5433ac7d329eeb6dd26545e96e55b874be909" ]
|
||||
! [ "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmnhijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu" sha-512 test-checksum ] unit-test
|
||||
|
||||
[
|
||||
t
|
||||
] [
|
||||
<sha1-state> "asdf" binary <byte-reader> add-checksum-stream
|
||||
[ get-checksum ] [ get-checksum ] bi =
|
||||
] unit-test
|
||||
|
||||
[
|
||||
t
|
||||
] [
|
||||
<sha-256-state> "asdf" binary <byte-reader> add-checksum-stream
|
||||
[ get-checksum ] [ get-checksum ] bi =
|
||||
] unit-test
|
||||
|
||||
[
|
||||
t
|
||||
] [
|
||||
<sha-224-state> "asdf" binary <byte-reader> add-checksum-stream
|
||||
[ get-checksum ] [ get-checksum ] bi =
|
||||
] unit-test
|
||||
|
||||
|
|
@ -3,16 +3,40 @@
|
|||
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 ;
|
||||
IN: checksums.sha2
|
||||
accessors locals checksums.stream multiline literals
|
||||
generalizations ;
|
||||
IN: checksums.sha
|
||||
|
||||
SINGLETON: sha1
|
||||
INSTANCE: sha1 stream-checksum
|
||||
|
||||
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: 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 ;
|
||||
|
||||
|
|
@ -22,6 +46,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 ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
CONSTANT: a 0
|
||||
|
|
@ -116,6 +145,33 @@ CONSTANT: 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' )
|
||||
[
|
||||
[ -7 bitroll-32 ]
|
||||
|
|
@ -172,7 +228,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 +237,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,26 +257,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 <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 )
|
||||
n M 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 ]
|
||||
[
|
||||
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 -- )
|
||||
|
|
@ -266,41 +302,110 @@ M: sha2-long 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
|
||||
|
||||
: 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 <sliced-groups> ]
|
||||
[ sha2-steps ] bi ;
|
||||
: seq>byte-array ( seq n -- string )
|
||||
'[ _ >be ] map B{ } join ;
|
||||
|
||||
: <sha-224-state> ( -- sha2-state )
|
||||
sha-224-state new
|
||||
K-256 >>K
|
||||
initial-H-224 >>H
|
||||
4 >>word-size
|
||||
64 >>block-size ;
|
||||
: sha1>checksum ( sha2 -- bytes )
|
||||
H>> 4 seq>byte-array ;
|
||||
|
||||
: <sha-256-state> ( -- sha2-state )
|
||||
sha-256-state new
|
||||
K-256 >>K
|
||||
initial-H-256 >>H
|
||||
4 >>word-size
|
||||
64 >>block-size ;
|
||||
: sha-224>checksum ( sha2 -- bytes )
|
||||
H>> 7 head 4 seq>byte-array ;
|
||||
|
||||
: sha-256>checksum ( sha2 -- bytes )
|
||||
H>> 4 seq>byte-array ;
|
||||
|
||||
: pad-last-short-block ( state -- )
|
||||
[ bytes>> t ] [ bytes-read>> pad-last-block ] [ ] tri
|
||||
[ checksum-block ] curry each ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
M: sha-224 checksum-bytes
|
||||
drop <sha-224-state>
|
||||
[ 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 <sha-256-state>
|
||||
[ 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
|
||||
[ <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
|
||||
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 ] }
|
||||
|
|
@ -200,10 +202,11 @@ 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:<lsb0-bit-reader>
|
||||
[ check-zlib-header ]
|
||||
[ inflate-loop ] bi
|
||||
[ check-zlib-header ] [ inflate-loop ] bi
|
||||
inflate-lz77 ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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-reader> ] [ file-info size>> ] bi
|
||||
|
|
|
|||
|
|
@ -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 ? -- )
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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" } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,11 +1,46 @@
|
|||
! 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 quotations ;
|
||||
IN: checksums
|
||||
|
||||
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 )
|
||||
normalize-path (file-reader) add-checksum-stream ;
|
||||
|
||||
GENERIC: checksum-bytes ( bytes checksum -- value )
|
||||
|
||||
GENERIC: checksum-stream ( stream checksum -- value )
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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 ( -- )
|
||||
|
|
|
|||
|
|
@ -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
|
||||
! 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
|
||||
] unit-test
|
||||
|
|
|
|||
Loading…
Reference in New Issue