master ecb5ebf: Improve make-process in Tramp

[Michael Albinus]

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

    Improve make-process in Tramp
    
    * doc/misc/tramp.texi (Remote processes): Remove INSIDE_EMACS
    restriction.
    (Frequently Asked Questions, External packages): Add indices.
    
    * etc/NEWS: 'start-process-shell-command' and
    'start-file-process-shell-command' do not support the old calling
    conventions any longer.
    
    * lisp/subr.el (start-process-shell-command)
    (start-file-process-shell-command): Remove old calling conventions.
    
    * lisp/net/tramp-compat.el (remote-file-error): Remove, it isn't
    necessary.
    
    * lisp/net/tramp.el (tramp-handle-make-process): Remove special shell
    handling.  Support environment variables.
    
    * test/lisp/net/tramp-tests.el
    (tramp--test--deftest-direct-async-process): Skip for mock method.
    (tramp--test-async-shell-command): Suppress `shell-command-sentinel'.
    (tramp-test32-shell-command, tramp-test33-environment-variables):
    Adapt tests.
    (tramp-test32-shell-command-direct-async)
    (tramp-test33-environment-variables-direct-async): New tests.
---
 doc/misc/tramp.texi          |   7 +--
 etc/NEWS                     |   8 +++-
 lisp/net/tramp-compat.el     |   5 --
 lisp/net/tramp.el            |  32 ++++++++-----
 lisp/subr.el                 |  19 ++------
 test/lisp/net/tramp-tests.el | 108 +++++++++++++++++++++++++------------------
 6 files changed, 100 insertions(+), 79 deletions(-)

diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 0557ca5..dd350f1 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -3584,9 +3584,6 @@ It does not set process property @code{remote-pid}.
 @item
 It does not use @code{tramp-remote-path} and
 @code{tramp-remote-process-environment}.
-
-@item
-It does not set environment variable @env{INSIDE_EMACS}.
 @end itemize
 
 In order to gain even more performance, it is recommended to bind
@@ -4880,6 +4877,8 @@ In case you have installed it from its Git repository, 
@ref{Recompilation}.
 @item
 I get an error @samp{Remote file error: Forbidden reentrant call of Tramp}
 
+@vindex remote-file-error
+@vindex debug-ignored-errors
 Timers, process filters and sentinels, and other event based functions
 can run at any time, when a remote file operation is still running.
 This can cause @value{tramp} to block.  When such a situation is
@@ -5021,6 +5020,7 @@ bind it to non-@code{nil} value.
 
 @subsection File attributes cache
 
+@vindex process-file-side-effects
 Keeping a local cache of remote file attributes in sync with the
 remote host is a time-consuming operation.  Flushing and re-querying
 these attributes can tax @value{tramp} to a grinding halt on busy
@@ -5061,6 +5061,7 @@ root-directory, it is most likely sufficient to make the
 
 @subsection Timers
 
+@vindex remote-file-error
 Timers run asynchronously at any time when Emacs is waiting for
 sending a string to a process, or waiting for process output.  They
 can run any remote file operation, which would conflict with the
diff --git a/etc/NEWS b/etc/NEWS
index 1b4c21c..7411295 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1482,7 +1482,7 @@ This new option allows the user to customize how case is 
converted
 when unifying entries.
 
 ---
-*** The user option `bibtex-maintain-sorted-entries' now permits
+*** The user option 'bibtex-maintain-sorted-entries' now permits
 user-defined sorting schemes.
 
 +++
@@ -2170,6 +2170,7 @@ and 'play-sound-file'.
 If this variable is non-nil, character syntax is used for printing
 numbers when this makes sense, such as '?A' for 65.
 
++++
 ** New error 'remote-file-error', a subcategory of 'file-error'.
 It is signaled if a remote file operation fails due to internal
 reasons, and could block Emacs.  It does not replace 'file-error'
@@ -2182,6 +2183,7 @@ Until it is solved you could ignore such errors by 
performing
 
     (setq debug-ignored-errors (cons 'remote-file-error debug-ignored-errors))
 
++++
 ** The error 'ftp-error' belongs also to category 'remote-file-error'.
 
 +++
@@ -2193,6 +2195,10 @@ buffer does not run the hooks 'kill-buffer-hook',
 avoids slowing down internal or temporary buffers that are never
 presented to users or passed on to other applications.
 
+---
+** 'start-process-shell-command' and 'start-file-process-shell-command'
+do not support the old calling conventions any longer.
+
 
 * Changes in Emacs 28.1 on Non-Free Operating Systems
 
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 4c8d37d..b44eabc 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -348,11 +348,6 @@ A nil value for either argument stands for the current 
time."
     (lambda (fromstring tostring instring)
       (replace-regexp-in-string (regexp-quote fromstring) tostring instring))))
 
