From 7a24cff1b2be9068a7c578360f6b51236105d98b Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Sun, 19 Jul 2020 23:12:54 +0200 Subject: [PATCH] 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). --- lisp/url/url.el | 18 +++++++++++------- 1 file 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. -- 2.39.5