node.scm (rrepl-get-result): Bugfix: Handle compilation errors

Guile-SSH would always fail to read compilation errors properly because it
considered the message as "undefined" result.  Now this bug should be fixed.

An example of an error that now should be handled is "no code for module" due
to using a non-existing module in 'with-ssh' expression.

Reported by Mathieu, in
<https://github.com/artyom-poptsov/guile-ssh/issues/3>

* modules/ssh/dist/node.scm (rrepl-get-result): Bugfix: Do not consider
  compilation errors as undefined results.
  (rrepl-eval): Call 'exit' on the remote side to ensure that the remote side
  closed a channel.
* tests/dist.scm: Improve logging.
  ("rrepl-get-result, compilation error"): New TC.
* doc/guile-ssh.texi (Acknowledgments): Update.
* AUTHORS, NEWS, THANKS: Update.

6 files changed, 93 insertions, 47 deletions

diff --git a/AUTHORS b/AUTHORS
index 19a562b..9ba7293 100644
--- a/AUTHORS
+++ b/AUTHORS
@@ -23,3 +23,5 @@ See also files THANKS and ChangeLog.
     session-func.c
 
   Bug reports, various comments and suggestions.
+* Mathieu <https://github.com/mothacehe>
+  Pointed out to a bug in 'rrepl-get-result' from (ssh dist node).
\ No newline at end of file
diff --git a/NEWS b/NEWS
index 09ee959..bf1ef5b 100644
--- a/NEWS
+++ b/NEWS
@@ -15,6 +15,17 @@ Copyright (C) Artyom V. Poptsov <poptsov.artyom@gmail.com>
 *** In (ssh tunnel)
 **** 'main-loop' now handles "interrupted system call" errors
      that sometimes occur on 'select' call.
+** In (ssh dist node)
+**** 'rrepl-get-result' now handles compilation errors
+     The procedure would always fail to read compilation errors properly
+     because it considered the message as "undefined" result.  Now this bug
+     should be fixed.
+
+     An example of an error that now should be handled is "no code for module"
+     due to using a non-existing module in 'with-ssh' expression.
+
+     Reported by Mathieu, in
+     <https://github.com/artyom-poptsov/guile-ssh/issues/3>
 ** Changes in (ssh dist node)
 *** 'node-eval' now can work without procps
     The procedure now checks if procps package is present on a node and uses
diff --git a/THANKS b/THANKS
index e659a86..4cbf399 100644
--- a/THANKS
+++ b/THANKS
@@ -12,6 +12,7 @@ through bug reports or patches:
 * David Thompson <davet@gnu.org>
 * Ludovic Courtès <ludo@gnu.org>
 * SaffronSnail <https://github.com/SaffronSnail>
+* Mathieu <https://github.com/mothacehe>
 
 
 Thank you.
