source: trunk/abcl/src/org/armedbear/lisp/digest.lisp @ 14196

Last change on this file since 14196 was 14196, checked in by Mark Evenson, 8 years ago

SYS:SHA256 efficiently computes cryptographic hashs on pathnames.

File size: 4.2 KB
Line 
1;;; require.lisp
2;;;
3;;; Copyright (C) 2012 Mark Evenson
4;;; $Id$
5
6;;; This program is free software; you can redistribute it and/or
7;;; modify it under the terms of the GNU General Public License
8;;; as published by the Free Software Foundation; either version 2
9;;; of the License, or (at your option) any later version.
10;;;
11;;; This program is distributed in the hope that it will be useful,
12;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with this program; if not, write to the Free Software
18;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
19;;;
20;;; As a special exception, the copyright holders of this library give you
21;;; permission to link this library with independent modules to produce an
22;;; executable, regardless of the license terms of these independent
23;;; modules, and to copy and distribute the resulting executable under
24;;; terms of your choice, provided that you also meet, for each linked
25;;; independent module, the terms and conditions of the license of that
26;;; module.  An independent module is a module which is not derived from
27;;; or based on this library.  If you modify this library, you may extend
28;;; this exception to your version of the library, but you are not
29;;; obligated to do so.  If you do not wish to do so, delete this
30;;; exception statement from your version.
31
32(require :java)
33(in-package :system)
34
35(defun ascii-digest (digest)
36  (format nil "~{~X~}"
37          (mapcar (lambda (b) (if (< b 0) (+ 256 b) b))
38                  (java::list-from-jarray digest))))
39(export 'sha256 :system)
40(defun sha256 (&rest paths-or-strings)
41  (format *debug-io* "~&Args: ~S~&" paths-or-strings)
42  (cond 
43    ((= 1 (length paths-or-strings))
44     (typecase paths-or-strings
45       (pathname
46        (ascii-digest (digest (first paths) 'nio)))
47       (string 
48       
49    ((consp paths)
50     (concatenate 'string
51                  (append
52                   (mapcar #'ascii-digest
53                           (mapcar (lambda (p)
54                                     (funcall #'digest p 'nio))
55                                   paths)))))
56    ((null paths)
57     nil)))
58                                     
59           
60(defgeneric digest (url algorithim  &optional (digest 'sha-256))
61  (:documentation "Digest byte based resource at URL with ALGORITHIM."))
62(defun digest-path (path) (ascii-digest (digest path 'nio 'sha-256)))
63
64(defvar *digest-types* 
65  '((sha-1 . "SHA-1")
66    (sha-256 . "SHA-256")
67    (sha-512 . "SHA-512"))
68  "Normalization of cryptographic digest naming.")
69
70;;; Implementation
71(defconstant +byte-buffer-rewind+ 
72  (java:jmethod "java.nio.ByteBuffer" "rewind"))
73(defconstant +byte-buffer-get+ 
74  (java:jmethod "java.nio.ByteBuffer" "get" "[B" "int" "int"))
75(defconstant +digest-update+ 
76  (java:jmethod "java.security.MessageDigest" "update" "[B" "int" "int"))
77
78(defmethod digest ((url t) (algorithim (eql 'nio)) &optional (digest 'sha-256))
79  "Calculate digest with default of :SHA-256 pathname specified by URL.
80Returns an array of JVM primitive signed 8-bit bytes.
81
82*DIGEST-TYPES* controls the allowable digest types."
83
84 (let* ((digest-type (cdr (assoc digest *digest-types*)))
85        (digest (java:jstatic "getInstance" "java.security.MessageDigest" digest-type))
86        (namestring (if (pathnamep url) (namestring url) url))
87        (file-input-stream (java:jnew "java.io.FileInputStream" namestring))
88        (channel (java:jcall "getChannel" file-input-stream))
89        (length 8192)
90        (buffer (java:jstatic "allocateDirect" "java.nio.ByteBuffer" length))
91        (array (java:jnew-array "byte" length)))
92   (do ((read (java:jcall "read" channel buffer)
93              (java:jcall "read" channel buffer)))
94       ((not (> read 0)))
95     (java:jcall +byte-buffer-rewind+ buffer)
96     (java:jcall +byte-buffer-get+ buffer array 0 read)
97     (java:jcall +byte-buffer-rewind+ buffer)
98     (java:jcall +digest-update+ digest array 0 read))
99   (java:jcall "digest" digest)))
100
101;;(defmethod digest ((s string) (algorithim (eql 'nio)) &optional (digest 'sha-256))
102;;  (warn "Unimplemented."))
103;;  (let ((input-stream (
Note: See TracBrowser for help on using the repository browser.