Coverage report: /home/ellis/comp/ext/ironclad/src/aead/gcm.lisp

KindCoveredAll%
expression0340 0.0
branch030 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;;; gcm.lisp -- Galois counter mode
2
 
3
 ;; See nistspecialpublication800-38d.pdf about GCM and GMAC.
4
 (in-package :crypto)
5
 
6
 
7
 (defclass gcm (aead-mode)
8
   ((cipher :accessor gcm-cipher
9
            :initform nil)
10
    (mac :accessor gcm-mac
11
         :initform nil)
12
    (associated-data-length :accessor gcm-ad-length
13
                            :initform 0
14
                            :type (integer 0 *))
15
    (encrypted-data-length :accessor gcm-ed-length
16
                           :initform 0
17
                           :type (integer 0 *))))
18
 
19
 (defmethod shared-initialize :after ((mode gcm) slot-names &rest initargs &key key cipher-name initialization-vector &allow-other-keys)
20
   (declare (ignore slot-names initargs)
21
            (type simple-octet-vector key initialization-vector))
22
   (let* ((mac (if (or (null (gcm-mac mode)) cipher-name)
23
                   (make-mac :gmac key cipher-name initialization-vector)
24
                   (reinitialize-instance (gcm-mac mode)
25
                                          :key key
26
                                          :initialization-vector initialization-vector)))
27
          (iv (let* ((iv (gmac-j0 mac))
28
                     (counter (subseq iv 12)))
29
                (increment-counter-block-1 4 counter)
30
                (replace iv counter :start1 12)))
31
          (cipher (if (or (null (gcm-cipher mode)) cipher-name)
32
                      (make-cipher cipher-name
33
                                   :key key
34
                                   :mode :ctr
35
                                   :initialization-vector iv)
36
                      (reinitialize-instance (gcm-cipher mode)
37
                                             :key key
38
                                             :mode :ctr
39
                                             :initialization-vector iv))))
40
     (setf (gcm-mac mode) mac
41
           (gcm-cipher mode) cipher
42
           (gcm-ad-length mode) 0
43
           (gcm-ed-length mode) 0))
44
   mode)
45
 
