From e48ac2e2040cf0dd628b7fee6991a1738ceb2349 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Tue, 5 Apr 2022 17:08:03 +0200 Subject: [PATCH] Handle remote system processes * doc/lispref/files.texi (Magic File Names): Add list-system-processes and process-attributes. * doc/lispref/processes.texi (System Processes): Document changes in list-system-processes and process-attributes. * doc/misc/tramp.texi (Customizing Completion): Use @ftable. (Remote processes): Document changes in list-system-processes and process-attributes. * etc/NEWS: Document changes in proced, list-system-processes and process-attributes. * lisp/proced.el (proced-show-remote-processes): New defcustom. (proced-remote-directory): Remove. (proced-filter-alist): Use it. (proced-user-name): New defun. (proced-available): Set it to t. (proced-mode): Adapt docstring. (proced): Adapt docstring. Acknowledge prefix argument. (proced-format): Change initialization of `standard-attributes'. (proced-send-signal, proced-renice): Adapt docstring. Remove special handling of prefix argument. * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist): * lisp/net/tramp-archive.el (tramp-archive-file-name-handler-alist): * lisp/net/tramp-crypt.el (tramp-crypt-file-name-handler-alist): * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist): * lisp/net/tramp-rclone.el (tramp-rclone-file-name-handler-alist): * lisp/net/tramp-sh.el (tramp-sh-file-name-handler-alist): * lisp/net/tramp-smb.el (tramp-smb-file-name-handler-alist): * lisp/net/tramp-sshfs.el (tramp-sshfs-file-name-handler-alist): * lisp/net/tramp-sudoedit.el (tramp-sudoedit-file-name-handler-alist): Add 'list-system-processes' and `process-attributes'. * lisp/net/tramp-integration.el (files-x): Require `files-x'. (tramp-bsd-process-attributes-ps-args) (tramp-bsd-process-attributes-ps-format) (tramp-connection-local-bsd-ps-variables) (tramp-busybox-process-attributes-ps-args) (tramp-busybox-process-attributes-ps-format) (tramp-connection-local-busybox-ps-variables): * lisp/net/tramp-adb.el (tramp-adb-connection-local-default-ps-variables): New defconsts. Add them to connection-local variables. * lisp/net/tramp.el (tramp-file-name-for-operation): Add 'list-system-processes' and `process-attributes'. (tramp-process-attributes-ps-args) (tramp-process-attributes-ps-format): New defconsts. (tramp-ps-time, tramp-get-process-attributes) (tramp-handle-list-system-processes) (tramp-handle-process-attributes): New defuns. * src/process.c (Flist_system_processes, Fprocess_attributes): Support remote system processes. (Qlist_system_processes, Qprocess_attributes): Declare symbols. --- doc/lispref/files.texi | 6 +- doc/lispref/processes.texi | 11 ++- doc/misc/tramp.texi | 107 +++++++++++++++++++--- etc/NEWS | 29 ++++-- lisp/net/tramp-adb.el | 23 ++++- lisp/net/tramp-archive.el | 2 + lisp/net/tramp-crypt.el | 2 + lisp/net/tramp-gvfs.el | 2 + lisp/net/tramp-integration.el | 140 ++++++++++++++++++++++++++++- lisp/net/tramp-rclone.el | 2 + lisp/net/tramp-sh.el | 2 + lisp/net/tramp-smb.el | 2 + lisp/net/tramp-sshfs.el | 2 + lisp/net/tramp-sudoedit.el | 2 + lisp/net/tramp.el | 161 +++++++++++++++++++++++++++++++++- lisp/proced.el | 63 ++++++------- src/process.c | 17 ++++ 17 files changed, 515 insertions(+), 58 deletions(-) diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 6e59e87d286..d8b55b114ae 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -3344,6 +3344,7 @@ first, before handlers for jobs such as remote file access. @code{get-file-buffer}, @code{insert-directory}, @code{insert-file-contents},@* +@code{list-system-processes}, @code{load}, @code{lock-file}, @code{make-auto-save-file-name}, @code{make-directory}, @@ -3352,7 +3353,7 @@ first, before handlers for jobs such as remote file access. @code{make-nearby-temp-file}, @code{make-process}, @code{make-symbolic-link},@* -@code{process-file}, +@code{process-attributes}, @code{process-file}, @code{rename-file}, @code{set-file-acl}, @code{set-file-modes}, @code{set-file-selinux-context}, @code{set-file-times}, @code{set-visited-file-modtime}, @code{shell-command}, @@ -3405,6 +3406,7 @@ first, before handlers for jobs such as remote file access. @code{get-file-buffer}, @code{insert-directory}, @code{insert-file-contents}, +@code{list-system-processes}, @code{load}, @code{lock-file}, @code{make-auto-save-file-name}, @code{make-direc@discretionary{}{}{}tory}, @@ -3413,7 +3415,7 @@ first, before handlers for jobs such as remote file access. @code{make-nearby-temp-file}, @code{make-process}, @code{make-symbolic-link}, -@code{process-file}, +@code{process-attributes}, @code{process-file}, @code{rename-file}, @code{set-file-acl}, @code{set-file-modes}, @code{set-file-selinux-context}, @code{set-file-times}, @code{set-visited-file-modtime}, @code{shell-command}, diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index ffc0f10a786..18f446735bb 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -2258,9 +2258,8 @@ query flag of all processes is ignored. In addition to accessing and manipulating processes that are subprocesses of the current Emacs session, Emacs Lisp programs can -also access other processes running on the same machine. We call -these @dfn{system processes}, to distinguish them from Emacs -subprocesses. +also access other processes. We call these @dfn{system processes}, to +distinguish them from Emacs subprocesses. Emacs provides several primitives for accessing system processes. Not all platforms support these primitives; on those which don't, @@ -2272,6 +2271,9 @@ system. Each process is identified by its @acronym{PID}, a numerical process ID that is assigned by the OS and distinguishes the process from all the other processes running on the same machine at the same time. + +If @code{default-directory} points to a remote host, processes of that +host are returned. @end defun @defun process-attributes pid @@ -2283,6 +2285,9 @@ attribute @var{key}s that this function can return are listed below. Not all platforms support all of these attributes; if an attribute is not supported, its association will not appear in the returned alist. +If @code{default-directory} points to a remote host, @var{pid} is +regarded as process of that host. + @table @code @item euid The effective user ID of the user who invoked the process. The diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 526e92aaddf..e4a586f8176 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -1881,29 +1881,25 @@ Example: The following predefined functions parsing configuration files exist: -@table @asis +@ftable @asis @item @code{tramp-parse-rhosts} -@findex tramp-parse-rhosts This function parses files which are syntactical equivalent to @file{~/.rhosts}. It returns both host names and user names, if specified. @item @code{tramp-parse-shosts} -@findex tramp-parse-shosts This function parses files which are syntactical equivalent to @file{~/.ssh/known_hosts}. Since there are no user names specified in such files, it can return host names only. @item @code{tramp-parse-sconfig} -@findex tramp-parse-sconfig This function returns the host nicknames defined by @option{Host} entries in @file{~/.ssh/config} style files. @item @code{tramp-parse-shostkeys} -@findex tramp-parse-shostkeys SSH2 parsing of directories @file{/etc/ssh2/hostkeys/*} and @file{~/ssh2/hostkeys/*}. Hosts are coded in file names @@ -1911,7 +1907,6 @@ SSH2 parsing of directories @file{/etc/ssh2/hostkeys/*} and are always @code{nil}. @item @code{tramp-parse-sknownhosts} -@findex tramp-parse-sknownhosts Another SSH2 style parsing of directories like @file{/etc/ssh2/knownhosts/*} and @file{~/ssh2/knownhosts/*}. This @@ -1919,26 +1914,22 @@ case, hosts names are coded in file names @file{@var{host-name}.@var{algorithm}.pub}. User names are always @code{nil}. @item @code{tramp-parse-hosts} -@findex tramp-parse-hosts A function dedicated to @file{/etc/hosts} for host names. @item @code{tramp-parse-passwd} -@findex tramp-parse-passwd A function which parses @file{/etc/passwd} for user names. @item @code{tramp-parse-etc-group} -@findex tramp-parse-etc-group A function which parses @file{/etc/group} for group names. @item @code{tramp-parse-netrc} -@findex tramp-parse-netrc A function which parses @file{~/.netrc} and @file{~/.authinfo}-style files. -@end table +@end ftable To keep a custom file with custom data in a custom structure, a custom function has to be provided. This function must meet the following @@ -4047,6 +4038,100 @@ arguments). This does not show the additional shell sugar inspect @value{tramp} @ref{Traces and Profiles, traces}. @end itemize +@findex list-system-processes +@findex process-attributes +The functions @code{list-system-processes} and +@code{process-attributes} return information about processes on the +respective remote host. In order to retrieve this information, they +use the command @command{ps}, driven by the following constants: + +@defvr Constant tramp-process-attributes-ps-args +This is a list of arguments (strings) @command{ps} is called with. +The default value is appropriate for GNU/Linux remote hosts. +@end defvr + +@defvr Constant tramp-process-attributes-ps-format +This is a list of cons cells @code{(@var{key} . @var{type})} for +interpretation of the @command{ps} output. @var{key} is a key used in +the @code{process-attributes} output plus the key @code{pid}, and +@var{type} is the respective value returned by @command{ps}. It can +be + + +@multitable {@bullet{} @code{numberp}} {--- a string of @var{number} width, could contain spaces} +@item @bullet{} @code{numberp} @tab --- a number +@item @bullet{} @code{stringp} @tab --- a string without spaces +@item @bullet{} @var{number} +@tab --- a string of @var{number} width, could contain spaces +@item @bullet{} @code{nil} @tab --- a string until end of line +@end multitable + +The default value is appropriate for GNU/Linux remote hosts. +@end defvr + +If, for example, @code{tramp-process-attributes-ps-args} is declared +as @code{("-eww" "-o" "pid,euid,euser,egid,egroup,comm:40,state")}, +the output of the respective @command{ps} command would look like + +@smallexample +@group + PID EUID EUSER EGID EGROUP COMMAND S + 1 0 root 0 root systemd S + 1610 0 root 0 root NFSv4 callback S + @dots{} +@end group +@end smallexample + +The corresponding @code{tramp-process-attributes-ps-format} has the value + +@smallexample +@group +@code{((pid . numberp) (euid . numberp) (user . stringp) + (egid . numberp) (group . stringp) (comm . 40) (state . stringp))} +@end group +@end smallexample + +@vindex tramp-adb-connection-local-default-ps-profile +@vindex tramp-adb-connection-local-default-ps-variables +@vindex tramp-connection-local-bsd-ps-profile +@vindex tramp-connection-local-bsd-ps-variables +@vindex tramp-connection-local-busybox-ps-profile +@vindex tramp-connection-local-busybox-ps-variables +The default values for @code{tramp-process-attributes-ps-args} and +@code{tramp-process-attributes-ps-format} can be overwritten by +connection-local variables. +@ifinfo +@xref{Connection Variables, , , emacs}. +@end ifinfo +This is already done by @value{tramp} for the @option{adb} method, see +@code{tramp-adb-connection-local-default-ps-profile} and +@code{tramp-adb-connection-local-default-ps-variables}. + +There are two further predefined sets of connection-local variables +for remote BSD systems, and for a remote @command{ps} command +implemented with @command{busybox}. These are called +@code{tramp-connection-local-bsd-ps-profile}, +@code{tramp-connection-local-bsd-ps-variables}, +@code{tramp-connection-local-busybox-ps-profile}, and +@code{tramp-connection-local-busybox-ps-variables}. Use them +like + +@lisp +@group +(connection-local-set-profiles + '(:application tramp :machine "mybsdhost") + 'tramp-connection-local-bsd-ps-profile) +@end group +@end lisp + +@cindex proced +@vindex proced-show-remote-processes +If you want to see a listing of remote system processes when calling +@code{proced}, set user option @code{proced-show-remote-processes} to +non-@code{nil}, or invoke that command with a negative argument like +@kbd{C-u - M-x proced @key{RET}} when your buffer has a remote +@code{default-directory}. + @anchor{Improving performance of asynchronous remote processes} @subsection Improving performance of asynchronous remote processes diff --git a/etc/NEWS b/etc/NEWS index f81d194a2f0..640e18c6bdc 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1175,11 +1175,12 @@ modes to emulate the behavior of the historical editor Twenex Emacs. It is believed to no longer be useful. --- -** proced.el supports sending signals to local processes with root permissions. -When typing 'C-u k' or 'C-u r', sending a signal to or renicing of a -local process will use alternative credentials. The credentials to be -used can be customised by the user option 'proced-remote-directory', -which defaults to "/sudo::". 'proced-signal-function' has been marked obsolete. +** proced.el shows system processes of remote hosts. +When 'default-directory' is remote, and 'proced' is invoked with a +negative argument like 'C-u - proced', the system processes of that +remote host are shown. Alternatively, the user option +'proced-show-remote-processes' can be set to non-nil. +'proced-signal-function' has been marked obsolete. * New Modes and Packages in Emacs 29.1 @@ -1855,6 +1856,24 @@ deliver the signal. This allows Tramp to send the signal to remote asynchronous processes. The hitherto existing implementation has been moved to 'signal-default-interrupt-process'. ++++ +** 'list-system-processes' returns remote process IDs now. +This happens, when the current buffer's 'default-directory' is +remote. In order to preserve the old behavior, apply + + (let ((default-directory temporary-file-directory)) + (list-system-processes)) + ++++ +** 'process-attributes' expects a remote process ID now. +When current buffer's 'default-directory' is remote, the PID argument +of 'process-attributes' is regarded as a remote process ID. In order +to preserve the old behavior, apply + + (let ((default-directory temporary-file-directory)) + (process-attributes pid)) + + * Changes in Emacs 29.1 on Non-Free Operating Systems diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index ab20185d5ad..d897594f8d8 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -159,6 +159,7 @@ It is used for TCP/IP devices." ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) + (list-system-processes . tramp-handle-list-system-processes) (load . tramp-handle-load) (lock-file . tramp-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) @@ -168,6 +169,7 @@ It is used for TCP/IP devices." (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . tramp-adb-handle-make-process) (make-symbolic-link . tramp-handle-make-symbolic-link) + (process-attributes . tramp-handle-process-attributes) (process-file . tramp-adb-handle-process-file) (rename-file . tramp-adb-handle-rename-file) (set-file-acl . ignore) @@ -1368,10 +1370,29 @@ connection if a previous connection has died for some reason." 'tramp-adb-connection-local-default-shell-profile tramp-adb-connection-local-default-shell-variables) +(defconst tramp-adb-connection-local-default-ps-variables + '((tramp-process-attributes-ps-args) + (tramp-process-attributes-ps-format + . ((user . string) + (pid . number) + (ppid . number) + (vsize . number) + (rss . number) + (wchan . string) ; ?? + (pc . string) ; ?? + (state . string) + (args . nil)))) + "Default connection-local ps variables for remote adb connections.") + +(connection-local-set-profile-variables + 'tramp-adb-connection-local-default-ps-profile + tramp-adb-connection-local-default-ps-variables) + (with-eval-after-load 'shell (connection-local-set-profiles `(:application tramp :protocol ,tramp-adb-method) - 'tramp-adb-connection-local-default-shell-profile)) + 'tramp-adb-connection-local-default-shell-profile + 'tramp-adb-connection-local-default-ps-profile)) ;; `shell-mode' tries to open remote files like "/adb::~/.history". ;; This fails, because the tilde cannot be expanded. Tell diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 890c8dbb755..7f4eca3f7c7 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -267,6 +267,7 @@ It must be supported by libarchive(3).") ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-archive-handle-insert-directory) (insert-file-contents . tramp-archive-handle-insert-file-contents) + (list-system-processes . ignore) (load . tramp-archive-handle-load) (lock-file . ignore) (make-auto-save-file-name . ignore) @@ -276,6 +277,7 @@ It must be supported by libarchive(3).") (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . ignore) (make-symbolic-link . tramp-archive-handle-not-implemented) + (process-attributes . ignore) (process-file . ignore) (rename-file . tramp-archive-handle-not-implemented) (set-file-acl . ignore) diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index fb3ba08bb14..ca7bcf35ce4 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -209,6 +209,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil." ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-crypt-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) + (list-system-processes . ignore) (load . tramp-handle-load) (lock-file . tramp-crypt-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) @@ -218,6 +219,7 @@ If NAME doesn't belong to a crypted remote directory, retun nil." (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . ignore) (make-symbolic-link . tramp-handle-make-symbolic-link) + (process-attributes . ignore) (process-file . ignore) (rename-file . tramp-crypt-handle-rename-file) (set-file-acl . ignore) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index d6120d2bee1..752dfdb068a 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -796,6 +796,7 @@ It has been changed in GVFS 1.14.") ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) + (list-system-processes . ignore) (load . tramp-handle-load) (lock-file . tramp-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) @@ -805,6 +806,7 @@ It has been changed in GVFS 1.14.") (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . ignore) (make-symbolic-link . tramp-handle-make-symbolic-link) + (process-attributes . ignore) (process-file . ignore) (rename-file . tramp-gvfs-handle-rename-file) (set-file-acl . ignore) diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el index 3b2e7c0f916..089093a4208 100644 --- a/lisp/net/tramp-integration.el +++ b/lisp/net/tramp-integration.el @@ -28,6 +28,7 @@ ;;; Code: (require 'tramp-compat) +(require 'files-x) ;; Pacify byte-compiler. (require 'cl-lib) @@ -285,9 +286,11 @@ NAME must be equal to `tramp-current-connection'." 'tramp-connection-local-default-system-profile tramp-connection-local-default-system-variables) -(connection-local-set-profiles +(apply + #'connection-local-set-profiles '(:application tramp) - 'tramp-connection-local-default-system-profile) + (cons 'tramp-connection-local-default-system-profile + (connection-local-get-profiles '(:application tramp)))) (defconst tramp-connection-local-default-shell-variables '((shell-file-name . "/bin/sh") @@ -299,9 +302,138 @@ NAME must be equal to `tramp-current-connection'." tramp-connection-local-default-shell-variables) (with-eval-after-load 'shell - (connection-local-set-profiles + (apply + #'connection-local-set-profiles '(:application tramp) - 'tramp-connection-local-default-shell-profile)) + (cons 'tramp-connection-local-default-shell-profile + (connection-local-get-profiles '(:application tramp))))) + +;; Tested with FreeBSD 12.2. +(defconst tramp-bsd-process-attributes-ps-args + `("-acxww" + "-o" + ,(mapconcat + #'identity + '("pid" + "euid" + "user" + "egid" + "egroup" + "comm=abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ") + ",") + "-o" + ,(mapconcat + #'identity + '("state" + "ppid" + "pgid" + "sid" + "tty" + "tpgid" + "minflt" + "majflt" + "time" + "pri" + "nice" + "vsz" + "rss" + "etimes" + "pcpu" + "pmem" + "args") + ",")) + "List of arguments for \"ps\". +See `tramp-process-attributes-ps-args'.") + +(defconst tramp-bsd-process-attributes-ps-format + '((pid . number) + (euid . number) + (user . string) + (egid . number) + (group . string) + (comm . 52) + (state . string) + (ppid . number) + (pgrp . number) + (sess . number) + (ttname . string) + (tpgid . number) + (minflt . number) + (majflt . number) + (time . tramp-ps-time) + (pri . number) + (nice . number) + (vsize . number) + (rss . number) + (etime . number) + (pcpu . number) + (pmem . number) + (args . nil)) + "Alist of formats for \"ps\". +See `tramp-process-attributes-ps-format'.") + +(defconst tramp-connection-local-bsd-ps-variables + `((tramp-process-attributes-ps-args + . ,tramp-bsd-process-attributes-ps-args) + (tramp-process-attributes-ps-format + . ,tramp-bsd-process-attributes-ps-format)) + "Default connection-local ps variables for remote BSD connections.") + +(connection-local-set-profile-variables + 'tramp-connection-local-bsd-ps-profile + tramp-connection-local-bsd-ps-variables) + +;; Tested with BusyBox v1.24.1. +(defconst tramp-busybox-process-attributes-ps-args + `("-o" + ,(mapconcat + #'identity + '("pid" + "user" + "group" + "comm=abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ") + ",") + "-o" "stat=abcde" + "-o" + ,(mapconcat + #'identity + '("ppid" + "pgid" + "tty" + "time" + "nice" + "etime" + "args") + ",")) + "List of arguments for \"ps\". +See `tramp-process-attributes-ps-args'.") + +(defconst tramp-busybox-process-attributes-ps-format + '((pid . number) + (user . string) + (group . string) + (comm . 52) + (state . 5) + (ppid . number) + (pgrp . number) + (ttname . string) + (time . tramp-ps-time) + (nice . number) + (etime . tramp-ps-time) + (args . nil)) + "Alist of formats for \"ps\". +See `tramp-process-attributes-ps-format'.") + +(defconst tramp-connection-local-busybox-ps-variables + `((tramp-process-attributes-ps-args + . ,tramp-busybox-process-attributes-ps-args) + (tramp-process-attributes-ps-format + . ,tramp-busybox-process-attributes-ps-format)) + "Default connection-local ps variables for remote Busybox connections.") + +(connection-local-set-profile-variables + 'tramp-connection-local-busybox-ps-profile + tramp-connection-local-busybox-ps-variables) (add-hook 'tramp-unload-hook (lambda () (unload-feature 'tramp-integration 'force))) diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el index 126b09fcbf3..bbc76851318 100644 --- a/lisp/net/tramp-rclone.el +++ b/lisp/net/tramp-rclone.el @@ -123,6 +123,7 @@ ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) + (list-system-processes . ignore) (load . tramp-handle-load) (lock-file . tramp-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) @@ -132,6 +133,7 @@ (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . ignore) (make-symbolic-link . tramp-handle-make-symbolic-link) + (process-attributes . ignore) (process-file . ignore) (rename-file . tramp-rclone-handle-rename-file) (set-file-acl . ignore) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 3ab5e4d169a..a8f265223f9 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1005,6 +1005,7 @@ Format specifiers \"%s\" are replaced before the script is used.") ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-sh-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) + (list-system-processes . tramp-handle-list-system-processes) (load . tramp-handle-load) (lock-file . tramp-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) @@ -1014,6 +1015,7 @@ Format specifiers \"%s\" are replaced before the script is used.") (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . tramp-sh-handle-make-process) (make-symbolic-link . tramp-sh-handle-make-symbolic-link) + (process-attributes . tramp-handle-process-attributes) (process-file . tramp-sh-handle-process-file) (rename-file . tramp-sh-handle-rename-file) (set-file-acl . tramp-sh-handle-set-file-acl) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index db6b0fc174d..4af5a4204f2 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -274,6 +274,7 @@ See `tramp-actions-before-shell' for more info.") ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-smb-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) + (list-system-processes . ignore) (load . tramp-handle-load) (lock-file . tramp-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) @@ -283,6 +284,7 @@ See `tramp-actions-before-shell' for more info.") (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . ignore) (make-symbolic-link . tramp-smb-handle-make-symbolic-link) + (process-attributes . ignore) (process-file . tramp-smb-handle-process-file) (rename-file . tramp-smb-handle-rename-file) (set-file-acl . tramp-smb-handle-set-file-acl) diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 9dcb6259fb1..02c0da3f184 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -126,6 +126,7 @@ ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-handle-insert-directory) (insert-file-contents . tramp-sshfs-handle-insert-file-contents) + (list-system-processes . tramp-handle-list-system-processes) (load . tramp-handle-load) (lock-file . tramp-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) @@ -135,6 +136,7 @@ (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . tramp-handle-make-process) (make-symbolic-link . tramp-handle-make-symbolic-link) + (process-attributes . tramp-handle-process-attributes) (process-file . tramp-sshfs-handle-process-file) (rename-file . tramp-sshfs-handle-rename-file) (set-file-acl . ignore) diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el index 242a6c7f587..fb885ebd054 100644 --- a/lisp/net/tramp-sudoedit.el +++ b/lisp/net/tramp-sudoedit.el @@ -117,6 +117,7 @@ See `tramp-actions-before-shell' for more info.") ;; `get-file-buffer' performed by default handler. (insert-directory . tramp-handle-insert-directory) (insert-file-contents . tramp-handle-insert-file-contents) + (list-system-processes . ignore) (load . tramp-handle-load) (lock-file . tramp-handle-lock-file) (make-auto-save-file-name . tramp-handle-make-auto-save-file-name) @@ -126,6 +127,7 @@ See `tramp-actions-before-shell' for more info.") (make-nearby-temp-file . tramp-handle-make-nearby-temp-file) (make-process . ignore) (make-symbolic-link . tramp-sudoedit-handle-make-symbolic-link) + (process-attributes . ignore) (process-file . ignore) (rename-file . tramp-sudoedit-handle-rename-file) (set-file-acl . tramp-sudoedit-handle-set-file-acl) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index bddbe3f91a2..1f429edf4f8 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2599,7 +2599,9 @@ Must be handled by the callers." '(make-nearby-temp-file process-file shell-command start-file-process temporary-file-directory ;; Emacs 27+ only. - exec-path make-process)) + exec-path make-process + ;; Emacs 29+ only. + list-system-processes process-attributes)) default-directory) ;; PROC. ((member operation '(file-notify-rm-watch file-notify-valid-p)) @@ -4001,6 +4003,155 @@ Let-bind it when necessary.") ;; Result. (cons filename (cdr result))))) +(defun tramp-ps-time () + "Read printed time oif \"ps\" in format \"[[DD-]hh:]mm:ss\". +Return it as number of seconds. Used in `tramp-process-attributes-ps-format'." + (search-forward-regexp "\\s-+") + (search-forward-regexp + (concat + "\\(?:" "\\(?:" "\\([0-9]+\\)-" "\\)?" + "\\([0-9]+\\):" "\\)?" + "\\([0-9]+\\):" + ;; Seconds can also be a floating point number. + "\\([0-9.]+\\)") + (line-end-position) 'noerror) + (+ (* 24 60 60 (string-to-number (or (match-string 1) "0"))) + (* 60 60 (string-to-number (or (match-string 2) "0"))) + (* 60 (string-to-number (or (match-string 3) "0"))) + (string-to-number (or (match-string 4) "0")))) + +(defconst tramp-process-attributes-ps-args + `("-eww" + "-o" + ,(mapconcat + #'identity + '("pid" + "euid" + "euser" + "egid" + "egroup" + "comm:80" + "state" + "ppid" + "pgrp" + "sess" + "tname" + "tpgid" + "min_flt" + "maj_flt" + "times" + "pri" + "nice" + "thcount" + "vsize" + "rss" + "etimes" + "pcpu" + "pmem" + "args") + ",")) + "List of arguments for calling \"ps\". +See `tramp-get-process-attributes'. + +This list is the default value on remote GNU/Linux systems.") + +(defconst tramp-process-attributes-ps-format + '((pid . number) + (euid . number) + (user . string) + (egid . number) + (group . string) + (comm . 80) + (state . string) + (ppid . number) + (pgrp . number) + (sess . number) + (ttname . string) + (tpgid . number) + (minflt . number) + (majflt . number) + (time . number) + (pri . number) + (nice . number) + (thcount . number) + (vsize . number) + (rss . number) + (etime . number) + (pcpu . number) + (pmem . number) + (args . nil)) + "Alist where each element is a cons cell of the form `\(KEY . TYPE)'. +KEY is a key (symbol) used in `process-attributes'. TYPE is the +printed result for KEY of the \"ps\" command, it can be `number', +`string', a number (string of that length), a symbol (a function +to be applied), or nil (for the last column of the \"ps\" output. + +This alist is used to parse the output of calling \"ps\" in +`tramp-get-process-attributes'. + +This alist is the default value on remote GNU/Linux systems.") + +(defun tramp-get-process-attributes (vec) + "Return all process attributes for connection VEC. +Parsing the remote \"ps\" output is controlled by +`tramp-process-attributes-ps-args' and +`tramp-process-attributes-ps-format'. + +It is not guaranteed, that all process attributes as described in +`process-attributes' are returned. The additional attribute +`pid' shall be returned always." + (with-tramp-file-property vec "/" "process-attributes" + (ignore-errors + (with-temp-buffer + (hack-connection-local-variables-apply + (connection-local-criteria-for-default-directory)) + ;; (pop-to-buffer (current-buffer)) + (when (zerop + (apply + #'process-file + "ps" nil t nil tramp-process-attributes-ps-args)) + (let (result res) + (goto-char (point-min)) + (while (not (eobp)) + ;; (tramp-test-message + ;; "%s" (buffer-substring (point) (line-end-position))) + (when (save-excursion + (search-forward-regexp + "[[:digit:]]" (line-end-position) 'noerror)) + (setq res nil) + (dolist (elt tramp-process-attributes-ps-format) + (push + (cons + (car elt) + (cond + ((eq (cdr elt) 'number) (read (current-buffer))) + ((eq (cdr elt) 'string) + (search-forward-regexp "\\S-+") + (match-string 0)) + ((numberp (cdr elt)) + (search-forward-regexp "\\s-+") + (search-forward-regexp ".+" (+ (point) (cdr elt))) + (string-trim (match-string 0))) + ((fboundp (cdr elt)) + (funcall (cdr elt))) + ((null (cdr elt)) + (search-forward-regexp "\\s-+") + (buffer-substring (point) (line-end-position))) + (t nil))) + res)) + ;; `nice' could be `-'. + (setq res (rassq-delete-all '- res)) + (push (append res) result)) + (forward-line)) + ;; Return result. + result)))))) + +(defun tramp-handle-list-system-processes () + "Like `list-system-processes' for Tramp files." + (let ((v (tramp-dissect-file-name default-directory))) + (tramp-flush-file-property v "/" "process-attributes") + (mapcar (lambda (x) (cdr (assq 'pid x))) (tramp-get-process-attributes v)))) + (defun tramp-get-lock-file (file) "Read lockfile info of FILE. Return nil when there is no lockfile." @@ -4407,6 +4558,14 @@ support symbolic links." (tramp-dissect-file-name (expand-file-name linkname)) 'file-error "make-symbolic-link not supported")) +(defun tramp-handle-process-attributes (pid) + "Like `process-attributes' for Tramp files." + (catch 'result + (dolist (elt (tramp-get-process-attributes + (tramp-dissect-file-name default-directory))) + (when (= (cdr (assq 'pid elt)) pid) + (throw 'result elt))))) + (defun tramp-handle-shell-command (command &optional output-buffer error-buffer) "Like `shell-command' for Tramp files." (let* ((asynchronous (string-match-p "[ \t]*&[ \t]*\\'" command)) diff --git a/lisp/proced.el b/lisp/proced.el index 7966ccfb084..a27638d3679 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -51,6 +51,12 @@ :group 'unix :prefix "proced-") +(defcustom proced-show-remote-processes nil + "Whether processes of the remote host shall be shown. +This happens only when `default-directory' is remote." + :version "29.1" + :type 'boolean) + (defcustom proced-signal-function #'signal-process "Name of signal function. It can be an elisp function (usually `signal-process') or a string specifying @@ -59,13 +65,6 @@ the external command (usually \"kill\")." (string :tag "command"))) (make-obsolete-variable 'proced-signal-function "no longer used." "29.1") -(defcustom proced-remote-directory "/sudo::" - "Remote directory to be used when sending a signal. -It must point to the local host, via a `sudo' or `doas' method, -or alike. See `proced-send-signal' and `proced-renice'." - :version "29.1" - :type '(string :tag "remote directory")) - (defcustom proced-renice-command "renice" "Name of renice command." :version "24.3" @@ -279,8 +278,8 @@ It can also be a list of keys appearing in `proced-grammar-alist'." ;; FIXME: is there a better name for filter `user' that does not coincide ;; with an attribute key? (defcustom proced-filter-alist - `((user (user . ,(concat "\\`" (regexp-quote (user-real-login-name)) "\\'"))) - (user-running (user . ,(concat "\\`" (regexp-quote (user-real-login-name)) "\\'")) + `((user (user . proced-user-name)) + (user-running (user . proced-user-name) (state . "\\`[Rr]\\'")) (all) (all-running (state . "\\`[Rr]\\'")) @@ -370,7 +369,7 @@ May be used to revert the process listing." ;; Internal variables -(defvar proced-available (not (null (list-system-processes))) +(defvar proced-available t;(not (null (list-system-processes))) "Non-nil means Proced is known to work on this system.") (defvar-local proced-process-alist nil @@ -569,6 +568,12 @@ Important: the match ends just after the marker.") :help "Renice Marked Processes"])) ;; helper functions +(defun proced-user-name (user) + "Check the `user' attribute with user name `proced' is running for." + (string-equal user (if (file-remote-p default-directory) + (file-remote-p default-directory 'user) + (user-real-login-name)))) + (defun proced-marker-regexp () "Return regexp matching `proced-marker-char'." ;; `proced-marker-char' must appear in column zero @@ -631,8 +636,6 @@ Type \\[proced] to start a Proced session. In a Proced buffer type \\\\[proced-mark] to mark a process for later commands. Type \\[proced-send-signal] to send signals to marked processes. Type \\[proced-renice] to renice marked processes. -With a prefix argument \\[universal-argument], sending signals to and renicing of processes -will be performed with the credentials of `proced-remote-directory'. The initial content of a listing is defined by the variable `proced-filter' and the variable `proced-format'. @@ -684,8 +687,13 @@ After displaying or updating a Proced buffer, Proced runs the normal hook (defun proced (&optional arg) "Generate a listing of UNIX system processes. \\ -If invoked with optional ARG, do not select the window displaying -the process information. +If invoked with optional non-negative ARG, do not select the +window displaying the process information. + +If `proced-show-remote-processes' is non-nil or the command is +invoked with a negative ARG `\\[universal-argument] \\[negative-argument]', \ +and `default-directory' +points to a remote host, the system processes of that host are shown. This function runs the normal hook `proced-post-display-hook'. @@ -696,6 +704,11 @@ Proced buffers." (error "Proced is not available on this system")) (let ((buffer (get-buffer-create "*Proced*")) new) (set-buffer buffer) + (when (and (file-remote-p default-directory) + (not + (or proced-show-remote-processes + (eq arg '-)))) + (setq default-directory temporary-file-directory)) (setq new (zerop (buffer-size))) (when new (proced-mode) @@ -1413,7 +1426,7 @@ Replace newline characters by \"^J\" (two characters)." ;; If none of the alternatives is non-nil, the attribute is ignored ;; in the listing. (let ((standard-attributes - (car (proced-process-attributes (list (emacs-pid))))) + (car (proced-process-attributes (list-system-processes)))) new-format fmi) (if (and proced-tree-flag (assq 'ppid standard-attributes)) @@ -1773,10 +1786,7 @@ runs the normal hook `proced-after-send-signal-hook'. For backward compatibility SIGNAL and PROCESS-ALIST may be nil. Then PROCESS-ALIST contains the marked processes or the process point is on and SIGNAL is queried interactively. This noninteractive usage is still -supported but discouraged. It will be removed in a future version of Emacs. - -With a prefix argument \\[universal-argument], send the signal with the credentials of -`proced-remote-directory'." +supported but discouraged. It will be removed in a future version of Emacs." (interactive (let* ((process-alist (proced-marked-processes)) (pnum (if (= 1 (length process-alist)) @@ -1818,10 +1828,7 @@ With a prefix argument \\[universal-argument], send the signal with the credenti proced-signal-list nil nil nil nil "TERM")))))) - (let ((default-directory - (if (and current-prefix-arg (stringp proced-remote-directory)) - proced-remote-directory temporary-file-directory)) - failures) + (let (failures) ;; Why not always use `signal-process'? See ;; https://lists.gnu.org/r/emacs-devel/2008-03/msg02955.html (if (functionp proced-signal-function) @@ -1876,10 +1883,7 @@ PROCESS-ALIST is an alist as returned by `proced-marked-processes'. Interactively, PROCESS-ALIST contains the marked processes. If no process is marked, it contains the process point is on, After renicing all processes in PROCESS-ALIST, this command runs -the normal hook `proced-after-send-signal-hook'. - -With a prefix argument \\[universal-argument], apply renice with the credentials of -`proced-remote-directory'." +the normal hook `proced-after-send-signal-hook'." (interactive (let ((process-alist (proced-marked-processes))) (proced-with-processes-buffer process-alist @@ -1888,10 +1892,7 @@ With a prefix argument \\[universal-argument], apply renice with the credentials proced-mode) (if (numberp priority) (setq priority (number-to-string priority))) - (let ((default-directory - (if (and current-prefix-arg (stringp proced-remote-directory)) - proced-remote-directory temporary-file-directory)) - failures) + (let (failures) (dolist (process process-alist) (with-temp-buffer (condition-case nil diff --git a/src/process.c b/src/process.c index e8aafd02d74..d4a78521ab1 100644 --- a/src/process.c +++ b/src/process.c @@ -8203,16 +8203,25 @@ DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes, 0, 0, 0, doc: /* Return a list of numerical process IDs of all running processes. If this functionality is unsupported, return nil. +If `default-directory' is remote, return process IDs of the respective remote host. See `process-attributes' for getting attributes of a process given its ID. */) (void) { + Lisp_Object handler + = Ffind_file_name_handler (BVAR (current_buffer, directory), + Qlist_system_processes); + if (!NILP (handler)) + return call1 (handler, Qlist_system_processes); + return list_system_processes (); } DEFUN ("process-attributes", Fprocess_attributes, Sprocess_attributes, 1, 1, 0, doc: /* Return attributes of the process given by its PID, a number. +If `default-directory' is remote, PID is regarded as process +identifier on the respective remote host. Value is an alist where each element is a cons cell of the form @@ -8263,6 +8272,12 @@ integer or floating point values. args -- command line which invoked the process (string). */) ( Lisp_Object pid) { + Lisp_Object handler + = Ffind_file_name_handler (BVAR (current_buffer, directory), + Qprocess_attributes); + if (!NILP (handler)) + return call2 (handler, Qprocess_attributes, pid); + return system_process_attributes (pid); } @@ -8438,6 +8453,8 @@ void syms_of_process (void) { DEFSYM (Qmake_process, "make-process"); + DEFSYM (Qlist_system_processes, "list-system-processes"); + DEFSYM (Qprocess_attributes, "process-attributes"); #ifdef subprocesses -- 2.39.5