mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-12 09:28:24 +00:00
Code Issues Releases Activity

Backport HTTPS proxy fix

Browse Source 
Cherry-picked from 3c623c26ae

Backport:
This commit is contained in:
Tao Fang 2016-04-04 22:21:21 +02:00 committed by Lars Magne Ingebrigtsen
parent 80128a7849
commit 2d1a6054b1
2 changed files with 97 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
etc/NEWS
View File

@ -933,6 +933,8 @@ variable, meaning you can bind it around an 'url-retrieve' call.
plist will contain a :peer element that has the output of
'gnutls-peer-status' (if Emacs is built with GnuTLS support).
*** The URL package now support https over proxies supporting CONNECT.
** Tramp
+++

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

@ -26,6 +26,7 @@
;;; Code:
(require 'cl-lib)
(require 'nsm)
(eval-when-compile
(require 'subr-x))
@ -135,6 +136,8 @@ request.")
(507 insufficient-storage "Insufficient storage"))
"The HTTP return codes and their text.")
(defconst url-https-default-port 443 "Default HTTPS port.")
;(eval-when-compile
;; These are all macros so that they are hidden from external sight
;; when the file is byte-compiled.
@ -196,7 +199,14 @@ request.")
;; `url-open-stream' needs a buffer in which to do things
;; like authentication. But we use another buffer afterwards.
(unwind-protect
(let ((proc (url-open-stream host buf host port gateway-method)))
(let ((proc (url-open-stream host buf
(if url-using-proxy
(url-host url-using-proxy)
host)
(if url-using-proxy
(url-port url-using-proxy)
port)
gateway-method)))
;; url-open-stream might return nil.
(when (processp proc)
;; Drop the temp buffer link before killing the buffer.
@ -475,6 +485,7 @@ work correctly."
)
(declare-function gnutls-peer-status "gnutls.c" (proc))
(declare-function gnutls-negotiate "gnutls.el")
(defun url-http-parse-headers ()
"Parse and handle HTTP specific headers.
@ -931,7 +942,13 @@ should be shown to the user."
(erase-buffer)
(let ((url-request-method url-http-method)
(url-request-extra-headers url-http-extra-headers)
(url-request-data url-http-data))
(url-request-data url-http-data)
(url-using-proxy (url-find-proxy-for-url
url-current-object
(url-host url-current-object))))
(when url-using-proxy
(setq url-using-proxy
(url-generic-parse-url url-using-proxy)))
(url-http url-current-object url-callback-function
url-callback-arguments (current-buffer)))))
((url-http-parse-headers)
@ -1212,17 +1229,20 @@ overriding the value of `url-gateway-method'."
(nsm-noninteractive (or url-request-noninteractive
(and (boundp 'url-http-noninteractive)
url-http-noninteractive)))
(connection (url-http-find-free-connection host port gateway-method))
(connection (url-http-find-free-connection (url-host url)
(url-port url)
gateway-method))
(mime-accept-string url-mime-accept-string)
(buffer (or retry-buffer
(generate-new-buffer
(format " *http %s:%d*" host port)))))
(format " *http %s:%d*" (url-host url) (url-port url))))))
(if (not connection)
;; Failed to open the connection for some reason
(progn
(kill-buffer buffer)
(setq buffer nil)
(error "Could not create connection to %s:%d" host port))
(error "Could not create connection to %s:%d" (url-host url)
(url-port url)))
(with-current-buffer buffer
(mm-disable-multibyte)
(setq url-current-object url
@ -1278,13 +1298,72 @@ overriding the value of `url-gateway-method'."
(set-process-sentinel connection 'url-http-async-sentinel))
(`failed
;; Asynchronous connection failed
(error "Could not create connection to %s:%d" host port))
(error "Could not create connection to %s:%d" (url-host url)
(url-port url)))
(_
(set-process-sentinel connection
'url-http-end-of-document-sentinel)
(process-send-string connection (url-http-create-request))))))
(if (and url-http-proxy (string= "https"
(url-type url-current-object)))
(url-https-proxy-connect connection)
(set-process-sentinel connection
'url-http-end-of-document-sentinel)
(process-send-string connection (url-http-create-request)))))))
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))))
(defun url-https-proxy-after-change-function (st nd length)
(let* ((process-buffer (current-buffer))
(proc (get-buffer-process process-buffer)))
(goto-char (point-min))
(when (re-search-forward "^\r?\n" nil t)
(backward-char 1)
;; Saw the end of the headers
(setq url-http-end-of-headers (set-marker (make-marker) (point)))
(url-http-parse-response)
(cond
((null url-http-response-status)
;; We got back a headerless malformed response from the
;; server.
(url-http-activate-callback)
(error "Malformed response from proxy, fail!"))
((= url-http-response-status 200)
(if (gnutls-available-p)
(condition-case e
(let ((tls-connection (gnutls-negotiate
:process proc
:hostname (url-host url-current-object)
:verify-error nil)))
;; check certificate validity
(setq tls-connection
(nsm-verify-connection tls-connection
(url-host url-current-object)
(url-port url-current-object)))
(with-current-buffer process-buffer (erase-buffer))
(set-process-buffer tls-connection process-buffer)
(setq url-http-after-change-function
'url-http-wait-for-headers-change-function)
(set-process-filter tls-connection 'url-http-generic-filter)
(process-send-string tls-connection
(url-http-create-request)))
(gnutls-error
(url-http-activate-callback)
(error "gnutls-error: %s" e))
(error
(url-http-activate-callback)
(error "error: %s" e)))
(error "error: gnutls support needed!")))
(t
(url-http-activate-callback)
(message "error response: %d" url-http-response-status))))))
(defun url-http-async-sentinel (proc why)
;; We are performing an asynchronous connection, and a status change
;; has occurred.
@ -1296,11 +1375,13 @@ overriding the value of `url-gateway-method'."
(url-http-end-of-document-sentinel proc why))
((string= (substring why 0 4) "open")
(setq url-http-connection-opened t)
(condition-case error
(process-send-string proc (url-http-create-request))
(file-error
(setq url-http-connection-opened nil)
(message "HTTP error: %s" error))))
(if (and url-http-proxy (string= "https" (url-type url-current-object)))
(url-https-proxy-connect proc)
(condition-case error
(process-send-string proc (url-http-create-request))
(file-error
(setq url-http-connection-opened nil)
(message "HTTP error: %s" error)))))
(t
(setf (car url-callback-arguments)
(nconc (list :error (list 'error 'connection-failed why
@ -1461,7 +1542,6 @@ p3p
;; with url-http.el on systems with 8-character file names.
(require 'tls)
(defconst url-https-default-port 443 "Default HTTPS port.")
(defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.")
;; FIXME what is the point of this alias being an autoload?