1 ;;;; This file implements The MD5 Message-Digest Algorithm, as defined in
2 ;;;; RFC 1321 by R. Rivest, published April 1992.
4 ;;;; It was written by Pierre R. Mai, with copious input from the
5 ;;;; cmucl-help mailing-list hosted at cons.org, in November 2001 and
6 ;;;; has been placed into the public domain.
10 ;;;; While the implementation should work on all conforming Common
11 ;;;; Lisp implementations, it has only been optimized for CMU CL,
12 ;;;; where it achieved comparable performance to the standard md5sum
13 ;;;; utility (within a factor of 1.5 or less on iA32 and UltraSparc
16 ;;;; Since the implementation makes heavy use of arithmetic on
17 ;;;; (unsigned-byte 32) numbers, acceptable performance is likely only
18 ;;;; on CL implementations that support unboxed arithmetic on such
19 ;;;; numbers in some form. For other CL implementations a 16bit
20 ;;;; implementation of MD5 is probably more suitable.
22 ;;;; The code implements correct operation for files of unbounded size
23 ;;;; as is, at the cost of having to do a single generic integer
24 ;;;; addition for each call to update-md5-state. If you call
25 ;;;; update-md5-state frequently with little data, this can pose a
26 ;;;; performance problem. If you can live with a size restriction of
27 ;;;; 512 MB, then you can enable fast fixnum arithmetic by putting
28 ;;;; :md5-small-length onto *features* prior to compiling this file.
30 ;;;; This software is "as is", and has no warranty of any kind. The
31 ;;;; authors assume no responsibility for the consequences of any use
32 ;;;; of this software.
34 (defpackage :SB-MD5 (:use :CL)
36 ;; Low-Level types and functions
37 #:md5-regs #:initial-md5-regs #:md5regs-digest
38 #:update-md5-block #:fill-block #:fill-block-ub8 #:fill-block-char
39 ;; Mid-Level types and functions
40 #:md5-state #:md5-state-p #:make-md5-state
41 #:update-md5-state #:finalize-md5-state
42 ;; High-Level functions on sequences, streams and files
43 #:md5sum-sequence #:md5sum-string #:md5sum-stream #:md5sum-file))
48 (eval-when (:compile-toplevel)
49 (defparameter *old-expansion-limit* ext:*inline-expansion-limit*)
50 (setq ext:*inline-expansion-limit* (max ext:*inline-expansion-limit* 1000)))
53 (eval-when (:compile-toplevel :execute)
54 (defparameter *old-features* *features*)
55 (pushnew (c:backend-byte-order c:*target-backend*) *features*))
58 (eval-when (:compile-toplevel)
59 (defparameter *old-features* *features*)
60 (pushnew sb-c:*backend-byte-order* *features*))
62 ;;; Section 2: Basic Datatypes
65 "Corresponds to the 32bit quantity word of the MD5 Spec"
68 (defmacro assemble-ub32 (a b c d)
69 "Assemble an ub32 value from the given (unsigned-byte 8) values,
70 where a is the intended low-order byte and d the high-order byte."
71 `(the ub32 (logior (ash ,d 24) (ash ,c 16) (ash ,b 8) ,a)))
73 ;;; Section 3.4: Auxilliary functions
75 (declaim (inline f g h i)
76 (ftype (function (ub32 ub32 ub32) ub32) f g h i))
79 (declare (type ub32 x y z)
80 (optimize (speed 3) (safety 0) (space 0) (debug 0)))
82 (kernel:32bit-logical-or (kernel:32bit-logical-and x y)
83 (kernel:32bit-logical-andc1 x z))
85 (logior (logand x y) (logandc1 x z)))
88 (declare (type ub32 x y z)
89 (optimize (speed 3) (safety 0) (space 0) (debug 0)))
91 (kernel:32bit-logical-or (kernel:32bit-logical-and x z)
92 (kernel:32bit-logical-andc2 y z))
94 (logior (logand x z) (logandc2 y z)))
97 (declare (type ub32 x y z)
98 (optimize (speed 3) (safety 0) (space 0) (debug 0)))
100 (kernel:32bit-logical-xor x (kernel:32bit-logical-xor y z))
105 (declare (type ub32 x y z)
106 (optimize (speed 3) (safety 0) (space 0) (debug 0)))
108 (kernel:32bit-logical-xor y (kernel:32bit-logical-orc2 x z))
110 (ldb (byte 32 0) (logxor y (logorc2 x z))))
112 (declaim (inline mod32+)
113 (ftype (function (ub32 ub32) ub32) mod32+))
115 (declare (type ub32 a b) (optimize (speed 3) (safety 0) (space 0) (debug 0)))
116 (ldb (byte 32 0) (+ a b)))
119 (define-compiler-macro mod32+ (a b)
120 `(ext:truly-the ub32 (+ ,a ,b)))
122 ;;; Dunno why we need this, but without it MOD32+ wasn't being
123 ;;; inlined. Oh well. -- CSR, 2003-09-14
125 (define-compiler-macro mod32+ (a b)
126 `(ldb (byte 32 0) (+ ,a ,b)))
128 (declaim (inline rol32)
129 (ftype (function (ub32 (unsigned-byte 5)) ub32) rol32))
131 (declare (type ub32 a) (type (unsigned-byte 5) s)
132 (optimize (speed 3) (safety 0) (space 0) (debug 0)))
134 (kernel:32bit-logical-or #+little-endian (kernel:shift-towards-end a s)
135 #+big-endian (kernel:shift-towards-start a s)
138 (sb-rotate-byte:rotate-byte s (byte 32 0) a)
140 (logior (ldb (byte 32 0) (ash a s)) (ash a (- s 32))))
142 ;;; Section 3.4: Table T
144 (eval-when (:compile-toplevel :load-toplevel :execute)
145 (defparameter *t* (make-array 64 :element-type 'ub32
147 (loop for i from 1 to 64
151 (abs (sin (float i 0.0d0)))))))))
153 ;;; Section 3.4: Helper Macro for single round definitions
155 (defmacro with-md5-round ((op block) &rest clauses)
156 (loop for (a b c d k s i) in clauses
158 `(setq ,a (mod32+ ,b (rol32 (mod32+ (mod32+ ,a (,op ,b ,c ,d))
159 (mod32+ (aref ,block ,k)
164 (return `(progn ,@result))))
166 ;;; Section 3.3: (Initial) MD5 Working Set
169 "The working state of the MD5 algorithm, which contains the 4 32-bit
170 registers A, B, C and D."
171 `(simple-array (unsigned-byte 32) (4)))
173 (defmacro md5-regs-a (regs)
176 (defmacro md5-regs-b (regs)
179 (defmacro md5-regs-c (regs)
182 (defmacro md5-regs-d (regs)
185 (defconstant +md5-magic-a+ (assemble-ub32 #x01 #x23 #x45 #x67)
186 "Initial value of Register A of the MD5 working state.")
187 (defconstant +md5-magic-b+ (assemble-ub32 #x89 #xab #xcd #xef)
188 "Initial value of Register B of the MD5 working state.")
189 (defconstant +md5-magic-c+ (assemble-ub32 #xfe #xdc #xba #x98)
190 "Initial value of Register C of the MD5 working state.")
191 (defconstant +md5-magic-d+ (assemble-ub32 #x76 #x54 #x32 #x10)
192 "Initial value of Register D of the MD5 working state.")
194 (declaim (inline initial-md5-regs))
195 (defun initial-md5-regs ()
196 "Create the initial working state of an MD5 run."
197 (declare (optimize (speed 3) (safety 0) (space 0) (debug 0)))
198 (let ((regs (make-array 4 :element-type '(unsigned-byte 32))))
199 (declare (type md5-regs regs))
200 (setf (md5-regs-a regs) +md5-magic-a+
201 (md5-regs-b regs) +md5-magic-b+
202 (md5-regs-c regs) +md5-magic-c+
203 (md5-regs-d regs) +md5-magic-d+)
206 ;;; Section 3.4: Operation on 16-Word Blocks
208 (defun update-md5-block (regs block)
209 "This is the core part of the MD5 algorithm. It takes a complete 16
210 word block of input, and updates the working state in A, B, C, and D
212 (declare (type md5-regs regs)
213 (type (simple-array ub32 (16)) block)
214 (optimize (speed 3) (safety 0) (space 0) (debug 0)))
215 (let ((a (md5-regs-a regs)) (b (md5-regs-b regs))
216 (c (md5-regs-c regs)) (d (md5-regs-d regs)))
217 (declare (type ub32 a b c d))
219 (with-md5-round (f block)
220 (A B C D 0 7 1)(D A B C 1 12 2)(C D A B 2 17 3)(B C D A 3 22 4)
221 (A B C D 4 7 5)(D A B C 5 12 6)(C D A B 6 17 7)(B C D A 7 22 8)
222 (A B C D 8 7 9)(D A B C 9 12 10)(C D A B 10 17 11)(B C D A 11 22 12)
223 (A B C D 12 7 13)(D A B C 13 12 14)(C D A B 14 17 15)(B C D A 15 22 16))
225 (with-md5-round (g block)
226 (A B C D 1 5 17)(D A B C 6 9 18)(C D A B 11 14 19)(B C D A 0 20 20)
227 (A B C D 5 5 21)(D A B C 10 9 22)(C D A B 15 14 23)(B C D A 4 20 24)
228 (A B C D 9 5 25)(D A B C 14 9 26)(C D A B 3 14 27)(B C D A 8 20 28)
229 (A B C D 13 5 29)(D A B C 2 9 30)(C D A B 7 14 31)(B C D A 12 20 32))
231 (with-md5-round (h block)
232 (A B C D 5 4 33)(D A B C 8 11 34)(C D A B 11 16 35)(B C D A 14 23 36)
233 (A B C D 1 4 37)(D A B C 4 11 38)(C D A B 7 16 39)(B C D A 10 23 40)
234 (A B C D 13 4 41)(D A B C 0 11 42)(C D A B 3 16 43)(B C D A 6 23 44)
235 (A B C D 9 4 45)(D A B C 12 11 46)(C D A B 15 16 47)(B C D A 2 23 48))
237 (with-md5-round (i block)
238 (A B C D 0 6 49)(D A B C 7 10 50)(C D A B 14 15 51)(B C D A 5 21 52)
239 (A B C D 12 6 53)(D A B C 3 10 54)(C D A B 10 15 55)(B C D A 1 21 56)
240 (A B C D 8 6 57)(D A B C 15 10 58)(C D A B 6 15 59)(B C D A 13 21 60)
241 (A B C D 4 6 61)(D A B C 11 10 62)(C D A B 2 15 63)(B C D A 9 21 64))
243 (setf (md5-regs-a regs) (mod32+ (md5-regs-a regs) a)
244 (md5-regs-b regs) (mod32+ (md5-regs-b regs) b)
245 (md5-regs-c regs) (mod32+ (md5-regs-c regs) c)
246 (md5-regs-d regs) (mod32+ (md5-regs-d regs) d))
249 ;;; Section 3.4: Converting 8bit-vectors into 16-Word Blocks
251 (declaim (inline fill-block fill-block-ub8 fill-block-char))
252 (defun fill-block (block buffer offset)
253 "Convert a complete 64 byte input vector segment into the given 16
254 word MD5 block. This currently works on (unsigned-byte 8) and
255 character simple-arrays, via the functions `fill-block-ub8' and
256 `fill-block-char' respectively."
257 (declare (type (integer 0 #.(- most-positive-fixnum 64)) offset)
258 (type (simple-array ub32 (16)) block)
259 (type (simple-array * (*)) buffer)
260 (optimize (speed 3) (safety 0) (space 0) (debug 0)))
262 ((simple-array (unsigned-byte 8) (*))
263 (fill-block-ub8 block buffer offset))
265 (fill-block-char block buffer offset))))
267 (defun fill-block-ub8 (block buffer offset)
268 "Convert a complete 64 (unsigned-byte 8) input vector segment
269 starting from offset into the given 16 word MD5 block."
270 (declare (type (integer 0 #.(- most-positive-fixnum 64)) offset)
271 (type (simple-array ub32 (16)) block)
272 (type (simple-array (unsigned-byte 8) (*)) buffer)
273 (optimize (speed 3) (safety 0) (space 0) (debug 0)))
274 #+(and :cmu :little-endian)
275 (kernel:bit-bash-copy
276 buffer (+ (* vm:vector-data-offset vm:word-bits) (* offset vm:byte-bits))
277 block (* vm:vector-data-offset vm:word-bits)
279 #+(and :sbcl :little-endian)
280 (sb-kernel:bit-bash-copy
281 buffer (+ (* sb-vm:vector-data-offset sb-vm:n-word-bits)
282 (* offset sb-vm:n-byte-bits))
283 block (* sb-vm:vector-data-offset sb-vm:n-word-bits)
284 (* 64 sb-vm:n-byte-bits))
285 #-(or (and :sbcl :little-endian) (and :cmu :little-endian))
286 (loop for i of-type (integer 0 16) from 0
287 for j of-type (integer 0 #.most-positive-fixnum)
288 from offset to (+ offset 63) by 4
291 (assemble-ub32 (aref buffer j)
292 (aref buffer (+ j 1))
293 (aref buffer (+ j 2))
294 (aref buffer (+ j 3))))))
296 (defun fill-block-char (block buffer offset)
297 "Convert a complete 64 character input string segment starting from
298 offset into the given 16 word MD5 block."
299 (declare (type (integer 0 #.(- most-positive-fixnum 64)) offset)
300 (type (simple-array ub32 (16)) block)
301 (type simple-string buffer)
302 (optimize (speed 3) (safety 0) (space 0) (debug 0)))
303 #+(and :cmu :little-endian)
304 (kernel:bit-bash-copy
305 buffer (+ (* vm:vector-data-offset vm:word-bits) (* offset vm:byte-bits))
306 block (* vm:vector-data-offset vm:word-bits)
308 #+(and :sbcl :little-endian)
309 (sb-kernel:bit-bash-copy
310 buffer (+ (* sb-vm:vector-data-offset sb-vm:n-word-bits)
311 (* offset sb-vm:n-byte-bits))
312 block (* sb-vm:vector-data-offset sb-vm:n-word-bits)
313 (* 64 sb-vm:n-byte-bits))
314 #-(or (and :sbcl :little-endian) (and :cmu :little-endian))
315 (loop for i of-type (integer 0 16) from 0
316 for j of-type (integer 0 #.most-positive-fixnum)
317 from offset to (+ offset 63) by 4
320 (assemble-ub32 (char-code (schar buffer j))
321 (char-code (schar buffer (+ j 1)))
322 (char-code (schar buffer (+ j 2)))
323 (char-code (schar buffer (+ j 3)))))))
325 ;;; Section 3.5: Message Digest Output
327 (declaim (inline md5regs-digest))
328 (defun md5regs-digest (regs)
329 "Create the final 16 byte message-digest from the MD5 working state
330 in regs. Returns a (simple-array (unsigned-byte 8) (16))."
331 (declare (optimize (speed 3) (safety 0) (space 0) (debug 0))
332 (type md5-regs regs))
333 (let ((result (make-array 16 :element-type '(unsigned-byte 8))))
334 (declare (type (simple-array (unsigned-byte 8) (16)) result))
335 (macrolet ((frob (reg offset)
336 (let ((var (gensym)))
338 (declare (type ub32 ,var))
340 (aref result ,offset) (ldb (byte 8 0) ,var)
341 (aref result ,(+ offset 1)) (ldb (byte 8 8) ,var)
342 (aref result ,(+ offset 2)) (ldb (byte 8 16) ,var)
343 (aref result ,(+ offset 3)) (ldb (byte 8 24) ,var))))))
344 (frob (md5-regs-a regs) 0)
345 (frob (md5-regs-b regs) 4)
346 (frob (md5-regs-c regs) 8)
347 (frob (md5-regs-d regs) 12))
350 ;;; Mid-Level Drivers
352 (defstruct (md5-state
353 (:constructor make-md5-state ())
355 (regs (initial-md5-regs) :type md5-regs :read-only t)
357 #-md5-small-length (integer 0 *)
358 #+md5-small-length (unsigned-byte 29))
359 (block (make-array 16 :element-type '(unsigned-byte 32)) :read-only t
360 :type (simple-array (unsigned-byte 32) (16)))
361 (buffer (make-array 64 :element-type '(unsigned-byte 8)) :read-only t
362 :type (simple-array (unsigned-byte 8) (64)))
363 (buffer-index 0 :type (integer 0 63))
366 (declaim (inline copy-to-buffer))
367 (defun copy-to-buffer (from from-offset count buffer buffer-offset)
368 "Copy a partial segment from input vector from starting at
369 from-offset and copying count elements into the 64 byte buffer
370 starting at buffer-offset."
371 (declare (optimize (speed 3) (safety 0) (space 0) (debug 0))
372 (type (unsigned-byte 29) from-offset)
373 (type (integer 0 63) count buffer-offset)
374 (type (simple-array * (*)) from)
375 (type (simple-array (unsigned-byte 8) (64)) buffer))
377 (kernel:bit-bash-copy
378 from (+ (* vm:vector-data-offset vm:word-bits) (* from-offset vm:byte-bits))
379 buffer (+ (* vm:vector-data-offset vm:word-bits)
380 (* buffer-offset vm:byte-bits))
381 (* count vm:byte-bits))
383 (sb-kernel:bit-bash-copy
384 from (+ (* sb-vm:vector-data-offset sb-vm:n-word-bits)
385 (* from-offset sb-vm:n-byte-bits))
386 buffer (+ (* sb-vm:vector-data-offset sb-vm:n-word-bits)
387 (* buffer-offset sb-vm:n-byte-bits))
388 (* count sb-vm:n-byte-bits))
392 (loop for buffer-index of-type (integer 0 64) from buffer-offset
393 for from-index of-type fixnum from from-offset
394 below (+ from-offset count)
396 (setf (aref buffer buffer-index)
397 (char-code (schar (the simple-string from) from-index)))))
398 ((simple-array (unsigned-byte 8) (*))
399 (loop for buffer-index of-type (integer 0 64) from buffer-offset
400 for from-index of-type fixnum from from-offset
401 below (+ from-offset count)
403 (setf (aref buffer buffer-index)
404 (aref (the (simple-array (unsigned-byte 8) (*)) from)
407 (defun update-md5-state (state sequence &key (start 0) (end (length sequence)))
408 "Update the given md5-state from sequence, which is either a
409 simple-string or a simple-array with element-type (unsigned-byte 8),
410 bounded by start and end, which must be numeric bounding-indices."
411 (declare (type md5-state state)
412 (type (simple-array * (*)) sequence)
413 (type fixnum start end)
414 (optimize (speed 3) #+(or cmu sbcl) (safety 0) (space 0) (debug 0))
416 (ext:optimize-interface (safety 1) (debug 1)))
417 (let ((regs (md5-state-regs state))
418 (block (md5-state-block state))
419 (buffer (md5-state-buffer state))
420 (buffer-index (md5-state-buffer-index state))
421 (length (- end start)))
422 (declare (type md5-regs regs) (type fixnum length)
423 (type (integer 0 63) buffer-index)
424 (type (simple-array (unsigned-byte 32) (16)) block)
425 (type (simple-array (unsigned-byte 8) (64)) buffer))
427 (unless (zerop buffer-index)
428 (let ((amount (min (- 64 buffer-index) length)))
429 (declare (type (integer 0 63) amount))
430 (copy-to-buffer sequence start amount buffer buffer-index)
431 (setq start (the fixnum (+ start amount)))
433 (setf (md5-state-buffer-index state) (+ buffer-index amount))
434 (return-from update-md5-state state)))
435 (fill-block-ub8 block buffer 0)
436 (update-md5-block regs block))
437 ;; Handle main-part and new-rest
439 ((simple-array (unsigned-byte 8) (*))
441 (declare (type (simple-array (unsigned-byte 8) (*)) sequence))
442 (loop for offset of-type (unsigned-byte 29) from start below end by 64
443 until (< (- end offset) 64)
445 (fill-block-ub8 block sequence offset)
446 (update-md5-block regs block)
448 (let ((amount (- end offset)))
449 (unless (zerop amount)
450 (copy-to-buffer sequence offset amount buffer 0))
451 (setf (md5-state-buffer-index state) amount)))))
454 (declare (type simple-string sequence))
455 (loop for offset of-type (unsigned-byte 29) from start below end by 64
456 until (< (- end offset) 64)
458 (fill-block-char block sequence offset)
459 (update-md5-block regs block)
461 (let ((amount (- end offset)))
462 (unless (zerop amount)
463 (copy-to-buffer sequence offset amount buffer 0))
464 (setf (md5-state-buffer-index state) amount))))))
465 (setf (md5-state-amount state)
466 #-md5-small-length (+ (md5-state-amount state) length)
467 #+md5-small-length (the (unsigned-byte 29)
468 (+ (md5-state-amount state) length)))
471 (defun finalize-md5-state (state)
472 "If the given md5-state has not already been finalized, finalize it,
473 by processing any remaining input in its buffer, with suitable padding
474 and appended bit-length, as specified by the MD5 standard.
476 The resulting MD5 message-digest is returned as an array of sixteen
477 (unsigned-byte 8) values. Calling `update-md5-state' after a call to
478 `finalize-md5-state' results in unspecified behaviour."
479 (declare (type md5-state state)
480 (optimize (speed 3) #+(or cmu sbcl) (safety 0) (space 0) (debug 0))
482 (ext:optimize-interface (safety 1) (debug 1)))
483 (or (md5-state-finalized-p state)
484 (let ((regs (md5-state-regs state))
485 (block (md5-state-block state))
486 (buffer (md5-state-buffer state))
487 (buffer-index (md5-state-buffer-index state))
488 (total-length (* 8 (md5-state-amount state))))
489 (declare (type md5-regs regs)
490 (type (integer 0 63) buffer-index)
491 (type (simple-array ub32 (16)) block)
492 (type (simple-array (unsigned-byte 8) (*)) buffer))
493 ;; Add mandatory bit 1 padding
494 (setf (aref buffer buffer-index) #x80)
495 ;; Fill with 0 bit padding
496 (loop for index of-type (integer 0 64)
497 from (1+ buffer-index) below 64
498 do (setf (aref buffer index) #x00))
499 (fill-block-ub8 block buffer 0)
500 ;; Flush block first if length wouldn't fit
501 (when (>= buffer-index 56)
502 (update-md5-block regs block)
503 ;; Create new fully 0 padded block
504 (loop for index of-type (integer 0 16) from 0 below 16
505 do (setf (aref block index) #x00000000)))
506 ;; Add 64bit message bit length
507 (setf (aref block 14) (ldb (byte 32 0) total-length))
509 (setf (aref block 15) (ldb (byte 32 32) total-length))
511 (update-md5-block regs block)
512 ;; Done, remember digest for later calls
513 (setf (md5-state-finalized-p state)
514 (md5regs-digest regs)))))
516 ;;; High-Level Drivers
518 (defun md5sum-sequence (sequence &key (start 0) end)
519 "Calculate the MD5 message-digest of data bounded by START and END
520 in SEQUENCE , which must be a vector with element-type (UNSIGNED-BYTE
522 (declare (optimize (speed 3) (space 0) (debug 0))
523 (type vector sequence) (type fixnum start))
524 (let ((state (make-md5-state)))
525 (declare (type md5-state state))
527 (lisp::with-array-data ((data sequence) (real-start start) (real-end end))
528 (update-md5-state state data :start real-start :end real-end))
530 (sb-kernel:with-array-data ((data sequence) (real-start start) (real-end end))
531 (update-md5-state state data :start real-start :end real-end))
533 (let ((real-end (or end (length sequence))))
534 (declare (type fixnum real-end))
535 (update-md5-state state sequence :start start :end real-end))
536 (finalize-md5-state state)))
538 (defun md5sum-string (string &key (external-format :default) (start 0) end)
539 "Calculate the MD5 message-digest of the binary representation
540 of STRING (as octets) in EXTERNAL-FORMAT. The boundaries START
541 and END refer to character positions in the string, not to octets
542 in the resulting binary representation."
543 (declare (optimize (speed 3) (space 0) (debug 0))
544 (type string string))
546 (sb-ext:string-to-octets string
547 :external-format external-format
548 :start start :end end)))
550 (defconstant +buffer-size+ (* 128 1024)
551 "Size of internal buffer to use for md5sum-stream and md5sum-file
552 operations. This should be a multiple of 64, the MD5 block size.")
554 (deftype buffer-index () `(integer 0 ,+buffer-size+))
556 (defun md5sum-stream (stream)
557 "Calculate an MD5 message-digest of the contents of STREAM, whose
558 element-type has to be (UNSIGNED-BYTE 8)."
559 (declare (optimize (speed 3) (space 0) (debug 0)))
560 (let ((state (make-md5-state)))
561 (declare (type md5-state state))
563 ((equal (stream-element-type stream) '(unsigned-byte 8))
564 (let ((buffer (make-array +buffer-size+
565 :element-type '(unsigned-byte 8))))
566 (declare (type (simple-array (unsigned-byte 8) (#.+buffer-size+))
568 (loop for bytes of-type buffer-index = (read-sequence buffer stream)
569 do (update-md5-state state buffer :end bytes)
570 until (< bytes +buffer-size+)
572 (return (finalize-md5-state state)))))
573 ((equal (stream-element-type stream) 'character)
574 (let ((buffer (make-string +buffer-size+)))
575 (declare (type (simple-string #.+buffer-size+) buffer))
576 (loop for bytes of-type buffer-index = (read-sequence buffer stream)
577 do (update-md5-state state buffer :end bytes)
578 until (< bytes +buffer-size+)
580 (return (finalize-md5-state state)))))
582 (error "Unsupported stream element-type ~S for stream ~S."
583 (stream-element-type stream) stream)))))
585 (defun md5sum-file (pathname)
586 "Calculate the MD5 message-digest of the file specified by pathname."
587 (declare (optimize (speed 3) (space 0) (debug 0)))
588 (with-open-file (stream pathname :element-type '(unsigned-byte 8))
589 (md5sum-stream stream)))
592 (eval-when (:compile-toplevel :execute)
593 (setq *features* *old-features*))
596 (eval-when (:compile-toplevel)
597 (setq ext:*inline-expansion-limit* *old-expansion-limit*))
600 (eval-when (:compile-toplevel)
601 (setq *features* *old-features*))