From 8b7af63754945c04a1046c9701d5257a7277a95a Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 24 Mar 2014 22:20:54 +0100
Subject: 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.
---
 guix/scripts/offload.scm | 38 ++++++++++++++++++++++----------------
 1 file changed, 22 insertions(+), 16 deletions(-)

(limited to 'guix/scripts/offload.scm')

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 @@ (define (missing-files files)
 
       ;; 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 @@ (define host
     (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 @@ (define host
 
              ;; 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)))))
 
 
 ;;;
-- 
cgit v1.2.3