diff --git a/extra/crypto/barrett/barrett.factor b/extra/crypto/barrett/barrett.factor index 55da97202f..4a070190e3 100644 --- a/extra/crypto/barrett/barrett.factor +++ b/extra/crypto/barrett/barrett.factor @@ -4,5 +4,11 @@ IN: crypto.barrett : barrett-mu ( n size -- mu ) #! Calculates Barrett's reduction parameter mu #! 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 ; + diff --git a/extra/crypto/common/common.factor b/extra/crypto/common/common.factor index b9f1d43784..a714727ad9 100644 --- a/extra/crypto/common/common.factor +++ b/extra/crypto/common/common.factor @@ -50,9 +50,8 @@ SYMBOL: big-endian? : 2seq>seq ( seq1 seq2 -- seq ) #! { aceg } { bdfh } -> { abcdefgh } - swap ! error? [ 2array flip concat ] keep like ; : mod-nth ( n seq -- elt ) #! 5 "abcd" -> b - [ length mod ] keep nth ; + [ length mod ] [ nth ] bi ; diff --git a/extra/crypto/hmac/hmac-tests.factor b/extra/crypto/hmac/hmac-tests.factor index fa0cbef4c7..eff95bbcd6 100755 --- a/extra/crypto/hmac/hmac-tests.factor +++ b/extra/crypto/hmac/hmac-tests.factor @@ -9,4 +9,3 @@ IN: crypto.hmac.tests [ "g[\u00000b:\eM\u0000dfN\u000012Hr\u0000dal/c+\u0000fe\u0000d9W\u0000e9" ] [ 16 11 "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 [ "\u0000d70YM\u000016~5\u0000d5\u000095o\u0000d8\0=\r\u0000b3\u0000d3\u0000f4m\u0000c7\u0000bb" ] [ 16 HEX: aa 50 HEX: dd >byte-array byte-array>sha1-hmac >string ] unit-test - diff --git a/extra/crypto/hmac/hmac.factor b/extra/crypto/hmac/hmac.factor index 3dad01fe3a..91d404aead 100755 --- a/extra/crypto/hmac/hmac.factor +++ b/extra/crypto/hmac/hmac.factor @@ -37,7 +37,6 @@ MEMO: opad ( -- seq ) 64 HEX: 5c ; : byte-array>sha1-hmac ( K string -- hmac ) binary stream>sha1-hmac ; - : stream>md5-hmac ( K stream -- hmac ) [ init-hmac md5-hmac ] with-stream ; diff --git a/extra/crypto/md5/md5.factor b/extra/crypto/md5/md5.factor index 7ecbd767b9..45e10da74d 100755 --- a/extra/crypto/md5/md5.factor +++ b/extra/crypto/md5/md5.factor @@ -3,7 +3,7 @@ USING: kernel io io.binary io.files io.streams.byte-array math math.functions math.parser namespaces splitting strings sequences crypto.common byte-arrays locals sequences.private -io.encodings.binary symbols ; +io.encodings.binary symbols math.bitfields.lib ; IN: crypto.md5 r bitand r> bitor ; + pick bitnot bitand [ bitand ] [ bitor ] bi* ; : G ( X Y Z -- GXYZ ) #! 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) = X xor Y xor Z diff --git a/extra/crypto/rsa/rsa.factor b/extra/crypto/rsa/rsa.factor index ccf17da4e8..5d3228db10 100644 --- a/extra/crypto/rsa/rsa.factor +++ b/extra/crypto/rsa/rsa.factor @@ -1,5 +1,5 @@ USING: math.miller-rabin kernel math math.functions namespaces -sequences ; +sequences accessors ; IN: crypto.rsa ! The private key is the only secret. @@ -39,7 +39,7 @@ PRIVATE> public-key ; : rsa-encrypt ( message rsa -- encrypted ) - [ rsa-public-key ] keep rsa-modulus ^mod ; + [ public-key>> ] [ modulus>> ] bi ^mod ; : rsa-decrypt ( encrypted rsa -- message ) - [ rsa-private-key ] keep rsa-modulus ^mod ; \ No newline at end of file + [ private-key>> ] [ modulus>> ] bi ^mod ; diff --git a/extra/crypto/test/common.factor b/extra/crypto/test/common.factor deleted file mode 100644 index 6050454402..0000000000 --- a/extra/crypto/test/common.factor +++ /dev/null @@ -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 - - diff --git a/extra/crypto/timing/timing.factor b/extra/crypto/timing/timing.factor index da2603d92c..a17d65d90b 100644 --- a/extra/crypto/timing/timing.factor +++ b/extra/crypto/timing/timing.factor @@ -1,7 +1,6 @@ USING: kernel math threads system ; IN: crypto.timing -: with-timing ( ... quot n -- ) +: with-timing ( quot n -- ) #! force the quotation to execute in, at minimum, n milliseconds - millis 2slip millis - + sleep ; - + millis 2slip millis - + sleep ; inline diff --git a/extra/crypto/xor/xor.factor b/extra/crypto/xor/xor.factor index 0713e19843..247387ebdf 100644 --- a/extra/crypto/xor/xor.factor +++ b/extra/crypto/xor/xor.factor @@ -1,8 +1,8 @@ USING: crypto.common kernel math sequences ; IN: crypto.xor -TUPLE: no-xor-key ; +ERROR: no-xor-key ; -: xor-crypt ( key seq -- seq ) - over empty? [ no-xor-key construct-empty throw ] when +: xor-crypt ( key seq -- seq' ) + over empty? [ no-xor-key ] when dup length rot [ mod-nth bitxor ] curry 2map ;