;;;; dsa.lisp -- implementation of the Digital Signature Algorithm (in-package :crypto)  ;;; class definitions (defclass discrete-logarithm-group ()   ((p :initarg :p :reader group-pval)    (q :initarg :q :reader group-qval)    (g :initarg :g :reader group-gval))) (defclass dsa-key ()   ((group :initarg :group :reader group))) (defclass dsa-public-key (dsa-key)   ((y :initarg :y :reader dsa-key-y :type integer))) (defclass dsa-private-key (dsa-key)   ((y :initarg :y :reader dsa-key-y :type integer)    (x :initarg :x :reader dsa-key-x :type integer))) (defclass dsa-signature ()   ((r :initarg :r :reader dsa-signature-r)    (s :initarg :s :reader dsa-signature-s))) (defun dsa-key-p (dsa-key)   (slot-value (group dsa-key) 'group-p)) (defun dsa-key-q (dsa-key)   (slot-value (group dsa-key) 'group-q)) (defun dsa-key-g (dsa-key)   (slot-value (group dsa-key) 'group-g))  ;;; function definitions (defun make-dsa-signature (r s)   (make-instance 'dsa-signature                  :r (maybe-integerize r) :s (maybe-integerize s))) (defmethod make-public-key ((kind (eql :dsa))                             &key p q g y &allow-other-keys)   (let ((group (make-instance 'discrete-logarithm-group :p p :q q :g g)))     (make-instance 'dsa-public-key :group group :y y))) (defmethod make-private-key ((kind (eql :dsa))                              &key p q g y x &allow-other-keys)   (unless (and p q g)     ;; FIXME: "real" ironclad error needed here    (error "Must specify all members of the DL group for DSA"))   (let ((group (make-instance 'discrete-logarithm-group :p p :q q :g g)))     (make-instance 'dsa-private-key :group group :y y :x x))) (defconstant +dsa-message-length+ 20) ;;; Note that hashing is not performed here. (defmethod sign-message ((key dsa-private-key) message &key (start 0) end)   (let ((end (or end (length message))))     (unless (= (- end start) +dsa-message-length+)       ;; FIXME: "real" ironclad error needed here      (error "Can only sign exactly 20 bytes of message with DSA"))     (let* ((group (group key))            (k (random (group-qval group)))            (r (mod (expt-mod (group-gval group) k (group-pval group))                    (group-qval group)))            (message-integer (octets-to-integer message :start start :end end))            (k-inverse (modular-inverse k (group-qval group)))            (s (mod (* k-inverse                       (+ (* (dsa-key-x key) r) message-integer))                    (group-qval group))))       (assert (= (mod (* k k-inverse) (group-qval group)) 1))       (make-dsa-signature (integer-to-octets r) (integer-to-octets s))))) (defmethod verify-signature ((key dsa-public-key) message (signature dsa-signature)                              &key (start 0) end)   (let ((end (or end (length message))))     (unless (= (- end start) +dsa-message-length+)       ;; FIXME: "real" ironclad error needed here      (error "Can only verify exactly 20 bytes of message with DSA"))     (let* ((group (group key))            (message-integer (octets-to-integer message))            (r-integer (maybe-integerize (dsa-signature-r signature)))            (s-integer (maybe-integerize (dsa-signature-s signature)))            (w (mod (modular-inverse s-integer (group-qval group))                    (group-qval group)))            (u1 (mod (* message-integer w) (group-qval group)))            (u2 (mod (* r-integer w) (group-qval group)))            (v (mod (mod (* (expt-mod (group-gval group) u1 (group-pval group))                            (expt-mod (dsa-key-y key) u2 (group-pval group)))                         (group-pval group))                    (group-qval group))))       (= v r-integer))))