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

offload: Compress files being sent/retrieved. 

* guix/scripts/offload.scm (send-files): Add "xz -dc |" to the remote
  pipe command.  Pass PIPE through 'call-with-compressed-output-port'.
  Remove 'close-pipe' call.
  (retrieve-files): Add "| xz -c" to the remote pipe command.  Pass PIPE
  through 'call-with-decompressed-port'.  Remove 'close-pipe' call.
This commit is contained in:
Ludovic Courtès 2014-03-24 22:20:54 +01:00
parent 01ac19dca4
commit 8b7af63754
1 changed files with 22 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
guix/scripts/offload.scm
View File

@ -377,19 +377,22 @@ success, #f otherwise."
;; Compute the subset of FILES missing on MACHINE, and send them in ;; Compute the subset of FILES missing on MACHINE, and send them in
;; topologically sorted order so that they can actually be imported. ;; topologically sorted order so that they can actually be imported.
(let ((files (missing-files (topologically-sorted store files))) (let* ((files (missing-files (topologically-sorted store files)))
(pipe (remote-pipe machine OPEN_WRITE (pipe (remote-pipe machine OPEN_WRITE
'("guix" "archive" "--import")))) '("xz" "-dc" "|"
"guix" "archive" "--import"))))
(format #t (_ "sending ~a store files to '~a'...~%") (format #t (_ "sending ~a store files to '~a'...~%")
(length files) (build-machine-name machine)) (length files) (build-machine-name machine))
(catch 'system-error (call-with-compressed-output-port 'xz pipe
(lambda () (lambda (compressed)
(export-paths store files pipe)) (catch 'system-error
(lambda args (lambda ()
(warning (_ "failed while exporting files to '~a': ~a~%") (export-paths store files compressed))
(build-machine-name machine) (lambda args
(strerror (system-error-errno args))))) (warning (_ "failed while exporting files to '~a': ~a~%")
(zero? (close-pipe pipe)))))) (build-machine-name machine)
(strerror (system-error-errno args)))))))
#t))))
(define (retrieve-files files machine) (define (retrieve-files files machine)
"Retrieve FILES from MACHINE's store, and import them." "Retrieve FILES from MACHINE's store, and import them."
@ -397,7 +400,8 @@ success, #f otherwise."
(build-machine-name machine)) (build-machine-name machine))
(let ((pipe (remote-pipe machine OPEN_READ (let ((pipe (remote-pipe machine OPEN_READ
`("guix" "archive" "--export" ,@files)))) `("guix" "archive" "--export" ,@files
"|" "xz" "-c"))))
(and pipe (and pipe
(with-store store (with-store store
(guard (c ((nix-protocol-error? c) (guard (c ((nix-protocol-error? c)
@ -409,11 +413,13 @@ success, #f otherwise."
;; We cannot use the 'import-paths' RPC here because we already ;; We cannot use the 'import-paths' RPC here because we already
;; hold the locks for FILES. ;; hold the locks for FILES.
(restore-file-set pipe (call-with-decompressed-port 'xz pipe
#:log-port (current-error-port) (lambda (decompressed)
#:lock? #f) (restore-file-set decompressed
#:log-port (current-error-port)
#:lock? #f)))
(zero? (close-pipe pipe))))))) #t)))))
;;; ;;;