-
+ DC7BD6F5202C4B4D5943A4FB7FAA8F46D1DC02A29B9D8F794007BC0D43359C9003BCA218A6BB2AC03F582EA27415939F8EE5C0C0C6055BB0C9280E7E8E1698ADesthlos-v/src/keccak/tests/cl-keccak-tests.lisp(0 . 0)(1 . 227)
477 (in-package "CL-KECCAK")
478
479 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
480 ;; utility functions for moving between integers and lanes
481 ;; these are not used in cl-keccak proper. rather, they are
482 ;; for testing and generating the round constants
483
484 (defun bit-truncate-right (bv n)
485 (subseq bv 0 n))
486
487 (defun integer-to-lane (n)
488 (labels ((bit-array-iter (n array)
489 (if (zerop n)
490 array
491 (multiple-value-bind (q r)
492 (floor n 2)
493 (bit-array-iter q
494 (append array (list r)))))))
495 (bit-truncate-right (bit-pad-right (bit-array-iter n '())
496 +lane-size+)
497 +lane-size+)))
498
499 (defun lane-to-integer (bv)
500 (reduce #'(lambda (a b) (+ a (* 2 b)))
501 bv
502 :from-end t))
503
504 (defun lane-to-string (lane &optional (raw t))
505 (if raw
506 (format nil "~a" lane)
507 (let ((fmt-str (format nil
508 "~~~d,'0X"
509 (max 0 (/ +lane-size+ 4)))))
510 (format nil fmt-str (lane-to-integer lane)))))
511
512
513 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
514 ;; test for magic constants.
515 ;; numbers used to generate the lanes can be found here:
516 ;; https://keccak.team/keccak_specs_summary.html#roundConstants
517
518 (defun test-magic-constants (&optional (stream t))
519 (let ((errors nil)
520 (calculated-constants
521 (make-array '(24)
522 :element-type 'lane
523 :initial-contents
524 (mapcar #'integer-to-lane
525 '(#x0000000000000001
526 #x0000000000008082
527 #x800000000000808a
528 #x8000000080008000
529 #x000000000000808b
530 #x0000000080000001
531 #x8000000080008081
532 #x8000000000008009
533 #x000000000000008a
534 #x0000000000000088
535 #x0000000080008009
536 #x000000008000000a
537 #x000000008000808b
538 #x800000000000008b
539 #x8000000000008089
540 #x8000000000008003
541 #x8000000000008002
542 #x8000000000000080
543 #x000000000000800a
544 #x800000008000000a
545 #x8000000080008081
546 #x8000000000008080
547 #x0000000080000001
548 #x8000000080008008)))))
549 (dotimes (x 24)
550 (let ((a (aref calculated-constants x))
551 (b (aref +round-constants+ x)))
552 (format stream "Constant number ~d~%" x)
553 (format stream "Actual: ~a~%" a)
554 (format stream "Expected: ~a~%" b)
555 (format stream "Status: ~a~%"
556 (if (equal a b) "OK" (progn (push x errors)
557 "ERROR")))))
558 (if errors
559 (format t "ERRORS DETECTED! SEE CONSTANTS: ~a" errors)
560 (format t "Test passed with no errors."))))
561
562
563 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
564 ;; various procedures to test states
565
566 (defun print-state (state &optional (raw t) (stream t))
567 (while-traversing-state (x y)
568 (format stream
569 (if (or raw (= x (1- +row-size+)))
570 "~a~%"
571 "~a ")
572 (lane-to-string (lane state x y) raw))))
573
574 (defun read-state (stream)
575 (with-return-state (b)
576 (dotimes (y +column-size+)
577 (dotimes (x +row-size+)
578 (setf (lane b x y) (read stream))))))
579
580 (defun diff-states (state1 state2)
581 (let ((diff '()))
582 (dotimes (x +row-size+)
583 (dotimes (y +column-size+)
584 (if (not (equal (lane state1 x y)
585 (lane state2 x y)))
586 (setq diff (append diff (list (cons x y)))))))
587 diff))
588
589
590 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
591 ;; tests of the permutation functions
592
593 (defun print-keccak-permute (state &optional (stream t) (raw t))
594 (format stream ";; Initial state:~%")
595 (print-state state raw stream)
596 (dotimes (r +round-quantity+)
597 (let ((maps (list (cons "theta" #'theta)
598 (cons "rho" #'rho)
599 (cons "pi" #'k-pi)
600 (cons "chi" #'chi)
601 (cons "iota" #'(lambda (a) (iota r a))))))
602 (format stream "~%;; Round ~d~%~%" r)
603 (dolist (m maps)
604 (format stream ";; After ~a:~%" (car m))
605 (print-state (setq state
606 (funcall (cdr m) state))
607 raw
608 stream))))
609 (format stream "~%;; Final state:~%")
610 (state-linearize state)
611 (print-state state raw stream))
612
613 (defun test-keccak-permute (test-file &optional (stream t))
614 (with-open-file (f test-file :direction :input)
615 (handler-case
616 (let* ((input-state (read-state f))
617 (calculated-state input-state))
618 (dotimes (r +round-quantity+)
619 (let ((maps `(("theta" ,#'theta)
620 ("rho" ,#'rho)
621 ("pi" ,#'k-pi)
622 ("chi" ,#'chi)
623 ("iota" ,#'(lambda (a) (iota r a))))))
624 (dolist (m maps)
625 (format stream "Testing: (~2,'0d, ~a)~%" r (first m))
626 (psetq input-state (read-state f)
627 calculated-state (funcall (second m)
628 calculated-state))
629 (format stream "Expected:~%")
630 (print-state input-state nil stream)
631 (format stream "Calculated:~%")
632 (print-state calculated-state nil stream)
633 (if (null (diff-states input-state calculated-state))
634 (format stream "Passed: (~2,'0d, ~a)~%" r (first m))
635 (progn
636 (format stream "~%FAILED on permutation ~a, round ~d~%"
637 (first m) r)
638 (format stream "Input state:~%")
639 (print-state input-state nil stream)
640 (format stream "Calculated state:~%")
641 (print-state calculated-state nil stream)
642 (error "State mismatch")))))))
643 (error (c) t)))
644 (format stream "All permutation function tests passed.~%"))
645
646
647 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
648 ;; procedure for testing the sponge
649
650 (defun test-keccak-sponge (input-bit-vector
651 expected-output-bit-vector-file
652 bitrate
653 output-bits
654 &optional (stream t) (output nil))
655 (let ((expected-output-bit-vector
656 (with-open-file (f expected-output-bit-vector-file :direction :input)
657 (read f))))
658 (format stream
659 "Testing sponge with input ~A, bitrate ~d, and output bit quantity ~d.~%"
660 input-bit-vector
661 bitrate
662 output-bits)
663 (setq output (keccak-sponge input-bit-vector bitrate output-bits))
664 (format stream "Output:~%~a~%" (bit-vector-to-hex output))
665 (format stream
666 (if (equal expected-output-bit-vector output)
667 "Output matches expected value. Test passed.~%"
668 "TEST FAILED! Output does NOT match expected value.~%"))))
669
670
671 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
672 ;; running the tests
673
674 (defun run-tests (&optional (out t))
675 (let ((tests
676 `(("Testing row constant generation~%"
677 ,(lambda () (test-magic-constants
678 out)))
679 ("Testing permutations from zero state~%"
680 ,(lambda () (test-keccak-permute "testzerostate.txt"
681 out)))
682 ("Testing permutations from nonzero state~%"
683 ,(lambda () (test-keccak-permute "testnonzerostate.txt"
684 out)))
685 ("First sponge test~%"
686 ,(lambda () (test-keccak-sponge #*11001
687 "testspongeoutput1.txt"
688 1344
689 4096
690 out)))
691 ("Second sponge test~%"
692 ,(lambda () (test-keccak-sponge #*110010100001101011011110100110
693 "testspongeoutput2.txt"
694 1344
695 1344
696 out))))))
697 (do ((error nil)
698 (n 0 (incf n)))
699 ((or error
700 (= n (length tests))))
701 (format out (first (nth n tests)))
702 (funcall (second (nth n tests)))
703 (format out "~%~%"))))