diff options
| -rw-r--r-- | guix/download.scm | 31 | ||||
| -rw-r--r-- | tests/builders.scm | 17 |
2 files changed, 35 insertions, 13 deletions
diff --git a/guix/download.scm b/guix/download.scm index e956e08470..2d4bf74951 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -242,20 +242,25 @@ must be a list of symbol/URL-list pairs." (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))) diff --git a/tests/builders.scm b/tests/builders.scm index ce1f3852d7..a2f500a94d 100644 --- a/tests/builders.scm +++ b/tests/builders.scm @@ -25,6 +25,7 @@ #: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 @@ (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)))) |