nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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:
Ludovic Courtès 2014-10-03 11:02:11 +02:00
parent b497a85be8
commit 882383a9aa
2 changed files with 35 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
guix/download.scm
View File

@ -242,20 +242,25 @@ must be a list of symbol/URL-list pairs."
(url-fetch '#$url #$output (url-fetch '#$url #$output
#:mirrors '#$mirrors))) #:mirrors '#$mirrors)))
(run-with-store store (let ((uri (and (string? url) (string->uri url))))
(gexp->derivation (or name file-name) builder (if (or (and (string? url) (not uri))
#:system system (and uri (memq (uri-scheme uri) '(#f file))))
#:hash-algo hash-algo (add-to-store store (or name file-name)
#:hash hash #f "sha256" (if uri (uri-path uri) url))
#:modules '((guix build download) (run-with-store store
(guix build utils) (gexp->derivation (or name file-name) builder
(guix ftp-client)) #:system system
#:guile-for-build guile-for-build #: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. ;; In general, offloading downloads is not a good idea.
#:local-build? #t) #:local-build? #t)
#:guile-for-build guile-for-build #:guile-for-build guile-for-build
#:system system)) #:system system))))
(define* (download-to-store store url #:optional (name (basename url)) (define* (download-to-store store url #:optional (name (basename url))
#:key (log (current-error-port))) #:key (log (current-error-port)))

17
tests/builders.scm
View File

@ -25,6 +25,7 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix hash)
#:use-module (guix tests) #:use-module (guix tests)
#:use-module ((guix packages) #:use-module ((guix packages)
#:select (package-derivation package-native-search-paths)) #:select (package-derivation package-native-search-paths))
@ -74,6 +75,22 @@
(file-exists? out-path) (file-exists? out-path)
(valid-path? %store 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" (test-assert "gnu-build-system"
(and (build-system? gnu-build-system) (and (build-system? gnu-build-system)
(eq? gnu-build (build-system-builder gnu-build-system)))) (eq? gnu-build (build-system-builder gnu-build-system))))