offload: Wait for the processes involved in 'guix archive --missing'.

* guix/scripts/offload.scm (send-files): Keep the second return value of
  'filtered-port'.  Call 'waitpid' on it.
This commit is contained in:
Ludovic Courtès 2014-03-26 16:22:41 +01:00
parent c67ccedd9e
commit 6c41cce0be
1 changed files with 13 additions and 9 deletions

View File

@ -26,6 +26,7 @@
#:use-module ((guix build utils) #:select (which mkdir-p)) #:use-module ((guix build utils) #:select (which mkdir-p))
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26) #: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)
@ -356,15 +357,18 @@ with exit code ~a~%"
success, #f otherwise." success, #f otherwise."
(define (missing-files files) (define (missing-files files)
;; Return the subset of FILES not already on MACHINE. ;; Return the subset of FILES not already on MACHINE.
(let* ((files (format #f "~{~a~%~}" files)) (let*-values (((files)
(missing (filtered-port (format #f "~{~a~%~}" files))
(list (which %lshg-command) ((missing pids)
"-l" (build-machine-user machine) (filtered-port
"-p" (number->string (build-machine-port machine)) (list (which %lshg-command)
"-i" (build-machine-private-key machine) "-l" (build-machine-user machine)
(build-machine-name machine) "-p" (number->string (build-machine-port machine))
"guix" "archive" "--missing") "-i" (build-machine-private-key machine)
(open-input-string files)))) (build-machine-name machine)
"guix" "archive" "--missing")
(open-input-string files))))
(for-each waitpid pids)
(string-tokenize (get-string-all missing)))) (string-tokenize (get-string-all missing))))
(with-store store (with-store store