From: Nathan Froyd Date: Wed, 16 Nov 2005 15:07:06 +0000 (+0000) Subject: 0.9.46.7: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=bbb52aeac5d78d354c24923422e6493bc8f54778;p=sbcl.git 0.9.46.7: Fix SB-MD5 bugs: * Updating the MD5 state with a "short" sequence was buggy; ...and the moral of the story is: (SAFETY 0) hides real bugs * MD5SUM-SEQUENCE did not respect fill pointers. --- diff --git a/contrib/sb-md5/md5-tests.lisp b/contrib/sb-md5/md5-tests.lisp index c0f8da1..5c0aff6 100644 --- a/contrib/sb-md5/md5-tests.lisp +++ b/contrib/sb-md5/md5-tests.lisp @@ -2,18 +2,45 @@ (:use #:sb-md5 #:cl #:sb-rt)) (in-package #:sb-md5-tests) +(defun byte-array-to-hex-string (bytevec) + (format nil "~(~{~2,'0X~}~)" (coerce bytevec 'list))) + +(defun one-shot-test (string) + (md5sum-string string :external-format :ascii)) + +(defun incremental-test (string) + (let ((bytevec (sb-ext:string-to-octets string :external-format :ascii)) + (state (sb-md5:make-md5-state))) + (dotimes (i (length bytevec) (sb-md5:finalize-md5-state state)) + (sb-md5:update-md5-state state bytevec :start i :end (1+ i))))) + +(defun fill-pointer-test (string) + (let* ((bytevec (sb-ext:string-to-octets string :external-format :ascii)) + (fillvec (let ((x (make-array (* 2 (length bytevec)) + :fill-pointer 0 + :element-type '(unsigned-byte 8)))) + (dotimes (i (length bytevec) x) + (vector-push (aref bytevec i) x))))) + (sb-md5:md5sum-sequence fillvec))) + +(eval-when (:compile-toplevel :load-toplevel :execute) +(defun tests-for-test-suite (basename index string expected-result) + (loop for (test-kind testfun) in '(("ONE-SHOT" one-shot-test) + ("INCREMENTAL" incremental-test) + ("FILL-POINTER" fill-pointer-test)) + collect `(deftest ,(intern (format nil "~A.~A.~A" basename test-kind index)) + (string= (byte-array-to-hex-string (funcall ',testfun ,string)) + ,expected-result) + t) into test-forms + finally (return `(progn ,@test-forms)))) +) ; EVAL-WHEN + (macrolet ((define-rfc1321-tests (test-list) `(progn ,@(loop for i upfrom 0 for (string . expected-result) in test-list - collect - `(deftest ,(intern (format nil "SB-MD5.RFC1321.~A" i)) - (string= (format nil - "~(~{~2,'0X~}~)" - (coerce (md5sum-string ,string :external-format :ascii) 'list)) - ,expected-result) - t))))) + collect (tests-for-test-suite "SB-MD5.RFC1321" i string expected-result))))) (define-rfc1321-tests (("" . "d41d8cd98f00b204e9800998ecf8427e") ("a" ."0cc175b9c0f1b6a831c399e269772661") @@ -28,13 +55,7 @@ `(progn ,@(loop for i upfrom 0 for (string . expected-result) in test-list - collect - `(deftest ,(intern (format nil "SB-MD5.OTHER.~A" i)) - (string= - (format nil "~(~{~2,'0X~}~)" - (coerce (md5sum-string ,string :external-format :ascii) 'list)) - ,expected-result) - t))))) + collect (tests-for-test-suite "SB-MD5.OTHER" i string expected-result))))) (define-other-tests (;; From padding bug report by Edi Weitz ("1631901HERR BUCHHEISTERCITROEN NORD1043360796beckenbauer" . "d734945e5930bb28859ccd13c830358b") diff --git a/contrib/sb-md5/md5.lisp b/contrib/sb-md5/md5.lisp index 4d7edac..54d5810 100644 --- a/contrib/sb-md5/md5.lisp +++ b/contrib/sb-md5/md5.lisp @@ -416,11 +416,14 @@ bounded by start and end, which must be numeric bounding-indices." (declare (type (integer 0 63) amount)) (copy-to-buffer sequence start amount buffer buffer-index) (setq start (the fixnum (+ start amount))) - (when (>= start end) - (setf (md5-state-buffer-index state) (+ buffer-index amount)) - (return-from update-md5-state state))) - (fill-block-ub8 block buffer 0) - (update-md5-block regs block)) + (let ((new-index (mod (+ buffer-index amount) 64))) + (when (zerop new-index) + (fill-block-ub8 block buffer 0) + (update-md5-block regs block)) + (when (>= start end) + (setf (md5-state-buffer-index state) new-index) + (incf (md5-state-amount state) length) + (return-from update-md5-state state))))) ;; Handle main-part and new-rest (etypecase sequence ((simple-array (unsigned-byte 8) (*)) @@ -513,11 +516,19 @@ in SEQUENCE , which must be a vector with element-type (UNSIGNED-BYTE (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)) + ;; respect the fill pointer + (let ((end (or end (length sequence)))) + (lisp::with-array-data ((data sequence) (real-start start) (real-end end)) + (declare (ignore real-end)) + (update-md5-state state data :start real-start + :end (+ real-start (- end start))))) #+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)) + ;; respect the fill pointer + (let ((end (or end (length sequence)))) + (sb-kernel:with-array-data ((data sequence) (real-start start) (real-end end)) + (declare (ignore real-end)) + (update-md5-state state data :start real-start + :end (+ real-start (- end start))))) #-(or cmu sbcl) (let ((real-end (or end (length sequence)))) (declare (type fixnum real-end)) diff --git a/version.lisp-expr b/version.lisp-expr index 8309609..51c538a 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.6.46" +"0.9.6.47"