diff options
| -rw-r--r-- | guix/scripts/offload.scm | 27 | ||||
| -rw-r--r-- | guix/ssh.scm | 36 |
2 files changed, 35 insertions, 28 deletions
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 7e114fa2c9..25efe90e79 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -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. diff --git a/guix/ssh.scm b/guix/ssh.scm index cb560c0e9c..21c452f28c 100644 --- a/guix/ssh.scm +++ b/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 @@ #: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 |