* 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.
(require 'tramp)
+(defvar process-file-return-signal-string)
+
;;;###tramp-autoload
(defcustom tramp-adb-program "adb"
"Name of the Android Debug Bridge program."
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."
;; 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))
(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)
(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."
;; 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))
(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'
;; 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 $$"))))
projects / emacs.git / commitdiff