aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorLars Magne Ingebrigtsen2016-04-06 18:36:18 +0200
committerLars Magne Ingebrigtsen2016-04-06 18:36:18 +0200
commit0d7aad1b30de7e9deb8b3c7011d9b679e538371c (patch)
treefcec0d4ae33eac780b308b45b5b5044b6f942353 /lisp
parent2d1a6054b161bd1055d4feb11c8c5ac95543f5db (diff)
downloademacs-0d7aad1b30de7e9deb8b3c7011d9b679e538371c.tar.gz
emacs-0d7aad1b30de7e9deb8b3c7011d9b679e538371c.zip
Revert "Backport HTTPS proxy fix"
This reverts commit 2d1a6054b161bd1055d4feb11c8c5ac95543f5db. It's too late in the Emacs 25 release cycle to add things like this to Emacs 25.1. It's border line new feature.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/url/url-http.el110
1 files changed, 15 insertions, 95 deletions
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 9548a1ffbe2..5832e92c5a3 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -26,7 +26,6 @@
26;;; Code: 26;;; Code:
27 27
28(require 'cl-lib) 28(require 'cl-lib)
29(require 'nsm)
30(eval-when-compile 29(eval-when-compile
31 (require 'subr-x)) 30 (require 'subr-x))
32 31
@@ -136,8 +135,6 @@ request.")
136 (507 insufficient-storage "Insufficient storage")) 135 (507 insufficient-storage "Insufficient storage"))
137 "The HTTP return codes and their text.") 136 "The HTTP return codes and their text.")
138 137
139(defconst url-https-default-port 443 "Default HTTPS port.")
140
141;(eval-when-compile 138;(eval-when-compile
142;; These are all macros so that they are hidden from external sight 139;; These are all macros so that they are hidden from external sight
143;; when the file is byte-compiled. 140;; when the file is byte-compiled.
@@ -199,14 +196,7 @@ request.")
199 ;; `url-open-stream' needs a buffer in which to do things 196 ;; `url-open-stream' needs a buffer in which to do things
200 ;; like authentication. But we use another buffer afterwards. 197 ;; like authentication. But we use another buffer afterwards.
201 (unwind-protect 198 (unwind-protect
202 (let ((proc (url-open-stream host buf 199 (let ((proc (url-open-stream host buf host port gateway-method)))
203 (if url-using-proxy
204 (url-host url-using-proxy)
205 host)
206 (if url-using-proxy
207 (url-port url-using-proxy)
208 port)
209 gateway-method)))
210 ;; url-open-stream might return nil. 200 ;; url-open-stream might return nil.
211 (when (processp proc) 201 (when (processp proc)
212 ;; Drop the temp buffer link before killing the buffer. 202 ;; Drop the temp buffer link before killing the buffer.
@@ -485,7 +475,6 @@ work correctly."
485 ) 475 )
486 476
487(declare-function gnutls-peer-status "gnutls.c" (proc)) 477(declare-function gnutls-peer-status "gnutls.c" (proc))
488(declare-function gnutls-negotiate "gnutls.el")
489 478
490(defun url-http-parse-headers () 479(defun url-http-parse-headers ()
491 "Parse and handle HTTP specific headers. 480 "Parse and handle HTTP specific headers.
@@ -942,13 +931,7 @@ should be shown to the user."
942 (erase-buffer) 931 (erase-buffer)
943 (let ((url-request-method url-http-method) 932 (let ((url-request-method url-http-method)
944 (url-request-extra-headers url-http-extra-headers) 933 (url-request-extra-headers url-http-extra-headers)
945 (url-request-data url-http-data) 934 (url-request-data url-http-data))
946 (url-using-proxy (url-find-proxy-for-url
947 url-current-object
948 (url-host url-current-object))))
949 (when url-using-proxy
950 (setq url-using-proxy
951 (url-generic-parse-url url-using-proxy)))
952 (url-http url-current-object url-callback-function 935 (url-http url-current-object url-callback-function
953 url-callback-arguments (current-buffer))))) 936 url-callback-arguments (current-buffer)))))
954 ((url-http-parse-headers) 937 ((url-http-parse-headers)
@@ -1229,20 +1212,17 @@ overriding the value of `url-gateway-method'."
1229 (nsm-noninteractive (or url-request-noninteractive 1212 (nsm-noninteractive (or url-request-noninteractive
1230 (and (boundp 'url-http-noninteractive) 1213 (and (boundp 'url-http-noninteractive)
1231 url-http-noninteractive))) 1214 url-http-noninteractive)))
1232 (connection (url-http-find-free-connection (url-host url) 1215 (connection (url-http-find-free-connection host port gateway-method))
1233 (url-port url)
1234 gateway-method))
1235 (mime-accept-string url-mime-accept-string) 1216 (mime-accept-string url-mime-accept-string)
1236 (buffer (or retry-buffer 1217 (buffer (or retry-buffer
1237 (generate-new-buffer 1218 (generate-new-buffer
1238 (format " *http %s:%d*" (url-host url) (url-port url)))))) 1219 (format " *http %s:%d*" host port)))))
1239 (if (not connection) 1220 (if (not connection)
1240 ;; Failed to open the connection for some reason 1221 ;; Failed to open the connection for some reason
1241 (progn 1222 (progn
1242 (kill-buffer buffer) 1223 (kill-buffer buffer)
1243 (setq buffer nil) 1224 (setq buffer nil)
1244 (error "Could not create connection to %s:%d" (url-host url) 1225 (error "Could not create connection to %s:%d" host port))
1245 (url-port url)))
1246 (with-current-buffer buffer 1226 (with-current-buffer buffer
1247 (mm-disable-multibyte) 1227 (mm-disable-multibyte)
1248 (setq url-current-object url 1228 (setq url-current-object url
@@ -1298,72 +1278,13 @@ overriding the value of `url-gateway-method'."
1298 (set-process-sentinel connection 'url-http-async-sentinel)) 1278 (set-process-sentinel connection 'url-http-async-sentinel))
1299 (`failed 1279 (`failed
1300 ;; Asynchronous connection failed 1280 ;; Asynchronous connection failed
1301 (error "Could not create connection to %s:%d" (url-host url) 1281 (error "Could not create connection to %s:%d" host port))
1302 (url-port url)))
1303 (_ 1282 (_
1304 (if (and url-http-proxy (string= "https" 1283 (set-process-sentinel connection
1305 (url-type url-current-object))) 1284 'url-http-end-of-document-sentinel)
1306 (url-https-proxy-connect connection) 1285 (process-send-string connection (url-http-create-request))))))
1307 (set-process-sentinel connection
1308 'url-http-end-of-document-sentinel)
1309 (process-send-string connection (url-http-create-request)))))))
1310 buffer)) 1286 buffer))
1311 1287
1312(defun url-https-proxy-connect (connection)
1313 (setq url-http-after-change-function 'url-https-proxy-after-change-function)
1314 (process-send-string connection (format (concat "CONNECT %s:%d HTTP/1.1\r\n"
1315 "Host: %s\r\n"
1316 "\r\n")
1317 (url-host url-current-object)
1318 (or (url-port url-current-object)
1319 url-https-default-port)
1320 (url-host url-current-object))))
1321
1322(defun url-https-proxy-after-change-function (st nd length)
1323 (let* ((process-buffer (current-buffer))
1324 (proc (get-buffer-process process-buffer)))
1325 (goto-char (point-min))
1326 (when (re-search-forward "^\r?\n" nil t)
1327 (backward-char 1)
1328 ;; Saw the end of the headers
1329 (setq url-http-end-of-headers (set-marker (make-marker) (point)))
1330 (url-http-parse-response)
1331 (cond
1332 ((null url-http-response-status)
1333 ;; We got back a headerless malformed response from the
1334 ;; server.
1335 (url-http-activate-callback)
1336 (error "Malformed response from proxy, fail!"))
1337 ((= url-http-response-status 200)
1338 (if (gnutls-available-p)
1339 (condition-case e
1340 (let ((tls-connection (gnutls-negotiate
1341 :process proc
1342 :hostname (url-host url-current-object)
1343 :verify-error nil)))
1344 ;; check certificate validity
1345 (setq tls-connection
1346 (nsm-verify-connection tls-connection
1347 (url-host url-current-object)
1348 (url-port url-current-object)))
1349 (with-current-buffer process-buffer (erase-buffer))
1350 (set-process-buffer tls-connection process-buffer)
1351 (setq url-http-after-change-function
1352 'url-http-wait-for-headers-change-function)
1353 (set-process-filter tls-connection 'url-http-generic-filter)
1354 (process-send-string tls-connection
1355 (url-http-create-request)))
1356 (gnutls-error
1357 (url-http-activate-callback)
1358 (error "gnutls-error: %s" e))
1359 (error
1360 (url-http-activate-callback)
1361 (error "error: %s" e)))
1362 (error "error: gnutls support needed!")))
1363 (t
1364 (url-http-activate-callback)
1365 (message "error response: %d" url-http-response-status))))))
1366
1367(defun url-http-async-sentinel (proc why) 1288(defun url-http-async-sentinel (proc why)
1368 ;; We are performing an asynchronous connection, and a status change 1289 ;; We are performing an asynchronous connection, and a status change
1369 ;; has occurred. 1290 ;; has occurred.
@@ -1375,13 +1296,11 @@ overriding the value of `url-gateway-method'."
1375 (url-http-end-of-document-sentinel proc why)) 1296 (url-http-end-of-document-sentinel proc why))
1376 ((string= (substring why 0 4) "open") 1297 ((string= (substring why 0 4) "open")
1377 (setq url-http-connection-opened t) 1298 (setq url-http-connection-opened t)
1378 (if (and url-http-proxy (string= "https" (url-type url-current-object))) 1299 (condition-case error
1379 (url-https-proxy-connect proc) 1300 (process-send-string proc (url-http-create-request))
1380 (condition-case error 1301 (file-error
1381 (process-send-string proc (url-http-create-request)) 1302 (setq url-http-connection-opened nil)
1382 (file-error 1303 (message "HTTP error: %s" error))))
1383 (setq url-http-connection-opened nil)
1384 (message "HTTP error: %s" error)))))
1385 (t 1304 (t
1386 (setf (car url-callback-arguments) 1305 (setf (car url-callback-arguments)
1387 (nconc (list :error (list 'error 'connection-failed why 1306 (nconc (list :error (list 'error 'connection-failed why
@@ -1542,6 +1461,7 @@ p3p
1542;; with url-http.el on systems with 8-character file names. 1461;; with url-http.el on systems with 8-character file names.
1543(require 'tls) 1462(require 'tls)
1544 1463
1464(defconst url-https-default-port 443 "Default HTTPS port.")
1545(defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.") 1465(defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.")
1546 1466
1547;; FIXME what is the point of this alias being an autoload? 1467;; FIXME what is the point of this alias being an autoload?