From 1f7be74ab9c2117e236b9ff359764393271f98ac Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sun, 9 Oct 2005 20:34:25 +0000 Subject: [PATCH] 0.9.5.32: Merge patch for asdf-install from Alexander Kjeldaas. --- NEWS | 2 ++ contrib/asdf-install/installer.lisp | 51 ++++++++++++++++++++--------------- version.lisp-expr | 2 +- 3 files changed, 32 insertions(+), 23 deletions(-) diff --git a/NEWS b/NEWS index 0774b12..b39d6f3 100644 --- a/NEWS +++ b/NEWS @@ -14,6 +14,8 @@ changes in sbcl-0.9.6 relative to sbcl-0.9.5: on MIPS/Linux in addition to the previously supported platforms. * bug fix: division by zero in sb-sprof when no samples were collected * bug fix: a race when a slow to arrive sigprof signal killed sbcl + * bug fix: asdf-install uses CRLF as required by the HTTP spec. + (thanks to Alexander Kjeldaas) * threads ** bug fix: threads stacks belonging to dead threads are freed by the next exiting thread, no need to gc to collect thread stacks anymore diff --git a/contrib/asdf-install/installer.lisp b/contrib/asdf-install/installer.lisp index fbf1b32..0f5b1f1 100644 --- a/contrib/asdf-install/installer.lisp +++ b/contrib/asdf-install/installer.lisp @@ -104,29 +104,36 @@ (defun url-connection (url) (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)) (host (url-host url)) - (port (url-port url))) + (port (url-port url)) + result) (declare (ignore port)) - (socket-connect - s (car (host-ent-addresses (get-host-by-name (url-host (or *proxy* url))))) - (url-port (or *proxy* url))) - (let ((stream (socket-make-stream s :input t :output t :buffering :full :external-format :iso-8859-1))) - ;; we are exceedingly unportable about proper line-endings here. - ;; Anyone wishing to run this under non-SBCL should take especial care - (format stream "GET ~A HTTP/1.0~%Host: ~A~%Cookie: CCLAN-SITE=~A~%~%" - url host *cclan-mirror*) - (force-output stream) - (list - (let* ((l (read-line stream)) - (space (position #\Space l))) - (parse-integer l :start (1+ space) :junk-allowed t)) - (loop for line = (read-line stream nil nil) - until (or (null line) (eql (elt line 0) (code-char 13))) - collect - (let ((colon (position #\: line))) - (cons (intern (string-upcase (subseq line 0 colon)) :keyword) - (string-trim (list #\Space (code-char 13)) - (subseq line (1+ colon)))))) - stream)))) + (unwind-protect + (progn + (socket-connect + s (car (host-ent-addresses (get-host-by-name (url-host (or *proxy* url))))) + (url-port (or *proxy* url))) + (let ((stream (socket-make-stream s :input t :output t :buffering :full :external-format :iso-8859-1))) + ;; we are exceedingly unportable about proper line-endings here. + ;; Anyone wishing to run this under non-SBCL should take especial care + (format stream "GET ~A HTTP/1.0~c~%Host: ~A~c~%Cookie: CCLAN-SITE=~A~c~%~c~%" + url #\Return host #\Return *cclan-mirror* #\Return #\Return) + (force-output stream) + (setf result + (list + (let* ((l (read-line stream)) + (space (position #\Space l))) + (parse-integer l :start (1+ space) :junk-allowed t)) + (loop for line = (read-line stream nil nil) + until (or (null line) (eql (elt line 0) (code-char 13))) + collect + (let ((colon (position #\: line))) + (cons (intern (string-upcase (subseq line 0 colon)) :keyword) + (string-trim (list #\Space (code-char 13)) + (subseq line (1+ colon)))))) + stream)))) + (when (and (null result) + (socket-open-p s)) + (socket-close s))))) (defun download-files-for-package (package-name-or-url file-name) (let ((url diff --git a/version.lisp-expr b/version.lisp-expr index 433ed63..e349be1 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.5.31" +"0.9.5.32" -- 1.7.10.4