mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-22 07:09:54 +00:00
Code Issues Releases Activity

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

Browse Source 
Suggested by Diane Murray.
This commit is contained in:
Chong Yidong 2007-04-13 14:58:56 +00:00
parent 2faae86bd7
commit 58aba8143c
1 changed files with 37 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
lisp/url/url-http.el
View File

@ -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