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

Suggested by Diane Murray.

diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 10a6f2e..d9ac818 100644 (file)
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -556,21 +556,43 @@ should be shown to the user."
            (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