OSCL/sha3
2
0
Fork 0
mirror of https://github.com/pmai/sha3.git synced 2025-12-21 15:24:28 +01:00
Code Issues Packages Projects Releases Wiki Activity

Add to documentation and include reference implementation for testing.

Browse Source
This commit is contained in:
Pierre R. Mai
2012-11-02 21:43:34 +01:00
parent 618df43b2d
commit 75d481de30
2 changed files with 402 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
README
View File

@ -89,8 +89,26 @@ have to be converted to a simple-array with element-type
rely on implementation-specific functions and is not part of the SHA3
library.
The implementation is licensed under the MIT-style license contained
in the file COPYING and the header of each source file.
The file keccak-reference.lisp contains a slow simple reference
implementation, and testdriver code, which allows testing of the tuned
implementations against this reference and against test data available
from the Keccak Site at: http://keccak.noekeon.org/KeccakKAT-3.zip
The testcases from the Keccak test data can be run with the following
form:
(keccak:test-keccak-msgkat
"/Path/To/MsgKatDirectory"
(lambda (total-bits bit-rate output-bits message)
(declare (ignore total-bits bit-rate))
(sha3:sha3-digest-vector message :output-bit-length output-bits)))
This SHA-3 implementation is licensed under the MIT-style license
contained in the file COPYING and the header of each source file.
Many thanks go to the Keccak Team (Guido Bertoni, Joan Daemen, Michaël
Peeters and Gilles Van Assche, cf. http://keccak.noekeon.org) for
their algorithm and excellent documentation and reference
implementations.
Please direct any feedback to pmai@pmsf.de. A git repository of this
library is available under git://github.com/pmai/sha3.git

382
keccak-reference.lisp Normal file
View File

@ -0,0 +1,382 @@
;;;; SHA3 --- Secure Hash Algorithm 3 (Keccak) Implementation
;;;;
;;;; Copyright (C) 2012 PMSF IT Consulting Pierre R. Mai.
;;;;
;;;; Permission is hereby granted, free of charge, to any person obtaining
;;;; a copy of this software and associated documentation files (the
;;;; "Software"), to deal in the Software without restriction, including
;;;; without limitation the rights to use, copy, modify, merge, publish,
;;;; distribute, sublicense, and/or sell copies of the Software, and to
;;;; permit persons to whom the Software is furnished to do so, subject to
;;;; the following conditions:
;;;;
;;;; The above copyright notice and this permission notice shall be
;;;; included in all copies or substantial portions of the Software.
;;;;
;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
;;;; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY CLAIM, DAMAGES OR
;;;; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
;;;; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
;;;; OTHER DEALINGS IN THE SOFTWARE.
;;;;
;;;; Except as contained in this notice, the name of the author shall
;;;; not be used in advertising or otherwise to promote the sale, use or
;;;; other dealings in this Software without prior written authorization
;;;; from the author.
;;;;
;;;; $Id$
(cl:defpackage #:keccak-reference
(:use #:common-lisp)
(:nicknames #:keccak)
(:export #:keccak
#:print-digest
#:test-with-testsuite
#:read-testsuite-from-file
#:test-with-testsuite-from-file
#:test-keccak-msgkat))
(cl:in-package #:keccak-reference)
;;;; %File Description:
;;;;
;;;; This file contains a simple and unoptimized reference
;;;; implementation of the Keccak secure hash algorithm (which forms
;;;; the basis of the SHA-3 Secure Hash Algorithm Standard).
;;;;
;;;; It is used as a reference for the more optimized and specialized
;;;; implementations of the SHA-3 standard contained in this package.
;;;;
;;;; The main entry point is the functions keccak which calculates a
;;;; keccak hash for a given set of parameters and a given input
;;;; vector and returns both the extracted output hash and the state
;;;; after hashing as its values.
;;;;
;;;
;;; Keccak state and parametes
;;;
(defconstant +keccak-state-columns+ 5
"Width of Keccak state in the x axis")
(defconstant +keccak-state-rows+ 5
"Width of Keccak state in the y axis")
(defconstant +keccak-state-lanes+ (* +keccak-state-columns+ +keccak-state-rows+)
"Total number of lanes in Keccak state")
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun keccak-lane-width (total-bits)
(multiple-value-bind (width rest)
(truncate total-bits +keccak-state-lanes+)
(assert (zerop rest) (total-bits)
"Illegal Keccak Total-Bits value: ~S. Must be a multiple of ~D."
total-bits +keccak-state-lanes+)
width)))
(deftype keccak-lane (total-bits)
"Type of a keccak lane for a given total bit number."
`(unsigned-byte ,(keccak-lane-width total-bits)))
(deftype keccak-state (total-bits)
"Type of a keccak working state object for a given total bit number."
`(simple-array (keccak-lane ,total-bits)
(,+keccak-state-columns+ ,+keccak-state-rows+)))
(defun make-keccak-state (total-bits)
(make-array (list +keccak-state-columns+ +keccak-state-rows+)
:element-type `(keccak-lane ,total-bits)
:initial-element 0))
;;;
;;; Transforming linear input/output to state array
;;;
(defun keccak-state-merge-input (state total-bits bit-rate input start)
(let ((lane-width (keccak-lane-width total-bits))
(rate-bytes (truncate bit-rate 8)))
(dotimes (x +keccak-state-columns+)
(dotimes (y +keccak-state-rows+)
(let ((offset (truncate (* (+ (* y +keccak-state-columns+) x) lane-width) 8)))
(unless (>= offset rate-bytes)
(setf (aref state x y)
(logxor (aref state x y)
(loop with value = 0
for index from (1- (+ start offset
(ceiling lane-width 8)))
downto (+ start offset)
do
(setq value (logior (ash value 8) (aref input index)))
finally
(return value))))))))))
(defun keccak-state-extract-output (state total-bits output-bits)
(let* ((lane-width (keccak-lane-width total-bits))
(output-bytes (truncate output-bits 8))
(digest (make-array (list output-bytes) :element-type '(unsigned-byte 8))))
(dotimes (x +keccak-state-columns+)
(dotimes (y +keccak-state-rows+)
(let ((offset (truncate (* (+ (* y +keccak-state-columns+) x) lane-width) 8)))
(unless (>= offset output-bytes)
(loop with value = (aref state x y)
for index from offset below (min (+ offset (ceiling lane-width 8))
output-bytes)
do
(setf (aref digest index) (ldb (byte 8 0) value)
value (ash value -8)))))))
digest))
;;;
;;; Keccak Constants
;;;
(defparameter *keccak-f-round-constants*
(make-array (list 24) :element-type '(unsigned-byte 64)
:initial-contents
'(#x0000000000000001
#x0000000000008082
#x800000000000808a
#x8000000080008000
#x000000000000808b
#x0000000080000001
#x8000000080008081
#x8000000000008009
#x000000000000008a
#x0000000000000088
#x0000000080008009
#x000000008000000a
#x000000008000808b
#x800000000000008b
#x8000000000008089
#x8000000000008003
#x8000000000008002
#x8000000000000080
#x000000000000800a
#x800000008000000a
#x8000000080008081
#x8000000000008080
#x0000000080000001
#x8000000080008008)))
(defun keccak-f-round-constant (total-bits i)
(let ((lane-width (keccak-lane-width total-bits)))
(ldb (byte lane-width 0) (aref *keccak-f-round-constants* i))))
(defparameter *keccak-f-rotate-offsets*
(make-array (list +keccak-state-columns+ +keccak-state-rows+)
:element-type '(unsigned-byte 8)
:initial-contents
'(( 0 36 3 41 18)
( 1 44 10 45 2)
(62 6 43 15 61)
(28 55 25 21 56)
(27 20 39 8 14))))
;;;
;;; Helper: Rotation
;;;
(defun keccak-f-rot (total-bits value offset)
(let ((lane-width (keccak-lane-width total-bits)))
(logior (ldb (byte lane-width 0) (ash value (mod offset lane-width)))
(ash value (- (mod offset lane-width) lane-width)))))
;;;
;;; Single Keccak-f round
;;;
(defun keccak-f-round (total-bits a rc)
(macrolet ((modref (array &rest indices)
`(aref ,array
,@(mapcar #'(lambda (idx)
`(mod ,idx +keccak-state-columns+)) indices))))
(let ((c (make-array (list +keccak-state-columns+)
:element-type `(keccak-lane ,total-bits)))
(d (make-array (list +keccak-state-columns+)
:element-type `(keccak-lane ,total-bits)))
(b (make-array (list +keccak-state-columns+ +keccak-state-rows+)
:element-type `(keccak-lane ,total-bits))))
(dotimes (x +keccak-state-columns+)
(setf (aref c x)
(logxor (aref a x 0) (aref a x 1) (aref a x 2)
(aref a x 3) (aref a x 4))))
(dotimes (x +keccak-state-columns+)
(setf (aref d x)
(logxor (modref c (1- x))
(keccak-f-rot total-bits (modref c (1+ x)) 1))))
(dotimes (x +keccak-state-columns+)
(dotimes (y +keccak-state-rows+)
(setf (aref a x y)
(logxor (aref a x y) (aref d x)))))
(dotimes (x +keccak-state-columns+)
(dotimes (y +keccak-state-rows+)
(setf (modref b y (+ (* 2 x) (* 3 y)))
(keccak-f-rot total-bits
(aref a x y)
(aref *keccak-f-rotate-offsets* x y)))))
(dotimes (x +keccak-state-columns+)
(dotimes (y +keccak-state-rows+)
(setf (aref a x y)
(logxor (aref b x y)
(logandc1 (modref b (1+ x) y) (modref b (+ x 2) y))))))
(setf (aref a 0 0)
(logxor (aref a 0 0) rc))
a)))
;;;
;;; Keccak-f permutation
;;;
(defun keccak-f (total-bits a)
(assert (member total-bits '(25 50 100 200 400 800 1600)) (total-bits)
"Illegal bit-width ~S!" total-bits)
(let ((rounds (+ 12 (* 2 (truncate (log (keccak-lane-width total-bits) 2))))))
(dotimes (i rounds a)
(keccak-f-round total-bits a (keccak-f-round-constant total-bits i)))))
;;;
;;; Message Padding for last block
;;;
(defun pad-message-to-width (message bit-width)
(let ((message-byte-length (length message))
(width-bytes (truncate bit-width 8)))
(setq message (adjust-array message (list width-bytes)))
(setf (aref message message-byte-length) #x01)
(loop for index from (1+ message-byte-length) below width-bytes
do (setf (aref message index) #x00)
finally
(setf (aref message (1- width-bytes))
(logior #x80 (aref message (1- width-bytes))))))
message)
;;;
;;; Main Entry Point: Keccak
;;;
(defun keccak (total-bits bit-rate output-bits message)
(assert (member total-bits '(25 50 100 200 400 800 1600)) (total-bits)
"Illegal bit-width ~S!" total-bits)
(let ((state (make-keccak-state total-bits))
(rate-bytes (truncate bit-rate 8))
(length (length message)))
(loop for block-offset from 0 to length by rate-bytes
do
(if (<= (+ block-offset rate-bytes) length)
(keccak-state-merge-input state total-bits bit-rate message block-offset)
(keccak-state-merge-input state total-bits bit-rate
(pad-message-to-width
(subseq message block-offset)
bit-rate)
0))
(setq state (keccak-f total-bits state)))
(let ((digest (keccak-state-extract-output state total-bits output-bits)))
(values digest state))))
;;;
;;; Utility functions
;;;
(defun print-digest (digest &optional (stream *standard-output*))
(format stream "~{~2,'0X~}~%" (coerce digest 'list)))
(defun pprint-keccak-state (state &optional (stream *standard-output*))
(dotimes (y +keccak-state-rows+)
(dotimes (x +keccak-state-columns+)
(format stream "~16,'0X " (aref state x y)))
(format stream "~%")))
;;;
;;; Testing
;;;
(defun test-with-testsuite (testsuite function)
(flet ((from-hex (hex-string)
(loop with result = (make-array (list (truncate (length hex-string) 2))
:element-type '(unsigned-byte 8))
for char-index from 0 below (length hex-string) by 2
for result-index upfrom 0
do
(setf (aref result result-index)
(parse-integer hex-string :start char-index :end (+ char-index 2)
:radix 16))
finally (return result)))
(to-hex (vector)
(format nil "~{~2,'0X~}" (map 'list #'identity vector))))
(loop for count from 1
for (source . digest) in testsuite
for binary-source = (from-hex source)
for binary-digest = (from-hex digest)
for test-digest = (funcall function binary-source)
do
(format
*trace-output*
"~2&Test-Case ~D:~% Input: ~A~% Required: ~A~% Returned: ~A~%"
count source digest (to-hex test-digest))
when (equalp binary-digest test-digest)
do (format *trace-output* " OK~%")
else
count 1 into failed
and do (format *trace-output* " FAILED~%")
finally
(format *trace-output*
"~2&~[All ~D test cases succeeded~:;~:*~D of ~D test cases failed~].~%"
failed (1- count))
(return (zerop failed)))))
(defun read-testsuite-from-file (file)
(with-open-file (in file)
(loop with testsuite = nil
with skip = nil
with length = nil
with message = nil
for line = (read-line in nil nil)
until (null line)
do
(cond
((zerop (length line)))
((char= (char line 0) #\#))
((and (>= (length line) 6)
(string= line "Len = " :end1 6))
(setq length (ignore-errors (parse-integer line :start 6))
skip (or (null length)
(not (zerop (mod length 8))))))
((and (not skip)
(>= (length line) 6)
(string= line "Msg = " :end1 6))
(setq message (if (zerop length) "" (subseq line 6))))
((and (not skip) message
(>= (length line) 5)
(string= line "MD = " :end1 5))
(push (cons message (subseq line 5)) testsuite)))
finally
(return (nreverse testsuite)))))
(defun test-with-testsuite-from-file (file function)
(let ((testsuite (read-testsuite-from-file file)))
(test-with-testsuite testsuite function)))
(defun test-keccak-msgkat (directory &optional function)
(loop with result = t
for (filename total-bits bit-rate output-bits) in
'(("ShortMsgKAT_224.txt" 1600 1152 224)
("ShortMsgKAT_256.txt" 1600 1088 256)
("ShortMsgKAT_384.txt" 1600 832 384)
("ShortMsgKAT_512.txt" 1600 576 512)
("LongMsgKAT_224.txt" 1600 1152 224)
("LongMsgKAT_256.txt" 1600 1088 256)
("LongMsgKAT_384.txt" 1600 832 384)
("LongMsgKAT_512.txt" 1600 576 512))
do
(unless
(test-with-testsuite-from-file
(merge-pathnames filename directory)
(if (null function)
(lambda (message) (keccak total-bits bit-rate output-bits message))
(lambda (message)
(funcall function total-bits bit-rate output-bits message))))
(setq result nil))
finally
(return result)))