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

Suggested by Diane Murray.

1 files changed, 37 insertions, 15 deletions

diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 10a6f2e7278..d9ac81838d4 100644
--- 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