diff options
| author | Ulf Jasper | 2014-09-29 10:18:32 +0200 |
|---|---|---|
| committer | Ulf Jasper | 2014-09-29 10:18:32 +0200 |
| commit | 2d7ade06a112d826a6a5d673e1db4e7959ed62a7 (patch) | |
| tree | 6d4741c90d9cdb476024262835222603ef4b2ece | |
| parent | 71a72686e3e81253f2bc0ad74568aafdbd86879c (diff) | |
| parent | 98c58df832975b01287ef749dd5235199d4cd431 (diff) | |
| download | emacs-2d7ade06a112d826a6a5d673e1db4e7959ed62a7.tar.gz emacs-2d7ade06a112d826a6a5d673e1db4e7959ed62a7.zip | |
Do not set `url-gateway-method' in `url-https'. (Bug#16543)
Currently, when `url-retrieve' is called for an https url it modifies
the variable `url-gateway-method'. This has been changed to
explicitly pass the requested gateway method to other functions.
When `url-retrieve' is being processed then (via
`accept-process-output') another `url-retrieve' call from a pending
timer can be started. The second call would always see the modified
`url-gateway-method' of the first one, which in general does not match
the url.
2014-09-28 Ulf Jasper <ulf.jasper@web.de>
* url-gw.el (url-open-stream): New optional parameter
`gateway-method'. If non-nil use it instead of global variable
`url-gateway-method'.
* url/url-http.el (url-http): New optional parameter
`gateway-method', pass it to `url-http-find-free-connection'.
(url-http-find-free-connection): New optional parameter
gateway-method, pass it to `url-open-stream'.
(url-https-create-secure-wrapper): Do not modify
`url-gateway-method' but explicitly provide 'tls as gateway-method
parameter to `url-https'.
| -rw-r--r-- | lisp/url/ChangeLog | 14 | ||||
| -rw-r--r-- | lisp/url/url-gw.el | 24 | ||||
| -rw-r--r-- | lisp/url/url-http.el | 18 |
3 files changed, 38 insertions, 18 deletions
diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index b99f57cfbfd..81096cfb800 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog | |||
| @@ -1,3 +1,17 @@ | |||
| 1 | 2014-09-28 Ulf Jasper <ulf.jasper@web.de> | ||
| 2 | |||
| 3 | * url-gw.el (url-open-stream): New optional parameter | ||
| 4 | `gateway-method'. If non-nil use it instead of global variable | ||
| 5 | `url-gateway-method'. | ||
| 6 | |||
| 7 | * url/url-http.el (url-http): New optional parameter | ||
| 8 | `gateway-method', pass it to `url-http-find-free-connection'. | ||
| 9 | (url-http-find-free-connection): New optional parameter | ||
| 10 | gateway-method, pass it to `url-open-stream'. | ||
| 11 | (url-https-create-secure-wrapper): Do not modify | ||
| 12 | `url-gateway-method' but explicitly provide 'tls as gateway-method | ||
| 13 | parameter to `url-https'. | ||
| 14 | |||
| 1 | 2014-09-22 Dmitry Gutov <dgutov@yandex.ru> | 15 | 2014-09-22 Dmitry Gutov <dgutov@yandex.ru> |
| 2 | 16 | ||
| 3 | * url.el (url-retrieve-internal): Clarify the docstring. | 17 | * url.el (url-retrieve-internal): Clarify the docstring. |
diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el index b1cc8a29e3b..4a6189dcfea 100644 --- a/lisp/url/url-gw.el +++ b/lisp/url/url-gw.el | |||
| @@ -203,20 +203,24 @@ linked Emacs under SunOS 4.x." | |||
| 203 | proc))) | 203 | proc))) |
| 204 | 204 | ||
| 205 | ;;;###autoload | 205 | ;;;###autoload |
| 206 | (defun url-open-stream (name buffer host service) | 206 | (defun url-open-stream (name buffer host service &optional gateway-method) |
| 207 | "Open a stream to HOST, possibly via a gateway. | 207 | "Open a stream to HOST, possibly via a gateway. |
| 208 | Args per `open-network-stream'. | 208 | Args per `open-network-stream'. |
| 209 | Will not make a connection if `url-gateway-unplugged' is non-nil. | 209 | Will not make a connection if `url-gateway-unplugged' is non-nil. |
| 210 | Might do a non-blocking connection; use `process-status' to check." | 210 | Might do a non-blocking connection; use `process-status' to check. |
| 211 | |||
| 212 | Optional arg GATEWAY-METHOD specifies the gateway to be used, | ||
| 213 | overriding the value of `url-gateway-method'." | ||
| 211 | (unless url-gateway-unplugged | 214 | (unless url-gateway-unplugged |
| 212 | (let ((gw-method (if (and url-gateway-local-host-regexp | 215 | (let* ((gwm (or gateway-method url-gateway-method)) |
| 213 | (not (eq 'tls url-gateway-method)) | 216 | (gw-method (if (and url-gateway-local-host-regexp |
| 214 | (not (eq 'ssl url-gateway-method)) | 217 | (not (eq 'tls gwm)) |
| 215 | (string-match | 218 | (not (eq 'ssl gwm)) |
| 216 | url-gateway-local-host-regexp | 219 | (string-match |
| 217 | host)) | 220 | url-gateway-local-host-regexp |
| 218 | 'native | 221 | host)) |
| 219 | url-gateway-method)) | 222 | 'native |
| 223 | gwm)) | ||
| 220 | ;; An attempt to deal with denied connections, and attempt | 224 | ;; An attempt to deal with denied connections, and attempt |
| 221 | ;; to reconnect | 225 | ;; to reconnect |
| 222 | (cur-retries 0) | 226 | (cur-retries 0) |
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index cba4c6fbc02..9a874c25ce0 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el | |||
| @@ -171,7 +171,7 @@ request.") | |||
| 171 | url-http-open-connections)) | 171 | url-http-open-connections)) |
| 172 | nil) | 172 | nil) |
| 173 | 173 | ||
| 174 | (defun url-http-find-free-connection (host port) | 174 | (defun url-http-find-free-connection (host port &optional gateway-method) |
| 175 | (let ((conns (gethash (cons host port) url-http-open-connections)) | 175 | (let ((conns (gethash (cons host port) url-http-open-connections)) |
| 176 | (connection nil)) | 176 | (connection nil)) |
| 177 | (while (and conns (not connection)) | 177 | (while (and conns (not connection)) |
| @@ -193,7 +193,7 @@ request.") | |||
| 193 | ;; `url-open-stream' needs a buffer in which to do things | 193 | ;; `url-open-stream' needs a buffer in which to do things |
| 194 | ;; like authentication. But we use another buffer afterwards. | 194 | ;; like authentication. But we use another buffer afterwards. |
| 195 | (unwind-protect | 195 | (unwind-protect |
| 196 | (let ((proc (url-open-stream host buf host port))) | 196 | (let ((proc (url-open-stream host buf host port gateway-method))) |
| 197 | ;; url-open-stream might return nil. | 197 | ;; url-open-stream might return nil. |
| 198 | (when (processp proc) | 198 | (when (processp proc) |
| 199 | ;; Drop the temp buffer link before killing the buffer. | 199 | ;; Drop the temp buffer link before killing the buffer. |
| @@ -1167,7 +1167,7 @@ the end of the document." | |||
| 1167 | (when (eq process-buffer (current-buffer)) | 1167 | (when (eq process-buffer (current-buffer)) |
| 1168 | (goto-char (point-max))))) | 1168 | (goto-char (point-max))))) |
| 1169 | 1169 | ||
| 1170 | (defun url-http (url callback cbargs &optional retry-buffer) | 1170 | (defun url-http (url callback cbargs &optional retry-buffer gateway-method) |
| 1171 | "Retrieve URL via HTTP asynchronously. | 1171 | "Retrieve URL via HTTP asynchronously. |
| 1172 | URL must be a parsed URL. See `url-generic-parse-url' for details. | 1172 | URL must be a parsed URL. See `url-generic-parse-url' for details. |
| 1173 | 1173 | ||
| @@ -1178,11 +1178,14 @@ request, as described in the docstring of `url-retrieve' (if in | |||
| 1178 | doubt, specify nil). | 1178 | doubt, specify nil). |
| 1179 | 1179 | ||
| 1180 | Optional arg RETRY-BUFFER, if non-nil, specifies the buffer of a | 1180 | Optional arg RETRY-BUFFER, if non-nil, specifies the buffer of a |
| 1181 | previous `url-http' call, which is being re-attempted." | 1181 | previous `url-http' call, which is being re-attempted. |
| 1182 | |||
| 1183 | Optional arg GATEWAY-METHOD specifies the gateway to be used, | ||
| 1184 | overriding the value of `url-gateway-method'." | ||
| 1182 | (cl-check-type url vector "Need a pre-parsed URL.") | 1185 | (cl-check-type url vector "Need a pre-parsed URL.") |
| 1183 | (let* ((host (url-host (or url-using-proxy url))) | 1186 | (let* ((host (url-host (or url-using-proxy url))) |
| 1184 | (port (url-port (or url-using-proxy url))) | 1187 | (port (url-port (or url-using-proxy url))) |
| 1185 | (connection (url-http-find-free-connection host port)) | 1188 | (connection (url-http-find-free-connection host port gateway-method)) |
| 1186 | (buffer (or retry-buffer | 1189 | (buffer (or retry-buffer |
| 1187 | (generate-new-buffer | 1190 | (generate-new-buffer |
| 1188 | (format " *http %s:%d*" host port))))) | 1191 | (format " *http %s:%d*" host port))))) |
| @@ -1440,9 +1443,8 @@ p3p | |||
| 1440 | (defmacro url-https-create-secure-wrapper (method args) | 1443 | (defmacro url-https-create-secure-wrapper (method args) |
| 1441 | `(defun ,(intern (format (if method "url-https-%s" "url-https") method)) ,args | 1444 | `(defun ,(intern (format (if method "url-https-%s" "url-https") method)) ,args |
| 1442 | ,(format "HTTPS wrapper around `%s' call." (or method "url-http")) | 1445 | ,(format "HTTPS wrapper around `%s' call." (or method "url-http")) |
| 1443 | (let ((url-gateway-method 'tls)) | 1446 | (,(intern (format (if method "url-http-%s" "url-http") method)) |
| 1444 | (,(intern (format (if method "url-http-%s" "url-http") method)) | 1447 | ,@(remove '&rest (remove '&optional (append args (if method nil '(nil 'tls)))))))) |
| 1445 | ,@(remove '&rest (remove '&optional args)))))) | ||
| 1446 | 1448 | ||
| 1447 | ;;;###autoload (autoload 'url-https "url-http") | 1449 | ;;;###autoload (autoload 'url-https "url-http") |
| 1448 | (url-https-create-secure-wrapper nil (url callback cbargs)) | 1450 | (url-https-create-secure-wrapper nil (url callback cbargs)) |