From e8bb87b256ccd00a7985ff978bbc1a495890c60c Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sun, 15 May 2005 15:03:07 +0000 Subject: [PATCH] 0.9.0.33: Make SB-MD5 enforce its requirements. ... also keep lambda lists around, for manual autogroveling purposes --- contrib/sb-md5/md5-tests.lisp | 7 ++- contrib/sb-md5/md5.lisp | 113 ++++++++++++++++++++++------------------- version.lisp-expr | 2 +- 3 files changed, 69 insertions(+), 53 deletions(-) diff --git a/contrib/sb-md5/md5-tests.lisp b/contrib/sb-md5/md5-tests.lisp index 3e3afe8..82183b3 100644 --- a/contrib/sb-md5/md5-tests.lisp +++ b/contrib/sb-md5/md5-tests.lisp @@ -113,4 +113,9 @@ (deftest sb-md5.md5sum-file.0 (string= (format nil "~(~{~2,'0X~}~)" (coerce (md5sum-file "/dev/null") 'list)) "d41d8cd98f00b204e9800998ecf8427e") - t) \ No newline at end of file + t) + +(deftest sb-md5.md5sum-sequence.error.0 + (handler-case (md5sum-sequence "foo") + (type-error () :good)) + :good) diff --git a/contrib/sb-md5/md5.lisp b/contrib/sb-md5/md5.lisp index eb7c7d5..ab006e9 100644 --- a/contrib/sb-md5/md5.lisp +++ b/contrib/sb-md5/md5.lisp @@ -506,33 +506,37 @@ The resulting MD5 message-digest is returned as an array of sixteen "Calculate the MD5 message-digest of data bounded by START and END in SEQUENCE , which must be a vector with element-type (UNSIGNED-BYTE 8)." - (declare (optimize (speed 3) (space 0) (debug 0)) - (type vector sequence) (type fixnum start)) - (let ((state (make-md5-state))) - (declare (type md5-state state)) - #+cmu - (lisp::with-array-data ((data sequence) (real-start start) (real-end end)) - (update-md5-state state data :start real-start :end real-end)) - #+sbcl - (sb-kernel:with-array-data ((data sequence) (real-start start) (real-end end)) - (update-md5-state state data :start real-start :end real-end)) - #-(or cmu sbcl) - (let ((real-end (or end (length sequence)))) - (declare (type fixnum real-end)) - (update-md5-state state sequence :start start :end real-end)) - (finalize-md5-state state))) + (declare (optimize (speed 3) (safety 3) (space 0) (debug 1)) + (type (vector (unsigned-byte 8)) sequence) (type fixnum start)) + (locally + (declare (optimize (safety 1) (debug 0))) + (let ((state (make-md5-state))) + (declare (type md5-state state)) + #+cmu + (lisp::with-array-data ((data sequence) (real-start start) (real-end end)) + (update-md5-state state data :start real-start :end real-end)) + #+sbcl + (sb-kernel:with-array-data ((data sequence) (real-start start) (real-end end)) + (update-md5-state state data :start real-start :end real-end)) + #-(or cmu sbcl) + (let ((real-end (or end (length sequence)))) + (declare (type fixnum real-end)) + (update-md5-state state sequence :start start :end real-end)) + (finalize-md5-state state)))) (defun md5sum-string (string &key (external-format :default) (start 0) end) "Calculate the MD5 message-digest of the binary representation of STRING (as octets) in EXTERNAL-FORMAT. The boundaries START and END refer to character positions in the string, not to octets in the resulting binary representation." - (declare (optimize (speed 3) (space 0) (debug 0)) - (type string string)) - (md5sum-sequence - (sb-ext:string-to-octets string - :external-format external-format - :start start :end end))) + (declare (optimize (speed 3) (safety 3) (space 0) (debug 1)) + (type string string) (type fixnum start)) + (locally + (declare (optimize (safety 1) (debug 0))) + (md5sum-sequence + (sb-ext:string-to-octets string + :external-format external-format + :start start :end end)))) (defconstant +buffer-size+ (* 128 1024) "Size of internal buffer to use for md5sum-stream and md5sum-file @@ -543,37 +547,44 @@ operations. This should be a multiple of 64, the MD5 block size.") (defun md5sum-stream (stream) "Calculate an MD5 message-digest of the contents of STREAM, whose element-type has to be (UNSIGNED-BYTE 8)." - (declare (optimize (speed 3) (space 0) (debug 0))) - (let ((state (make-md5-state))) - (declare (type md5-state state)) - (cond - ((equal (stream-element-type stream) '(unsigned-byte 8)) - (let ((buffer (make-array +buffer-size+ - :element-type '(unsigned-byte 8)))) - (declare (type (simple-array (unsigned-byte 8) (#.+buffer-size+)) - buffer)) - (loop for bytes of-type buffer-index = (read-sequence buffer stream) - do (update-md5-state state buffer :end bytes) - until (< bytes +buffer-size+) - finally - (return (finalize-md5-state state))))) - ((equal (stream-element-type stream) 'character) - (let ((buffer (make-string +buffer-size+))) - (declare (type (simple-string #.+buffer-size+) buffer)) - (loop for bytes of-type buffer-index = (read-sequence buffer stream) - do (update-md5-state state buffer :end bytes) - until (< bytes +buffer-size+) - finally - (return (finalize-md5-state state))))) - (t - (error "Unsupported stream element-type ~S for stream ~S." - (stream-element-type stream) stream))))) + (declare (optimize (speed 3) (safety 3) (space 0) (debug 1))) + (declare (type stream stream)) + (locally + (declare (optimize (safety 1) (debug 0))) + (let ((state (make-md5-state))) + (declare (type md5-state state)) + (cond + ((equal (stream-element-type stream) '(unsigned-byte 8)) + (let ((buffer (make-array +buffer-size+ + :element-type '(unsigned-byte 8)))) + (declare (type (simple-array (unsigned-byte 8) (#.+buffer-size+)) + buffer)) + (loop for bytes of-type buffer-index = (read-sequence buffer stream) + do (update-md5-state state buffer :end bytes) + until (< bytes +buffer-size+) + finally + (return (finalize-md5-state state))))) + #+(or) + ((equal (stream-element-type stream) 'character) + (let ((buffer (make-string +buffer-size+))) + (declare (type (simple-string #.+buffer-size+) buffer)) + (loop for bytes of-type buffer-index = (read-sequence buffer stream) + do (update-md5-state state buffer :end bytes) + until (< bytes +buffer-size+) + finally + (return (finalize-md5-state state))))) + (t + (error "Unsupported stream element-type ~S for stream ~S." + (stream-element-type stream) stream)))))) (defun md5sum-file (pathname) - "Calculate the MD5 message-digest of the file specified by pathname." - (declare (optimize (speed 3) (space 0) (debug 0))) - (with-open-file (stream pathname :element-type '(unsigned-byte 8)) - (md5sum-stream stream))) + "Calculate the MD5 message-digest of the file designated by +pathname." + (declare (optimize (speed 3) (safety 3) (space 0) (debug 1))) + (locally + (declare (optimize (safety 1) (debug 0))) + (with-open-file (stream pathname :element-type '(unsigned-byte 8)) + (md5sum-stream stream)))) #+cmu (eval-when (:compile-toplevel :execute) @@ -585,4 +596,4 @@ element-type has to be (UNSIGNED-BYTE 8)." #+sbcl (eval-when (:compile-toplevel) - (setq *features* *old-features*)) \ No newline at end of file + (setq *features* *old-features*)) diff --git a/version.lisp-expr b/version.lisp-expr index 0426e99..8847cfc 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.0.32" +"0.9.0.33" -- 1.7.10.4