From 8be253c47fed9439c70b962b10fec5580f1704a7 Mon Sep 17 00:00:00 2001
From: Doug Coleman <erg@g.local>
Date: Sat, 6 Oct 2007 23:01:26 -0500
Subject: [PATCH] Fix RSA Fix crypto unit tests

---
 extra/crypto/{ => rc4}/rc4.factor             | 25 +++++----
 extra/crypto/rsa.factor                       | 26 ----------
 extra/crypto/rsa/rsa-tests.factor             |  2 +-
 extra/crypto/rsa/rsa.factor                   | 52 ++++++++++++-------
 extra/crypto/test/rsa.factor                  |  7 ---
 extra/crypto/xor.factor                       |  9 ----
 .../{test/xor.factor => xor/xor-tests.factor} |  5 +-
 extra/crypto/xor/xor.factor                   |  8 +++
 8 files changed, 60 insertions(+), 74 deletions(-)
 rename extra/crypto/{ => rc4}/rc4.factor (66%)
 delete mode 100644 extra/crypto/rsa.factor
 delete mode 100644 extra/crypto/test/rsa.factor
 delete mode 100644 extra/crypto/xor.factor
 rename extra/crypto/{test/xor.factor => xor/xor-tests.factor} (85%)
 create mode 100644 extra/crypto/xor/xor.factor

diff --git a/extra/crypto/rc4.factor b/extra/crypto/rc4/rc4.factor
similarity index 66%
rename from extra/crypto/rc4.factor
rename to extra/crypto/rc4/rc4.factor
index 24f523189f..b730c4b7fe 100644
--- a/extra/crypto/rc4.factor
+++ b/extra/crypto/rc4/rc4.factor
@@ -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 ;
+    [
+        [ key set ] keep
+        length l set
+        ksa
+        0 i set
+        0 j set
+    ] with-scope ;
 
diff --git a/extra/crypto/rsa.factor b/extra/crypto/rsa.factor
deleted file mode 100644
index e082e431fa..0000000000
--- a/extra/crypto/rsa.factor
+++ /dev/null
@@ -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 ;
-
diff --git a/extra/crypto/rsa/rsa-tests.factor b/extra/crypto/rsa/rsa-tests.factor
index 10ff28a8b8..7de6bed76f 100644
--- a/extra/crypto/rsa/rsa-tests.factor
+++ b/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
 
diff --git a/extra/crypto/rsa/rsa.factor b/extra/crypto/rsa/rsa.factor
index ad5822b24c..ffb2a64b76 100644
--- a/extra/crypto/rsa/rsa.factor
+++ b/extra/crypto/rsa/rsa.factor
@@ -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 ;
\ No newline at end of file
diff --git a/extra/crypto/test/rsa.factor b/extra/crypto/test/rsa.factor
deleted file mode 100644
index cddad58897..0000000000
--- a/extra/crypto/test/rsa.factor
+++ /dev/null
@@ -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
-
diff --git a/extra/crypto/xor.factor b/extra/crypto/xor.factor
deleted file mode 100644
index a2b3161d4b..0000000000
--- a/extra/crypto/xor.factor
+++ /dev/null
@@ -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 ;
diff --git a/extra/crypto/test/xor.factor b/extra/crypto/xor/xor-tests.factor
similarity index 85%
rename from extra/crypto/test/xor.factor
rename to extra/crypto/xor/xor-tests.factor
index 2a77cf0e64..a0b764cc03 100644
--- a/extra/crypto/test/xor.factor
+++ b/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
 
diff --git a/extra/crypto/xor/xor.factor b/extra/crypto/xor/xor.factor
new file mode 100644
index 0000000000..0713e19843
--- /dev/null
+++ b/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 ;