From b49c1740105dd3715315aa433674c95f44aaeac4 Mon Sep 17 00:00:00 2001 From: Po Lu Date: Thu, 4 Aug 2022 15:52:03 +0800 Subject: [PATCH] Fix about:protocols in EWW * lisp/net/eww.el (eww--dwim-expand-url): Handle `about: ' URLs. (bug#56885) * lisp/url/url-about.el (url-about): Return correct content type for HTML data. * lisp/url/url-http.el (url-http--get-referer): Refrain from looking for a referrer if the lastloc had no host. --- lisp/net/eww.el | 3 +++ lisp/url/url-about.el | 2 +- lisp/url/url-http.el | 48 +++++++++++++++++++++++-------------------- 3 files changed, 30 insertions(+), 23 deletions(-) diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 4dbd5de2ef7..beb8e0c45d5 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -450,6 +450,9 @@ For more information, see Info node `(eww) Top'." ;; Don't mangle file: URLs at all. ((string-match-p "\\`ftp://" url) (user-error "FTP is not supported")) + ((string-match-p "\\`about:" url) + ;; Treat this as an about: url. (bug#56885) + url) (t ;; Anything that starts with something that vaguely looks ;; like a protocol designator is interpreted as a full URL. diff --git a/lisp/url/url-about.el b/lisp/url/url-about.el index a50986d511a..ee94fde8b4c 100644 --- a/lisp/url/url-about.el +++ b/lisp/url/url-about.el @@ -93,7 +93,7 @@ (if (fboundp func) (progn (set-buffer (generate-new-buffer " *about-data*")) - (insert "Content-type: text/plain\n\n") + (insert "Content-type: text/html\n\n") (funcall func url) (current-buffer)) (error "URL does not know about `%s'" item)))) diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 125f8436f68..e2d28974b66 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -237,28 +237,32 @@ request.") (if (not (url-p url-current-lastloc)) (setq url-current-lastloc (url-generic-parse-url url-current-lastloc))) (let ((referer (copy-sequence url-current-lastloc))) - (setf (url-host referer) (puny-encode-domain (url-host referer))) - (let ((referer-string (url-recreate-url referer))) - (when (and (not (memq url-privacy-level '(low high paranoid))) - (not (and (listp url-privacy-level) - (memq 'lastloc url-privacy-level)))) - ;; url-privacy-level allows referer. But url-lastloc-privacy-level - ;; may restrict who we send it to. - (cl-case url-lastloc-privacy-level - (host-match - (let ((referer-host (url-host referer)) - (url-host (url-host url))) - (when (string= referer-host url-host) - referer-string))) - (domain-match - (let ((referer-domain (url-domain referer)) - (url-domain (url-domain url))) - (when (and referer-domain - url-domain - (string= referer-domain url-domain)) - referer-string))) - (otherwise - referer-string))))))) + ;; In the case of `url-about', there is actually no host. + (if (url-host referer) + (progn + (setf (url-host referer) (puny-encode-domain (url-host referer))) + (let ((referer-string (url-recreate-url referer))) + (when (and (not (memq url-privacy-level '(low high paranoid))) + (not (and (listp url-privacy-level) + (memq 'lastloc url-privacy-level)))) + ;; url-privacy-level allows referer. But url-lastloc-privacy-level + ;; may restrict who we send it to. + (cl-case url-lastloc-privacy-level + (host-match + (let ((referer-host (url-host referer)) + (url-host (url-host url))) + (when (string= referer-host url-host) + referer-string))) + (domain-match + (let ((referer-domain (url-domain referer)) + (url-domain (url-domain url))) + (when (and referer-domain + url-domain + (string= referer-domain url-domain)) + referer-string))) + (otherwise + referer-string))))) + nil)))) ;; Building an HTTP request (defun url-http-user-agent-string () -- 2.39.5