Changeset 14200 for trunk/abcl/src/org/armedbear/lisp/digest.lisp

Timestamp:

10/15/12 08:45:04 (8 years ago)

Author:

Mark Evenson

Message:

digest: simplify API.

SHA256 only working for PATHNAME objects at the moment.

File:

• trunk/abcl/src/org/armedbear/lisp/digest.lisp (modified) (4 diffs)

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

@@ -1 @@
-;;; require.lisp
+;;; digest.lisp
 ;;; 
 ;;; Copyright (C) 2012 Mark Evenson
@@ -33 +33 @@
 (in-package :system)
 
-(defun ascii-digest (digest)
+(defun asciify-digest (digest)
   (format nil "~{~X~}"
           (mapcar (lambda (b) (if (< b 0) (+ 256 b) b))
                   (java::list-from-jarray digest))))
-(export 'sha256 :system)
+
+
+;;;; Really needs to concatenate all input into a single source of
+;;;; bytes, running digest over that concatentation
 (defun sha256 (&rest paths-or-strings)
-  (cond 
-    ((= 1 (length paths-or-strings))
-     (typecase paths-or-strings
-       (pathname
-        (ascii-digest (digest (first paths-or-strings) 'nio)))
-       (string (error "Somebody implement me please")))) ; FIXME
-        
-    ((consp paths-or-strings)
-     (concatenate 'string
-                  (append
-                   (mapcar #'ascii-digest
-                           (mapcar (lambda (p)
-                                     (funcall #'digest p 'nio))
-                                   paths-or-strings)))))
-    ((null paths-or-strings)
-     nil)))
-                                      
+  "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
+                     (typecase first
+                       (pathname (digest first))
+                       (string (digest first))
+                       (null)
+                       (list
+                        (concatenate 'string 
+                                     (sha256 (first first))
+                                     (sha256 (rest first)))))))
+                  (when rest
+                    (sha256 rest)))))
+                        
+#+nil ;; Bugs out the compiler 
+(defun sha256 (paths-or-strings)   
+  (labels ((walk (p-or-s)
+             ((atom p-or-s)
+              (typecase p-or-s 
+                (pathname
+                 (digest-path p-or-s))
+                (string 
+                 (error "Somebody implement me please"))))
+             ((cons p-or-s)
+              (walk (first p-or-s)
+                    (rest p-or-s)))))
+         (concatenate 'string
+                      (walk paths-or-strings))))
+
            
-(defgeneric digest (url algorithim  &optional (digest 'sha-256))
-  (:documentation "Digest byte based resource at URL with ALGORITHIM."))
-(defun digest-path (path) (ascii-digest (digest path 'nio 'sha-256)))
+(defgeneric digest (resource &key (digest 'sha-256))
+  (:documentation "Digest byte based resource at RESOURCE."))
+(defun digest-path (path) (asciify-digest (digest path 'nio 'sha-256)))
 
 (defvar *digest-types* 
@@ -75 +93 @@
   (java:jmethod "java.security.MessageDigest" "update" "[B" "int" "int"))
 
-(defmethod digest ((url t) (algorithim (eql 'nio)) &optional (digest 'sha-256))
+(defmethod digest ((url pathname) &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*)))
@@ -98 +119 @@
    (java:jcall "digest" digest)))
 
-;;(defmethod digest ((s string) (algorithim (eql 'nio)) &optional (digest 'sha-256))
-;;  (warn "Unimplemented."))
-;;  (let ((input-stream (
+(defmethod digest ((source string) &key (digest 'sha-256))
+  (declare (ignorable source digest))
+  (warn "Umimplemented.")
+  "deadbeef")
+          
+
+
+(export 'sha256 :system)