Merge git://spitspat.com/git/factor
U-C4\Administrator
commit
8b2bb93d1e
|
|
@ -1,23 +1,24 @@
|
|||
USING: kernel math sequences namespaces math-contrib ;
|
||||
IN: crypto-internals
|
||||
USING: kernel math sequences namespaces ;
|
||||
IN: crypto.rc4
|
||||
|
||||
! http://en.wikipedia.org/wiki/RC4_%28cipher%29
|
||||
|
||||
<PRIVATE
|
||||
|
||||
SYMBOL: i
|
||||
SYMBOL: j
|
||||
SYMBOL: s
|
||||
SYMBOL: key
|
||||
SYMBOL: l
|
||||
|
||||
|
||||
! key scheduling algorithm, initialize s
|
||||
: ksa ( -- )
|
||||
256 [ ] map s set
|
||||
0 j set
|
||||
256 [
|
||||
dup s get nth j get + over l get mod key get nth + 255 bitand j set
|
||||
dup j get s get exchange
|
||||
] repeat ;
|
||||
dup j get s get exchange drop
|
||||
] each ;
|
||||
|
||||
: generate ( -- n )
|
||||
i get 1+ 255 bitand i set
|
||||
|
|
@ -25,12 +26,14 @@ SYMBOL: l
|
|||
i get j get s get exchange
|
||||
i get s get nth j get s get nth + 255 bitand s get nth ;
|
||||
|
||||
IN: crypto
|
||||
PRIVATE>
|
||||
|
||||
: rc4 ( key -- )
|
||||
[
|
||||
[ key set ] keep
|
||||
length l set
|
||||
ksa
|
||||
0 i set
|
||||
0 j set ;
|
||||
0 j set
|
||||
] with-scope ;
|
||||
|
||||
|
|
@ -1,26 +0,0 @@
|
|||
USING: kernel math namespaces math-contrib errors ;
|
||||
|
||||
IN: crypto
|
||||
SYMBOL: d
|
||||
SYMBOL: p
|
||||
SYMBOL: q
|
||||
SYMBOL: n
|
||||
SYMBOL: m
|
||||
SYMBOL: ee
|
||||
|
||||
! e = public key, d = private key, n = public modulus
|
||||
TUPLE: rsa e d n ;
|
||||
|
||||
! n bits
|
||||
: generate-rsa-keypair ( bitlen -- <rsa> )
|
||||
[
|
||||
2 /i generate-two-unique-primes [ q set p set ] 2keep [ * n set ] 2keep
|
||||
[ 1- ] 2apply * m set
|
||||
65537 ee set
|
||||
m get ee get mod-inv m get + d set
|
||||
ee get d get n get <rsa>
|
||||
] with-scope ;
|
||||
|
||||
: rsa-encrypt ( message rsa -- encrypted ) [ rsa-e ] keep rsa-n ^mod ;
|
||||
: rsa-decrypt ( encrypted rsa -- message ) [ rsa-d ] keep rsa-n ^mod ;
|
||||
|
||||
|
|
@ -3,5 +3,5 @@ USING: kernel math namespaces crypto.rsa tools.test ;
|
|||
[ 123456789 ] [ 128 generate-rsa-keypair 123456789 over rsa-encrypt swap rsa-decrypt ] unit-test
|
||||
[ 123456789 ] [ 129 generate-rsa-keypair 123456789 over rsa-encrypt swap rsa-decrypt ] unit-test
|
||||
[ 123456789 ] [ 130 generate-rsa-keypair 123456789 over rsa-encrypt swap rsa-decrypt ] unit-test
|
||||
[ 123 ] [ 17 2753 3233 <rsa> 123 over rsa-encrypt swap rsa-decrypt ] unit-test
|
||||
[ 123 ] [ 3233 2753 17 <rsa> 123 over rsa-encrypt swap rsa-decrypt ] unit-test
|
||||
|
||||
|
|
|
|||
|
|
@ -2,28 +2,44 @@ USING: math.miller-rabin kernel math math.functions namespaces
|
|||
sequences ;
|
||||
IN: crypto.rsa
|
||||
|
||||
SYMBOL: d
|
||||
SYMBOL: p
|
||||
SYMBOL: q
|
||||
SYMBOL: n
|
||||
SYMBOL: m
|
||||
SYMBOL: ee
|
||||
! The private key is the only secret.
|
||||
|
||||
! e = public key, d = private key, n = public modulus
|
||||
TUPLE: rsa e d n ;
|
||||
! p,q are two random primes of numbits/2
|
||||
! phi = (p-1)(q-1)
|
||||
! modulus = p*q
|
||||
! public = 65537
|
||||
! private = public modinv phi
|
||||
|
||||
TUPLE: rsa modulus private-key public-key ;
|
||||
|
||||
C: <rsa> rsa
|
||||
|
||||
! n bits
|
||||
<PRIVATE
|
||||
|
||||
: public-key 65537 ; inline
|
||||
|
||||
: rsa-primes ( numbits -- p q )
|
||||
2/ 2 unique-primes first2 ;
|
||||
|
||||
: modulus-phi ( numbits -- n phi )
|
||||
#! Loop until phi is not divisible by the public key.
|
||||
dup rsa-primes [ * ] 2keep
|
||||
[ 1- ] 2apply *
|
||||
dup public-key gcd nip 1 = [
|
||||
rot drop
|
||||
] [
|
||||
2drop modulus-phi
|
||||
] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: generate-rsa-keypair ( numbits -- <rsa> )
|
||||
[
|
||||
2 /i 2 unique-primes first2 [ q set p set ] 2keep [ * n set ] 2keep
|
||||
[ 1- ] 2apply * m set
|
||||
65537 ee set
|
||||
m get ee get mod-inv m get + d set
|
||||
ee get d get n get <rsa>
|
||||
] with-scope ;
|
||||
modulus-phi
|
||||
public-key over mod-inv +
|
||||
public-key <rsa> ;
|
||||
|
||||
: rsa-encrypt ( message rsa -- encrypted ) [ rsa-e ] keep rsa-n ^mod ;
|
||||
: rsa-decrypt ( encrypted rsa -- message ) [ rsa-d ] keep rsa-n ^mod ;
|
||||
: rsa-encrypt ( message rsa -- encrypted )
|
||||
[ rsa-public-key ] keep rsa-modulus ^mod ;
|
||||
|
||||
: rsa-decrypt ( encrypted rsa -- message )
|
||||
[ rsa-private-key ] keep rsa-modulus ^mod ;
|
||||
|
|
@ -1,7 +0,0 @@
|
|||
USING: kernel math test namespaces crypto ;
|
||||
|
||||
[ 123456789 ] [ 128 generate-rsa-keypair 123456789 over rsa-encrypt swap rsa-decrypt ] unit-test
|
||||
[ 123456789 ] [ 129 generate-rsa-keypair 123456789 over rsa-encrypt swap rsa-decrypt ] unit-test
|
||||
[ 123456789 ] [ 130 generate-rsa-keypair 123456789 over rsa-encrypt swap rsa-decrypt ] unit-test
|
||||
[ 123 ] [ 17 2753 3233 <rsa> 123 over rsa-encrypt swap rsa-decrypt ] unit-test
|
||||
|
||||
|
|
@ -1,9 +0,0 @@
|
|||
USING: errors kernel math sequences ;
|
||||
IN: crypto
|
||||
|
||||
TUPLE: no-xor-key ;
|
||||
|
||||
: xor-crypt ( key seq -- seq )
|
||||
over empty? [ <no-xor-key> throw ] when
|
||||
[ length ] keep
|
||||
[ >r over mod-nth r> bitxor ] 2map nip ;
|
||||
|
|
@ -1,4 +1,5 @@
|
|||
USING: crypto errors kernel test strings ;
|
||||
USING: continuations crypto.xor kernel strings tools.test ;
|
||||
IN: temporary
|
||||
|
||||
! No key
|
||||
[ T{ no-xor-key f } ] [ [ "" dup xor-crypt ] catch ] unit-test
|
||||
|
|
@ -7,7 +8,7 @@ USING: crypto errors kernel test strings ;
|
|||
[ T{ no-xor-key f } ] [ [ "" "asdf" dupd xor-crypt xor-crypt ] catch ] unit-test
|
||||
|
||||
! a xor a = 0
|
||||
[ { 0 0 0 0 0 0 0 } ] [ "abcdefg" dup xor-crypt ] unit-test
|
||||
[ "\0\0\0\0\0\0\0" ] [ "abcdefg" dup xor-crypt ] unit-test
|
||||
|
||||
[ { 15 15 15 15 } ] [ { 10 10 10 10 } { 5 5 5 5 } xor-crypt ] unit-test
|
||||
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
USING: crypto.common kernel math sequences ;
|
||||
IN: crypto.xor
|
||||
|
||||
TUPLE: no-xor-key ;
|
||||
|
||||
: xor-crypt ( key seq -- seq )
|
||||
over empty? [ no-xor-key construct-empty throw ] when
|
||||
dup length rot [ mod-nth bitxor ] curry 2map ;
|
||||
|
|
@ -5,7 +5,7 @@ set +e
|
|||
|
||||
# Case insensitive string comparison
|
||||
shopt -s nocaseglob
|
||||
shopt -s nocasematch
|
||||
#shopt -s nocasematch
|
||||
|
||||
ensure_program_installed() {
|
||||
echo -n "Checking for $1..."
|
||||
|
|
@ -47,7 +47,9 @@ case $uname_s in
|
|||
*CYGWIN_NT*) OS=windows-nt;;
|
||||
*CYGWIN*) OS=windows-nt;;
|
||||
*darwin*) OS=macosx;;
|
||||
*Darwin*) OS=macosx;;
|
||||
*linux*) OS=linux;;
|
||||
*Linux*) OS=linux;;
|
||||
esac
|
||||
|
||||
# Architecture
|
||||
|
|
@ -107,4 +109,12 @@ rm $BOOT_IMAGE.* > /dev/null 2>&1
|
|||
wget http://factorcode.org/images/latest/$BOOT_IMAGE
|
||||
check_ret wget
|
||||
|
||||
if [[ $OS == windows-nt ]] ; then
|
||||
wget http://factorcode.org/dlls/freetype6.dll
|
||||
check_ret
|
||||
wget http://factorcode.org/dlls/zlib1.dla
|
||||
check_ret
|
||||
fi
|
||||
|
||||
|
||||
./$FACTOR_BINARY -i=$BOOT_IMAGE
|
||||
|
|
|
|||
Loading…
Reference in New Issue