Add benchmark

2 files changed, 251 insertions, 0 deletions

diff --git a/benchmark/benchmark-implementation.lisp b/benchmark/benchmark-implementation.lisp
new file mode 100644
index 0000000..a29eec2
--- /dev/null
+++ b/benchmark/benchmark-implementation.lisp
@@ -0,0 +1,101 @@
+(asdf:load-system "ironclad")
+
+(defparameter *file-size*
+  #+sbcl (expt 10 8)
+  #+(or allegro ccl ecl) (expt 10 7)
+  #-(or allegro ccl ecl sbcl) (expt 10 6))
+(defparameter *data-file* "/tmp/data-clr")
+(defparameter *encrypted-file* "/tmp/data-enc")
+(defparameter *implementation-result-file* "benchmark-tmp")
+(defparameter *result* (acons "version"
+                              (format nil "~a ~a"
+                                      (lisp-implementation-type)
+                                      (lisp-implementation-version))
+                              '()))
+
+(defmacro get-speed (&body body)
+  (let ((start-time (gensym))
+        (end-time (gensym))
+        (result (gensym))
+        (duration (gensym))
+        (speed (gensym)))
+    `(let* ((,start-time (get-internal-real-time))
+            (,result ,@body)
+            (,end-time (get-internal-real-time))
+            (,duration (/ (- ,end-time ,start-time) internal-time-units-per-second))
+            (,speed (round *file-size* ,duration)))
+       (values ,speed ,result))))
+
+(defun benchmark-ciphers ()
+  (let ((speeds '()))
+    (dolist (cipher-name (ironclad:list-all-ciphers))
+      (with-open-file (plaintext *data-file*
+                                 :element-type '(unsigned-byte 8))
+        (with-open-file (ciphertext *encrypted-file*
+                                    :direction :output
+                                    :element-type '(unsigned-byte 8)
+                                    :if-exists :supersede)
+          (flet ((stream-cipher-p (cipher-name)
+                   (= 1 (ironclad:block-length cipher-name))))
+            (let* ((key (ironclad:random-data (car (last (ironclad:key-lengths cipher-name)))))
+                   (cipher (ironclad:make-cipher cipher-name
+                                                 :key key
+                                                 :mode (if (stream-cipher-p cipher-name)
+                                                           :stream
+                                                           :ecb)))
+                   (buffer (make-array 32768 :element-type '(unsigned-byte 8)))
+                   (speed (get-speed (loop for buffer-length = (read-sequence buffer plaintext)
+                                           until (zerop buffer-length)
+                                           do (progn
+                                                (ironclad:encrypt-in-place cipher buffer :end buffer-length)
+                                                (write-sequence buffer ciphertext :end buffer-length))))))
+              (setf speeds (acons cipher-name speed speeds)))))))
+    (setf *result* (acons "ciphers" speeds *result*))))
+
+(defun benchmark-digests ()
+  (let ((speeds '()))
+    (dolist (digest-name (ironclad:list-all-digests))
+      (with-open-file (plaintext *data-file*
+                                 :element-type '(unsigned-byte 8))
+        (let* ((digest (ironclad:make-digest digest-name))
+               (buffer (make-array 32768 :element-type '(unsigned-byte 8)))
+               (speed (get-speed (loop for buffer-length = (read-sequence buffer plaintext)
+                                       until (zerop buffer-length)
+                                       do (ironclad:update-digest digest buffer :end buffer-length)
+                                       finally (ironclad:produce-digest digest)))))
+          (setf speeds (acons digest-name speed speeds)))))
+    (setf *result* (acons "digests" speeds *result*))))
+
+(defun benchmark-macs ()
+  (let ((speeds '()))
+    (dolist (mac-name (ironclad:list-all-macs))
+      (with-open-file (plaintext *data-file*
+                                 :element-type '(unsigned-byte 8))
+        (let* ((key-length (ecase mac-name
+                             (ironclad:blake2-mac 64)
+                             (ironclad:blake2s-mac 32)
+                             (ironclad:cmac 32)
+                             (ironclad:hmac 32)
+                             (ironclad:poly1305 32)
+                             (ironclad:skein-mac 64)))
+               (key (ironclad:random-data key-length))
+               (extra-args (case mac-name
+                             (ironclad:cmac '(:aes))
+                             (ironclad:hmac '(:sha256))))
+               (mac (apply #'ironclad:make-mac mac-name key extra-args))
+               (buffer (make-array 32768 :element-type '(unsigned-byte 8)))
+               (speed (get-speed (loop for buffer-length = (read-sequence buffer plaintext)
+                                       until (zerop buffer-length)
+                                       do (ironclad:update-mac mac buffer :end buffer-length)
+                                       finally (ironclad:produce-mac mac)))))
+          (setf speeds (acons mac-name speed speeds)))))
+    (setf *result* (acons "macs" speeds *result*))))
+
+(benchmark-ciphers)
+(benchmark-digests)
+(benchmark-macs)
+(with-open-file (file *implementation-result-file* :direction :output :if-exists :supersede)
+  (write *result* :stream file))
+
+#+allegro (exit)
+#-allegro (quit)
diff --git a/benchmark/benchmark.lisp b/benchmark/benchmark.lisp
new file mode 100644
index 0000000..ab27ddc
--- /dev/null
+++ b/benchmark/benchmark.lisp
@@ -0,0 +1,150 @@
+(asdf:load-system "ironclad")
+
+(defparameter *lisp-implementations*
+  `(("ABCL" "abcl --load benchmark-implementation.lisp")
+    ("AllegroCL" ,(format nil "alisp -L ~a -L benchmark-implementation.lisp"
+                          (merge-pathnames ".clinit.cl" (user-homedir-pathname))))
+    ("ClozureCL" "ccl --load benchmark-implementation.lisp")
+    ("Clisp" "clisp -i benchmark-implementation.lisp")
+    ("ECL" "ecl --load benchmark-implementation.lisp")
+    ("SBCL" "sbcl --load benchmark-implementation.lisp")))
+(defparameter *data-file* "/tmp/data-clr")
+(defparameter *encrypted-file* "/tmp/data-enc")
+(defparameter *implementation-result-file* "benchmark-tmp")
+(defparameter *result-file* "benchmark.org")
+
+(defun make-data-file (size)
+  (with-open-file (data-file *data-file*
+                             :direction :output
+                             :element-type '(unsigned-byte 8)
+                             :if-exists :supersede)
+    (loop with remaining = size
+          until (zerop remaining)
+          do (let ((n (min remaining 1000)))
+               (write-sequence (ironclad:random-data n) data-file)
+               (decf remaining n)))))
+
+(defun delete-data-files ()
+  (uiop:delete-file-if-exists *data-file*)
+  (uiop:delete-file-if-exists *encrypted-file*)
+  (uiop:delete-file-if-exists *implementation-result-file*))
+
+;;; results format:
+;;;
+;;; (("lisp1" (("version" "...")
+;;;            ("ciphers" (("cipher1" speed1)
+;;;                        ("cipher2" speed2)
+;;;                        (...)))
+;;;            ("digests" (("digest1" speed1)
+;;;                        ("digest2" speed2)
+;;;                        (...)))
+;;;            ("macs" (("mac1" speed1)
+;;;                     ("mac2" speed2)
+;;;                     (...)))))
+;;;  ("lisp2" ...)
+;;;  (...))
+(defun write-result-file (results)
+  (with-open-file (file *result-file* :direction :output :if-exists :supersede)
+    (format file "#+TITLE: Speed benchmark of the Ironclad crypto library~%~%")
+    (format file "Ironclad version: ~a~%~%" (asdf:component-version (asdf:find-system "ironclad")))
+    (format file "Processor: ~a (~a)~%" (machine-type) (machine-version))
+    (format file "Operating system: ~a (~a)~%~%" (software-type) (software-version))
+    (format file "Common Lisp implementations:~%")
+    (dolist (implementation *lisp-implementations*)
+      (let ((lisp (car implementation)))
+        (format file " - ~a: ~a~%" lisp (cdr (assoc "version"
+                                                    (cdr (assoc lisp results :test #'string=))
+                                                    :test #'string=)))))
+    (terpri file)
+
+    (let ((line "|----------------"))
+      (dotimes (i (length *lisp-implementations*))
+        (setf line (concatenate 'string line "+------------")))
+      (setf line (concatenate 'string line "|"))
+
+      (format file "* Ciphers~%~%")
+      (format file "Encryption speed in bytes per second~%~%")
+      (format file "~a~%" line)
+      (format file "|                |")
+      (dolist (implementation *lisp-implementations*)
+        (let ((lisp (car implementation)))
+          (format file " ~10a |" lisp)))
+      (terpri file)
+      (format file "~a~%" line)
+      (dolist (cipher-name (ironclad:list-all-ciphers))
+        (format file "| ~14a |" cipher-name)
+        (dolist (implementation *lisp-implementations*)
+          (let* ((lisp (car implementation))
+                 (result (cdr (assoc "ciphers"
+                                     (cdr (assoc lisp results :test #'string=))
+                                     :test #'string=)))
+                 (speed (cdr (assoc cipher-name result :test #'string=))))
+            (format file " ~10@a |" speed)))
+        (terpri file))
+      (format file "~a~%~%" line)
+
+      (format file "* Digests~%~%")
+      (format file "Hashing speed in bytes per second~%~%")
+      (format file "~a~%" line)
+      (format file "|                |")
+      (dolist (implementation *lisp-implementations*)
+        (let ((lisp (car implementation)))
+          (format file " ~10a |" lisp)))
+      (terpri file)
+      (format file "~a~%" line)
+      (dolist (digest-name (ironclad:list-all-digests))
+        (format file "| ~14a |" digest-name)
+        (dolist (implementation *lisp-implementations*)
+          (let* ((lisp (car implementation))
+                 (result (cdr (assoc "digests"
+                                     (cdr (assoc lisp results :test #'string=))
+                                     :test #'string=)))
+                 (speed (cdr (assoc digest-name result :test #'string=))))
+            (format file " ~10@a |" speed)))
+        (terpri file))
+      (format file "~a~%~%" line)
+
+      (format file "* Message authentication codes~%~%")
+      (format file "CMAC: AES~%")
+      (format file "HMAC: SHA256~%")
+      (format file "SKEIN-MAC: SKEIN512~%~%")
+      (format file "Hashing speed in bytes per second~%~%")
+      (format file "~a~%" line)
+      (format file "|                |")
+      (dolist (implementation *lisp-implementations*)
+        (let ((lisp (car implementation)))
+          (format file " ~10a |" lisp)))
+      (terpri file)
+      (format file "~a~%" line)
+      (dolist (mac-name (ironclad:list-all-macs))
+        (format file "| ~14a |" mac-name)
+        (dolist (implementation *lisp-implementations*)
+          (let* ((lisp (car implementation))
+                 (result (cdr (assoc "macs"
+                                     (cdr (assoc lisp results :test #'string=))
+                                     :test #'string=)))
+                 (speed (cdr (assoc mac-name result :test #'string=))))
+            (format file " ~10@a |" speed)))
+        (terpri file))
+      (format file "~a~%~%" line))))
+
+(defun benchmark ()
+  (let ((results '()))
+    (dolist (implementation *lisp-implementations*)
+      (let ((lisp (car implementation))
+            (command (cadr implementation)))
+        (format t "Benchmarking ~a...~%" lisp)
+        (make-data-file (cond ((member lisp '("SBCL") :test #'string=)
+                               (expt 10 8))
+                              ((member lisp '("AllegroCL" "ClozureCL" "ECL") :test #'string=)
+                               (expt 10 7))
+                              (t
+                               (expt 10 6))))
+        (uiop:run-program command)
+        (with-open-file (file *implementation-result-file*)
+          (setf results (acons lisp (read file) results)))
+        (delete-data-files)))
+    (write-result-file results)
+    (format t "Benchmark result written to \"~a\"~%" *result-file*)))
+
+(benchmark)