diff options
Diffstat (limited to 'lisp/url')
| -rw-r--r-- | lisp/url/url-http.el | 33 | ||||
| -rw-r--r-- | lisp/url/url-queue.el | 29 |
2 files changed, 35 insertions, 27 deletions
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 669c24571f9..8532da1d1fb 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -702,15 +702,7 @@ should be shown to the user." ;; Treat everything like '300' nil)) (when redirect-uri - ;; Clean off any whitespace and/or <...> cruft. - (if (string-match "\\([^ \t]+\\)[ \t]" redirect-uri) - (setq redirect-uri (match-string 1 redirect-uri))) - (if (string-match "^<\\(.*\\)>$" redirect-uri) - (setq redirect-uri (match-string 1 redirect-uri))) - - ;; Some stupid sites (like sourceforge) send a - ;; non-fully-qualified URL (ie: /), which royally confuses - ;; the URL library. + ;; Handle relative redirect URIs. (if (not (string-match url-nonrelative-link redirect-uri)) ;; Be careful to use the real target URL, otherwise we may ;; compute the redirection relative to the URL of the proxy. @@ -1404,13 +1396,22 @@ The return value of this function is the retrieval buffer." (defun url-https-proxy-connect (connection) (setq url-http-after-change-function 'url-https-proxy-after-change-function) - (process-send-string connection (format (concat "CONNECT %s:%d HTTP/1.1\r\n" - "Host: %s\r\n" - "\r\n") - (url-host url-current-object) - (or (url-port url-current-object) - url-https-default-port) - (url-host url-current-object)))) + (process-send-string + connection + (format + (concat "CONNECT %s:%d HTTP/1.1\r\n" + "Host: %s\r\n" + (let ((proxy-auth (let ((url-basic-auth-storage + 'url-http-proxy-basic-auth-storage)) + (url-get-authentication url-http-proxy nil + 'any nil)))) + (and proxy-auth + (concat "Proxy-Authorization: " proxy-auth "\r\n"))) + "\r\n") + (url-host url-current-object) + (or (url-port url-current-object) + url-https-default-port) + (url-host url-current-object)))) (defun url-https-proxy-after-change-function (_st _nd _length) (let* ((process-buffer (current-buffer)) diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el index ff18cf1fe40..46cdff0f724 100644 --- a/lisp/url/url-queue.el +++ b/lisp/url/url-queue.el @@ -123,17 +123,24 @@ The variable `url-queue-timeout' sets a timeout." (setq url-queue-progress-timer nil)))) (defun url-queue-callback-function (status job) - (setq url-queue (delq job url-queue)) - (when (and (eq (car status) :error) - (eq (cadr (cadr status)) 'connection-failed)) - ;; If we get a connection error, then flush all other jobs from - ;; the host from the queue. This particularly makes sense if the - ;; error really is a DNS resolver issue, which happens - ;; synchronously and totally halts Emacs. - (url-queue-remove-jobs-from-host - (plist-get (nthcdr 3 (cadr status)) :host))) - (url-queue-run-queue) - (apply (url-queue-callback job) (cons status (url-queue-cbargs job)))) + (let ((buffer (current-buffer))) + (setq url-queue (delq job url-queue)) + (when (and (eq (car status) :error) + (eq (cadr (cadr status)) 'connection-failed)) + ;; If we get a connection error, then flush all other jobs from + ;; the host from the queue. This particularly makes sense if the + ;; error really is a DNS resolver issue, which happens + ;; synchronously and totally halts Emacs. + (url-queue-remove-jobs-from-host + (plist-get (nthcdr 3 (cadr status)) :host))) + (url-queue-run-queue) + ;; Somehow something deep in the bowels in the URL library may + ;; have killed off the current buffer. So check that it's still + ;; alive before doing anything, and if not, just create a dummy + ;; buffer and do the callback anyway. + (unless (buffer-live-p buffer) + (set-buffer (generate-new-buffer " *temp*"))) + (apply (url-queue-callback job) (cons status (url-queue-cbargs job))))) (defun url-queue-remove-jobs-from-host (host) (let ((jobs nil)) |