changeset 77179:3aa49a5ae0ce

(url-http-parse-headers): Stop after a set number of redirections. Suggested by Diane Murray.

--- a/lisp/url/url-http.el	Fri Apr 13 14:52:03 2007 +0000
+++ b/lisp/url/url-http.el	Fri Apr 13 14:58:56 2007 +0000
@@ -556,21 +556,43 @@
            (let ((url-request-method url-http-method)
 		 (url-request-data url-http-data)
 		 (url-request-extra-headers url-http-extra-headers))
-	     ;; Remember that the request was redirected.
-	     (setf (car url-callback-arguments)
-		   (nconc (list :redirect redirect-uri)
-			  (car url-callback-arguments)))
-              ;; Put in the current buffer a forwarding pointer to the new
-              ;; destination buffer.
-              ;; FIXME: This is a hack to fix url-retrieve-synchronously
-              ;; without changing the API.  Instead url-retrieve should
-              ;; either simply not return the "destination" buffer, or it
-              ;; should take an optional `dest-buf' argument.
-              (set (make-local-variable 'url-redirect-buffer)
-		   (url-retrieve-internal
-		    redirect-uri url-callback-function
-		    url-callback-arguments))
-	      (url-mark-buffer-as-dead (current-buffer))))))
+	     ;; Check existing number of redirects
+	     (if (or (< url-max-redirections 0)
+		     (and (> url-max-redirections 0)
+			  (let ((events (car url-callback-arguments))
+				(old-redirects 0))
+			    (while events
+			      (if (eq (car events) :redirect)
+				  (setq old-redirects (1+ old-redirects)))
+			      (and (setq events (cdr events))
+				   (setq events (cdr events))))
+			    (< old-redirects url-max-redirections))))
+		 ;; url-max-redirections hasn't been reached, so go
+		 ;; ahead and redirect.
+		 (progn
+		   ;; Remember that the request was redirected.
+		   (setf (car url-callback-arguments)
+			 (nconc (list :redirect redirect-uri)
+				(car url-callback-arguments)))
+		   ;; Put in the current buffer a forwarding pointer to the new
+		   ;; destination buffer.
+		   ;; FIXME: This is a hack to fix url-retrieve-synchronously
+		   ;; without changing the API.  Instead url-retrieve should
+		   ;; either simply not return the "destination" buffer, or it
+		   ;; should take an optional `dest-buf' argument.
+		   (set (make-local-variable 'url-redirect-buffer)
+			(url-retrieve-internal
+			 redirect-uri url-callback-function
+			 url-callback-arguments))
+		   (url-mark-buffer-as-dead (current-buffer)))
+	       ;; We hit url-max-redirections, so issue an error and
+	       ;; stop redirecting.
+	       (url-http-debug "Maximum redirections reached")
+	       (setf (car url-callback-arguments)
+		     (nconc (list :error (list 'error 'http-redirect-limit
+					       redirect-uri))
+			    (car url-callback-arguments)))
+	       (setq success t))))))
       (4				; Client error
        ;; 400 Bad Request
        ;; 401 Unauthorized