master 56bdfe7820: Fix problem with fetching images via Cloudflare

[Lars Ingebrigtsen]

branch: master
commit 56bdfe78208149fa864842d47bfd08d1bc4d6d10
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Fix problem with fetching images via Cloudflare
    
    * lisp/url/url-http.el (url-http): Factor out url-interactive-p.
    * lisp/url/url-auth.el (url-basic-auth):
    (url-basic-auth):
    (url-digest-prompt-creds): Use it to not query the user.
    
    * lisp/url/url-queue.el (url-queue-start-retrieve): Don't send a
    bogus empty Authorization header (bug#54246) -- this triggers
    Cloudflare's anti-attack software.  Instead rely on
    url-request-noninteractive.
    
    * lisp/url/url-vars.el (url-interactive-p): New utility function.
---
 lisp/url/url-auth.el  | 26 ++++++++++++++++----------
 lisp/url/url-http.el  |  4 +---
 lisp/url/url-queue.el |  6 +-----
 lisp/url/url-vars.el  |  5 +++++
 4 files changed, 23 insertions(+), 18 deletions(-)

diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 585010d21c..dd658b1b68 100644
--- a/lisp/url/url-auth.el
+++ b/lisp/url/url-auth.el
@@ -87,11 +87,13 @@ instead of the filename inheritance method."
      ((and prompt (not byserv))
       (setq user (or
                  (url-do-auth-source-search server type :user)
-                 (read-string (url-auth-user-prompt href realm)
-                              (or user (user-real-login-name))))
+                  (and (url-interactive-p)
+                      (read-string (url-auth-user-prompt href realm)
+                                   (or user (user-real-login-name)))))
            pass (or
                  (url-do-auth-source-search server type :secret)
-                 (read-passwd "Password: " nil (or pass ""))))
+                  (and (url-interactive-p)
+                      (read-passwd "Password: " nil (or pass "")))))
       (set url-basic-auth-storage
           (cons (list server
                       (cons file
@@ -117,11 +119,13 @@ instead of the filename inheritance method."
          (progn
            (setq user (or
                        (url-do-auth-source-search server type :user)
-                       (read-string (url-auth-user-prompt href realm)
-                                    (user-real-login-name)))
+                        (and (url-interactive-p)
+                            (read-string (url-auth-user-prompt href realm)
+                                         (user-real-login-name))))
                  pass (or
                        (url-do-auth-source-search server type :secret)
-                       (read-passwd "Password: "))
+                        (and (url-interactive-p)
+                            (read-passwd "Password: ")))
                  retval (base64-encode-string (format "%s:%s" user pass) t)
                  byserv (assoc server (symbol-value url-basic-auth-storage)))
            (setcdr byserv
@@ -233,11 +237,13 @@ CREDS is a plist that may have properties `:user' and 
`:secret'."
   ;; plist-put modify the same plist.
   (setq creds
         (plist-put creds :user
-                   (read-string (url-auth-user-prompt url realm)
-                                (or (plist-get creds :user)
-                                    (user-real-login-name)))))
+                   (and (url-interactive-p)
+                        (read-string (url-auth-user-prompt url realm)
+                                     (or (plist-get creds :user)
+                                         (user-real-login-name))))))
   (plist-put creds :secret
-             (read-passwd "Password: " nil (plist-get creds :secret))))
+             (and (url-interactive-p)
+                  (read-passwd "Password: " nil (plist-get creds :secret)))))
 
 (defun url-digest-auth-directory-id-assoc (dirkey keylist)
   "Find the best match for DIRKEY in key alist KEYLIST.
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 16c3a6a1e6..daeba17031 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -1304,9 +1304,7 @@ The return value of this function is the retrieval 
buffer."
   (cl-check-type url url "Need a pre-parsed URL.")
   (let* (;; (host (url-host (or url-using-proxy url)))
         ;; (port (url-port (or url-using-proxy url)))
-        (nsm-noninteractive (or url-request-noninteractive
-                                (and (boundp 'url-http-noninteractive)
-                                     url-http-noninteractive)))
+        (nsm-noninteractive (not (url-interactive-p)))
          ;; The following binding is needed in url-open-stream, which
          ;; is called from url-http-find-free-connection.
          (url-current-object url)
diff --git a/lisp/url/url-queue.el b/lisp/url/url-queue.el
index 152300bda5..b2e24607e1 100644
--- a/lisp/url/url-queue.el
+++ b/lisp/url/url-queue.el
@@ -161,11 +161,7 @@ The variable `url-queue-timeout' sets a timeout."
                                    (url-queue-context-buffer job)
                                  (current-buffer))
            (let ((url-request-noninteractive t)
-                  (url-allow-non-local-files t)
-                  ;; This will disable querying the user for
-                  ;; credentials if one of the things we're fetching
-                  ;; in the background return a header requesting it.
-                  (url-request-extra-headers '(("Authorization" . ""))))
+                  (url-allow-non-local-files t))
               (url-retrieve (url-queue-url job)
                             #'url-queue-callback-function (list job)
                             (url-queue-silentp job)
diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index 83c089a930..9e91bf0670 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -424,6 +424,11 @@ Should be one of:
 This should be set, e.g. by mail user agents rendering HTML to avoid
 `bugs' which call home.")
 
+(defun url-interactive-p ()
+  "Say whether the current request is from a interactive context."
+  (not (or url-request-noninteractive
+           (bound-and-true-p 'url-http-noninteractive))))
+
 ;; Obsolete
 
 (defconst url-version "Emacs" "Version number of URL package.")