diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2012-11-13 22:57:50 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2012-11-13 22:58:43 +0100 |
| commit | 352ec143de32e751286590ff51c40f5a32c7fa87 (patch) | |
| tree | dd52b23ac37be4fb6023810c7485894c776a5cbe | |
| parent | ecdb81e159a29c92351bc51c3556a760074f7473 (diff) | |
guix-download: Add support for file:// URIs.
* guix-download.in (fetch-and-store): New procedure.
(guix-download): Use it to compute PATH. Call `add-to-store' when
a `file' URI scheme is used.
* Makefile.am (AM_TESTS_ENVIRONMENT): New variable.
* tests/guix-download.sh: Add test.
| -rw-r--r-- | Makefile.am | 2 | ||||
| -rw-r--r-- | guix-download.in | 24 | ||||
| -rw-r--r-- | tests/guix-download.sh | 3 |
3 files changed, 20 insertions, 9 deletions
diff --git a/Makefile.am b/Makefile.am index 4e2975b4d3..8b9c3ebaf5 100644 --- a/Makefile.am +++ b/Makefile.am @@ -154,6 +154,8 @@ TESTS = \ TEST_EXTENSIONS = .scm .sh +AM_TESTS_ENVIRONMENT = abs_top_srcdir="$(abs_top_srcdir)" + SCM_LOG_COMPILER = $(top_builddir)/pre-inst-env $(GUILE) AM_SCM_LOG_FLAGS = --no-auto-compile -L "$(top_srcdir)" diff --git a/guix-download.in b/guix-download.in index a3fd4b55d4..cd4ad1b71b 100644 --- a/guix-download.in +++ b/guix-download.in @@ -86,6 +86,15 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \ (put-bytevector port buffer 0 count) (loop (get-bytevector-n! in buffer 0 len))))))) +(define (fetch-and-store store fetch uri) + "Call FETCH for URI, and pass it an output port to write to; eventually, +copy data from that port to STORE. Return the resulting store path." + (call-with-temporary-output-file + (lambda (name port) + (fetch uri port) + (close port) + (add-to-store store (basename (uri-path uri)) + #t #f "sha256" name)))) ;;; ;;; Command-line options. @@ -162,18 +171,15 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@")) (uri (or (string->uri (assq-ref opts 'argument)) (leave (_ "guix-download: ~a: failed to parse URI~%") (assq-ref opts 'argument)))) - (fetch (case (uri-scheme uri) - ((http) http-fetch) - ((ftp) ftp-fetch) + (path (case (uri-scheme uri) + ((http) (fetch-and-store store uri http-fetch)) + ((ftp) (fetch-and-store store uri ftp-fetch)) + ((file) + (add-to-store store (basename (uri-path uri)) + #t #f "sha256" (uri-path uri))) (else (leave (_ "guix-download: ~a: unsupported URI scheme~%") (uri-scheme uri))))) - (path (call-with-temporary-output-file - (lambda (name port) - (fetch uri port) - (close port) - (add-to-store store (basename (uri-path uri)) - #t #f "sha256" name)))) (hash (call-with-input-file path (compose sha256 get-bytevector-all))) (fmt (assq-ref opts 'format))) diff --git a/tests/guix-download.sh b/tests/guix-download.sh index fc7b35d1b3..e756600404 100644 --- a/tests/guix-download.sh +++ b/tests/guix-download.sh @@ -31,3 +31,6 @@ then false; else true; fi if guix-download not/a/uri; then false; else true; fi + +# This one should succeed. +guix-download "file://$abs_top_srcdir/README" |