From 3375d08299bbc1e224d19a871012cdbbf5d787ee Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 22 Mar 2019 14:38:06 +0100 Subject: [PATCH] Fix Bug#24394, Bug#34172 * lisp/subr.el (process-file-shell-command): Use `with-connection-local-variables'. Do not set "/bin/sh" for remote buffers, trust settings of `shell-file-name'. * lisp/net/tramp-adb.el (tramp-methods) : * lisp/net/tramp-smb.el (tramp-methods) : Remove `tramp-remote-shell' and `tramp-remote-shell-args'. * lisp/net/tramp-sh.el (tramp-sh-handle-file-notify-add-watch) (tramp-maybe-open-connection): Use proper read syntax for function names. * lisp/net/tramp.el (tramp-handle-shell-command): Do not use shell file names from `tramp-methods'. Respect `async-shell-command-buffer'. (Bug#24394, Bug#34172) Use `start-file-process-shell-command' and `process-file-shell-command'. * test/lisp/net/tramp-tests.el (tramp-test32-shell-command): Let it run partly for tramp-adb. --- lisp/net/tramp-adb.el | 3 -- lisp/net/tramp-sh.el | 4 +- lisp/net/tramp-smb.el | 4 -- lisp/net/tramp.el | 72 +++++++++++++++++++++++------------- lisp/subr.el | 10 ++--- test/lisp/net/tramp-tests.el | 16 ++++++-- 6 files changed, 66 insertions(+), 43 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 632ad12667d..8eeaa8be415 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -78,9 +78,6 @@ It is used for TCP/IP devices." (tramp--with-startup (add-to-list 'tramp-methods `(,tramp-adb-method - ;; Used in `tramp-handle-shell-command'. - (tramp-remote-shell "/system/bin/sh") - (tramp-remote-shell-args ("-c")) (tramp-tmpdir "/data/local/tmp") (tramp-default-port 5555))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index d9edcb14198..2b4399f8de7 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3619,7 +3619,7 @@ Fall back to normal file name handler if no Tramp handler exists." sequence `(,command "monitor" ,localname))) ;; "gvfs-monitor-dir". ((setq command (tramp-get-remote-gvfs-monitor-dir v)) - (setq filter 'tramp-sh-gvfs-monitor-dir-process-filter + (setq filter #'tramp-sh-gvfs-monitor-dir-process-filter events (cond ((and (memq 'change flags) (memq 'attribute-change flags)) @@ -4886,7 +4886,7 @@ connection if a previous connection has died for some reason." (list tramp-encoding-shell)))))) ;; Set sentinel and query flag. Initialize variables. - (set-process-sentinel p 'tramp-process-sentinel) + (set-process-sentinel p #'tramp-process-sentinel) (process-put p 'vector vec) (process-put p 'adjust-window-size-function #'ignore) (set-process-query-on-exit-flag p nil) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index e6e2485ea0f..66476305c2b 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -41,10 +41,6 @@ (tramp--with-startup (add-to-list 'tramp-methods `(,tramp-smb-method - ;; We define an empty command, because - ;; `tramp-smb-call-winexe' opens already the powershell. - ;; Used in `tramp-handle-shell-command'. - (tramp-remote-shell "") ;; This is just a guess. We don't know whether the share "C$" ;; is available for public use, and whether the user has write ;; access. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 97ec5e174b4..48c363a873a 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3569,17 +3569,7 @@ support symbolic links." (command &optional output-buffer error-buffer) "Like `shell-command' for Tramp files." (let* ((asynchronous (string-match-p "[ \t]*&[ \t]*\\'" command)) - ;; We cannot use `shell-file-name' and `shell-command-switch', - ;; they are variables of the local host. - (args (append - (cons - (tramp-get-method-parameter - (tramp-dissect-file-name default-directory) - 'tramp-remote-shell) - (tramp-get-method-parameter - (tramp-dissect-file-name default-directory) - 'tramp-remote-shell-args)) - (list (substring command 0 asynchronous)))) + (command (substring command 0 asynchronous)) current-buffer-p (output-buffer (cond @@ -3596,19 +3586,48 @@ support symbolic links." (cond ((bufferp error-buffer) error-buffer) ((stringp error-buffer) (get-buffer-create error-buffer)))) - (buffer - (if (and (not asynchronous) error-buffer) - (with-parsed-tramp-file-name default-directory nil - (list output-buffer (tramp-make-tramp-temp-file v))) - output-buffer)) - (p (get-buffer-process output-buffer))) - - ;; Check whether there is another process running. Tramp does not - ;; support 2 (asynchronous) processes in parallel. + (bname (buffer-name output-buffer)) + (p (get-buffer-process output-buffer)) + buffer) + + ;; The following code is taken from `shell-command', slightly + ;; adapted. Shouldn't it be factored out? (when p - (if (yes-or-no-p "A command is running. Kill it? ") - (ignore-errors (kill-process p)) - (tramp-user-error p "Shell command in progress"))) + (cond + ((eq async-shell-command-buffer 'confirm-kill-process) + ;; If will kill a process, query first. + (if (yes-or-no-p + "A command is running in the default buffer. Kill it? ") + (kill-process p) + (tramp-user-error p "Shell command in progress"))) + ((eq async-shell-command-buffer 'confirm-new-buffer) + ;; If will create a new buffer, query first. + (if (yes-or-no-p + "A command is running in the default buffer. Use a new buffer? ") + (setq output-buffer (generate-new-buffer bname)) + (tramp-user-error p "Shell command in progress"))) + ((eq async-shell-command-buffer 'new-buffer) + ;; It will create a new buffer. + (setq output-buffer (generate-new-buffer bname))) + ((eq async-shell-command-buffer 'confirm-rename-buffer) + ;; If will rename the buffer, query first. + (if (yes-or-no-p + "A command is running in the default buffer. Rename it? ") + (progn + (with-current-buffer output-buffer + (rename-uniquely)) + (setq output-buffer (get-buffer-create bname))) + (tramp-user-error p "Shell command in progress"))) + ((eq async-shell-command-buffer 'rename-buffer) + ;; It will rename the buffer. + (with-current-buffer output-buffer + (rename-uniquely)) + (setq output-buffer (get-buffer-create bname))))) + + (setq buffer (if (and (not asynchronous) error-buffer) + (with-parsed-tramp-file-name default-directory nil + (list output-buffer (tramp-make-tramp-temp-file v))) + output-buffer)) (if current-buffer-p (progn @@ -3621,18 +3640,19 @@ support symbolic links." (if (and (not current-buffer-p) (integerp asynchronous)) (prog1 ;; Run the process. - (setq p (apply #'start-file-process "*Async Shell*" buffer args)) + (setq p (start-file-process-shell-command + "*Async Shell*" buffer command)) ;; Display output. (with-current-buffer output-buffer (display-buffer output-buffer '(nil (allow-no-window . t))) (setq mode-line-process '(":%s")) (shell-mode) (set-process-sentinel p #'shell-command-sentinel) - (set-process-filter p 'comint-output-filter))) + (set-process-filter p #'comint-output-filter))) (prog1 ;; Run the process. - (apply #'process-file (car args) nil buffer nil (cdr args)) + (process-file-shell-command command nil buffer nil) ;; Insert error messages if they were separated. (when (listp buffer) (with-current-buffer error-buffer diff --git a/lisp/subr.el b/lisp/subr.el index f48ca545c9d..6dc53cd7201 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3233,11 +3233,11 @@ discouraged." Similar to `call-process-shell-command', but calls `process-file'." (declare (advertised-calling-convention (command &optional infile buffer display) "24.5")) - (process-file - (if (file-remote-p default-directory) "/bin/sh" shell-file-name) - infile buffer display - (if (file-remote-p default-directory) "-c" shell-command-switch) - (mapconcat 'identity (cons command args) " "))) + ;; On remote hosts, the local `shell-file-name' might be useless. + (with-connection-local-variables + (process-file + shell-file-name infile buffer display shell-command-switch + (mapconcat 'identity (cons command args) " ")))) (defun call-shell-region (start end command &optional delete buffer) "Send text from START to END as input to an inferior shell running COMMAND. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index bf7cdfafabe..34b676ee324 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4065,7 +4065,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." "Check `shell-command'." :tags '(:expensive-test) (skip-unless (tramp--test-enabled)) - (skip-unless (tramp--test-sh-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. + (skip-unless (or (and (tramp--test-adb-p) (tramp--test-emacs27-p)) + (tramp--test-sh-p))) (dolist (quoted (if (tramp--test-expensive-test) '(nil t) '(nil))) (let ((tmp-name (tramp--test-make-temp-name nil quoted)) @@ -4093,6 +4096,8 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." ;; Cleanup. (ignore-errors (delete-file tmp-name))) + ;; tramp-adb.el is not fit yet for asynchronous processes. + (unless (tramp--test-adb-p) (unwind-protect (with-temp-buffer (write-region "foo" nil tmp-name) @@ -4119,8 +4124,10 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (buffer-string)))) ;; Cleanup. - (ignore-errors (delete-file tmp-name))) + (ignore-errors (delete-file tmp-name)))) + ;; tramp-adb.el is not fit yet for asynchronous processes. + (unless (tramp--test-adb-p) (unwind-protect (with-temp-buffer (write-region "foo" nil tmp-name) @@ -4148,7 +4155,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'." (buffer-string)))) ;; Cleanup. - (ignore-errors (delete-file tmp-name)))))) + (ignore-errors (delete-file tmp-name))))))) (defun tramp--test-shell-command-to-string-asynchronously (command) "Like `shell-command-to-string', but for asynchronous processes." @@ -5705,6 +5712,9 @@ Since it unloads Tramp, it shall be the last test to run." ;; do not work properly for `nextcloud'. ;; * Fix `tramp-test29-start-file-process' and ;; `tramp-test30-make-process' on MS Windows (`process-send-eof'?). +;; * Fix `tramp-test29-start-file-process', +;; `tramp-test30-make-process' and `tramp-test32-shell-command' for +;; `adb' (see comment in `tramp-adb-send-command'). ;; * Fix Bug#16928 in `tramp-test43-asynchronous-requests'. (provide 'tramp-tests) -- 2.39.5