master b04d391: Implement alternative for Tramp's signal return string

[Michael Albinus]

branch: master
commit b04d391d796281faf0f824ed398b26a9a1758f8d
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>

    Implement alternative for Tramp's signal return string
    
    * lisp/net/tramp-adb.el (process-file-return-signal-string): Declare.
    (tramp-adb-get-signal-strings): New defun.
    (tramp-adb-handle-process-file): Use it.
    
    * lisp/net/tramp-sh.el (process-file-return-signal-string): Declare.
    (tramp-sh-get-signal-strings): New defun.
    (tramp-sh-handle-process-file): Use it.
    
    * lisp/net/tramp.el (tramp-get-signal-strings): Remove function.
    
    * test/lisp/net/tramp-tests.el (tramp-test28-process-file):
    Accept alternative signal return string.
---
 lisp/net/tramp-adb.el        | 31 ++++++++++++++++++++++-
 lisp/net/tramp-sh.el         | 58 +++++++++++++++++++++++++++++++++++++++++++-
 lisp/net/tramp.el            | 17 -------------
 test/lisp/net/tramp-tests.el |  4 +--
 4 files changed, 89 insertions(+), 21 deletions(-)

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index c1eb36e..7e5af69 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -35,6 +35,8 @@
 
 (require 'tramp)
 
+(defvar process-file-return-signal-string)
+
 ;;;###tramp-autoload
 (defcustom tramp-adb-program "adb"
   "Name of the Android Debug Bridge program."
@@ -741,6 +743,33 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
             filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
            (delete-file filename)))))))
 
+(defun tramp-adb-get-signal-strings (vec)
+  "Strings to return by `process-file' in case of signals."
+  (with-tramp-connection-property vec "signal-strings"
+    (let ((default-directory (tramp-make-tramp-file-name vec 'localname))
+         ;; `shell-file-name' and `shell-command-switch' are needed
+         ;; for Emacs < 27.1, which doesn't support connection-local
+         ;; variables in `shell-command'.
+         (shell-file-name "/system/bin/sh")
+         (shell-command-switch "-c")
+         process-file-return-signal-string signals result)
+      (dotimes (i 128) (push (format "Signal %d" i) result))
+      (setq result (reverse result)
+           signals (split-string
+                    (shell-command-to-string "COLUMNS=40 kill -l") "\n" 'omit))
+      (setcar result 0)
+      (dolist (line signals)
+       (when (string-match
+              (concat
+               "^[[:space:]]*\\([[:digit:]]+\\)"
+               "[[:space:]]+\\S-+[[:space:]]+"
+               "\\([[:alpha:]].*\\)$")
+              line)
+         (setcar
+          (nthcdr (string-to-number (match-string 1 line)) result)
+          (match-string 2 line))))
+      result)))
+
 (defun tramp-adb-handle-process-file
   (program &optional infile destination display &rest args)
   "Like `process-file' for Tramp files."
@@ -833,7 +862,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
       ;; since Emacs 28.1.
       (when (and (bound-and-true-p process-file-return-signal-string)
                 (natnump ret) (> ret 128))
-       (setq ret (nth (- ret 128) (tramp-get-signal-strings))))
+       (setq ret (nth (- ret 128) (tramp-adb-get-signal-strings v))))
 
       ;; Provide error file.
       (when tmpstderr (rename-file tmpstderr (cadr destination) t))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 1a867c3..9f37207 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -36,6 +36,7 @@
 
 (declare-function dired-remove-file "dired-aux")
 (defvar dired-compress-file-suffixes)
+(defvar process-file-return-signal-string)
 (defvar vc-handled-backends)
 (defvar vc-bzr-program)
 (defvar vc-git-program)
@@ -3009,6 +3010,61 @@ STDERR can also be a file name."
              (tramp-flush-connection-property v "process-name")
              (tramp-flush-connection-property v "process-buffer"))))))))
 
