shell.scm: New module

* modules/ssh/shell.scm: New module.
* modules/ssh/dist/node.scm: Move all shell related procedures to (ssh shell).
  Use (ssh shell).
* modules/ssh/Makefile.am (SCM_SOURCES): Add 'shell.scm'.

3 files changed, 123 insertions, 59 deletions

diff --git a/modules/ssh/Makefile.am b/modules/ssh/Makefile.am
index f32f699..b16f9fc 100644
--- a/modules/ssh/Makefile.am
+++ b/modules/ssh/Makefile.am
@@ -22,7 +22,8 @@ SUBDIRS = dist
 SCM_SOURCES = \
 	auth.scm channel.scm key.scm session.scm	\
 	server.scm message.scm version.scm log.scm	\
-	tunnel.scm dist.scm sftp.scm popen.scm
+	tunnel.scm dist.scm sftp.scm popen.scm		\
+	shell.scm
 
 pkgguilesitedir = $(guilesitedir)/ssh
 
diff --git a/modules/ssh/dist/node.scm b/modules/ssh/dist/node.scm
index 0492a7c..2091aa1 100644
--- a/modules/ssh/dist/node.scm
+++ b/modules/ssh/dist/node.scm
@@ -61,6 +61,7 @@
   #:use-module (ssh popen)
   #:use-module (ssh tunnel)
   #:use-module (ssh log)
+  #:use-module (ssh shell)
   #:export (node?
             node-session
             node-tunnel
@@ -143,18 +144,6 @@ to #t then a REPL server will be stopped as soon as an evaluation is done."
   "Read a string STR."
   (call-with-input-string str read))
 
