[11818] | 1 | From 172363d31b3ad5f45da44aa09652d0e0779ef5f2 Mon Sep 17 00:00:00 2001 |
---|
| 2 | From: Tao Fang <fangtao0901@gmail.com> |
---|
| 3 | Date: Tue, 22 Mar 2016 22:39:51 +0800 |
---|
| 4 | Subject: [PATCH] Fix url https over proxy implement. (Bug#11788) |
---|
| 5 | |
---|
| 6 | * lisp/url/url-http.el: Fix url https over proxy implement. (Bug#11788) |
---|
| 7 | |
---|
| 8 | * etc/NEWS: Mention this. |
---|
| 9 | --- |
---|
| 10 | etc/NEWS | 3 ++ |
---|
| 11 | lisp/url/url-http.el | 105 ++++++++++++++++++++++++++++++++++++++++++++------- |
---|
| 12 | 2 files changed, 94 insertions(+), 14 deletions(-) |
---|
| 13 | |
---|
| 14 | diff --git a/etc/NEWS b/etc/NEWS |
---|
| 15 | index 4414625..7d2cc92 100644 |
---|
| 16 | --- a/etc/NEWS |
---|
| 17 | +++ b/etc/NEWS |
---|
| 18 | @@ -1193,6 +1193,9 @@ plist will contain a :peer element that has the output of |
---|
| 19 | programmatically delete all cookies, or cookies from a specific |
---|
| 20 | domain. |
---|
| 21 | |
---|
| 22 | ++++ |
---|
| 23 | +*** The URL package now support https over proxy. |
---|
| 24 | + |
---|
| 25 | ** Tramp |
---|
| 26 | |
---|
| 27 | +++ |
---|
| 28 | diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el |
---|
| 29 | index 33f6d11..4f180ed 100644 |
---|
| 30 | --- a/lisp/url/url-http.el |
---|
| 31 | +++ b/lisp/url/url-http.el |
---|
| 32 | @@ -197,7 +197,14 @@ request.") |
---|
| 33 | ;; `url-open-stream' needs a buffer in which to do things |
---|
| 34 | ;; like authentication. But we use another buffer afterwards. |
---|
| 35 | (unwind-protect |
---|
| 36 | - (let ((proc (url-open-stream host buf host port gateway-method))) |
---|
| 37 | + (let ((proc (url-open-stream host buf |
---|
| 38 | + (if url-using-proxy |
---|
| 39 | + (url-host url-using-proxy) |
---|
| 40 | + host) |
---|
| 41 | + (if url-using-proxy |
---|
| 42 | + (url-port url-using-proxy) |
---|
| 43 | + port) |
---|
| 44 | + gateway-method))) |
---|
| 45 | ;; url-open-stream might return nil. |
---|
| 46 | (when (processp proc) |
---|
| 47 | ;; Drop the temp buffer link before killing the buffer. |
---|
| 48 | @@ -925,7 +932,13 @@ should be shown to the user." |
---|
| 49 | (erase-buffer) |
---|
| 50 | (let ((url-request-method url-http-method) |
---|
| 51 | (url-request-extra-headers url-http-extra-headers) |
---|
| 52 | - (url-request-data url-http-data)) |
---|
| 53 | + (url-request-data url-http-data) |
---|
| 54 | + (url-using-proxy (url-find-proxy-for-url |
---|
| 55 | + url-current-object |
---|
| 56 | + (url-host url-current-object)))) |
---|
| 57 | + (when url-using-proxy |
---|
| 58 | + (setq url-using-proxy |
---|
| 59 | + (url-generic-parse-url url-using-proxy))) |
---|
| 60 | (url-http url-current-object url-callback-function |
---|
| 61 | url-callback-arguments (current-buffer))))) |
---|
| 62 | ((url-http-parse-headers) |
---|
| 63 | @@ -1209,17 +1222,20 @@ The return value of this function is the retrieval buffer." |
---|
| 64 | (nsm-noninteractive (or url-request-noninteractive |
---|
| 65 | (and (boundp 'url-http-noninteractive) |
---|
| 66 | url-http-noninteractive))) |
---|
| 67 | - (connection (url-http-find-free-connection host port gateway-method)) |
---|
| 68 | + (connection (url-http-find-free-connection (url-host url) |
---|
| 69 | + (url-port url) |
---|
| 70 | + gateway-method)) |
---|
| 71 | (mime-accept-string url-mime-accept-string) |
---|
| 72 | (buffer (or retry-buffer |
---|
| 73 | (generate-new-buffer |
---|
| 74 | - (format " *http %s:%d*" host port))))) |
---|
| 75 | + (format " *http %s:%d*" (url-host url) (url-port url)))))) |
---|
| 76 | (if (not connection) |
---|
| 77 | ;; Failed to open the connection for some reason |
---|
| 78 | (progn |
---|
| 79 | (kill-buffer buffer) |
---|
| 80 | (setq buffer nil) |
---|
| 81 | - (error "Could not create connection to %s:%d" host port)) |
---|
| 82 | + (error "Could not create connection to %s:%d" (url-host url) |
---|
| 83 | + (url-port url))) |
---|
| 84 | (with-current-buffer buffer |
---|
| 85 | (mm-disable-multibyte) |
---|
| 86 | (setq url-current-object url |
---|
| 87 | @@ -1275,13 +1291,72 @@ The return value of this function is the retrieval buffer." |
---|
| 88 | (set-process-sentinel connection 'url-http-async-sentinel)) |
---|
| 89 | (`failed |
---|
| 90 | ;; Asynchronous connection failed |
---|
| 91 | - (error "Could not create connection to %s:%d" host port)) |
---|
| 92 | + (error "Could not create connection to %s:%d" (url-host url) |
---|
| 93 | + (url-port url))) |
---|
| 94 | (_ |
---|
| 95 | - (set-process-sentinel connection |
---|
| 96 | - 'url-http-end-of-document-sentinel) |
---|
| 97 | - (process-send-string connection (url-http-create-request)))))) |
---|
| 98 | + (if (and url-http-proxy (string= "https" |
---|
| 99 | + (url-type url-current-object))) |
---|
| 100 | + (url-https-proxy-connect connection) |
---|
| 101 | + (set-process-sentinel connection |
---|
| 102 | + 'url-http-end-of-document-sentinel) |
---|
| 103 | + (process-send-string connection (url-http-create-request))))))) |
---|
| 104 | buffer)) |
---|
| 105 | |
---|
| 106 | +(defun url-https-proxy-connect (connection) |
---|
| 107 | + (setq url-http-after-change-function 'url-https-proxy-after-change-function) |
---|
| 108 | + (process-send-string connection (format (concat "CONNECT %s:%d HTTP/1.1\r\n" |
---|
| 109 | + "Host: %s\r\n" |
---|
| 110 | + "\r\n") |
---|
| 111 | + (url-host url-current-object) |
---|
| 112 | + (or (url-port url-current-object) |
---|
| 113 | + url-https-default-port) |
---|
| 114 | + (url-host url-current-object)))) |
---|
| 115 | + |
---|
| 116 | +(defun url-https-proxy-after-change-function (st nd length) |
---|
| 117 | + (let* ((process-buffer (current-buffer)) |
---|
| 118 | + (proc (get-buffer-process process-buffer))) |
---|
| 119 | + (goto-char (point-min)) |
---|
| 120 | + (when (re-search-forward "^\r?\n" nil t) |
---|
| 121 | + (backward-char 1) |
---|
| 122 | + ;; Saw the end of the headers |
---|
| 123 | + (setq url-http-end-of-headers (set-marker (make-marker) (point))) |
---|
| 124 | + (url-http-parse-response) |
---|
| 125 | + (cond |
---|
| 126 | + ((null url-http-response-status) |
---|
| 127 | + ;; We got back a headerless malformed response from the |
---|
| 128 | + ;; server. |
---|
| 129 | + (url-http-activate-callback) |
---|
| 130 | + (error "Malformed response from proxy, fail!")) |
---|
| 131 | + ((= url-http-response-status 200) |
---|
| 132 | + (if (gnutls-available-p) |
---|
| 133 | + (condition-case e |
---|
| 134 | + (let ((tls-connection (gnutls-negotiate |
---|
| 135 | + :process proc |
---|
| 136 | + :hostname (url-host url-current-object) |
---|
| 137 | + :verify-error nil))) |
---|
| 138 | + ;; check certificate validity |
---|
| 139 | + (setq tls-connection |
---|
| 140 | + (nsm-verify-connection tls-connection |
---|
| 141 | + (url-host url-current-object) |
---|
| 142 | + (url-port url-current-object))) |
---|
| 143 | + (with-current-buffer process-buffer (erase-buffer)) |
---|
| 144 | + (set-process-buffer tls-connection process-buffer) |
---|
| 145 | + (setq url-http-after-change-function |
---|
| 146 | + 'url-http-wait-for-headers-change-function) |
---|
| 147 | + (set-process-filter tls-connection 'url-http-generic-filter) |
---|
| 148 | + (process-send-string tls-connection |
---|
| 149 | + (url-http-create-request))) |
---|
| 150 | + (gnutls-error |
---|
| 151 | + (url-http-activate-callback) |
---|
| 152 | + (error "gnutls-error: %s" e)) |
---|
| 153 | + (error |
---|
| 154 | + (url-http-activate-callback) |
---|
| 155 | + (error "error: %s" e))) |
---|
| 156 | + (error "error: gnutls support needed!"))) |
---|
| 157 | + (t |
---|
| 158 | + (url-http-activate-callback) |
---|
| 159 | + (message "error response: %d" url-http-response-status)))))) |
---|
| 160 | + |
---|
| 161 | (defun url-http-async-sentinel (proc why) |
---|
| 162 | ;; We are performing an asynchronous connection, and a status change |
---|
| 163 | ;; has occurred. |
---|
| 164 | @@ -1293,11 +1368,13 @@ The return value of this function is the retrieval buffer." |
---|
| 165 | (url-http-end-of-document-sentinel proc why)) |
---|
| 166 | ((string= (substring why 0 4) "open") |
---|
| 167 | (setq url-http-connection-opened t) |
---|
| 168 | - (condition-case error |
---|
| 169 | - (process-send-string proc (url-http-create-request)) |
---|
| 170 | - (file-error |
---|
| 171 | - (setq url-http-connection-opened nil) |
---|
| 172 | - (message "HTTP error: %s" error)))) |
---|
| 173 | + (if (and url-http-proxy (string= "https" (url-type url-current-object))) |
---|
| 174 | + (url-https-proxy-connect proc) |
---|
| 175 | + (condition-case error |
---|
| 176 | + (process-send-string proc (url-http-create-request)) |
---|
| 177 | + (file-error |
---|
| 178 | + (setq url-http-connection-opened nil) |
---|
| 179 | + (message "HTTP error: %s" error))))) |
---|
| 180 | (t |
---|
| 181 | (setf (car url-callback-arguments) |
---|
| 182 | (nconc (list :error (list 'error 'connection-failed why |
---|
| 183 | -- |
---|
| 184 | 2.7.4 |
---|
| 185 | |
---|