Fix RSA

Fix crypto unit tests

extra/crypto/rc4/rc4.factor

@@ -1,23 +1,24 @@
-USING: kernel math sequences namespaces math-contrib ;
+USING: kernel math sequences namespaces ;
-IN: crypto-internals
+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
+        dup j get s get exchange drop
-    ] repeat ;
+    ] 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
+        [ key set ] keep
-    ksa
+        length l set
-    0 i set
+        ksa
-    0 j set ;
+        0 i set
+        0 j set
+    ] with-scope ;
 

extra/crypto/rsa.factor

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

extra/crypto/rsa/rsa-tests.factor

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

extra/crypto/rsa/rsa.factor

@@ -2,28 +2,44 @@ USING: math.miller-rabin kernel math math.functions namespaces
 sequences ;
 IN: crypto.rsa
 
-SYMBOL: d
+! The private key is the only secret.
-SYMBOL: p
-SYMBOL: q
-SYMBOL: n
-SYMBOL: m
-SYMBOL: ee
 
-! e = public key, d = private key, n = public modulus
+! p,q are two random primes of numbits/2
-TUPLE: rsa e d n ;
+! 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> )
-    [
+    modulus-phi
-        2 /i 2 unique-primes first2 [ q set p set ] 2keep [ * n set ] 2keep
+    public-key over mod-inv +
-        [ 1- ] 2apply * m set
+    public-key <rsa> ;
-        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-encrypt ( message rsa -- encrypted )
-: rsa-decrypt ( encrypted rsa -- message ) [ rsa-d ] keep rsa-n ^mod ;
+    [ rsa-public-key ] keep rsa-modulus ^mod ;
 
+: rsa-decrypt ( encrypted rsa -- message )
+    [ rsa-private-key ] keep rsa-modulus ^mod ;

extra/crypto/test/rsa.factor

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

extra/crypto/xor.factor

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

extra/crypto/xor/xor-tests.factor

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

extra/crypto/xor/xor.factor

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