Improve Tramp's process-file implementations

* lisp/net/tramp-adb.el (tramp-adb-handle-process-file)
* lisp/net/tramp-sh.el (tramp-sh-handle-process-file):
* lisp/net/tramp-smb.el (tramp-smb-handle-process-file):
* lisp/net/tramp-sshfs.el (tramp-sshfs-handle-process-file):
Improve implementation.  (Bug#53854)

* test/lisp/net/tramp-tests.el (tramp-test28-process-file)
(tramp--test-check-files, tramp-test47-unload): Extend tests.

5 files changed, 153 insertions, 40 deletions

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 85cd2d9bc1e..c683f4c6e8a 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -818,7 +818,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
         (setq infile (tramp-compat-file-name-unquote (expand-file-name infile)))
         (if (tramp-equal-remote default-directory infile)
             ;; INFILE is on the same remote host.
-            (setq input (tramp-file-local-name infile))
+            (setq input (tramp-unquote-file-local-name infile))
           ;; INFILE must be copied to remote host.
           (setq input (tramp-make-tramp-temp-file v)
                 tmpinput (tramp-make-tramp-file-name v input))
@@ -849,7 +849,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
           (setcar (cdr destination) (expand-file-name (cadr destination)))
           (if (tramp-equal-remote default-directory (cadr destination))
               ;; stderr is on the same remote host.
-              (setq stderr (tramp-file-local-name (cadr destination)))
+              (setq stderr (tramp-unquote-file-local-name (cadr destination)))
             ;; stderr must be copied to remote host.  The temporary
             ;; file must be deleted after execution.
             (setq stderr (tramp-make-tramp-temp-file v)
@@ -1264,7 +1264,7 @@ connection if a previous connection has died for some reason."
         (if (zerop (length device))
             (tramp-error vec 'file-error "Device %s not connected" host))
         (with-tramp-progress-reporter vec 3 "Opening adb shell connection"
-          (let* ((coding-system-for-read 'utf-8-dos) ;is this correct?
+          (let* ((coding-system-for-read 'utf-8-dos)  ; Is this correct?
                  (process-connection-type tramp-process-connection-type)
                  (args (if (> (length host) 0)
                            (list "-s" device "shell")
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index ea089224aef..40ddf106c99 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -3118,7 +3118,7 @@ implementation will be used."
         (setq infile (tramp-compat-file-name-unquote (expand-file-name infile)))
         (if (tramp-equal-remote default-directory infile)
             ;; INFILE is on the same remote host.
-            (setq input (tramp-file-local-name infile))
+            (setq input (tramp-unquote-file-local-name infile))
           ;; INFILE must be copied to remote host.
           (setq input (tramp-make-tramp-temp-file v)
                 tmpinput (tramp-make-tramp-file-name v input))
@@ -3149,7 +3149,7 @@ implementation will be used."
           (setcar (cdr destination) (expand-file-name (cadr destination)))
           (if (tramp-equal-remote default-directory (cadr destination))
               ;; stderr is on the same remote host.
-              (setq stderr (tramp-file-local-name (cadr destination)))
+              (setq stderr (tramp-unquote-file-local-name (cadr destination)))
             ;; stderr must be copied to remote host.  The temporary
             ;; file must be deleted after execution.
             (setq stderr (tramp-make-tramp-temp-file v)
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 6515519680c..f52fa0a93be 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1284,7 +1284,7 @@ component is used as the target of the symlink."
         (setq infile (tramp-compat-file-name-unquote (expand-file-name infile)))
         (if (tramp-equal-remote default-directory infile)
             ;; INFILE is on the same remote host.
-            (setq input (tramp-file-local-name infile))
+            (setq input (tramp-unquote-file-local-name infile))
           ;; INFILE must be copied to remote host.
           (setq input (tramp-make-tramp-temp-file v)
                 tmpinput (tramp-make-tramp-file-name v input))
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index 664dbc31b14..3f23b1a8786 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -240,12 +240,13 @@ arguments to pass to the OPERATION."
     (error "Implementation does not handle immediate return"))
 
   (with-parsed-tramp-file-name (expand-file-name default-directory) nil
-    (let ((command
+    (let ((coding-system-for-read 'utf-8-dos)  ; Is this correct?
+          (command
            (format
             "cd %s && exec %s"
             (tramp-unquote-shell-quote-argument localname)
             (mapconcat #'tramp-shell-quote-argument (cons program args) " ")))
-          input tmpinput)
+          input tmpinput stderr tmpstderr outbuf)
 
       ;; Determine input.
       (if (null infile)
@@ -253,18 +254,55 @@ arguments to pass to the OPERATION."
         (setq infile (tramp-compat-file-name-unquote (expand-file-name infile)))
         (if (tramp-equal-remote default-directory infile)
             ;; INFILE is on the same remote host.
-            (setq input (tramp-file-local-name infile))
+            (setq input (tramp-unquote-file-local-name infile))
           ;; INFILE must be copied to remote host.
           (setq input (tramp-make-tramp-temp-file v)
                 tmpinput (tramp-make-tramp-file-name v input))
           (copy-file infile tmpinput t)))
       (when input (setq command (format "%s <%s" command input)))
 
+      ;; Determine output.
+      (cond
+       ;; Just a buffer.
+       ((bufferp destination)
+        (setq outbuf destination))
+       ;; A buffer name.
+       ((stringp destination)
+        (setq outbuf (get-buffer-create destination)))
+       ;; (REAL-DESTINATION ERROR-DESTINATION)
+       ((consp destination)
+        ;; output.
+        (cond
+         ((bufferp (car destination))
+          (setq outbuf (car destination)))
+         ((stringp (car destination))
+          (setq outbuf (get-buffer-create (car destination))))
+         ((car destination)
+          (setq outbuf (current-buffer))))
+        ;; stderr.
+        (cond
+         ((stringp (cadr destination))
+          (setcar (cdr destination) (expand-file-name (cadr destination)))
+          (if (tramp-equal-remote default-directory (cadr destination))
+              ;; stderr is on the same remote host.
+              (setq stderr (tramp-unquote-file-local-name (cadr destination)))
+            ;; stderr must be copied to remote host.  The temporary
+            ;; file must be deleted after execution.
+            (setq stderr (tramp-make-tramp-temp-file v)
+                  tmpstderr (tramp-make-tramp-file-name v stderr))))
+         ;; stderr to be discarded.
+         ((null (cadr destination))
+          (setq stderr (tramp-get-remote-null-device v)))))
+       ;; 't
+       (destination
+        (setq outbuf (current-buffer))))
+      (when stderr (setq command (format "%s 2>%s" command stderr)))
+
       (unwind-protect
           (apply
            #'tramp-call-process
            v (tramp-get-method-parameter v 'tramp-login-program)
-           nil destination display
+           nil outbuf display
            (tramp-expand-args
             v 'tramp-login-args
             ?h (or (tramp-file-name-host v) "")
@@ -272,6 +310,15 @@ arguments to pass to the OPERATION."
             ?p (or (tramp-file-name-port v) "")
             ?l command))
 
+        ;; Synchronize stderr.
+        (when tmpstderr
+          (tramp-cleanup-connection v 'keep-debug 'keep-password)
+          (tramp-fuse-unmount v))
+
+        ;; Provide error file.
+        (when tmpstderr
+          (rename-file tmpstderr (cadr destination) t))
+
         ;; Cleanup.  We remove all file cache values for the
         ;; connection, because the remote process could have changed
         ;; them.
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index d78e8815b25..baddcd2d7ac 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -4398,6 +4398,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
     (let* ((tmp-name (tramp--test-make-temp-name nil quoted))
            (fnnd (file-name-nondirectory tmp-name))
            (default-directory tramp-test-temporary-file-directory)
+           (buffer (get-buffer-create "*tramp-tests*"))
            kill-buffer-query-functions)
       (unwind-protect
           (progn
@@ -4430,31 +4431,47 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
                    (tramp--test-shell-file-name)
                    nil nil nil "-c" "kill -2 $$")))))
 
-            (with-temp-buffer
-              (write-region "foo" nil tmp-name)
-              (should (file-exists-p tmp-name))
-              (should (zerop (process-file "ls" nil t nil fnnd)))
-              ;; "ls" could produce colorized output.
-              (goto-char (point-min))
-              (while
-                  (re-search-forward tramp-display-escape-sequence-regexp nil t)
-                (replace-match "" nil nil))
-              (should (string-equal (format "%s\n" fnnd) (buffer-string)))
-              (should-not (get-buffer-window (current-buffer) t))
+            ;; Check DESTINATION.
+            (dolist (destination `(nil t ,buffer))
+              (when (bufferp destination)
+                (with-current-buffer destination
+                  (delete-region (point-min) (point-max))))
+              (with-temp-buffer
+                (write-region "foo" nil tmp-name)
+                (should (file-exists-p tmp-name))
+                (should (zerop (process-file "ls" nil destination nil fnnd)))
+                (with-current-buffer
+                    (if (bufferp destination) destination (current-buffer))
+                  ;; "ls" could produce colorized output.
+                  (goto-char (point-min))
+                  (while (re-search-forward
+                          tramp-display-escape-sequence-regexp nil t)
+                    (replace-match "" nil nil))
+                  (should
+                   (string-equal (if destination (format "%s\n" fnnd) "")
+                                 (buffer-string)))
+                  (should-not (get-buffer-window (current-buffer) t))
+                  (goto-char (point-max)))
+
+                ;; Second run.  The output must be appended.
+                (should (zerop (process-file "ls" nil destination t fnnd)))
+                (with-current-buffer
+                    (if (bufferp destination) destination (current-buffer))
+                  ;; "ls" could produce colorized output.
+                  (goto-char (point-min))
+                  (while (re-search-forward
+                          tramp-display-escape-sequence-regexp nil t)
+                    (replace-match "" nil nil))
+                  (should
+                   (string-equal
+                    (if destination (format "%s\n%s\n" fnnd fnnd) "")
+                    (buffer-string))))
 
-              ;; Second run.  The output must be appended.
-              (goto-char (point-max))
-              (should (zerop (process-file "ls" nil t t fnnd)))
-              ;; "ls" could produce colorized output.
-              (goto-char (point-min))
-              (while
-                  (re-search-forward tramp-display-escape-sequence-regexp nil t)
-                (replace-match "" nil nil))
-              (should
-               (string-equal (format "%s\n%s\n" fnnd fnnd) (buffer-string)))
-              ;; A non-nil DISPLAY must not raise the buffer.
-              (should-not (get-buffer-window (current-buffer) t))
-              (delete-file tmp-name))
+                (unless (eq destination t)
+                  (should (string-empty-p (buffer-string))))
+                ;; A non-nil DISPLAY must not raise the buffer.
+                (should-not (get-buffer-window (current-buffer) t))
+                (delete-file tmp-name)))
 
             ;; Check remote and local INFILE.
             (dolist (local '(nil t))
@@ -4464,10 +4481,37 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
                 (should (file-exists-p tmp-name))
                 (should (zerop (process-file "cat" tmp-name t)))
                 (should (string-equal "foo" (buffer-string)))
-                (should-not (get-buffer-window (current-buffer) t)))
-              (delete-file tmp-name)))
+                (should-not (get-buffer-window (current-buffer) t))
+                (delete-file tmp-name)))
+
+            ;; Check remote and local DESTNATION file.  This isn't
+            ;; implemented yet ina all file name handler backends.
+            ;; (dolist (local '(nil t))
+            ;;   (setq tmp-name (tramp--test-make-temp-name local quoted))
+            ;;   (should
+            ;;    (zerop (process-file "echo" nil `(:file ,tmp-name) nil "foo")))
+            ;;   (with-temp-buffer
+            ;;  (insert-file-contents tmp-name)
+            ;;  (should (string-equal "foo" (buffer-string)))
+            ;;  (should-not (get-buffer-window (current-buffer) t))
+            ;;  (delete-file tmp-name)))
+
+            ;; Check remote and local STDERR.
+            (dolist (local '(nil t))
+              (setq tmp-name (tramp--test-make-temp-name local quoted))
+              (should-not
+               (zerop
+                (process-file "cat" nil `(t ,tmp-name) nil "/does-not-exist")))
+              (with-temp-buffer
+                (insert-file-contents tmp-name)
+                (should
+                 (string-match-p
+                  "cat:.* No such file or directory" (buffer-string)))
+                (should-not (get-buffer-window (current-buffer) t))
+                (delete-file tmp-name))))
 
         ;; Cleanup.
+        (ignore-errors (kill-buffer buffer))
         (ignore-errors (delete-file tmp-name))))))
 
 ;; Must be a command, because used as `sigusr1' handler.
@@ -6479,7 +6523,13 @@ This requires restrictions of file name syntax."
                 ;; `default-directory' with special characters.  See
                 ;; Bug#53846.
                 (when (and (tramp--test-expensive-test-p)
-                           (tramp--test-supports-processes-p))
+                           (tramp--test-supports-processes-p)
+                           ;; Prior Emacs 27, `shell-file-name' was
+                           ;; hard coded as "/bin/sh" for remote
+                           ;; processes in Emacs.  That doesn't work
+                           ;; for tramp-adb.el.
+                           (or (not (tramp--test-adb-p))
+                               (tramp--test-emacs27-p)))
                   (let ((default-directory file1))
                     (dolist (this-shell-command
                              (append
@@ -7207,17 +7257,20 @@ Since it unloads Tramp, it shall be the last test to run."
   (should (featurep 'tramp-archive))
   ;; This unloads also tramp-archive.el and tramp-theme.el if needed.
   (unload-feature 'tramp 'force)
-  ;; No Tramp feature must be left.
+
+  ;; No Tramp feature must be left except the test packages.
   (should-not (featurep 'tramp))
   (should-not (featurep 'tramp-archive))
   (should-not (featurep 'tramp-theme))
   (should-not
    (all-completions
     "tramp" (delq 'tramp-tests (delq 'tramp-archive-tests features))))
+
   ;; `file-name-handler-alist' must be clean.
   (should-not (all-completions "tramp" (mapcar #'cdr file-name-handler-alist)))
+
   ;; There shouldn't be left a bound symbol, except buffer-local
-  ;; variables, and autoload functions.  We do not regard our test
+  ;; variables, and autoloaded functions.  We do not regard our test
   ;; symbols, and the Tramp unload hooks.
   (mapatoms
    (lambda (x)
@@ -7231,6 +7284,7 @@ Since it unloads Tramp, it shall be the last test to run."
           (not (string-match-p "unload-hook$" (symbol-name x)))
           (not (get x 'tramp-autoload))
           (ert-fail (format "`%s' still bound" x)))))
+
   ;; The defstruct `tramp-file-name' and all its internal functions
   ;; shall be purged.
   (should-not (cl--find-class 'tramp-file-name))
@@ -7239,6 +7293,7 @@ Since it unloads Tramp, it shall be the last test to run."
      (and (functionp x)
           (string-match-p "tramp-file-name" (symbol-name x))
           (ert-fail (format "Structure function `%s' still exists" x)))))
+
   ;; There shouldn't be left a hook function containing a Tramp
   ;; function.  We do not regard the Tramp unload hooks.
   (mapatoms
@@ -7248,7 +7303,18 @@ Since it unloads Tramp, it shall be the last test to run."
           (not (string-match-p "unload-hook$" (symbol-name x)))
           (consp (symbol-value x))
           (ignore-errors (all-completions "tramp" (symbol-value x)))
-          (ert-fail (format "Hook `%s' still contains Tramp function" x))))))
+          (ert-fail (format "Hook `%s' still contains Tramp function" x)))))
+
+  ;; There shouldn't be left an advice function from Tramp.
+  (mapatoms
+   (lambda (x)
+     (and (functionp x)
+          (advice-mapc
+           (lambda (fun _symbol)
+             (and (string-match-p "^tramp" (symbol-name fun))
+                  (ert-fail
+                   (format "Function `%s' still contains Tramp advice" x))))
+           x)))))
 
 (defun tramp-test-all (&optional interactive)
   "Run all tests for \\[tramp].