[elpa] externals/detached c41e6a035b: New implementation for killing a session

[ELPA Syncer]

branch: externals/detached
commit c41e6a035b05fb7c26c30c3f1c9572fbea05a0f9
Author: Niklas Eklund <niklas.eklund@posteo.net>
Commit: Niklas Eklund <niklas.eklund@posteo.net>

    New implementation for killing a session
    
    The previous implementation relied on finding all the child processes
    to the dtach process and terminating them in reverse order. This
    approach worked most of the time, but in situations where the initial
    process had forked of such as would happen when a docker container
    started detached failed to terminate the session properly.
    
    The new approach instead relies on the fact that when we are attached
    to a session in a comint derived mode we can simply execute
    comint-interrupt-subjob. When not attached to the session we instead
    attach to it in the background by creating a dedicated comint buffer
    and attaching to the session and sending comint-interrupt-subjob. For
    this to work reliably we add a small delay between the steps using
    timers.
---
 CHANGELOG.org     |  1 +
 detached-shell.el | 26 ---------------
 detached.el       | 95 +++++++++++++++++++++++++++++++++++--------------------
 3 files changed, 62 insertions(+), 60 deletions(-)

diff --git a/CHANGELOG.org b/CHANGELOG.org
index 59a43a42e9..1b6d4e58e0 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -9,6 +9,7 @@
 - Implement mean and std duration for sessions
 - Make tail commands work on macOS
 - Rewrite core code related to creating, starting, and attaching to sessions.
+- New implementation of kill command. Instead of determining process IDs and 
sending termination signal to all of them detached attach to the session behind 
the scenes and sends a termination.
 
 * Version 0.9.2 (2022-11-01)
 
diff --git a/detached-shell.el b/detached-shell.el
index 05d3c57a8d..f0f5b56579 100644
--- a/detached-shell.el
+++ b/detached-shell.el
@@ -67,34 +67,8 @@ This function also makes sure that the HISTFILE is disabled 
for local shells."
          (comint-input-sender #'detached-shell--create-input-sender))
     (comint-send-input)))
 
