mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
download: Allow raw file names or file:// URLs.
* guix/download.scm (url-fetch): When URL is a string, if it's not a URI or if it's a URI with 'file' or #f scheme, use 'add-to-store'. * tests/builders.scm ("url-fetch, file", "url-fetch, file URI"): New tests.
This commit is contained in:
parent
b497a85be8
commit
882383a9aa
2 changed files with 35 additions and 13 deletions
|
@ -242,20 +242,25 @@ (define builder
|
|||
(url-fetch '#$url #$output
|
||||
#:mirrors '#$mirrors)))
|
||||
|
||||
(run-with-store store
|
||||
(gexp->derivation (or name file-name) builder
|
||||
#:system system
|
||||
#:hash-algo hash-algo
|
||||
#:hash hash
|
||||
#:modules '((guix build download)
|
||||
(guix build utils)
|
||||
(guix ftp-client))
|
||||
#:guile-for-build guile-for-build
|
||||
(let ((uri (and (string? url) (string->uri url))))
|
||||
(if (or (and (string? url) (not uri))
|
||||
(and uri (memq (uri-scheme uri) '(#f file))))
|
||||
(add-to-store store (or name file-name)
|
||||
#f "sha256" (if uri (uri-path uri) url))
|
||||
(run-with-store store
|
||||
(gexp->derivation (or name file-name) builder
|
||||
#:system system
|
||||
#:hash-algo hash-algo
|
||||
#:hash hash
|
||||
#:modules '((guix build download)
|
||||
(guix build utils)
|
||||
(guix ftp-client))
|
||||
#:guile-for-build guile-for-build
|
||||
|
||||
;; In general, offloading downloads is not a good idea.
|
||||
#:local-build? #t)
|
||||
#:guile-for-build guile-for-build
|
||||
#:system system))
|
||||
;; In general, offloading downloads is not a good idea.
|
||||
#:local-build? #t)
|
||||
#:guile-for-build guile-for-build
|
||||
#:system system))))
|
||||
|
||||
(define* (download-to-store store url #:optional (name (basename url))
|
||||
#:key (log (current-error-port)))
|
||||
|
|
|
@ -25,6 +25,7 @@ (define-module (test-builders)
|
|||
#:use-module (guix utils)
|
||||
#:use-module (guix base32)
|
||||
#:use-module (guix derivations)
|
||||
#:use-module (guix hash)
|
||||
#:use-module (guix tests)
|
||||
#:use-module ((guix packages)
|
||||
#:select (package-derivation package-native-search-paths))
|
||||
|
@ -74,6 +75,22 @@ (define network-reachable?
|
|||
(file-exists? out-path)
|
||||
(valid-path? %store out-path))))
|
||||
|
||||
(test-assert "url-fetch, file"
|
||||
(let* ((file (search-path %load-path "guix.scm"))
|
||||
(hash (call-with-input-file file port-sha256))
|
||||
(out (url-fetch %store file 'sha256 hash)))
|
||||
(and (file-exists? out)
|
||||
(valid-path? %store out))))
|
||||
|
||||
(test-assert "url-fetch, file URI"
|
||||
(let* ((file (search-path %load-path "guix.scm"))
|
||||
(hash (call-with-input-file file port-sha256))
|
||||
(out (url-fetch %store
|
||||
(string-append "file://" (canonicalize-path file))
|
||||
'sha256 hash)))
|
||||
(and (file-exists? out)
|
||||
(valid-path? %store out))))
|
||||
|
||||
(test-assert "gnu-build-system"
|
||||
(and (build-system? gnu-build-system)
|
||||
(eq? gnu-build (build-system-builder gnu-build-system))))
|
||||
|
|
Loading…
Reference in a new issue