diff options
| author | Lars Magne Ingebrigtsen | 2016-04-06 18:36:18 +0200 |
|---|---|---|
| committer | Lars Magne Ingebrigtsen | 2016-04-06 18:36:18 +0200 |
| commit | 0d7aad1b30de7e9deb8b3c7011d9b679e538371c (patch) | |
| tree | fcec0d4ae33eac780b308b45b5b5044b6f942353 /lisp | |
| parent | 2d1a6054b161bd1055d4feb11c8c5ac95543f5db (diff) | |
| download | emacs-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.el | 110 |
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? |