Coverage report: /home/ellis/comp/ext/ironclad/src/macs/poly1305.lisp

KindCoveredAll%
expression0401 0.0
branch014 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;;; poly1305.lisp -- RFC 7539 poly1305 message authentication code
2
 
3
 (in-package :crypto)
4
 
5
 (defclass poly1305 (mac)
6
   ((accumulator :accessor poly1305-accumulator
7
                 :initform (make-array 5 :element-type '(unsigned-byte 32))
8
                 :type (simple-array (unsigned-byte 32) (5)))
9
    (r :accessor poly1305-r
10
       :initform (make-array 4 :element-type '(unsigned-byte 32))
11
       :type (simple-array (unsigned-byte 32) (4)))
12
    (s :accessor poly1305-s
13
       :initform (make-array 4 :element-type '(unsigned-byte 32))
14
       :type (simple-array (unsigned-byte 32) (4)))
15
    (buffer :accessor poly1305-buffer
16
            :initform (make-array 16 :element-type '(unsigned-byte 8))
17
            :type (simple-array (unsigned-byte 8) (16)))
18
    (buffer-length :accessor poly1305-buffer-length
19
                   :initform 0
20
                   :type (integer 0 16))))
21
 
22
 (defun make-poly1305 (key)
23
   (declare (type (simple-array (unsigned-byte 8) (*)) key))
24
   (unless (= (length key) 32)
25
     (error 'invalid-mac-parameter
26
            :mac-name 'poly1305
27
            :message "The key length must be 32 bytes"))
28
   (make-instance 'poly1305 :key key))
29
 
30
 (defmethod shared-initialize :after ((mac poly1305) slot-names &rest initargs &key key &allow-other-keys)
31
   (declare (ignore slot-names initargs)
32
            (type (simple-array (unsigned-byte 8) (32)) key))
33
   (let ((accumulator (poly1305-accumulator mac))
34
         (r (poly1305-r mac))
35
         (s (poly1305-s mac)))
36
     (declare (type (simple-array (unsigned-byte 32) (5)) accumulator)
37
              (type (simple-array (unsigned-byte 32) (4)) r s))
38
     (fill accumulator 0)
39
     (setf (aref r 0) (logand (ub32ref/le key 0) #x0fffffff)
40
           (aref r 1) (logand (ub32ref/le key 4) #x0ffffffc)
41
           (aref r 2) (logand (ub32ref/le key 8) #x0ffffffc)
42
           (aref r 3) (logand (ub32ref/le key 12) #x0ffffffc))
43
     (setf (aref s 0) (ub32ref/le key 16)
44
           (aref s 1) (ub32ref/le key 20)
45
           (aref s 2) (ub32ref/le key 24)
46
           (aref s 3) (ub32ref/le key 28))
47
     (setf (poly1305-buffer-length mac) 0)
48
     mac))
49
 
50
 (defun poly1305-process-full-blocks (accumulator r data start remaining final)
51
   (declare (type (simple-array (unsigned-byte 32) (5)) accumulator)
52
            (type (simple-array (unsigned-byte 32) (4)) r)
53
            (type (simple-array (unsigned-byte 8) (*)) data)
54
            (type index start remaining)
55
            (type boolean final)
56
            (optimize (speed 3) (space 0) (safety 0) (debug 0)))
57
   (let* ((hibit (if final 0 1))
58
          (h0 (aref accumulator 0))
59
          (h1 (aref accumulator 1))
60
          (h2 (aref accumulator 2))
61
          (h3 (aref accumulator 3))
62
          (h4 (aref accumulator 4))
63
          (r0 (aref r 0))
64
          (r1 (aref r 1))
65
          (r2 (aref r 2))
66
          (r3 (aref r 3))
67
          (rr0 (mod32* (mod32ash r0 -2) 5))
68
          (rr1 (mod32+ (mod32ash r1 -2) r1))
69
          (rr2 (mod32+ (mod32ash r2 -2) r2))
70
          (rr3 (mod32+ (mod32ash r3 -2) r3)))
71
     (declare (type (unsigned-byte 32) hibit h0 h1 h2 h3 h4 r0 r1 r2 r3 rr0 rr1 rr2 rr3))
72
     (loop while (>= remaining 16) do
73
       (let* ((s0 (mod64+ h0 (ub32ref/le data start)))
74
              (s1 (mod64+ h1 (ub32ref/le data (+ start 4))))
75
              (s2 (mod64+ h2 (ub32ref/le data (+ start 8))))
76
              (s3 (mod64+ h3 (ub32ref/le data (+ start 12))))
77
              (s4 (mod32+ h4 hibit))
78
              (x0 (mod64+ (mod64* s0 r0)
79
                          (mod64+ (mod64* s1 rr3)
80
                                  (mod64+ (mod64* s2 rr2)
81
                                          (mod64+ (mod64* s3 rr1)
82
                                                  (mod64* s4 rr0))))))
83
              (x1 (mod64+ (mod64* s0 r1)
84
                          (mod64+ (mod64* s1 r0)
85
                                  (mod64+ (mod64* s2 rr3)
86
                                          (mod64+ (mod64* s3 rr2)
87
                                                  (mod64* s4 rr1))))))
88
              (x2 (mod64+ (mod64* s0 r2)
89
                          (mod64+ (mod64* s1 r1)
90
                                  (mod64+ (mod64* s2 r0)
91
                                          (mod64+ (mod64* s3 rr3)
92
                                                  (mod64* s4 rr2))))))
93
              (x3 (mod64+ (mod64* s0 r3)
94
                          (mod64+ (mod64* s1 r2)
95
                                  (mod64+ (mod64* s2 r1)
96
                                          (mod64+ (mod64* s3 r0)
97
                                                  (mod64* s4 rr3))))))
98
              (x4 (mod32* s4 (logand r0 3)))
99
              (u5 (mod32+ x4 (logand (mod64ash x3 -32) #xffffffff)))
100
              (u0 (mod64+ (mod64* (mod32ash u5 -2) 5)
101
                          (logand x0 #xffffffff)))
102
              (u1 (mod64+ (mod64ash u0 -32)
103
                          (mod64+ (logand x1 #xffffffff)
104
                                  (mod64ash x0 -32))))
105
              (u2 (mod64+ (mod64ash u1 -32)
106
                          (mod64+ (logand x2 #xffffffff)
107
                                  (mod64ash x1 -32))))
108
              (u3 (mod64+ (mod64ash u2 -32)
109
                          (mod64+ (logand x3 #xffffffff)
110
                                  (mod64ash x2 -32))))
111
              (u4 (mod64+ (mod64ash u3 -32)
112
                          (logand u5 3))))
113
         (declare (type (unsigned-byte 64) s0 s1 s2 s3 x0 x1 x2 x3 u0 u1 u2 u3 u4)
114
                  (type (unsigned-byte 32) s4 x4 u5))
115
         (setf h0 (logand u0 #xffffffff)
116
               h1 (logand u1 #xffffffff)
117
               h2 (logand u2 #xffffffff)
118
               h3 (logand u3 #xffffffff)
119
               h4 (logand u4 #xffffffff)))
120
       (incf start 16)
121
       (decf remaining 16))
122
     (setf (aref accumulator 0) h0
123
           (aref accumulator 1) h1
124
           (aref accumulator 2) h2
125
           (aref accumulator 3) h3
126
           (aref accumulator 4) h4)
127
     (values start remaining)))
128
 
129
 (defun update-poly1305 (mac data &key (start 0) (end (length data)))
130
   (declare (type (simple-array (unsigned-byte 8) (*)) data)
131
            (type fixnum start end)
132
            (optimize (speed 3) (space 0) (safety 1) (debug 0)))
133
   (let ((buffer (poly1305-buffer mac))
134
         (buffer-length (poly1305-buffer-length mac))
135
         (accumulator (poly1305-accumulator mac))
136
         (r (poly1305-r mac))
137
         (remaining (- end start)))
138
     (declare (type (simple-array (unsigned-byte 8) (16)) buffer)
139
              (type (integer 0 16) buffer-length)
140
              (type (simple-array (unsigned-byte 32) (5)) accumulator)
141
              (type (simple-array (unsigned-byte 32) (4)) r)
142
              (type fixnum remaining))
143
 
144
     ;; Fill the buffer with new data if necessary
145
     (when (plusp buffer-length)
146
       (let ((n (min remaining (- 16 buffer-length))))
147
         (declare (type (integer 0 16) n))
148
         (replace buffer data
149
                  :start1 buffer-length
150
                  :start2 start
151
                  :end2 (+ start n))
152
         (incf buffer-length n)
153
         (incf start n)
154
         (decf remaining n)))
155
 
156
     ;; Process the buffer
157
     (when (= buffer-length 16)
158
       (poly1305-process-full-blocks accumulator r buffer 0 16 nil)
159
       (setf buffer-length 0))
160
 
161
     ;; Process the data
162
     (multiple-value-setq (start remaining)
163
       (poly1305-process-full-blocks accumulator r data start remaining nil))
164
 
165
     ;; Put the remaining data in the buffer
166
     (when (plusp remaining)
167
       (replace buffer data :start1 0 :start2 start :end2 end)
168
       (setf buffer-length remaining))
169
 
170
     ;; Save the state
171
     (setf (poly1305-buffer-length mac) buffer-length)
172
     (values)))
173
 
174
 (defun poly1305-digest (mac)
175
   (let ((buffer (copy-seq (poly1305-buffer mac)))
176
         (buffer-length (poly1305-buffer-length mac))
177
         (accumulator (copy-seq (poly1305-accumulator mac)))
178
         (r (poly1305-r mac))
179
         (s (poly1305-s mac)))
180
     (declare (type (simple-array (unsigned-byte 8) (16)) buffer)
181
              (type (integer 0 16) buffer-length)
182
              (type (simple-array (unsigned-byte 32) (5)) accumulator)
183
              (type (simple-array (unsigned-byte 32) (4)) r s))
184
 
185
     ;; Process the buffer
186
     (when (plusp buffer-length)
187
       (setf (aref buffer buffer-length) 1)
188
       (when (< buffer-length 15)
189
         (fill buffer 0 :start (1+ buffer-length) :end 16))
190
       (poly1305-process-full-blocks accumulator r buffer 0 16 t))
191
 
192
     ;; Produce the tag
193
     (let* ((h0 (aref accumulator 0))
194
            (h1 (aref accumulator 1))
195
            (h2 (aref accumulator 2))
196
            (h3 (aref accumulator 3))
197
            (h4 (aref accumulator 4))
198
            (u0 (mod64+ 5 h0))
199
            (u1 (mod64+ (mod64ash u0 -32) h1))
200
            (u2 (mod64+ (mod64ash u1 -32) h2))
201
            (u3 (mod64+ (mod64ash u2 -32) h3))
202
            (u4 (mod64+ (mod64ash u3 -32) h4))
203
            (uu0 (mod64+ (mod64* (mod64ash u4 -2) 5)
204
                         (mod64+ h0 (aref s 0))))
205
            (uu1 (mod64+ (mod64ash uu0 -32)
206
                         (mod64+ h1 (aref s 1))))
207
            (uu2 (mod64+ (mod64ash uu1 -32)
208
                         (mod64+ h2 (aref s 2))))
209
            (uu3 (mod64+ (mod64ash uu2 -32)
210
                         (mod64+ h3 (aref s 3))))
211
            (tag (make-array 16 :element-type '(unsigned-byte 8))))
212
       (declare (type (unsigned-byte 32) h0 h1 h2 h3 h4)
213
                (type (unsigned-byte 64) u0 u1 u2 u3 u4 uu0 uu1 uu2 uu3)
214
                (type (simple-array (unsigned-byte 8) (16)) tag))
215
       (setf (ub32ref/le tag 0) (logand uu0 #xffffffff)
216
             (ub32ref/le tag 4) (logand uu1 #xffffffff)
217
             (ub32ref/le tag 8) (logand uu2 #xffffffff)
218
             (ub32ref/le tag 12) (logand uu3 #xffffffff))
219
       tag)))
220
 
221
 (defmac poly1305
222
         make-poly1305
223
         update-poly1305
224
         poly1305-digest)