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"