[bknr-cvs] r2178 - in branches/bos: bknr/src bknr/src/indices bknr/src/utils bknr/src/xml bknr/src/xml-impex projects/bos/worldpay-test thirdparty/ironclad
bknr at bknr.net
bknr at bknr.net
Wed Oct 3 01:20:42 UTC 2007
Author: hhubner
Date: 2007-10-02 21:20:42 -0400 (Tue, 02 Oct 2007)
New Revision: 2178
Added:
branches/bos/bknr/src/bknr-xml.asd
branches/bos/bknr/src/xml/
branches/bos/bknr/src/xml/package.lisp
branches/bos/bknr/src/xml/xml.lisp
Removed:
branches/bos/thirdparty/ironclad/digest.lisp.orig
branches/bos/thirdparty/ironclad/package.lisp.orig
Modified:
branches/bos/bknr/src/bknr-impex.asd
branches/bos/bknr/src/bknr-utils.asd
branches/bos/bknr/src/bknr.asd
branches/bos/bknr/src/indices/package.lisp
branches/bos/bknr/src/packages.lisp
branches/bos/bknr/src/utils/package.lisp
branches/bos/bknr/src/utils/utils.lisp
branches/bos/bknr/src/utils/xml.lisp
branches/bos/bknr/src/xml-impex/package.lisp
branches/bos/projects/bos/worldpay-test/utils.lisp
Log:
Patch from Kamen Tomov to isolate CXML from the datastore. In order to get
this compiled, I moved FIND-ALL from the BOS project to bknr/src/utils.
Modified: branches/bos/bknr/src/bknr-impex.asd
===================================================================
--- branches/bos/bknr/src/bknr-impex.asd 2007-10-02 10:54:15 UTC (rev 2177)
+++ branches/bos/bknr/src/bknr-impex.asd 2007-10-03 01:20:42 UTC (rev 2178)
@@ -21,7 +21,7 @@
:description "BKNR XML import/export"
:long-description ""
- :depends-on (:cl-interpol :cxml :bknr-utils :bknr-indices)
+ :depends-on (:cl-interpol :cxml :bknr-utils :bknr-xml :bknr-indices)
:components ((:module "xml-impex"
:components
Modified: branches/bos/bknr/src/bknr-utils.asd
===================================================================
--- branches/bos/bknr/src/bknr-utils.asd 2007-10-02 10:54:15 UTC (rev 2177)
+++ branches/bos/bknr/src/bknr-utils.asd 2007-10-03 01:20:42 UTC (rev 2178)
@@ -17,7 +17,6 @@
:description "baikonour - launchpad for lisp satellites"
:depends-on (:cl-interpol :cl-ppcre
- :cxml
:md5
#+(not allegro)
:acl-compat
@@ -37,7 +36,6 @@
(:file "base64" :depends-on ("utils"))
(:file "capability" :depends-on ("utils"))
(:file "make-fdf-file" :depends-on ("utils"))
- (:file "xml" :depends-on ("utils"))
(:file "date-calc")
(:file "acl-mp-compat" :depends-on ("package"))))))
Added: branches/bos/bknr/src/bknr-xml.asd
===================================================================
--- branches/bos/bknr/src/bknr-xml.asd 2007-10-02 10:54:15 UTC (rev 2177)
+++ branches/bos/bknr/src/bknr-xml.asd 2007-10-03 01:20:42 UTC (rev 2178)
@@ -0,0 +1,42 @@
+;; -*-Lisp-*-
+
+(in-package :cl-user)
+
+(defpackage :bknr.xml.system
+ (:use :cl :asdf))
+
+(in-package :bknr.xml.system)
+
+(defsystem :bknr-xml
+ :name "baikonour"
+ :author "Hans Huebner <hans at huebner.org>"
+ :author "Manuel Odendahl <manuel at bl0rg.net>"
+ :version "0"
+ :maintainer "Manuel Odendahl <manuel at bl0rg.net>"
+ :licence "BSD"
+ :description "baikonour - launchpad for lisp satellites"
+ :depends-on (:cl-interpol :cxml)
+ :components ((:module "xml" :components ((:file "package")
+ (:file "xml")))))
+
+;; -*-Lisp-*-
+
+(in-package :cl-user)
+
+(defpackage :bknr.xml.system
+ (:use :cl :asdf))
+
+(in-package :bknr.xml.system)
+
+(defsystem :bknr-xml
+ :name "baikonour"
+ :author "Hans Huebner <hans at huebner.org>"
+ :author "Manuel Odendahl <manuel at bl0rg.net>"
+ :version "0"
+ :maintainer "Manuel Odendahl <manuel at bl0rg.net>"
+ :licence "BSD"
+ :description "baikonour - launchpad for lisp satellites"
+ :depends-on (:cl-interpol :cxml)
+ :components ((:module "xml" :components ((:file "package")
+ (:file "xml")))))
+
Modified: branches/bos/bknr/src/bknr.asd
===================================================================
--- branches/bos/bknr/src/bknr.asd 2007-10-02 10:54:15 UTC (rev 2177)
+++ branches/bos/bknr/src/bknr.asd 2007-10-03 01:20:42 UTC (rev 2178)
@@ -28,6 +28,7 @@
:cxml
:unit-test
:bknr-utils
+ :bknr-xml
:puri
;:stem
;:mime
Modified: branches/bos/bknr/src/indices/package.lisp
===================================================================
--- branches/bos/bknr/src/indices/package.lisp 2007-10-02 10:54:15 UTC (rev 2177)
+++ branches/bos/bknr/src/indices/package.lisp 2007-10-03 01:20:42 UTC (rev 2178)
@@ -6,7 +6,6 @@
#+cmu :ext
#+sbcl :sb-ext
:cl-user
- :cxml
:bknr.utils
:bknr.skip-list
#+allegro :aclmop
Modified: branches/bos/bknr/src/packages.lisp
===================================================================
--- branches/bos/bknr/src/packages.lisp 2007-10-02 10:54:15 UTC (rev 2177)
+++ branches/bos/bknr/src/packages.lisp 2007-10-03 01:20:42 UTC (rev 2178)
@@ -26,7 +26,7 @@
#:start-cron))
(defpackage :bknr.rss
- (:use :cl :cl-user :cl-ppcre :bknr.utils :puri :cxml-xmls :bknr.datastore :bknr.indices :cxml)
+ (:use :cl :cl-user :cl-ppcre :bknr.utils :bknr.xml :puri :cxml-xmls :bknr.datastore :bknr.indices :cxml)
(:export #:xml-escape
#:*img-src-scanner*
#:*a-href-scanner*
@@ -192,6 +192,7 @@
:bknr.indices
:bknr.impex
:bknr.utils
+ :bknr.xml
:bknr.events
:bknr.user)
(:shadowing-import-from :cl-interpol #:quote-meta-chars)
Modified: branches/bos/bknr/src/utils/package.lisp
===================================================================
--- branches/bos/bknr/src/utils/package.lisp 2007-10-02 10:54:15 UTC (rev 2177)
+++ branches/bos/bknr/src/utils/package.lisp 2007-10-03 01:20:42 UTC (rev 2178)
@@ -4,7 +4,6 @@
(:use :cl
:cl-ppcre
:cl-interpol
- :cxml-xmls
:md5
#+cmu :extensions
; #+sbcl :sb-ext
@@ -122,15 +121,6 @@
#:string-beginning-with-p
#:string-delimited-by-p
- ;; xml
- #:node-children-nodes
- #:find-child
- #:find-children
- #:node-string-body
- #:node-attribute
- #:node-child-string-body
- #:node-to-html
-
;; crypt-md5
#:crypt-md5
#:verify-md5-password
@@ -150,4 +140,7 @@
#:mp-with-recursive-lock-held
;; class utils
- #:class-subclasses))
+ #:class-subclasses
+
+ ;; norvig
+ #:find-all))
Modified: branches/bos/bknr/src/utils/utils.lisp
===================================================================
--- branches/bos/bknr/src/utils/utils.lisp 2007-10-02 10:54:15 UTC (rev 2177)
+++ branches/bos/bknr/src/utils/utils.lisp 2007-10-03 01:20:42 UTC (rev 2178)
@@ -545,4 +545,15 @@
(format nil "~3,1F KB" (/ byte-count 1024)))
(t
(format nil "~A" byte-count))))
-
\ No newline at end of file
+
+;;; from norvig
+(defun find-all (item sequence &rest keyword-args
+ &key (test #'eql) test-not &allow-other-keys)
+ "Find all those elements of sequence that match item,
+ according to the keywords. Doesn't alter sequence."
+ (if test-not
+ (apply #'remove item sequence
+ :test-not (complement test-not) keyword-args)
+ (apply #'remove item sequence
+ :test (complement test) keyword-args)))
+
Modified: branches/bos/bknr/src/utils/xml.lisp
===================================================================
--- branches/bos/bknr/src/utils/xml.lisp 2007-10-02 10:54:15 UTC (rev 2177)
+++ branches/bos/bknr/src/utils/xml.lisp 2007-10-03 01:20:42 UTC (rev 2178)
@@ -1,63 +0,0 @@
-(in-package :bknr.utils)
-
-(defun node-children-nodes (xml)
- (remove-if-not #'consp (node-children xml)))
-
-(defun find-child (xml node-name)
- (let ((children (node-children-nodes xml)))
- (find node-name children :test #'string-equal :key #'node-name)))
-
-(defun find-children (xml node-name)
- (let ((children (node-children-nodes xml)))
- (find-all node-name children :test #'string-equal :key #'node-name)))
-
-(defun node-string-body (xml)
- (let ((children (remove-if #'consp (node-children xml))))
- (if (every #'stringp children)
- (apply #'concatenate 'string children)
- (error "Some children are not strings"))))
-
-(defun node-attribute (xml attribute-name)
- (cadr (assoc attribute-name (node-attrs xml) :test #'string-equal)))
-
-(defun node-child-string-body (xml node-name)
- (let ((child (find-child xml node-name)))
- (if (and child (consp child))
- (node-string-body child)
- nil)))
-
-(defun node-to-html (node &optional (stream *standard-output*))
- (when (stringp node)
- (write-string node)
- (return-from node-to-html))
- (write-char #\< stream)
- (when (node-ns node)
- (write-string (node-ns node) stream)
- (write-char #\: stream))
- (write-string (node-name node) stream)
- (loop for (key value) in (node-attrs node)
- do (write-char #\Space stream)
- (write-string key stream)
- (write-char #\= stream)
- (write-char #\" stream)
- (write-string value stream)
- (write-char #\" stream))
- (if (node-children node)
- (progn
- (write-char #\> stream)
- (write-char #\Newline stream)
- (dolist (child (node-children node))
- (node-to-html child stream))
- (write-char #\< stream)
- (write-char #\/ stream)
- (when (node-ns node)
- (write-string (node-ns node) stream)
- (write-char #\: stream))
- (write-string (node-name node) stream)
- (write-char #\> stream)
- (write-char #\Newline stream))
- (progn (write-char #\Space stream)
- (write-char #\/ stream)
- (write-char #\> stream)
- (write-char #\Newline stream))))
-
Added: branches/bos/bknr/src/xml/package.lisp
===================================================================
--- branches/bos/bknr/src/xml/package.lisp 2007-10-02 10:54:15 UTC (rev 2177)
+++ branches/bos/bknr/src/xml/package.lisp 2007-10-03 01:20:42 UTC (rev 2178)
@@ -0,0 +1,16 @@
+(in-package :cl-user)
+
+(defpackage :bknr.xml
+ (:use :cl
+ :cl-ppcre
+ :cl-interpol
+ :cxml-xmls)
+ (:shadowing-import-from :cl-interpol "QUOTE-META-CHARS")
+ (:export
+ #:node-children-nodes
+ #:find-child
+ #:find-children
+ #:node-string-body
+ #:node-attribute
+ #:node-child-string-body
+ #:node-to-html))
Added: branches/bos/bknr/src/xml/xml.lisp
===================================================================
--- branches/bos/bknr/src/xml/xml.lisp 2007-10-02 10:54:15 UTC (rev 2177)
+++ branches/bos/bknr/src/xml/xml.lisp 2007-10-03 01:20:42 UTC (rev 2178)
@@ -0,0 +1,126 @@
+(in-package :bknr.xml)
+
+(defun node-children-nodes (xml)
+ (remove-if-not #'consp (node-children xml)))
+
+(defun find-child (xml node-name)
+ (let ((children (node-children-nodes xml)))
+ (find node-name children :test #'string-equal :key #'node-name)))
+
+(defun find-children (xml node-name)
+ (let ((children (node-children-nodes xml)))
+ (find-all node-name children :test #'string-equal :key #'node-name)))
+
+(defun node-string-body (xml)
+ (let ((children (remove-if #'consp (node-children xml))))
+ (if (every #'stringp children)
+ (apply #'concatenate 'string children)
+ (error "Some children are not strings"))))
+
+(defun node-attribute (xml attribute-name)
+ (cadr (assoc attribute-name (node-attrs xml) :test #'string-equal)))
+
+(defun node-child-string-body (xml node-name)
+ (let ((child (find-child xml node-name)))
+ (if (and child (consp child))
+ (node-string-body child)
+ nil)))
+
+(defun node-to-html (node &optional (stream *standard-output*))
+ (when (stringp node)
+ (write-string node)
+ (return-from node-to-html))
+ (write-char #\< stream)
+ (when (node-ns node)
+ (write-string (node-ns node) stream)
+ (write-char #\: stream))
+ (write-string (node-name node) stream)
+ (loop for (key value) in (node-attrs node)
+ do (write-char #\Space stream)
+ (write-string key stream)
+ (write-char #\= stream)
+ (write-char #\" stream)
+ (write-string value stream)
+ (write-char #\" stream))
+ (if (node-children node)
+ (progn
+ (write-char #\> stream)
+ (write-char #\Newline stream)
+ (dolist (child (node-children node))
+ (node-to-html child stream))
+ (write-char #\< stream)
+ (write-char #\/ stream)
+ (when (node-ns node)
+ (write-string (node-ns node) stream)
+ (write-char #\: stream))
+ (write-string (node-name node) stream)
+ (write-char #\> stream)
+ (write-char #\Newline stream))
+ (progn (write-char #\Space stream)
+ (write-char #\/ stream)
+ (write-char #\> stream)
+ (write-char #\Newline stream))))
+
+(in-package :bknr.xml)
+
+(defun node-children-nodes (xml)
+ (remove-if-not #'consp (node-children xml)))
+
+(defun find-child (xml node-name)
+ (let ((children (node-children-nodes xml)))
+ (find node-name children :test #'string-equal :key #'node-name)))
+
+(defun find-children (xml node-name)
+ (let ((children (node-children-nodes xml)))
+ (find-all node-name children :test #'string-equal :key #'node-name)))
+
+(defun node-string-body (xml)
+ (let ((children (remove-if #'consp (node-children xml))))
+ (if (every #'stringp children)
+ (apply #'concatenate 'string children)
+ (error "Some children are not strings"))))
+
+(defun node-attribute (xml attribute-name)
+ (cadr (assoc attribute-name (node-attrs xml) :test #'string-equal)))
+
+(defun node-child-string-body (xml node-name)
+ (let ((child (find-child xml node-name)))
+ (if (and child (consp child))
+ (node-string-body child)
+ nil)))
+
+(defun node-to-html (node &optional (stream *standard-output*))
+ (when (stringp node)
+ (write-string node)
+ (return-from node-to-html))
+ (write-char #\< stream)
+ (when (node-ns node)
+ (write-string (node-ns node) stream)
+ (write-char #\: stream))
+ (write-string (node-name node) stream)
+ (loop for (key value) in (node-attrs node)
+ do (write-char #\Space stream)
+ (write-string key stream)
+ (write-char #\= stream)
+ (write-char #\" stream)
+ (write-string value stream)
+ (write-char #\" stream))
+ (if (node-children node)
+ (progn
+ (write-char #\> stream)
+ (write-char #\Newline stream)
+ (dolist (child (node-children node))
+ (node-to-html child stream))
+ (write-char #\< stream)
+ (write-char #\/ stream)
+ (when (node-ns node)
+ (write-string (node-ns node) stream)
+ (write-char #\: stream))
+ (write-string (node-name node) stream)
+ (write-char #\> stream)
+ (write-char #\Newline stream))
+ (progn (write-char #\Space stream)
+ (write-char #\/ stream)
+ (write-char #\> stream)
+ (write-char #\Newline stream))))
+
Modified: branches/bos/bknr/src/xml-impex/package.lisp
===================================================================
--- branches/bos/bknr/src/xml-impex/package.lisp 2007-10-02 10:54:15 UTC (rev 2177)
+++ branches/bos/bknr/src/xml-impex/package.lisp 2007-10-03 01:20:42 UTC (rev 2178)
@@ -13,6 +13,7 @@
#+sbcl
:sb-pcl
:bknr.utils
+ :bknr.xml
:bknr.indices)
(:export #:xml-class
Modified: branches/bos/projects/bos/worldpay-test/utils.lisp
===================================================================
--- branches/bos/projects/bos/worldpay-test/utils.lisp 2007-10-02 10:54:15 UTC (rev 2177)
+++ branches/bos/projects/bos/worldpay-test/utils.lisp 2007-10-03 01:20:42 UTC (rev 2178)
@@ -260,17 +260,6 @@
((funcall test i num)
(append l (nreverse smaller)))))
-;;; from norvig
-(defun find-all (item sequence &rest keyword-args
- &key (test #'eql) test-not &allow-other-keys)
- "Find all those elements of sequence that match item,
- according to the keywords. Doesn't alter sequence."
- (if test-not
- (apply #'remove item sequence
- :test-not (complement test-not) keyword-args)
- (apply #'remove item sequence
- :test (complement test) keyword-args)))
-
;;; hash table
(defun hash-to-list (hash &key (key #'cdr) (compare #'>) num)
(let ((results (sort (loop for key being the hash-key of hash using (hash-value val)
Deleted: branches/bos/thirdparty/ironclad/digest.lisp.orig
===================================================================
--- branches/bos/thirdparty/ironclad/digest.lisp.orig 2007-10-02 10:54:15 UTC (rev 2177)
+++ branches/bos/thirdparty/ironclad/digest.lisp.orig 2007-10-03 01:20:42 UTC (rev 2178)
@@ -1,196 +0,0 @@
-;;;; digest.lisp -- common functions for hashing
-
-(in-package :crypto)
-
-
-;;; defining digest (hash) functions
-
-;;; general inlinable functions for implementing the higher-level functions
-
-(declaim (inline digest-sequence-body digest-stream-body digest-file-body))
-
-(defun digest-sequence-body (sequence state-creation-fn
- state-update-fn
- state-finalize-fn
- &key (start 0) end)
- (declare (type (vector (unsigned-byte 8)) sequence) (type index start))
- (let ((state (funcall state-creation-fn)))
- #+cmu
- (lisp::with-array-data ((data sequence) (real-start start) (real-end end))
- (funcall state-update-fn state data
- :start real-start :end (or real-end (length sequence))))
- #+sbcl
- (sb-kernel:with-array-data ((data sequence) (real-start start) (real-end end))
- (funcall state-update-fn state data
- :start real-start :end (or real-end (length sequence))))
- #-(or cmu sbcl)
- (let ((real-end (or end (length sequence))))
- (declare (type index real-end))
- (funcall state-update-fn state sequence
- :start start :end (or real-end (length sequence))))
- (funcall state-finalize-fn state)))
-
-(eval-when (:compile-toplevel)
-(defconstant +buffer-size+ (* 128 1024))
-) ; EVAL-WHEN
-
-(deftype buffer-index () `(integer 0 (,+buffer-size+)))
-
-(defun digest-stream-body (stream state-creation-fn
- state-update-fn
- state-finalize-fn)
- (let ((state (funcall state-creation-fn)))
- (cond
- ((equal (stream-element-type stream) '(unsigned-byte 8))
- (let ((buffer (make-array +buffer-size+
- :element-type '(unsigned-byte 8))))
- (declare (type (simple-array (unsigned-byte 8) (#.+buffer-size+))
- buffer))
- (declare (dynamic-extent buffer))
- (loop for n-bytes of-type buffer-index = (read-sequence buffer stream)
- do (funcall state-update-fn state buffer :end n-bytes)
- until (< n-bytes +buffer-size+)
- finally (return (funcall state-finalize-fn state)))))
- (t
- (error "Unsupported stream element-type ~S for stream ~S."
- (stream-element-type stream) stream)))))
-
-(defun digest-file-body (pathname state-creation-fn
- state-update-fn
- state-finalize-fn)
- (with-open-file (stream pathname :element-type '(unsigned-byte 8)
- :direction :input
- :if-does-not-exist :error)
- (digest-stream-body stream state-creation-fn state-update-fn
- state-finalize-fn)))
-
-
-;;; high-level generic function drivers
-
-;;; These three functions are intended to be one-shot ways to digest
-;;; an object of some kind. You could write these in terms of the more
-;;; familiar digest interface below, but these are likely to be slightly
-;;; more efficient, as well as more obvious about what you're trying to
-;;; do.
-(defgeneric digest-file (digest-name pathname)
- (:documentation "Return the digest of PATHNAME using the algorithm DIGEST-NAME."))
-
-(defgeneric digest-stream (digest-name stream)
- (:documentation "Return the digest of STREAM using the algorithm DIGEST-NAME.
-STREAM-ELEMENT-TYPE of STREAM should be (UNSIGNED-BYTE 8)."))
-
-(defgeneric digest-sequence (digest-name sequence &key start end)
- (:documentation "Return the digest of the subsequence of SEQUENCE
-specified by START and END using the algorithm DIGEST-NAME. For CMUCL
-and SBCL, SEQUENCE can be any vector with an element-type of
-(UNSIGNED-BYTE 8); for other implementations, SEQUENCE must be a
-SIMPLE-ARRAY."))
-
-;;; These four functions represent the common interface for digests in
-;;; other crypto toolkits (OpenSSL, Botan, Python, etc.). You obtain
-;;; some state object for a particular digest, you update it with some
-;;; data, and then you get the actual digest. Flexibility is the name
-;;; of the game with these functions.
-(defgeneric make-digest (digest-name)
- (:documentation "Return a digest object which uses the algorithm DIGEST-NAME."))
-
-(defgeneric copy-digest (digest)
- (:documentation "Return a copy of DIGEST. The copy is a deep copy, not a
-shallow copy as might be returned by COPY-STRUCTURE."))
-
-(defgeneric update-digest (digest sequence &key start end)
- (:documentation "Update the internal state of DIGEST with the subsequence
-of SEQUENCE specified by START and END. For CMUCL and SBCL, SEQUENCE
-can be any vector with an element-type of (UNSIGNED-BYTE 8); for other
-implementations, SEQUENCE must be a SIMPLE-ARRAY."))
-
-(defgeneric produce-digest (digest)
- (:documentation "Return the hash of the data processed by DIGEST so far.
-This function does not modify the internal state of DIGEST."))
-
-
-;;; the digest-defining macro
-
-(defvar *supported-digests* nil)
-
-(defun list-all-digests ()
- (copy-seq *supported-digests*))
-
-(defun digest-supported-p (name)
- "Return T if the digest NAME is a valid digest name."
- (member name *supported-digests*))
-
-(defgeneric digest-length (digest)
- (:documentation "Return the number of bytes in a digest generated by DIGEST."))
-
-(defmacro defdigest (name &rest initargs)
- (%defdigest name initargs))
-
-(defun %defdigest (name initargs)
- (let ((creation-function nil)
- (copy-function nil)
- (update-function nil)
- (finalize-function nil)
- (state-type nil)
- (digest-length nil)
- (digest-name (intern (string name) (find-package :keyword))))
- (loop for (arg value) in initargs
- do
- (case arg
- (:creation-function
- (if (not creation-function)
- (setf creation-function value)
- (error "Specified :CREATION-FUNCTION multiple times.")))
- (:copy-function
- (if (not copy-function)
- (setf copy-function value)
- (error "Specified :COPY-FUNCTION multiple times.")))
- (:update-function
- (if (not update-function)
- (setf update-function value)
- (error "Specified :UPDATE-FUNCTION multiple times.")))
- (:finalize-function
- (if (not finalize-function)
- (setf finalize-function value)
- (error "Specified :FINALIZE-FUNCTION multiple times.")))
- (:state-type
- (if (not state-type)
- (setf state-type value)
- (error "Specified :STATE-TYPE multiple times.")))
- (:digest-length
- (if (not digest-length)
- (setf digest-length value)
- (error "Specified :DIGEST-LENGTH multiple times."))))
- finally (if (and creation-function copy-function update-function
- finalize-function state-type digest-length)
- (return (generate-digest-forms digest-name state-type
- digest-length
- creation-function
- copy-function update-function
- finalize-function))
- (error "Didn't specify all required options for DEFDIGEST")))))
-
-(defun generate-digest-forms (digest-name state-type digest-length
- creation-function copy-function
- update-function finalize-function)
- `(progn
- (push ,digest-name *supported-digests*)
- (defmethod digest-length ((digest (eql ,digest-name)))
- ,digest-length)
- (defmethod digest-length ((digest ,state-type))
- ,digest-length)
- (defmethod make-digest ((digest-name (eql ,digest-name)))
- (,creation-function))
- (defmethod copy-digest ((digest ,state-type))
- (,copy-function digest))
- (defmethod update-digest ((digest ,state-type) sequence &key (start 0) end)
- (,update-function digest sequence
- :start start :end (or end (length sequence))))
- (defmethod produce-digest ((digest ,state-type))
- (,finalize-function (,copy-function digest)))
- (defmethod digest-file ((digest-name (eql ,digest-name)) pathname)
- (digest-file-body pathname #',creation-function #',update-function #',finalize-function))
- (defmethod digest-stream ((digest-name (eql ,digest-name)) stream)
- (digest-stream-body stream #',creation-function #',update-function #',finalize-function))
- (defmethod digest-sequence ((digest-name (eql ,digest-name)) sequence &key (start 0) end)
- (digest-sequence-body sequence #',creation-function #',update-function #',finalize-function :start start :end end))))
Deleted: branches/bos/thirdparty/ironclad/package.lisp.orig
===================================================================
--- branches/bos/thirdparty/ironclad/package.lisp.orig 2007-10-02 10:54:15 UTC (rev 2177)
+++ branches/bos/thirdparty/ironclad/package.lisp.orig 2007-10-03 01:20:42 UTC (rev 2178)
@@ -1,28 +0,0 @@
-(defpackage :ironclad
- (:use :cl)
- (:nicknames :crypto)
- (:export
- ;; hash functions
- #:digest-sequence #:digest-stream #:digest-file
- #:make-digest #:copy-digest #:update-digest #:produce-digest
-
- ;; HMACs
- #:make-hmac #:update-hmac #:hmac-digest
-
- ;; introspection
- #:cipher-supported-p #:list-all-ciphers
- #:digest-supported-p #:list-all-digests
- #:mode-supported-p #:list-all-modes
- #:block-length #:digest-length
-
- ;; high-level operators
- #:make-cipher #:encrypt #:decrypt
-
- ;; classes
- #:aes-context #:square-context #:blowfish-context #:idea-context
- #:twofish-context
- #:des-context #:cast5-context #:tea-context #:xtea-context
-
- ;; conditions
- #:ironclad-error #:initialization-vector-not-supplied
- #:invalid-initialization-vector #:invalid-key-length))
\ No newline at end of file
More information about the Bknr-cvs
mailing list