-(define (rexec node cmd)
-  "Execute a command CMD on the remote side.  Return two values: list of
-output lines returned by CMD and its exit code."
-  (let ((channel (open-remote-input-pipe (node-session node) cmd)))
-    (values (let loop ((line   (read-line channel))
-                       (result '()))
-              (if (eof-or-null? line)
-                  (reverse result)
-                  (loop (read-line channel)
-                        (cons line result))))
-            (channel-get-exit-status channel))))
-
 (define (rrepl-skip-to-prompt repl-channel)
   "Read from REPL-CHANNEL until REPL is observed.  Throw 'node-error' on an
 error."
@@ -266,45 +255,6 @@ result, a number of the evaluation, a module name and a language name.  Throw
   (rrepl-get-result rrepl-channel))
 
 
-;;; Remote shell
-
-(define (which node program-name)
-  "Check if a PROGRAM-NAME is available on a NODE.  Return two values: a check
-result and a return code."
-  (rexec node (format #f "which '~a'" program-name)))
-
-(define* (pgrep node pattern #:key (full? #f))
-  "Check if a process with a PATTERN cmdline is available on a NODE.
-Return two values: a check result and a return code."
-  (rexec node (format #f "pgrep ~a '~a'"
-                      (if full? "--full" "")
-                      pattern)))
-
-(define (fallback-pgrep node 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.
-Return two values: a check result and a return code."
-  (let ((ptrn (string-append (regexp-substitute/global #f " " pattern
-                                                       'pre "?" 'post)
-                             ".*")))
-    (rexec node
-           (string-append
-            "echo '"
-            "for p in $(ls /proc); do"
-            "  if [[ \"$p\" =~ ^[0-9]+ ]]; then"
-            "    name=$(cat \"/proc/$p/status\" 2>/dev/null | head -1);"
-            "    if [[ \"$name\" =~ Name:.*guile ]]; then"
-            "      cmdline=$(cat \"/proc/$p/cmdline\");"
-            (format #f "       if [[ \"$cmdline\" =~~ ~a ]]; then" ptrn)
-            "        exit 0;"
-            "      fi;"
-            "    fi;"
-            "  fi;"
-            "done;"
-            "exit 1;"
-            "' | bash"))))
-
-
 ;;;
 
 (define (node-server-running? node)
@@ -313,7 +263,7 @@ listens on an expected port, return #f otherwise."
   (define (pgrep-available?)
     "Check if 'pgrep' from procps is available on the node."
     (receive (result rc)
-        (which node "pgrep")
+        (which (node-session node) "pgrep")
       (zero? rc)))
   (define (guile-up-and-running?)
     (let ((rp (tunnel-open-forward-channel (node-tunnel node))))
@@ -333,19 +283,24 @@ listens on an expected port, return #f otherwise."
                   node))
     (receive (result rc)
         (if pgrep?
-            (pgrep node (format #f "guile --listen=~a"
-                                (node-repl-port node))
+            (pgrep (node-session node)
+                   (format #f "guile --listen=~a"
+                           (node-repl-port node))
                    #:full? #t)
-            (fallback-pgrep node (format #f "guile --listen=~a"
-                                         (node-repl-port node))))
+            (fallback-pgrep (node-session node)
+                            (format #f "guile --listen=~a"
+                                    (node-repl-port node))))
       (or (and (zero? rc)
                (guile-up-and-running?))
           ;; Check the default port.
           (and (= (node-repl-port node) %guile-default-repl-port)
                (receive (result rc)
                    (if pgrep?
-                       (pgrep node "guile --listen" #:full? #t)
-                       (fallback-pgrep "guile --listen"))
+                       (pgrep (node-session node)
+                              "guile --listen"
+                              #:full? #t)
+                       (fallback-pgrep (node-session node)
+                                       "guile --listen"))
                  (and (zero? rc)
                       (guile-up-and-running?))))))))
 
diff --git a/modules/ssh/shell.scm b/modules/ssh/shell.scm
new file mode 100644
index 0000000..2b108ea
--- /dev/null
+++ b/modules/ssh/shell.scm
@@ -0,0 +1,108 @@
+;;; node.scm -- Distributed computing node
+
+;; Copyright (C) 2016 Artyom V. Poptsov <poptsov.artyom@gmail.com>
+;;
+;; This file is a part of Guile-SSH.
+;;
+;; Guile-SSH is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; Guile-SSH is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with Guile-SSH.  If not, see
+;; <http://www.gnu.org/licenses/>.
+
+
+;;; Commentary:
+
+;; Remote shell.
+;;
+;; The module provides the following procedures:
+;;   rexec
+;;   which
+;;   pgrep
+;;   fallback-pgrep
+;;
+;; See the Info documentation for detailed description of these exceptions and
+;; aforementioned procedures.
+
+
+;;; Code:
+
+(define-module (ssh shell)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ssh channel)
+  #:use-module (ssh popen)
+  #:export (rexec which pgrep fallback-pgrep))
+
+
+;;;
+
+;; TODO: Move to some other file do prevent duplicating of the procedure in
+;; (ssh dist node).
+(define (eof-or-null? str)
+  "Return #t if a STR is an EOF object or an empty string, #f otherwise."
+  (or (eof-object? str) (string-null? str)))
+
+
+;;;
+
+(define (rexec session cmd)
+  "Execute a command CMD on the remote side.  Return two values: list of
+output lines returned by CMD and its exit code."
+  (let ((channel (open-remote-input-pipe session cmd)))
+    (values (let loop ((line   (read-line channel))
+                       (result '()))
+              (if (eof-or-null? line)
+                  (reverse result)
+                  (loop (read-line channel)
+                        (cons line result))))
+            (channel-get-exit-status channel))))
+
+
+;;;
+
+(define (which session program-name)
+  "Check if a PROGRAM-NAME is available on a remote side.  Return two values:
+a check result and a return code."
+  (rexec session (format #f "which '~a'" program-name)))
+
+
+(define* (pgrep session pattern #:key (full? #f))
+  "Check if a process with a PATTERN cmdline is available on a NODE.
+Return two values: a check result and a return code."
+  (rexec session (format #f "pgrep ~a '~a'"
+                         (if full? "--full" "")
+                         pattern)))
+
+(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.
+Return two values: a check result and a return code."
+  (let ((ptrn (string-append (regexp-substitute/global #f " " pattern
+                                                       'pre "?" 'post)
+                             ".*")))
+    (rexec session
+           (string-append
+            "echo '"
+            "for p in $(ls /proc); do"
+            "  if [[ \"$p\" =~ ^[0-9]+ ]]; then"
+            "    name=$(cat \"/proc/$p/status\" 2>/dev/null | head -1);"
+            "    if [[ \"$name\" =~ Name:.*guile ]]; then"
+            "      cmdline=$(cat \"/proc/$p/cmdline\");"
+            (format #f "       if [[ \"$cmdline\" =~~ ~a ]]; then" ptrn)
+            "        exit 0;"
+            "      fi;"
+            "    fi;"
+            "  fi;"
+            "done;"
+            "exit 1;"
+            "' | bash"))))
+
+;;; shell.scm ends here.