diff options
author | Michael Albinus <michael.albinus@gmx.de> | 2022-03-30 13:16:54 +0200 |
---|---|---|
committer | Michael Albinus <michael.albinus@gmx.de> | 2022-03-30 13:16:54 +0200 |
commit | 2212b42806757957fff6a9646debddecb301241c (patch) | |
tree | 8ded1ebd36764c9f8253e60d672b693716a38e21 /lisp | |
parent | c0f5e0a559bab530d6a2e1de3bb021d004a855cf (diff) | |
download | emacs-2212b42806757957fff6a9646debddecb301241c.tar.gz emacs-2212b42806757957fff6a9646debddecb301241c.tar.bz2 emacs-2212b42806757957fff6a9646debddecb301241c.zip |
Extend signal-process and proced.el
* doc/lispref/processes.texi (Signals to Processes):
Document changes in signal-process.
* etc/NEWS: Mention changes in proced.el and signal-process.
* lisp/proced.el (proced-signal-function): Declare it obsolete.
(proced-remote-directory): New user option.
(proced-mode): Adapt docstring.
(proced-send-signal, proced-renice): Handle interactive prefix argument.
* lisp/net/tramp.el (tramp-signal-process): New defun. Add it to
`signal-process-functions'.
* src/process.c (Finternal_default_signal_process): New defun,
providing the hitherto existing implementation of Fsignal_process.
(Fsignal_process): Loop through Vsignal_process_functions.
(Vsignal_process_functions): New defvar.
(Qinternal_default_signal_process, Qsignal_process_functions):
Declare symbols.
(Sinternal_default_signal_process): Declare subroutine.
* test/lisp/net/tramp-tests.el (tramp-test31-signal-process): New test.
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/net/tramp.el | 39 | ||||
-rw-r--r-- | lisp/proced.el | 42 |
2 files changed, 70 insertions, 11 deletions
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 4e5eed9d997..bddbe3f91a2 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -5961,6 +5961,45 @@ name of a process or buffer, or nil to default to the current buffer." (lambda () (remove-hook 'interrupt-process-functions #'tramp-interrupt-process))) +(defun tramp-signal-process (process sigcode &optional remote) + "Send PROCESS the signal with code SIGCODE. +PROCESS may also be a number specifying the process id of the +process to signal; in this case, the process need not be a child of +this Emacs. +If PROCESS is a process object which contains the property +`remote-pid', or PROCESS is a number and REMOTE is a remote file name, +PROCESS is interpreted as process on the respective remote host, which +will be the process to signal. +SIGCODE may be an integer, or a symbol whose name is a signal name." + (let (pid vec) + (cond + ((processp process) + (setq pid (process-get process 'remote-pid) + vec (process-get process 'vector))) + ((numberp process) + (setq pid process + vec (and (stringp remote) (tramp-dissect-file-name remote)))) + (t (signal 'wrong-type-argument (list #'processp process)))) + (unless (or (numberp sigcode) (symbolp sigcode)) + (signal 'wrong-type-argument (list #'numberp sigcode))) + ;; If it's a Tramp process, send SIGCODE remotely. + (when (and pid vec) + (tramp-message + vec 5 "Send signal %s to process %s with pid %s" sigcode process pid) + ;; This is for tramp-sh.el. Other backends do not support this (yet). + (if (tramp-compat-funcall + 'tramp-send-command-and-check + vec (format "\\kill -%s %d" sigcode pid)) + 0 -1)))) + +;; `signal-process-functions' exists since Emacs 29.1. +(when (boundp 'signal-process-functions) + (add-hook 'signal-process-functions #'tramp-signal-process) + (add-hook + 'tramp-unload-hook + (lambda () + (remove-hook 'signal-process-functions #'tramp-signal-process)))) + (defun tramp-get-remote-null-device (vec) "Return null device on the remote host identified by VEC. If VEC is `tramp-null-hop', return local null device." diff --git a/lisp/proced.el b/lisp/proced.el index c1d599afc4a..7966ccfb084 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -29,10 +29,6 @@ ;; ;; To do: ;; - Interactive temporary customizability of flags in `proced-grammar-alist' -;; - Allow "sudo kill PID", "sudo renice PID" -;; `proced-send-signal' operates on multiple processes one by one. -;; With "sudo" we want to execute one "kill" or "renice" command -;; for all marked processes. Is there a `sudo-call-process'? ;; ;; Thoughts and Ideas ;; - Currently, `process-attributes' returns the list of @@ -61,6 +57,14 @@ It can be an elisp function (usually `signal-process') or a string specifying the external command (usually \"kill\")." :type '(choice (function :tag "function") (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." @@ -626,6 +630,9 @@ Return nil if point is not on a process line." Type \\[proced] to start a Proced session. In a Proced buffer type \\<proced-mode-map>\\[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'. @@ -1766,7 +1773,10 @@ 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." +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'." (interactive (let* ((process-alist (proced-marked-processes)) (pnum (if (= 1 (length process-alist)) @@ -1808,7 +1818,10 @@ supported but discouraged. It will be removed in a future version of Emacs." proced-signal-list nil nil nil nil "TERM")))))) - (let (failures) + (let ((default-directory + (if (and current-prefix-arg (stringp proced-remote-directory)) + proced-remote-directory temporary-file-directory)) + failures) ;; Why not always use `signal-process'? See ;; https://lists.gnu.org/r/emacs-devel/2008-03/msg02955.html (if (functionp proced-signal-function) @@ -1821,7 +1834,8 @@ supported but discouraged. It will be removed in a future version of Emacs." (dolist (process process-alist) (condition-case err (unless (zerop (funcall - proced-signal-function (car process) signal)) + proced-signal-function (car process) signal + (file-remote-p default-directory))) (proced-log "%s\n" (cdr process)) (push (cdr process) failures)) (error ; catch errors from failed signals @@ -1833,7 +1847,7 @@ supported but discouraged. It will be removed in a future version of Emacs." (dolist (process process-alist) (with-temp-buffer (condition-case nil - (unless (zerop (call-process + (unless (zerop (process-file proced-signal-function nil t nil signal (number-to-string (car process)))) (proced-log (current-buffer)) @@ -1862,7 +1876,10 @@ 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'." +the normal hook `proced-after-send-signal-hook'. + +With a prefix argument \\[universal-argument], apply renice with the credentials of +`proced-remote-directory'." (interactive (let ((process-alist (proced-marked-processes))) (proced-with-processes-buffer process-alist @@ -1871,11 +1888,14 @@ the normal hook `proced-after-send-signal-hook'." proced-mode) (if (numberp priority) (setq priority (number-to-string priority))) - (let (failures) + (let ((default-directory + (if (and current-prefix-arg (stringp proced-remote-directory)) + proced-remote-directory temporary-file-directory)) + failures) (dolist (process process-alist) (with-temp-buffer (condition-case nil - (unless (zerop (call-process + (unless (zerop (process-file proced-renice-command nil t nil priority (number-to-string (car process)))) (proced-log (current-buffer)) |