08/09: remote, ssh: Show the command exit status upon failure.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit e09c7f4ae4e1c634975874cc18fd65ae4c4af091
Author: Ludovic Courtès <address@hidden>
Date:   Wed Aug 28 18:51:12 2019 +0200

    remote, ssh: Show the command exit status upon failure.
    
    * guix/remote.scm (remote-pipe-for-gexp): Show the exit status in error
    message.
    * guix/ssh.scm (remote-inferior): Likewise.
---
 guix/remote.scm | 12 ++++++++----
 guix/ssh.scm    | 14 +++++++-------
 2 files changed, 15 insertions(+), 11 deletions(-)

diff --git a/guix/remote.scm b/guix/remote.scm
index d0c3d04..c00585d 100644
--- a/guix/remote.scm
+++ b/guix/remote.scm
@@ -27,6 +27,7 @@
   #:use-module (guix derivations)
   #:use-module (guix utils)
   #:use-module (ssh popen)
+  #:use-module (ssh channel)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
@@ -68,10 +69,13 @@ BECOME-COMMAND is given, use that to invoke the remote 
Guile REPL."
 
   (let ((pipe (apply open-remote-pipe* session OPEN_READ repl-command)))
     (when (eof-object? (peek-char pipe))
-      (raise (condition
-              (&message
-               (message (format #f (G_ "failed to run '~{~a~^ ~}'")
-                                repl-command))))))
+      (let ((status (channel-get-exit-status pipe)))
+        (close-port pipe)
+        (raise (condition
+                (&message
+                 (message (format #f (G_ "remote command '~{~a~^ ~}' failed \
+with status ~a")
+                                  repl-command status)))))))
     pipe))
 
 (define* (%remote-eval lowered session #:optional become-command)
diff --git a/guix/ssh.scm b/guix/ssh.scm
index 7bc499a..b6b55bd 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -106,14 +106,14 @@ given, use that to invoke the remote Guile REPL."
   (let* ((repl-command (append (or become-command '())
                                '("guix" "repl" "-t" "machine")))
          (pipe (apply open-remote-pipe* session OPEN_BOTH repl-command)))
-    ;; XXX: 'channel-get-exit-status' would be better here, but hangs if the
-    ;; process does succeed. This doesn't reflect the documentation, so it's
-    ;; possible that it's a bug in guile-ssh.
     (when (eof-object? (peek-char pipe))
-      (raise (condition
-              (&message
-               (message (format #f (G_ "failed to run '~{~a~^ ~}'")
-                                repl-command))))))
+      (let ((status (channel-get-exit-status pipe)))
+        (close-port pipe)
+        (raise (condition
+                (&message
+                 (message (format #f (G_ "remote command '~{~a~^ ~}' failed \
+with status ~a")
+                                  repl-command status)))))))
     (port->inferior pipe)))
 
 (define* (inferior-remote-eval exp session #:optional become-command)