summaryrefslogtreecommitdiff
path: root/guix/ssh.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-08-07 11:26:07 +0200
committerLudovic Courtès <ludo@gnu.org>2020-08-07 11:31:58 +0200
commitbc2b1484f781f3a660ccad5c5b8e4c3f5d9cbe90 (patch)
tree549a9d1b5a643c35179e0e394e070be3a7db6b45 /guix/ssh.scm
parentdc98472a412218c3081b3ee4800e6fd7191bf16b (diff)
ssh: Really report Guile setup errors in 'send-files'.
This is a followup to commit 8f53d73493a2949e2db28cd7d689a690b2d9479a, 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.
Diffstat (limited to 'guix/ssh.scm')
-rw-r--r--guix/ssh.scm73
1 files changed, 41 insertions, 32 deletions
diff --git a/guix/ssh.scm b/guix/ssh.scm
index a36f72bb67..24db171374 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -283,6 +283,11 @@ can be written."
;; 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 @@ can be written."
(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 @@ 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
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 @@ Return the list of store items actually sent."
(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 @@ to the length of FILES.)"
(&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 @@ from REMOTE. When RECURSIVE? is true, retrieve the closure of FILES."
(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)))