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.
This commit is contained in:
2018-02-24 12:56:32 +01:00
parent 55979bd429
commit de40c49ce9

View File

@ -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))