[crypticl-cvs] CVS update: crypticl/src/keystore.lisp crypticl/src/aes.lisp crypticl/src/crypticl-package.lisp crypticl/src/diffie-hellman.lisp crypticl/src/dsa.lisp crypticl/src/idea.lisp crypticl/src/keygenerator.lisp crypticl/src/rsa.lisp
Taale Skogan
tskogan at common-lisp.net
Sun Nov 7 12:04:31 UTC 2004
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 at 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 at 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 at stud.cs.uit.no"...) ("22ffee" "55aadd" ...))
-;; (("Ross Anderson" "ross at 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 at stud.cs.uit.no" - first line
-RSAPublicKey "22ffee" 5 119 - one line per key
-RSAPrivateKey "22ffee" 77 119
-**** - separator between users
-"Ron Rivest" "ron at 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 at stud.cs.uit.no" - first line
-RSAPublicKey "22ffee" 5 119 - one line per key
-RSAPrivateKey "22ffee" 77 119
-**** - separator between users
-"Ron Rivest" "ron at 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)
More information about the Crypticl-cvs
mailing list