fix sha1
Doug Coleman
parent
ee6a8e78e7
commit
e342082722
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
USING: kernel io strings byte-arrays sequences namespaces math
|
||||
parser checksums.hmac tools.test checksums.md5 checksums.sha1
|
||||
checksums.sha2 checksums ;
|
||||
parser checksums.hmac tools.test checksums.md5 checksums.sha2
|
||||
checksums ;
|
||||
IN: checksums.hmac.tests
|
||||
|
||||
[
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: tools.test checksums.interleave checksums.sha1 ;
|
||||
USING: tools.test checksums.interleave checksums.sha2 ;
|
||||
IN: checksums.interleave.tests
|
||||
|
||||
[
|
||||
|
|
|
|||
|
|
@ -1 +0,0 @@
|
|||
Doug Coleman
|
||||
|
|
@ -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
|
||||
|
|
@ -5,6 +5,13 @@ IN: checksums.sha2.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"
|
||||
|
|
|
|||
|
|
@ -3,15 +3,39 @@
|
|||
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 checksums.stream multiline ;
|
||||
accessors locals checksums.stream multiline literals
|
||||
generalizations ;
|
||||
IN: checksums.sha2
|
||||
|
||||
SINGLETON: sha1
|
||||
INSTANCE: sha1 stream-checksum
|
||||
|
||||
SINGLETON: sha-224
|
||||
SINGLETON: sha-256
|
||||
|
||||
INSTANCE: sha-224 stream-checksum
|
||||
INSTANCE: sha-256 stream-checksum
|
||||
|
||||
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 ;
|
||||
|
|
@ -121,6 +145,13 @@ 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
|
||||
|
|
@ -135,6 +166,8 @@ ALIAS: K-512 K-384
|
|||
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> ;
|
||||
|
|
@ -224,9 +257,6 @@ M: sha-256 initialize-checksum-state drop <sha-256-state> ;
|
|||
|
||||
GENERIC: pad-initial-bytes ( string sha2 -- padded-string )
|
||||
|
||||
: seq>byte-array ( seq n -- string )
|
||||
'[ _ >be ] map B{ } join ;
|
||||
|
||||
:: T1-256 ( n M H sha2 -- T1 )
|
||||
n M nth
|
||||
n sha2 K>> nth +
|
||||
|
|
@ -272,12 +302,18 @@ GENERIC: 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
|
||||
|
||||
M: sha2-short checksum-block
|
||||
[ prepare-message-schedule ]
|
||||
[ [ block-size>> ] [ H>> clone ] [ ] tri process-chunk ] bi ;
|
||||
|
||||
: seq>byte-array ( seq n -- string )
|
||||
'[ _ >be ] map B{ } join ;
|
||||
|
||||
: sha1>checksum ( sha2 -- bytes )
|
||||
H>> 4 seq>byte-array ;
|
||||
|
||||
: sha-224>checksum ( sha2 -- bytes )
|
||||
H>> 7 head 4 seq>byte-array ;
|
||||
|
||||
|
|
@ -305,3 +341,71 @@ M: sha-224 checksum-stream ( stream checksum -- byte-array )
|
|||
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 ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue