diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2016-08-01 15:28:38 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2016-08-01 17:50:12 +0200 |
| commit | e3d2b39d9446a12579a7f4cc3cbd4fb0d1bd8593 (patch) | |
| tree | 9c6a0e6f0113767b573c5b91204c090f9c2b94bc | |
| parent | 97e60e341d4e7da770fe4a3d70a6c4b8a2baa8c2 (diff) | |
offload: Compress only uncompressed files.origin/wip-offload-compression
Suggested by Andreas Enge <andreas@enge.fr>.
* guix/utils.scm (compressed-file?): New procedure.
* guix/scripts/offload.scm (retrieve-files): Use xz compression only
when (any (negate compressed-file?) files).
(send-files): Likewise.
| -rw-r--r-- | guix/scripts/offload.scm | 28 | ||||
| -rw-r--r-- | guix/utils.scm | 6 |
2 files changed, 23 insertions, 11 deletions
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 7db0c9d610..6c315599d0 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -480,14 +480,17 @@ success, #f otherwise." ;; already quite busy, see hydra.gnu.org), compress with gzip rather ;; than xz: For a compression ratio 2 times larger, it is 20 times ;; faster. - (let* ((files (missing-files (topologically-sorted store files))) - (pipe (remote-pipe machine OPEN_WRITE - '("gzip" "-dc" "|" - "guix" "archive" "--import") - #:quote? #f))) + (let* ((files (missing-files (topologically-sorted store files))) + (compress? (any (negate compressed-file?) files)) + (pipe (remote-pipe machine OPEN_WRITE + (if compress? + '("gzip" "-dc" "|" + "guix" "archive" "--import") + '("guix archive" "--import")) + #:quote? #f))) (format #t (_ "sending ~a store files to '~a'...~%") (length files) (build-machine-name machine)) - (call-with-compressed-output-port 'gzip pipe + (call-with-compressed-output-port (and compress? 'gzip) pipe (lambda (compressed) (catch 'system-error (lambda () @@ -506,10 +509,13 @@ success, #f otherwise." (define host (build-machine-name machine)) - (let ((pipe (remote-pipe machine OPEN_READ - `("guix" "archive" "--export" ,@files - "|" "xz" "-c") - #:quote? #f))) + (let* ((compress? (any (negate compressed-file?) files)) + (pipe (remote-pipe machine OPEN_READ + (if compress? + `("guix" "archive" "--export" ,@files + "|" "xz" "-c") + `("guix" "archive" "--export" ,@files)) + #:quote? #f))) (and pipe (with-store store (guard (c ((nix-protocol-error? c) @@ -521,7 +527,7 @@ success, #f otherwise." ;; We cannot use the 'import-paths' RPC here because we already ;; hold the locks for FILES. - (call-with-decompressed-port 'xz pipe + (call-with-decompressed-port (and compress? 'xz) pipe (lambda (decompressed) (restore-file-set decompressed #:log-port (current-error-port) diff --git a/guix/utils.scm b/guix/utils.scm index 4c6b33171d..465686c44a 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -79,6 +79,7 @@ arguments-from-environment-variable file-extension file-sans-extension + compressed-file? switch-symlinks call-with-temporary-output-file call-with-temporary-directory @@ -551,6 +552,11 @@ minor version numbers from version-string." (substring file 0 dot) file))) +(define (compressed-file? file) + "Return true if FILE denotes a compressed file." + (->bool (member (file-extension file) + '("gz" "bz2" "xz" "lz" "tgz" "tbz2" "zip")))) + (define (switch-symlinks link target) "Atomically switch LINK, a symbolic link, to point to TARGET. Works both when LINK already exists and when it does not." |