guix_mirror_bot pushed a commit to branch master
in repository guix.
commit 392cf48739f08a55f06d97cb053160b13d55e1a4
Author: Christopher Baines <[email protected]>
AuthorDate: Mon Mar 15 18:29:33 2021 +0000
http-client: Alter http-fetch to return the response.
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/scripts/challenge.scm (call-with-nar): Adapt accordingly.
Change-Id: I490ecf7cef1f5ebbf1e6ed026f6a8fc9dacc56be
---
guix/build/download-nar.scm | 5 +++--
guix/build/download.scm | 11 ++++++++---
guix/http-client.scm | 12 ++++++------
guix/scripts/challenge.scm | 8 ++++++--
guix/scripts/substitute.scm | 13 +++++++++----
5 files changed, 32 insertions(+), 17 deletions(-)
diff --git a/guix/build/download-nar.scm b/guix/build/download-nar.scm
index f26ad28cd0..eb358d69d9 100644
--- a/guix/build/download-nar.scm
+++ b/guix/build/download-nar.scm
@@ -22,6 +22,7 @@
#:autoload (lzlib) (call-with-lzip-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)
@@ -69,7 +70,7 @@ item. Return #t on 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 response)
(catch #t
(lambda ()
(http-fetch (string->uri url)))
@@ -81,7 +82,7 @@ item. Return #t on success, #f otherwise."
(values #f #f)))))
(if (not port)
(loop rest)
- (begin
+ (let ((size (response-content-length response)))
(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 509dcc08c7..53a0997164 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -22,6 +22,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)
@@ -752,7 +753,7 @@ otherwise simply ignore them."
(case (uri-scheme uri)
((http https)
(false-if-exception*
- (let-values (((port size)
+ (let-values (((port response)
(http-fetch uri
#:verify-certificate? verify-certificate?
#:timeout timeout)))
@@ -762,9 +763,13 @@ 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
+ response))
(progress-reporter/file
- (uri-abbreviation uri) size)))
+ (uri-abbreviation uri)
+ (response-content-length
+ response))))
(newline)))
(close-port port)
file)))
diff --git a/guix/http-client.scm b/guix/http-client.scm
index 4e0cc59e91..4622dbdcb6 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -83,11 +83,11 @@
(headers '((user-agent . "GNU Guile")))
(log-port (current-error-port))
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.
@@ -126,7 +126,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/challenge.scm b/guix/scripts/challenge.scm
index d38171b868..a1f90b7844 100644
--- a/guix/scripts/challenge.scm
+++ b/guix/scripts/challenge.scm
@@ -44,6 +44,7 @@
#:use-module (ice-9 format)
#:use-module (ice-9 ftw)
#:use-module (web uri)
+ #:use-module (web response)
#:export (compare-contents
comparison-report?
@@ -257,11 +258,14 @@ in the nar."
"Call PROC with an input port from which it can read the nar pointed to by
NARINFO."
(let* ((uri compression size (narinfo-best-uri narinfo))
- (port actual-size (http-fetch uri)))
+ (port response (http-fetch uri)))
(define reporter
(progress-reporter/file (narinfo-path narinfo)
(and size
- (max size (or actual-size 0))) ;defensive
+ (max size (or
+ (response-content-length
+ response)
+ 0))) ;defensive
#:abbreviation (const (uri-host uri))))
(define result
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index aa702abc60..2f86e3c55e 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -61,6 +61,7 @@
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-71)
#:use-module (web uri)
+ #:use-module (web response)
#:use-module (guix http-client)
#:export (%allow-unauthenticated-substitutes?
%reply-file-descriptor
@@ -496,10 +497,14 @@ STATUS-PORT."
(uri->string uri))
(warning (G_ "try `--no-substitutes' if the problem persists~%")))
(with-cached-connection uri port
- (http-fetch uri #:text? #f
- #:port port
- #:keep-alive? #t
- #:buffered? #f))))
+ (let ((raw
+ response
+ (http-fetch uri #:text? #f
+ #:port port
+ #:keep-alive? #t
+ #:buffered? #f)))
+ (values raw
+ (response-content-length response))))))
(else
(raise
(formatted-message
