Re: process-file instead of call-process in proced.el?

[Michael Albinus <michael.albinus@gmx.de>]

[-- Attachment #1: Type: text/plain, Size: 927 bytes --]

Michael Albinus <michael.albinus@gmx.de> writes:

Hi,

> I see. So if we don't want to emulate list-system-processes on a remote
> host, we need another mean to determine, that a process is killed in a
> sudo environment.

I've prepared a first version of a patch (still missing documentation),
see appended. The changes are:

- `signal-process' is capable now to signal remote processes. This is
  triggered when either the PROCESS object has the property `remote-pid'
  (set by Tramp), or the PROCESS is just a number, and the additional
  optional parameter REMOTE is a remote file name.

- There is a new user option `proced-remote-directory', which defaults
  to "/sudo::". When `proced-send-signal' or `proced-renice' are invoked
  with a prefix arg ("C-u k" or "C-u r" in the *Proced* buffer), the
  respective signal is sent with the credentials as identified by this
  user option.

Comments?

Best regards, Michael.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 11026 bytes --]

diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 0192a63a10..ff42a22765 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -5957,6 +5957,43 @@ tramp-interrupt-process
  (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.  Furthermore, if REMOTE is a remote file name, this
+number is interpreted as process id 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 c1d599afc4..7966ccfb08 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 @@ proced-signal-function
 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 @@ proced-mode
 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 @@ proced-send-signal
 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 @@ proced-send-signal
                                         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 @@ proced-send-signal
           (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 @@ proced-send-signal
         (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 @@ proced-renice
 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 @@ proced-renice
    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 993e1c5603..fcff9c71ac 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,21 @@ DEFUN ("signal-process", Fsignal_process, Ssignal_process,
   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.  Furthermore, if REMOTE is a remote file name, this
+number is interpreted as process id 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 +8594,13 @@ syms_of_process (void)
 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 +8621,10 @@ syms_of_process (void)
 	  "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 +8679,7 @@ syms_of_process (void)
   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);