1
0
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:
Clément Pit--Claudel 2016-04-24 14:51:33 +02:00 committed by Lars Magne Ingebrigtsen
parent 97ecff0783
commit 234ef3b432
3 changed files with 49 additions and 17 deletions

View File

@ -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
---

View File

@ -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."

View File

@ -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?")