mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 05:39:18 +02:00
8b5eb68238
They can be close()d explicitly with close-file-descriptor, and will close() on gc, but only explicitly closing the last port on them will close the fileno. Notably needed for network sockets where we open separate input and output ports on the same socket.
124 lines
4.7 KiB
Scheme
124 lines
4.7 KiB
Scheme
;; 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))))
|