Operations on Objects
@@ -377,7 +378,50 @@ Contents
- Operations on Buckets
+Backoff
+
+
+ The response to some requests — a very small proportion
+ — will be an error internal to the AWS server. In these
+ circumstances an exponential backoff
+ policy is recommended.
+
+
+
+
+
+ *backoff*
+
+
+
+
+ Used as the default value of :backoff
when
+ submitting a request. The value should be a cons of two
+ numbers: how many times to try before giving up, and how long
+ to wait (in ms) before trying for the second time. Each
+ subsequent attempt will double that time.
+
+
+
+ The default value is (3 . 100)
.
+
+
+
+ If a requst fails more times than permitted by
+ *backoff*
, an error will be signalled:
+
+
+ (ERROR #<ZS3::INTERNAL-ERROR @ #x10008f1a8b2>)
+
+
+ It is the application's responsibility to handle this.
+
+
+
+
+
+
+Operations on Buckets
With ZS3, you can put, get, copy, and delete buckets. You can also
get information about the bucket.
@@ -387,7 +431,7 @@
Contents
all-buckets
- &key
credentials
+ &key
credentials backoff
=> bucket-vector
@@ -442,6 +486,7 @@ Contents
&key
prefix
credentials
+ backoff
=> key-vector
@@ -474,6 +519,7 @@ Contents
bucket
&key
credentials
+ backoff
=> boolean
@@ -495,6 +541,7 @@ Contents
public
location
credentials
+ backoff
=> |
@@ -547,7 +594,9 @@ Contents
delete-bucket
- bucket &key
credentials
+ bucket &key
+ credentials
+ backoff
=> |
@@ -566,7 +615,9 @@ Contents
bucket-location
- bucket &key
credentials
+ bucket &key
+ credentials
+ backoff
=> location
@@ -684,6 +735,7 @@ Contents
&body
days
credentials
+ backoff
=> |
@@ -719,6 +771,7 @@ Contents
key
&key
credentials
+ backoff
=> status-string
@@ -753,6 +806,7 @@ Contents
max-keys
delimiter
credentials
+ backoff
=> response
@@ -1094,6 +1148,7 @@ Contents
when-etag-matches unless-etag-matches
if-exists string-external-format
credentials
+ backoff
=> object
@@ -1164,6 +1219,7 @@ Contents
when-modified-since unless-modified-since
when-etag-matches unless-etag-matches
credentials
+ backoff
=> vector
@@ -1192,6 +1248,7 @@ Contents
when-etag-matches
unless-etag-matches
credentials
+ backoff
=> string
@@ -1221,6 +1278,7 @@ Contents
when-etag-matches
unless-etag-matches
credentials
+ backoff
=> pathname
@@ -1256,6 +1314,7 @@ Contents
expires
storage-class
credentials
+ backoff
=> |
@@ -1337,6 +1396,7 @@ Contents
expires
storage-class
credentials
+ backoff
=> |
@@ -1373,6 +1433,7 @@ Contents
expires
storage-class
credentials
+ backoff
=> |
@@ -1406,6 +1467,7 @@ Contents
expires
storage-class
credentials
+ backoff
=> |
@@ -1447,6 +1509,7 @@ Contents
expires
storage-class
credentials
+ backoff
=> |
@@ -1495,6 +1558,7 @@ Contents
metadata public precondition-errors
storage-class
credentials
+ backoff
=> |
@@ -1544,6 +1608,7 @@ Contents
key
&key
credentials
+ backoff
=> |
@@ -1567,6 +1632,7 @@ Contents
keys
&key
credentials
+ backoff
=> deleted-count, errors
@@ -1588,6 +1654,7 @@ Contents
bucket
&key
credentials
+ backoff
=> count
@@ -1608,6 +1675,7 @@ Contents
key
&key
credentials
+ backoff
=> metadata-alist
@@ -1637,6 +1705,7 @@ Contents
storage-class
&key
credentials
+ backoff
=> |
@@ -1684,6 +1753,7 @@ Contents
bucket
key
credentials
+ backoff
=> owner, grants
@@ -1705,6 +1775,7 @@ Contents
bucket
key
credentials
+ backoff
=> |
@@ -1856,6 +1927,7 @@ Contents
&key
credentials
+ backoff
=> acl-person
@@ -1879,6 +1951,7 @@ Contents
bucket
key
credentials
+ backoff
=> |
@@ -1899,6 +1972,7 @@ Contents
bucket
key
credentials
+ backoff
=> |
@@ -1931,6 +2005,7 @@ Contents
bucket
&key
credentials
+ backoff
=> |
@@ -1950,6 +2025,7 @@ Contents
bucket
&key
credentials
+ backoff
=> |
@@ -1973,6 +2049,7 @@ Contents
&key
target-grants
credentials
+ backoff
=> |
@@ -1999,7 +2076,9 @@ Contents
disable-logging
- bucket &key
credentials
+ bucket &key
+ credentials
+ backoff
=> |
@@ -2018,6 +2097,7 @@ Contents
bucket
&key
credentials
+ backoff
=> target-bucket,
target-prefix,
@@ -2150,6 +2230,7 @@ Contents
key
parameters
credentials
+ backoff
=> headers-alist,
status-code,
diff --git a/errors.lisp b/errors.lisp
index ba93808..5abfc1a 100644
--- a/errors.lisp
+++ b/errors.lisp
@@ -58,6 +58,11 @@
(setf (message response) (bvalue :message bindings))
(setf (error-data response) (bvalue :data bindings))))
+(defmethod specialized-initialize ((response amazon-error) (source null))
+ (setf (code response) "InternalError"
+ (message response) nil
+ (error-data response) nil))
+
(defmethod print-object ((response amazon-error) stream)
(print-unreadable-object (response stream :type t)
(prin1 (code response) stream)))
@@ -65,7 +70,7 @@
;;; Further specializing error messages/conditions
(defun report-request-error (condition stream)
- (format stream "~A: ~A"
+ (format stream "~A~@[: ~A~]"
(code (request-error-response condition))
(message (request-error-response condition))))
@@ -134,7 +139,7 @@
:response response
:data (error-data response)
,@(mapcan #'slot-initializer slots))))))
-
+
;;; The specific errors
@@ -186,7 +191,7 @@
(report-request-error condition stream)
(format stream "~&For more information, see:~% ~A"
(linked-url condition)))))
-
+
(define-condition bucket-restrictions (linked)
()
diff --git a/interface.lisp b/interface.lisp
index 2660dba..8c55433 100644
--- a/interface.lisp
+++ b/interface.lisp
@@ -53,11 +53,12 @@
(canned-access-policy access-policy))))
(defun head (&key bucket key parameters
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
"Return three values: the HTTP status, an alist of Drakma-style HTTP
headers, and the HTTP phrase, with the results of a HEAD request for
the object specified by the optional BUCKET and KEY arguments."
- (let* ((security-token (security-token *credentials*))
+ (let* ((security-token (security-token *credentials*))
(response
(submit-request (make-instance 'request
:method :head
@@ -74,14 +75,16 @@ the object specified by the optional BUCKET and KEY arguments."
;;; Operations on buckets
-(defun all-buckets (&key ((:credentials *credentials*) *credentials*))
+(defun all-buckets (&key ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
"Return a vector of all BUCKET objects associated with *CREDENTIALS*."
(let ((response (submit-request (make-instance 'request
:method :get))))
(buckets response)))
(defun bucket-location (bucket &key
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
"If BUCKET was created with a LocationConstraint, return its
constraint."
(let* ((request (make-instance 'request
@@ -94,7 +97,8 @@ constraint."
location)))
(defun bucket-region (bucket
- &key ((:credentials *credentials*) *credentials*))
+ &key ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(or (bucket-location bucket)
"us-east-1"))
@@ -104,7 +108,8 @@ constraint."
(format nil "s3-~A.amazonaws.com" region)))
(defun query-bucket (bucket &key prefix marker max-keys delimiter
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(submit-request (make-instance 'request
:method :get
:bucket bucket
@@ -122,7 +127,8 @@ constraint."
(submit-request request)))))
(defun all-keys (bucket &key prefix
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
"Reutrn a vector of all KEY objects in BUCKET."
(let ((response (query-bucket bucket :prefix prefix))
(results '()))
@@ -138,7 +144,8 @@ constraint."
(incf start (length keys))))))
(defun bucket-exists-p (bucket &key
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(let ((code (nth-value 1 (head :bucket bucket
:parameters
(parameters-alist :max-keys 0)))))
@@ -148,7 +155,8 @@ constraint."
access-policy
public
location
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(let ((policy-header (access-policy-header access-policy public)))
(submit-request (make-instance 'request
:method :put
@@ -159,7 +167,8 @@ constraint."
:amz-headers policy-header))))
(defun delete-bucket (bucket &key
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(let* ((request (make-instance 'request
:method :delete
:bucket bucket))
@@ -223,7 +232,8 @@ constraint."
(output :vector)
(if-exists :supersede)
(string-external-format :utf-8)
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(flet ((range-argument (start end)
(when start
(format nil "bytes=~D-~@[~D~]" start (and end (1- end)))))
@@ -286,7 +296,8 @@ constraint."
when-modified-since unless-modified-since
when-etag-matches unless-etag-matches
(if-exists :supersede)
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(get-object bucket key
:output :vector
:start start
@@ -303,7 +314,8 @@ constraint."
when-modified-since unless-modified-since
when-etag-matches unless-etag-matches
(if-exists :supersede)
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(get-object bucket key
:output :string
:string-external-format external-format
@@ -320,7 +332,8 @@ constraint."
when-modified-since unless-modified-since
when-etag-matches unless-etag-matches
(if-exists :supersede)
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(get-object bucket key
:output (pathname file)
:start start
@@ -346,7 +359,8 @@ constraint."
expires
content-type
(storage-class "STANDARD")
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(let ((content
(etypecase object
(string
@@ -390,7 +404,8 @@ constraint."
(content-type "binary/octet-stream")
expires
storage-class
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(when (or start end)
(setf vector (subseq vector (or start 0) end)))
(put-object vector bucket key
@@ -416,7 +431,8 @@ constraint."
(content-type "text/plain")
expires
storage-class
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(when (or start end)
(setf string (subseq string (or start 0) end)))
(put-object string bucket key
@@ -443,7 +459,8 @@ constraint."
(content-type "binary/octet-stream")
expires
storage-class
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(when (eq key t)
(setf key (file-namestring file)))
(let ((content (pathname file)))
@@ -472,7 +489,8 @@ constraint."
(content-type "binary/octet-stream")
expires
storage-class
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(let ((content (stream-subset-vector stream start end)))
(put-object content bucket key
:access-policy access-policy
@@ -489,7 +507,8 @@ constraint."
;;; Delete & copy objects
(defun delete-object (bucket key &key
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
"Delete one object from BUCKET identified by KEY."
(let ((security-token (security-token *credentials*)))
(submit-request (make-instance 'request
@@ -523,8 +542,10 @@ constraint."
("Code" (bind :error-code))
("Message" (bind :error-message)))))))
-(defun delete-objects (bucket keys &key
- ((:credentials *credentials*) *credentials*))
+(defun delete-objects (bucket keys
+ &key
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
"Delete the objects in BUCKET identified by the sequence KEYS."
(let ((deleted 0)
(failed '())
@@ -560,7 +581,8 @@ constraint."
(values deleted failed))))
(defun delete-all-objects (bucket &key
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
"Delete all objects in BUCKET."
;; FIXME: This should probably bucket-query and incrementally delete
;; instead of fetching all keys upfront.
@@ -578,7 +600,8 @@ constraint."
public
precondition-errors
(storage-class "STANDARD")
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
"Copy the object identified by FROM-BUCKET/FROM-KEY to
TO-BUCKET/TO-KEY.
@@ -635,8 +658,10 @@ users. Otherwise, a default ACL is present on the new object.
(nconc headers policy-header))))))
-(defun object-metadata (bucket key &key
- ((:credentials *credentials*) *credentials*))
+(defun object-metadata (bucket key
+ &key
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
"Return the metadata headers as an alist, with keywords for the keys."
(let* ((prefix "X-AMZ-META-")
(plen (length prefix)))
@@ -654,8 +679,10 @@ users. Otherwise, a default ACL is present on the new object.
;;; Convenience bit for storage class
-(defun set-storage-class (bucket key storage-class &key
- ((:credentials *credentials*) *credentials*))
+(defun set-storage-class (bucket key storage-class
+ &key
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
"Set the storage class of the object identified by BUCKET and KEY to
STORAGE-CLASS."
(copy-object :from-bucket bucket :from-key key
@@ -672,7 +699,8 @@ STORAGE-CLASS."
read access for all users.")
(defun get-acl (&key bucket key
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(let* ((request (make-instance 'request
:method :get
:bucket bucket
@@ -684,7 +712,8 @@ STORAGE-CLASS."
(grants acl))))
(defun put-acl (owner grants &key bucket key
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(let* ((acl (make-instance 'access-control-list
:owner owner
:grants grants))
@@ -698,7 +727,8 @@ STORAGE-CLASS."
(defun make-public (&key bucket key
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(multiple-value-bind (owner grants)
(get-acl :bucket bucket :key key)
(put-acl owner
@@ -707,7 +737,8 @@ STORAGE-CLASS."
:key key)))
(defun make-private (&key bucket key
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(multiple-value-bind (owner grants)
(get-acl :bucket bucket :key key)
(setf grants
@@ -729,7 +760,8 @@ STORAGE-CLASS."
to write logfile objects into a particular bucket.")
(defun enable-logging-to (bucket &key
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
"Configure the ACL of BUCKET to accept logfile objects."
(multiple-value-bind (owner grants)
(get-acl :bucket bucket)
@@ -737,7 +769,8 @@ to write logfile objects into a particular bucket.")
(put-acl owner grants :bucket bucket)))
(defun disable-logging-to (bucket &key
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
"Configure the ACL of BUCKET to remove permissions for the log
delivery group."
(multiple-value-bind (owner grants)
@@ -747,9 +780,11 @@ delivery group."
grants))
(put-acl owner grants :bucket bucket)))
-(defun enable-logging (bucket target-bucket target-prefix &key
+(defun enable-logging (bucket target-bucket target-prefix
+ &key
target-grants
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
"Enable logging of requests to BUCKET, putting logfile objects into
TARGET-BUCKET with a key prefix of TARGET-PREFIX."
(let* ((setup (make-instance 'logging-setup
@@ -779,7 +814,8 @@ TARGET-BUCKET with a key prefix of TARGET-PREFIX."
bucket effectively disables logging.")
(defun disable-logging (bucket &key
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
"Disable the creation of access logs for BUCKET."
(submit-request (make-instance 'request
:method :put
@@ -788,7 +824,8 @@ TARGET-BUCKET with a key prefix of TARGET-PREFIX."
:content *empty-logging-setup*)))
(defun logging-setup (bucket &key
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(let ((setup (setup
(submit-request (make-instance 'request
:bucket bucket
@@ -892,7 +929,8 @@ TARGET-BUCKET with a key prefix of TARGET-PREFIX."
key strings.")
(defun me (&key
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
"Return a PERSON object corresponding to the current credentials. Cached."
(or (gethash (access-key *credentials*) *me-cache*)
(setf
@@ -901,7 +939,7 @@ TARGET-BUCKET with a key prefix of TARGET-PREFIX."
(owner response)))))
(defun make-post-policy (&key expires conditions
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*))
"Return an encoded HTTP POST policy string and policy signature as
multiple values."
(unless expires
diff --git a/lifecycle.lisp b/lifecycle.lisp
index b4a49d8..8abb7ad 100644
--- a/lifecycle.lisp
+++ b/lifecycle.lisp
@@ -184,7 +184,8 @@ by xml-binding the LIFECYCLE-CONFIGURATION binder with a document."
() ())
(defun bucket-lifecycle (bucket
- &key ((:credentials *credentials*) *credentials*))
+ &key ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
"Return the bucket lifecycle rules for BUCKET. Signals
NO-SUCH-LIFECYCLE-CONFIGURATION if the bucket has no lifecycle
configuration."
@@ -198,7 +199,8 @@ configuration."
(defun delete-bucket-lifecycle (bucket
&key
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
"Delete the lifecycle configuration of BUCKET."
(submit-request (make-instance 'request
:method :delete
@@ -207,7 +209,8 @@ configuration."
(defun (setf bucket-lifecycle) (rules bucket
&key
- ((:credentials *credentials*) *credentials*))
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
"Set the lifecycle configuration of BUCKET to RULES. RULES is
coerced to a list if needed. If RULES is NIL, the lifecycle
configuration is deleted with DELETE-BUCKET-LIFECYCLE."
@@ -233,9 +236,11 @@ configuration is deleted with DELETE-BUCKET-LIFECYCLE."
(with-element "Days"
(text (princ-to-string days))))))
-(defun restore-object (bucket key &key
- days
- ((:credentials *credentials*) *credentials*))
+(defun restore-object (bucket key
+ &key
+ days
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(let* ((content (restore-request-document days))
(md5 (vector-md5/b64 content)))
(submit-request (make-instance 'request
@@ -246,8 +251,10 @@ configuration is deleted with DELETE-BUCKET-LIFECYCLE."
:key key
:content content))))
-(defun object-restoration-status (bucket key &key
- ((:credentials *credentials*) *credentials*))
+(defun object-restoration-status (bucket key
+ &key
+ ((:credentials *credentials*) *credentials*)
+ ((:backoff *backoff*) *backoff*))
(let ((headers (head :bucket bucket :key key)))
(cdr (assoc :x-amz-restore headers))))
diff --git a/package.lisp b/package.lisp
index 4252048..444b701 100644
--- a/package.lisp
+++ b/package.lisp
@@ -35,6 +35,8 @@
#:access-key
#:secret-key
#:file-credentials)
+ ;; Backoff
+ (:export #:*backoff*)
;; Buckets
(:export #:all-buckets
#:creation-date
diff --git a/response.lisp b/response.lisp
index 5821fc6..ec84b98 100644
--- a/response.lisp
+++ b/response.lisp
@@ -85,6 +85,9 @@
(cond ((or (null (body response))
(and (not (streamp (body response)))
(zerop (length (body response)))))
+ (when (<= 500 (http-code response) 599)
+ (change-class response 'amazon-error)
+ (specialized-initialize response nil))
response)
(t
(let* ((source (xml-source (body response)))
@@ -133,6 +136,12 @@
(setq *keep-alive-stream* nil)
(funcall handler response))))))
+(defvar *backoff* (cons 3 100)
+ "Used as the default value of :BACKOFF when submitting a request.
+ The value should be a cons of two numbers: how many times to try
+ before giving up, and how long to wait (in ms) before trying for
+ the second time. Each subsequent attempt will double that time.")
+
(defun submit-request (request
&key body-stream
(keep-stream *use-keep-alive*)
@@ -140,7 +149,10 @@
;; The original endpoint has to be stashed so it can be updated as
;; needed by AuthorizationHeaderMalformed responses after being
;; clobbered in the request by TemporaryRedirect responses.
- (let ((original-endpoint (endpoint request)))
+ (let* ((original-endpoint (endpoint request))
+ (backoff *backoff*)
+ (tries (car backoff))
+ (delay (/ (cdr backoff) 1000)))
(loop
(handler-case
(let ((response (request-response request
@@ -170,9 +182,15 @@
(setf (endpoint request) new-endpoint)
(when new-region
(setf (region request) new-region))))
- (internal-error ()
- ;; Per the S3 docs, InternalErrors should simply be retried
- (close-keep-alive))
+ (internal-error (e)
+ ;; Per the S3 docs, InternalErrors should be retried. Up to
+ ;; a point.
+ (close-keep-alive)
+ (when (minusp (decf tries))
+ ;; We've exceeded our failure allowance. Resignal.
+ (error e))
+ (sleep delay)
+ (incf delay delay))
(error (e)
;; Ensure that we don't reuse the stream, it may be the source of
;; our error. Then resignal.