~ruther/guix-local

882383a9aa5fbeef6f29d359a786a6db7c9e03db — Ludovic Courtès 11 years ago b497a85
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.
2 files changed, 35 insertions(+), 13 deletions(-)

M guix/download.scm
M tests/builders.scm
M guix/download.scm => guix/download.scm +18 -13
@@ 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)))

M tests/builders.scm => tests/builders.scm +17 -0
@@ 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))))