~ruther/guix-local

352ec143de32e751286590ff51c40f5a32c7fa87 — Ludovic Courtès 13 years ago ecdb81e
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.
3 files changed, 20 insertions(+), 9 deletions(-)

M Makefile.am
M guix-download.in
M tests/guix-download.sh
M Makefile.am => Makefile.am +2 -0
@@ 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)"


M guix-download.in => guix-download.in +15 -9
@@ 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)))

M tests/guix-download.sh => tests/guix-download.sh +3 -0
@@ 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"