mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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.
This commit is contained in:
parent
ecdb81e159
commit
352ec143de
3 changed files with 20 additions and 9 deletions
|
@ -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)"
|
||||
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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"
|
||||
|
|
Loading…
Reference in a new issue