diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 533b740896..fe2d82c99e 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -113,7 +113,9 @@ make-desktop-entry-file - locale-category->string)) + locale-category->string + + %xz-parallel-args)) ;;; @@ -1484,6 +1486,17 @@ returned." LC_NAME LC_NUMERIC LC_PAPER LC_TELEPHONE LC_TIME))) + +;;; +;;; Others. +;;; + +(define (%xz-parallel-args) + "The xz arguments required to enable bit-reproducible, multi-threaded +compression." + (list "--memlimit=50%" + (format #f "--threads=~a" (max 2 (parallel-job-count))))) + ;;; Local Variables: ;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1) ;;; eval: (put 'call-with-ascii-input-file 'scheme-indent-function 1) diff --git a/guix/packages.scm b/guix/packages.scm index 6598bd3149..865cb81929 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2016 Alex Kost ;;; Copyright © 2017, 2019, 2020 Efraim Flashner ;;; Copyright © 2019 Marius Bakke +;;; Copyright © 2020 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -693,6 +694,8 @@ specifies modules in scope when evaluating SNIPPET." (setenv "PATH" (string-append #+xz "/bin" ":" #+decomp "/bin")) + (setenv "XZ_DEFAULTS" (string-join (%xz-parallel-args))) + ;; SOURCE may be either a directory or a tarball. (if (file-is-directory? #+source) (let* ((store (%store-directory)) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 379e6a3ac6..a0112162e3 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2018 Chris Marusich ;;; Copyright © 2018 Efraim Flashner ;;; Copyright © 2020 Tobias Geerinckx-Rice +;;; Copyright © 2020 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,6 +26,7 @@ #:use-module (guix scripts) #:use-module (guix ui) #:use-module (guix gexp) + #:use-module ((guix build utils) #:select (%xz-parallel-args)) #:use-module (guix utils) #:use-module (guix store) #:use-module ((guix status) #:select (with-status-verbosity)) @@ -70,29 +72,34 @@ compressor? (name compressor-name) ;string (e.g., "gzip") (extension compressor-extension) ;string (e.g., ".lz") - (command compressor-command)) ;gexp (e.g., #~("/gnu/store/…/gzip" "-9n")) + (command compressor-command)) ;gexp (e.g., #~(list "/gnu/store/…/gzip" + ; "-9n" )) (define %compressors ;; Available compression tools. (list (compressor "gzip" ".gz" - #~(#+(file-append gzip "/bin/gzip") "-9n")) + #~(list #+(file-append gzip "/bin/gzip") "-9n")) (compressor "lzip" ".lz" - #~(#+(file-append lzip "/bin/lzip") "-9")) + #~(list #+(file-append lzip "/bin/lzip") "-9")) (compressor "xz" ".xz" - #~(#+(file-append xz "/bin/xz") "-e")) + #~(append (list #+(file-append xz "/bin/xz") + "-e") + (%xz-parallel-args))) (compressor "bzip2" ".bz2" - #~(#+(file-append bzip2 "/bin/bzip2") "-9")) + #~(list #+(file-append bzip2 "/bin/bzip2") "-9")) (compressor "zstd" ".zst" ;; The default level 3 compresses better than gzip in a ;; fraction of the time, while the highest level 19 ;; (de)compresses more slowly and worse than xz. - #~(#+(file-append zstd "/bin/zstd") "-3")) + #~(list #+(file-append zstd "/bin/zstd") "-3")) (compressor "none" "" #f))) ;; This one is only for use in this module, so don't put it in %compressors. (define bootstrap-xz (compressor "bootstrap-xz" ".xz" - #~(#+(file-append %bootstrap-coreutils&co "/bin/xz") "-e"))) + #~(append (list #+(file-append %bootstrap-coreutils&co "/bin/xz") + "-e") + (%xz-parallel-args)))) (define (lookup-compressor name) "Return the compressor object called NAME. Error out if it could not be @@ -269,7 +276,7 @@ added to the pack." #+@(if (compressor-command compressor) #~("-I" (string-join - '#+(compressor-command compressor))) + #+(compressor-command compressor))) #~()) "--format=gnu" @@ -541,11 +548,13 @@ the image." ,@(source-module-closure `((guix docker) (guix build store-copy) + (guix build utils) ;for %xz-parallel-args (guix profiles) (guix search-paths)) #:select? not-config?)) #~(begin (use-modules (guix docker) (guix build store-copy) + (guix build utils) (guix profiles) (guix search-paths) (srfi srfi-1) (srfi srfi-19) (ice-9 match)) @@ -602,7 +611,7 @@ the image." #~(list (string-append #$profile "/" #$entry-point))) #:extra-files directives - #:compressor '#+(compressor-command compressor) + #:compressor #+(compressor-command compressor) #:creation-time (make-time time-utc 0 1)))))) (gexp->derivation (string-append name ".tar" diff --git a/guix/utils.scm b/guix/utils.scm index 7cc321205e..ba896623f4 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -8,6 +8,7 @@ ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2018, 2020 Marius Bakke ;;; Copyright © 2020 Efraim Flashner +;;; Copyright © 2020 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -37,7 +38,7 @@ #:use-module (guix memoization) #:use-module ((guix build utils) #:select (dump-port mkdir-p delete-file-recursively - call-with-temporary-output-file)) + call-with-temporary-output-file %xz-parallel-args)) #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync)) #:use-module (guix diagnostics) ;, &error-location, etc. #:use-module (ice-9 format) @@ -220,7 +221,7 @@ a symbol such as 'xz." (match compression ((or #f 'none) (values input '())) ('bzip2 (filtered-port `(,%bzip2 "-dc") input)) - ('xz (filtered-port `(,%xz "-dc") input)) + ('xz (filtered-port `(,%xz "-dc" ,@(%xz-parallel-args)) input)) ('gzip (filtered-port `(,%gzip "-dc") input)) ('lzip (values (lzip-port 'make-lzip-input-port input) '())) @@ -232,7 +233,7 @@ a symbol such as 'xz." (match compression ((or #f 'none) (values input '())) ('bzip2 (filtered-port `(,%bzip2 "-c") input)) - ('xz (filtered-port `(,%xz "-c") input)) + ('xz (filtered-port `(,%xz "-c" ,@(%xz-parallel-args)) input)) ('gzip (filtered-port `(,%gzip "-c") input)) ('lzip (values (lzip-port 'make-lzip-input-port/compressed input) '())) @@ -291,7 +292,8 @@ program--e.g., '(\"--fast\")." (match compression ((or #f 'none) (values output '())) ('bzip2 (filtered-output-port `(,%bzip2 "-c" ,@options) output)) - ('xz (filtered-output-port `(,%xz "-c" ,@options) output)) + ('xz (filtered-output-port `(,%xz "-c" ,@(%xz-parallel-args) + ,@options) output)) ('gzip (filtered-output-port `(,%gzip "-c" ,@options) output)) ('lzip (values (lzip-port 'make-lzip-output-port output) '()))