From 3a6129e723943e499009a7d40b38ee9eec17c8ad Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Sun, 20 Feb 2022 16:08:45 +0100
Subject: [PATCH] Make eww work better on Tramp HTML
* lisp/net/eww.el (eww-open-file): Use it.
(eww-browse-url): Ditto.
* lisp/net/shr.el (shr-expand-url): Allow loading relative Tramp
files if we're reading from a file:// document.
* lisp/url/url-file.el (url-allow-non-local-files): New user option
(bug#40425).
---
lisp/net/eww.el | 18 ++++++++----------
lisp/net/shr.el | 6 ++++--
lisp/url/url-file.el | 9 ++++++++-
3 files changed, 20 insertions(+), 13 deletions(-)
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index cfebb108a5b..700a6c3e82f 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -32,6 +32,7 @@
(require 'thingatpt)
(require 'url)
(require 'url-queue)
+(require 'url-file)
(require 'xdg)
(eval-when-compile (require 'subr-x))
@@ -487,15 +488,11 @@ killed after rendering."
(defun eww-open-file (file)
"Render FILE using EWW."
(interactive "fFile: ")
- (eww (concat "file://"
- (and (memq system-type '(windows-nt ms-dos))
- "/")
- (expand-file-name file))
- nil
- ;; The file name may be a non-local Tramp file. The URL
- ;; library doesn't understand these file names, so use the
- ;; normal Emacs machinery to load the file.
- (eww--file-buffer file)))
+ (let ((url-allow-non-local-files t))
+ (eww (concat "file://"
+ (and (memq system-type '(windows-nt ms-dos))
+ "/")
+ (expand-file-name file)))))
(defun eww--file-buffer (file)
(with-current-buffer (generate-new-buffer " *eww file*")
@@ -1207,7 +1204,8 @@ instead of `browse-url-new-window-flag'."
(format "*eww-%s*" (url-host (url-generic-parse-url
(eww--dwim-expand-url url))))))
(eww-mode))
- (eww url))
+ (let ((url-allow-non-local-files t))
+ (eww url)))
(defun eww-back-url ()
"Go to the previously displayed page."
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 6e0af06bed1..2a4fa9ceb0c 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -877,8 +877,10 @@ size, and full-buffer size."
;; A link to an anchor.
(concat (nth 3 base) url))
(t
- ;; Totally relative.
- (url-expand-file-name url (concat (car base) (cadr base))))))
+ ;; Totally relative. Allow Tramp file names if we're
+ ;; rendering a file:// URL.
+ (let ((url-allow-non-local-files (equal (nth 2 base) "file")))
+ (url-expand-file-name url (concat (car base) (cadr base)))))))
(defun shr-ensure-newline ()
(unless (bobp)
diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index 31e5c07234c..60a79425a3f 100644
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -29,6 +29,12 @@
(require 'url-dired)
(declare-function mm-disable-multibyte "mm-util" ())
+(defvar url-allow-non-local-files nil
+ "If non-nil, allow URL to fetch non-local files.
+By default, this is not allowed, since that would allow rendering
+HTML to fetch files on other systems if given a <img
+src=\"/ssh:host...\"> element, which can be disturbing.")
+
(defconst url-file-default-port 21 "Default FTP port.")
(defconst url-file-asynchronous-p t "FTP transfers are asynchronous.")
(defalias 'url-file-expand-file-name 'url-default-expander)
@@ -111,7 +117,8 @@ to them."
(memq system-type '(ms-dos windows-nt)))
(substring file 1))
;; file: URL with a file:/bar:/foo-like spec.
- ((string-match "\\`/[^/]+:/" file)
+ ((and (not url-allow-non-local-files)
+ (string-match "\\`/[^/]+:/" file))
(concat "/:" file))
(t
file))))
--
2.39.5