added rsa

added miller-rabin

contrib/crypto/load.factor

@@ -5,6 +5,9 @@ USING: kernel parser sequences words compiler ;
 
 {
     "common"
+    "random"
+    "miller-rabin"
     "md5"
     "sha1"
+    "rsa"
 } [ "/contrib/crypto/" swap ".factor" append3 run-resource ] each

contrib/crypto/miller-rabin.factor

@@ -0,0 +1,61 @@
+USING: kernel math errors namespaces math-contrib sequences io ;
+USE: prettyprint
+USE: inspector
+IN: crypto
+
+SYMBOL: a
+SYMBOL: n
+SYMBOL: r
+SYMBOL: s
+SYMBOL: composite
+SYMBOL: count
+SYMBOL: trials
+
+: rand[1..n-1] ( n -- )
+    1- random-int 1+ ;
+
+: (factor-2s) ( s n -- s n )
+    dup 2 mod 0 = [ -1 shift >r 1+ r> (factor-2s) ] when ;
+
+: factor-2s ( n -- r s )
+    #! factor an even number into 2 ^ s * m
+    dup dup even? >r 0 > r> and [
+        "input must be positive and even" throw
+    ] unless 0 swap (factor-2s) ;
+
+: init-miller-rabin ( n -- )
+    0 composite set
+    [ n set ] keep 10000 < 20 100 ? trials set ;
+
+: miller-rabin ( n -- bool )
+    [
+        init-miller-rabin
+        n get even? [
+            f ] [
+            n get 1- factor-2s s set r set
+            trials get [
+                n get rand[1..n-1] a set
+                a get s get n get ^mod 1 = [
+                    0 count set
+                    r get [
+                        2 over ^ s get * a get swap n get ^mod n get - -1 = [
+                            count [ 1+ ] change
+                            r get +
+                        ] when
+                    ] repeat
+                    count get zero? [
+                        composite on
+                        trials get +
+                    ] when
+                ] unless
+            ] repeat
+            composite get 0 = [ t ] [ composite get not ] if
+        ] if
+    ] with-scope ;
+
+: next-miller-rabin-prime ( n -- p )
+    dup even? [ 1+ ] [ 2 + ] if
+    dup miller-rabin [ next-miller-rabin-prime ] unless ;
+
+
+! 473155932665450549999756893736999469773678960651272093993257221235459777950185377130233556540099119926369437865330559863 100 miller-rabin

contrib/crypto/rsa.factor

@@ -0,0 +1,30 @@
+USING: kernel math namespaces math-contrib ;
+
+IN: crypto
+SYMBOL: d
+SYMBOL: p
+SYMBOL: q
+SYMBOL: n
+SYMBOL: m
+SYMBOL: ee
+
+: while-gcd ( -- )
+    m get ee get gcd nip 1 > [ ee [ 2 + ] change while-gcd ] when ;
+
+! n bits
+: generate-key-pair ( bitlen -- )
+    2 swap 1- 2 /i shift
+    [ random-int next-miller-rabin-prime p set ] keep
+    random-int next-miller-rabin-prime q set
+
+    p get q get * n set
+    p get 1- q get 1- * m set
+    3 ee set
+    while-gcd
+    m get ee get mod-inv m get + d set ;
+
+: rsa-encrypt ( message -- encrypted )
+    ee get n get ^mod ;
+
+: rsa-decrypt ( encrypted -- message )
+    d get n get ^mod ;