diff options
| author | Lars Ingebrigtsen <larsi@gnus.org> | 2020-07-19 23:12:54 +0200 |
|---|---|---|
| committer | Lars Ingebrigtsen <larsi@gnus.org> | 2020-07-19 23:12:54 +0200 |
| commit | 7a24cff1b2be9068a7c578360f6b51236105d98b (patch) | |
| tree | f581e02fac6bcda9cf749abbd2e0e36854771868 /lisp/url | |
| parent | 5d2bc1543925960009167988523d76fc6d4c805a (diff) | |
| download | emacs-7a24cff1b2be9068a7c578360f6b51236105d98b.tar.gz | |
Only kill url-retrieve-synchronously connections when we have a timeout
* lisp/url/url.el (url-retrieve-synchronously): Only kill the
connections when we have a timeout (bug#34607).
Diffstat (limited to 'lisp/url')
| -rw-r--r-- | lisp/url/url.el | 18 |
1 files changed, 11 insertions, 7 deletions
diff --git a/lisp/url/url.el b/lisp/url/url.el index 367af1b5a90..321e79c019f 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -238,7 +238,8 @@ how long to wait for a response before giving up." (let ((retrieval-done nil) (start-time (current-time)) (url-asynchronous nil) - (asynch-buffer nil)) + (asynch-buffer nil) + (timed-out nil)) (setq asynch-buffer (url-retrieve url (lambda (&rest ignored) (url-debug 'retrieval "Synchronous fetching done (%S)" (current-buffer)) @@ -261,7 +262,9 @@ how long to wait for a response before giving up." ;; process output. (while (and (not retrieval-done) (or (not timeout) - (time-less-p (time-since start-time) timeout))) + (not (setq timed-out + (time-less-p timeout + (time-since start-time)))))) (url-debug 'retrieval "Spinning in url-retrieve-synchronously: %S (%S)" retrieval-done asynch-buffer) @@ -303,11 +306,12 @@ how long to wait for a response before giving up." (get-buffer-process asynch-buffer)))))) ;; On timeouts, make sure we kill any pending processes. ;; There may be more than one if we had a redirect. - (when (process-live-p proc) - (delete-process proc)) - (when-let ((aproc (get-buffer-process asynch-buffer))) - (when (process-live-p aproc) - (delete-process aproc))))) + (when timed-out + (when (process-live-p proc) + (delete-process proc)) + (when-let ((aproc (get-buffer-process asynch-buffer))) + (when (process-live-p aproc) + (delete-process aproc)))))) asynch-buffer)) ;; url-mm-callback called from url-mm, which requires mm-decode. |