[elpa] externals/dtache 668f6aca83 157/158: Improve dtache-kill-session

[ELPA Syncer]

branch: externals/dtache
commit 668f6aca83405a68a6e6f27eed483af58b85f55f
Author: Niklas Eklund <niklas.eklund@posteo.net>
Commit: Niklas Eklund <niklas.eklund@posteo.net>

    Improve dtache-kill-session
    
    Simplify the underlying detection of the session's pid and child
    pids. This patch should work on remote hosts as well as local hosts.
---
 dtache.el           | 41 ++++++++++++++++-------------------------
 test/dtache-test.el | 11 -----------
 2 files changed, 16 insertions(+), 36 deletions(-)

diff --git a/dtache.el b/dtache.el
index 1961d592e9..e3da9e07e2 100644
--- a/dtache.el
+++ b/dtache.el
@@ -380,7 +380,8 @@ Optionally SUPPRESS-OUTPUT."
   (interactive
    (list (dtache-completing-read (dtache-get-sessions))))
   (when (dtache-valid-session session)
-    (let* ((pid (dtache--session-pid session)))
+    (let* ((default-directory (dtache--session-directory session))
+           (pid (dtache--session-pid session)))
       (when pid
         (dtache--kill-processes pid)))))
 
@@ -751,29 +752,17 @@ Optionally CONCAT the command return command into a 
string."
 (defun dtache--session-pid (session)
   "Return SESSION's pid."
   (let* ((socket
-          (concat
-           (dtache--session-directory session)
-           (symbol-name (dtache--session-id session))
-           ".socket"))
-         (regexp (rx-to-string `(and "dtach " (or "-n " "-c ") ,socket)))
-         (ps-args '("aux" "-w")))
-    (with-temp-buffer
-      (apply #'process-file `("ps" nil t nil ,@ps-args))
-      (goto-char (point-min))
-      (when (search-forward-regexp regexp nil t)
-        (elt (split-string (thing-at-point 'line) " " t) 1)))))
-
-(defun dtache--session-child-pids (pid)
-  "Return a list of pids for all child processes including PID."
-  (let ((pids `(,pid))
-        (child-processes
-         (split-string
-          (shell-command-to-string (format "pgrep -P %s" pid))
-          "\n" t)))
-    (seq-do (lambda (pid)
-              (push (dtache--session-child-pids pid) pids))
-            child-processes)
-    pids))
+          (expand-file-name
+           (concat (symbol-name (dtache--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 dtache--session-truncate-command (session)
   "Return a truncated string representation of SESSION's command."
@@ -1033,7 +1022,9 @@ Optionally make the path LOCAL to host."
   "Kill PID and all of its children."
   (let ((child-processes
          (split-string
-          (shell-command-to-string (format "pgrep -P %s" pid))
+          (with-temp-buffer
+            (apply #'process-file `("pgrep" nil t nil "-P" ,pid))
+            (buffer-string))
           "\n" t)))
     (seq-do (lambda (pid) (dtache--kill-processes pid)) child-processes)
     (apply #'process-file `("kill" nil nil nil ,pid))))
diff --git a/test/dtache-test.el b/test/dtache-test.el
index 68822aadae..c8f499d71f 100644
--- a/test/dtache-test.el
+++ b/test/dtache-test.el
@@ -242,17 +242,6 @@
     (should (dtache-attachable-command-p "cd"))
     (should (not (dtache-attachable-command-p "ls -la")))))
 
-(ert-deftest dtache-test-session-pid ()
-  (cl-letf* (((symbol-function #'process-file) (lambda (_program _infile 
_buffer _display &rest _args)
-                                                 (insert "\"USER       PID 
%CPU %MEM    VSZ   RSS TTY      STAT START   TIME COMMAND\nuser    6699  0.0  
0.0   4752  2304 ?        Ss   13:06   0:00 dtach -n /tmp/foo.socket\nuser    
6698  0.0  0.0   4752  2304 ?        Ss   13:07   0:00 dtach -c 
/tmp/bar.socket\n")))
-
-             (session1 (dtache--session-create :id 'foo :directory "/tmp/"))
-             (session2 (dtache--session-create :id 'bar :directory "/tmp/"))
-             (session3 (dtache--session-create :id 'baz :directory "/tmp/")))
-    (should (string= "6699" (dtache--session-pid session1)))
-    (should (string= "6698" (dtache--session-pid session2)))
-    (should (not (dtache--session-pid session3)))))
-
 ;;;;; String representations
 
 (ert-deftest dtache-test-duration-str ()