summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-06-04 22:53:40 +0200
committerLudovic Courtès <ludo@gnu.org>2017-06-04 23:00:32 +0200
commitde9d8f0e295928d92e0e5ea43a4e594fa78c76fb (patch)
tree1be7a033d83eaad8db727974c83991977a1eaf77
parentfb976ada5be4634048bcbdde880729ee12f610e9 (diff)
ssh: Improve error reporting when 'send-files' fails.
Fixes <http://bugs.gnu.org/26972>. * guix/ssh.scm (store-import-channel)[import]: Add 'consume-input' procedure. Wrap body in 'catch' and 'guard'. Use 'open-remote-pipe' with OPEN_BOTH instead of 'open-remote-output-pipe'. (send-files): After the 'channel-send-eof' call, do (read port). Interpret the result sexp and raise an error condition if needed.
-rw-r--r--guix/ssh.scm76
1 files changed, 58 insertions, 18 deletions
diff --git a/guix/ssh.scm b/guix/ssh.scm
index 4fb145230d..32cf6e464b 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -150,23 +150,44 @@ can be written."
;; makes a round trip every time 32 KiB have been transferred. This
;; procedure instead opens a separate channel to use the remote
;; 'import-paths' procedure, which consumes all the data in a single round
- ;; trip.
+ ;; trip. This optimizes the successful case at the expense of error
+ ;; conditions: errors can only be reported once all the input has been
+ ;; consumed.
(define import
`(begin
- (use-modules (guix))
-
- (with-store store
- (setvbuf (current-input-port) _IONBF)
-
- ;; FIXME: Exceptions are silently swallowed. We should report them
- ;; somehow.
- (import-paths store (current-input-port)))))
-
- (open-remote-output-pipe session
- (string-join
- `("guile" "-c"
- ,(object->string
- (object->string import))))))
+ (use-modules (guix) (srfi srfi-34)
+ (rnrs io ports) (rnrs bytevectors))
+
+ (define (consume-input port)
+ (let ((bv (make-bytevector 32768)))
+ (let loop ()
+ (let ((n (get-bytevector-n! port bv 0
+ (bytevector-length bv))))
+ (unless (eof-object? n)
+ (loop))))))
+
+ ;; Upon completion, write an sexp that denotes the status.
+ (write
+ (catch #t
+ (lambda ()
+ (guard (c ((nix-protocol-error? c)
+ ;; Consume all the input since the only time we can
+ ;; report the error is after everything has been
+ ;; consumed.
+ (consume-input (current-input-port))
+ (list 'protocol-error (nix-protocol-error-message c))))
+ (with-store store
+ (setvbuf (current-input-port) _IONBF)
+ (import-paths store (current-input-port))
+ '(success))))
+ (lambda args
+ (cons 'error args))))))
+
+ (open-remote-pipe session
+ (string-join
+ `("guile" "-c"
+ ,(object->string (object->string import))))
+ OPEN_BOTH))
(define* (store-export-channel session files
#:key recursive?)
@@ -224,10 +245,29 @@ Return the list of store items actually sent."
;; mark of 'export-paths' would be enough, but in practice it's not.)
(channel-send-eof port)
- ;; Wait for completion of the remote process.
- (let ((result (zero? (channel-get-exit-status port))))
+ ;; Wait for completion of the remote process and read the status sexp from
+ ;; PORT.
+ (let* ((result (false-if-exception (read port)))
+ (status (zero? (channel-get-exit-status port))))
(close-port port)
- missing)))
+ (match result
+ (('success . _)
+ missing)
+ (('protocol-error message)
+ (raise (condition
+ (&nix-protocol-error (message message) (status 42)))))
+ (('error key args ...)
+ (raise (condition
+ (&nix-protocol-error
+ (message (call-with-output-string
+ (lambda (port)
+ (print-exception port #f key args))))
+ (status 43)))))
+ (_
+ (raise (condition
+ (&nix-protocol-error
+ (message "unknown error while sending files over SSH")
+ (status 44)))))))))
(define (remote-store-session remote)
"Return the SSH channel beneath REMOTE, a remote store as returned by