Update of /project/crypticl/cvsroot/crypticl/src In directory common-lisp.net:/tmp/cvs-serv18578/src Modified Files: aes.lisp crypticl-package.lisp diffie-hellman.lisp dsa.lisp idea.lisp keygenerator.lisp rsa.lisp Added Files: keystore.lisp Log Message: Refactoring key generation. Date: Sun Nov 7 13:04:17 2004 Author: tskogan Index: crypticl/src/aes.lisp diff -u crypticl/src/aes.lisp:1.2 crypticl/src/aes.lisp:1.3 --- crypticl/src/aes.lisp:1.2 Sun Nov 7 01:17:35 2004 +++ crypticl/src/aes.lisp Sun Nov 7 13:04:17 2004 @@ -650,6 +650,11 @@ (update-and-decrypt obj data start end)) +(defun aes-generate-key (&optional (bitsize 128) encoding) + (declare (ignore encoding)) + (assert (member bitsize '(128 192 256)) () "AES invalid key size ~A" bitsize) + (generate-symmetric-key bitsize "AES")) + ;;;;;;; ;;; Test suite @@ -785,6 +790,7 @@ (register-constructor 'AES #'make-AES) +(register-key-generator 'AES #'aes-generate-key) Index: crypticl/src/crypticl-package.lisp diff -u crypticl/src/crypticl-package.lisp:1.2 crypticl/src/crypticl-package.lisp:1.3 --- crypticl/src/crypticl-package.lisp:1.2 Sun Nov 7 01:17:35 2004 +++ crypticl/src/crypticl-package.lisp Sun Nov 7 13:04:17 2004 @@ -3,9 +3,7 @@ ;;;; ;;;; Description: This file defines the crypticl package, the public interface ;;;; of the library. -;;;; Usage: Loading this file will call the funtion load-crypticl which again -;;;; loads the entire library. Unit tests will be run as part of the -;;;; loading. +;;;; Usage: Loading this file will load the rest of the library. ;;;; After loading you can list the public interface with ;;;; (crypticl:print-external-symbols) from the top-level. ;;;; Author: Tåle Skogan <tasko@frisurf.no> @@ -42,6 +40,7 @@ load-package fast-load-package generate-key + key-from-encoding random-secure-octets public private @@ -70,6 +69,7 @@ "random" "keygenerator" "md5" "aes" "idea" "dsa" "rsa" "diffie-hellman" + "keystore" "test"))) (dolist (file files) (let ((module (concatenate 'string path file))) Index: crypticl/src/diffie-hellman.lisp diff -u crypticl/src/diffie-hellman.lisp:1.2 crypticl/src/diffie-hellman.lisp:1.3 --- crypticl/src/diffie-hellman.lisp:1.2 Sun Nov 7 01:17:35 2004 +++ crypticl/src/diffie-hellman.lisp Sun Nov 7 13:04:17 2004 @@ -35,7 +35,47 @@ (x (x (key obj)))) (mod-expt y x p))) + +;;;;;;;; +;;; Key generation + +(defclass Diffie-HellmanKey (Key) + ((g :accessor g :initarg :g) + (p :accessor p :initarg :p) + (x :accessor x :initarg :x))) + +(defmethod make-Diffie-HellmanKey (g p) + (make-instance 'Diffie-HellmanKey + :key nil + :g g + :p p + :algorithm "Diffie-Hellman")) + +(defun Diffie-Hellman-generate-key (bitsize) + (let ((p (random-bignum-max-odd bitsize))) + + (while (not (primep p)) + (setf p (random-bignum-max-odd bitsize))) + + ;; Find generator + (do ((g 2 (+ g 1))) + ((/= (mod-expt g p p) 1) (make-Diffie-HellmanKey g p))))) +(defun make-Diffie-HellmanKey-from-encoding (encoding) + (let ((lst (construct-from-encoding encoding 'Diffie-Hellman))) + (make-instance 'Diffie-HellmanKey + :key nil + :g (first lst) + :p (second lst) + :algorithm "Diffie-Hellman"))) + +(defmethod string-rep ((obj Diffie-HellmanKey)) + (format nil "~A ~A" (g obj) (p obj))) + +(defmethod get-encoding ((obj Diffie-HellmanKey)) + (get-element-encodings (list (g obj) (p obj)))) + + (defun test-dh () (let (y1 @@ -58,5 +98,6 @@ (register-constructor 'Diffie-Hellman #'make-Diffie-Hellman) - +(register-key-generator 'Diffie-Hellman #'Diffie-Hellman-generate-key) +(register-key-from-encoding 'Diffie-HellmanKey #'make-Diffie-HellmanKey-from-encoding) Index: crypticl/src/dsa.lisp diff -u crypticl/src/dsa.lisp:1.2 crypticl/src/dsa.lisp:1.3 --- crypticl/src/dsa.lisp:1.2 Sun Nov 7 01:17:35 2004 +++ crypticl/src/dsa.lisp Sun Nov 7 13:04:17 2004 @@ -29,6 +29,18 @@ (:documentation "A class for digital signatures using DSA. p and q are the primes, g the generator,x the private and y the public key.")) +(defclass DSAPrivateKey (PrivateKey) + ((p :accessor p :initarg :p) + (q :accessor q :initarg :q) + (g :accessor g :initarg :g) + (x :accessor x :initarg :x) + (y :accessor y :initarg :y))) + +(defclass DSAPublicKey (PublicKey) + ((p :accessor p :initarg :p) + (q :accessor q :initarg :q) + (g :accessor g :initarg :g) + (y :accessor y :initarg :y))) ;; Suiteable q and p (p 1024 bits) primes from the NIST DSA home page. (defparameter *DSA-default-q* @@ -207,12 +219,7 @@ (return k))))) -(defclass DSAPrivateKey (PrivateKey) - ((p :accessor p :initarg :p) - (q :accessor q :initarg :q) - (g :accessor g :initarg :g) - (x :accessor x :initarg :x) - (y :accessor y :initarg :y))) + (defun make-DSAPrivateKey (p q g x y) (make-instance 'DSAPrivateKey :p p :q q :g g :x x :y y :algorithm "DSA")) @@ -225,11 +232,7 @@ ;; Long output ;; (format stream "<DSAPrivateKey p=~A q=~A g=~A x=~A y=~A>" (p obj) (q obj) (g obj) (x obj) (y obj))) -(defclass DSAPublicKey (PublicKey) - ((p :accessor p :initarg :p) - (q :accessor q :initarg :q) - (g :accessor g :initarg :g) - (y :accessor y :initarg :y))) + (defun make-DSAPublicKey (p q g y) (make-instance 'DSAPublicKey :p p :q q :g g :y y :algorithm "DSA")) @@ -389,4 +392,7 @@ ;;; (values p q))) -(register-constructor 'DSA #'make-DSA) \ No newline at end of file +(register-constructor 'DSA #'make-DSA) +(register-key-generator 'DSA #'dsa-generate-keys) +(register-key-from-encoding 'DSAPublicKey #'make-DSAPublicKey-from-encoding) +(register-key-from-encoding 'DSAPrivateKey #'make-DSAPrivateKey-from-encoding) \ No newline at end of file Index: crypticl/src/idea.lisp diff -u crypticl/src/idea.lisp:1.2 crypticl/src/idea.lisp:1.3 --- crypticl/src/idea.lisp:1.2 Sun Nov 7 01:17:35 2004 +++ crypticl/src/idea.lisp Sun Nov 7 13:04:17 2004 @@ -470,6 +470,14 @@ (update-and-decrypt obj data start end)) +;;;;;;;;;;; +;;; Key generation + +(defun idea-generate-key (&optional (bitsize 128) ) + (assert (member bitsize '(128)) () "IDEA invalid key size ~A" bitsize) + (generate-symmetric-key bitsize "IDEA")) + + ;;;;;;; ;;; Test suite @@ -628,4 +636,4 @@ (register-constructor 'IDEA #'make-IDEA) - +(register-key-generator 'IDEA #'idea-generate-key) Index: crypticl/src/keygenerator.lisp diff -u crypticl/src/keygenerator.lisp:1.2 crypticl/src/keygenerator.lisp:1.3 --- crypticl/src/keygenerator.lisp:1.2 Sun Nov 7 01:17:35 2004 +++ crypticl/src/keygenerator.lisp Sun Nov 7 13:04:17 2004 @@ -1,7 +1,7 @@ ;;;;-*-lisp-*- ;;;; The Crypticl cryptographic library. ;;;; -;;;; Description: Key generation and key store. +;;;; Description: Interface for key generation. ;;;; Author: Tåle Skogan <tasko@frisurf.no> ;;;; Distribution: See the accompanying file LICENSE. @@ -44,168 +44,53 @@ (defclass PrivateKey (AsymmetricKey) ()) -(defclass Diffie-HellmanKey (Key) - ((g :accessor g :initarg :g) - (p :accessor p :initarg :p) - (x :accessor x :initarg :x))) - -(defmethod make-Diffie-HellmanKey (g p) - (make-instance 'Diffie-HellmanKey - :key nil - :g g - :p p - :algorithm "Diffie-Hellman")) - -(defun Diffie-Hellman-generate-key (bitsize) - (let ((p (random-bignum-max-odd bitsize))) - - (while (not (primep p)) - (setf p (random-bignum-max-odd bitsize))) - - ;; Find generator - (do ((g 2 (+ g 1))) - ((/= (mod-expt g p p) 1) (make-Diffie-HellmanKey g p))))) - -(defun make-Diffie-HellmanKey-from-encoding (encoding) - (let ((lst (construct-from-encoding encoding 'Diffie-Hellman))) - (make-instance 'Diffie-HellmanKey - :key nil - :g (first lst) - :p (second lst) - :algorithm "Diffie-Hellman"))) -(defmethod string-rep ((obj Diffie-HellmanKey)) - (format nil "~A ~A" (g obj) (p obj))) -(defmethod get-encoding ((obj Diffie-HellmanKey)) - (get-element-encodings (list (g obj) (p obj)))) - - - - -(defclass RSAPublicKey (PublicKey) - ((e :accessor e :initarg :e) ;public exponent - (n :accessor n :initarg :n))) ;modulus - -(defun make-RSAPublicKey (e n) - (make-instance 'RSAPublicKey :e e :n n :algorithm "RSA")) - -(defmethod string-rep ((obj RSAPublicKey)) - (format nil "~A ~A" (e obj) (n obj))) - -(defmethod print-object ((obj RSAPublicKey) stream) - (format stream "<RSAPublicKey e=~A n=~A>" (e obj) (n obj))) - -(defclass RSAPrivateKey (PrivateKey) - ((d :accessor d :initarg :d) ;private exponent - (n :accessor n :initarg :n))) - -(defun make-RSAPrivateKey (d n) - (make-instance 'RSAPrivateKey :d d :n n :algorithm "RSA")) - -(defun make-RSAPublicKey-from-encoding (encoding) - (let ((lst (construct-from-encoding encoding 'RSA))) - (make-instance 'RSAPublicKey - :e (first lst) - :n (second lst) - :algorithm "RSA"))) - -(defun make-RSAPrivateKey-from-encoding (encoding) - (let ((lst (construct-from-encoding encoding 'RSA))) - (make-instance 'RSAPrivateKey - :d (first lst) - :n (second lst) - :algorithm "RSA"))) - -(defmethod string-rep ((obj RSAPrivateKey)) - (format nil "~A ~A" (d obj) (n obj))) - -(defmethod print-object ((obj RSAPrivateKey) stream) - (format stream "<RSAPrivateKey d=~A n=~A>" (d obj) (n obj))) - -(defmethod get-encoding ((obj RSAPublicKey)) - (get-element-encodings (list (e obj) (n obj)))) +(defun generate-symmetric-key (bitsize &optional algorithm) + (assert (= 0 (mod bitsize 8))) + (let ((octet-size (/ bitsize 8))) + (make-SymmetricKey (random-secure-octets octet-size) algorithm))) -(defmethod get-encoding ((obj RSAPrivateKey)) - (get-element-encodings (list (d obj) (n obj)))) -(defclass RSAKeyPair (KeyPair) - ()) +;; Can be used by lobo +(defgeneric key-from-encoding (keytype encoding)) -(defun make-RSAKeyPair (e d n) - (make-instance 'RSAKeyPair - :public (make-RSAPublicKey e n) - :private (make-RSAPrivateKey d n))) - -(defun aes-generate-key (&optional (bitsize 128) ) - (assert (member bitsize '(128 192 256)) () "AES invalid key size ~A" bitsize) - (generate-symmetric-key bitsize "AES")) - -(defun idea-generate-key (&optional (bitsize 128) ) - (assert (member bitsize '(128)) () "IDEA invalid key size ~A" bitsize) - (generate-symmetric-key bitsize "IDEA")) +(defmethod key-from-encoding ((keytype string) encoding) + "dispatch on keytype" + (do ((fun (get-key-from-encoding keytype) + (get-key-from-encoding keytype))) + (fun (apply fun (list encoding))) + (restart-case (error "No such keytype ~A implemented." keytype) + (store-value (value) + :report "Try another keytype." + :interactive + (lambda () + (format t "~&New keytype ") + (format + t "(use 'RSAPublicKey or RSAPublicKey, not \"RSAPublicKey\"): ") + (list (read))) + (typecase value + (cons (setf keytype (second value))) ;input format 'RSA + (symbol (setf keytype value))))))) + -(defun generate-symmetric-key (bitsize &optional algorithm) - (assert (= 0 (mod bitsize 8))) - (let ((octet-size (/ bitsize 8))) - (make-SymmetricKey (random-secure-octets octet-size) algorithm))) +(defparameter *key-from-encoding-table* (make-hash-table)) +(defun register-key-from-encoding (algorithm key-generator) + "The key generator function must accept one argument, an encoding. The encoding can be used to recreate a key." + ;; Store both symbol and symbol name + (setf (gethash algorithm *key-from-encoding-table*) key-generator) + (setf (gethash (symbol-name algorithm) + *key-from-encoding-table*) key-generator)) -(defun rsa-get-prime (bitsize e) - "Get a RSA prime n so that (n,e) = 1" - (do ((n (random-bignum-max-odd bitsize) - (random-bignum-max-odd bitsize))) - ((and (rsa-primep n) - (= 1 (gcd e (- n 1)))) - n))) - -(defun rsa-generate-keys (bitsize) - "Returns list with (public exponent, private exponent, modulus)" - (format t - "~&Generating ~A bits RSA keys, this may take some time..." bitsize) - (let* ((e 17) - (p (rsa-get-prime (floor bitsize 2) e)) - (q (rsa-get-prime (floor bitsize 2) e)) - (d (mod-inverse e (* (- p 1) (- q 1))))) - ;;(list e d p q (* p q)))) - (make-RSAKeyPair e d (* p q)))) - - - - -(defun generate-key (type &optional bitsize &key encoding) - "Ex: (generate-key 'AES 128)" - ;; NB! In Allegro string= handles both symbols and strings - (cond - (encoding - (cond - ((or (equal type 'RSAPublicKey) (string= type "RSAPublicKey")) - (make-RSAPublicKey-from-encoding encoding)) - ((or (equal type 'RSAPrivateKey) (string= type "RSAPrivateKey")) - (make-RSAPrivateKey-from-encoding encoding)) - ((or (equal type 'DSAPublicKey) (string= type "DSAPublicKey")) - (make-DSAPublicKey-from-encoding encoding)) - ((or (equal type 'DSAPrivateKey) (string= type "DSAPrivateKey")) - (make-DSAPrivateKey-from-encoding encoding)) - ((or (equal type 'Diffie-HellmanKey) (string= type "Diffie-Hellman")) - (make-Diffie-HellmanKey-from-encoding encoding)) - (t (error "generate-key:Unknown algorithm=~S of type=~A" - type (type-of type))))) - - ((or (equal type 'AES) (string= type "AES")) - (aes-generate-key bitsize)) - ((or (equal type 'IDEA) (string= type "IDEA")) - (idea-generate-key bitsize)) - ((or (equal type 'RSA) (string= type "RSA")) - (rsa-generate-keys bitsize)) - ((or (equal type 'DSA) (string= type "DSA")) - (dsa-generate-keys)) - ((or (equal type 'Diffie-Hellman) (string= type "Diffie-Hellman")) - (Diffie-Hellman-generate-key bitsize)) - (t (error "generate-key:Cannot generate key of type ~A" type)))) +(defun delete-key-from-encoding(algorithm) + (remhash algorithm *key-from-encoding-table*) + (remhash (symbol-name algorithm) *key-from-encoding-table*)) +(defun get-key-from-encoding (algorithm) + (gethash algorithm *key-from-encoding-table*)) @@ -213,16 +98,20 @@ (defparameter *key-generator-table* (make-hash-table)) (defun register-key-generator (algorithm key-generator) - (setf (gethash algorithm *key-generator-table*) key-generator)) + "The key generator function must accept one argument, a bitsize. The bitsize may be ignored (e.g. DSA)." + ;; Store both symbol and symbol name + (setf (gethash algorithm *key-generator-table*) key-generator) + (setf (gethash (symbol-name algorithm) + *key-generator-table*) key-generator)) (defun delete-key-generator(algorithm) - (remhash algorithm *key-generator-table*)) + (remhash algorithm *key-generator-table*) + (remhash (symbol-name algorithm) *key-generator-table*)) (defun get-key-generator (algorithm) (gethash algorithm *key-generator-table*)) - -(defun new-key (algorithm bitsize) +(defun generate-key (algorithm &optional bitsize) "Main function for getting new keys." (do ((fun (get-key-generator algorithm) (get-key-generator algorithm))) (fun (apply fun (list bitsize))) @@ -241,269 +130,3 @@ -;;;;;;; -;;; Key store - -;; Printed representation of KeyStore object -;; users: -;;( (("Tåle Skogan" "tasko@stud.cs.uit.no"...) ("22ffee" "55aadd" ...)) -;; (("Ross Anderson" "ross@acm.org" ...) ("eeff34"..:))) -;; ht: -;; "22ffee" -> #<RSAPrivateKey @ #x211f58ba> - -(defclass KeyStore () - ((path :accessor path :initarg :path) - (users :accessor users :initform ()) - (ht :accessor ht :initform (make-hash-table :test #'equal)))) - -(defun handle-RSAPublicKey (tokens) - (make-RSAPublicKey (parse-integer (first tokens)) - (parse-integer (second tokens)))) - -(defun handle-RSAPrivateKey (tokens) - (make-RSAPrivateKey (parse-integer (first tokens)) - (parse-integer (second tokens)))) - -(defun handle-DSAPublicKey (tokens) - (make-DSAPublicKey (parse-integer (nth 0 tokens)) - (parse-integer (nth 1 tokens)) - (parse-integer (nth 2 tokens)) - (parse-integer (nth 3 tokens)))) - -(defun handle-DSAPrivateKey (tokens) - (make-DSAPrivateKey (parse-integer (nth 0 tokens)) - (parse-integer (nth 1 tokens)) - (parse-integer (nth 2 tokens)) - (parse-integer (nth 3 tokens)) - (parse-integer (nth 4 tokens)))) - -|# -"Tåle Skogan" "tasko@stud.cs.uit.no" - first line -RSAPublicKey "22ffee" 5 119 - one line per key -RSAPrivateKey "22ffee" 77 119 -**** - separator between users -"Ron Rivest" "ron@acm.org" -RSAPublicKey "1234ffee" 3533 11413 -RSAPrivateKey "4321ffee" 6597 11413 -**** -#| - -(defun new-user (line) - (string= (string-trim " " line ) "****")) - -(defmethod put ((obj KeyStore) key-id key) - (setf (gethash key-id (ht obj)) key)) - -(defmethod insert-user ((obj KeyStore) names key-fingerprints) - (push (list names key-fingerprints) (users obj))) - -(defmethod find-entry ((obj KeyStore) names) - "Returns reference to entry where all names occur or nil." - (print names) - (dolist (entry (users obj)) - (print entry) - (when (subsetp names (first entry) :test #'string=) - (return entry)))) - -(defun get-int-fingerprint (int) - "Get fingerprint from integer. Uses the 64 least significant bits as in RFC 1991 (PGP)" - (hex-prepad-zero - (integer-to-octet-vector - (if (>= (integer-length int) 64) - (ldb (byte 64 0) int) - (ldb (byte (integer-length int) 0) int))) - 8)) - -(defmethod get-fingerprint ((obj Key)) - (etypecase obj - (DSAPublicKey (get-int-fingerprint (y obj))) - (DSAPublicKey (get-int-fingerprint (x obj))) - (RSAPublicKey (get-int-fingerprint (n obj))) - (RSAPrivateKey (get-int-fingerprint (n obj))))) - - - -(defun parse-user (obj stream usernames) - " -Stored as Lisp readable input: --RSAPublicKey ee23445566aabb e n --RSAPrivateKey 223344ddaaee23 d n -" - (let* ((names) - (key-fingerprints ())) - - ;; Parse user names in the first line - (let ((start 0)) - (loop - (multiple-value-bind (token end) - (read-from-string usernames nil 'eof :start start) - ;;(format t "~&Got:'~A' (start=~A, end=~A)" token start end) - (when (eq token 'eof) - (return)) ;break out of loop - (push (string token) names) - (setf start end)))) - - ;; Parse all key lines untill we reach a new user - (do ((line (read-line stream) (read-line stream nil 'eof))) - ((or (eq line 'eof) - (new-user line))) - - (let* ((tokens (split-string line " ")) - (type (read-from-string (first tokens))) ;make a token - (fingerprint (read-from-string (second tokens))) - (key-parts (cdr (cdr tokens))) - (key nil)) - (push fingerprint key-fingerprints) - - ;; Parse key parts and return a key object - (setf key - (case type - ('RSAPublicKey (handle-RSAPublicKey key-parts)) - ('RSAPrivateKey (handle-RSAPrivateKey key-parts)) - ('DSAPublicKey (handle-DSAPublicKey key-parts)) - ('DSAPrivateKey (handle-DSAPrivateKey key-parts)) - (t (error "~¬ a valid key type=~A" type)))) - (put obj fingerprint key))) - - (insert-user obj names key-fingerprints))) - - - - - - -(defmethod get-key ((obj KeyStore) fingerprint) - "Retrieves key" - (gethash fingerprint (ht obj))) - -|# -"Tåle Skogan" "tasko@stud.cs.uit.no" - first line -RSAPublicKey "22ffee" 5 119 - one line per key -RSAPrivateKey "22ffee" 77 119 -**** - separator between users -"Ron Rivest" "ron@acm.org" -RSAPublicKey "1234ffee" 3533 11413 -RSAPrivateKey "4321ffee" 6597 11413 -**** -#| - -(defmethod write-to-file ((obj KeyStore) &optional (filename (path obj))) - (with-open-file (str filename :direction :output :if-exists :supersede) - (dolist (user (users obj)) - ;; First line with user name and aliases - (dolist (name (first user) (format str "~%")) - (format str "~w " name)) - - ;; Print each key - (dolist (fingerprint (second user) (format str "****~%")) - (let ((key (get-key obj fingerprint))) - (format str "~w ~w ~A~%" - (type-of key) fingerprint (string-rep key))))))) - - -(defmethod write-KeyStore ((obj KeyStore) &optional (filename (path obj))) - (with-open-file (str filename :direction :output :if-exists :supersede) - (dolist (user (users obj)) - ;; First line with user name and aliases - (dolist (name (first user) (format str "~%")) - (format str "~w " name)) - - ;; Print each key - (dolist (fingerprint (second user) (format str "****~%")) - (let ((key (get-key obj fingerprint))) - (format str "~w ~w ~A~%" - (type-of key) fingerprint (string-rep key))))))) - - -(defun print-entry (id key) - (print (list id key))) - -(defmethod print-object ((obj KeyStore) (str stream)) - (format str "~&Users:") - (print (users obj) str) - (format str "~&Keys:") - (maphash #'(lambda (fingerprint key) - (format str "~&~A ~A" fingerprint key)) - (ht obj))) - - - -(defun load-KeyStore (obj path) - "NB! If a key has multiple id it will be stored several times" - (with-open-file (str path :direction :input) - (when str - (do ((line (read-line str) (read-line str nil 'eof))) - ((eq line 'eof)) - (parse-user obj str line))))) - -;;;;;;; -;;; User level API - -(defmethod reset ((obj KeyStore)) - (setf (path obj) nil) - (clrhash (ht obj))) - -(defmethod init-KeyStore ((obj KeyStore) &optional (path "keystore.txt")) - "Init object with data from path." - (reset obj) - (load-KeyStore obj path)) - -(defun make-KeyStore (&optional (path "keystore.txt")) - (let ((obj (make-instance 'KeyStore :path path))) - (load-KeyStore obj path) - obj)) - -(defmethod add-key ((obj KeyStore) names key) - "Adds key to keystore with the given list of names as identifiers. If the names already exists, store the key under the existing entry." - (let ((fingerprint (get-fingerprint key)) - (entry (find-entry obj names))) - (format t "~&add-key: Found entry: ~A" entry) - - ;; Add fingerprint if not already present, else make new user - (if entry - (setf (nth 1 entry) (adjoin fingerprint (nth 1 entry) :test #'string=)) - (push (list names (list fingerprint)) (users obj))) - - ;; Insert key unless already there. - (unless (gethash fingerprint (ht obj)) - (put obj fingerprint key)))) - - - -(defmethod get-keys ((obj KeyStore) user) - (let ((fingerprints - (dolist (entry (users obj)) - (when (member user (first entry) :test #'(lambda (u e) - (string= u e))) - (return (second entry)))))) - (mapcar #'(lambda (fingerprint) - (get-key obj fingerprint)) - fingerprints))) - -(defmethod get-public-keys ((obj KeyStore) user) - (let ((fingerprints - (dolist (entry (users obj)) - (when (member user (first entry) :test #'(lambda (u e) - (string= u e))) - (return (second entry)))))) - (delete nil - (mapcar #'(lambda (fingerprint) - (let ((key (get-key obj fingerprint))) - (when (subtypep (class-of key) 'PublicKey) - key))) - fingerprints)))) - -(defmethod get-dsa-public-keys ((obj KeyStore) user) - (delete-if-not #'(lambda (x) - (subtypep (class-of x) 'DSAPublicKey)) - (get-public-keys obj user))) - - -;; Register all key generators -(register-key-generator 'AES #'aes-generate-key) -(register-key-generator 'IDEA #'idea-generate-key) -(register-key-generator 'RSA #'rsa-generate-keys) -(register-key-generator 'DSA #'dsa-generate-keys) -(register-key-generator 'Diffie-Hellman #'Diffie-Hellman-generate-key) - -(register-constructor 'KeyStore #'make-KeyStore) \ No newline at end of file Index: crypticl/src/rsa.lisp diff -u crypticl/src/rsa.lisp:1.2 crypticl/src/rsa.lisp:1.3 --- crypticl/src/rsa.lisp:1.2 Sun Nov 7 01:17:35 2004 +++ crypticl/src/rsa.lisp Sun Nov 7 13:04:17 2004 @@ -142,6 +142,16 @@ (leftover-count :accessor leftover-count ;number of unprocessed octets :initform 0))) +(defclass RSAPrivateKey (PrivateKey) + ((d :accessor d :initarg :d) ;private exponent + (n :accessor n :initarg :n))) + + +(defclass RSAPublicKey (PublicKey) + ((e :accessor e :initarg :e) ;public exponent + (n :accessor n :initarg :n))) ;modulus + + (defun make-RSA () "Constructor." (make-instance 'RSA :algorithm "RSA")) @@ -307,7 +317,85 @@ (if (vector-equal (decrypt cipher sig) hash) t nil))) - + + + + + +;;;;;; +;;; Key generation + + +(defun make-RSAPublicKey (e n) + (make-instance 'RSAPublicKey :e e :n n :algorithm "RSA")) + +(defmethod string-rep ((obj RSAPublicKey)) + (format nil "~A ~A" (e obj) (n obj))) + +(defmethod print-object ((obj RSAPublicKey) stream) + (format stream "<RSAPublicKey e=~A n=~A>" (e obj) (n obj))) + + + +(defun make-RSAPrivateKey (d n) + (make-instance 'RSAPrivateKey :d d :n n :algorithm "RSA")) + +(defun make-RSAPublicKey-from-encoding (encoding) + (let ((lst (construct-from-encoding encoding 'RSA))) + (make-instance 'RSAPublicKey + :e (first lst) + :n (second lst) + :algorithm "RSA"))) + +(defun make-RSAPrivateKey-from-encoding (encoding) + (let ((lst (construct-from-encoding encoding 'RSA))) + (make-instance 'RSAPrivateKey + :d (first lst) + :n (second lst) + :algorithm "RSA"))) + +(defmethod string-rep ((obj RSAPrivateKey)) + (format nil "~A ~A" (d obj) (n obj))) + +(defmethod print-object ((obj RSAPrivateKey) stream) + (format stream "<RSAPrivateKey d=~A n=~A>" (d obj) (n obj))) + +(defmethod get-encoding ((obj RSAPublicKey)) + (get-element-encodings (list (e obj) (n obj)))) + +(defmethod get-encoding ((obj RSAPrivateKey)) + (get-element-encodings (list (d obj) (n obj)))) + + +(defclass RSAKeyPair (KeyPair) + ()) + +(defun make-RSAKeyPair (e d n) + (make-instance 'RSAKeyPair + :public (make-RSAPublicKey e n) + :private (make-RSAPrivateKey d n))) + + +(defun rsa-get-prime (bitsize e) + "Get a RSA prime n so that (n,e) = 1" + (do ((n (random-bignum-max-odd bitsize) + (random-bignum-max-odd bitsize))) + ((and (rsa-primep n) + (= 1 (gcd e (- n 1)))) + n))) + +(defun rsa-generate-keys (bitsize) + "Returns list with (public exponent, private exponent, modulus)" + (format t + "~&Generating ~A bits RSA keys, this may take some time..." bitsize) + (let* ((e 17) + (p (rsa-get-prime (floor bitsize 2) e)) + (q (rsa-get-prime (floor bitsize 2) e)) + (d (mod-inverse e (* (- p 1) (- q 1))))) + ;;(list e d p q (* p q)))) + (make-RSAKeyPair e d (* p q)))) + + ;;;;;;;;; ;;; Test suite @@ -421,4 +509,7 @@ (register-constructor 'RSA #'make-RSA) -(register-constructor 'SHA1withRSA #'make-SHA1withRSA) \ No newline at end of file +(register-constructor 'SHA1withRSA #'make-SHA1withRSA) +(register-key-generator 'RSA #'rsa-generate-keys) +(register-key-from-encoding 'RSAPublicKey #'make-RSAPublicKey-from-encoding) +(register-key-from-encoding 'RSAPrivateKey #'make-RSAPrivateKey-from-encoding)