[armedbear-devel] [quicklisp] The "kitchen" behind quicklisp repositories

[Mark Evenson]

On 6/10/11 13:52 , Zach Beane wrote:
[…]
> I'm not exactly sure what I will need, yet, but certainly if it was easy
> for ABCL to provide a fast way to compute the SHA1/SHA256/SHA512 digest
> of disk files, that would be helpful.
[…]

Attached please find code for ABCL which directly manipulates the 
underlying JVM APIs for fast I/O ("NIO") and uses the built-in 
MessageDigest computation.  Is this sufficient for your needs?

ABCL needs to look at how to make such things happen natively in Lisp a 
lot faster, but that won't be happening in the near future.


-- 
"A screaming comes across the sky.  It has happened before, but there
is nothing to compare to it now."
-------------- next part --------------
;;;; Fast message digest calculation with ABCL
;;;;
;;;; Mark <evenson.not.org at gmail.com>
;;;;

(defvar *digest-types*
  '((:sha-1 . "SHA-1")
    (:sha-256 . "SHA-256")
    (:sha-512 . "SHA-512")))

(defconstant +byte-buffer-rewind+ 
  (jmethod "java.nio.ByteBuffer" "rewind"))
(defconstant +byte-buffer-get+ 
  (jmethod "java.nio.ByteBuffer" "get" "[B" "int" "int"))
(defconstant +digest-update+ 
  (jmethod "java.security.MessageDigest" "update" "[B" "int" "int"))

;;;  needs ABCL svn > r13328 and is probably not faster than the NIO version
#+nil
(defun digest-file (path &key (digest :sha-256))
 (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))
  "Calculate DIGEST with default of :SHA-256 for file at PATH.
Returns an array of signed JVM primitive bytes.
*DIGEST-TYPES* contain allowable digest types."
 (let* ((digest-type (cdr (assoc digest *digest-types*)))
        (digest (jstatic "getInstance" "java.security.MessageDigest" digest-type))
        (namestring (if (pathnamep path) (namestring path) path))
        (file-input-stream (jnew "java.io.FileInputStream" namestring))
        (channel (jcall "getChannel" file-input-stream))
        (length 8192)
        (buffer (jstatic "allocateDirect" "java.nio.ByteBuffer" length))
        (array (jnew-array "byte" length)))
   (do ((read (jcall "read" channel buffer)
              (jcall "read" channel buffer)))
       ((not (> read 0)))
     (jcall +byte-buffer-rewind+ buffer)
     (jcall +byte-buffer-get+ buffer array 0 read)
     (jcall +byte-buffer-rewind+ buffer)
     (jcall +digest-update+ digest array 0 read))
   (jcall "digest" digest)))

(defun ascii-digest (digest)
  "Return the ascii hexadecimal encoding of DIGEST an array of byte[]"
  (format nil "�"
          (mapcar (lambda (b) (if (< b 0) (+ 256 b) b))
                  (java::list-from-jarray digest))))