1;;;; -*- mode: lisp; indent-tabs-mode: nil -*-
2;;;; modes.lisp -- using encryption modes with block ciphers
3
4(in-package :crypto)
5
6(defclass encryption-mode ()
7  ((encrypt-function :reader encrypt-function)
8   (decrypt-function :reader decrypt-function)))
9(defclass padded-mode ()
10  ((padding :accessor padding :initform nil)))
11(defclass ecb-mode (encryption-mode padded-mode) ())
12(defclass stream-mode (encryption-mode) ())
13(defclass inititialization-vector-mixin ()
14  ((iv :reader iv :initarg :initialization-vector)
15   (position :accessor iv-position :initform 0)))
16(defclass cbc-mode (encryption-mode inititialization-vector-mixin padded-mode) ())
17(defclass ofb-mode (encryption-mode inititialization-vector-mixin) ())
18(defclass cfb-mode (encryption-mode inititialization-vector-mixin) ())
19(defclass cfb8-mode (encryption-mode inititialization-vector-mixin) ())
20(defclass ctr-mode (encryption-mode inititialization-vector-mixin)
21  ((keystream-blocks :accessor keystream-blocks :initform 0 :type (integer 0 *))))
22
23(defmethod print-object ((object encryption-mode) stream)
24  (print-unreadable-object (object stream :identity t)
25    (format stream "~A" (class-name (class-of object)))))
26
27(defmethod initialize-instance :after ((mode encryption-mode) &key cipher padding)
28  (when (typep mode 'padded-mode)
29    (case padding
30      ((:pkcs7 pkcs7)
31       (setf (padding mode) (make-instance 'pkcs7-padding)))
32      ((:ansi-x923 ansi-x923)
33       (setf (padding mode) (make-instance 'ansi-x923-padding)))
34      ((:iso-7816-4 iso-7816-4)
35       (setf (padding mode) (make-instance 'iso-7816-4-padding)))
36      ((nil)
37       (setf (padding mode) nil))
38      (t
39       (error 'unsupported-padding :name padding))))
40  (multiple-value-bind (efun dfun) (mode-crypt-functions cipher mode)
41    (setf (slot-value mode 'encrypt-function) efun
42          (slot-value mode 'decrypt-function) dfun)))
43
44(defvar *supported-modes* (list :ecb :cbc :ofb :cfb :cfb8 :ctr))
45
46(defun mode-supported-p (name)
47  (and (symbolp name)
48       (not (null (member (intern (symbol-name name) :keyword)
49                          *supported-modes*)))))
50
51(defun list-all-modes ()
52  (sort (copy-seq *supported-modes*) #'string<))
53
54(defmethod encrypt-message (cipher message &key (start 0) (end (length message)) &allow-other-keys)
55  (let* ((length (- end start))
56         (encrypted-length (encrypted-message-length cipher (mode cipher)
57                                                     length t))
58         (encrypted-message (make-array encrypted-length
59                                        :element-type '(unsigned-byte 8))))
60    (encrypt cipher message encrypted-message
61             :plaintext-start start :plaintext-end end
62             :handle-final-block t)
63    encrypted-message))
64
65(defmethod decrypt-message (cipher message &key (start 0) (end (length message)) &allow-other-keys)
66  (let* ((length (- end start))
67         (decrypted-message (make-array length :element-type '(unsigned-byte 8))))
68    (multiple-value-bind (bytes-consumed bytes-produced)
69        (decrypt cipher message decrypted-message
70                 :ciphertext-start start :ciphertext-end end
71                 :handle-final-block t)
72      (declare (ignore bytes-consumed))
73      (if (< bytes-produced length)
74          (subseq decrypted-message 0 bytes-produced)
75          decrypted-message))))
76
77(defun increment-counter-block (block n)
78  (declare (type simple-octet-vector block)
79           (type (mod #.most-positive-fixnum) n)
80           (optimize (speed 3) (space 0) (debug 0) (safety 0)))
81  (loop with carry of-type (mod #.most-positive-fixnum) = n
82        with sum of-type (unsigned-byte 16) = 0
83        for i of-type fixnum from (1- (length block)) downto 0
84        do (setf sum (+ (aref block i) (logand carry #xff))
85                 (aref block i) (logand sum #xff)
86                 carry (+ (ash carry -8) (ash sum -8)))
87        until (zerop carry)))
88
89(declaim (inline increment-counter-block-1))
90(defun increment-counter-block-1 (size block)
91  (declare (type index size)
92           (type simple-octet-vector block)
93           (optimize (speed 3) (space 0) (debug 0) (safety 0)))
94  #+(and sbcl (or x86 x86-64) ironclad-assembly)
95  (inc-counter-block size block)
96  #-(and sbcl (or x86 x86-64) ironclad-assembly)
97  (loop with sum of-type (unsigned-byte 16) = 1
98        for i of-type fixnum from (1- size) downto 0
99        do (setf sum (+ (aref block i) sum)
100                 (aref block i) (logand sum #xff)
101                 sum (ash sum -8))
102        until (zerop sum)))
103
104(defun decrement-counter-block (block n)
105  (declare (type simple-octet-vector block)
106           (type (mod #.most-positive-fixnum) n)
107           (optimize (speed 3) (space 0) (debug 0) (safety 0)))
108  (loop with carry of-type (mod #.most-positive-fixnum) = n
109        with sub of-type fixnum = 0
110        for i of-type fixnum from (1- (length block)) downto 0
111        do (setf sub (- (aref block i) (logand carry #xff))
112                 (aref block i) (logand sub #xff)
113                 carry (+ (ash carry -8) (if (minusp sub) 1 0)))
114        until (zerop carry)))
115
116;;; This way is kind of ugly, but I don't know a better way.
117(macrolet ((define-mode-function (&rest mode-definition-funs &environment env)
118             (loop for fun in mode-definition-funs
119                   collect (macroexpand `(,fun 128-byte-block-mixin 128) env) into forms
120                   collect (macroexpand `(,fun 64-byte-block-mixin 64) env) into forms
121                   collect (macroexpand `(,fun 32-byte-block-mixin 32) env) into forms
122                   collect (macroexpand `(,fun 16-byte-block-mixin 16) env) into forms
123                   collect (macroexpand `(,fun 8-byte-block-mixin 8) env) into forms
124                   finally (return `(progn ,@forms))))
125           (mode-lambda (&body body)
126             `(lambda (in out in-start in-end out-start handle-final-block)
127                (declare (type simple-octet-vector in out))
128                (declare (type index in-start in-end out-start))
129                (declare (ignorable handle-final-block))
130                (declare (optimize (speed 3) (space 0) (debug 0)))
131                ,@body)))
132
133
134;;; ECB mode
135
136(macrolet ((mode-crypt (cipher-specializer block-length-expr)
137             `(defmethod mode-crypt-functions ((cipher ,cipher-specializer)
138                                               (mode ecb-mode))
139                (let ((efun (encrypt-function cipher))
140                      (dfun (decrypt-function cipher))
141                      (padding (padding mode)))
142                 (declare (type function efun dfun))
143                  (values
144                   (mode-lambda
145                    (let ((offset in-start))
146                      (declare (type index offset))
147                      (loop with end = (- in-end ,block-length-expr)
148                            while (<= offset end)
149                            do (funcall efun cipher in offset out out-start)
150                               (incf offset ,block-length-expr)
151                               (incf out-start ,block-length-expr))
152                      (let ((n-bytes-processed (- offset in-start)))
153                        (declare (type index n-bytes-processed))
154                        (if (and handle-final-block padding)
155                            (let ((n-bytes-remaining (- in-end offset)))
156                              (declare (type index n-bytes-remaining))
157                              (when (< (- (length out) out-start) ,block-length-expr)
158                                (error 'insufficient-buffer-space
159                                       :buffer out
160                                       :start out-start
161                                       :length ,block-length-expr))
162                              (replace out in
163                                       :start1 out-start
164                                       :start2 offset :end2 in-end)
165                              (add-padding-bytes padding out out-start
166                                                 n-bytes-remaining ,block-length-expr)
167                              (funcall efun cipher out out-start out out-start)
168                              (values (+ n-bytes-processed n-bytes-remaining)
169                                      (+ n-bytes-processed ,block-length-expr)))
170                            (values n-bytes-processed n-bytes-processed)))))
171                   (mode-lambda
172                    (let ((temp-block (make-array ,block-length-expr
173                                                  :element-type '(unsigned-byte 8)))
174                          (offset in-start))
175                      (declare (type (simple-octet-vector ,block-length-expr) temp-block))
176                      (declare (dynamic-extent temp-block))
177                      (declare (type index offset))
178                      (loop with end = (if (and handle-final-block padding)
179                                           (- in-end (* 2 ,block-length-expr))
180                                           (- in-end ,block-length-expr))
181                            while (<= offset end)
182                            do (funcall dfun cipher in offset out out-start)
183                               (incf offset ,block-length-expr)
184                               (incf out-start ,block-length-expr))
185                      (let ((n-bytes-processed (- offset in-start)))
186                        (declare (type index n-bytes-processed))
187                        (if (and handle-final-block
188                                 padding
189                                 (= (- in-end offset) ,block-length-expr))
190                            (let ((n-bytes-remaining 0))
191                              (declare (type index n-bytes-remaining))
192                              (funcall dfun cipher in offset temp-block 0)
193                              (setf n-bytes-remaining (- ,block-length-expr
194                                                         (count-padding-bytes padding temp-block
195                                                                              0 ,block-length-expr)))
196                              (replace out temp-block
197                                       :start1 out-start
198                                       :start2 0 :end2 n-bytes-remaining)
199                              (values (+ n-bytes-processed ,block-length-expr)
200                                      (+ n-bytes-processed n-bytes-remaining)))
201                            (values n-bytes-processed n-bytes-processed)))))))))
202           (message-length (cipher-specializer block-length-expr)
203             `(defmethod encrypted-message-length ((cipher ,cipher-specializer)
204                                                   (mode ecb-mode) length
205                                                   &optional handle-final-block)
206                (let ((encrypted-length (* (truncate length ,block-length-expr) ,block-length-expr)))
207                  (if (and handle-final-block (padding mode))
208                      (+ encrypted-length ,block-length-expr)
209                      encrypted-length)))))
210  (define-mode-function mode-crypt message-length))
211
212
213;;; CBC mode
214
215(macrolet ((mode-crypt (cipher-specializer block-length-expr)
216             `(defmethod mode-crypt-functions ((cipher ,cipher-specializer)
217                                               (mode cbc-mode))
218                (let ((efun (encrypt-function cipher))
219                      (dfun (decrypt-function cipher))
220                      (iv (iv mode))
221                      (padding (padding mode)))
222                  (declare (type function efun dfun))
223                  (declare (type (simple-octet-vector ,block-length-expr) iv))
224                  (declare (inline xor-block))
225                  (declare (inline copy-block))
226                  (values
227                   (mode-lambda
228                    (let ((offset in-start))
229                      (declare (type index offset))
230                      (loop with end = (- in-end ,block-length-expr)
231                            while (<= offset end)
232                            do (xor-block ,block-length-expr iv 0 in offset out out-start)
233                               (funcall efun cipher out out-start out out-start)
234                               (copy-block ,block-length-expr out out-start iv 0)
235                               (incf offset ,block-length-expr)
236                               (incf out-start ,block-length-expr))
237                      (let ((n-bytes-processed (- offset in-start)))
238                        (declare (type index n-bytes-processed))
239                        (if (and handle-final-block padding)
240                            (let ((n-bytes-remaining (- in-end offset)))
241                              (declare (type index n-bytes-remaining))
242                              (when (< (- (length out) out-start) ,block-length-expr)
243                                (error 'insufficient-buffer-space
244                                       :buffer out
245                                       :start out-start
246                                       :length ,block-length-expr))
247                              (replace out in
248                                       :start1 out-start
249                                       :start2 offset :end2 in-end)
250                              (add-padding-bytes padding out out-start
251                                                 n-bytes-remaining ,block-length-expr)
252                              (xor-block ,block-length-expr iv 0 out out-start out out-start)
253                              (funcall efun cipher out out-start out out-start)
254                              (copy-block ,block-length-expr out out-start iv 0)
255                              (values (+ n-bytes-processed n-bytes-remaining)
256                                      (+ n-bytes-processed ,block-length-expr)))
257                            (values n-bytes-processed n-bytes-processed)))))
258                   (mode-lambda
259                    (let ((temp-block (make-array ,block-length-expr
260                                                  :element-type '(unsigned-byte 8)))
261                          (offset in-start))
262                      (declare (type (simple-octet-vector ,block-length-expr) temp-block))
263                      (declare (dynamic-extent temp-block))
264                      (declare (type index offset))
265                      (loop with end = (if (and handle-final-block padding)
266                                           (- in-end (* 2 ,block-length-expr))
267                                           (- in-end ,block-length-expr))
268                            while (<= offset end)
269                            do (copy-block ,block-length-expr in offset temp-block 0)
270                               (funcall dfun cipher in offset out out-start)
271                               (xor-block ,block-length-expr iv 0 out out-start out out-start)
272                               (copy-block ,block-length-expr temp-block 0 iv 0)
273                               (incf offset ,block-length-expr)
274                               (incf out-start ,block-length-expr))
275                      (let ((n-bytes-processed (- offset in-start)))
276                        (declare (type index n-bytes-processed))
277                        (if (and handle-final-block
278                                 padding
279                                 (= (- in-end offset) ,block-length-expr))
280                            (let ((n-bytes-remaining 0))
281                              (declare (type index n-bytes-remaining))
282                              (funcall dfun cipher in offset temp-block 0)
283                              (xor-block ,block-length-expr iv 0 temp-block 0 temp-block 0)
284                              (setf n-bytes-remaining (- ,block-length-expr
285                                                         (count-padding-bytes padding temp-block
286                                                                              0 ,block-length-expr)))
287                              (replace out temp-block
288                                       :start1 out-start
289                                       :start2 0 :end2 n-bytes-remaining)
290                              (values (+ n-bytes-processed ,block-length-expr)
291                                      (+ n-bytes-processed n-bytes-remaining)))
292                            (values n-bytes-processed n-bytes-processed)))))))))
293           (message-length (cipher-specializer block-length-expr)
294             `(defmethod encrypted-message-length ((cipher ,cipher-specializer)
295                                                   (mode cbc-mode) length
296                                                   &optional handle-final-block)
297                (let ((encrypted-length (* (truncate length ,block-length-expr) ,block-length-expr)))
298                  (if (and handle-final-block (padding mode))
299                      (+ encrypted-length ,block-length-expr)
300                      encrypted-length)))))
301  (define-mode-function mode-crypt message-length))
302
303
304;;; CFB mode
305
306(macrolet ((mode-crypt (cipher-specializer block-length-expr)
307             `(defmethod mode-crypt-functions ((cipher ,cipher-specializer)
308                                               (mode cfb-mode))
309                (let ((function (encrypt-function cipher))
310                      (iv (iv mode))
311                      (iv-position (iv-position mode)))
312                  (declare (type function function))
313                  (declare (type (simple-octet-vector ,block-length-expr) iv))
314                  (declare (type (integer 0 (,block-length-expr)) iv-position))
315                  (values
316                   (mode-lambda
317                    (let ((remaining (- in-end in-start))
318                          (offset in-start))
319                      (declare (type index remaining offset))
320
321                      ;; Use remaining bytes in iv
322                      (loop until (or (zerop iv-position) (zerop remaining)) do
323                        (let ((b (logxor (aref in offset) (aref iv iv-position))))
324                          (declare (type (unsigned-byte 8) b))
325                          (setf (aref out out-start) b
326                                (aref iv iv-position) b
327                                iv-position (mod (1+ iv-position) ,block-length-expr))
328                          (incf offset)
329                          (incf out-start)
330                          (decf remaining)))
331
332                      ;; Process data by block
333                      (multiple-value-bind (q r)
334                          (truncate remaining ,block-length-expr)
335                        (dotimes (i q)
336                          (funcall function cipher iv 0 iv 0)
337                          (xor-block ,block-length-expr iv 0 in offset iv 0)
338                          (copy-block ,block-length-expr iv 0 out out-start)
339                          (incf offset ,block-length-expr)
340                          (incf out-start ,block-length-expr))
341                        (setf remaining r))
342
343                      ;; Process remaing bytes of data
344                      (loop until (zerop remaining) do
345                        (when (zerop iv-position)
346                          (funcall function cipher iv 0 iv 0))
347                        (let ((b (logxor (aref in offset) (aref iv iv-position))))
348                          (declare (type (unsigned-byte 8) b))
349                          (setf (aref out out-start) b
350                                (aref iv iv-position) b
351                                iv-position (mod (1+ iv-position) ,block-length-expr))
352                          (incf offset)
353                          (incf out-start)
354                          (decf remaining)))
355
356                      (let ((processed (- offset in-start)))
357                        (values processed processed))))
358                   (mode-lambda
359                    (let ((temp-block (make-array ,block-length-expr
360                                                  :element-type '(unsigned-byte 8)))
361                          (remaining (- in-end in-start))
362                          (offset in-start))
363                      (declare (type (simple-octet-vector ,block-length-expr) temp-block)
364                               (dynamic-extent temp-block)
365                               (type index remaining offset))
366
367                      ;; Use remaining bytes in iv
368                      (loop until (or (zerop iv-position) (zerop remaining)) do
369                        (let ((b (aref in offset)))
370                          (declare (type (unsigned-byte 8) b))
371                          (setf (aref out out-start) (logxor b (aref iv iv-position))
372                                (aref iv iv-position) b
373                                iv-position (mod (1+ iv-position) ,block-length-expr))
374                          (incf offset)
375                          (incf out-start)
376                          (decf remaining)))
377
378                      ;; Process data by block
379                      (multiple-value-bind (q r)
380                          (truncate remaining ,block-length-expr)
381                        (dotimes (i q)
382                          (funcall function cipher iv 0 temp-block 0)
383                          (copy-block ,block-length-expr in offset iv 0)
384                          (xor-block ,block-length-expr temp-block 0 in offset out out-start)
385                          (incf offset ,block-length-expr)
386                          (incf out-start ,block-length-expr))
387                        (setf remaining r))
388
389                      ;; Process remaing bytes of data
390                      (loop until (zerop remaining) do
391                        (when (zerop iv-position)
392                          (funcall function cipher iv 0 iv 0))
393                        (let ((b (aref in offset)))
394                          (declare (type (unsigned-byte 8) b))
395                          (setf (aref out out-start) (logxor b (aref iv iv-position))
396                                (aref iv iv-position) b
397                                iv-position (mod (1+ iv-position) ,block-length-expr))
398                          (incf offset)
399                          (incf out-start)
400                          (decf remaining)))
401
402                      (let ((processed (- offset in-start)))
403                        (values processed processed))))))))
404           (message-length (cipher-specializer block-length-expr)
405             (declare (ignore block-length-expr))
406             `(defmethod encrypted-message-length ((cipher ,cipher-specializer)
407                                                   (mode cfb-mode) length
408                                                   &optional handle-final-block)
409                (declare (ignore handle-final-block))
410                ;; We can encrypt the whole thing.
411                length)))
412  (define-mode-function mode-crypt message-length))
413
414
415;;; CFB8 mode
416
417(macrolet ((mode-crypt (cipher-specializer block-length-expr)
418           `(defmethod mode-crypt-functions ((cipher ,cipher-specializer)
419                                             (mode cfb8-mode))
420              (let ((function (encrypt-function cipher))
421                    (iv (iv mode))
422                    (encrypted-iv (make-array ,block-length-expr :element-type '(unsigned-byte 8))))
423                (declare (type function function))
424                (declare (type (simple-octet-vector ,block-length-expr) iv encrypted-iv))
425                (declare (inline copy-block))
426                (values
427                  (mode-lambda
428                   (loop for i of-type index from in-start below in-end
429                         for j of-type index from out-start
430                         do (copy-block ,block-length-expr iv 0 encrypted-iv 0)
431                            (funcall function cipher encrypted-iv 0 encrypted-iv 0)
432                            (let ((b (logxor (aref in i) (aref encrypted-iv 0))))
433                              (setf (aref out j) b)
434                              (replace iv iv :start1 0 :start2 1
435                                       :end1 (1- ,block-length-expr) :end2 ,block-length-expr)
436                              (setf (aref iv (1- ,block-length-expr)) b))
437                         finally (return
438                                   (let ((n-bytes-processed (- in-end in-start)))
439                                     (values n-bytes-processed n-bytes-processed)))))
440                  (mode-lambda
441                   (loop for i of-type index from in-start below in-end
442                         for j of-type index from out-start
443                         do (copy-block ,block-length-expr iv 0 encrypted-iv 0)
444                            (funcall function cipher encrypted-iv 0 encrypted-iv 0)
445                            (replace iv iv :start1 0 :start2 1
446                                     :end1 (1- ,block-length-expr) :end2 ,block-length-expr)
447                            (let ((b (aref in i)))
448                              (setf (aref iv (1- ,block-length-expr)) b)
449                              (setf (aref out j) (logxor b (aref encrypted-iv 0))))
450                         finally (return
451                                   (let ((n-bytes-processed (- in-end in-start)))
452                                     (values n-bytes-processed n-bytes-processed)))))))))
453           (message-length (cipher-specializer block-length-expr)
454             (declare (ignore block-length-expr))
455             `(defmethod encrypted-message-length ((cipher ,cipher-specializer)
456                                                   (mode cfb8-mode) length
457                                                   &optional handle-final-block)
458                (declare (ignore handle-final-block))
459                ;; We can encrypt the whole thing.
460                length)))
461  (define-mode-function mode-crypt message-length))
462
463
464;;; OFB mode
465
466(macrolet ((mode-crypt (cipher-specializer block-length-expr)
467             `(defmethod mode-crypt-functions ((cipher ,cipher-specializer)
468                                               (mode ofb-mode))
469                (let ((iv (iv mode))
470                      (iv-position (iv-position mode)))
471                  (declare (type (simple-octet-vector ,block-length-expr) iv))
472                  (declare (type (integer 0 (,block-length-expr)) iv-position))
473                  (flet ((ofb-crypt-function (function)
474                           (declare (type function function))
475                           (mode-lambda
476                            (let ((remaining (- in-end in-start))
477                                  (offset in-start))
478                              (declare (type index remaining offset))
479
480                              ;; Use remaining bytes in iv
481                              (loop until (or (zerop iv-position) (zerop remaining)) do
482                                (setf (aref out out-start)
483                                      (logxor (aref in offset) (aref iv iv-position)))
484                                (setf iv-position (mod (1+ iv-position) ,block-length-expr))
485                                (incf offset)
486                                (incf out-start)
487                                (decf remaining))
488
489                              ;; Process data by block
490                              (multiple-value-bind (q r)
491                                  (truncate remaining ,block-length-expr)
492                                (dotimes (i q)
493                                  (funcall function cipher iv 0 iv 0)
494                                  (xor-block ,block-length-expr iv 0 in offset out out-start)
495                                  (incf offset ,block-length-expr)
496                                  (incf out-start ,block-length-expr))
497                                (setf remaining r))
498
499                              ;; Process remaing bytes of data
500                              (loop until (zerop remaining) do
501                                (when (zerop iv-position)
502                                  (funcall function cipher iv 0 iv 0))
503                                (setf (aref out out-start)
504                                      (logxor (aref in offset) (aref iv iv-position)))
505                                (setf iv-position (mod (1+ iv-position) ,block-length-expr))
506                                (incf offset)
507                                (incf out-start)
508                                (decf remaining))
509
510                              (let ((processed (- offset in-start)))
511                                (values processed processed))))))
512                    (let ((f (ofb-crypt-function (encrypt-function cipher))))
513                      (values f f))))))
514           (message-length (cipher-specializer block-length-expr)
515             (declare (ignore block-length-expr))
516             `(defmethod encrypted-message-length ((cipher ,cipher-specializer)
517                                                   (mode ofb-mode) length
518                                                   &optional handle-final-block)
519                (declare (ignore handle-final-block))
520                ;; We can encrypt the whole thing.
521                length)))
522  (define-mode-function mode-crypt message-length))
523
524
525;;; CTR mode
526
527(macrolet ((mode-crypt (cipher-specializer block-length-expr)
528             `(defmethod mode-crypt-functions ((cipher ,cipher-specializer)
529                                               (mode ctr-mode))
530                (let ((iv (iv mode))
531                      (encrypted-iv (make-array ,block-length-expr :element-type '(unsigned-byte 8))))
532                  (declare (type (simple-octet-vector ,block-length-expr) iv encrypted-iv))
533                  (flet ((ctr-crypt-function (function)
534                           (declare (type function function))
535                           (mode-lambda
536                            (let ((iv-position (iv-position mode))
537                                  (keystream-blocks (keystream-blocks mode))
538                                  (remaining (- in-end in-start))
539                                  (offset in-start))
540                              (declare (type (integer 0 (,block-length-expr)) iv-position)
541                                       (type (integer 0 *) keystream-blocks)
542                                       (type index remaining offset))
543
544                              ;; Use remaining bytes in encrypted-iv
545                              (loop until (or (zerop iv-position) (zerop remaining)) do
546                                (setf (aref out out-start)
547                                      (logxor (aref in offset) (aref encrypted-iv iv-position)))
548                                (setf iv-position (mod (1+ iv-position) ,block-length-expr))
549                                (incf offset)
550                                (incf out-start)
551                                (decf remaining))
552
553                              ;; Process data by block
554                              (multiple-value-bind (q r)
555                                  (truncate remaining ,block-length-expr)
556                                (dotimes (i q)
557                                  (funcall function cipher iv 0 encrypted-iv 0)
558                                  (increment-counter-block-1 ,block-length-expr iv)
559                                  (xor-block ,block-length-expr encrypted-iv 0 in offset out out-start)
560                                  (incf offset ,block-length-expr)
561                                  (incf out-start ,block-length-expr))
562                                (incf keystream-blocks q)
563                                (setf remaining r))
564
565                              ;; Process remaing bytes of data
566                              (loop until (zerop remaining) do
567                                (when (zerop iv-position)
568                                  (funcall function cipher iv 0 encrypted-iv 0)
569                                  (increment-counter-block-1 ,block-length-expr iv)
570                                  (incf keystream-blocks))
571                                (setf (aref out out-start)
572                                      (logxor (aref in offset) (aref encrypted-iv iv-position)))
573                                (setf iv-position (mod (1+ iv-position) ,block-length-expr))
574                                (incf offset)
575                                (incf out-start)
576                                (decf remaining))
577
578                              (setf (iv-position mode) iv-position)
579                              (setf (keystream-blocks mode) keystream-blocks)
580                              (let ((processed (- offset in-start)))
581                                (values processed processed))))))
582                    (let ((f (ctr-crypt-function (encrypt-function cipher))))
583                      (values f f))))))
584           (message-length (cipher-specializer block-length-expr)
585             (declare (ignore block-length-expr))
586             `(defmethod encrypted-message-length ((cipher ,cipher-specializer)
587                                                   (mode ctr-mode) length
588                                                   &optional handle-final-block)
589                (declare (ignore handle-final-block))
590                ;; We can encrypt the whole thing.
591                length)))
592  (define-mode-function mode-crypt message-length))
593
594(defmethod mode-crypt-functions (cipher (mode stream-mode))
595  (flet ((stream-crypt-function (function)
596           (declare (type function function))
597           (mode-lambda
598            (let ((length (- in-end in-start)))
599              (when (plusp length)
600                (funcall function cipher in in-start out out-start length))
601              (let ((n-bytes-processed (max 0 length)))
602                (values n-bytes-processed n-bytes-processed))))))
603    (values (stream-crypt-function (encrypt-function cipher))
604            (stream-crypt-function (decrypt-function cipher)))))
605
606) ; DEFINE-MODE-FUNCTION MACROLET
607
608(defmethod encrypted-message-length (context
609                                     (mode stream-mode) length
610                                     &optional handle-final-block)
611  (declare (ignore context mode handle-final-block))
612  (declare (type index length))
613  length)
614