Changeset 13330


Ignore:
Timestamp:
06/15/11 09:26:03 (10 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:
1 added
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/tools/digest.lisp

    r13329 r13330  
     1;;;; Cryptographic  message digest calculation with ABCL with different implementations.
     2;;;;
     3;;;; Mark <evenson.not.org@gmail.com>
     4;;;;
     5
     6(in-package :cl-user)
     7
     8;;; API
     9(defgeneric digest (url algorithim  &optional (digest 'sha-256))
     10  (:documentation "Digest byte based resource at URL with ALGORITHIM."))
     11(defun digest-path (path) (ascii-digest (digest path 'nio 'sha-256)))
     12
    113(defvar *digest-types*
    2   '((:sha-1 . "SHA-1")
    3     (:sha-256 . "SHA-256")
    4     (:sha-512 . "SHA-512")))
     14  '((sha-1 . "SHA-1")
     15    (sha-256 . "SHA-256")
     16    (sha-512 . "SHA-512"))
     17  "Normalization of cryptographic digest naming.")
    518
     19;;; Implementation
    620(defconstant +byte-buffer-rewind+
    721  (jmethod "java.nio.ByteBuffer" "rewind"))
     
    1125  (jmethod "java.security.MessageDigest" "update" "[B" "int" "int"))
    1226
    13 ;;;  needs ABCL svn > r13328 and is probably not faster than the NIO version
     27(defmethod digest ((url t) (algorithim (eql 'nio)) &optional (digest 'sha-256))
     28  "Calculate digest with default of :SHA-256 pathname specified by URL.
     29Returns an array of JVM primitive signed 8-bit bytes.
    1430
    15 (defun digest-file-1 (path &key (digest :sha-256))
     31*DIGEST-TYPES* controls the allowable digest types."
     32
    1633 (let* ((digest-type (cdr (assoc digest *digest-types*)))
    1734        (digest (jstatic "getInstance" "java.security.MessageDigest" digest-type))
    18         (buffer (make-array 8192 :element-type '(unsigned-byte 8))))
    19    (with-open-file (input path :element-type '(unsigned-byte 8))
    20      (loop :for bytes = (read-sequence buffer input)
    21         :while (plusp bytes)
    22         :do
    23         (jcall-raw "update" digest
    24                    (jnew-array-from-array "byte" buffer) 0 bytes))
    25      (jcall "digest" digest))))
    26 
    27 (defun digest-file (path &key (digest :sha-256))
    28  (let* ((digest-type (cdr (assoc digest *digest-types*)))
    29         (digest (jstatic "getInstance" "java.security.MessageDigest" digest-type))
    30         (namestring (if (pathnamep path) (namestring path) path))
     35        (namestring (if (pathnamep url) (namestring url) url))
    3136        (file-input-stream (jnew "java.io.FileInputStream" namestring))
    3237        (channel (jcall "getChannel" file-input-stream))
     
    4348   (jcall "digest" digest)))
    4449
     50(defmethod digest ((url pathname) (algorithim (eql 'lisp)) &optional (digest 'sha-256))
     51  "Compute digest of URL in Lisp where possible.
     52
     53Currently much slower that using 'nio.
     54
     55Needs ABCL svn > r13328."
     56
     57 (let* ((digest-type (cdr (assoc digest *digest-types*)))
     58        (digest (jstatic "getInstance" "java.security.MessageDigest" digest-type))
     59        (buffer (make-array 8192 :element-type '(unsigned-byte 8))))
     60   (with-open-file (input url :element-type '(unsigned-byte 8))
     61     (loop
     62        :for 
     63            bytes = (read-sequence buffer input)
     64        :while
     65           (plusp bytes)
     66        :do
     67           (jcall-raw "update" digest
     68                      (jnew-array-from-array "byte" buffer) 0 bytes))
     69     (jcall "digest" digest))))
     70
    4571(defun ascii-digest (digest)
    4672  (format nil "~{~X~}"
     
    4975
    5076(defun benchmark (directory)
    51     (let (results start-1 end-1 start-2 end-2)
     77  "For a given DIRECTORY containing a wildcard of files, run the benchmark tests."
     78  (let (results)
     79    (flet ((benchmark (task)
     80             (let (start end result)
     81               (psetf start (get-internal-run-time)
     82                      result (push (funcall task) result)
     83                      end (get-internal-run-time))
     84               (nconc result (list start (- end start))))))
    5285      (dolist (entry (directory directory))
    53         (setf start-1 (get-internal-run-time))
    54         (digest-file-1 entry)
    55         (setf end-1 (get-internal-run-time))
    56         (setf start-2 (get-internal-run-time))
    57         (digest-file entry)
    58         (setf end-2 (get-internal-run-time))
    59         (let ((result (list entry (- end-1 start-1) (- end-2 start-2))))
    60           (format t "~&~A" result)
    61           (push result results)))
    62       results))
    63    
    64        
     86        (let ((result
     87               (list
     88                (list 'nio (benchmark (lambda () (digest entry 'nio))))
     89                (list 'lisp (benchmark (lambda () (digest entry 'lisp)))))))
     90          (format t "~&~{~A~&~A~}" result)
     91          (push result results))))))
    6592
     93;;; Deprecated
     94(setf (symbol-function 'digest-file-1) #'digest)
    6695
    67    
     96;;; Test
    6897
     98#|
     99(benchmark "/usr/local/bin/*") ;; unix
     100(benchmark "c:/*")             ;; win32
     101|#
Note: See TracChangeset for help on using the changeset viewer.