shell.scm (fallback-pkill): New procedure

* modules/ssh/shell.scm (fallback-pkill): New procedure.
* modules/ssh/dist/node.scm (node-stop-server): Use it.  Improve logging.

2 files changed, 35 insertions, 10 deletions

diff --git a/modules/ssh/dist/node.scm b/modules/ssh/dist/node.scm
index a39934d..340b41f 100644
--- a/modules/ssh/dist/node.scm
+++ b/modules/ssh/dist/node.scm
@@ -313,20 +313,31 @@ listens on an expected port, return #f otherwise."
 
 (define (node-stop-server node)
   "Stop a RREPL server on a NODE."
+  (define (pkill-available?)
+    (command-available? (node-session node) "pkill"))
   (format-log 'functions "[scm] node-stop-server"
               "trying to SIGTERM the RREPL server on ~a ..." node)
-  (pkill (node-session node)
-         (format #f "guile --listen=~a" (node-repl-port node))
-         #:full? #t)
-  (while (node-server-running? node)
-    (format-log 'functions "[scm] node-stop-server"
-                "trying to SIGKILL the RREPL server on ~a ..."
-                node)
+  (let* ((pkill? (pkill-available?))
+         (pkill (if pkill? pkill fallback-pkill)))
+    (unless pkill?
+      (format-log 'rare
+                  "node-server-running?"
+                  (string-append
+                   "WARNING: 'pkill' from procps is not available on the node"
+                   " ~a; falling back to the Guile-SSH pkill implementation")
+                  node))
     (pkill (node-session node)
            (format #f "guile --listen=~a" (node-repl-port node))
-           #:signal 'SIGKILL
            #:full? #t)
-    (sleep 1)))
+    (while (node-server-running? node)
+      (format-log 'functions "[scm] node-stop-server"
+                  "trying to SIGKILL the RREPL server on ~a ..."
+                  node)
+      (pkill (node-session node)
+             (format #f "guile --listen=~a" (node-repl-port node))
+             #:signal 'SIGKILL
+             #:full? #t)
+      (sleep 1))))
 
 
 (define (node-open-rrepl node)
diff --git a/modules/ssh/shell.scm b/modules/ssh/shell.scm
index 3ac3dc2..00c2d77 100644
--- a/modules/ssh/shell.scm
+++ b/modules/ssh/shell.scm
@@ -36,13 +36,16 @@
 ;;; Code:
 
 (define-module (ssh shell)
+  #:use-module (srfi srfi-11)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 format)
   #:use-module (ice-9 receive)
   #:use-module (ssh channel)
   #:use-module (ssh popen)
-  #:export (rexec which pgrep pkill fallback-pgrep command-available?))
+  #:use-module (ssh log)
+  #:export (rexec which pgrep pkill fallback-pgrep command-available?
+                  fallback-pkill))
 
 
 ;;;
@@ -100,6 +103,17 @@ Return two values: a check result and a return code."
                          signal
                          pattern)))
 
+(define* (fallback-pkill session pattern #:key (full? #f)
+                         (signal 'SIGTERM))
+  (let-values (((pids exit-status) (pgrep session pattern #:full? full?)))
+    (format-log 'functions "[scm] fallback-pkill"
+                "pids: ~a (pgrep exit status: ~a)"
+                (car pids) exit-status)
+    (let ((cmd (format "guile -c '(kill ~a ~a)'" (car pids) signal)))
+      (format-log 'functions "[scm] fallback-pkill"
+                "going to use this kill command: ~a" cmd)
+      (rexec session cmd))))
+
 (define (fallback-pgrep session pattern)
   "Guile-SSH implementation of 'pgrep' that uses pure bash and '/proc'
 filesystem.  Check if a process with a PATTERN cmdline is available on a NODE.