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 @@ decompress FILE-NAME, based on its file extension, else false."
((string-suffix? "lz" file-name) "lzip") ((string-suffix? "lz" file-name) "lzip")
((string-suffix? "zip" file-name) "unzip") ((string-suffix? "zip" file-name) "unzip")
((string-suffix? "xz" file-name) "xz") ((string-suffix? "xz" file-name) "xz")
((string-suffix? "zst" file-name) "zstd")
(else #f))) ;no compression used/unknown file extension (else #f))) ;no compression used/unknown file extension
(define (tarball? file-name) (define (tarball? file-name)

View file

@ -5,7 +5,7 @@
;;; Copyright © 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2017, 2019, 2020, 2022 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2017, 2019, 2020, 2022 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com> ;;; 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 © 2021 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be> ;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2022 jgart <jgart@dismail.de> ;;; Copyright © 2022 jgart <jgart@dismail.de>
@ -912,6 +912,7 @@ identifiers. The result is inferred from the file names of patches."
(module-ref (resolve-interface module) var)))))) (module-ref (resolve-interface module) var))))))
`(("tar" ,(ref '(gnu packages base) 'tar)) `(("tar" ,(ref '(gnu packages base) 'tar))
("xz" ,(ref '(gnu packages compression) 'xz)) ("xz" ,(ref '(gnu packages compression) 'xz))
("zstd" ,(ref '(gnu packages compression) 'zstd))
("bzip2" ,(ref '(gnu packages compression) 'bzip2)) ("bzip2" ,(ref '(gnu packages compression) 'bzip2))
("gzip" ,(ref '(gnu packages compression) 'gzip)) ("gzip" ,(ref '(gnu packages compression) 'gzip))
("lzip" ,(ref '(gnu packages compression) 'lzip)) ("lzip" ,(ref '(gnu packages compression) 'lzip))
@ -974,31 +975,35 @@ specifies modules in scope when evaluating SNIPPET."
;; Return true if DIRECTORY is a checkout (git, svn, etc). ;; Return true if DIRECTORY is a checkout (git, svn, etc).
(string-suffix? "-checkout" directory)) (string-suffix? "-checkout" directory))
(define (tarxz-name file-name) (define (tar-file-name file-name ext)
;; Return a '.tar.xz' file name based on FILE-NAME. ;; Return a '$filename.tar.$ext' file name based on FILE-NAME and EXT.
(let ((base (if (numeric-extension? file-name) (let ((base (if (numeric-extension? file-name)
original-file-name original-file-name
(file-sans-extension file-name)))) (file-sans-extension file-name))))
(string-append base (string-append base
(if (equal? (file-extension base) "tar") (if (equal? (file-extension base) "tar")
".xz" (string-append "." ext)
".tar.xz")))) (string-append ".tar." ext)))))
(define instantiate-patch (define instantiate-patch
(match-lambda (match-lambda
((? string? patch) ;deprecated ((? string? patch) ;deprecated
(local-file patch #:recursive? #t)) (local-file patch #:recursive? #t))
((? struct? patch) ;origin, local-file, etc. ((? struct? patch) ;origin, local-file, etc.
patch))) patch)))
(let ((tar (lookup-input "tar")) (let* ((tar (lookup-input "tar"))
(gzip (lookup-input "gzip")) (gzip (lookup-input "gzip"))
(bzip2 (lookup-input "bzip2")) (bzip2 (lookup-input "bzip2"))
(lzip (lookup-input "lzip")) (lzip (lookup-input "lzip"))
(xz (lookup-input "xz")) (xz (lookup-input "xz"))
(patch (lookup-input "patch")) (zstd (or (lookup-input "zstd")
(comp (and=> (compressor source-file-name) lookup-input)) ;; Fallback to xz in case zstd is not available, such as
(patches (map instantiate-patch patches))) ;; for bootstrap packages.
xz))
(patch (lookup-input "patch"))
(comp (and=> (compressor source-file-name) lookup-input))
(patches (map instantiate-patch patches)))
(define build (define build
(with-imported-modules '((guix build utils)) (with-imported-modules '((guix build utils))
#~(begin #~(begin
@ -1076,12 +1081,12 @@ specifies modules in scope when evaluating SNIPPET."
locale (system-error-errno args))))) locale (system-error-errno args)))))
(setenv "PATH" (setenv "PATH"
(string-append #+xz "/bin" (string-append #+zstd "/bin"
(if #+comp (if #+comp
(string-append ":" #+comp "/bin") (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. ;; SOURCE may be either a directory, a tarball or a simple file.
(let ((name (strip-store-file-name #+source)) (let ((name (strip-store-file-name #+source))
@ -1136,10 +1141,13 @@ specifies modules in scope when evaluating SNIPPET."
(else ;single uncompressed file (else ;single uncompressed file
(copy-file file #$output))))))) (copy-file file #$output)))))))
(let ((name (if (or (checkout? original-file-name) (let* ((ext (if zstd
(not (compressor original-file-name))) "zst" ;usual case
original-file-name "xz")) ;zstd-less bootstrap-origin
(tarxz-name original-file-name)))) (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 (gexp->derivation name build
#:graft? #f #:graft? #f
#:system system #:system system