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.

diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el
index 585010d21c50b3deac97ee0c3bafc1c549b7bb6b..dd658b1b68b45c62e9c0ec769827c5cd2352e3e7 100644 (file)
--- 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 16c3a6a1e6240528c18ad6b7fe980c66eaac3c99..daeba17031dd9c731db71cf5307e80c33291e435 100644 (file)
--- 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 152300bda55a67e6842e17c2af222b13088d1d9c..b2e24607e1172615e1eba9e7366fc8cfdc790785 100644 (file)
--- 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 83c089a930aa8e1ef1c506d75112b5636b550631..9e91bf0670e237a773374745d7eb039ac4f07598 100644 (file)
--- 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.")