source: trunk/abcl/tools/digest.lisp @ 13330

Last change on this file since 13330 was 13330, checked in by Mark Evenson, 10 years ago

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.

File size: 3.6 KB
Line 
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
13(defvar *digest-types* 
14  '((sha-1 . "SHA-1")
15    (sha-256 . "SHA-256")
16    (sha-512 . "SHA-512"))
17  "Normalization of cryptographic digest naming.")
18
19;;; Implementation
20(defconstant +byte-buffer-rewind+ 
21  (jmethod "java.nio.ByteBuffer" "rewind"))
22(defconstant +byte-buffer-get+ 
23  (jmethod "java.nio.ByteBuffer" "get" "[B" "int" "int"))
24(defconstant +digest-update+ 
25  (jmethod "java.security.MessageDigest" "update" "[B" "int" "int"))
26
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.
30
31*DIGEST-TYPES* controls the allowable digest types."
32
33 (let* ((digest-type (cdr (assoc digest *digest-types*)))
34        (digest (jstatic "getInstance" "java.security.MessageDigest" digest-type))
35        (namestring (if (pathnamep url) (namestring url) url))
36        (file-input-stream (jnew "java.io.FileInputStream" namestring))
37        (channel (jcall "getChannel" file-input-stream))
38        (length 8192)
39        (buffer (jstatic "allocateDirect" "java.nio.ByteBuffer" length))
40        (array (jnew-array "byte" length)))
41   (do ((read (jcall "read" channel buffer)
42              (jcall "read" channel buffer)))
43       ((not (> read 0)))
44     (jcall +byte-buffer-rewind+ buffer)
45     (jcall +byte-buffer-get+ buffer array 0 read)
46     (jcall +byte-buffer-rewind+ buffer)
47     (jcall +digest-update+ digest array 0 read))
48   (jcall "digest" digest)))
49
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
71(defun ascii-digest (digest)
72  (format nil "~{~X~}"
73          (mapcar (lambda (b) (if (< b 0) (+ 256 b) b))
74                  (java::list-from-jarray digest))))
75
76(defun benchmark (directory)
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))))))
85      (dolist (entry (directory directory))
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))))))
92
93;;; Deprecated
94(setf (symbol-function 'digest-file-1) #'digest)
95
96;;; Test
97
98#|
99(benchmark "/usr/local/bin/*") ;; unix
100(benchmark "c:/*")             ;; win32
101|#
Note: See TracBrowser for help on using the repository browser.