From: Michael Albinus Date: Wed, 30 Mar 2022 11:16:54 +0000 (+0200) Subject: Extend signal-process and proced.el X-Git-Tag: emacs-29.0.90~1931^2~859 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=2212b42806757957fff6a9646debddecb301241c;p=emacs.git 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. --- diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index ea51abda4b7..ffc0f10a786 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -1472,7 +1472,7 @@ incoming data from the connection. For serial connections, data that arrived during the time the process was stopped might be lost. @end defun -@deffn Command signal-process process signal +@deffn Command signal-process process signal &optional remote This function sends a signal to process @var{process}. The argument @var{signal} specifies which signal to send; it should be an integer, or a symbol whose name is a signal. @@ -1480,12 +1480,18 @@ or a symbol whose name is a signal. The @var{process} argument can be a system process @acronym{ID} (an integer); that allows you to send signals to processes that are not children of Emacs. @xref{System Processes}. + +If @var{process} is a process object which contains the property +@code{remote-pid}, or @var{process} is a number and @var{remote} is a +remote file name, @var{process} is interpreted as process on the +respective remote host, which will be the process to signal. @end deffn Sometimes, it is necessary to send a signal to a non-local asynchronous process. This is possible by writing an own -@code{interrupt-process} implementation. This function must be added -then to @code{interrupt-process-functions}. +@code{interrupt-process} or @code{signal-process} implementation. +This function must be added then to @code{interrupt-process-functions} +or @code{signal-process-functions}, respectively. @defvar interrupt-process-functions This variable is a list of functions to be called for @@ -1498,6 +1504,17 @@ default function, which shall always be the last in this list, is This is the mechanism, how Tramp implements @code{interrupt-process}. @end defvar +@defvar signal-process-functions +This variable is a list of functions to be called for +@code{signal-process}. The arguments of the functions are the same as +for @code{signal-process}. These functions are called in the order of +the list, until one of them returns non-@code{nil}. The default +function, which shall always be the last in this list, is +@code{signal-default-interrupt-process}. + +This is the mechanism, how Tramp implements @code{signal-process}. +@end defvar + @node Output from Processes @section Receiving Output from Processes @cindex process output diff --git a/etc/NEWS b/etc/NEWS index e684ee30f0e..aaab0f45170 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -132,8 +132,8 @@ If you have code in your init file that removes directories from To get the previous action back, put something like the following in your init file: - (require 'ido) - (keymap-set ido-file-completion-map "C-k" #'ido-delete-file-at-head) + (require 'ido) + (keymap-set ido-file-completion-map "C-k" #'ido-delete-file-at-head) --- ** New user option 'term-clear-full-screen-programs'. @@ -590,8 +590,8 @@ value. To enable this behavior, customize the user option 'completion-auto-select' to t, then pressing 'TAB' will switch to the "*Completions*" buffer when it pops up that buffer. If the value is -'second-tab', then the first tab will display "*Completions*", and the -second one will switch to the "*Completions*" buffer. +'second-tab', then the first 'TAB' will display "*Completions*", and +the second one will switch to the "*Completions*" buffer. *** New user option 'completion-wrap-movement'. When non-nil, the commands 'next-completion' and 'previous-completion' @@ -710,8 +710,8 @@ It narrows to the current node. +++ *** 'eudc-expansion-overwrites-query' to 'eudc-expansion-save-query-as-kill'. 'eudc-expansion-overwrites-query' is renamed to -'eudc-expansion-save-query-as-kill' to reflect the actual behaviour of -the customization variable. +'eudc-expansion-save-query-as-kill' to reflect the actual behavior of +the user option. +++ *** New command 'eudc-expand-try-all'. @@ -722,10 +722,10 @@ return any. This is useful for example, if one wants to search LDAP for a name that happens to match a contact in one's BBDB. +++ -*** New behaviour and default for option 'eudc-inline-expansion-format' +*** New behavior and default for user option 'eudc-inline-expansion-format'. EUDC inline expansion result formatting defaulted to - '("%s %s <%s>" firstname name email) + '("%s %s <%s>" firstname name email) Since email address specifications need to comply with RFC 5322 in order to be useful in messages, there was a risk to produce syntax @@ -738,7 +738,7 @@ function. In both cases, the formatted result will be in compliance with RFC 5322. When set to nil, a default format very similar to the old default will be produced. When set to a function, that function is called, and the returned values are used to populate the phrase and -comment parts (see RFC 5322 for definitions). In both cases, the +comment parts (see RFC 5322 for definitions). In both cases, the phrase part will be automatically quoted if necessary. ** eww/shr @@ -1153,13 +1153,20 @@ This library provides the 'autoarg-mode' and 'autoarg-kp-mode' minor 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. + * New Modes and Packages in Emacs 29.1 +++ ** New package 'oclosure'. Allows the creation of "functions with slots" or "function objects" -via the macros `oclosure-define` and `oclosure-lambda`. +via the macros 'oclosure-define' and 'oclosure-lambda'. --- ** New theme 'leuven-dark'. @@ -1814,6 +1821,13 @@ translation. This is useful when quoting shell arguments for a remote shell invocation. Such shells are POSIX conform by default. ++++ +** 'signal-process' now consults the list 'signal-process-functions'. +This is to determine which function has to be called in order to +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'. + * Changes in Emacs 29.1 on Non-Free Operating Systems 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-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)) diff --git a/src/process.c b/src/process.c index 993e1c56038..e8aafd02d74 100644 --- a/src/process.c +++ b/src/process.c @@ -7034,14 +7034,13 @@ abbr_to_signal (char const *name) return -1; } -DEFUN ("signal-process", Fsignal_process, Ssignal_process, - 2, 2, "sProcess (name or number): \nnSignal code: ", - doc: /* 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. -SIGCODE may be an integer, or a symbol whose name is a signal name. */) - (Lisp_Object process, Lisp_Object sigcode) +DEFUN ("internal-default-signal-process", + Finternal_default_signal_process, + Sinternal_default_signal_process, 2, 3, 0, + doc: /* Default function to send PROCESS the signal with code SIGCODE. +It shall be the last element in list `signal-process-functions'. +See function `signal-process' for more details on usage. */) + (Lisp_Object process, Lisp_Object sigcode, Lisp_Object remote) { pid_t pid; int signo; @@ -7091,6 +7090,23 @@ SIGCODE may be an integer, or a symbol whose name is a signal name. */) return make_fixnum (kill (pid, signo)); } +DEFUN ("signal-process", Fsignal_process, Ssignal_process, + 2, 3, "sProcess (name or number): \nnSignal code: ", + doc: /* 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. */) + (Lisp_Object process, Lisp_Object sigcode, Lisp_Object remote) +{ + return CALLN (Frun_hook_with_args_until_success, Qsignal_process_functions, + process, sigcode, remote); +} + DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0, doc: /* Make PROCESS see end-of-file in its input. EOF comes after any text already sent to it. @@ -8580,6 +8596,13 @@ These functions are called in the order of the list, until one of them returns non-nil. */); Vinterrupt_process_functions = list1 (Qinternal_default_interrupt_process); + DEFVAR_LISP ("signal-process-functions", Vsignal_process_functions, + doc: /* List of functions to be called for `signal-process'. +The arguments of the functions are the same as for `signal-process'. +These functions are called in the order of the list, until one of them +returns non-nil. */); + Vsignal_process_functions = list1 (Qinternal_default_signal_process); + DEFVAR_LISP ("internal--daemon-sockname", Vinternal__daemon_sockname, doc: /* Name of external socket passed to Emacs, or nil if none. */); Vinternal__daemon_sockname = Qnil; @@ -8600,6 +8623,10 @@ sentinel or a process filter function has an error. */); "internal-default-interrupt-process"); DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions"); + DEFSYM (Qinternal_default_signal_process, + "internal-default-signal-process"); + DEFSYM (Qsignal_process_functions, "signal-process-functions"); + DEFSYM (Qnull, "null"); DEFSYM (Qpipe_process_p, "pipe-process-p"); @@ -8654,6 +8681,7 @@ sentinel or a process filter function has an error. */); defsubr (&Scontinue_process); defsubr (&Sprocess_running_child_p); defsubr (&Sprocess_send_eof); + defsubr (&Sinternal_default_signal_process); defsubr (&Ssignal_process); defsubr (&Swaiting_for_user_input_p); defsubr (&Sprocess_type); diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 94ff12bab4d..c3b3f21d528 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -4984,6 +4984,7 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (ert-deftest tramp-test31-interrupt-process () "Check `interrupt-process'." :tags (append '(:expensive-test :tramp-asynchronous-processes) + ;; The final `process-live-p' check does not run sufficiently. (and (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")) '(:unstable))) (skip-unless (tramp--test-enabled)) @@ -5022,6 +5023,73 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." ;; Cleanup. (ignore-errors (delete-process proc))))) +(ert-deftest tramp-test31-signal-process () + "Check `signal-process'." + :tags (append '(:expensive-test :tramp-asynchronous-processes) + ;; The final `process-live-p' check does not run sufficiently. + (and (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")) + '(:unstable))) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-sh-p)) + (skip-unless (not (tramp--test-crypt-p))) + ;; Since Emacs 29.1. + (skip-unless (boundp 'signal-process-functions)) + + ;; We must use `file-truename' for the temporary directory, in + ;; order to establish the connection prior running an asynchronous + ;; process. + (let ((default-directory (file-truename tramp-test-temporary-file-directory)) + (delete-exited-processes t) + kill-buffer-query-functions command proc) + + (dolist (sigcode '(2 INT)) + (unwind-protect + (with-temp-buffer + (setq command "trap 'echo boom; exit 1' 2; sleep 100" + proc (start-file-process-shell-command + (format "test1%s" sigcode) (current-buffer) command)) + (should (processp proc)) + (should (process-live-p proc)) + (should (equal (process-status proc) 'run)) + (should (numberp (process-get proc 'remote-pid))) + (should (equal (process-get proc 'remote-command) + (with-connection-local-variables + `(,shell-file-name ,shell-command-switch ,command)))) + (should (zerop (signal-process proc sigcode))) + ;; Let the process accept the signal. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (accept-process-output proc 0 nil t))) + (should-not (process-live-p proc))) + + ;; Cleanup. + (ignore-errors (kill-process proc)) + (ignore-errors (delete-process proc))) + + (unwind-protect + (with-temp-buffer + (setq command "trap 'echo boom; exit 1' 2; sleep 100" + proc (start-file-process-shell-command + (format "test2%s" sigcode) (current-buffer) command)) + (should (processp proc)) + (should (process-live-p proc)) + (should (equal (process-status proc) 'run)) + (should (numberp (process-get proc 'remote-pid))) + (should (equal (process-get proc 'remote-command) + (with-connection-local-variables + `(,shell-file-name ,shell-command-switch ,command)))) + (should + (zerop + (signal-process + (process-get proc 'remote-pid) sigcode default-directory))) + ;; Let the process accept the signal. + (with-timeout (10 (tramp--test-timeout-handler)) + (while (accept-process-output proc 0 nil t))) + (should-not (process-live-p proc))) + + ;; Cleanup. + (ignore-errors (kill-process proc)) + (ignore-errors (delete-process proc)))))) + (defun tramp--test-async-shell-command (command output-buffer &optional error-buffer input) "Like `async-shell-command', reading the output.