\ No newline at end of file
diff --git a/doc/guile-ssh.texi b/doc/guile-ssh.texi
index c7df6d7..9653a53 100644
--- a/doc/guile-ssh.texi
+++ b/doc/guile-ssh.texi
@@ -229,6 +229,7 @@ through bug reports or patches:
 @item David Thompson @email{davet@@gnu.org}
 @item SaffronSnail @url{https://github.com/SaffronSnail}
 @item David Kastrup @email{dak@@gnu.org>}
+@item Mathieu @url{https://github.com/mothacehe}
 @end itemize
 
 
diff --git a/modules/ssh/dist/node.scm b/modules/ssh/dist/node.scm
index 02fbce3..247dd88 100644
--- a/modules/ssh/dist/node.scm
+++ b/modules/ssh/dist/node.scm
@@ -56,6 +56,7 @@
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 receive)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
   #:use-module (ssh session)
@@ -178,30 +179,30 @@ error."
 (define %repl-error-regexp
   (make-regexp "^(.*)@(.*)> ERROR: .*"))
 
+(define %repl-error-regexp-2
+  (make-regexp "^ERROR: .*"))
+
 (define (rrepl-get-result repl-channel)
   "Get result of evaluation form REPL-CHANNEL, return four values: an
 evaluation result, a number of the evaluation, a module name and a language
 name.  Throw 'node-repl-error' on an error."
 
   (define (raise-repl-error result)
-    (let loop ((line   (read-line repl-channel))
-               (result result))
-      (if (eof-or-null? line)
-          (node-repl-error "Evaluation failed" result)
-          (loop (read-line repl-channel)
-                (string-append result "\n" line)))))
+    "Raise an REPL error with a RESULT of evaluation."
+    (node-repl-error "Evaluation failed" result))
 
-  (define (parse-result 1st-match)
-    (let loop ((line    (read-line repl-channel))
-               (matches (list 1st-match)))
-      (if (or (eof-or-null? line)
-              (regexp-exec %repl-undefined-result-regexp line))
-          (reverse matches)
-          (loop (read-line repl-channel)
-                (cons (regexp-exec %repl-result-2-regexp line) matches)))))
+  (define (parse-result matches lines)
+    (if (null? lines)
+        (reverse matches)
+        (let ((line (car lines)))
+          (if (or (eof-or-null? line)
+                  (regexp-exec %repl-undefined-result-regexp line))
+              (reverse matches)
+              (parse-result (cons (regexp-exec %repl-result-2-regexp line) matches)
+                            (cdr lines))))))
 
-  (define (read-result match)
-    (let* ((matches (parse-result match))
+  (define (read-result match rest)
+    (let* ((matches (parse-result (list match) rest))
            (len     (length matches)))
       (if (= len 1)
           (let ((m (car matches)))
@@ -223,31 +224,47 @@ name.  Throw 'node-repl-error' on an error."
                 (vector-set! nv i (string->number (match:substring m 1)))))
             (values rv nv)))))
 
-  (let ((result (read-line repl-channel)))
-    (if (string-null? result)
-        (rrepl-get-result repl-channel)
-        (cond
-         ((regexp-exec %repl-result-regexp result) =>
-          (lambda (match)
-            (receive (result eval-num)
-                (read-result match)
-              (values
-               result                                ; Result
-               eval-num                              ; # of evaluation
-               (match:substring match 2)             ; Module
-               (match:substring match 1)))))         ; Language
-         ((regexp-exec %repl-error-regexp result) =>
-          (lambda (match) (raise-repl-error result)))
-         ((regexp-exec %repl-undefined-result-regexp result) =>
-          (lambda (match)
-            (values
-             *unspecified*                ; Result
-             *unspecified*                ; # of evaluation
-             (match:substring match 2)    ; Module
-             (match:substring match 1)))) ; Language
-         (else
-          (raise-repl-error result))))))
+  (define (error? line)
+    "Does a LINE contain an REPL error message?"
+    (or (regexp-exec %repl-error-regexp line)
+        (regexp-exec %repl-error-regexp-2 line)))
+
+  (define (error-message? result)
+    "Does a RESULT of evaluation contains a REPL error message?"
+    (find error? result))
+
+  (define (handle-response result)
+    (cond
+     ((error-message? result)
+      (raise-repl-error (string-join result "\n")))
+     ((regexp-exec %repl-result-regexp (car result)) =>
+      (lambda (match)
+        (receive (result eval-num)
+            (read-result match (cdr result))
+          (values
+           result                                ; Result
+           eval-num                              ; # of evaluation
+           (match:substring match 2)             ; Module
+           (match:substring match 1)))))         ; Language
+     ((regexp-exec %repl-undefined-result-regexp (car result)) =>
+      (lambda (match)
+        (values
+         *unspecified*                ; Result
+         *unspecified*                ; # of evaluation
+         (match:substring match 2)    ; Module
+         (match:substring match 1)))) ; Language
+     (else
+      (raise-repl-error (string-join result "\n")))))
 
+  (define (read-response result)
+    (let ((line (read-line repl-channel)))
+      (if (eof-or-null? line)
+          (handle-response (reverse result))
+          (read-response (cons line result)))))
+
+  (read-response '()))
+
+
 (define (rrepl-eval rrepl-channel quoted-exp)
   "Evaluate QUOTED-EXP using RREPL-CHANNEL, return four values: an evaluation
 result, a number of the evaluation, a module name and a language name.  Throw
@@ -255,6 +272,7 @@ result, a number of the evaluation, a module name and a language name.  Throw
   (write quoted-exp rrepl-channel)
   (newline rrepl-channel)
   (write-line '(newline) rrepl-channel)
+  (write-line '(exit) rrepl-channel)
   (rrepl-get-result rrepl-channel))
 
 
diff --git a/tests/dist.scm b/tests/dist.scm
index 88df35c..307a7bb 100644
--- a/tests/dist.scm
+++ b/tests/dist.scm
@@ -104,6 +104,8 @@
   (receive (result eval-num module-name lang)
       (call-with-input-string "scheme@(guile-user)> $0 = test"
                               rrepl-get-result)
+    ;; (format (current-error-port)
+    ;;         "\tresult: ~a\neval-num: ~a"
     (and (eq?      result      'test)
          (=        eval-num    0)
          (string=? module-name "(guile-user)")
@@ -123,6 +125,14 @@
   (call-with-input-string "scheme@(guile-user)> ERROR: error."
                           rrepl-get-result))
 
+;; See <https://github.com/artyom-poptsov/guile-ssh/issues/3>.
+(test-error-with-log/= "rrepl-get-result, compilation error"
+  'node-repl-error "scheme@(guile-user)> While compiling expression:\nERROR: no code for module (module-that-doesnt-exist)"
+  (call-with-input-string
+   (string-append "scheme@(guile-user)> While compiling expression:\n"
+                  "ERROR: no code for module (module-that-doesnt-exist)")
+   rrepl-get-result))
+
 (test-assert "rrepl-get-result, elisp"
   (receive (result eval-num module-name lang)
       (call-with-input-string "elisp@(guile-user)> $0 = #nil"
@@ -175,28 +185,31 @@
        (start-session-loop
         session
         (lambda (msg type)
+          (format-log/scm 'nolog
+                          "server"
+                          "msg: ~a; type: ~a" msg type)
           (case (car type)
             ((request-channel-open)
              (let ((c (message-channel-request-open-reply-accept msg)))
-
+               (format-log/scm 'nolog "server" "channel 0: ~a" c)
                ;; Write the last line of Guile REPL greeting message to
                ;; pretend that we're a REPL server.
                (write-line "Enter `,help' for help." c)
-
+               (format-log/scm 'nolog "server" "channel 1: ~a" c)
                (usleep 100)
                (poll c
                      (lambda args
                        ;; Read expression
                        (let ((result (read-line c)))
-                         (format-log 'nolog "server"
-                                     "[SCM] sexp: ~a" result)
+                         (format-log/scm 'nolog "server"
+                                         "sexp: ~a" result)
                          (or (string=? result "(begin (+ 21 21))")
                              (error "Wrong result 1" result)))
 
                        ;; Read newline
                        (let ((result (read-line c)))
-                         (format-log 'nolog "server"
-                                     "[SCM] sexp: ~a" result)
+                         (format-log/scm 'nolog "server"
+                                         "sexp: ~a" result)
                          (or (string=? result "(newline)")
                              (error "Wrong result 2" result)))
 
@@ -210,7 +223,7 @@
      (call-with-connected-session
       (lambda (session)
         (authenticate-server session)
-
+        (format-log/scm 'nolog "client" "session: ~a" session)
         (unless (equal? (userauth-none! session) 'success)
           (error "Could not authenticate with a server" session))