master 3a6129e723 3/3: Make eww work better on Tramp HTML

[Lars Ingebrigtsen]

branch: master
commit 3a6129e723943e499009a7d40b38ee9eec17c8ad
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    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 cfebb108a5..700a6c3e82 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 6e0af06bed..2a4fa9ceb0 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 31e5c07234..60a79425a3 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))))