* guix/download.scm (url-fetch/xz-file): New variable. --- guix/download.scm | 43 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 43 insertions(+)
diff --git a/guix/download.scm b/guix/download.scm index 2e9ecb43fc..cce62c4185 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -41,6 +41,7 @@ (define-module (guix download) (url-fetch* . url-fetch) url-fetch/executable url-fetch/tarbomb + url-fetch/xz-file url-fetch/zipbomb download-to-store)) @@ -602,6 +603,48 @@ (define tar #:graft? #f #:local-build? #t))) +(define* (url-fetch/xz-file url hash-algo hash + #:optional name + #:key (system (%current-system)) + (guile (default-guile))) + "Similar to 'url-fetch' but decompress the xz file at URL as the result. +This is mainly used for adding xz-compressed patches to a origin definition." + (define file-name + (match url + ((head _ ...) + (basename head)) + (_ + (basename url)))) + (define xz + (module-ref (resolve-interface '(gnu packages compression)) 'xz)) + + (mlet %store-monad ((drv (url-fetch* url hash-algo hash + (or name (basename file-name ".xz")) + #:system system + #:guile guile)) + (guile (package->derivation guile system))) + ;; Take the xz file, and simply decompress it. + ;; Use ungrafted xz so that the resulting file doesn't depend on whether + ;; grafts are enabled. + (gexp->derivation (or name file-name) + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + (setenv "XZ_OPT" + (string-join (%xz-parallel-args))) + + (copy-file #$drv #$file-name) + (make-file-writable #$file-name) + (invoke (string-append #+xz "/bin/unxz") + #$file-name) + + (copy-file (basename #$file-name ".xz") + #$output))) + #:system system + #:guile-for-build guile + #:graft? #f + #:local-build? #t))) + (define* (url-fetch/zipbomb url hash-algo hash #:optional name #:key (system (%current-system)) base-commit: 718223c58c20fa066527fb30da2b5dccca82913f -- 2.39.1