Create API for message digests via generic function DIGEST.

DIGEST-PATH will return the ascii encoding of the SHA-256
cryptographic hash of the resource at PATH as fast as possible.
parent 4e5d1245
;;; -*- Mode: LISP; Syntax: COMMON-LISP -*-
(require 'asdf)
(in-package :asdf)
(defsystem :abcl-tools :version "0.1.0" :components
((:module src :pathname "" :components
((:file "digest")
(:file "code-grapher")))))
\ No newline at end of file
;;;; Cryptographic message digest calculation with ABCL with different implementations.
;;;; Mark <>
(in-package :cl-user)
;;; API
(defgeneric digest (url algorithim &optional (digest 'sha-256))
(:documentation "Digest byte based resource at URL with ALGORITHIM."))
(defun digest-path (path) (ascii-digest (digest path 'nio 'sha-256)))
(defvar *digest-types*
'((:sha-1 . "SHA-1")
(:sha-256 . "SHA-256")
(:sha-512 . "SHA-512")))
'((sha-1 . "SHA-1")
(sha-256 . "SHA-256")
(sha-512 . "SHA-512"))
"Normalization of cryptographic digest naming.")
;;; Implementation
(defconstant +byte-buffer-rewind+
(jmethod "java.nio.ByteBuffer" "rewind"))
(defconstant +byte-buffer-get+
......@@ -10,24 +24,15 @@
(defconstant +digest-update+
(jmethod "" "update" "[B" "int" "int"))
;;; needs ABCL svn > r13328 and is probably not faster than the NIO version
(defmethod digest ((url t) (algorithim (eql 'nio)) &optional (digest 'sha-256))
"Calculate digest with default of :SHA-256 pathname specified by URL.
Returns an array of JVM primitive signed 8-bit bytes.
(defun digest-file-1 (path &key (digest :sha-256))
(let* ((digest-type (cdr (assoc digest *digest-types*)))
(digest (jstatic "getInstance" "" digest-type))
(buffer (make-array 8192 :element-type '(unsigned-byte 8))))
(with-open-file (input path :element-type '(unsigned-byte 8))
(loop :for bytes = (read-sequence buffer input)
:while (plusp bytes)
(jcall-raw "update" digest
(jnew-array-from-array "byte" buffer) 0 bytes))
(jcall "digest" digest))))
*DIGEST-TYPES* controls the allowable digest types."
(defun digest-file (path &key (digest :sha-256))
(let* ((digest-type (cdr (assoc digest *digest-types*)))
(digest (jstatic "getInstance" "" digest-type))
(namestring (if (pathnamep path) (namestring path) path))
(namestring (if (pathnamep url) (namestring url) url))
(file-input-stream (jnew "" namestring))
(channel (jcall "getChannel" file-input-stream))
(length 8192)
......@@ -42,27 +47,55 @@
(jcall +digest-update+ digest array 0 read))
(jcall "digest" digest)))
(defmethod digest ((url pathname) (algorithim (eql 'lisp)) &optional (digest 'sha-256))
"Compute digest of URL in Lisp where possible.
Currently much slower that using 'nio.
Needs ABCL svn > r13328."
(let* ((digest-type (cdr (assoc digest *digest-types*)))
(digest (jstatic "getInstance" "" digest-type))
(buffer (make-array 8192 :element-type '(unsigned-byte 8))))
(with-open-file (input url :element-type '(unsigned-byte 8))
bytes = (read-sequence buffer input)
(plusp bytes)
(jcall-raw "update" digest
(jnew-array-from-array "byte" buffer) 0 bytes))
(jcall "digest" digest))))
(defun ascii-digest (digest)
(format nil "~{~X~}"
(mapcar (lambda (b) (if (< b 0) (+ 256 b) b))
(java::list-from-jarray digest))))
(defun benchmark (directory)
(let (results start-1 end-1 start-2 end-2)
"For a given DIRECTORY containing a wildcard of files, run the benchmark tests."
(let (results)
(flet ((benchmark (task)
(let (start end result)
(psetf start (get-internal-run-time)
result (push (funcall task) result)
end (get-internal-run-time))
(nconc result (list start (- end start))))))
(dolist (entry (directory directory))
(setf start-1 (get-internal-run-time))
(digest-file-1 entry)
(setf end-1 (get-internal-run-time))
(setf start-2 (get-internal-run-time))
(digest-file entry)
(setf end-2 (get-internal-run-time))
(let ((result (list entry (- end-1 start-1) (- end-2 start-2))))
(format t "~&~A" result)
(push result results)))
(let ((result
(list 'nio (benchmark (lambda () (digest entry 'nio))))
(list 'lisp (benchmark (lambda () (digest entry 'lisp)))))))
(format t "~&~{~A~&~A~}" result)
(push result results))))))
;;; Deprecated
(setf (symbol-function 'digest-file-1) #'digest)
;;; Test
(benchmark "/usr/local/bin/*") ;; unix
(benchmark "c:/*") ;; win32
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment