ssh: Really report Guile setup errors in 'send-files'.

This is a followup to commit 8f53d73493,
which did not have the desired effect: the 'resolve-module' call was
bound to succeed since the inferior runs 'guix repl'.

* guix/ssh.scm (store-import-channel)[import]: Add call to
'resolve-module' and write '(module-error) upon error.  Write
'(importing) when we're ready.
(send-files)[inferior-remote-eval*]: Remove.
[missing]: Remove call to 'resolve-module'.
Call 'handle-import/export-channel-error' when PORT doesn't
return '(importing).
(handle-import/export-channel-error): New procedure.
(retrieve-files*): Use it.
This commit is contained in:
Ludovic Courtès 2020-08-07 11:26:07 +02:00
parent dc98472a41
commit bc2b1484f7
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5

View File

@ -283,6 +283,11 @@ can be written."
;; consumed. ;; consumed.
(define import (define import
`(begin `(begin
(eval-when (load expand eval)
(unless (resolve-module '(guix) #:ensure #f)
(write `(module-error))
(exit 7)))
(use-modules (guix) (srfi srfi-34) (use-modules (guix) (srfi srfi-34)
(rnrs io ports) (rnrs bytevectors)) (rnrs io ports) (rnrs bytevectors))
@ -305,6 +310,9 @@ can be written."
(consume-input (current-input-port)) (consume-input (current-input-port))
(list 'protocol-error (nix-protocol-error-message c)))) (list 'protocol-error (nix-protocol-error-message c))))
(with-store store (with-store store
(write '(importing)) ;we're ready
(force-output)
(setvbuf (current-input-port) 'none) (setvbuf (current-input-port) 'none)
(import-paths store (current-input-port)) (import-paths store (current-input-port))
'(success)))) '(success))))
@ -401,24 +409,11 @@ to the system ACL file if it has not yet been authorized."
"Send the subset of FILES from LOCAL (a local store) that's missing to "Send the subset of FILES from LOCAL (a local store) that's missing to
REMOTE, a remote store. When RECURSIVE? is true, send the closure of FILES. REMOTE, a remote store. When RECURSIVE? is true, send the closure of FILES.
Return the list of store items actually sent." Return the list of store items actually sent."
(define (inferior-remote-eval* exp session)
(guard (c ((inferior-exception? c)
(match (inferior-exception-arguments c)
(('quit 7)
(report-module-error (remote-store-host remote)))
(_
(report-inferior-exception c (remote-store-host remote))))))
(inferior-remote-eval exp session)))
;; Compute the subset of FILES missing on SESSION and send them. ;; Compute the subset of FILES missing on SESSION and send them.
(let* ((files (if recursive? (requisites local files) files)) (let* ((files (if recursive? (requisites local files) files))
(session (channel-get-session (store-connection-socket remote))) (session (channel-get-session (store-connection-socket remote)))
(missing (inferior-remote-eval* (missing (inferior-remote-eval
`(begin `(begin
(eval-when (load expand eval)
(unless (resolve-module '(guix) #:ensure #f)
(exit 7)))
(use-modules (guix) (use-modules (guix)
(srfi srfi-1) (srfi srfi-26)) (srfi srfi-1) (srfi srfi-26))
@ -431,6 +426,13 @@ Return the list of store items actually sent."
(path-info-nar-size (query-path-info local item))) (path-info-nar-size (query-path-info local item)))
missing)) missing))
(port (store-import-channel session))) (port (store-import-channel session)))
;; Make sure everything alright on the remote side.
(match (read port)
(('importing)
#t)
(sexp
(handle-import/export-channel-error sexp remote)))
(format log-port (N_ "sending ~a store item (~h MiB) to '~a'...~%" (format log-port (N_ "sending ~a store item (~h MiB) to '~a'...~%"
"sending ~a store items (~h MiB) to '~a'...~%" count) "sending ~a store items (~h MiB) to '~a'...~%" count)
count count
@ -505,6 +507,29 @@ to the length of FILES.)"
(&message (&message
(message (format #f fmt args ...)))))))) (message (format #f fmt args ...))))))))
(define (handle-import/export-channel-error sexp remote)
"Report an error corresponding to SEXP, the EOF object or an sexp read from
REMOTE."
(match sexp
((? eof-object?)
(report-guile-error (remote-store-host remote)))
(('module-error . _)
(report-module-error (remote-store-host remote)))
(('connection-error file code . _)
(raise-error (G_ "failed to connect to '~A' on remote host '~A': ~a")
file (remote-store-host remote) (strerror code)))
(('invalid-items items . _)
(raise-error (N_ "no such item on remote host '~A':~{ ~a~}"
"no such items on remote host '~A':~{ ~a~}"
(length items))
(remote-store-host remote) items))
(('protocol-error status message . _)
(raise-error (G_ "protocol error on remote host '~A': ~a")
(remote-store-host remote) message))
(_
(raise-error (G_ "failed to retrieve store items from '~a'")
(remote-store-host remote)))))
(define* (retrieve-files* files remote (define* (retrieve-files* files remote
#:key recursive? (log-port (current-error-port)) #:key recursive? (log-port (current-error-port))
(import (const #f))) (import (const #f)))
@ -525,24 +550,8 @@ from REMOTE. When RECURSIVE? is true, retrieve the closure of FILES."
(import port)) (import port))
(lambda () (lambda ()
(close-port port)))) (close-port port))))
((? eof-object?) (sexp
(report-guile-error (remote-store-host remote))) (handle-import/export-channel-error sexp remote)))))
(('module-error . _)
(report-module-error (remote-store-host remote)))
(('connection-error file code . _)
(raise-error (G_ "failed to connect to '~A' on remote host '~A': ~a")
file (remote-store-host remote) (strerror code)))
(('invalid-items items . _)
(raise-error (N_ "no such item on remote host '~A':~{ ~a~}"
"no such items on remote host '~A':~{ ~a~}"
(length items))
(remote-store-host remote) items))
(('protocol-error status message . _)
(raise-error (G_ "protocol error on remote host '~A': ~a")
(remote-store-host remote) message))
(_
(raise-error (G_ "failed to retrieve store items from '~a'")
(remote-store-host remote))))))
(define* (retrieve-files local files remote (define* (retrieve-files local files remote
#:key recursive? (log-port (current-error-port))) #:key recursive? (log-port (current-error-port)))