diff options
| -rw-r--r-- | AUTHORS | 2 | ||||
| -rw-r--r-- | NEWS | 11 | ||||
| -rw-r--r-- | THANKS | 1 | ||||
| -rw-r--r-- | doc/guile-ssh.texi | 1 | ||||
| -rw-r--r-- | modules/ssh/dist/node.scm | 98 | ||||
| -rw-r--r-- | tests/dist.scm | 27 |
6 files changed, 93 insertions, 47 deletions
@@ -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 @@ -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 @@ -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)) |