-(defun detached-shell-attach-session (session)
-  "Attach to SESSION.
-
-`comint-add-to-input-history' is temporarily disabled to avoid
-cluttering the `comint-history' with dtach commands."
-  (interactive
-   (list (detached-select-host-session)))
-  (when (detached-valid-session session)
-    (if (detached-session-active-p session)
-        (cl-letf ((detached-current-session session)
-                  (comint-input-sender #'detached-shell--attach-input-sender)
-                  ((symbol-function 'comint-add-to-input-history) (lambda (_) 
t)))
-          (setq detached-buffer-session session)
-          (let ((kill-ring nil))
-            (comint-kill-input))
-          (insert "[attached]")
-          (comint-send-input))
-      (detached-open-session session))))
-
 ;;;; Support functions
 
-(defun detached-shell--attach-input-sender (proc _string)
-  "Attach to `detached--session' and send the attach command to PROC."
-  (let* ((input
-          (detached-session-attach-command detached-current-session
-                                           :type 'string)))
-    (comint-simple-send proc input)))
-
 (defun detached-shell--create-input-sender (proc string)
   "Create a detached session based on STRING and send to PROC."
   (with-connection-local-variables
diff --git a/detached.el b/detached.el
index 0bc77b56f4..5271880552 100644
--- a/detached.el
+++ b/detached.el
@@ -617,8 +617,8 @@ Optionally TOGGLE-SESSION-MODE."
 (defun detached-delete-session (session)
   "Delete SESSION."
   (interactive
-   (list (detached-completing-read (detached-get-sessions))))
-  (when (detached-valid-session session)
+   (list (detached-session-in-context)))
+  (when session
     (if (detached-session-active-p session)
         (message "Kill session first before removing it.")
       (detached--db-remove-entry session))))
@@ -632,9 +632,10 @@ Optionally DELETE the session if prefix-argument is 
provided."
    (list (detached-session-in-context)
          current-prefix-arg))
   (when (detached-valid-session session)
-    (when-let* ((default-directory (detached-session-directory session))
-                (pid (detached-session-pid session)))
-      (detached--kill-processes pid))
+    (when-let* ((default-directory (detached-session-directory session)))
+      (if (derived-mode-p 'comint-mode)
+          (call-interactively #'comint-interrupt-subjob)
+        (detached-session-kill session)))
     (when delete
       (detached--db-remove-entry session))))
 
@@ -910,6 +911,25 @@ This function uses the `notifications' library."
     (detached--db-update-sessions))
   (detached--db-get-sessions))
 
+(defun detached-shell-attach-session (session)
+  "Attach to SESSION.
+
+`comint-add-to-input-history' is temporarily disabled to avoid
+cluttering the `comint-history' with dtach commands."
+  (interactive
+   (list (detached-select-host-session)))
+  (when (detached-valid-session session)
+    (if (detached-session-active-p session)
+        (cl-letf ((detached-current-session session)
+                  (comint-input-sender #'detached-shell--attach-input-sender)
+                  ((symbol-function 'comint-add-to-input-history) (lambda (_) 
t)))
+          (setq detached-buffer-session session)
+          (let ((kill-ring nil))
+            (comint-kill-input))
+          (insert "[attached]")
+          (comint-send-input))
+      (detached-open-session session))))
+
 (defun detached-shell-command-attach-session (session)
   "Attach to SESSION with `async-shell-command'."
   (let* ((inhibit-message t))
@@ -1025,6 +1045,34 @@ This function uses the `notifications' library."
          ('list command)
          (_ nil))))))
 
+
+(defun detached-session-kill (session)
+  "Kill SESSION."
+  (interactive
+   (list (detached-session-in-context)))
+  (when session
+    (cl-letf* (((getenv "HISTFILE") "")
+               (default-directory (detached-session-directory session))
+               (buffer (get-buffer-create (format "*dtach-%s*" 
(detached-session-id session))))
+               (termination-delay 0.1)
+               (comint-exec-hook
+                `(,(lambda ()
+                     (when-let ((process (get-buffer-process 
(current-buffer))))
+                       (run-with-timer termination-delay nil
+                                       (lambda ()
+                                         ;; Attach to session
+                                         (with-current-buffer buffer
+                                           (let 
((detached-show-session-context nil))
+                                             (detached-shell-attach-session 
session))
+                                           (run-with-timer termination-delay 
nil
+                                                           (lambda ()
+                                                             ;; Send 
termination signal to session
+                                                             
(with-current-buffer buffer
+                                                               
(call-interactively #'comint-interrupt-subjob)
+                                                               (let 
((kill-buffer-query-functions nil))
+                                                                 
(kill-buffer)))))))))))))
+      (apply #'make-comint-in-buffer `("dtach" ,buffer ,detached-shell-program 
nil)))))
+
 (defun detached-session-output (session)
   "Return content of SESSION's output."
   (let* ((filename (detached--session-file session 'log))
@@ -1041,23 +1089,6 @@ This function uses the `notifications' library."
                    (point-max))))
         (buffer-substring beginning end)))))
 
-(defun detached-session-pid (session)
-  "Return SESSION's process id."
-  (let* ((socket
-          (expand-file-name
-           (concat (symbol-name (detached-session-id session)) ".socket")
-           (or
-            (file-remote-p default-directory 'localname)
-            default-directory))))
-    (car
-     (split-string
-      (with-temp-buffer
-        (apply #'process-file
-               `("pgrep" nil t nil
-                 "-f" ,(shell-quote-argument (format "dtach -. %s" socket))))
-        (buffer-string))
-      "\n" t))))
-
 (defun detached-session-state (session)
   "Return SESSION's state."
   (detached--session-state session))
@@ -1178,7 +1209,7 @@ This function uses the `notifications' library."
   (let ((session
          (or (detached--session-in-context major-mode)
              (detached-completing-read (detached-get-sessions)))))
-    (when (detached-valid-session session)
+    (when (detached-session-p session)
       session)))
 
 (defun detached-session-validated-p (session)
@@ -1504,6 +1535,13 @@ Optionally make the path LOCAL to host."
                        (seq-length durations)))))
     `(:durations ,durations :mean ,mean :std ,std)))
 
+(defun detached-shell--attach-input-sender (proc _string)
+  "Attach to `detached--session' and send the attach command to PROC."
+  (let* ((input
+          (detached-session-attach-command detached-current-session
+                                           :type 'string)))
+    (comint-simple-send proc input)))
+
 ;;;;; Database
 
 (defun detached--db-initialize ()
@@ -1694,17 +1732,6 @@ Optionally specify if the end-time should be APPROXIMATE 
or not."
   (funcall (detached-session-callback-function session)
            session))
 
-(defun detached--kill-processes (pid)
-  "Kill PID and all of its children."
-  (let ((child-processes
-         (split-string
-          (with-temp-buffer
-            (apply #'process-file `("pgrep" nil t nil "-P" ,pid))
-            (buffer-string))
-          "\n" t)))
-    (seq-do (lambda (pid) (detached--kill-processes pid)) child-processes)
-    (apply #'process-file `("kill" nil nil nil ,pid))))
-
 (defun detached--detached-command (session)
   "Return the detached command for SESSION.