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

Last change on this file since 14199 was 14199, checked in by rschlatte, 8 years ago

Restore build harder.

  • sha256 was corrupted (truncated line in typecase form), kludged into compiling without trying to guess what the form was supposed to be
File size: 4.3 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  (cond 
42    ((= 1 (length paths-or-strings))
43     (typecase paths-or-strings
44       (pathname
45        (ascii-digest (digest (first paths-or-strings) 'nio)))
46       (string (error "Somebody implement me please")))) ; FIXME
47       
48    ((consp paths-or-strings)
49     (concatenate 'string
50                  (append
51                   (mapcar #'ascii-digest
52                           (mapcar (lambda (p)
53                                     (funcall #'digest p 'nio))
54                                   paths-or-strings)))))
55    ((null paths-or-strings)
56     nil)))
57                                     
58           
59(defgeneric digest (url algorithim  &optional (digest 'sha-256))
60  (:documentation "Digest byte based resource at URL with ALGORITHIM."))
61(defun digest-path (path) (ascii-digest (digest path 'nio 'sha-256)))
62
63(defvar *digest-types* 
64  '((sha-1 . "SHA-1")
65    (sha-256 . "SHA-256")
66    (sha-512 . "SHA-512"))
67  "Normalization of cryptographic digest naming.")
68
69;;; Implementation
70(defconstant +byte-buffer-rewind+ 
71  (java:jmethod "java.nio.ByteBuffer" "rewind"))
72(defconstant +byte-buffer-get+ 
73  (java:jmethod "java.nio.ByteBuffer" "get" "[B" "int" "int"))
74(defconstant +digest-update+ 
75  (java:jmethod "java.security.MessageDigest" "update" "[B" "int" "int"))
76
77(defmethod digest ((url t) (algorithim (eql 'nio)) &optional (digest 'sha-256))
78  "Calculate digest with default of :SHA-256 pathname specified by URL.
79Returns an array of JVM primitive signed 8-bit bytes.
80
81*DIGEST-TYPES* controls the allowable digest types."
82
83 (let* ((digest-type (cdr (assoc digest *digest-types*)))
84        (digest (java:jstatic "getInstance" "java.security.MessageDigest" digest-type))
85        (namestring (if (pathnamep url) (namestring url) url))
86        (file-input-stream (java:jnew "java.io.FileInputStream" namestring))
87        (channel (java:jcall "getChannel" file-input-stream))
88        (length 8192)
89        (buffer (java:jstatic "allocateDirect" "java.nio.ByteBuffer" length))
90        (array (java:jnew-array "byte" length)))
91   (do ((read (java:jcall "read" channel buffer)
92              (java:jcall "read" channel buffer)))
93       ((not (> read 0)))
94     (java:jcall +byte-buffer-rewind+ buffer)
95     (java:jcall +byte-buffer-get+ buffer array 0 read)
96     (java:jcall +byte-buffer-rewind+ buffer)
97     (java:jcall +digest-update+ digest array 0 read))
98   (java:jcall "digest" digest)))
99
100;;(defmethod digest ((s string) (algorithim (eql 'nio)) &optional (digest 'sha-256))
101;;  (warn "Unimplemented."))
102;;  (let ((input-stream (
Note: See TracBrowser for help on using the repository browser.