Changeset 14200 for trunk/abcl/src/org/armedbear/lisp/digest.lisp
- Timestamp:
- 10/15/12 08:45:04 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/digest.lisp
r14199 r14200 1 ;;; require.lisp1 ;;; digest.lisp 2 2 ;;; 3 3 ;;; Copyright (C) 2012 Mark Evenson … … 33 33 (in-package :system) 34 34 35 (defun ascii -digest (digest)35 (defun asciify-digest (digest) 36 36 (format nil "~{~X~}" 37 37 (mapcar (lambda (b) (if (< b 0) (+ 256 b) b)) 38 38 (java::list-from-jarray digest)))) 39 (export 'sha256 :system) 39 40 41 ;;;; Really needs to concatenate all input into a single source of 42 ;;;; bytes, running digest over that concatentation 40 43 (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 44 "Returned ASCIIfied representation of SHA256 digest of byte-based resource at PATHS-OR-STRINGs." 45 (let ((first (first paths-or-strings)) 46 (rest (rest paths-or-strings))) 47 (concatenate 'string 48 (when first 49 (asciify-digest 50 (typecase first 51 (pathname (digest first)) 52 (string (digest first)) 53 (null) 54 (list 55 (concatenate 'string 56 (sha256 (first first)) 57 (sha256 (rest first))))))) 58 (when rest 59 (sha256 rest))))) 60 61 #+nil ;; Bugs out the compiler 62 (defun sha256 (paths-or-strings) 63 (labels ((walk (p-or-s) 64 ((atom p-or-s) 65 (typecase p-or-s 66 (pathname 67 (digest-path p-or-s)) 68 (string 69 (error "Somebody implement me please")))) 70 ((cons p-or-s) 71 (walk (first p-or-s) 72 (rest p-or-s))))) 73 (concatenate 'string 74 (walk paths-or-strings)))) 75 58 76 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)))77 (defgeneric digest (resource &key (digest 'sha-256)) 78 (:documentation "Digest byte based resource at RESOURCE.")) 79 (defun digest-path (path) (asciify-digest (digest path 'nio 'sha-256))) 62 80 63 81 (defvar *digest-types* … … 75 93 (java:jmethod "java.security.MessageDigest" "update" "[B" "int" "int")) 76 94 77 (defmethod digest ((url t) (algorithim (eql 'nio)) &optional(digest 'sha-256))95 (defmethod digest ((url pathname) &key (digest 'sha-256)) 78 96 "Calculate digest with default of :SHA-256 pathname specified by URL. 79 97 Returns an array of JVM primitive signed 8-bit bytes. 80 98 99 Uses \"New I/O\" in JVM \"worse named API of all time\". 100 81 101 *DIGEST-TYPES* controls the allowable digest types." 102 (format *debug-io* "~&pathname: ~S" url) 82 103 83 104 (let* ((digest-type (cdr (assoc digest *digest-types*))) … … 98 119 (java:jcall "digest" digest))) 99 120 100 ;;(defmethod digest ((s string) (algorithim (eql 'nio)) &optional (digest 'sha-256)) 101 ;; (warn "Unimplemented.")) 102 ;; (let ((input-stream ( 121 (defmethod digest ((source string) &key (digest 'sha-256)) 122 (declare (ignorable source digest)) 123 (warn "Umimplemented.") 124 "deadbeef") 125 126 127 128 (export 'sha256 :system)
Note: See TracChangeset
for help on using the changeset viewer.