From: "Clément Pit--Claudel" <clement.pit@gmail.com>
To: Lars Magne Ingebrigtsen <larsi@gnus.org>
Cc: Emacs developers <emacs-devel@gnu.org>
Subject: Re: Help understanding the URL code
Date: Thu, 7 Apr 2016 18:00:02 +0100 [thread overview]
Message-ID: <57069212.6030701@gmail.com> (raw)
In-Reply-To: <m3k2k9wqdh.fsf@gnus.org>
[-- Attachment #1.1.1: Type: text/plain, Size: 314 bytes --]
On 04/07/2016 01:32 PM, Lars Magne Ingebrigtsen wrote:
> Looks good, I think. One little niggle:
>
> [...]
>
>> + (format "GNUEmacs/%s" emacs-version)))
>
> I think "Emacs" is better here. "GNUEmacs" looks very odd to me.
Thanks! Here is an updated patch.
Cheers,
Clément.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.1.2: 0001-Take-Emacs-and-package-versions-into-account-in-URL-.patch --]
[-- Type: text/x-diff; name="0001-Take-Emacs-and-package-versions-into-account-in-URL-.patch", Size: 5346 bytes --]
From 38849b1b513a51ffd754c3764b650c0c3428a173 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Cl=C3=A9ment=20Pit--Claudel?= <clement.pitclaudel@live.com>
Date: Thu, 7 Apr 2016 11:31:13 +0100
Subject: [PATCH] Take Emacs and package versions into account in URL's
User-Agent string
* 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.
* url-http.el (url-http-user-agent-string): Compute User-Agent string
dynamically.
(url-http--user-agent-default-string): New function.
The original code took `url-package-name' and `url-package-version' into
account only when url-vars.el was loaded; the new code takes them into
account in all cases, allowing users to let-bind them. It also adds
the current Emacs version to the User-Agent string.
---
lisp/url/url-http.el | 35 ++++++++++++++++++++++++++++-------
lisp/url/url-vars.el | 25 ++++++++++++++++---------
2 files changed, 44 insertions(+), 16 deletions(-)
diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el
index 5832e92..9077e62 100644
--- a/lisp/url/url-http.el
+++ b/lisp/url/url-http.el
@@ -211,15 +211,36 @@ url-http-find-free-connection
(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 960a04a..97dac9c 100644
--- a/lisp/url/url-vars.el
+++ b/lisp/url/url-vars.el
@@ -116,6 +116,7 @@ url-privacy-level
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 @@ url-privacy-level
(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,15 +359,20 @@ url-gateway-method
(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"))
+(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.1"
:group 'url)
--
2.8.1
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 836 bytes --]
next prev parent reply other threads:[~2016-04-07 17:00 UTC|newest]
Thread overview: 20+ messages / expand[flat|nested] mbox.gz Atom feed top
2016-04-05 15:37 Help understanding the URL code Clément Pit--Claudel
2016-04-05 16:54 ` Andreas Schwab
2016-04-06 11:34 ` Lars Magne Ingebrigtsen
2016-04-07 11:02 ` Clément Pit--Claudel
2016-04-07 12:32 ` Lars Magne Ingebrigtsen
2016-04-07 12:53 ` Andreas Schwab
2016-04-07 13:01 ` Lars Magne Ingebrigtsen
2016-04-07 13:02 ` Yuri Khan
2016-04-07 13:13 ` Andreas Schwab
2016-04-07 13:22 ` Stefan Monnier
2016-04-07 13:32 ` Andreas Schwab
2016-04-07 14:17 ` Stefan Monnier
2016-04-07 14:28 ` Andreas Schwab
2016-04-07 15:37 ` Stefan Monnier
2016-04-07 16:28 ` John Wiegley
2016-04-07 13:07 ` Stefan Monnier
2016-04-07 14:20 ` Drew Adams
2016-04-07 21:18 ` Richard Stallman
2016-04-07 17:00 ` Clément Pit--Claudel [this message]
2016-04-24 12:51 ` Lars Magne Ingebrigtsen
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=57069212.6030701@gmail.com \
--to=clement.pit@gmail.com \
--cc=emacs-devel@gnu.org \
--cc=larsi@gnus.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).