offload: Fix regression in file retrieval.

This fixes a regression in 'retrieve-files*' introduced in
896fec476f, whereby (guix scripts offload)
would not read the initial sexp now sent by the remote host via
'store-export-channel'.  This would effectively prevent file retrieval
entirely when offloading.

* guix/ssh.scm (retrieve-files*): New procedure, like former
'retrieve-files' but with an extra #:import parameter.
(retrieve-files): Rewrite in terms of 'retrieve-files*'.
(file-retrieval-port): Make private.
* guix/scripts/offload.scm (transfer-and-offload): Pass #:import to
'retrieve-files*'.
(retrieve-files*): Remove.
This commit is contained in:
Ludovic Courtès 2018-01-12 22:20:30 +01:00
parent 6b433caed2
commit d06d54e338
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 35 additions and 28 deletions

View File

@ -358,26 +358,19 @@ MACHINE."
(parameterize ((current-build-output-port (build-log-port)))
(build-derivations store (list drv))))
(retrieve-files* outputs store)
(retrieve-files* outputs store
;; We cannot use the 'import-paths' RPC here because we
;; already hold the locks for FILES.
#:import
(lambda (port)
(restore-file-set port
#:log-port (current-error-port)
#:lock? #f)))
(format (current-error-port) "done with offloaded '~a'~%"
(derivation-file-name drv)))
(define (retrieve-files* files remote)
"Retrieve FILES from REMOTE and import them using 'restore-file-set'."
(let-values (((port count)
(file-retrieval-port files remote)))
(format #t (N_ "retrieving ~a store item from '~a'...~%"
"retrieving ~a store items from '~a'...~%" count)
count (remote-store-host remote))
;; We cannot use the 'import-paths' RPC here because we already
;; hold the locks for FILES.
(let ((result (restore-file-set port
#:log-port (current-error-port)
#:lock? #f)))
(close-port port)
result)))
;;;
;;; Scheduling.

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -29,6 +29,7 @@
#:use-module (ssh dist)
#:use-module (ssh dist node)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 match)
@ -38,9 +39,8 @@
connect-to-remote-daemon
send-files
retrieve-files
remote-store-host
file-retrieval-port))
retrieve-files*
remote-store-host))
;;; Commentary:
;;;
@ -339,10 +339,11 @@ to the length of FILES.)"
(&message
(message (format #f fmt args ...))))))))
(define* (retrieve-files local files remote
#:key recursive? (log-port (current-error-port)))
"Retrieve FILES from REMOTE and import them using the 'import-paths' RPC on
LOCAL. When RECURSIVE? is true, retrieve the closure of FILES."
(define* (retrieve-files* files remote
#:key recursive? (log-port (current-error-port))
(import (const #f)))
"Pass IMPORT an input port from which to read the sequence of FILES coming
from REMOTE. When RECURSIVE? is true, retrieve the closure of FILES."
(let-values (((port count)
(file-retrieval-port files remote
#:recursive? recursive?)))
@ -352,9 +353,12 @@ LOCAL. When RECURSIVE? is true, retrieve the closure of FILES."
"retrieving ~a store items from '~a'...~%" count)
count (remote-store-host remote))
(let ((result (import-paths local port)))
(close-port port)
result))
(dynamic-wind
(const #t)
(lambda ()
(import port))
(lambda ()
(close-port port))))
((? eof-object?)
(raise-error (G_ "failed to start Guile on remote host '~A': exit code ~A")
(remote-store-host remote)
@ -386,4 +390,14 @@ check.")
(raise-error (G_ "failed to retrieve store items from '~a'")
(remote-store-host remote))))))
(define* (retrieve-files local files remote
#:key recursive? (log-port (current-error-port)))
"Retrieve FILES from REMOTE and import them using the 'import-paths' RPC on
LOCAL. When RECURSIVE? is true, retrieve the closure of FILES."
(retrieve-files* files remote
#:recursive? recursive?
#:log-port log-port
#:import (lambda (port)
(import-paths local port))))
;;; ssh.scm ends here