diff options
Diffstat (limited to 'lisp/url/url-http.el')
| -rw-r--r-- | lisp/url/url-http.el | 52 |
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 |