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:
parent
6b433caed2
commit
d06d54e338
2 changed files with 35 additions and 28 deletions
|
@ -358,26 +358,19 @@ (define store
|
|||
(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.
|
||||
|
|
36
guix/ssh.scm
36
guix/ssh.scm
|
@ -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 @@ (define-module (guix ssh)
|
|||
#: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 @@ (define-module (guix ssh)
|
|||
connect-to-remote-daemon
|
||||
send-files
|
||||
retrieve-files
|
||||
remote-store-host
|
||||
|
||||
file-retrieval-port))
|
||||
retrieve-files*
|
||||
remote-store-host))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
@ -339,10 +339,11 @@ (define-syntax raise-error
|
|||
(&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 @@ (define* (retrieve-files local files remote
|
|||
"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 @@ (define* (retrieve-files local files remote
|
|||
(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
|
||||
|
|
Loading…
Reference in a new issue