summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-03-24 22:20:54 +0100
committerLudovic Courtès <ludo@gnu.org>2014-03-24 22:20:54 +0100
commit8b7af63754945c04a1046c9701d5257a7277a95a (patch)
treea8fd2667df3bcade0b885acc7648085dc83dbe67 /guix
parent01ac19dca4318d577cf3bef53cfe6af590f0e5f8 (diff)
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.
Diffstat (limited to 'guix')
-rw-r--r--guix/scripts/offload.scm38
1 files changed, 22 insertions, 16 deletions
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index e078012582..e8dd927f54 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -377,19 +377,22 @@ success, #f otherwise."
;; Compute the subset of FILES missing on MACHINE, and send them in
;; topologically sorted order so that they can actually be imported.
- (let ((files (missing-files (topologically-sorted store files)))
- (pipe (remote-pipe machine OPEN_WRITE
- '("guix" "archive" "--import"))))
+ (let* ((files (missing-files (topologically-sorted store files)))
+ (pipe (remote-pipe machine OPEN_WRITE
+ '("xz" "-dc" "|"
+ "guix" "archive" "--import"))))
(format #t (_ "sending ~a store files to '~a'...~%")
(length files) (build-machine-name machine))
- (catch 'system-error
- (lambda ()
- (export-paths store files pipe))
- (lambda args
- (warning (_ "failed while exporting files to '~a': ~a~%")
- (build-machine-name machine)
- (strerror (system-error-errno args)))))
- (zero? (close-pipe pipe))))))
+ (call-with-compressed-output-port 'xz pipe
+ (lambda (compressed)
+ (catch 'system-error
+ (lambda ()
+ (export-paths store files compressed))
+ (lambda args
+ (warning (_ "failed while exporting files to '~a': ~a~%")
+ (build-machine-name machine)
+ (strerror (system-error-errno args)))))))
+ #t))))
(define (retrieve-files files machine)
"Retrieve FILES from MACHINE's store, and import them."
@@ -397,7 +400,8 @@ success, #f otherwise."
(build-machine-name machine))
(let ((pipe (remote-pipe machine OPEN_READ
- `("guix" "archive" "--export" ,@files))))
+ `("guix" "archive" "--export" ,@files
+ "|" "xz" "-c"))))
(and pipe
(with-store store
(guard (c ((nix-protocol-error? c)
@@ -409,11 +413,13 @@ success, #f otherwise."
;; We cannot use the 'import-paths' RPC here because we already
;; hold the locks for FILES.
- (restore-file-set pipe
- #:log-port (current-error-port)
- #:lock? #f)
+ (call-with-decompressed-port 'xz pipe
+ (lambda (decompressed)
+ (restore-file-set decompressed
+ #:log-port (current-error-port)
+ #:lock? #f)))
- (zero? (close-pipe pipe)))))))
+ #t)))))
;;;