Coverage report: /home/ellis/comp/ext/ironclad/src/ciphers/make-cipher.lisp

KindCoveredAll%
expression87225 38.7
branch1532 46.9
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;;; make-cipher.lisp -- all the machinery necessary for MAKE-CIPHER
2
 (in-package :crypto)
3
 
4
 ;;; Validity of modes for ciphers.
5
 (defmethod valid-mode-for-cipher-p (cipher mode)
6
   nil)
7
 
8
 (defun valid-mode-for-block-cipher-p (mode)
9
   (member mode '(:ecb :cbc :ofb :cfb :cfb8 :ctr
10
                  ecb cbc ofb cfb cfb8 ctr)))
11
 
12
 (defmethod valid-mode-for-cipher-p ((cipher 128-byte-block-mixin) mode)
13
   (valid-mode-for-block-cipher-p mode))
14
 
15
 (defmethod valid-mode-for-cipher-p ((cipher 64-byte-block-mixin) mode)
16
   (valid-mode-for-block-cipher-p mode))
17
 
18
 (defmethod valid-mode-for-cipher-p ((cipher 32-byte-block-mixin) mode)
19
   (valid-mode-for-block-cipher-p mode))
20
 
21
 (defmethod valid-mode-for-cipher-p ((cipher 16-byte-block-mixin) mode)
22
   (valid-mode-for-block-cipher-p mode))
23
 
24
 (defmethod valid-mode-for-cipher-p ((cipher 8-byte-block-mixin) mode)
25
   (valid-mode-for-block-cipher-p mode))
26
 
