raw
esthlos-v_keccak        1 (in-package "CL-KECCAK")
esthlos-v_keccak        2 
esthlos-v_keccak        3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
esthlos-v_keccak        4 ;; utility functions for moving between integers and lanes
esthlos-v_keccak        5 ;; these are not used in cl-keccak proper. rather, they are
esthlos-v_keccak        6 ;; for testing and generating the round constants
esthlos-v_keccak        7 
esthlos-v_keccak        8 (defun bit-truncate-right (bv n)
esthlos-v_keccak        9   (subseq bv 0 n))
esthlos-v_keccak       10 
esthlos-v_keccak       11 (defun integer-to-lane (n)
esthlos-v_keccak       12   (labels ((bit-array-iter (n array)
esthlos-v_keccak       13              (if (zerop n)
esthlos-v_keccak       14                  array
esthlos-v_keccak       15                  (multiple-value-bind (q r)
esthlos-v_keccak       16                      (floor n 2)
esthlos-v_keccak       17                    (bit-array-iter q
esthlos-v_keccak       18                                    (append array (list r)))))))
esthlos-v_keccak       19     (bit-truncate-right (bit-pad-right (bit-array-iter n '())
esthlos-v_keccak       20                                        +lane-size+)
esthlos-v_keccak       21                         +lane-size+)))
esthlos-v_keccak       22 
esthlos-v_keccak       23 (defun lane-to-integer (bv)
esthlos-v_keccak       24   (reduce #'(lambda (a b) (+ a (* 2 b)))
esthlos-v_keccak       25           bv
esthlos-v_keccak       26           :from-end t))
esthlos-v_keccak       27 
esthlos-v_keccak       28 (defun lane-to-string (lane &optional (raw t))
esthlos-v_keccak       29   (if raw
esthlos-v_keccak       30       (format nil "~a" lane)
esthlos-v_keccak       31       (let ((fmt-str (format nil
esthlos-v_keccak       32                              "~~~d,'0X"
esthlos-v_keccak       33                              (max 0 (/ +lane-size+ 4)))))
esthlos-v_keccak       34         (format nil fmt-str (lane-to-integer lane)))))
esthlos-v_keccak       35 
esthlos-v_keccak       36 
esthlos-v_keccak       37 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
esthlos-v_keccak       38 ;; test for magic constants.
esthlos-v_keccak       39 ;; numbers used to generate the lanes can be found here:
esthlos-v_keccak       40 ;; https://keccak.team/keccak_specs_summary.html#roundConstants
esthlos-v_keccak       41 
esthlos-v_keccak       42 (defun test-magic-constants (&optional (stream t))
esthlos-v_keccak       43   (let ((errors nil)
esthlos-v_keccak       44         (calculated-constants
esthlos-v_keccak       45          (make-array '(24)
esthlos-v_keccak       46                      :element-type 'lane
esthlos-v_keccak       47                      :initial-contents
esthlos-v_keccak       48                      (mapcar #'integer-to-lane
esthlos-v_keccak       49                              '(#x0000000000000001
esthlos-v_keccak       50                                #x0000000000008082
esthlos-v_keccak       51                                #x800000000000808a
esthlos-v_keccak       52                                #x8000000080008000
esthlos-v_keccak       53                                #x000000000000808b
esthlos-v_keccak       54                                #x0000000080000001
esthlos-v_keccak       55                                #x8000000080008081
esthlos-v_keccak       56                                #x8000000000008009
esthlos-v_keccak       57                                #x000000000000008a
esthlos-v_keccak       58                                #x0000000000000088
esthlos-v_keccak       59                                #x0000000080008009
esthlos-v_keccak       60                                #x000000008000000a
esthlos-v_keccak       61                                #x000000008000808b
esthlos-v_keccak       62                                #x800000000000008b
esthlos-v_keccak       63                                #x8000000000008089
esthlos-v_keccak       64                                #x8000000000008003
esthlos-v_keccak       65                                #x8000000000008002
esthlos-v_keccak       66                                #x8000000000000080
esthlos-v_keccak       67                                #x000000000000800a
esthlos-v_keccak       68                                #x800000008000000a
esthlos-v_keccak       69                                #x8000000080008081
esthlos-v_keccak       70                                #x8000000000008080
esthlos-v_keccak       71                                #x0000000080000001
esthlos-v_keccak       72                                #x8000000080008008)))))
esthlos-v_keccak       73     (dotimes (x 24)
esthlos-v_keccak       74       (let ((a (aref calculated-constants x))
esthlos-v_keccak       75             (b (aref +round-constants+ x)))
esthlos-v_keccak       76         (format stream "Constant number ~d~%" x)
esthlos-v_keccak       77         (format stream "Actual:   ~a~%" a)
esthlos-v_keccak       78         (format stream "Expected: ~a~%" b)
esthlos-v_keccak       79         (format stream "Status: ~a~%"
esthlos-v_keccak       80                 (if (equal a b) "OK" (progn (push x errors)
esthlos-v_keccak       81                                             "ERROR")))))
esthlos-v_keccak       82     (if errors
esthlos-v_keccak       83         (format t "ERRORS DETECTED! SEE CONSTANTS: ~a" errors)
esthlos-v_keccak       84         (format t "Test passed with no errors."))))
esthlos-v_keccak       85 
esthlos-v_keccak       86 
esthlos-v_keccak       87 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
esthlos-v_keccak       88 ;; various procedures to test states
esthlos-v_keccak       89 
esthlos-v_keccak       90 (defun print-state (state &optional (raw t) (stream t))
esthlos-v_keccak       91   (while-traversing-state (x y)
esthlos-v_keccak       92     (format stream
esthlos-v_keccak       93             (if (or raw (= x (1- +row-size+)))
esthlos-v_keccak       94                 "~a~%"
esthlos-v_keccak       95                 "~a ")
esthlos-v_keccak       96             (lane-to-string (lane state x y) raw))))
esthlos-v_keccak       97 
esthlos-v_keccak       98 (defun read-state (stream)
esthlos-v_keccak       99   (with-return-state (b)
esthlos-v_keccak      100     (dotimes (y +column-size+)
esthlos-v_keccak      101       (dotimes (x +row-size+)
esthlos-v_keccak      102         (setf (lane b x y) (read stream))))))
esthlos-v_keccak      103 
esthlos-v_keccak      104 (defun diff-states (state1 state2)
esthlos-v_keccak      105   (let ((diff '()))
esthlos-v_keccak      106     (dotimes (x +row-size+)
esthlos-v_keccak      107       (dotimes (y +column-size+)
esthlos-v_keccak      108         (if (not (equal (lane state1 x y)
esthlos-v_keccak      109                         (lane state2 x y)))
esthlos-v_keccak      110             (setq diff (append diff (list (cons x y)))))))
esthlos-v_keccak      111     diff))
esthlos-v_keccak      112 
esthlos-v_keccak      113 
esthlos-v_keccak      114 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
esthlos-v_keccak      115 ;; tests of the permutation functions
esthlos-v_keccak      116 
esthlos-v_keccak      117 (defun print-keccak-permute (state &optional (stream t) (raw t))
esthlos-v_keccak      118   (format stream ";; Initial state:~%")
esthlos-v_keccak      119   (print-state state raw stream)
esthlos-v_keccak      120   (dotimes (r +round-quantity+)
esthlos-v_keccak      121     (let ((maps (list (cons "theta" #'theta)
esthlos-v_keccak      122                       (cons "rho" #'rho)
esthlos-v_keccak      123                       (cons "pi" #'k-pi)
esthlos-v_keccak      124                       (cons "chi" #'chi)
esthlos-v_keccak      125                       (cons "iota" #'(lambda (a) (iota r a))))))
esthlos-v_keccak      126       (format stream "~%;; Round ~d~%~%" r)
esthlos-v_keccak      127       (dolist (m maps)
esthlos-v_keccak      128         (format stream ";; After ~a:~%" (car m))
esthlos-v_keccak      129         (print-state (setq state
esthlos-v_keccak      130                            (funcall (cdr m) state))
esthlos-v_keccak      131                      raw
esthlos-v_keccak      132                      stream))))
esthlos-v_keccak      133   (format stream "~%;; Final state:~%")
esthlos-v_keccak      134   (state-linearize state)
esthlos-v_keccak      135   (print-state state raw stream))
esthlos-v_keccak      136 
esthlos-v_keccak      137 (defun test-keccak-permute (test-file &optional (stream t))
esthlos-v_keccak      138   (with-open-file (f test-file :direction :input)
esthlos-v_keccak      139     (handler-case
esthlos-v_keccak      140         (let* ((input-state (read-state f))
esthlos-v_keccak      141                (calculated-state input-state))
esthlos-v_keccak      142           (dotimes (r +round-quantity+)
esthlos-v_keccak      143             (let ((maps `(("theta" ,#'theta)
esthlos-v_keccak      144                           ("rho" ,#'rho)
esthlos-v_keccak      145                           ("pi" ,#'k-pi)
esthlos-v_keccak      146                           ("chi" ,#'chi)
esthlos-v_keccak      147                           ("iota" ,#'(lambda (a) (iota r a))))))
esthlos-v_keccak      148               (dolist (m maps)
esthlos-v_keccak      149                 (format stream "Testing: (~2,'0d, ~a)~%" r (first m))
esthlos-v_keccak      150                 (psetq input-state (read-state f)
esthlos-v_keccak      151                        calculated-state (funcall (second m)
esthlos-v_keccak      152                                                  calculated-state))
esthlos-v_keccak      153                 (format stream "Expected:~%")
esthlos-v_keccak      154                 (print-state input-state nil stream)
esthlos-v_keccak      155                 (format stream "Calculated:~%")
esthlos-v_keccak      156                 (print-state calculated-state nil stream)
esthlos-v_keccak      157                 (if (null (diff-states input-state calculated-state))
esthlos-v_keccak      158                     (format stream "Passed: (~2,'0d, ~a)~%" r (first m))
esthlos-v_keccak      159                     (progn
esthlos-v_keccak      160                       (format stream "~%FAILED on permutation ~a, round ~d~%"
esthlos-v_keccak      161                               (first m) r)
esthlos-v_keccak      162                       (format stream "Input state:~%")
esthlos-v_keccak      163                       (print-state input-state nil stream)
esthlos-v_keccak      164                       (format stream "Calculated state:~%")
esthlos-v_keccak      165                       (print-state calculated-state nil stream)
esthlos-v_keccak      166                       (error "State mismatch")))))))
esthlos-v_keccak      167       (error (c) t)))
esthlos-v_keccak      168   (format stream "All permutation function tests passed.~%"))
esthlos-v_keccak      169 
esthlos-v_keccak      170 
esthlos-v_keccak      171 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
esthlos-v_keccak      172 ;; procedure for testing the sponge
esthlos-v_keccak      173 
esthlos-v_keccak      174 (defun test-keccak-sponge (input-bit-vector
esthlos-v_keccak      175                            expected-output-bit-vector-file
esthlos-v_keccak      176                            bitrate
esthlos-v_keccak      177                            output-bits
esthlos-v_keccak      178                            &optional (stream t) (output nil))
esthlos-v_keccak      179   (let ((expected-output-bit-vector
esthlos-v_keccak      180          (with-open-file (f expected-output-bit-vector-file :direction :input)
esthlos-v_keccak      181            (read f))))
esthlos-v_keccak      182     (format stream
esthlos-v_keccak      183             "Testing sponge with input ~A, bitrate ~d, and output bit quantity ~d.~%"
esthlos-v_keccak      184             input-bit-vector
esthlos-v_keccak      185             bitrate
esthlos-v_keccak      186             output-bits)
esthlos-v_keccak      187     (setq output (keccak-sponge input-bit-vector bitrate output-bits))
esthlos-v_keccak      188     (format stream "Output:~%~a~%" (bit-vector-to-hex output))
esthlos-v_keccak      189     (format stream
esthlos-v_keccak      190             (if (equal expected-output-bit-vector output)
esthlos-v_keccak      191                 "Output matches expected value. Test passed.~%"
esthlos-v_keccak      192                 "TEST FAILED! Output does NOT match expected value.~%"))))
esthlos-v_keccak      193 
esthlos-v_keccak      194 
esthlos-v_keccak      195 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
esthlos-v_keccak      196 ;; running the tests
esthlos-v_keccak      197 
esthlos-v_keccak      198 (defun run-tests (&optional (out t))
esthlos-v_keccak      199   (let ((tests
esthlos-v_keccak      200          `(("Testing row constant generation~%"
esthlos-v_keccak      201             ,(lambda () (test-magic-constants
esthlos-v_keccak      202                          out)))
esthlos-v_keccak      203            ("Testing permutations from zero state~%"
esthlos-v_keccak      204             ,(lambda () (test-keccak-permute "testzerostate.txt"
esthlos-v_keccak      205                                              out)))
esthlos-v_keccak      206            ("Testing permutations from nonzero state~%"
esthlos-v_keccak      207             ,(lambda () (test-keccak-permute "testnonzerostate.txt"
esthlos-v_keccak      208                                              out)))
esthlos-v_keccak      209            ("First sponge test~%"
esthlos-v_keccak      210             ,(lambda () (test-keccak-sponge #*11001
esthlos-v_keccak      211                                             "testspongeoutput1.txt"
esthlos-v_keccak      212                                             1344
esthlos-v_keccak      213                                             4096
esthlos-v_keccak      214                                             out)))
esthlos-v_keccak      215            ("Second sponge test~%"
esthlos-v_keccak      216             ,(lambda () (test-keccak-sponge #*110010100001101011011110100110
esthlos-v_keccak      217                                             "testspongeoutput2.txt"
esthlos-v_keccak      218                                             1344
esthlos-v_keccak      219                                             1344
esthlos-v_keccak      220                                             out))))))
esthlos-v_keccak      221     (do ((error nil)
esthlos-v_keccak      222          (n 0 (incf n)))
esthlos-v_keccak      223         ((or error
esthlos-v_keccak      224              (= n (length tests))))
esthlos-v_keccak      225       (format out (first (nth n tests)))
esthlos-v_keccak      226       (funcall (second (nth n tests)))
esthlos-v_keccak      227       (format out "~%~%"))))