mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-12 09:28:24 +00:00
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.
This commit is contained in:
parent
97ecff0783
commit
234ef3b432
4
etc/NEWS
4
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
|
||||
|
||||
---
|
||||
|
@ -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."
|
||||
|
@ -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?")
|
||||
|
Loading…
Reference in New Issue
Block a user