27
 (defmethod valid-mode-for-cipher-p ((cipher stream-cipher) mode)
28
   (or (eq mode :stream) (eq mode 'stream)))
29
 
30
 (defun make-mode-for-cipher (cipher mode &optional initialization-vector padding)
31
   (let ((block-length (block-length cipher)))
32
     (flet ((make-extended-mode (mode-class)
33
              (declare (ignorable mode-class))
34
              (unless initialization-vector
35
                (error 'initialization-vector-not-supplied
36
                       :mode mode))
37
              (unless (typep initialization-vector '(vector (unsigned-byte 8)))
38
                (error 'type-error
39
                       :datum initialization-vector
40
                       :expected-type '(vector (unsigned-byte 8))))
41
              (unless (= (length initialization-vector) block-length)
42
                (error 'invalid-initialization-vector
43
                       :cipher (class-name (class-of cipher))
44
                       :block-length block-length))
45
              (make-instance mode-class
46
                             :initialization-vector (copy-seq initialization-vector)
47
                             :padding padding
48
                             :cipher cipher)))
49
     (case mode
50
       ((:ecb ecb)
51
        (make-instance 'ecb-mode :cipher cipher :padding padding))
52
       ((:cbc cbc)
53
        (make-extended-mode 'cbc-mode))
54
       ((:ofb ofb)
55
        (make-extended-mode 'ofb-mode))
56
       ((:cfb cfb)
57
        (make-extended-mode 'cfb-mode))
58
       ((:cfb8 cfb8)
59
        (make-extended-mode 'cfb8-mode))
60
       ((:ctr ctr)
61
        (make-extended-mode 'ctr-mode))
62
       ((:stream stream)
63
        (make-instance 'stream-mode :cipher cipher))
64
       (t
65
        (error 'unsupported-mode :mode mode))))))
66
 
67
 ;;; CLOS methods.
68
 
69
 ;;; This is where all the work gets done.
70
 (defmethod shared-initialize :after ((cipher cipher) slot-names
71
                                      &rest initargs
72
                                      &key (key nil key-p) (mode nil mode-p)
73
                                        (padding nil padding-p)
74
                                        (initialization-vector nil iv-p)
75
                                      &allow-other-keys)
76
   (declare (ignorable padding padding-p iv-p initargs))
77
   ;; We always want to check that we have a valid key when we initialize
78
   ;; a cipher (what good is an unkeyed cipher?).  We want to check for
79
   ;; a valid key upon reinitialization only if one has been provided.
80
   (when (or (not (initialized-p cipher)) key-p)
81
     (schedule-key cipher key))
82
   ;; Check that the mode is valid for the cipher we are initializing.
83
   (when (and (or (not (initialized-p cipher)) mode-p)
84
              (not (valid-mode-for-cipher-p cipher mode)))
85
     ;; FIXME: (CLASS-NAME (CLASS-OF ...)) is not quite right.
86
     (error 'unsupported-mode :mode mode :cipher (class-name (class-of cipher))))
87
   (when (and iv-p
88
              (not mode-p))
89
     (setq mode (mode-name cipher)))
90
   (when (or mode-p iv-p padding-p)
91
     (setf (slot-value cipher 'mode-name) mode)
92
     (let ((mode-instance (make-mode-for-cipher cipher mode initialization-vector padding)))
93
       (setf (mode cipher) mode-instance)))
94
   cipher)
95
 
96
 (defmethod initialize-instance :after ((cipher cipher)
97
                                        &rest initargs
98
                                        &key key mode padding tweak
99
                                        initialization-vector
100
                                        &allow-other-keys)
101
   (declare (ignore key mode padding initialization-vector initargs tweak))
102
   (setf (initialized-p cipher) t)
103
   cipher)
104
 
105
 (defun %block-cipher-p (info)
106
   (not (= (%block-length info) 1)))
107
 
108
 (defun find-cipher-or-lose (name)
109
   (let ((cipher-info (%find-cipher name)))
110
     (unless cipher-info
111
       (error 'unsupported-cipher :name name))
112
     cipher-info))
113
 
114
 (defun validate-parameters-for-cipher-info (cipher-info mode padding)
115
   (cond
116
     ((%block-cipher-p cipher-info)
117
      ;; Block cipher.
118
      (when (or (eq mode 'stream) (eq mode :stream))
119
        (error 'unsupported-mode :cipher (cipher cipher-info) :mode mode)))
120
     (t
121
      ;; Stream cipher.
122
      (unless (or (eq mode 'stream) (eq mode :stream))
123
        (error 'unsupported-mode :cipher (cipher cipher-info) :mode mode))
124
      (when padding
125
        (error 'ironclad-error :format-control "padding is not supported for stream ciphers"))))
126
   cipher-info)
127
 
128
 (defun make-cipher (name &key key mode initialization-vector padding tweak)
129
   "Return a cipher object using algorithm NAME with KEY in the
130
 specified MODE.  If MODE requires an initialization vector, it
131
 must be provided as INITIALIZATION-VECTOR; otherwise, the
132
 INITIALIZATION-VECTOR argument is ignored.  If the cipher can
133
 can use a tweak, it can be provided with the TWEAK argument."
134
   (let ((cipher-info (find-cipher-or-lose name)))
135
     (validate-parameters-for-cipher-info cipher-info mode padding)
136
     (make-instance (%class-name cipher-info) :key key :mode mode
137
                    :initialization-vector initialization-vector
138
                    :padding padding
139
                    :tweak tweak)))
140
 
141
 ;;; Many implementations can optimize MAKE-INSTANCE of a constant class
142
 ;;; name; try to enable that optimization by converting MAKE-CIPHER to
143
 ;;; such a form.
144
 (define-compiler-macro make-cipher (&whole form &environment env
145
                                            name
146
                                            &rest keys
147
                                            &key key mode initialization-vector padding tweak &allow-other-keys)
148
   (declare (ignore env keys))
149
   (cond
150
    ((or (keywordp name)
151
         (and (quotationp name) (symbolp name)))
152
     (let ((cipher-info (ignore-errors
153
                          (validate-parameters-for-cipher-info
154
                           (find-cipher-or-lose (unquote name))
155
                           (unquote mode)
156
                           padding))))
157
       (if cipher-info
158
           `(make-instance ',(%class-name cipher-info)
159
                           :key ,key :mode ,mode
160
                           :initialization-vector ,initialization-vector
161
                           :padding ,padding
162
                           :tweak ,tweak)
163
           form)))
164
    (t form)))