[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

03/05: download: Make 'http-fetch' public.

From: Ludovic Courtès
Subject: 03/05: download: Make 'http-fetch' public.
Date: Thu, 19 Oct 2017 17:21:57 -0400 (EDT)

civodul pushed a commit to branch master
in repository guix.

commit 347fa4aebf0bd5609761b4515578b7040f0b7d3c
Author: Ludovic Courtès <address@hidden>
Date:   Mon Oct 16 22:31:50 2017 +0200

    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 e227ae5..3b89f94 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -39,6 +39,7 @@
   #:use-module (ice-9 format)
   #:export (open-socket-for-uri
+            http-fetch
@@ -745,11 +746,11 @@ Return the resulting target URI."
                     #: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, would block you if
@@ -779,20 +780,10 @@ certificates; otherwise simply ignore them."
                            #:streaming? #t
                            #:headers headers))
-                 (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 @@ certificates; otherwise simply ignore them."
          (format #t "following redirection to `~a'...~%"
                  (uri->string uri))
          (close connection)
-         (http-fetch uri file
+         (http-fetch uri
                      #:timeout timeout
                      #:verify-certificate? verify-certificate?)))
@@ -873,10 +864,19 @@ otherwise simply ignore them."
             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)))
        (false-if-exception* (ftp-fetch uri file
                                        #:timeout timeout)))

reply via email to

[Prev in Thread] Current Thread [Next in Thread]