46
 (defmethod process-associated-data ((mode gcm) data &key (start 0) end)
47
   (if (encryption-started-p mode)
48
       (error 'ironclad-error :format-control "All associated data must be processed before the encryption begins.")
49
       (let* ((end (or end (length data)))
50
              (length (- end start)))
51
         (incf (gcm-ad-length mode) length)
52
         (update-mac (gcm-mac mode) data :start start :end end))))
53
 
54
 (defmethod produce-tag ((mode gcm) &key tag (tag-start 0))
55
   (let* ((encrypted-data-length (gcm-ed-length mode))
56
          (mac (gcm-mac mode))
57
          (mac-digest (gmac-digest mac encrypted-data-length))
58
          (digest-size (length mac-digest)))
59
     (etypecase tag
60
       (simple-octet-vector
61
        (if (<= digest-size (- (length tag) tag-start))
62
            (replace tag mac-digest :start1 tag-start)
63
            (error 'insufficient-buffer-space
64
                   :buffer tag
65
                   :start tag-start
66
                   :length digest-size)))
67
       (null
68
        mac-digest))))
69
 
70
 (defmethod encrypt ((mode gcm) plaintext ciphertext &key (plaintext-start 0) plaintext-end (ciphertext-start 0) handle-final-block)
71
   (declare (ignore handle-final-block))
72
   (let ((cipher (gcm-cipher mode))
73
         (mac (gcm-mac mode))
74
         (plaintext-end (or plaintext-end (length plaintext)))
75
         (consumed-bytes 0)
76
         (produced-bytes 0))
77
     (when (< plaintext-start plaintext-end)
78
       (unless (encryption-started-p mode)
79
         (let* ((associated-data-length (gcm-ad-length mode))
80
                (remaining (mod associated-data-length 16))
81
                (padding-length (if (zerop remaining) 0 (- 16 remaining)))
82
                (padding (make-array 16 :element-type '(unsigned-byte 8) :initial-element 0)))
83
           (declare (dynamic-extent padding))
84
           (update-mac mac padding :end padding-length)
85
           (decf (gmac-total-length mac) padding-length))
86
         (setf (encryption-started-p mode) t))
87
       (multiple-value-setq (consumed-bytes produced-bytes)
88
         (encrypt cipher plaintext ciphertext
89
                  :plaintext-start plaintext-start :plaintext-end plaintext-end
90
                  :ciphertext-start ciphertext-start))
91
       (incf (gcm-ed-length mode) produced-bytes)
92
       (update-mac mac ciphertext
93
                   :start ciphertext-start :end (+ ciphertext-start produced-bytes)))
94
     (values consumed-bytes produced-bytes)))
95
 
96
 (defmethod decrypt ((mode gcm) ciphertext plaintext &key (ciphertext-start 0) ciphertext-end (plaintext-start 0) handle-final-block)
97
   (let ((cipher (gcm-cipher mode))
98
         (mac (gcm-mac mode))
99
         (ciphertext-end (or ciphertext-end (length ciphertext)))
100
         (consumed-bytes 0)
101
         (produced-bytes 0))
102
     (when (< ciphertext-start ciphertext-end)
103
       (unless (encryption-started-p mode)
104
         (let* ((associated-data-length (gcm-ad-length mode))
105
                (remaining (mod associated-data-length 16))
106
                (padding-length (if (zerop remaining) 0 (- 16 remaining)))
107
                (padding (make-array 16 :element-type '(unsigned-byte 8) :initial-element 0)))
108
           (declare (dynamic-extent padding))
109
           (update-mac mac padding :end padding-length)
110
           (decf (gmac-total-length mac) padding-length))
111
         (setf (encryption-started-p mode) t))
112
       (update-mac mac ciphertext
113
                   :start ciphertext-start :end ciphertext-end)
114
       (multiple-value-setq (consumed-bytes produced-bytes)
115
         (decrypt cipher ciphertext plaintext
116
                  :ciphertext-start ciphertext-start :ciphertext-end ciphertext-end
117
                  :plaintext-start plaintext-start))
118
       (incf (gcm-ed-length mode) consumed-bytes))
119
     (when (and handle-final-block (tag mode))
120
       (let* ((correct-tag (tag mode))
121
              (encrypted-data-length (gcm-ed-length mode))
122
              (full-tag (gmac-digest mac encrypted-data-length))
123
              (tag (if (< (length correct-tag) (length full-tag))
124
                       (subseq full-tag 0 (length correct-tag))
125
                       full-tag)))
126
         (unless (constant-time-equal tag correct-tag)
127
           (error 'bad-authentication-tag))))
128
     (values consumed-bytes produced-bytes)))
129
 
130
 (defmethod encrypt-message ((mode gcm) message &key (start 0) end associated-data (associated-data-start 0) associated-data-end &allow-other-keys)
131
   (let* ((length (- (or end (length message)) start))
132
          (encrypted-message (make-array length :element-type '(unsigned-byte 8))))
133
     (when associated-data
134
       (process-associated-data mode associated-data
135
                                :start associated-data-start :end associated-data-end))
136
     (encrypt mode message encrypted-message
137
              :plaintext-start start :plaintext-end end)
138
     encrypted-message))
139
 
140
 (defmethod decrypt-message ((mode gcm) message &key (start 0) end associated-data (associated-data-start 0) associated-data-end &allow-other-keys)
141
   (let* ((length (- (or end (length message)) start))
142
          (decrypted-message (make-array length :element-type '(unsigned-byte 8))))
143
     (when associated-data
144
       (process-associated-data mode associated-data
145
                                :start associated-data-start :end associated-data-end))
146
     (decrypt mode message decrypted-message
147
              :plaintext-start start :plaintext-end end
148
              :handle-final-block t)
149
     decrypted-message))
150
 
151
 (defaead gcm)