master 6536112: Handle sensitive auto-save or backup remote files (Bug#45245)

[Michael Albinus]

branch: master
commit 6536112bdce592eed9f3d71022aafbe6be44da45
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Handle sensitive auto-save or backup remote files (Bug#45245)
    
    * doc/misc/tramp.texi (Auto-save and Backup):
    Describe tramp-allow-unsafe-temporary-files.
    (Ad-hoc multi-hops): Use proper format.
    
    * etc/NEWS: Mention confirmation for writing sensitive auto-save
    or backup remote files to the local temporary directory..
    
    * lisp/net/tramp-cache.el (tramp-dump-connection-properties):
    Strengthen test.
    
    * lisp/net/tramp.el (tramp-allow-unsafe-temporary-files): New defcustom.
    (tramp-handle-find-backup-file-name)
    (tramp-handle-make-auto-save-file-name): Don't expose sensible
    auto-save or backup files on local temporary directory.  (Bug#45245)
    
    * test/lisp/net/tramp-tests.el (tramp--test-always): New defalias.
    (tramp-test10-write-region, tramp-test21-file-links)
    (tramp--test--deftest-direct-async-process): Use it.
    (tramp-test37-make-auto-save-file-name)
    (tramp-test38-find-backup-file-name): Extend tests.
---
 doc/misc/tramp.texi          |  17 ++++---
 etc/NEWS                     |   7 ++-
 lisp/net/tramp-cache.el      |   7 +--
 lisp/net/tramp-sh.el         |   3 +-
 lisp/net/tramp.el            | 103 +++++++++++++++++++++++++++++--------------
 test/lisp/net/tramp-tests.el |  85 +++++++++++++++++++++++++++++++----
 6 files changed, 169 insertions(+), 53 deletions(-)

diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index e5a0bb9..6ef9459 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -1261,7 +1261,7 @@ uses @file{@trampfn{mtp,,}} as the default name.
 As the name indicates, the method @option{nextcloud} allows you to
 access OwnCloud or NextCloud hosted files and directories.  Like the
 @option{gdrive} method, your credentials must be populated in your
-@command{Online Accounts} application outside Emacs. The method
+@command{Online Accounts} application outside Emacs.  The method
 supports port numbers.
 
 @item @option{sftp}
@@ -2842,6 +2842,13 @@ auto-saved files to the same directory as the original 
file.
 Alternatively, set the user option @code{tramp-auto-save-directory}
 to direct all auto saves to that location.
 
+@vindex tramp-allow-unsafe-temporary-files
+Per default, @value{tramp} asks for confirmation if a
+@samp{root}-owned backup or auto-save remote file has to be written to
+your local temporary directory.  If you want to suppress this
+confirmation question, set user option
+@code{tramp-allow-unsafe-temporary-files} to @code{t}.
+
 
 @node Keeping files encrypted
 @section Protect remote files by encryption
@@ -3309,12 +3316,12 @@ For ad-hoc definitions to be saved automatically in
 
 Ad-hoc proxies can take patterns @code{%h} or @code{%u} like in
 @code{tramp-default-proxies-alist}.  The following file name expands
-to user @code{root} on host @code{remotehost}, starting with an
-@option{ssh} session on host @code{remotehost}:
+to user @samp{root} on host @samp{remotehost}, starting with an
+@option{ssh} session on host @samp{remotehost}:
 
@samp{@value{prefix}ssh@value{postfixhop}%h|su@value{postfixhop}remotehost@value{postfix}}.
 
 On the other hand, if a trailing hop does not specify a host name,
-the host name of the previous hop is reused. Therefore, the following
+the host name of the previous hop is reused.  Therefore, the following
 file name is equivalent to the previous example:
 
@samp{@value{prefix}ssh@value{postfixhop}remotehost|su@value{postfixhop}@value{postfix}}.
 
@@ -5294,7 +5301,7 @@ attributes cache in its process sentinel with this code:
 @end lisp
 
 Since @value{tramp} traverses subdirectories starting with the
-root-directory, it is most likely sufficient to make the
+root directory, it is most likely sufficient to make the
 @code{default-directory} of the process buffer as the root directory.
 
 
diff --git a/etc/NEWS b/etc/NEWS
index 4fe95dd..367cd59 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -605,7 +605,7 @@ These options include 'windmove-default-keybindings',
 ** Windows
 
 +++
-*** New option 'delete-window-choose-selected'.
+*** New user option 'delete-window-choose-selected'.
 This allows to choose a frame's selected window after deleting the
 previously selected one.
 
@@ -1403,6 +1403,11 @@ When non-nil, this user option instructs Tramp to mirror 
the debug
 buffer to a file under the "/tmp/" directory.  This is useful, if (in
 rare cases) Tramp blocks Emacs, and we need further debug information.
 
++++
+*** Writing sensitive auto-save or backup files to the local temporary
+directory must be confirmed.  In order to suppress this confirmation,
+set user option 'tramp-allow-unsafe-temporary-files' to t.
+
 ** Tempo
 
 ---
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index fdde7fb..a41620a 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -70,7 +70,8 @@
 ;;   process key retrieved by `tramp-get-process' (the main connection
 ;;   process).  Other processes could reuse these properties, avoiding
 ;;   recomputation when a new asynchronous process is created by
-;;   `make-process'.  Examples are "remote-path" or "device" (tramp-adb.el).
+;;   `make-process'.  Examples are "remote-path",
+;;   "unsafe-temporary-file" or "device" (tramp-adb.el).
 
 ;;; Code:
 
@@ -470,11 +471,11 @@ used to cache connection properties of the local machine."
        ;; don't save either, because all other properties might
        ;; depend on the login name, and we want to give the
        ;; possibility to use another login name later on.  Key
-       ;; "started" exists for the "ftp" method only, which must be
+       ;; "started" exists for the "ftp" method only, which must not
        ;; be kept persistent.
        (maphash
         (lambda (key value)
-          (if (and (tramp-file-name-p key) value
+          (if (and (tramp-file-name-p key) (hash-table-p value)
                    (not (string-equal
                          (tramp-file-name-method key) tramp-archive-method))
                    (not (tramp-file-name-localname key))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 29ed944..b613ad3 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -5296,8 +5296,7 @@ Nonexistent directories are removed from spec."
        ;; cache the result for the session only.  Otherwise, the
        ;; result is cached persistently.
        (if (memq 'tramp-own-remote-path tramp-remote-path)
-           (tramp-get-process vec)
-         vec)
+           (tramp-get-process vec) vec)
        "remote-path"
       (let* ((remote-path (copy-tree tramp-remote-path))
             (elt1 (memq 'tramp-default-remote-path remote-path))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 838464e..5284981 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3627,6 +3627,11 @@ User is always nil."
        (and (file-directory-p (file-name-directory filename))
             (file-writable-p (file-name-directory filename)))))))
 
+(defcustom tramp-allow-unsafe-temporary-files nil
+  "Whether root-owned auto-save or backup files can be written to \"/tmp\"."
+  :version "28.1"
+  :type 'boolean)
+
 (defun tramp-handle-find-backup-file-name (filename)
   "Like `find-backup-file-name' for Tramp files."
   (with-parsed-tramp-file-name filename nil
@@ -3642,8 +3647,25 @@ User is always nil."
                       (tramp-make-tramp-file-name v (cdr x))
                     (cdr x))))
                tramp-backup-directory-alist)
