diff options
Diffstat (limited to 'modules/ssh/dist/node.scm')
| -rw-r--r-- | modules/ssh/dist/node.scm | 71 |
1 files changed, 13 insertions, 58 deletions
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?)))))))) |