Adding initial RSA library.

lib/chibi/crypto/rsa.scm

@@ -0,0 +1,124 @@
+;; rsa.scm -- RSA public key cryptography library
+;; Copyright (c) 2014 Alex Shinn.  All rights reserved.
+;; BSD-style license: http://synthcode.com/license.txt
+
+;; The RSA key type.  The public fields are always present, but the
+;; private key d may be #f.
+(define-record-type Rsa-Key
+  (make-rsa-key bits n e d)
+  rsa-key?
+  (bits rsa-key-bits)
+  (n rsa-key-n)         ; public modulus, the product of two primes
+  (e rsa-key-e)         ; public exponent, coptime to (totient n)
+  (d rsa-key-d))        ; private exponent, the inverse of e mod (totient n)
+
+(define (rsa-key-gen-from-primes bit-length p q . o)
+  (define (choose-exponent phi e)
+    (cond ((>= e phi) (error "couldn't find an exponent for " p q))
+          ((= 1 (gcd e phi)) e)
+          (else (choose-exponent phi (+ e 2)))))
+  (let* ((n (* p q))
+         (phi (* (- p 1) (- q 1)))
+         ;; Default to Fermat's number F4, or if too large the number
+         ;; 3, as suggested by RFC 1423.  Ensure it's coprime to phi.
+         (e (choose-exponent phi (cond ((pair? o) (car o))
+                                       ((< 65537 phi) 65537)
+                                       (else 3))))
+         (d (modular-inverse e phi)))
+    (make-rsa-key bit-length n e d)))
+
+(define (rsa-key-gen . o)
+  (let* ((bit-length (if (pair? o) (car o) 128))
+         (lo (max 3 (expt 2 (- bit-length 1))))
+         (hi (expt 2 bit-length))
+         (p (random-prime lo hi))
+         (q (random-prime-distinct-from lo hi p)))
+    (rsa-key-gen-from-primes bit-length p q)))
+
+;;> Returns a copy of the given key with the private key, if any,
+;;> removed.
+(define (rsa-pub-key priv-key)
+  (make-rsa-key (rsa-key-bits priv-key) (rsa-key-n priv-key)
+                (rsa-key-e priv-key) #f))
+
+;; From RFC-1423
+(define (pkcs1-pad bv)
+  (let ((pad (- 8 (modulo (bytevector-length bv) 8))))
+    (bytevector-append bv (make-bytevector pad pad))))
+
+(define (pkcs1-unpad bv)
+  (let* ((len (bytevector-length bv))
+         (pad (bytevector-u8-ref bv (- len 1))))
+    (if (not (<= 1 pad 8))
+        (error "not pkcs1 padded" bv)
+        (bytevector-copy bv 0 (- len pad)))))
+
+;; Actual encryption and decryption are trivially defined as modular
+;; exponentiation.
+
+(define (rsa-encrypt-integer pub-key msg)
+  (if (>= msg (rsa-key-n pub-key))
+      (error "message larger than modulus"))
+  (modular-expt msg (rsa-key-e pub-key) (rsa-key-n pub-key)))
+
+(define (rsa-decrypt-integer priv-key cipher)
+  (if (>= cipher (rsa-key-n priv-key))
+      (error "cipher larger than modulus"))
+  (modular-expt cipher (rsa-key-d priv-key) (rsa-key-n priv-key)))
+
+;; Arbitrary messages are encrypted by converting padded bytevectors
+;; to and from integers.
+;; TODO: user better padding
+
+(define (convert-plain f key msg)
+  (cond
+   ((bytevector? msg)
+    (integer->bytevector (f key (bytevector->integer (pkcs1-pad msg)))))
+   ((string? msg)
+    (convert-plain f key (string->utf8 msg)))
+   (else
+    (f key msg))))
+
+(define (convert-cipher f key cipher)
+  (cond
+   ((bytevector? cipher)
+    (pkcs1-unpad (integer->bytevector (f key (bytevector->integer cipher)))))
+   ((string? cipher)
+    (convert-cipher f key (string->utf8 cipher)))
+   (else
+    (f key cipher))))
+
+;; General API can handle integers, bytevectors, or strings which are
+;; converted to utf8 bytevectors.
+
+;;> Encrypts \var{msg} for the given public key \var{pub-key}.
+;;> \var{msg} may be an integer or bytevector, in which case the
+;;> result is of the same type, or a string, in which case the string
+;;> is first coerced to a utf8 encoded bytevector.
+(define (rsa-encrypt pub-key msg)
+  (if (not (rsa-key-e pub-key))
+      (error "can't encrypt without a public key" pub-key)
+      (convert-plain rsa-encrypt-integer pub-key msg)))
+
+;;> Decrypts \var{cipher} using the given private key \var{priv-key}.
+;;> \var{cipher} may be an integer or bytevector, in which case the
+;;> result is of the same type, or a string, in which case the string
+;;> is first coerced to a utf8 encoded bytevector.
+(define (rsa-decrypt priv-key cipher)
+  (if (not (rsa-key-d priv-key))
+      (error "can't decrypt without a private key" priv-key)
+      (convert-cipher rsa-decrypt-integer priv-key cipher)))
+
+;;> Signs \var{msg} using the given private key \var{priv-key}.
+(define (rsa-sign priv-key msg)
+  (if (not (rsa-key-d priv-key))
+      (error "can't sign without a private key" priv-key)
+      (convert-plain rsa-decrypt-integer priv-key msg)))
+
+;;> Returns true iff \var{sig} is a valid signature of \var{msg} for
+;;> the given public key \var{pub-key}.
+(define (rsa-verify? pub-key msg sig)
+  (if (not (rsa-key-e pub-key))
+      (error "can't verify without a public key" pub-key)
+      (equal? (if (string? msg) (string->utf8 msg) msg)
+              (convert-cipher rsa-encrypt-integer pub-key sig))))

lib/chibi/crypto/rsa.sld

@@ -0,0 +1,7 @@
+
+(define-library (chibi crypto rsa)
+  (import (scheme base) (srfi 33) (chibi bytevector) (chibi math prime))
+  (export make-rsa-key rsa-key-gen rsa-key-gen-from-primes rsa-pub-key
+          rsa-encrypt rsa-decrypt rsa-sign rsa-verify?
+          rsa-key? rsa-key-bits rsa-key-n rsa-key-e rsa-key-d)
+  (include "rsa.scm"))

tests/rsa-tests.scm

@@ -0,0 +1,56 @@
+
+(import (scheme base) (scheme write) (chibi crypto rsa) (chibi test))
+
+(test-begin "rsa")
+
+;; Verify an explicit key.
+
+;; p = 61, q = 53
+(define priv-key (rsa-key-gen-from-primes 8 61 53))
+(define pub-key (rsa-pub-key priv-key))
+
+(test 439 (rsa-sign priv-key 42))
+(test #t (rsa-verify? pub-key 42 (rsa-sign priv-key 42)))
+
+(let ((msg 42))
+  (test msg (rsa-decrypt priv-key (rsa-encrypt pub-key msg))))
+
+(define priv-key2 (rsa-key-gen-from-primes 32 2936546443 3213384203))
+(define pub-key2 (rsa-pub-key priv-key2))
+
+(let ((msg 42))
+  (test msg (rsa-decrypt priv-key2 (rsa-encrypt pub-key2 msg))))
+
+(let ((msg #u8(42)))
+  (test msg (rsa-decrypt priv-key2 (rsa-encrypt pub-key2 msg))))
+
+(let ((msg "*"))
+  (test msg (utf8->string (rsa-decrypt priv-key2 (rsa-encrypt pub-key2 msg)))))
+
+(let ((msg "*"))
+  (test #t (rsa-verify? pub-key2 msg (rsa-sign priv-key2 msg))))
+
+(let ((msg #u8(42)))
+  (test #t (rsa-verify? pub-key2 msg (rsa-sign priv-key2 msg))))
+
+;; Key generation.
+
+(define (test-key key)
+  (test #t (rsa-key? key))
+  (test #t (positive? (rsa-key-n key)))
+  (test #t (positive? (rsa-key-e key)))
+  (test #t (positive? (rsa-key-d key)))
+  (test 5 (rsa-decrypt key (rsa-encrypt (rsa-pub-key key) 5))))
+
+(test-key (rsa-key-gen 8))
+(test-key (rsa-key-gen 16))
+(test-key (rsa-key-gen 32))
+(test-key (rsa-key-gen-from-primes 32 2936546443 3213384203))
+
+;; These are expensive to test.  Times with -h1G:
+;; (test-key (rsa-key-gen 128))   ; 0.04s
+;; (test-key (rsa-key-gen 256))   ; 0.4s
+;; (test-key (rsa-key-gen 512))   ; 4s
+;; (test-key (rsa-key-gen 1024))  ; 92s
+
+(test-end)