diff options
| author | Artyom V. Poptsov <poptsov.artyom@gmail.com> | 2016-07-31 12:34:12 +0400 |
|---|---|---|
| committer | Artyom V. Poptsov <poptsov.artyom@gmail.com> | 2016-07-31 12:34:12 +0400 |
| commit | c02e686cec60803c2f0a6721359652604007b881 (patch) | |
| tree | 9951993e86578ef0c7463c67bc4574767a7d7e69 /modules/ssh | |
| parent | Makefile.am (SUBDIRS): Change order of dirs (diff) | |
| download | guile-ssh-c02e686cec60803c2f0a6721359652604007b881.tar.gz | |
node.scm (node-server-running?): Bugfix: Check the default port
'node-server-running?' would always fail to detect running Guile REPL server
if no port was specified to '--listen' option. The patch fixes that.
* modules/ssh/dist/node.scm (node-server-running?): Check for a Guile REPL
process started with default port.
Diffstat (limited to 'modules/ssh')
| -rw-r--r-- | modules/ssh/dist/node.scm | 21 |
1 files changed, 14 insertions, 7 deletions
diff --git a/modules/ssh/dist/node.scm b/modules/ssh/dist/node.scm index eae6ddb..97090a4 100644 --- a/modules/ssh/dist/node.scm +++ b/modules/ssh/dist/node.scm @@ -268,16 +268,23 @@ result, a number of the evaluation, a module name and a language name. Throw (define (node-server-running? node) "Check if a RREPL is running on a NODE, return #t if it is running and listens on an expected port, return #f otherwise." + (define (guile-up-and-running?) + (let ((rp (tunnel-open-forward-channel (node-tunnel node)))) + (and (channel-open? rp) + (let ((line (read-line rp))) + (close rp) + (and (not (eof-object? line))) + (string-match "^GNU Guile .*" line))))) (receive (result rc) (rexec node (format #f "pgrep --full 'guile --listen=~a'" (node-repl-port node))) - (and (zero? rc) - (let ((rp (tunnel-open-forward-channel (node-tunnel node)))) - (and (channel-open? rp) - (let ((line (read-line rp))) - (close rp) - (and (not (eof-object? line)) - (string-match "^GNU Guile .*" line)))))))) + (or (and (zero? rc) + (guile-up-and-running?)) + ;; Check the default port. + (receive (result rc) + (rexec node "pgrep --full 'guile --listen'") + (and (zero? rc) + (guile-up-and-running?)))))) (define (node-run-server node) |
