Compute User-Agent dynamically in url-http

* url-http.el (url-http-user-agent-string): Compute User-Agent
string dynamically.
(url-http--user-agent-default-string): New function.

* url-vars.el (url-privacy-level): Allow `emacs' in list of
information not to send.
(url-user-agent): Add nil and `default' options; do not
pre-compute value.

diff --git a/etc/NEWS b/etc/NEWS
index 0a2641f75b3c6b4a2afacdddae32011c1b7388eb..d0afb8462a9d90f07bbe9062f694e56407dfd42a 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -284,6 +284,10 @@ domain.
 
 *** The URL package now support https over proxies supporting CONNECT.
 
+---
+*** `url-user-agent' now defaults to `default', and the User-Agent
+string is computed dynamically based on `url-privacy-level'.
+
 ** VC and related modes
 
 ---

diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 1fe9ac25555a3d8d7458e793d610b2640b9c2807..23cd69590dc722160e77b471594fce22de69ebe5 100644 (file)
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -222,15 +222,36 @@ request.")
     (if connection
        (url-http-mark-connection-as-busy host port connection))))
 
+(defun url-http--user-agent-default-string ()
+  "Compute a default User-Agent string based on `url-privacy-level'."
+  (let ((package-info (when url-package-name
+                        (format "%s/%s" url-package-name url-package-version)))
+        (emacs-info (unless (and (listp url-privacy-level)
+                                 (memq 'emacs url-privacy-level))
+                      (format "Emacs/%s" emacs-version)))
+        (os-info (unless (and (listp url-privacy-level)
+                              (memq 'os url-privacy-level))
+                   (format "(%s; %s)" url-system-type url-os-type)))
+        (url-info (format "URL/%s" url-version)))
+    (string-join (delq nil (list package-info url-info
+                                 emacs-info os-info))
+                 " ")))
+
 ;; Building an HTTP request
 (defun url-http-user-agent-string ()
-  (if (or (eq url-privacy-level 'paranoid)
-         (and (listp url-privacy-level)
-              (memq 'agent url-privacy-level)))
-      ""
-    (if (functionp url-user-agent)
-        (funcall url-user-agent)
-      url-user-agent)))
+  "Compute a User-Agent string.
+The string is based on `url-privacy-level' and `url-user-agent'."
+  (let* ((hide-ua
+          (or (eq url-privacy-level 'paranoid)
+              (and (listp url-privacy-level)
+                   (memq 'agent url-privacy-level))))
+         (ua-string
+          (and (not hide-ua)
+               (cond
+                ((functionp url-user-agent) (funcall url-user-agent))
+                ((stringp url-user-agent) url-user-agent)
+                ((eq url-user-agent 'default) (url-http--user-agent-default-string))))))
+    (if ua-string (format "User-Agent: %s\r\n" (string-trim ua-string)) "")))
 
 (defun url-http-create-request (&optional ref-url)
   "Create an HTTP request for `url-http-target-url', referred to by REF-URL."

diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el
index 960a04ad30fe2547c000c1c6e521697690189ce3..f6aae21a838ccf93f0c31d02ad19816dc75f726d 100644 (file)
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -116,6 +116,7 @@ If a list, this should be a list of symbols of what NOT to send.
 Valid symbols are:
 email    -- the email address
 os       -- the operating system info
+emacs    -- the version of Emacs
 lastloc  -- the last location
 agent    -- do not send the User-Agent string
 cookies  -- never accept HTTP cookies
@@ -143,6 +144,7 @@ variable."
                (checklist :tag "Custom"
                           (const :tag "Email address" :value email)
                           (const :tag "Operating system" :value os)
+                          (const :tag "Emacs version" :value emacs)
                           (const :tag "Last location" :value lastloc)
                           (const :tag "Browser identification" :value agent)
                           (const :tag "No cookies" :value cookie)))
@@ -357,16 +359,21 @@ Currently supported methods:
                (const :tag "Direct connection" :value native))
   :group 'url-hairy)
 
-(defcustom url-user-agent (format "User-Agent: %sURL/%s\r\n"
-                                 (if url-package-name
-                                     (concat url-package-name "/"
-                                             url-package-version " ")
-                                   "") url-version)
-  "User Agent used by the URL package for HTTP/HTTPS requests
-Should be a string or a function of no arguments returning a string."
-  :type '(choice (string :tag "A static User-Agent string")
-                 (function :tag "Call a function to get the User-Agent string"))
-  :version "25.1"
+(defcustom url-user-agent 'default
+  "User Agent used by the URL package for HTTP/HTTPS requests.
+Should be one of:
+* A string (not including the \"User-Agent:\" prefix)
+* A function of no arguments, returning a string
+* `default' (to compute a value according to `url-privacy-level')
+* nil (to omit the User-Agent header entirely)"
+  :type
+  '(choice
+    (string :tag "A static User-Agent string")
+    (function :tag "Call a function to get the User-Agent string")
+    (const :tag "No User-Agent at all" :value nil)
+    (const :tag "An string auto-generated according to `url-privacy-level'"
+           :value default))
+  :version "25.2"
   :group 'url)
 
 (defvar url-setup-done nil "Has setup configuration been done?")