From: Michael Albinus Date: Sat, 1 Aug 2020 18:08:44 +0000 (+0200) Subject: Implement alternative for Tramp's signal return string X-Git-Tag: emacs-28.0.90~6876 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=b04d391d796281faf0f824ed398b26a9a1758f8d;p=emacs.git 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. --- diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index c1eb36e3405..7e5af6910bb 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 1a867c30feb..9f37207def1 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 19cf3334502..c169a86f915 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 34782e7f151..19da15acafa 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 $$"))))