Implement `interrupt-process' for remote processes (Bug#28066)

* lisp/net/tramp-sh.el (tramp-sh-handle-start-file-process):
Support sending signals remotely.
(tramp-open-connection-setup-interactive-shell):
Trace "remote-tty" connection property.

* lisp/net/tramp.el (tramp-advice-interrupt-process): New defun.
(top): Add advice to `interrupt-process'.  (Bug#28066)

* test/lisp/net/tramp-tests.el (tramp-test28-interrupt-process):
New test.
(tramp-test29-shell-command)
(tramp-test30-environment-variables)
(tramp-test30-environment-variables-and-port-numbers)
(tramp-test31-explicit-shell-file-name)
(tramp-test32-vc-registered)
(tramp-test33-make-auto-save-file-name)
(tramp-test34-make-nearby-temp-file)
(tramp-test35-special-characters)
(tramp-test35-special-characters-with-stat)
(tramp-test35-special-characters-with-perl)
(tramp-test35-special-characters-with-ls, tramp-test36-utf8)
(tramp-test36-utf8-with-stat, tramp-test36-utf8-with-perl)
(tramp-test36-utf8-with-ls)
(tramp-test37-asynchronous-requests)
(tramp-test38-recursive-load, tramp-test39-remote-load-path)
(tramp-test40-unload): Rename.
(tramp-test40-unload): Test also removal of advice.

2 files changed, 52 insertions, 18 deletions

diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 6b365c10e25..50b380100ba 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2875,7 +2875,8 @@ the result will be a local, non-Tramp, file name."
 	   ;; We do not want to raise an error when
 	   ;; `start-file-process' has been started several times in
 	   ;; `eshell' and friends.
-	   (tramp-current-connection nil))
+	   (tramp-current-connection nil)
+	   p)
 
       (while (get-process name1)
 	;; NAME must be unique as process name.
@@ -2905,33 +2906,37 @@ the result will be a local, non-Tramp, file name."
 		  ;; to cleanup the prompt afterwards.
 		  (catch 'suppress
 		    (tramp-maybe-open-connection v)
+		    (setq p (tramp-get-connection-process v))
+		    ;; Set the pid of the remote shell.  This is
+		    ;; needed when sending signals remotely.
+		    (let ((pid (tramp-send-command-and-read v "echo $$")))
+		      (process-put p 'remote-pid pid)
+		      (tramp-set-connection-property p "remote-pid" pid))
 		    (widen)
-		    (delete-region mark (point))
+		    (delete-region mark (point-max))
 		    (narrow-to-region (point-max) (point-max))
 		    ;; Now do it.
 		    (if command
 			;; Send the command.
 			(tramp-send-command v command nil t) ; nooutput
 		      ;; Check, whether a pty is associated.
-		      (unless (process-get
-			       (tramp-get-connection-process v) 'remote-tty)
+		      (unless (process-get p 'remote-tty)
 			(tramp-error
 			 v 'file-error
 			 "pty association is not supported for `%s'" name))))
-		  (let ((p (tramp-get-connection-process v)))
-		    ;; Set query flag and process marker for this
-		    ;; process.  We ignore errors, because the process
-		    ;; could have finished already.
-		    (ignore-errors
-		      (set-process-query-on-exit-flag p t)
-		      (set-marker (process-mark p) (point)))
-		    ;; Return process.
-		    p))))
+		  ;; Set query flag and process marker for this
+		  ;; process.  We ignore errors, because the process
+		  ;; could have finished already.
+		  (ignore-errors
+		    (set-process-query-on-exit-flag p t)
+		    (set-marker (process-mark p) (point)))
+		  ;; Return process.
+		  p)))
 
 	  ;; Save exit.
 	  (if (string-match tramp-temp-buffer-name (buffer-name))
 	      (ignore-errors
-		(set-process-buffer (tramp-get-connection-process v) nil)
+		(set-process-buffer p nil)
 		(kill-buffer (current-buffer)))
 	    (set-buffer-modified-p bmp))
 	  (tramp-set-connection-property v "process-name" nil)
@@ -4111,7 +4116,8 @@ process to set up.  VEC specifies the connection."
     ;; Set `remote-tty' process property.
     (let ((tty (tramp-send-command-and-read vec "echo \\\"`tty`\\\"" 'noerror)))
       (unless (zerop (length tty))
-	(process-put proc 'remote-tty tty)))
+	(process-put proc 'remote-tty tty)
+	(tramp-set-connection-property proc "remote-tty" tty)))
 
     ;; Dump stty settings in the traces.
     (when (>= tramp-verbose 9)
@@ -5687,9 +5693,6 @@ function cell is returned to be applied on a buffer."
 ;; * Reconnect directly to a compliant shell without first going
 ;;   through the user's default shell.  (Pete Forman)
 ;;
-;; * How can I interrupt the remote process with a signal
-;;   (interrupt-process seems not to work)?  (Markus Triska)
-;;
 ;; * Avoid the local shell entirely for starting remote processes.  If
 ;;   so, I think even a signal, when delivered directly to the local
 ;;   SSH instance, would correctly be propagated to the remote process
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 8d7fbc068b8..3469d45ff2a 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -4378,6 +4378,37 @@ Only works for Bourne-like shells."
 				      t t result)))
 	result))))
 
+;;; Signal handling.  This works for remote processes, which have set
+;;; the process property `remote-pid'.
+
+(defun tramp-advice-interrupt-process (orig-fun &rest args)
+  "Interrupt remote process PROC."
+  (let* ((arg0 (car args))
+	 (proc (cond
+		((processp arg0) arg0)
+		((bufferp arg0)  (get-buffer-process arg0))
+		((stringp arg0)  (or (get-process arg0)
+				     (get-buffer-process arg0)))
+		((null arg0)     (get-buffer-process (current-buffer)))
+		(t               arg0)))
+	 pid)
+    ;; If it's a Tramp process, send the INT signal remotely.
+    (if (and (processp proc)
+	     (setq pid (process-get proc 'remote-pid)))
+	(progn
+	  (tramp-message proc 5 "%s %s" proc pid)
+	  (tramp-send-command
+	   (tramp-get-connection-property proc "vector" nil)
+	   (format "kill -2 %d" pid)))
+      ;; Otherwise, just run the original function.
+      (apply orig-fun args))))
+
+(advice-add 'interrupt-process :around 'tramp-advice-interrupt-process)
+(add-hook
+ 'tramp-unload-hook
+ (lambda ()
+   (advice-remove 'interrupt-process 'tramp-advice-interrupt-process)))
+
 ;;; Integration of eshell.el:
 
 ;; eshell.el keeps the path in `eshell-path-env'.  We must change it