steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'checksums'

db4
Doug Coleman 2009-05-17 18:00:36 -05:00
parent daeb25175b b352bbdc12
commit 400317affc
33 changed files with 487 additions and 437 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/checksums/adler-32/adler-32.factor
View File

@ -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
basis/checksums/sha1/authors.txt → basis/checksums/hmac/authors.txt
View File

48
basis/checksums/hmac/hmac-tests.factor Executable file
View File

@ -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

39
basis/checksums/hmac/hmac.factor Executable file
View File

@ -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 ;

1
basis/checksums/interleave/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

19
basis/checksums/interleave/interleave-tests.factor Normal file
View File

@ -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

17
basis/checksums/interleave/interleave.factor Normal file
View File

@ -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 ;

25
basis/checksums/md5/md5-tests.factor
View File

@ -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

154
basis/checksums/md5/md5.factor
View File

@ -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 ;

2
basis/checksums/openssl/openssl-docs.factor
View File

@ -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
basis/checksums/sha2/authors.txt → basis/checksums/sha/authors.txt
View File

18
basis/checksums/sha/sha-docs.factor Normal file
View File

@ -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"

13
basis/checksums/sha2/sha2-tests.factor → basis/checksums/sha/sha-tests.factor
View File

@ -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

221
basis/checksums/sha2/sha2.factor → basis/checksums/sha/sha.factor
View File

@ -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 ;

1
basis/checksums/sha/summary.txt Normal file
View File

@ -0,0 +1 @@
SHA checksum algorithms

11
basis/checksums/sha1/sha1-docs.factor
View File

@ -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"

14
basis/checksums/sha1/sha1-tests.factor
View File

@ -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

134
basis/checksums/sha1/sha1.factor
View File

@ -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
basis/checksums/sha1/summary.txt
View File

@ -1 +0,0 @@
SHA1 checksum algorithm

11
basis/checksums/sha2/sha2-docs.factor
View File

@ -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
basis/checksums/sha2/summary.txt
View File

@ -1 +0,0 @@
SHA2 checksum algorithm

25
basis/compression/inflate/inflate.factor
View File

@ -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 ;

2
basis/furnace/auth/auth-docs.factor
View File

@ -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

2
basis/furnace/auth/auth.factor
View File

@ -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

18
basis/images/bitmap/bitmap-tests.factor
View File

@ -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

3
basis/uuid/uuid.factor
View File

@ -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 ;

3
core/checksums/checksums-docs.factor
View File

@ -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" } ;

39
core/checksums/checksums.factor
View File

@ -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 )

2
extra/benchmark/sha1/sha1.factor
View File

@ -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
extra/crypto/hmac/authors.txt
View File

@ -1 +0,0 @@
Doug Coleman

38
extra/crypto/hmac/hmac-tests.factor
View File

@ -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

55
extra/crypto/hmac/hmac.factor
View File

@ -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 ;

4
extra/ecdsa/ecdsa-tests.factor
View File

@ -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