+(defun tramp-sh-get-signal-strings (vec)
+  "Strings to return by `process-file' in case of signals."
+  (with-tramp-connection-property
+      vec
+      (concat
+       "signal-strings-" (tramp-get-method-parameter vec 'tramp-remote-shell))
+    (let ((default-directory (tramp-make-tramp-file-name vec 'localname))
+         process-file-return-signal-string signals res result)
+      (setq signals
+           (append
+            '(0) (split-string (shell-command-to-string "kill -l") nil 'omit)))
+      ;; Sanity check.  "kill -l" shall have returned just the signal
+      ;; names.  Some shells don't, like the one in "docker alpine".
+      (let (signal-hook-function)
+       (condition-case nil
+           (dolist (sig (cdr signals))
+             (unless (string-match-p "^[[:alnum:]+-]+$" sig)
+               (error nil)))
+         (error (setq signals '(0)))))
+      (dotimes (i 128)
+       (push
+        (cond
+         ;; Some predefined values, which aren't reported sometimes,
+         ;; or would raise problems (all Stopped signals).
+         ((= i 0) 0)
+         ((string-equal (nth i signals) "HUP") "Hangup")
+         ((string-equal (nth i signals) "INT") "Interrupt")
+         ((string-equal (nth i signals) "QUIT") "Quit")
+         ((string-equal (nth i signals) "STOP") "Stopped (signal)")
+         ((string-equal (nth i signals) "TSTP") "Stopped")
+         ((string-equal (nth i signals) "TTIN") "Stopped (tty input)")
+         ((string-equal (nth i signals) "TTOU") "Stopped (tty output)")
+         (t (setq res
+                  (if (null (nth i signals))
+                      ""
+                    (tramp-send-command
+                     vec
+                     (format
+                      "%s %s %s"
+                      (tramp-get-method-parameter vec 'tramp-remote-shell)
+                      (mapconcat
+                       #'identity
+                       (tramp-get-method-parameter vec 
'tramp-remote-shell-args)
+                       " ")
+                      (tramp-shell-quote-argument (format "kill -%d $$" i))))
+                    (with-current-buffer (tramp-get-connection-buffer vec)
+                      (goto-char (point-min))
+                      (buffer-substring (point-at-bol) (point-at-eol)))))
+            (if (string-equal res "")
+                (format "Signal %d" i)
+              res)))
+        result))
+      ;; Due to Bug#41287, we cannot add this to the `dotimes' clause.
+      (reverse result))))
+
 (defun tramp-sh-handle-process-file
   (program &optional infile destination display &rest args)
   "Like `process-file' for Tramp files."
@@ -3126,7 +3182,7 @@ STDERR can also be a file name."
       ;; since Emacs 28.1.
       (when (and (bound-and-true-p process-file-return-signal-string)
                 (natnump ret) (>= ret 128))
-       (setq ret (nth (- ret 128) (tramp-get-signal-strings))))
+       (setq ret (nth (- ret 128) (tramp-sh-get-signal-strings v))))
 
       ;; Provide error file.
       (when tmpstderr (rename-file tmpstderr (cadr destination) t))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 19cf333..c169a86 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -5108,23 +5108,6 @@ 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-get-signal-strings ()
-  "Strings to return by `process-file' in case of signals."
-  ;; We use key nil for local connection properties.
-  (with-tramp-connection-property nil "signal-strings"
-    (let (result)
-      (if (and (stringp shell-file-name) (executable-find shell-file-name))
-         (dotimes (i 128)
-           (push
-            (if (= i 19) 1 ;; SIGSTOP
-              (call-process
-               shell-file-name nil nil nil "-c" (format "kill -%d $$" i)))
-            result))
-       (dotimes (i 128)
-         (push (format "Signal %d" i) result)))
-      ;; Due to Bug#41287, we cannot add this to the `dotimes' clause.
-      (reverse result))))
-
 ;; Checklist for `tramp-unload-hook'
 ;; - Unload all `tramp-*' packages
 ;; - Reset `file-name-handler-alist'
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 34782e7..19da15a 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -4256,8 +4256,8 @@ This tests also `make-symbolic-link', `file-truename' and 
`add-name-to-file'."
            ;; there's an indication for a signal describing string.
            (let ((process-file-return-signal-string t))
              (should
-              (string-equal
-               "Interrupt"
+              (string-match
+               "Interrupt\\|Signal 2"
                (process-file
                 (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
                 nil nil nil "-c" "kill -2 $$"))))