From 352ec143de32e751286590ff51c40f5a32c7fa87 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 13 Nov 2012 22:57:50 +0100
Subject: [PATCH] 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.
---
 Makefile.am            |  2 ++
 guix-download.in       | 24 +++++++++++++++---------
 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"