TakeV/guix
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

ssh: Improve error reporting when 'send-files' fails.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2017-06-04 22:53:40 +02:00
parent fb976ada5b
commit de9d8f0e29
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 55 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

70
guix/ssh.scm
View file

@ -150,23 +150,44 @@ (define (store-import-channel session)
;; makes a round trip every time 32 KiB have been transferred. This ;; makes a round trip every time 32 KiB have been transferred. This
;; procedure instead opens a separate channel to use the remote ;; procedure instead opens a separate channel to use the remote
;; 'import-paths' procedure, which consumes all the data in a single round ;; '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 (define import
`(begin `(begin
(use-modules (guix)) (use-modules (guix) (srfi srfi-34)
(rnrs io ports) (rnrs bytevectors))
(with-store store (define (consume-input port)
(setvbuf (current-input-port) _IONBF) (let ((bv (make-bytevector 32768)))
(let loop ()
(let ((n (get-bytevector-n! port bv 0
(bytevector-length bv))))
(unless (eof-object? n)
(loop))))))
;; FIXME: Exceptions are silently swallowed. We should report them ;; Upon completion, write an sexp that denotes the status.
;; somehow. (write
(import-paths store (current-input-port))))) (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-output-pipe session (open-remote-pipe session
(string-join (string-join
`("guile" "-c" `("guile" "-c"
,(object->string ,(object->string (object->string import))))
(object->string import)))))) OPEN_BOTH))
(define* (store-export-channel session files (define* (store-export-channel session files
#:key recursive?) #:key recursive?)
@ -224,10 +245,29 @@ (define* (send-files local files remote
;; mark of 'export-paths' would be enough, but in practice it's not.) ;; mark of 'export-paths' would be enough, but in practice it's not.)
(channel-send-eof port) (channel-send-eof port)
;; Wait for completion of the remote process. ;; Wait for completion of the remote process and read the status sexp from
(let ((result (zero? (channel-get-exit-status port)))) ;; PORT.
(let* ((result (false-if-exception (read port)))
(status (zero? (channel-get-exit-status port))))
(close-port 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) (define (remote-store-session remote)
"Return the SSH channel beneath REMOTE, a remote store as returned by "Return the SSH channel beneath REMOTE, a remote store as returned by