Changeset 13330

Timestamp:

06/15/11 09:26:03 (12 years ago)

Author:

Mark Evenson

Message:

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.

Location:

trunk/abcl/tools

Files:

• abcl-tools.asd (added)
• digest.lisp (modified) (4 diffs)

trunk/abcl/tools/digest.lisp

@@ +1 @@
+;;;; Cryptographic  message digest calculation with ABCL with different implementations.
+;;;;
+;;;; Mark <evenson.not.org@gmail.com>
+;;;;
+
+(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"))
@@ -11 +25 @@
   (jmethod "java.security.MessageDigest" "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))
+*DIGEST-TYPES* controls the allowable digest types."
+
  (let* ((digest-type (cdr (assoc digest *digest-types*)))
         (digest (jstatic "getInstance" "java.security.MessageDigest" 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)
-        :do 
-        (jcall-raw "update" digest 
-                   (jnew-array-from-array "byte" buffer) 0 bytes))
-     (jcall "digest" digest))))
-
-(defun digest-file (path &key (digest :sha-256))
- (let* ((digest-type (cdr (assoc digest *digest-types*)))
-        (digest (jstatic "getInstance" "java.security.MessageDigest" digest-type))
-        (namestring (if (pathnamep path) (namestring path) path))
+        (namestring (if (pathnamep url) (namestring url) url))
         (file-input-stream (jnew "java.io.FileInputStream" namestring))
         (channel (jcall "getChannel" file-input-stream))
@@ -43 +48 @@
    (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" "java.security.MessageDigest" digest-type))
+        (buffer (make-array 8192 :element-type '(unsigned-byte 8))))
+   (with-open-file (input url :element-type '(unsigned-byte 8))
+     (loop 
+        :for  
+            bytes = (read-sequence buffer input)
+        :while 
+           (plusp bytes)
+        :do 
+           (jcall-raw "update" digest 
+                      (jnew-array-from-array "byte" buffer) 0 bytes))
+     (jcall "digest" digest))))
+
 (defun ascii-digest (digest)
   (format nil "~{~X~}"
@@ -49 +75 @@
 
 (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)))
-      results))
-    
-        
+        (let ((result 
+               (list 
+                (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
+|#