-;; Error symbol `remote-file-error' is defined in Emacs 28.1.  We use
-;; an adapted error message in order to see that compatible symbol.
-(unless (get 'remote-file-error 'error-conditions)
-  (define-error 'remote-file-error "Remote file error (compat)" 'file-error))
-
 (add-hook 'tramp-unload-hook
          (lambda ()
            (unload-feature 'tramp-loaddefs 'force)
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 6c1c09b..4d8118a 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3790,23 +3790,31 @@ It does not support `:stderr'."
        (unless (or (null stderr) (bufferp stderr))
          (signal 'wrong-type-argument (list #'bufferp stderr)))
 
-       ;; Quote shell command.
-       (when (and (= (length command) 3)
-                  (stringp (nth 0 command))
-                  (string-match-p "sh$" (nth 0 command))
-                  (stringp (nth 1 command))
-                  (string-equal "-c" (nth 1 command))
-                  (stringp (nth 2 command)))
-         (setcar (cddr command) (tramp-shell-quote-argument (nth 2 command))))
-
        (let* ((buffer
                (if buffer
                    (get-buffer-create buffer)
                  ;; BUFFER can be nil.  We use a temporary buffer.
                  (generate-new-buffer tramp-temp-buffer-name)))
+              ;; We use as environment the difference to toplevel
+              ;; `process-environment'.
+              (env (mapcar
+                    (lambda (elt)
+                      (unless
+                          (member
+                           elt (default-toplevel-value 'process-environment))
+                        (when (string-match-p "=" elt) elt)))
+                    process-environment))
+              (env (setenv-internal
+                    env "INSIDE_EMACS"
+                    (concat (or (getenv "INSIDE_EMACS") emacs-version)
+                            ",tramp:" tramp-version)
+                    'keep))
+              (env (mapcar #'tramp-shell-quote-argument (delq nil env)))
+              ;; Quote command.
+              (command (mapconcat #'tramp-shell-quote-argument command " "))
+              ;; Set cwd and environment variables.
               (command
-               (mapconcat
-                #'identity (append `("cd" ,localname "&&") command) " ")))
+               (append `("cd" ,localname "&&" "(" "env") env `(,command ")"))))
 
          ;; Check for `tramp-sh-file-name-handler', because something
          ;; is different between tramp-adb.el and tramp-sh.el.
@@ -3861,7 +3869,7 @@ It does not support `:stderr'."
              (mapcar (lambda (x) (split-string x " ")) login-args))
             p (make-process
                :name name :buffer buffer
-               :command (append `(,login-program) login-args `(,command))
+               :command (append `(,login-program) login-args command)
                :coding coding :noquery noquery :connection-type connection-type
                :filter filter :sentinel sentinel :stderr stderr))
 
diff --git a/lisp/subr.el b/lisp/subr.el
index 7461fa2..cb64b3f 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -3560,7 +3560,7 @@ Do nothing if FACE is nil."
 
 ;;;; Synchronous shell commands.
 
-(defun start-process-shell-command (name buffer &rest args)
+(defun start-process-shell-command (name buffer command)
   "Start a program in a subprocess.  Return the process object for it.
 NAME is name for process.  It is modified if necessary to make it unique.
 BUFFER is the buffer (or buffer name) to associate with the process.
@@ -3568,27 +3568,18 @@ BUFFER is the buffer (or buffer name) to associate with 
the process.
  an output stream or filter function to handle the output.
  BUFFER may be also nil, meaning that this process is not associated
  with any buffer
-COMMAND is the shell command to run.
-
-An old calling convention accepted any number of arguments after COMMAND,
-which were just concatenated to COMMAND.  This is still supported but strongly
-discouraged."
-  (declare (advertised-calling-convention (name buffer command) "23.1"))
+COMMAND is the shell command to run."
   ;; We used to use `exec' to replace the shell with the command,
   ;; but that failed to handle (...) and semicolon, etc.
-  (start-process name buffer shell-file-name shell-command-switch
-                (mapconcat 'identity args " ")))
+  (start-process name buffer shell-file-name shell-command-switch command))
 
-(defun start-file-process-shell-command (name buffer &rest args)
+(defun start-file-process-shell-command (name buffer command)
   "Start a program in a subprocess.  Return the process object for it.
 Similar to `start-process-shell-command', but calls `start-file-process'."
-  (declare (advertised-calling-convention (name buffer command) "23.1"))
   ;; On remote hosts, the local `shell-file-name' might be useless.
   (with-connection-local-variables
    (start-file-process
-    name buffer
-    shell-file-name shell-command-switch
-    (mapconcat 'identity args " "))))
+    name buffer shell-file-name shell-command-switch command)))
 
 (defun call-process-shell-command (command &optional infile buffer display
                                           &rest args)
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 0a5931d..9dd9803 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -4459,6 +4459,7 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
                (should-error
                 (start-file-process "test4" (current-buffer) nil)
                 :type 'wrong-type-argument)
+
              (setq proc (start-file-process "test4" (current-buffer) nil))
              (should (processp proc))
              (should (equal (process-status proc) 'run))
@@ -4483,6 +4484,8 @@ If UNSTABLE is non-nil, the test is tagged as 
`:unstable'."
           (tramp-connection-properties
            (cons '(nil "direct-async-process" t) tramp-connection-properties)))
        (skip-unless (tramp-direct-async-process-p))
+       ;; For whatever reason, it doesn't cooperate with the "mock" method.
+       (skip-unless (not (tramp--test-mock-p)))
        ;; We do expect an established connection already,
        ;; `file-truename' does it by side-effect.  Suppress
        ;; `tramp--test-enabled', in order to keep the connection.
@@ -4703,12 +4706,14 @@ INPUT, if non-nil, is a string sent to the process."
   (async-shell-command command output-buffer error-buffer)
   (let ((proc (get-buffer-process output-buffer))
        (delete-exited-processes t))
-    (when (stringp input)
-      (process-send-string proc input))
-    (with-timeout
-       ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler))
-      (while (or (accept-process-output proc nil nil t) (process-live-p 
proc))))
-    (accept-process-output proc nil nil t)))
+    (cl-letf (((symbol-function #'shell-command-sentinel) #'ignore))
+      (when (stringp input)
+       (process-send-string proc input))
+      (with-timeout
+         ((if (getenv "EMACS_EMBA_CI") 30 10) (tramp--test-timeout-handler))
+       (while
+           (or (accept-process-output proc nil nil t) (process-live-p proc))))
+      (accept-process-output proc nil nil t))))
 
 (defun tramp--test-shell-command-to-string-asynchronously (command)
   "Like `shell-command-to-string', but for asynchronous processes."
@@ -4762,19 +4767,20 @@ INPUT, if non-nil, is a string sent to the process."
          (ignore-errors (delete-file tmp-name)))
 
        ;; Test `{async-}shell-command' with error buffer.
-       (let ((stderr (generate-new-buffer "*stderr*")))
-         (unwind-protect
-             (with-temp-buffer
-               (funcall
-                this-shell-command
-                "echo foo >&2; echo bar" (current-buffer) stderr)
-               (should (string-equal "bar\n" (buffer-string)))
-               ;; Check stderr.
-               (with-current-buffer stderr
-                 (should (string-equal "foo\n" (buffer-string)))))
+       (unless (tramp-direct-async-process-p)
+         (let ((stderr (generate-new-buffer "*stderr*")))
+           (unwind-protect
+               (with-temp-buffer
+                 (funcall
+                  this-shell-command
+                  "echo foo >&2; echo bar" (current-buffer) stderr)
+                 (should (string-equal "bar\n" (buffer-string)))
+                 ;; Check stderr.
+                 (with-current-buffer stderr
+                   (should (string-equal "foo\n" (buffer-string)))))
 
-           ;; Cleanup.
-           (ignore-errors (kill-buffer stderr)))))
+             ;; Cleanup.
+             (ignore-errors (kill-buffer stderr))))))
 
       ;; Test sending string to `async-shell-command'.
       (unwind-protect
@@ -4810,6 +4816,9 @@ INPUT, if non-nil, is a string sent to the process."
       (when (natnump cols)
        (should (= cols async-shell-command-width))))))
 
+(tramp--test--deftest-direct-async-process tramp-test32-shell-command
+  "Check direct async `shell-command'.")
+
 ;; This test is inspired by Bug#39067.
 (ert-deftest tramp-test32-shell-command-dont-erase-buffer ()
   "Check `shell-command-dont-erase-buffer'."
@@ -4961,7 +4970,7 @@ INPUT, if non-nil, is a string sent to the process."
       (should
        (string-equal
        (format "%s,tramp:%s\n" emacs-version tramp-version)
-       (funcall this-shell-command-to-string "echo ${INSIDE_EMACS:-bla}")))
+       (funcall this-shell-command-to-string "echo \"${INSIDE_EMACS:-bla}\"")))
       (let ((process-environment
             (cons (format "INSIDE_EMACS=%s,foo" emacs-version)
                   process-environment)))
@@ -4969,7 +4978,7 @@ INPUT, if non-nil, is a string sent to the process."
         (string-equal
          (format "%s,foo,tramp:%s\n" emacs-version tramp-version)
          (funcall
-          this-shell-command-to-string "echo ${INSIDE_EMACS:-bla}"))))
+          this-shell-command-to-string "echo \"${INSIDE_EMACS:-bla}\""))))
 
       ;; Set a value.
       (let ((process-environment
@@ -4979,7 +4988,8 @@ INPUT, if non-nil, is a string sent to the process."
         (string-match
          "foo"
          (funcall
-          this-shell-command-to-string (format "echo ${%s:-bla}" envvar)))))
+          this-shell-command-to-string
+          (format "echo \"${%s:-bla}\"" envvar)))))
 
       ;; Set the empty value.
       (let ((process-environment
@@ -4989,38 +4999,45 @@ INPUT, if non-nil, is a string sent to the process."
         (string-match
          "bla"
          (funcall
-          this-shell-command-to-string (format "echo ${%s:-bla}" envvar))))
+          this-shell-command-to-string (format "echo \"${%s:-bla}\"" envvar))))
        ;; Variable is set.
        (should
         (string-match
          (regexp-quote envvar)
          (funcall this-shell-command-to-string "set"))))
 
