[armedbear-cvs] r14202 - trunk/abcl/src/org/armedbear/lisp

[mevenson at common-lisp.net]

Author: mevenson
Date: Tue Oct 16 01:54:42 2012
New Revision: 14202

Log:
SYS:SHA256 now hashes strings passed its way.

TODO: develop a "lazy serialization" so that all of the arguments of
SHA256 will have the underlying java.nio.Channel objects ready t obe
run through the digest function.

Enough for an implementation of renaming dynamic callbacks.

Modified:
   trunk/abcl/src/org/armedbear/lisp/digest.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/digest.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/digest.lisp	Mon Oct 15 09:08:06 2012	(r14201)
+++ trunk/abcl/src/org/armedbear/lisp/digest.lisp	Tue Oct 16 01:54:42 2012	(r14202)
@@ -32,7 +32,7 @@
 (require :java)
 (in-package :system)
 
-(defun asciify-digest (digest)
+(defun asciify (digest)
   (format nil "~{~X~}"
           (mapcar (lambda (b) (if (< b 0) (+ 256 b) b))
                   (java::list-from-jarray digest))))
@@ -40,13 +40,13 @@
 
 ;;;; Really needs to concatenate all input into a single source of
 ;;;; bytes, running digest over that concatentation
-(defun sha256 (&rest paths-or-strings)
+(defun sha256 (&rest paths-or-strings) ;;; XXX more than one arg is very broken.
   "Returned ASCIIfied representation of SHA256 digest of byte-based resource at PATHS-OR-STRINGs." 
   (let ((first (first paths-or-strings))
         (rest (rest paths-or-strings)))
     (concatenate 'string 
                   (when first
-                    (asciify-digest
+                    (asciify
                      (typecase first
                        (pathname (digest first))
                        (string (digest first))
@@ -93,23 +93,31 @@
   (java:jmethod "java.security.MessageDigest" "update" "[B" "int" "int"))
 
 (defmethod digest ((url pathname) &key (digest 'sha-256))
+  (digest-nio url :digest digest))
+
+(defun digest-nio (source &key (digest 'sha-256))
   "Calculate digest with default of :SHA-256 pathname specified by URL.
 Returns an array of JVM primitive signed 8-bit bytes.
 
 Uses \"New I/O\" in JVM \"worse named API of all time\".
 
 *DIGEST-TYPES* controls the allowable digest types."
-  (format *debug-io* "~&pathname: ~S" url)
-
- (let* ((digest-type (cdr (assoc digest *digest-types*)))
-        (digest (java:jstatic "getInstance" "java.security.MessageDigest" digest-type))
-        (namestring (if (pathnamep url) (namestring url) url))
-        (file-input-stream (java:jnew "java.io.FileInputStream" namestring))
-        (channel (java:jcall "getChannel" file-input-stream))
-        (length 8192)
-        (buffer (java:jstatic "allocateDirect" "java.nio.ByteBuffer" length))
-        (array (java:jnew-array "byte" length)))
-   (do ((read (java:jcall "read" channel buffer)
+  (let* 
+      ((channel (typecase source
+                    (pathname 
+                     (java:jcall "getChannel" (java:jnew "java.io.FileInputStream" 
+                                                       (namestring source))))
+                     (string 
+                      (java:jstatic "newChannel" "java.nio.channels.Channels" 
+                                    (java:jnew "java.io.ByteArrayInputStream" 
+                                               (java:jcall "getBytes" source))))
+                   (error "Typecase failed of object of type ~S." source)))
+       (digest-type (cdr (assoc digest *digest-types*)))
+       (digest (java:jstatic "getInstance" "java.security.MessageDigest" digest-type))
+       (length 8192)
+       (buffer (java:jstatic "allocateDirect" "java.nio.ByteBuffer" length))
+       (array (java:jnew-array "byte" length)))
+  (do ((read (java:jcall "read" channel buffer)
               (java:jcall "read" channel buffer)))
        ((not (> read 0)))
      (java:jcall +byte-buffer-rewind+ buffer)
@@ -119,10 +127,6 @@
    (java:jcall "digest" digest)))
 
 (defmethod digest ((source string) &key (digest 'sha-256))
-  (declare (ignorable source digest))
-  (warn "Umimplemented.")
-  "deadbeef")
-          
-
+    (digest-nio source :digest digest))
 
 (export 'sha256 :system)