From 347fa4aebf0bd5609761b4515578b7040f0b7d3c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 16 Oct 2017 22:31:50 +0200
Subject: [PATCH] download: Make 'http-fetch' public.

* guix/build/download.scm (http-fetch): Remove 'file' parameter.  Change
to return an input port and the content-length.  Make public.
(url-fetch): Adjust accordingly.
---
 guix/build/download.scm | 44 ++++++++++++++++++++---------------------
 1 file changed, 22 insertions(+), 22 deletions(-)

diff --git a/guix/build/download.scm b/guix/build/download.scm
index e227ae598b..3b89f9412f 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -39,6 +39,7 @@ (define-module (guix build download)
   #:use-module (ice-9 format)
   #:export (open-socket-for-uri
             open-connection-for-uri
+            http-fetch
             %x509-certificate-directory
             close-connection
             resolve-uri-reference
@@ -745,11 +746,11 @@ (define (remove-dot-segments path)
                     #:query    (uri-query    ref)
                     #:fragment (uri-fragment ref)))))
 
-(define* (http-fetch uri file #:key timeout (verify-certificate? #t))
-  "Fetch data from URI and write it to FILE; when TIMEOUT is true, bail out if
-the connection could not be established in less than TIMEOUT seconds.  Return
-FILE on success.  When VERIFY-CERTIFICATE? is true, verify HTTPS
-certificates; otherwise simply ignore them."
+(define* (http-fetch uri #:key timeout (verify-certificate? #t))
+  "Return an input port containing the data at URI, and the expected number of
+bytes available or #f.  When TIMEOUT is true, bail out if the connection could
+not be established in less than TIMEOUT seconds.  When VERIFY-CERTIFICATE? is
+true, verify HTTPS certificates; otherwise simply ignore them."
 
   (define headers
     `(;; Some web sites, such as http://dist.schmorp.de, would block you if
@@ -779,20 +780,10 @@ (define headers
                            #:streaming? #t
                            #:headers headers))
                 ((code)
-                 (response-code resp))
-                ((size)
-                 (response-content-length resp)))
+                 (response-code resp)))
     (case code
       ((200)                                      ; OK
-       (begin
-         (call-with-output-file file
-           (lambda (p)
-             (dump-port* port p
-                         #:buffer-size %http-receive-buffer-size
-                         #:reporter (progress-reporter/file
-                                     (uri-abbreviation uri) size))
-             (newline)))
-         file))
+       (values port (response-content-length resp)))
       ((301                                       ; moved permanently
         302                                       ; found (redirection)
         303                                       ; see other
@@ -802,7 +793,7 @@ (define headers
          (format #t "following redirection to `~a'...~%"
                  (uri->string uri))
          (close connection)
-         (http-fetch uri file
+         (http-fetch uri
                      #:timeout timeout
                      #:verify-certificate? verify-certificate?)))
       (else
@@ -873,10 +864,19 @@ (define (fetch uri file)
             file (uri->string uri))
     (case (uri-scheme uri)
       ((http https)
-       (false-if-exception* (http-fetch uri file
-                                        #:verify-certificate?
-                                        verify-certificate?
-                                        #:timeout timeout)))
+       (false-if-exception*
+        (let-values (((port size)
+                      (http-fetch uri
+                                  #:verify-certificate? verify-certificate?
+                                  #:timeout timeout)))
+          (call-with-output-file file
+            (lambda (output)
+              (dump-port* port output
+                          #:buffer-size %http-receive-buffer-size
+                          #:reporter (progress-reporter/file
+                                      (uri-abbreviation uri) size))
+              (newline)))
+          #t)))
       ((ftp)
        (false-if-exception* (ftp-fetch uri file
                                        #:timeout timeout)))