aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2023-04-26 18:06:39 +0200
committerMichael Albinus2023-04-26 18:06:39 +0200
commit022f50ebe616e04bb34487a26d529ca08954d287 (patch)
tree617a2abdf09c7f17931a850f9e53709f7327b9f6
parentd07815a7cc3540201afa06e3c80c061e9f497815 (diff)
downloademacs-022f50ebe616e04bb34487a26d529ca08954d287.tar.gz
emacs-022f50ebe616e04bb34487a26d529ca08954d287.zip
New command 'tramp-cleanup-some-buffers'
* doc/misc/tramp.texi (Cleanup remote connections): Document tramp-cleanup-some-buffers and tramp-cleanup-some-buffers-hook. * etc/NEWS: New command 'tramp-cleanup-some-buffers'. * lisp/net/tramp.el (tramp-handle-make-process): * lisp/net/tramp-adb.el (tramp-adb-handle-make-process): * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Use `tramp-taint-remote-process-buffer'. * lisp/net/tramp.el (tramp-post-process-creation): New defun. (tramp-handle-make-process): * lisp/net/tramp-adb.el (tramp-adb-maybe-open-connection): * lisp/net/tramp-crypt.el (tramp-crypt-maybe-open-connection): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-file-notify-add-watch) (tramp-gvfs-maybe-open-connection): * lisp/net/tramp-rclone.el (tramp-rclone-maybe-open-connection): * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-out-of-band) (tramp-sh-handle-file-notify-add-watch) (tramp-maybe-open-connection): * lisp/net/tramp-smb.el (tramp-smb-handle-copy-directory) (tramp-smb-handle-file-acl, tramp-smb-handle-set-file-acl) (tramp-smb-maybe-open-connection): * lisp/net/tramp-sshfs.el (tramp-sshfs-maybe-open-connection): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-maybe-open-connection) (tramp-sudoedit-send-command): Use it. * lisp/net/tramp-cmds.el (tramp-tainted-remote-process-buffers): New defvar. (tramp-cleanup-dired-buffer-p) (tramp-delete-tainted-remote-process-buffer-function) (kill-buffer-hook, tramp-cleanup-remote-process-p) (tramp-cleanup-some-buffers): New defuns. (tramp-cleanup-some-buffers-hook): New defcustom. Add `buffer-file-name', `tramp-cleanup-dired-buffer-p' and `tramp-cleanup-remote-process-p' to the hook. (kill-buffer-hook): Add `tramp-delete-tainted-remote-process-buffer-function'. (tramp-cleanup-all-buffers): Rework. * lisp/net/tramp-compat.el (tramp-compat-always): New defalias. * test/lisp/net/tramp-tests.el (tramp--test-always): Delete. (tramp-test10-write-region, tramp-test21-file-links) (tramp--test-deftest-direct-async-process) (tramp-test37-make-auto-save-file-name) (tramp-test38-find-backup-file-name) (tramp-test39-make-lock-file-name) (tramp-test39-detect-external-change): Use `tramp-compat-always'.
-rw-r--r--doc/misc/tramp.texi15
-rw-r--r--etc/NEWS7
-rw-r--r--lisp/net/tramp-adb.el9
-rw-r--r--lisp/net/tramp-cmds.el67
-rw-r--r--lisp/net/tramp-compat.el10
-rw-r--r--lisp/net/tramp-crypt.el3
-rw-r--r--lisp/net/tramp-gvfs.el9
-rw-r--r--lisp/net/tramp-rclone.el3
-rw-r--r--lisp/net/tramp-sh.el20
-rw-r--r--lisp/net/tramp-smb.el28
-rw-r--r--lisp/net/tramp-sshfs.el3
-rw-r--r--lisp/net/tramp-sudoedit.el8
-rw-r--r--lisp/net/tramp.el18
-rw-r--r--test/lisp/net/tramp-tests.el31
14 files changed, 139 insertions, 92 deletions
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 247d718b59a..43792c4e9e3 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -4377,7 +4377,6 @@ Flushes the current buffer's remote connection objects, the same as in
4377Flushes all active remote connection objects, the same as in 4377Flushes all active remote connection objects, the same as in
4378@code{tramp-cleanup-connection}. This command removes also ad-hoc 4378@code{tramp-cleanup-connection}. This command removes also ad-hoc
4379proxy definitions (@pxref{Ad-hoc multi-hops}). 4379proxy definitions (@pxref{Ad-hoc multi-hops}).
4380
4381@end deffn 4380@end deffn
4382 4381
4383@deffn Command tramp-cleanup-all-buffers 4382@deffn Command tramp-cleanup-all-buffers
@@ -4386,6 +4385,20 @@ connections and ad-hoc proxy definition are cleaned up in addition to
4386killing all buffers related to remote connections. 4385killing all buffers related to remote connections.
4387@end deffn 4386@end deffn
4388 4387
4388@deffn Command tramp-cleanup-some-buffers
4389Similar to @code{tramp-cleanup-all-buffers}, where all remote
4390connections and ad-hoc proxy definition are cleaned up. However,
4391additional buffers are killed only if one of the functions in
4392@code{tramp-cleanup-some-buffers-hook} returns @code{t}.
4393@end deffn
4394
4395@defopt tramp-cleanup-some-buffers-hook
4396The functions in this hook determine, whether a remote buffer is
4397killed when @code{tramp-cleanup-some-buffers} is called. Per default,
4398remote buffers which are linked to a remote file, remote @code{dired}
4399buffers, and buffers related to a remote process are cleaned up.
4400@end defopt
4401
4389 4402
4390@node Renaming remote files 4403@node Renaming remote files
4391@section Renaming remote files 4404@section Renaming remote files
diff --git a/etc/NEWS b/etc/NEWS
index d39343b8bd4..87d312596cd 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -222,6 +222,11 @@ The latter suppresses also "ControlMaster" settings in the user's
222"~/.ssh/config" file, or connection share configuration in PuTTY 222"~/.ssh/config" file, or connection share configuration in PuTTY
223sessions, respectively. 223sessions, respectively.
224 224
225+++
226*** New command 'tramp-cleanup-some-buffers'.
227It allows to kill only selected remote buffers, controlled by user
228option 'tramp-cleanup-some-buffers-hook'.
229
225** EWW 230** EWW
226 231
227+++ 232+++
@@ -239,7 +244,7 @@ for tab completion.
239+++ 244+++
240*** 'eww' URL and keyword prompt now completes suggested URIs and bookmarks. 245*** 'eww' URL and keyword prompt now completes suggested URIs and bookmarks.
241The interactive minibuffer prompt when invoking 'eww' now provides 246The interactive minibuffer prompt when invoking 'eww' now provides
242completions from 'eww-suggest-uris'. 'eww-suggest-uris' now includes 247completions from 'eww-suggest-uris'. 'eww-suggest-uris' now includes
243bookmark URIs. 248bookmark URIs.
244 249
245** go-ts-mode 250** go-ts-mode
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 3f3fb1ea6b3..5a8044f8a53 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -1000,6 +1000,7 @@ implementation will be used."
1000 ;; deleted. 1000 ;; deleted.
1001 (when (bufferp stderr) 1001 (when (bufferp stderr)
1002 (ignore-errors 1002 (ignore-errors
1003 (tramp-taint-remote-process-buffer stderr)
1003 (with-current-buffer stderr 1004 (with-current-buffer stderr
1004 (insert-file-contents-literally 1005 (insert-file-contents-literally
1005 remote-tmpstderr 'visit))) 1006 remote-tmpstderr 'visit)))
@@ -1237,8 +1238,6 @@ connection if a previous connection has died for some reason."
1237 tramp-adb-program args))) 1238 tramp-adb-program args)))
1238 (prompt (md5 (concat (prin1-to-string process-environment) 1239 (prompt (md5 (concat (prin1-to-string process-environment)
1239 (current-time-string))))) 1240 (current-time-string)))))
1240 (tramp-message
1241 vec 6 "%s" (string-join (process-command p) " "))
1242 ;; Wait for initial prompt. On some devices, it needs an 1241 ;; Wait for initial prompt. On some devices, it needs an
1243 ;; initial RET, in order to get it. 1242 ;; initial RET, in order to get it.
1244 (sleep-for 0.1) 1243 (sleep-for 0.1)
@@ -1247,11 +1246,9 @@ connection if a previous connection has died for some reason."
1247 (unless (process-live-p p) 1246 (unless (process-live-p p)
1248 (tramp-error vec 'file-error "Terminated!")) 1247 (tramp-error vec 'file-error "Terminated!"))
1249 1248
1250 ;; Set sentinel and query flag. Initialize variables. 1249 ;; Set sentinel. Initialize variables.
1251 (set-process-sentinel p #'tramp-process-sentinel) 1250 (set-process-sentinel p #'tramp-process-sentinel)
1252 (process-put p 'tramp-vector vec) 1251 (tramp-post-process-creation p vec)
1253 (process-put p 'adjust-window-size-function #'ignore)
1254 (set-process-query-on-exit-flag p nil)
1255 1252
1256 ;; Set connection-local variables. 1253 ;; Set connection-local variables.
1257 (tramp-set-connection-local-variables vec) 1254 (tramp-set-connection-local-variables vec)
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 1a9d8003530..07f449a3a2e 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -207,17 +207,76 @@ This includes password cache, file cache, connection cache, buffers."
207 ;; The end. 207 ;; The end.
208 (run-hooks 'tramp-cleanup-all-connections-hook)) 208 (run-hooks 'tramp-cleanup-all-connections-hook))
209 209
210(defcustom tramp-cleanup-some-buffers-hook nil
211 "Hook for `tramp-cleanup-some-buffers'.
212The functions determine which buffers shall be killed. This
213happens when at least one of the functions returns non-nil. The
214functions are called with `current-buffer' set."
215 :group 'tramp
216 :version "30.1"
217 :type 'hook)
218
219(add-hook 'tramp-cleanup-some-buffers-hook
220 #'buffer-file-name)
221
222(defun tramp-cleanup-dired-buffer-p ()
223 "Return t if current buffer runs `dired-mode'."
224 (derived-mode-p 'dired-mode))
225
226(add-hook 'tramp-cleanup-some-buffers-hook
227 #'tramp-cleanup-dired-buffer-p)
228
229(defvar tramp-tainted-remote-process-buffers nil
230 "List of process buffers to be cleaned up.")
231
232(defun tramp-delete-tainted-remote-process-buffer-function ()
233 "Delete current buffer from `tramp-tainted-remote-process-buffers'."
234 (setq tramp-tainted-remote-process-buffers
235 (delete (current-buffer) tramp-tainted-remote-process-buffers)))
236
210;;;###tramp-autoload 237;;;###tramp-autoload
211(defun tramp-cleanup-all-buffers () 238(defun tramp-taint-remote-process-buffer (buffer)
212 "Kill all remote buffers." 239 "Mark buffer as related to remote processes."
240 (add-to-list 'tramp-tainted-remote-process-buffers buffer))
241
242(add-hook 'kill-buffer-hook
243 #'tramp-delete-tainted-remote-process-buffer-function)
244(add-hook 'tramp-unload-hook
245 (lambda ()
246 (remove-hook 'kill-buffer-hook
247 #'tramp-delete-tainted-remote-process-buffer-function)))
248
249(defun tramp-cleanup-remote-process-p ()
250 "Return t if current buffer belongs to a remote process."
251 (memq (current-buffer) tramp-tainted-remote-process-buffers))
252
253(add-hook 'tramp-cleanup-some-buffers-hook
254 #'tramp-cleanup-remote-process-p)
255
256;;;###tramp-autoload
257(defun tramp-cleanup-some-buffers ()
258 "Kill some remote buffers.
259A buffer is killed when it has a remote `default-directory', and
260one of the functions in `tramp-cleanup-some-buffers-hook' returns
261non-nil."
213 (interactive) 262 (interactive)
214 263
215 ;; Remove all Tramp related connections. 264 ;; Remove all Tramp related connections.
216 (tramp-cleanup-all-connections) 265 (tramp-cleanup-all-connections)
217 266
218 ;; Remove all buffers with a remote default-directory. 267 ;; Remove all buffers with a remote default-directory which fit the hook.
219 (dolist (name (tramp-list-remote-buffers)) 268 (dolist (name (tramp-list-remote-buffers))
220 (when (bufferp (get-buffer name)) (kill-buffer name)))) 269 (and (buffer-live-p (get-buffer name))
270 (with-current-buffer (get-buffer name)
271 (run-hook-with-args-until-success 'tramp-cleanup-some-buffers-hook))
272 (kill-buffer name))))
273
274;;;###tramp-autoload
275(defun tramp-cleanup-all-buffers ()
276 "Kill all remote buffers."
277 (interactive)
278 (let ((tramp-cleanup-some-buffers-hook '(tramp-compat-always)))
279 (tramp-cleanup-some-buffers)))
221 280
222(defcustom tramp-default-rename-alist nil 281(defcustom tramp-default-rename-alist nil
223 "Default target for renaming remote buffer file names. 282 "Default target for renaming remote buffer file names.
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 420d6cadb9c..150c3fbf187 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -219,6 +219,16 @@ Add the extension of F, if existing."
219 (lambda (sequence length) 219 (lambda (sequence length)
220 (= (length sequence) length)))) 220 (= (length sequence) length))))
221 221
222;; `always' is introduced with Emacs 28.1.
223(defalias 'tramp-compat-always
224 (if (fboundp 'always)
225 #'always
226 (lambda (&rest _arguments)
227 "Do nothing and return t.
228This function accepts any number of ARGUMENTS, but ignores them.
229Also see `ignore'."
230 t)))
231
222;; `permission-denied' is introduced in Emacs 29.1. 232;; `permission-denied' is introduced in Emacs 29.1.
223(defconst tramp-permission-denied 233(defconst tramp-permission-denied
224 (if (get 'permission-denied 'error-conditions) 'permission-denied 'file-error) 234 (if (get 'permission-denied 'error-conditions) 'permission-denied 'file-error)
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 4d15695ccbf..ea27c704587 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -316,8 +316,7 @@ connection if a previous connection has died for some reason."
316 :name (tramp-get-connection-name vec) 316 :name (tramp-get-connection-name vec)
317 :buffer (tramp-get-connection-buffer vec) 317 :buffer (tramp-get-connection-buffer vec)
318 :server t :host 'local :service t :noquery t))) 318 :server t :host 'local :service t :noquery t)))
319 (process-put p 'tramp-vector vec) 319 (tramp-post-process-creation p vec)))
320 (set-process-query-on-exit-flag p nil)))
321 320
322 ;; The following operations must be performed without 321 ;; The following operations must be performed without
323 ;; `tramp-crypt-file-name-handler'. 322 ;; `tramp-crypt-file-name-handler'.
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index d44fd55b225..ad7b1ff054c 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -1498,15 +1498,11 @@ If FILE-SYSTEM is non-nil, return file system attributes."
1498 (if (not (processp p)) 1498 (if (not (processp p))
1499 (tramp-error 1499 (tramp-error
1500 v 'file-notify-error "Monitoring not supported for `%s'" file-name) 1500 v 'file-notify-error "Monitoring not supported for `%s'" file-name)
1501 (tramp-message
1502 v 6 "Run `%s', %S" (string-join (process-command p) " ") p)
1503 (process-put p 'tramp-vector v)
1504 (process-put p 'tramp-events events) 1501 (process-put p 'tramp-events events)
1505 (process-put p 'tramp-watch-name localname) 1502 (process-put p 'tramp-watch-name localname)
1506 (process-put p 'adjust-window-size-function #'ignore)
1507 (set-process-query-on-exit-flag p nil)
1508 (set-process-filter p #'tramp-gvfs-monitor-process-filter) 1503 (set-process-filter p #'tramp-gvfs-monitor-process-filter)
1509 (set-process-sentinel p #'tramp-file-notify-process-sentinel) 1504 (set-process-sentinel p #'tramp-file-notify-process-sentinel)
1505 (tramp-post-process-creation p v)
1510 ;; There might be an error if the monitor is not supported. 1506 ;; There might be an error if the monitor is not supported.
1511 ;; Give the filter a chance to read the output. 1507 ;; Give the filter a chance to read the output.
1512 (while (tramp-accept-process-output p)) 1508 (while (tramp-accept-process-output p))
@@ -2204,8 +2200,7 @@ connection if a previous connection has died for some reason."
2204 :name (tramp-get-connection-name vec) 2200 :name (tramp-get-connection-name vec)
2205 :buffer (tramp-get-connection-buffer vec) 2201 :buffer (tramp-get-connection-buffer vec)
2206 :server t :host 'local :service t :noquery t))) 2202 :server t :host 'local :service t :noquery t)))
2207 (process-put p 'tramp-vector vec) 2203 (tramp-post-process-creation p vec)
2208 (set-process-query-on-exit-flag p nil)
2209 2204
2210 ;; Set connection-local variables. 2205 ;; Set connection-local variables.
2211 (tramp-set-connection-local-variables vec))) 2206 (tramp-set-connection-local-variables vec)))
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index ec6a1da684f..74295de4c29 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -371,8 +371,7 @@ connection if a previous connection has died for some reason."
371 :name (tramp-get-connection-name vec) 371 :name (tramp-get-connection-name vec)
372 :buffer (tramp-get-connection-buffer vec) 372 :buffer (tramp-get-connection-buffer vec)
373 :server t :host 'local :service t :noquery t))) 373 :server t :host 'local :service t :noquery t)))
374 (process-put p 'tramp-vector vec) 374 (tramp-post-process-creation p vec)
375 (set-process-query-on-exit-flag p nil)
376 375
377 ;; Set connection-local variables. 376 ;; Set connection-local variables.
378 (tramp-set-connection-local-variables vec))) 377 (tramp-set-connection-local-variables vec)))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 2df3006c1d9..0369e19378c 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2426,14 +2426,11 @@ The method used must be an out-of-band method."
2426 (tramp-get-connection-name v) 2426 (tramp-get-connection-name v)
2427 (tramp-get-connection-buffer v) 2427 (tramp-get-connection-buffer v)
2428 copy-program copy-args))) 2428 copy-program copy-args)))
2429 (tramp-message v 6 "%s" (string-join (process-command p) " "))
2430 (process-put p 'tramp-vector v)
2431 ;; This is neded for ssh or PuTTY based processes, and 2429 ;; This is neded for ssh or PuTTY based processes, and
2432 ;; only if the respective options are set. Perhaps, 2430 ;; only if the respective options are set. Perhaps,
2433 ;; the setting could be more fine-grained. 2431 ;; the setting could be more fine-grained.
2434 ;; (process-put p 'tramp-shared-socket t) 2432 ;; (process-put p 'tramp-shared-socket t)
2435 (process-put p 'adjust-window-size-function #'ignore) 2433 (tramp-post-process-creation p v)
2436 (set-process-query-on-exit-flag p nil)
2437 2434
2438 ;; We must adapt `tramp-local-end-of-line' for sending 2435 ;; We must adapt `tramp-local-end-of-line' for sending
2439 ;; the password. Also, we indicate that perhaps 2436 ;; the password. Also, we indicate that perhaps
@@ -2934,6 +2931,7 @@ implementation will be used."
2934 v 'file-error "Stderr buffer `%s' not supported" stderr)) 2931 v 'file-error "Stderr buffer `%s' not supported" stderr))
2935 (with-current-buffer stderr 2932 (with-current-buffer stderr
2936 (setq buffer-read-only nil)) 2933 (setq buffer-read-only nil))
2934 (tramp-taint-remote-process-buffer stderr)
2937 ;; Create named pipe. 2935 ;; Create named pipe.
2938 (tramp-send-command 2936 (tramp-send-command
2939 v (format (tramp-get-remote-mknod-or-mkfifo v) tmpstderr)) 2937 v (format (tramp-get-remote-mknod-or-mkfifo v) tmpstderr))
@@ -3759,8 +3757,6 @@ Fall back to normal file name handler if no Tramp handler exists."
3759 v 'file-notify-error 3757 v 'file-notify-error
3760 "`%s' failed to start on remote host" 3758 "`%s' failed to start on remote host"
3761 (string-join sequence " ")) 3759 (string-join sequence " "))
3762 (tramp-message v 6 "Run `%s', %S" (string-join sequence " ") p)
3763 (process-put p 'tramp-vector v)
3764 ;; This is neded for ssh or PuTTY based processes, and only if 3760 ;; This is neded for ssh or PuTTY based processes, and only if
3765 ;; the respective options are set. Perhaps, the setting could 3761 ;; the respective options are set. Perhaps, the setting could
3766 ;; be more fine-grained. 3762 ;; be more fine-grained.
@@ -3768,9 +3764,9 @@ Fall back to normal file name handler if no Tramp handler exists."
3768 ;; Needed for process filter. 3764 ;; Needed for process filter.
3769 (process-put p 'tramp-events events) 3765 (process-put p 'tramp-events events)
3770 (process-put p 'tramp-watch-name localname) 3766 (process-put p 'tramp-watch-name localname)
3771 (set-process-query-on-exit-flag p nil)
3772 (set-process-filter p filter) 3767 (set-process-filter p filter)
3773 (set-process-sentinel p #'tramp-file-notify-process-sentinel) 3768 (set-process-sentinel p #'tramp-file-notify-process-sentinel)
3769 (tramp-post-process-creation p v)
3774 ;; There might be an error if the monitor is not supported. 3770 ;; There might be an error if the monitor is not supported.
3775 ;; Give the filter a chance to read the output. 3771 ;; Give the filter a chance to read the output.
3776 (while (tramp-accept-process-output p)) 3772 (while (tramp-accept-process-output p))
@@ -5130,19 +5126,15 @@ connection if a previous connection has died for some reason."
5130 (and tramp-encoding-command-interactive 5126 (and tramp-encoding-command-interactive
5131 (list tramp-encoding-command-interactive))))))) 5127 (list tramp-encoding-command-interactive)))))))
5132 5128
5133 ;; Set sentinel and query flag. Initialize variables.
5134 (set-process-sentinel p #'tramp-process-sentinel)
5135 (process-put p 'tramp-vector vec)
5136 ;; This is neded for ssh or PuTTY based processes, and 5129 ;; This is neded for ssh or PuTTY based processes, and
5137 ;; only if the respective options are set. Perhaps, 5130 ;; only if the respective options are set. Perhaps,
5138 ;; the setting could be more fine-grained. 5131 ;; the setting could be more fine-grained.
5139 ;; (process-put p 'tramp-shared-socket t) 5132 ;; (process-put p 'tramp-shared-socket t)
5140 (process-put p 'adjust-window-size-function #'ignore) 5133 ;; Set sentinel. Initialize variables.
5141 (set-process-query-on-exit-flag p nil) 5134 (set-process-sentinel p #'tramp-process-sentinel)
5135 (tramp-post-process-creation p vec)
5142 (setq tramp-current-connection (cons vec (current-time))) 5136 (setq tramp-current-connection (cons vec (current-time)))
5143 5137
5144 (tramp-message vec 6 "%s" (string-join (process-command p) " "))
5145
5146 ;; Set connection-local variables. 5138 ;; Set connection-local variables.
5147 (tramp-set-connection-local-variables vec) 5139 (tramp-set-connection-local-variables vec)
5148 5140
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 13d5e17a9ff..9a24403bb18 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -556,13 +556,7 @@ arguments to pass to the OPERATION."
556 (tramp-get-connection-name v) 556 (tramp-get-connection-name v)
557 (tramp-get-connection-buffer v) 557 (tramp-get-connection-buffer v)
558 tramp-smb-program args))) 558 tramp-smb-program args)))
559 559 (tramp-post-process-creation p v)
560 (tramp-message
561 v 6 "%s" (string-join (process-command p) " "))
562 (process-put p 'tramp-vector v)
563 (process-put
564 p 'adjust-window-size-function #'ignore)
565 (set-process-query-on-exit-flag p nil)
566 (tramp-process-actions 560 (tramp-process-actions
567 p v nil tramp-smb-actions-with-tar) 561 p v nil tramp-smb-actions-with-tar)
568 562
@@ -816,12 +810,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
816 (tramp-get-connection-name v) 810 (tramp-get-connection-name v)
817 (tramp-get-connection-buffer v) 811 (tramp-get-connection-buffer v)
818 tramp-smb-acl-program args))) 812 tramp-smb-acl-program args)))
819 813 (tramp-post-process-creation p v)
820 (tramp-message
821 v 6 "%s" (string-join (process-command p) " "))
822 (process-put p 'tramp-vector v)
823 (process-put p 'adjust-window-size-function #'ignore)
824 (set-process-query-on-exit-flag p nil)
825 (tramp-process-actions p v nil tramp-smb-actions-get-acl) 814 (tramp-process-actions p v nil tramp-smb-actions-get-acl)
826 (when (> (point-max) (point-min)) 815 (when (> (point-max) (point-min))
827 (substring-no-properties (buffer-string)))))))))))) 816 (substring-no-properties (buffer-string))))))))))))
@@ -1416,12 +1405,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
1416 (tramp-get-connection-name v) 1405 (tramp-get-connection-name v)
1417 (tramp-get-connection-buffer v) 1406 (tramp-get-connection-buffer v)
1418 tramp-smb-acl-program args))) 1407 tramp-smb-acl-program args)))
1419 1408 (tramp-post-process-creation p v)
1420 (tramp-message
1421 v 6 "%s" (string-join (process-command p) " "))
1422 (process-put p 'tramp-vector v)
1423 (process-put p 'adjust-window-size-function #'ignore)
1424 (set-process-query-on-exit-flag p nil)
1425 (tramp-process-actions p v nil tramp-smb-actions-set-acl) 1409 (tramp-process-actions p v nil tramp-smb-actions-set-acl)
1426 ;; This is meant for traces, and returning from 1410 ;; This is meant for traces, and returning from
1427 ;; the function. No error is propagated outside, 1411 ;; the function. No error is propagated outside,
@@ -1965,11 +1949,7 @@ If ARGUMENT is non-nil, use it as argument for
1965 (if argument 1949 (if argument
1966 tramp-smb-winexe-program tramp-smb-program) 1950 tramp-smb-winexe-program tramp-smb-program)
1967 args)))) 1951 args))))
1968 1952 (tramp-post-process-creation p vec)
1969 (tramp-message vec 6 "%s" (string-join (process-command p) " "))
1970 (process-put p 'tramp-vector vec)
1971 (process-put p 'adjust-window-size-function #'ignore)
1972 (set-process-query-on-exit-flag p nil)
1973 1953
1974 ;; Set connection-local variables. 1954 ;; Set connection-local variables.
1975 (tramp-set-connection-local-variables vec) 1955 (tramp-set-connection-local-variables vec)
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index a4f6246ec23..fe126361ac3 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -399,8 +399,7 @@ connection if a previous connection has died for some reason."
399 :name (tramp-get-connection-name vec) 399 :name (tramp-get-connection-name vec)
400 :buffer (tramp-get-connection-buffer vec) 400 :buffer (tramp-get-connection-buffer vec)
401 :server t :host 'local :service t :noquery t))) 401 :server t :host 'local :service t :noquery t)))
402 (process-put p 'tramp-vector vec) 402 (tramp-post-process-creation p vec)
403 (set-process-query-on-exit-flag p nil)
404 403
405 ;; Set connection-local variables. 404 ;; Set connection-local variables.
406 (tramp-set-connection-local-variables vec))) 405 (tramp-set-connection-local-variables vec)))
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index defd4f430bc..941c1e8dd24 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -720,8 +720,7 @@ connection if a previous connection has died for some reason."
720 :name (tramp-get-connection-name vec) 720 :name (tramp-get-connection-name vec)
721 :buffer (tramp-get-connection-buffer vec) 721 :buffer (tramp-get-connection-buffer vec)
722 :server t :host 'local :service t :noquery t))) 722 :server t :host 'local :service t :noquery t)))
723 (process-put p 'tramp-vector vec) 723 (tramp-post-process-creation p vec)
724 (set-process-query-on-exit-flag p nil)
725 724
726 ;; Set connection-local variables. 725 ;; Set connection-local variables.
727 (tramp-set-connection-local-variables vec) 726 (tramp-set-connection-local-variables vec)
@@ -755,12 +754,9 @@ in case of error, t otherwise."
755 (tramp-cache-read-persistent-data t) 754 (tramp-cache-read-persistent-data t)
756 ;; We do not want to save the password. 755 ;; We do not want to save the password.
757 auth-source-save-behavior) 756 auth-source-save-behavior)
758 (tramp-message vec 6 "%s" (string-join (process-command p) " "))
759 ;; Avoid process status message in output buffer. 757 ;; Avoid process status message in output buffer.
760 (set-process-sentinel p #'ignore) 758 (set-process-sentinel p #'ignore)
761 (process-put p 'tramp-vector vec) 759 (tramp-post-process-creation p vec)
762 (process-put p 'adjust-window-size-function #'ignore)
763 (set-process-query-on-exit-flag p nil)
764 (tramp-set-connection-property p "password-vector" tramp-sudoedit-null-hop) 760 (tramp-set-connection-property p "password-vector" tramp-sudoedit-null-hop)
765 (tramp-process-actions p vec nil tramp-sudoedit-sudo-actions) 761 (tramp-process-actions p vec nil tramp-sudoedit-sudo-actions)
766 (tramp-message vec 6 "%s\n%s" (process-exit-status p) (buffer-string)) 762 (tramp-message vec 6 "%s\n%s" (process-exit-status p) (buffer-string))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 3420bb76d14..81473404f0c 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4941,6 +4941,16 @@ substitution. SPEC-LIST is a list of char/value pairs used for
4941 (unless (member "" x) x)) 4941 (unless (member "" x) x))
4942 args)))) 4942 args))))
4943 4943
4944(defun tramp-post-process-creation (proc vec)
4945 "Apply actions after creation of process PROC."
4946 (process-put proc 'tramp-vector vec)
4947 (process-put proc 'adjust-window-size-function #'ignore)
4948 (set-process-query-on-exit-flag proc nil)
4949 (tramp-taint-remote-process-buffer (process-buffer proc))
4950 (tramp-message vec 6 "%s" (string-join (process-command proc) " ")))
4951
4952(put #'tramp-post-process-creation 'tramp-suppress-trace t)
4953
4944(defun tramp-direct-async-process-p (&rest args) 4954(defun tramp-direct-async-process-p (&rest args)
4945 "Whether direct async `make-process' can be called." 4955 "Whether direct async `make-process' can be called."
4946 (let ((v (tramp-dissect-file-name default-directory)) 4956 (let ((v (tramp-dissect-file-name default-directory))
@@ -5090,15 +5100,19 @@ substitution. SPEC-LIST is a list of char/value pairs used for
5090 ;; t. See Bug#51177. 5100 ;; t. See Bug#51177.
5091 (when filter 5101 (when filter
5092 (set-process-filter p filter)) 5102 (set-process-filter p filter))
5093 (process-put p 'tramp-vector v) 5103 (tramp-post-process-creation p v)
5104 ;; Query flag is overwritten in `tramp-post-process-creation',
5105 ;; so we reset it.
5106 (set-process-query-on-exit-flag p (null noquery))
5094 ;; This is neded for ssh or PuTTY based processes, and 5107 ;; This is neded for ssh or PuTTY based processes, and
5095 ;; only if the respective options are set. Perhaps, the 5108 ;; only if the respective options are set. Perhaps, the
5096 ;; setting could be more fine-grained. 5109 ;; setting could be more fine-grained.
5097 ;; (process-put p 'tramp-shared-socket t) 5110 ;; (process-put p 'tramp-shared-socket t)
5098 (process-put p 'remote-command orig-command) 5111 (process-put p 'remote-command orig-command)
5099 (tramp-set-connection-property p "remote-command" orig-command) 5112 (tramp-set-connection-property p "remote-command" orig-command)
5113 (when (bufferp stderr)
5114 (tramp-taint-remote-process-buffer stderr))
5100 5115
5101 (tramp-message v 6 "%s" (string-join (process-command p) " "))
5102 p)))))) 5116 p))))))
5103 5117
5104(defun tramp-handle-make-symbolic-link 5118(defun tramp-handle-make-symbolic-link
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 9bca6a03754..5fde783087e 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -297,16 +297,6 @@ is greater than 10.
297 (tramp--test-message 297 (tramp--test-message
298 "%s %f sec" ,message (float-time (time-subtract nil start)))))) 298 "%s %f sec" ,message (float-time (time-subtract nil start))))))
299 299
300;; `always' is introduced with Emacs 28.1.
301(defalias 'tramp--test-always
302 (if (fboundp 'always)
303 #'always
304 (lambda (&rest _arguments)
305 "Do nothing and return t.
306This function accepts any number of ARGUMENTS, but ignores them.
307Also see `ignore'."
308 t)))
309
310(ert-deftest tramp-test00-availability () 300(ert-deftest tramp-test00-availability ()
311 "Test availability of Tramp functions." 301 "Test availability of Tramp functions."
312 :expected-result (if (tramp--test-enabled) :passed :failed) 302 :expected-result (if (tramp--test-enabled) :passed :failed)
@@ -2563,9 +2553,9 @@ This checks also `file-name-as-directory', `file-name-directory',
2563 ;; `tramp-test39-make-lock-file-name'. 2553 ;; `tramp-test39-make-lock-file-name'.
2564 2554
2565 ;; Do not overwrite if excluded. 2555 ;; Do not overwrite if excluded.
2566 (cl-letf (((symbol-function #'y-or-n-p) #'tramp--test-always) 2556 (cl-letf (((symbol-function #'y-or-n-p) #'tramp-compat-always)
2567 ;; Ange-FTP. 2557 ;; Ange-FTP.
2568 ((symbol-function 'yes-or-no-p) #'tramp--test-always)) 2558 ((symbol-function 'yes-or-no-p) #'tramp-compat-always))
2569 (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) 2559 (write-region "foo" nil tmp-name nil nil nil 'mustbenew))
2570 (should-error 2560 (should-error
2571 (cl-letf (((symbol-function #'y-or-n-p) #'ignore) 2561 (cl-letf (((symbol-function #'y-or-n-p) #'ignore)
@@ -3991,7 +3981,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
3991 (should-error 3981 (should-error
3992 (make-symbolic-link tmp-name1 tmp-name2 0) 3982 (make-symbolic-link tmp-name1 tmp-name2 0)
3993 :type 'file-already-exists))) 3983 :type 'file-already-exists)))
3994 (cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always)) 3984 (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always))
3995 (make-symbolic-link tmp-name1 tmp-name2 0) 3985 (make-symbolic-link tmp-name1 tmp-name2 0)
3996 (should 3986 (should
3997 (string-equal 3987 (string-equal
@@ -4071,7 +4061,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
4071 (should-error 4061 (should-error
4072 (add-name-to-file tmp-name1 tmp-name2 0) 4062 (add-name-to-file tmp-name1 tmp-name2 0)
4073 :type 'file-already-exists)) 4063 :type 'file-already-exists))
4074 (cl-letf (((symbol-function #'yes-or-no-p) #'tramp--test-always)) 4064 (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always))
4075 (add-name-to-file tmp-name1 tmp-name2 0) 4065 (add-name-to-file tmp-name1 tmp-name2 0)
4076 (should (file-regular-p tmp-name2))) 4066 (should (file-regular-p tmp-name2)))
4077 (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists) 4067 (add-name-to-file tmp-name1 tmp-name2 'ok-if-already-exists)
@@ -5202,7 +5192,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'."
5202 ;; `file-truename' does it by side-effect. Suppress 5192 ;; `file-truename' does it by side-effect. Suppress
5203 ;; `tramp--test-enabled', in order to keep the connection. 5193 ;; `tramp--test-enabled', in order to keep the connection.
5204 ;; Suppress "Process ... finished" messages. 5194 ;; Suppress "Process ... finished" messages.
5205 (cl-letf (((symbol-function #'tramp--test-enabled) #'tramp--test-always) 5195 (cl-letf (((symbol-function #'tramp--test-enabled) #'tramp-compat-always)
5206 ((symbol-function #'internal-default-process-sentinel) 5196 ((symbol-function #'internal-default-process-sentinel)
5207 #'ignore)) 5197 #'ignore))
5208 (file-truename ert-remote-temporary-file-directory) 5198 (file-truename ert-remote-temporary-file-directory)
@@ -6410,7 +6400,7 @@ INPUT, if non-nil, is a string sent to the process."
6410 (tramp-cleanup-connection 6400 (tramp-cleanup-connection
6411 tramp-test-vec 'keep-debug 'keep-password) 6401 tramp-test-vec 'keep-debug 'keep-password)
6412 (cl-letf (((symbol-function #'yes-or-no-p) 6402 (cl-letf (((symbol-function #'yes-or-no-p)
6413 #'tramp--test-always)) 6403 #'tramp-compat-always))
6414 (should (stringp (make-auto-save-file-name)))))))) 6404 (should (stringp (make-auto-save-file-name))))))))
6415 6405
6416 ;; Cleanup. 6406 ;; Cleanup.
@@ -6556,8 +6546,7 @@ INPUT, if non-nil, is a string sent to the process."
6556 :type 'file-error)) 6546 :type 'file-error))
6557 (tramp-cleanup-connection 6547 (tramp-cleanup-connection
6558 tramp-test-vec 'keep-debug 'keep-password) 6548 tramp-test-vec 'keep-debug 'keep-password)
6559 (cl-letf (((symbol-function #'yes-or-no-p) 6549 (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always))
6560 #'tramp--test-always))
6561 (should (stringp (car (find-backup-file-name tmp-name1))))))) 6550 (should (stringp (car (find-backup-file-name tmp-name1)))))))
6562 6551
6563 ;; Cleanup. 6552 ;; Cleanup.
@@ -6712,8 +6701,7 @@ INPUT, if non-nil, is a string sent to the process."
6712 :type 'file-error)) 6701 :type 'file-error))
6713 (tramp-cleanup-connection 6702 (tramp-cleanup-connection
6714 tramp-test-vec 'keep-debug 'keep-password) 6703 tramp-test-vec 'keep-debug 'keep-password)
6715 (cl-letf (((symbol-function #'yes-or-no-p) 6704 (cl-letf (((symbol-function #'yes-or-no-p) #'tramp-compat-always))
6716 #'tramp--test-always))
6717 (write-region "foo" nil tmp-name1)))) 6705 (write-region "foo" nil tmp-name1))))
6718 6706
6719 ;; Cleanup. 6707 ;; Cleanup.
@@ -6783,7 +6771,8 @@ INPUT, if non-nil, is a string sent to the process."
6783 (should (file-locked-p tmp-name))))) 6771 (should (file-locked-p tmp-name)))))
6784 6772
6785 ;; `save-buffer' removes the file lock. 6773 ;; `save-buffer' removes the file lock.
6786 (cl-letf (((symbol-function 'yes-or-no-p) #'tramp--test-always) 6774 (cl-letf (((symbol-function 'yes-or-no-p)
6775 #'tramp-compat-always)
6787 ((symbol-function 'read-char-choice) 6776 ((symbol-function 'read-char-choice)
6788 (lambda (&rest _) ?y))) 6777 (lambda (&rest _) ?y)))
6789 (should (buffer-modified-p)) 6778 (should (buffer-modified-p))