[bug#47174] [PATCH 1/2] guix: Alter http-fetch to return the response.

[Christopher Baines]

Rather than just the port and response-content-length.  I'm looking at using
the response headers within the substitute script to work out when to close
the connection.

* guix/http-client.scm (http-fetch): Return the response as the second value,
rather than the response-content-length.
* guix/build/download-nar.scm (download-nar): Adapt accordingly.
* guix/build/download.scm (url-fetch): Adapt accordingly.
* guix/scripts/substitute.scm (process-substitution): Adapt accordingly.
---
 guix/build/download-nar.scm |  5 +++--
 guix/build/download.scm     |  9 ++++++---
 guix/http-client.scm        | 12 ++++++------
 guix/scripts/substitute.scm | 16 +++++++++++-----
 4 files changed, 26 insertions(+), 16 deletions(-)

diff --git a/guix/build/download-nar.scm b/guix/build/download-nar.scm
index 867f3c10bb..fbb5d37c0a 100644
--- a/guix/build/download-nar.scm
+++ b/guix/build/download-nar.scm
@@ -23,6 +23,7 @@
   #:autoload   (zlib) (call-with-gzip-input-port)
   #:use-module (guix progress)
   #:use-module (web uri)
+  #:use-module (web response)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 format)
@@ -101,7 +102,7 @@ success, #f otherwise."
       ((url rest ...)
        (format #t "Trying content-addressed mirror at ~a...~%"
                (uri-host (string->uri url)))
-       (let-values (((port size)
+       (let-values (((port resp)
                      (catch #t
                        (lambda ()
                          (http-fetch (string->uri url)))
@@ -109,7 +110,7 @@ success, #f otherwise."
                          (values #f #f)))))
          (if (not port)
              (loop rest)
-             (begin
+             (let ((size (response-content-length resp)))
                (if size
                    (format #t "Downloading from ~a (~,2h MiB)...~%" url
                            (/ size (expt 2 20.)))
diff --git a/guix/build/download.scm b/guix/build/download.scm
index f24a1e20df..437184b9cb 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -21,6 +21,7 @@
 (define-module (guix build download)
   #:use-module (web uri)
   #:use-module (web http)
+  #:use-module (web response)
   #:use-module ((web client) #:hide (open-socket-for-uri))
   #:use-module (web response)
   #:use-module (guix base64)
@@ -647,7 +648,7 @@ otherwise simply ignore them."
     (case (uri-scheme uri)
       ((http https)
        (false-if-exception*
-        (let-values (((port size)
+        (let-values (((port resp)
                       (http-fetch uri
                                   #:verify-certificate? verify-certificate?
                                   #:timeout timeout)))
@@ -657,9 +658,11 @@ otherwise simply ignore them."
                           #:buffer-size %http-receive-buffer-size
                           #:reporter (if print-build-trace?
                                          (progress-reporter/trace
-                                          file (uri->string uri) size)
+                                          file (uri->string uri)
+                                          (response-content-length resp))
                                          (progress-reporter/file
-                                          (uri-abbreviation uri) size)))
+                                          (uri-abbreviation uri)
+                                          (response-content-length resp))))
               (newline)))
           file)))
       ((ftp)
diff --git a/guix/http-client.scm b/guix/http-client.scm
index 2d7458a56e..47076d41f6 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -80,11 +80,11 @@
                      (verify-certificate? #t)
                      (headers '((user-agent . "GNU Guile")))
                      timeout)
-  "Return an input port containing the data at URI, and the expected number of
-bytes available or #f.  If TEXT? is true, the data at URI is considered to be
-textual.  Follow any HTTP redirection.  When BUFFERED? is #f, return an
-unbuffered port, suitable for use in `filtered-port'.  HEADERS is an alist of
-extra HTTP headers.
+  "Return an input port containing the data at URI, and the HTTP response from
+the server.  If TEXT? is true, the data at URI is considered to be textual.
+Follow any HTTP redirection.  When BUFFERED? is #f, return an unbuffered port,
+suitable for use in `filtered-port'.  HEADERS is an alist of extra HTTP
+headers.
 
 When KEEP-ALIVE? is true, the connection is marked as 'keep-alive' and PORT is
 not closed upon completion.
@@ -120,7 +120,7 @@ Raise an '&http-get-error' condition if downloading fails."
                      (response-code resp)))
         (case code
           ((200)
-           (values data (response-content-length resp)))
+           (values data resp))
           ((301                                   ; moved permanently
             302                                   ; found (redirection)
             303                                   ; see other
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 6892aa999b..cb79ea6927 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -60,6 +60,7 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (web uri)
+  #:use-module (web response)
   #:use-module (guix http-client)
   #:export (%allow-unauthenticated-substitutes?
             %error-to-file-descriptor-4?
@@ -424,11 +425,16 @@ the current output port."
            (call-with-connection-error-handling
             uri
             (lambda ()
-              (http-fetch uri #:text? #f
-                          #:open-connection open-connection-for-uri/cached
-                          #:keep-alive? #t
-                          #:buffered? #f
-                          #:verify-certificate? #f))))))
+              (let-values (((raw response)
+                            (http-fetch
+                             uri
+                             #:text? #f
+                             #:open-connection open-connection-for-uri/cached
+                             #:keep-alive? #t
+                             #:buffered? #f
+                             #:verify-certificate? #f)))
+                (values raw
+                        (response-content-length response))))))))
       (else
        (leave (G_ "unsupported substitute URI scheme: ~a~%")
               (uri->string uri)))))
-- 
2.30.1