-      ;; We force a reconnect, in order to have a clean environment.
-      (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
-      ;; Unset the variable.
-      (let ((tramp-remote-process-environment
-            (cons (concat envvar "=foo") tramp-remote-process-environment)))
-       ;; Set the initial value, we want to unset below.
-       (should
-        (string-match
-         "foo"
-         (funcall
-          this-shell-command-to-string (format "echo ${%s:-bla}" envvar))))
-       (let ((process-environment (cons envvar process-environment)))
-         ;; Variable is unset.
+      (unless (tramp-direct-async-process-p)
+       ;; We force a reconnect, in order to have a clean environment.
+       (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+       ;; Unset the variable.
+       (let ((tramp-remote-process-environment
+              (cons (concat envvar "=foo") tramp-remote-process-environment)))
+         ;; Set the initial value, we want to unset below.
          (should
           (string-match
-           "bla"
-           (funcall
-            this-shell-command-to-string (format "echo ${%s:-bla}" envvar))))
-         ;; Variable is unset.
-         (should-not
-          (string-match
-           (regexp-quote envvar)
-           ;; We must remove PS1, the output is truncated otherwise.
+           "foo"
            (funcall
-            this-shell-command-to-string "printenv | grep -v PS1"))))))))
+            this-shell-command-to-string
+            (format "echo \"${%s:-bla}\"" envvar))))
+         (let ((process-environment (cons envvar process-environment)))
+           ;; Variable is unset.
+           (should
+            (string-match
+             "bla"
+             (funcall
+              this-shell-command-to-string
+              (format "echo \"${%s:-bla}\"" envvar))))
+           ;; Variable is unset.
+           (should-not
+            (string-match
+             (regexp-quote envvar)
+             ;; We must remove PS1, the output is truncated otherwise.
+             (funcall
+              this-shell-command-to-string "printenv | grep -v PS1")))))))))
+
+(tramp--test--deftest-direct-async-process tramp-test33-environment-variables
+  "Check that remote processes set / unset environment variables properly.
+Use direct async.")
 
 ;; This test is inspired by Bug#27009.
 (ert-deftest tramp-test33-environment-variables-and-port-numbers ()
@@ -6432,6 +6449,9 @@ process sentinels.  They shall not disturb each other."
         (ignore-errors (cancel-timer timer))
         (ignore-errors (delete-directory tmp-name 'recursive))))))
 
+;; (tramp--test--deftest-direct-async-process 
tramp-test43-asynchronous-requests
+;;   "Check parallel direct asynchronous requests.")
+
 ;; This test is inspired by Bug#29163.
 (ert-deftest tramp-test44-auto-load ()
   "Check that Tramp autoloads properly."