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