cleanup in aisle crypto
parent
0b90458cca
commit
53d21c6c7a
|
@ -4,5 +4,11 @@ IN: crypto.barrett
|
||||||
: barrett-mu ( n size -- mu )
|
: barrett-mu ( n size -- mu )
|
||||||
#! Calculates Barrett's reduction parameter mu
|
#! Calculates Barrett's reduction parameter mu
|
||||||
#! size = word size in bits (8, 16, 32, 64, ...)
|
#! size = word size in bits (8, 16, 32, 64, ...)
|
||||||
over log2 1+ over / 2 * >r 2 swap ^ r> ^ swap / floor ;
|
! over log2 1+ over / 2 * >r 2 swap ^ r> ^ swap / floor ;
|
||||||
|
[
|
||||||
|
[ log2 1+ ] [ / 2 * ] bi*
|
||||||
|
] [
|
||||||
|
2^ rot ^ swap /i
|
||||||
|
] 2bi ;
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -50,9 +50,8 @@ SYMBOL: big-endian?
|
||||||
|
|
||||||
: 2seq>seq ( seq1 seq2 -- seq )
|
: 2seq>seq ( seq1 seq2 -- seq )
|
||||||
#! { aceg } { bdfh } -> { abcdefgh }
|
#! { aceg } { bdfh } -> { abcdefgh }
|
||||||
swap ! error?
|
|
||||||
[ 2array flip concat ] keep like ;
|
[ 2array flip concat ] keep like ;
|
||||||
|
|
||||||
: mod-nth ( n seq -- elt )
|
: mod-nth ( n seq -- elt )
|
||||||
#! 5 "abcd" -> b
|
#! 5 "abcd" -> b
|
||||||
[ length mod ] keep nth ;
|
[ length mod ] [ nth ] bi ;
|
||||||
|
|
|
@ -9,4 +9,3 @@ IN: crypto.hmac.tests
|
||||||
[ "g[\u00000b:\eM\u0000dfN\u000012Hr\u0000dal/c+\u0000fe\u0000d9W\u0000e9" ] [ 16 11 <string> "Hi There" >byte-array byte-array>sha1-hmac >string ] unit-test
|
[ "g[\u00000b:\eM\u0000dfN\u000012Hr\u0000dal/c+\u0000fe\u0000d9W\u0000e9" ] [ 16 11 <string> "Hi There" >byte-array byte-array>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?" >byte-array byte-array>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?" >byte-array byte-array>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> >byte-array byte-array>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> >byte-array byte-array>sha1-hmac >string ] unit-test
|
||||||
|
|
||||||
|
|
|
@ -37,7 +37,6 @@ MEMO: opad ( -- seq ) 64 HEX: 5c <array> ;
|
||||||
: byte-array>sha1-hmac ( K string -- hmac )
|
: byte-array>sha1-hmac ( K string -- hmac )
|
||||||
binary <byte-reader> stream>sha1-hmac ;
|
binary <byte-reader> stream>sha1-hmac ;
|
||||||
|
|
||||||
|
|
||||||
: stream>md5-hmac ( K stream -- hmac )
|
: stream>md5-hmac ( K stream -- hmac )
|
||||||
[ init-hmac md5-hmac ] with-stream ;
|
[ init-hmac md5-hmac ] with-stream ;
|
||||||
|
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
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 strings
|
math.functions math.parser namespaces splitting strings
|
||||||
sequences crypto.common byte-arrays locals sequences.private
|
sequences crypto.common byte-arrays locals sequences.private
|
||||||
io.encodings.binary symbols ;
|
io.encodings.binary symbols math.bitfields.lib ;
|
||||||
IN: crypto.md5
|
IN: crypto.md5
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
@ -43,11 +43,11 @@ SYMBOLS: a b c d old-a old-b old-c old-d ;
|
||||||
|
|
||||||
: F ( X Y Z -- FXYZ )
|
: 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 >r bitand r> bitor ;
|
pick bitnot bitand [ bitand ] [ bitor ] bi* ;
|
||||||
|
|
||||||
: 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 >r bitand r> bitor ;
|
dup bitnot rot bitand [ bitand ] [ bitor ] bi* ;
|
||||||
|
|
||||||
: 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
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
USING: math.miller-rabin kernel math math.functions namespaces
|
USING: math.miller-rabin kernel math math.functions namespaces
|
||||||
sequences ;
|
sequences accessors ;
|
||||||
IN: crypto.rsa
|
IN: crypto.rsa
|
||||||
|
|
||||||
! The private key is the only secret.
|
! The private key is the only secret.
|
||||||
|
@ -39,7 +39,7 @@ PRIVATE>
|
||||||
public-key <rsa> ;
|
public-key <rsa> ;
|
||||||
|
|
||||||
: rsa-encrypt ( message rsa -- encrypted )
|
: rsa-encrypt ( message rsa -- encrypted )
|
||||||
[ rsa-public-key ] keep rsa-modulus ^mod ;
|
[ public-key>> ] [ modulus>> ] bi ^mod ;
|
||||||
|
|
||||||
: rsa-decrypt ( encrypted rsa -- message )
|
: rsa-decrypt ( encrypted rsa -- message )
|
||||||
[ rsa-private-key ] keep rsa-modulus ^mod ;
|
[ private-key>> ] [ modulus>> ] bi ^mod ;
|
||||||
|
|
|
@ -1,15 +0,0 @@
|
||||||
USING: kernel math test namespaces crypto ;
|
|
||||||
|
|
||||||
[ 0 ] [ 1 0 0 bitroll ] unit-test
|
|
||||||
[ 1 ] [ 1 0 1 bitroll ] unit-test
|
|
||||||
[ 1 ] [ 1 1 1 bitroll ] unit-test
|
|
||||||
[ 1 ] [ 1 0 2 bitroll ] unit-test
|
|
||||||
[ 1 ] [ 1 0 1 bitroll ] unit-test
|
|
||||||
[ 1 ] [ 1 20 2 bitroll ] unit-test
|
|
||||||
[ 1 ] [ 1 8 8 bitroll ] unit-test
|
|
||||||
[ 1 ] [ 1 -8 8 bitroll ] unit-test
|
|
||||||
[ 1 ] [ 1 -32 8 bitroll ] unit-test
|
|
||||||
[ 128 ] [ 1 -1 8 bitroll ] unit-test
|
|
||||||
[ 8 ] [ 1 3 32 bitroll ] unit-test
|
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
USING: kernel math threads system ;
|
USING: kernel math threads system ;
|
||||||
IN: crypto.timing
|
IN: crypto.timing
|
||||||
|
|
||||||
: with-timing ( ... quot n -- )
|
: with-timing ( quot n -- )
|
||||||
#! force the quotation to execute in, at minimum, n milliseconds
|
#! force the quotation to execute in, at minimum, n milliseconds
|
||||||
millis 2slip millis - + sleep ;
|
millis 2slip millis - + sleep ; inline
|
||||||
|
|
||||||
|
|
|
@ -1,8 +1,8 @@
|
||||||
USING: crypto.common kernel math sequences ;
|
USING: crypto.common kernel math sequences ;
|
||||||
IN: crypto.xor
|
IN: crypto.xor
|
||||||
|
|
||||||
TUPLE: no-xor-key ;
|
ERROR: no-xor-key ;
|
||||||
|
|
||||||
: xor-crypt ( key seq -- seq )
|
: xor-crypt ( key seq -- seq' )
|
||||||
over empty? [ no-xor-key construct-empty throw ] when
|
over empty? [ no-xor-key ] when
|
||||||
dup length rot [ mod-nth bitxor ] curry 2map ;
|
dup length rot [ mod-nth bitxor ] curry 2map ;
|
||||||
|
|
Loading…
Reference in New Issue