;;;; make-cipher.lisp -- all the machinery necessary for MAKE-CIPHER (in-package :crypto)  ;;; Validity of modes for ciphers. (defgeneric valid-mode-for-cipher-p (cipher mode)) (defmethod valid-mode-for-cipher-p (cipher mode)   nil) (defun valid-mode-for-block-cipher-p (mode)   (member mode '(:ecb :cbc :ofb :cfb :cfb8 :ctr                  ecb cbc ofb cfb cfb8 ctr))) (defmethod valid-mode-for-cipher-p ((cipher 16-byte-block-mixin) mode)   (valid-mode-for-block-cipher-p mode)) (defmethod valid-mode-for-cipher-p ((cipher 8-byte-block-mixin) mode)   (valid-mode-for-block-cipher-p mode)) (defmethod valid-mode-for-cipher-p ((cipher stream-cipher) mode)   (or (eq mode :stream) (eq mode 'stream))) (defun make-mode-for-cipher (cipher mode &optional initialization-vector)   (let ((block-length (block-length cipher)))     (flet ((make-extended-mode (mode-class)              (declare (ignorable mode-class))              (unless initialization-vector                (error 'initialization-vector-not-supplied                       :mode mode))              (unless (typep initialization-vector '(vector (unsigned-byte 8)))                (error 'type-error                       :datum initialization-vector                       :expected-type '(vector (unsigned-byte 8))))              (unless (= (length initialization-vector) block-length)                (error 'invalid-initialization-vector                       :cipher (class-name (class-of cipher))                       :block-length block-length))              (make-instance mode-class                             :initialization-vector (copy-seq initialization-vector))))     (case mode       ((:ecb ecb)        (make-instance 'ecb-mode))       ((:cbc cbc)        (make-extended-mode 'cbc-mode))       ((:ofb ofb)        (make-extended-mode 'ofb-mode))       ((:cfb cfb)        (make-extended-mode 'cfb-mode))       ((:cfb8 cfb8)        (make-extended-mode 'cfb8-mode))       ((:ctr ctr)        (make-extended-mode 'ctr-mode))       (:stream (make-instance 'stream-mode))       (t        (error 'unsupported-mode :mode mode))))))  ;;; CLOS methods. ;;; This is where all the work gets done. (defmethod shared-initialize :after ((cipher cipher) slot-names                               &rest initargs                               &key (key nil key-p) (mode nil mode-p)                               (padding nil padding-p)                               (initialization-vector nil iv-p)                               &allow-other-keys)   (declare (ignorable padding padding-p iv-p initargs))   ;; We always want to check that we have a valid key when we initialize  ;; a cipher (what good is an unkeyed cipher?).  We want to check for  ;; a valid key upon reinitialization only if one has been provided.  (when (or (not (initialized-p cipher)) key-p)     (schedule-key cipher key))   ;; Check that the mode is valid for the cipher we are initializing.  (when (and (or (not (initialized-p cipher)) mode-p)              (not (valid-mode-for-cipher-p cipher mode)))     ;; FIXME: (CLASS-NAME (CLASS-OF ...)) is not quite right.    (error 'unsupported-mode :mode mode            :cipher (class-name (class-of cipher))))   (when mode-p     (let ((mode-instance (make-mode-for-cipher cipher mode initialization-vector)))       (typecase (mode cipher)         #+nil         (padded-mode          (setf (mode (mode cipher)) mode-instance))         (t          (setf (mode cipher) mode-instance)))))   #+nil   (when padding-p     (typecase (mode cipher)       (padded-mode        (setf (padding (mode cipher)) padding))       (t        (setf (padding (mode cipher))              (make-instance 'padded-mode :mode mode :padding padding)))))   cipher) (defmethod initialize-instance :after ((cipher cipher)                                        &rest initargs                                        &key key mode padding                                        initialization-vector                                        &allow-other-keys)   (declare (ignore key mode padding initialization-vector initargs))   (setf (initialized-p cipher) t)   cipher) (defun %block-cipher-p (info)   (not (= (%block-length info) 1))) (defun make-cipher (name &key key mode initialization-vector padding)   "Return a cipher object using algorithm NAME with KEY in the specified MODE.  If MODE requires an initialization vector, it must be provided as INITIALIZATION-VECTOR; otherwise, the INITIALIZATION-VECTOR argument is ignored."   (let ((cipher-info (%find-cipher name)))     (unless cipher-info       (error 'unsupported-cipher :name name))     ;; Check for validity of the mode.    (cond       ((%block-cipher-p cipher-info)        ;; Block cipher.       (when (or (eq mode 'stream) (eq mode :stream))          (error 'unsupported-mode :cipher name :mode mode)))       (t        ;; Stream cipher.       (unless (or (eq mode 'stream) (eq mode :stream))          (error 'unsupposed-mode :cipher name :mode mode))        (when padding          (error "padding is not supported for stream ciphers"))))     (make-instance (%class-name cipher-info) :key key :mode mode                    :initialization-vector initialization-vector                    :padding padding)))