mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-27 04:59:27 -05:00
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:
parent
dc98472a41
commit
bc2b1484f7
1 changed files with 41 additions and 32 deletions
73
guix/ssh.scm
73
guix/ssh.scm
|
@ -283,6 +283,11 @@ (define (store-import-channel session)
|
|||
;; consumed.
|
||||
(define import
|
||||
`(begin
|
||||
(eval-when (load expand eval)
|
||||
(unless (resolve-module '(guix) #:ensure #f)
|
||||
(write `(module-error))
|
||||
(exit 7)))
|
||||
|
||||
(use-modules (guix) (srfi srfi-34)
|
||||
(rnrs io ports) (rnrs bytevectors))
|
||||
|
||||
|
@ -305,6 +310,9 @@ (define (consume-input port)
|
|||
(consume-input (current-input-port))
|
||||
(list 'protocol-error (nix-protocol-error-message c))))
|
||||
(with-store store
|
||||
(write '(importing)) ;we're ready
|
||||
(force-output)
|
||||
|
||||
(setvbuf (current-input-port) 'none)
|
||||
(import-paths store (current-input-port))
|
||||
'(success))))
|
||||
|
@ -401,24 +409,11 @@ (define* (send-files local files remote
|
|||
"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.
|
||||
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.
|
||||
(let* ((files (if recursive? (requisites local files) files))
|
||||
(session (channel-get-session (store-connection-socket remote)))
|
||||
(missing (inferior-remote-eval*
|
||||
(missing (inferior-remote-eval
|
||||
`(begin
|
||||
(eval-when (load expand eval)
|
||||
(unless (resolve-module '(guix) #:ensure #f)
|
||||
(exit 7)))
|
||||
|
||||
(use-modules (guix)
|
||||
(srfi srfi-1) (srfi srfi-26))
|
||||
|
||||
|
@ -431,6 +426,13 @@ (define (inferior-remote-eval* exp session)
|
|||
(path-info-nar-size (query-path-info local item)))
|
||||
missing))
|
||||
(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'...~%"
|
||||
"sending ~a store items (~h MiB) to '~a'...~%" count)
|
||||
count
|
||||
|
@ -505,6 +507,29 @@ (define-syntax raise-error
|
|||
(&message
|
||||
(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
|
||||
#:key recursive? (log-port (current-error-port))
|
||||
(import (const #f)))
|
||||
|
@ -525,24 +550,8 @@ (define* (retrieve-files* files remote
|
|||
(import port))
|
||||
(lambda ()
|
||||
(close-port port))))
|
||||
((? 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))))))
|
||||
(sexp
|
||||
(handle-import/export-channel-error sexp remote)))))
|
||||
|
||||
(define* (retrieve-files local files remote
|
||||
#:key recursive? (log-port (current-error-port)))
|
||||
|
|
Loading…
Reference in a new issue