-            backup-directory-alist)))
-      (tramp-run-real-handler #'find-backup-file-name (list filename)))))
+            backup-directory-alist))
+         (uid (tramp-compat-file-attribute-user-id
+               (file-attributes filename 'integer)))
+         result)
+      (prog1 ;; Run plain `find-backup-file-name'.
+         (setq result
+               (tramp-run-real-handler
+                #'find-backup-file-name (list filename)))
+        ;; Protect against security hole.
+       (when (and (natnump uid) (zerop uid)
+                  (file-in-directory-p (car result) temporary-file-directory)
+                  (not tramp-allow-unsafe-temporary-files)
+                  (not (with-tramp-connection-property
+                           (tramp-get-process v) "unsafe-temporary-file"
+                         (yes-or-no-p
+                          (concat
+                           "Backup file on local temporary directory, "
+                           "do you want to continue? ")))))
+         (tramp-error v 'file-error "Unsafe backup file name"))))))
 
 (defun tramp-handle-insert-directory
   (filename switches &optional wildcard full-directory-p)
@@ -5225,37 +5247,52 @@ Return the local name of the temporary file."
   "Like `make-auto-save-file-name' for Tramp files.
 Returns a file name in `tramp-auto-save-directory' for autosaving
 this file, if that variable is non-nil."
-  (when (stringp tramp-auto-save-directory)
-    (setq tramp-auto-save-directory
-         (expand-file-name tramp-auto-save-directory)))
-  ;; Create directory.
-  (unless (or (null tramp-auto-save-directory)
-             (file-exists-p tramp-auto-save-directory))
-    (make-directory tramp-auto-save-directory t))
-
-  (let ((system-type
-        (if (and (stringp tramp-auto-save-directory)
-                 (tramp-tramp-file-p tramp-auto-save-directory))
-            'not-windows
-          system-type))
-       (auto-save-file-name-transforms
-        (if (null tramp-auto-save-directory)
-            auto-save-file-name-transforms))
-       (buffer-file-name
-        (if (null tramp-auto-save-directory)
-            buffer-file-name
-          (expand-file-name
-           (tramp-subst-strs-in-string
-            '(("_" . "|")
-              ("/" . "_a")
-              (":" . "_b")
-              ("|" . "__")
-              ("[" . "_l")
-              ("]" . "_r"))
-            (tramp-compat-file-name-unquote (buffer-file-name)))
-           tramp-auto-save-directory))))
-    ;; Run plain `make-auto-save-file-name'.
-    (tramp-run-real-handler #'make-auto-save-file-name nil)))
+  (with-parsed-tramp-file-name buffer-file-name nil
+    (when (stringp tramp-auto-save-directory)
+      (setq tramp-auto-save-directory
+           (expand-file-name tramp-auto-save-directory)))
+    ;; Create directory.
+    (unless (or (null tramp-auto-save-directory)
+               (file-exists-p tramp-auto-save-directory))
+      (make-directory tramp-auto-save-directory t))
+
+    (let ((system-type
+          (if (and (stringp tramp-auto-save-directory)
+                   (tramp-tramp-file-p tramp-auto-save-directory))
+              'not-windows
+            system-type))
+         (auto-save-file-name-transforms
+          (if (null tramp-auto-save-directory)
+              auto-save-file-name-transforms))
+         (uid (tramp-compat-file-attribute-user-id
+               (file-attributes buffer-file-name 'integer)))
+         (buffer-file-name
+          (if (null tramp-auto-save-directory)
+              buffer-file-name
+            (expand-file-name
+             (tramp-subst-strs-in-string
+              '(("_" . "|")
+                ("/" . "_a")
+                (":" . "_b")
+                ("|" . "__")
+                ("[" . "_l")
+                ("]" . "_r"))
+              (tramp-compat-file-name-unquote (buffer-file-name)))
+             tramp-auto-save-directory)))
+         result)
+      (prog1 ;; Run plain `make-auto-save-file-name'.
+         (setq result (tramp-run-real-handler #'make-auto-save-file-name nil))
+       ;; Protect against security hole.
+       (when (and (natnump uid) (zerop uid)
+                  (file-in-directory-p result temporary-file-directory)
+                  (not tramp-allow-unsafe-temporary-files)
+                  (not (with-tramp-connection-property
+                           (tramp-get-process v) "unsafe-temporary-file"
+                         (yes-or-no-p
+                          (concat
+                           "Autosave file on local temporary directory, "
+                           "do you want to continue? ")))))
+         (tramp-error v 'file-error "Unsafe autosave file name"))))))
 
 (defun tramp-subst-strs-in-string (alist string)
   "Replace all occurrences of the string FROM with TO in STRING.
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 5e4626a..37cd701 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -229,6 +229,16 @@ is greater than 10.
        "%s %f sec"
        ,message (float-time (time-subtract (current-time) start))))))
 
+;; `always' is introduced with Emacs 28.1.
+(defalias 'tramp--test-always
+  (if (fboundp 'always)
+      #'always
+    (lambda (&rest _arguments)
+      "Do nothing and return t.
+This function accepts any number of ARGUMENTS, but ignores them.
+Also see `ignore'."
+      t)))
+
 (ert-deftest tramp-test00-availability ()
   "Test availability of Tramp functions."
   :expected-result (if (tramp--test-enabled) :passed :failed)
@@ -2454,9 +2464,9 @@ This checks also `file-name-as-directory', 
`file-name-directory',
                        tramp--test-messages))))))))
 
            ;; Do not overwrite if excluded.
-           (cl-letf (((symbol-function #'y-or-n-p) (lambda (_prompt) t))
+           (cl-letf (((symbol-function #'y-or-n-p) #'tramp--test-always)
                      ;; Ange-FTP.
-                     ((symbol-function 'yes-or-no-p) (lambda (_prompt) t)))
+                     ((symbol-function 'yes-or-no-p) #'tramp--test-always))
              (write-region "foo" nil tmp-name nil nil nil 'mustbenew))
            ;; `mustbenew' is passed to Tramp since Emacs 26.1.
            (when (tramp--test-emacs26-p)
@@ -3671,7 +3681,7 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
                (should-error
                 (make-symbolic-link tmp-name1 tmp-name2 0)
                 :type 'file-already-exists)))
-           (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_prompt) t)))
+           (cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always))
              (make-symbolic-link tmp-name1 tmp-name2 0)
              (should
               (string-equal
@@ -3747,7 +3757,7 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
               (should-error
                (add-name-to-file tmp-name1 tmp-name2 0)
                :type 'file-already-exists))
-            (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_prompt) t)))
+            (cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always))
               (add-name-to-file tmp-name1 tmp-name2 0)
               (should (file-regular-p tmp-name2)))
             (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists)
@@ -4545,7 +4555,7 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
 If UNSTABLE is non-nil, the test is tagged as `:unstable'."
   (declare (indent 1))
   ;; `make-process' supports file name handlers since Emacs 27.
-  (when (let ((file-name-handler-alist '(("" . (lambda (&rest _) t)))))
+  (when (let ((file-name-handler-alist '(("" . #'tramp--test-always))))
          (ignore-errors (make-process :file-handler t)))
     `(ert-deftest ,(intern (concat (symbol-name test) "-direct-async")) ()
        ,docstring
@@ -4561,7 +4571,7 @@ If UNSTABLE is non-nil, the test is tagged as 
`:unstable'."
         ;; `file-truename' does it by side-effect.  Suppress
         ;; `tramp--test-enabled', in order to keep the connection.
         ;; Suppress "Process ... finished" messages.
-        (cl-letf (((symbol-function #'tramp--test-enabled) (lambda nil t))
+        (cl-letf (((symbol-function #'tramp--test-enabled) 
#'tramp--test-always)
                   ((symbol-function #'internal-default-process-sentinel)
                    #'ignore))
           (file-truename tramp-test-temporary-file-directory)
@@ -5554,11 +5564,38 @@ Use direct async.")
                         ("]" . "_r"))
                       (tramp-compat-file-name-unquote tmp-name1)))
                     tmp-name2)))
-                 (should (file-directory-p tmp-name2))))))
+                 (should (file-directory-p tmp-name2)))))
+
+           ;; Create temporary file.  This shall check for sensible
+           ;; files, owned by root.
+           (let ((tramp-auto-save-directory temporary-file-directory)
+                 tramp-allow-unsafe-temporary-files)
+             (write-region "foo" nil tmp-name1)
+             (when (zerop (or (tramp-compat-file-attribute-user-id
+                               (file-attributes tmp-name1))
+                              tramp-unknown-id-integer))
+               (with-temp-buffer
+                 (setq buffer-file-name tmp-name1)
+                 (tramp-cleanup-connection
+                  tramp-test-vec 'keep-debug 'keep-password)
+                 (let ((tramp-allow-unsafe-temporary-files t))
+                   (should (stringp (make-auto-save-file-name))))
+                 (tramp-cleanup-connection
+                  tramp-test-vec 'keep-debug 'keep-password)
+                 (cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
+                   (should-error
+                    (make-auto-save-file-name)
+                    :type 'file-error))
+                 (tramp-cleanup-connection
+                  tramp-test-vec 'keep-debug 'keep-password)
+                 (cl-letf (((symbol-function #'yes-or-no-p)
+                            #'tramp--test-always))
+                   (should (stringp (make-auto-save-file-name))))))))
 
        ;; Cleanup.
        (ignore-errors (delete-file tmp-name1))
-       (ignore-errors (delete-directory tmp-name2 'recursive))))))
+       (ignore-errors (delete-directory tmp-name2 'recursive))
+       (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))))
 
 (ert-deftest tramp-test38-find-backup-file-name ()
   "Check `find-backup-file-name'."
@@ -5672,7 +5709,37 @@ Use direct async.")
              (should (file-directory-p tmp-name2))))
 
        ;; Cleanup.
-       (ignore-errors (delete-directory tmp-name2 'recursive))))))
+       (ignore-errors (delete-directory tmp-name2 'recursive)))
+
+      (unwind-protect
+         ;; Create temporary file.  This shall check for sensible
+         ;; files, owned by root.
+         (let ((backup-directory-alist `(("." . ,temporary-file-directory)))
+               tramp-allow-unsafe-temporary-files
+               tramp-backup-directory-alist)
+           (write-region "foo" nil tmp-name1)
+           (when (zerop (or (tramp-compat-file-attribute-user-id
+                             (file-attributes tmp-name1))
+                            tramp-unknown-id-integer))
+             (tramp-cleanup-connection
+              tramp-test-vec 'keep-debug 'keep-password)
+             (let ((tramp-allow-unsafe-temporary-files t))
+               (should (stringp (car (find-backup-file-name tmp-name1)))))
+             (tramp-cleanup-connection
+              tramp-test-vec 'keep-debug 'keep-password)
+             (cl-letf (((symbol-function #'yes-or-no-p) #'ignore))
+               (should-error
+                (find-backup-file-name tmp-name1)
+                :type 'file-error))
+             (tramp-cleanup-connection
+              tramp-test-vec 'keep-debug 'keep-password)
+             (cl-letf (((symbol-function #'yes-or-no-p)
+                        #'tramp--test-always))
+               (should (stringp (car (find-backup-file-name tmp-name1)))))))
+
+       ;; Cleanup.
+       (ignore-errors (delete-file tmp-name1))
+       (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))))
 
 ;; The functions were introduced in Emacs 26.1.
 (ert-deftest tramp-test39-make-nearby-temp-file ()