Commit b04d391d authored by Michael Albinus's avatar Michael Albinus

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.
parent f1097d7a
Pipeline #6189 failed with stage
in 40 minutes and 34 seconds
......@@ -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))
......
......@@ -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))
......
......@@ -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'
......
......@@ -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 $$"))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment