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
* 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/challenge.scm | 6 ++++--
guix/scripts/substitute.scm | 12 ++++++++----
5 files changed, 27 insertions(+), 17 deletions(-)
Toggle diff (148 lines)
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
#:autoload (zlib) (call-with-gzip-input-port)
#:use-module (guix progress)
+ #: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."
(format #t "Trying content-addressed mirror at ~a...~%"
(uri-host (string->uri url)))
- (let-values (((port size)
+ (let-values (((port resp)
(http-fetch (string->uri url)))
@@ -109,7 +110,7 @@ success, #f otherwise."
+ (let ((size (response-content-length resp)))
(format #t "Downloading from ~a (~,2h MiB)...~%" url
diff --git a/guix/build/download.scm b/guix/build/download.scm
index b14db42352..d2006cc1fd 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
(define-module (guix build download)
+ #:use-module (web response)
#:use-module ((web client) #:hide (open-socket-for-uri))
#:use-module (web response)
#:use-module (guix base64)
@@ -706,7 +707,7 @@ otherwise simply ignore them."
- (let-values (((port size)
+ (let-values (((port resp)
#:verify-certificate? verify-certificate?
@@ -716,9 +717,11 @@ otherwise simply ignore them."
#:buffer-size %http-receive-buffer-size
#:reporter (if print-build-trace?
- file (uri->string uri) size)
+ (response-content-length resp))
- (uri-abbreviation uri) size)))
+ (response-content-length resp))))
diff --git a/guix/http-client.scm b/guix/http-client.scm
index 10bc278023..189535079b 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
(headers '((user-agent . "GNU Guile")))
(log-port (current-error-port))
- "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
+ "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
When KEEP-ALIVE? is true, the connection is marked as 'keep-alive' and PORT is
not closed upon completion.
@@ -123,7 +123,7 @@ Raise an '&http-get-error' condition if downloading fails."
- (values data (response-content-length resp)))
((301 ; moved permanently
302 ; found (redirection)
diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm
index 69c2781abb..73103a061b 100644
--- a/guix/scripts/challenge.scm
+++ b/guix/scripts/challenge.scm
@@ -253,12 +253,14 @@ taken since we do not import the archives."
(let*-values (((uri compression size)
(narinfo-best-uri narinfo))
(progress-reporter/file (narinfo-path narinfo)
- (max size (or actual-size 0))) ;defensive
+ (response-content-length response)
#:abbreviation (const (uri-host uri))))
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 8e4eae00b3..96f425eaa0 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
+ #:use-module (web response)
#:use-module (guix http-client)
#:export (%allow-unauthenticated-substitutes?
@@ -480,10 +481,13 @@ PORT."
(warning (G_ "try `--no-substitutes' if the problem persists~%")))
(with-cached-connection uri port
- (http-fetch uri #:text? #f
+ (let-values (((raw response)
+ (http-fetch uri #:text? #f
+ (response-content-length response)))))))
(leave (G_ "unsupported substitute URI scheme: ~a~%")