[elpa] externals/dtache ea07041f52 013/158: Merge develop branch into master

[ELPA Syncer]

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

    Merge develop branch into master
---
 dtache-shell.el     | 21 +++++++++++++--------
 dtache.el           | 51 +++++++++++++++++++++++++++++++++++++--------------
 test/dtache-test.el | 12 ++++++++++++
 3 files changed, 62 insertions(+), 22 deletions(-)

diff --git a/dtache-shell.el b/dtache-shell.el
index 8453ad5339..11f2717ab6 100755
--- a/dtache-shell.el
+++ b/dtache-shell.el
@@ -37,6 +37,8 @@
 
 (defvar dtache-shell-block-list '("^$")
   "A list of regexps to block non-supported input.")
+(defvar dtache-shell-new-block-list '("^sudo.*")
+  "A list of regexps to block from creating a session without attaching.")
 (defvar dtache-shell-silence-dtach-messages t
   "Filter out messages from the `dtach' program.")
 (defvar dtache-shell-create-primary-function #'dtache-shell-new-session
@@ -142,8 +144,15 @@ cluttering the comint-history with dtach commands."
    (if-let* ((supported-input
               (not (seq-find
                     (lambda (blocked)
-                      (string-match-p string blocked))
+                      (string-match-p blocked string))
                     dtache-shell-block-list)))
+             (dtache--dtach-mode
+              (if (seq-find
+                   (lambda (blocked)
+                     (string-match-p blocked string))
+                   dtache-shell-new-block-list)
+                  "-c"
+                dtache--dtach-mode))
              (command (dtache-dtach-command
                        (dtache--create-session
                         (substring-no-properties string)))))
@@ -159,13 +168,9 @@ cluttering the comint-history with dtach commands."
             map)
   (with-connection-local-variables
    (if dtache-shell-mode
-       (progn
-         (dtache-db-initialize)
-         (dtache-create-session-directory)
-         (dtache-cleanup-sessions)
-         (when dtache-shell-silence-dtach-messages
-           (add-hook 'comint-preoutput-filter-functions 
#'dtache-shell-filter-dtach-eof 0 t)
-           (add-hook 'comint-preoutput-filter-functions 
#'dtache-shell-filter-dtach-detached 0 t)))
+       (when dtache-shell-silence-dtach-messages
+         (add-hook 'comint-preoutput-filter-functions 
#'dtache-shell-filter-dtach-eof 0 t)
+         (add-hook 'comint-preoutput-filter-functions 
#'dtache-shell-filter-dtach-detached 0 t))
      (when dtache-shell-silence-dtach-messages
        (remove-hook 'comint-preoutput-filter-functions 
#'dtache-shell-filter-dtach-eof t)
        (remove-hook 'comint-preoutput-filter-functions 
#'dtache-shell-filter-dtach-detached t)))))
diff --git a/dtache.el b/dtache.el
index ce963f4e36..ad74a3b5ac 100644
--- a/dtache.el
+++ b/dtache.el
@@ -162,6 +162,7 @@
 
 (defun dtache-session-candidates ()
   "Return an alist of session candidates."
+  (dtache-initialize)
   (dtache-update-sessions)
   (let* ((sessions (nreverse
                     (dtache--db-select-host-sessions (dtache--host)))))
@@ -170,6 +171,13 @@
                      `(,(dtache-encode-session session) . ,session))
                    sessions))))
 
+(defun dtache-initialize ()
+  "Initialize `dtache'."
+  (unless dtache-db
+    (dtache-db-initialize)
+    (dtache-create-session-directory)
+    (dtache-cleanup-sessions)))
+
 ;;;;; Database
 
 (defun dtache-db-initialize ()
@@ -330,12 +338,18 @@ This function also makes sure that the HISTFILE is 
disabled for local shells."
   "Send a TERM signal to SESSION."
   (interactive
    (list (dtache-select-session)))
-  (let* ((pids (flatten-list
-                (dtache--session-child-pids
-                 (dtache--session-pid session)))))
-    (seq-doseq (pid pids)
-      (apply #'process-file
-             `("kill" nil nil nil ,pid)))))
+  (let ((pid (dtache--session-pid session)))
+    (when pid
+      (dtache--kill-processes pid))))
+
+(defun dtache--kill-processes (pid)
+  "Kill PID and all of its children."
+  (let ((child-processes
+         (split-string
+          (shell-command-to-string (format "pgrep -P %s" pid))
+          "\n" t)))
+    (seq-do (lambda (pid) (dtache--kill-processes pid)) child-processes)
+    (apply #'process-file `("kill" nil nil nil ,pid))))
 
 ;;;###autoload
 (defun dtache-open-log (session)
@@ -411,18 +425,18 @@ nil before closing."
 
 (defun dtache--session-pid (session)
   "Return SESSION's pid."
-  (let* ((socket (concat
-                  (dtache--session-session-directory session)
-                  (dtache--session-id session)
-                  dtache-socket-ext))
-         (regexp (concat "dtach -c " socket))
+  (let* ((socket
+          (concat
+           (dtache--session-session-directory session)
+           (dtache--session-id session)
+           dtache-socket-ext))
+         (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))
-      (buffer-substring-no-properties (point-min) (point-max))
       (goto-char (point-min))
-      (search-forward-regexp regexp nil t)
-      (elt (split-string (thing-at-point 'line) " " t) 1))))
+      (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."
@@ -486,6 +500,7 @@ nil before closing."
 
 (defun dtache--db-insert-session (session)
   "Insert SESSION into the database."
+  (dtache-initialize)
   (let ((id (dtache--session-id session))
         (host (dtache--session-host session))
         (active (dtache--session-active session)))
@@ -678,6 +693,14 @@ the current time is used."
   (auto-revert-tail-mode)
   (read-only-mode t))
 
+(defun dtache-setup-evil-bindings ()
+  "Function that use `general' to setup `evil' bindings."
+  (when (fboundp 'general-def)
+    (general-def '(motion normal) dtache-log-mode-map
+      "q" #'kill-buffer-and-window)
+    (general-def '(motion normal) dtache-tail-mode-map
+      "q" #'dtache-quit-tail-log)))
+
 (provide 'dtache)
 
 ;;; dtache.el ends here
diff --git a/test/dtache-test.el b/test/dtache-test.el
index 5dd7ffc0e4..232de41bc3 100644
--- a/test/dtache-test.el
+++ b/test/dtache-test.el
@@ -273,6 +273,18 @@
     (should (not (dtache-degraded-p "cd")))
     (should (dtache-degraded-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" :session-directory 
"/tmp/"))
+             (session2 (dtache--session-create :id "bar" :session-directory 
"/tmp/"))
+             (session3 (dtache--session-create :id "baz" :session-directory 
"/tmp/"))
+             (dtache-socket-ext ".socket"))
+    (should (string= "6699" (dtache--session-pid session1)))
+    (should (string= "6698" (dtache--session-pid session2)))
+    (should (not (dtache--session-pid session3)))))
+
 (provide 'dtache-test)
 
 ;;; dtache-test.el ends here