diff mbox series

[bug#68242,3/5] packages: Repack patched source archives via zstd by default.

Message ID 731e80fc6d38e18709f359ea2f982e9b302b2864.1704386901.git.maxim.cournoyer@gmail.com
State New
Headers show
Series [bug#68242,1/5] utils: Lower xz compression memory usage limit to 20%. | expand

Commit Message

Maxim Cournoyer Jan. 4, 2024, 4:48 p.m. UTC 
* guix/build/utils.scm (compressor): Register zst file name extension.
* guix/packages.scm (%standard-patch-inputs): Add zstd.
(patch-and-repack): Rename tarxz-name nested procedure to tar-file-name, and
accept a new 'ext' argument; adjust accordingly.  Add zstd binding, and
replace the XZ_DEFAULTS environment variable with ZSTD_NBTHREADS.  Fallback to
xz when zstd is not available.

Change-Id: I614a6be8c87a4a0858eadce616c51d8e9b9fc020
---

 guix/build/utils.scm |  1 +
 guix/packages.scm    | 50 +++++++++++++++++++++++++-------------------
 2 files changed, 30 insertions(+), 21 deletions(-)
diff mbox series

Patch

diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index e87066cc02..9c1e19f6d8 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -177,6 +177,7 @@  (define (compressor file-name)
         ((string-suffix? "lz"  file-name)  "lzip")
         ((string-suffix? "zip" file-name)  "unzip")
         ((string-suffix? "xz"  file-name)  "xz")
+        ((string-suffix? "zst" file-name)  "zstd")
         (else #f)))                ;no compression used/unknown file extension
 
 (define (tarball? file-name)
diff --git a/guix/packages.scm b/guix/packages.scm
index cb8db925f8..ce1ba7c53a 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -5,7 +5,7 @@ 
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017, 2019, 2020, 2022 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
-;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020, 2021, 2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2022 jgart <jgart@dismail.de>
@@ -862,6 +862,7 @@  (define (%standard-patch-inputs system)
                          (module-ref (resolve-interface module) var))))))
     `(("tar"   ,(ref '(gnu packages base) 'tar))
       ("xz"    ,(ref '(gnu packages compression) 'xz))
+      ("zstd"  ,(ref '(gnu packages compression) 'zstd))
       ("bzip2" ,(ref '(gnu packages compression) 'bzip2))
       ("gzip"  ,(ref '(gnu packages compression) 'gzip))
       ("lzip"  ,(ref '(gnu packages compression) 'lzip))
@@ -926,31 +927,35 @@  (define* (patch-and-repack source patches
     ;; Return true if DIRECTORY is a checkout (git, svn, etc).
     (string-suffix? "-checkout" directory))
 
-  (define (tarxz-name file-name)
-    ;; Return a '.tar.xz' file name based on FILE-NAME.
+  (define (tar-file-name file-name ext)
+    ;; Return a '$filename.tar.$ext' file name based on FILE-NAME and EXT.
     (let ((base (if (numeric-extension? file-name)
                     original-file-name
                     (file-sans-extension file-name))))
       (string-append base
                      (if (equal? (file-extension base) "tar")
-                         ".xz"
-                         ".tar.xz"))))
+                         (string-append "." ext)
+                         (string-append ".tar." ext)))))
 
   (define instantiate-patch
     (match-lambda
-      ((? string? patch)                          ;deprecated
+      ((? string? patch)                ;deprecated
        (local-file patch #:recursive? #t))
-      ((? struct? patch)                          ;origin, local-file, etc.
+      ((? struct? patch)                ;origin, local-file, etc.
        patch)))
 
-  (let ((tar     (lookup-input "tar"))
-        (gzip    (lookup-input "gzip"))
-        (bzip2   (lookup-input "bzip2"))
-        (lzip    (lookup-input "lzip"))
-        (xz      (lookup-input "xz"))
-        (patch   (lookup-input "patch"))
-        (comp    (and=> (compressor source-file-name) lookup-input))
-        (patches (map instantiate-patch patches)))
+  (let* ((tar     (lookup-input "tar"))
+         (gzip    (lookup-input "gzip"))
+         (bzip2   (lookup-input "bzip2"))
+         (lzip    (lookup-input "lzip"))
+         (xz      (lookup-input "xz"))
+         (zstd    (or (lookup-input "zstd")
+                      ;; Fallback to xz in case zstd is not available, such as
+                      ;; for bootstrap packages.
+                      xz))
+         (patch   (lookup-input "patch"))
+         (comp    (and=> (compressor source-file-name) lookup-input))
+         (patches (map instantiate-patch patches)))
     (define build
       (with-imported-modules '((guix build utils))
         #~(begin
@@ -1028,12 +1033,12 @@  (define* (patch-and-repack source patches
                           locale (system-error-errno args)))))
 
             (setenv "PATH"
-                    (string-append #+xz "/bin"
+                    (string-append #+zstd "/bin"
                                    (if #+comp
                                        (string-append ":" #+comp "/bin")
                                        "")))
 
-            (setenv "XZ_DEFAULTS" (string-join (%xz-parallel-args)))
+            (setenv "ZSTD_NBTHREADS" (number->string (parallel-job-count)))
 
             ;; SOURCE may be either a directory, a tarball or a simple file.
             (let ((name (strip-store-file-name #+source))
@@ -1088,10 +1093,13 @@  (define* (patch-and-repack source patches
                (else                    ;single uncompressed file
                 (copy-file file #$output)))))))
 
-    (let ((name (if (or (checkout? original-file-name)
-                        (not (compressor original-file-name)))
-                    original-file-name
-                    (tarxz-name original-file-name))))
+    (let* ((ext (if zstd
+                    "zst"               ;usual case
+                    "xz"))              ;zstd-less bootstrap-origin
+           (name (if (or (checkout? original-file-name)
+                         (not (compressor original-file-name)))
+                     original-file-name
+                     (tar-file-name original-file-name ext))))
       (gexp->derivation name build
                         #:graft? #f
                         #:system system