proposed asdf-install patch
Robert Goldman <[email protected]> Wed, 27 Feb 2008 13:50:06 -0600
| Newsgroups | gmane.lisp.cclan.general |
|---|---|
| Message-ID | <[email protected]> |
There was some discussion of asdf-install on #lisp today, when Athas found that cl-yacc installation crashed asdf-install (the sbcl fork) and I found the same thing (portable fork). For some reason the web server at which cl-yacc is stored, serves up the gpg signature badly, although without setting a condition. This revealed the fact that asdf-install will raise cryptic make-string errors when there is either no content-length header, or there is a bad content-length header. I made the attached patch so that it's more obvious to the user when this happens. Best, r ------------------------------------------------------------------------- This SF.net email is sponsored by: Microsoft Defy all challenges. Microsoft(R) Visual Studio 2008. http://clk.atdmt.com/MRT/go/vse0120000070mrt/direct/01/ _______________________________________________ cclan-list mailing list [email protected] https://lists.sourceforge.net/lists/listinfo/cclan-list
content-length-header-patch
(text/plain, 2.6 KB)
Index: installer.lisp
===================================================================
RCS file: /cvsroot/cclan/asdf-install/installer.lisp,v
retrieving revision 1.15
diff -b -u -F^(def -r1.15 installer.lisp
--- installer.lisp 20 Mar 2006 16:46:21 -0000 1.15
+++ installer.lisp 27 Feb 2008 19:49:26 -0000
@@ -176,13 +176,29 @@ (defun add-locations (loc-name site syst
;;;---------------------------------------------------------------------------
;;; Conditions.
-(define-condition download-error (error)
- ((url :initarg :url :reader download-url)
- (response :initarg :response :reader download-response))
+(define-condition http-transfer-error (error)
+ ((url :initarg :url :reader download-url)))
+
+(define-condition download-error (http-transfer-error)
+ ((response :initarg :response :reader download-response))
(:report (lambda (c s)
(format s "Server responded ~A for GET ~A"
(download-response c) (download-url c)))))
+(define-condition content-length-missing (http-transfer-error)
+ ()
+ (:report (lambda (c s)
+ (format s "No content-length header, expected in transfer from ~A"
+ (download-url c)))))
+
+(define-condition content-length-parse-error (http-transfer-error)
+ ((header-text :initarg :header-text :reader header-text))
+ (:report (lambda (c s)
+ (format s "Unable to parse content-length header in transfer from ~A: header-text: ~A"
+ (download-url c) (header-text c)))))
+
+
+
(define-condition signature-error (error)
((cause :initarg :cause :reader signature-error-cause))
(:report (lambda (c s)
@@ -472,11 +488,16 @@ (defun verify-gpg-signature/url (url fil
:response 200))
(setf (char data i) (code-char byte)))))))
(if (= response 200)
- (let ((data (make-string (parse-integer
- (cdr (assoc :CONTENT-LENGTH headers))
- :junk-allowed t))))
+ (flet ((content-length ()
+ (let ((cell (assoc :CONTENT-LENGTH headers)))
+ (unless cell
+ (error 'content-length-missing :url (concatenate 'string url ".asc"))
+ (or (parse-integer (cdr cell) :junk-allowed t)
+ (error 'content-length-parse-error :url (concatenate 'string url ".asc")
+ :header-text (cdr cell)))))))
+ (let ((data (make-string (content-length))))
(read-signature data stream)
- (verify-gpg-signature/string data file-name))
+ (verify-gpg-signature/string data file-name)))
(error 'download-error :url (concatenate 'string url ".asc")
:response response)))
(close stream)))))