diff options
author | Ludovic Courtès <ludo@gnu.org> | 2014-03-24 22:20:54 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2014-03-24 22:20:54 +0100 |
commit | 8b7af63754945c04a1046c9701d5257a7277a95a (patch) | |
tree | a8fd2667df3bcade0b885acc7648085dc83dbe67 /guix | |
parent | 01ac19dca4318d577cf3bef53cfe6af590f0e5f8 (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.scm | 38 |
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))))) ;;; |