packages: Repack patched source archives via zstd by default.

* 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.

Reviewed-by: Ludovic Courtès <ludo@gnu.org>
Change-Id: I614a6be8c87a4a0858eadce616c51d8e9b9fc020
This commit is contained in:
Maxim Cournoyer 2024-01-02 11:08:36 -05:00 committed by Ludovic Courtès
parent 8e57c5d1f3
commit c9666c120b
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 30 additions and 21 deletions

View file

@ -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)

View file

@ -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>
@ -912,6 +912,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))
@ -974,31 +975,35 @@ (define (checkout? directory)
;; 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
@ -1076,12 +1081,12 @@ (define (repack directory output)
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))
@ -1136,10 +1141,13 @@ (define (repack directory output)
(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