Update of /project/closure/cvsroot/closure/src/net In directory common-lisp.net:/tmp/cvs-serv16846/src/net
Modified Files: http.lisp Log Message: Partial fix for following HTTP redirects (code 301 or 302 or 303). Certain servers (such as www.lisp.org) only include a path in the Location header, instead of a complete URL. We now accept either a path (in which case the rest of the URL is derived from the current URL), or a complete URL.
This fix is only partial, since the GUI code in gui/clim-gui.lisp is not prepared to handle redirects correctly.
Date: Sun Jul 17 11:44:40 2005 Author: emarsden
Index: closure/src/net/http.lisp diff -u closure/src/net/http.lisp:1.6 closure/src/net/http.lisp:1.7 --- closure/src/net/http.lisp:1.6 Wed Jul 13 17:13:05 2005 +++ closure/src/net/http.lisp Sun Jul 17 11:44:40 2005 @@ -99,7 +99,7 @@
(defparameter *user-agent* "Lynx/2.7.1ac-0.98 libwww-FM/2.14") (defparameter *user-agent* "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)") -(defparameter *user-agent* "CLOSURE/0.1") +(defparameter *user-agent* "Closure/200507")
#|| @@ -549,20 +549,19 @@ response-header)))
((301 302 303) - ;; moved permanently; moved temponary; see other - (multiple-value-bind (input header) - (http-open-document - (url:parse-url - (or (get-header-field response-header :location) - (error "301/302 Response from ~A lacks a 'Location' field." - (url:url-host url)))) - :yet-urls (cons url yet-urls)) - (values input - (append header - (list - (cons "Location" - (get-header-field response-header :location))))))) - + ;; moved permanently; moved temporary; see other + ;; + ;; the Location field may be either a complete URI, or just a path + (let* ((new-location (or (url:parse-url + (get-header-field response-header :location)) + (error "301/302 Response from ~A lacks a 'Location' field." + (url:url-host url)))) + (new-url (if (url:url-host new-location) new-location + (url:merge-url new-location url)))) + (multiple-value-bind (input header) + (apply #'http-open-document new-url :yet-urls (cons url yet-urls) options) + (values input `(,@header ("Location" . ,(unparse-url new-url))))))) + (304 ;; not modified (values (cl-byte-stream->gstream (open (hce-pathname (http-cache) ce)