nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
guix/scripts/offload.scm
View File

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

36
guix/ssh.scm
View File

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