From de40c49ce9cac9e3131e77ca94f6de91e97abe02 Mon Sep 17 00:00:00 2001 From: "Pierre R. Mai" Date: Sat, 24 Feb 2018 12:56:32 +0100 Subject: [PATCH] Fix ACL results due to adjust-array anomaly The old code relied on adjust-array of a simple-array yielding a new simple-array, which is the case on most implementations and corresponds with my reading of the standard. However ACL returns a non-simple array in this case, which would later on clash with the declared types in keccak-state-merge-input, leading to erroneous data accesses and possible non-termination, etc. Since our use of adjust-array is not central to the pad-message-to-width function, and that function is not really performance critical (only called once during the digest finalization), we just switch to new allocation and replace. --- common.lisp | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/common.lisp b/common.lisp index 217f364..4aab244 100755 --- a/common.lisp +++ b/common.lisp @@ -185,16 +185,18 @@ Only supports atoms and function forms, no special forms." "Destructively pad the given message to the given bit-width according to the Keccak 10*1 padding rules, optionally appending the FIPS 202/SHA-3 mandated 01 suffix first, and return the padded message." - (let ((message-byte-length (length message)) - (width-bytes (truncate bit-width 8))) - (setq message (adjust-array message (list width-bytes))) + (let* ((message-byte-length (length message)) + (width-bytes (truncate bit-width 8)) + (padded (make-array width-bytes + :element-type '(unsigned-byte 8)))) + (replace padded message) ;; FIPS 202 SHA-3 mandates the appending of a 01 suffix prior to the ;; final Keccak padding so that the first byte following the message ;; will be #b00000101 instead of #b00000001 for raw Keccak. - (setf (aref message message-byte-length) (if add-fips-202-suffix-p #x06 #x01)) + (setf (aref padded message-byte-length) (if add-fips-202-suffix-p #x06 #x01)) (loop for index from (1+ message-byte-length) below width-bytes - do (setf (aref message index) #x00) + do (setf (aref padded index) #x00) finally - (setf (aref message (1- width-bytes)) - (logior #x80 (aref message (1- width-bytes)))))) - message) + (setf (aref padded (1- width-bytes)) + (logior #x80 (aref padded (1- width-bytes))))) + padded))