mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-19 05:57:04 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

download: Autoload (guix build download).

Browse source 
* guix/download.scm: Autoload (guix build download).
(url-fetch): Rename to...
(url-fetch*): ... this, locally, to allow for #:autoload.
* guix/status.scm: Autoload (guix build download).
This commit is contained in:
Ludovic Courtès 2021-03-19 12:02:08 +01:00
parent c1940fde43
commit f7008ca713
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 26 additions and 28 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

49
guix/download.scm
View file

@ -27,7 +27,7 @@ (define-module (guix download)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix store) #:use-module (guix store)
#:use-module ((guix build download) #:prefix build:) #:autoload (guix build download) (url-fetch)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix utils) #:use-module (guix utils)
@ -35,7 +35,7 @@ (define-module (guix download)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:export (%mirrors #:export (%mirrors
url-fetch (url-fetch* . url-fetch)
url-fetch/executable url-fetch/executable
url-fetch/tarbomb url-fetch/tarbomb
url-fetch/zipbomb url-fetch/zipbomb
@ -449,11 +449,11 @@ (define* (built-in-download file-name url
;; for that built-in is widespread. ;; for that built-in is widespread.
#:local-build? #t))) #:local-build? #t)))
(define* (url-fetch url hash-algo hash (define* (url-fetch* url hash-algo hash
#:optional name #:optional name
#:key (system (%current-system)) #:key (system (%current-system))
(guile (default-guile)) (guile (default-guile))
executable?) executable?)
"Return a fixed-output derivation that fetches data from URL (a string, or a "Return a fixed-output derivation that fetches data from URL (a string, or a
list of strings denoting alternate URLs), which is expected to have hash HASH list of strings denoting alternate URLs), which is expected to have hash HASH
of type HASH-ALGO (a symbol). By default, the file name is the base name of of type HASH-ALGO (a symbol). By default, the file name is the base name of
@ -499,10 +499,10 @@ (define* (url-fetch/executable url hash-algo hash
#:key (system (%current-system)) #:key (system (%current-system))
(guile (default-guile))) (guile (default-guile)))
"Like 'url-fetch', but make the downloaded file executable." "Like 'url-fetch', but make the downloaded file executable."
(url-fetch url hash-algo hash name (url-fetch* url hash-algo hash name
#:system system #:system system
#:guile guile #:guile guile
#:executable? #t)) #:executable? #t))
(define* (url-fetch/tarbomb url hash-algo hash (define* (url-fetch/tarbomb url hash-algo hash
#:optional name #:optional name
@ -521,11 +521,11 @@ (define gzip
(define tar (define tar
(module-ref (resolve-interface '(gnu packages base)) 'tar)) (module-ref (resolve-interface '(gnu packages base)) 'tar))
(mlet %store-monad ((drv (url-fetch url hash-algo hash (mlet %store-monad ((drv (url-fetch* url hash-algo hash
(string-append "tarbomb-" (string-append "tarbomb-"
(or name file-name)) (or name file-name))
#:system system #:system system
#:guile guile)) #:guile guile))
(guile (package->derivation guile system))) (guile (package->derivation guile system)))
;; Take the tar bomb, and simply unpack it as a directory. ;; Take the tar bomb, and simply unpack it as a directory.
;; Use ungrafted tar/gzip so that the resulting tarball doesn't depend on ;; Use ungrafted tar/gzip so that the resulting tarball doesn't depend on
@ -559,11 +559,11 @@ (define file-name
(define unzip (define unzip
(module-ref (resolve-interface '(gnu packages compression)) 'unzip)) (module-ref (resolve-interface '(gnu packages compression)) 'unzip))
(mlet %store-monad ((drv (url-fetch url hash-algo hash (mlet %store-monad ((drv (url-fetch* url hash-algo hash
(string-append "zipbomb-" (string-append "zipbomb-"
(or name file-name)) (or name file-name))
#:system system #:system system
#:guile guile)) #:guile guile))
(guile (package->derivation guile system))) (guile (package->derivation guile system)))
;; Take the zip bomb, and simply unpack it as a directory. ;; Take the zip bomb, and simply unpack it as a directory.
;; Use ungrafted unzip so that the resulting tarball doesn't depend on ;; Use ungrafted unzip so that the resulting tarball doesn't depend on
@ -598,10 +598,9 @@ (define uri
(lambda (temp port) (lambda (temp port)
(let ((result (let ((result
(parameterize ((current-output-port log)) (parameterize ((current-output-port log))
(build:url-fetch url temp (url-fetch url temp
#:mirrors %mirrors #:mirrors %mirrors
#:verify-certificate? #:verify-certificate? verify-certificate?))))
verify-certificate?))))
(close port) (close port)
(and result (and result
(add-to-store store name recursive? "sha256" temp))))))) (add-to-store store name recursive? "sha256" temp)))))))

5
guix/status.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -23,8 +23,7 @@ (define-module (guix status)
#:use-module (guix colors) #:use-module (guix colors)
#:use-module (guix progress) #:use-module (guix progress)
#:autoload (guix build syscalls) (terminal-columns) #:autoload (guix build syscalls) (terminal-columns)
#:use-module ((guix build download) #:autoload (guix build download) (nar-uri-abbreviation)
#:select (nar-uri-abbreviation))
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix memoization) #:use-module (guix memoization)