[bug#47174] [PATCH 0/2] substitute: Handle closing connections to substitute servers.

[bug#47174] [PATCH 0/2] substitute: Handle closing connections to substitute servers.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 388 bytes --]


Christopher Baines (2):
  guix: Alter http-fetch to return the response.
  substitute: Handle closing connections to substitute servers.

 guix/build/download-nar.scm |  5 +++--
 guix/build/download.scm     |  9 ++++++---
 guix/http-client.scm        | 12 ++++++------
 guix/scripts/substitute.scm | 31 ++++++++++++++++++++++++-------
 4 files changed, 39 insertions(+), 18 deletions(-)

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 987 bytes --]

[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

[bug#47174] [PATCH 2/2] substitute: Handle closing connections to substitute servers.

[Christopher Baines]

When reusing a HTTP connection to fetch multiple nars, and the remote server
signals that the connection should be closed.

* guix/scripts/substitute.scm (process-substitution): Close connections to
substitute servers when a Connection: close header is specified in the
response.
---
 guix/scripts/substitute.scm | 17 ++++++++++++++---
 1 file changed, 14 insertions(+), 3 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index cb79ea6927..deb6fbdaa2 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -406,7 +406,9 @@ the current output port."
     (case (uri-scheme uri)
       ((file)
        (let ((port (open-file (uri-path uri) "r0b")))
-         (values port (stat:size (stat port)))))
+         (values port
+                 (stat:size (stat port))
+                 (const #t))))          ; no cleanup to do
       ((http https)
        (guard (c ((http-get-error? c)
                   (leave (G_ "download from '~a' failed: ~a, ~s~%")
@@ -434,7 +436,12 @@ the current output port."
                              #:buffered? #f
                              #:verify-certificate? #f)))
                 (values raw
-                        (response-content-length response))))))))
+                        (response-content-length response)
+                        (match (assq 'connection (response-headers response))
+                          (('connection 'close)
+                           (lambda ()
+                             (close-port (response-port response))))
+                          (_ (const #t))))))))))
       (else
        (leave (G_ "unsupported substitute URI scheme: ~a~%")
               (uri->string uri)))))
@@ -449,7 +456,7 @@ the current output port."
       (format (current-error-port)
               (G_ "Downloading ~a...~%") (uri->string uri)))
 
-    (let*-values (((raw download-size)
+    (let*-values (((raw download-size post-fetch-cleanup)
                    ;; 'guix publish' without '--cache' doesn't specify a
                    ;; Content-Length, so DOWNLOAD-SIZE is #f in this case.
                    (fetch uri))
@@ -493,6 +500,10 @@ the current output port."
       ;; Wait for the reporter to finish.
       (every (compose zero? cdr waitpid) pids)
 
+      ;; Do post-fetch cleanup, maybe closing the HTTP connection if HTTP is
+      ;; being used, and the connection should be closed
+      (post-fetch-cleanup)
+
       ;; Skip a line after what 'progress-reporter/file' printed, and another
       ;; one to visually separate substitutions.
       (display "\n\n" (current-error-port))
-- 
2.30.1

[bug#47174] [PATCH 0/2] substitute: Handle closing connections to substitute servers.

[Ludovic Courtès]

Christopher Baines <mail@cbaines.net> skribis:

> When reusing a HTTP connection to fetch multiple nars, and the remote server
> signals that the connection should be closed.
>
> * guix/scripts/substitute.scm (process-substitution): Close connections to
> substitute servers when a Connection: close header is specified in the
> response.

In the context of <https://issues.guix.gnu.org/47157>, honoring
“Connection: close” isn’t enough.  We need to handle the case where the
server didn’t express the intent to close the connection but eventually
closed it after some time.

Does that make sense?

Ludo’.

[bug#47174] [PATCH 0/2] substitute: Handle closing connections to substitute servers.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 823 bytes --]


Ludovic Courtès <ludo@gnu.org> writes:

> Christopher Baines <mail@cbaines.net> skribis:
>
>> When reusing a HTTP connection to fetch multiple nars, and the remote server
>> signals that the connection should be closed.
>>
>> * guix/scripts/substitute.scm (process-substitution): Close connections to
>> substitute servers when a Connection: close header is specified in the
>> response.
>
> In the context of <https://issues.guix.gnu.org/47157>, honoring
> “Connection: close” isn’t enough.  We need to handle the case where the
> server didn’t express the intent to close the connection but eventually
> closed it after some time.
>
> Does that make sense?

Yeah, of course, this was something I was thinking about in addition to
the changes in [1].

1: https://issues.guix.gnu.org/47160

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 987 bytes --]

[bug#47174] [PATCH v2 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 | 12 ++++++++----
 4 files changed, 23 insertions(+), 15 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 b14db42352..d2006cc1fd 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)
@@ -706,7 +707,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)))
@@ -716,9 +717,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 10bc278023..189535079b 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -81,11 +81,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.
@@ -123,7 +123,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 8e4eae00b3..96f425eaa0 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -61,6 +61,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?
             %reply-file-descriptor
@@ -480,10 +481,13 @@ 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-values (((raw response)
+                           (http-fetch uri #:text? #f
+                                       #:port port
+                                       #:keep-alive? #t
+                                       #:buffered? #f)))
+               (values raw
+                       (response-content-length response)))))))
       (else
        (leave (G_ "unsupported substitute URI scheme: ~a~%")
               (uri->string uri)))))
-- 
2.30.1

[bug#47174] [PATCH v2 2/2] substitute: Handle closing connections to substitute servers.

[Christopher Baines]

When reusing a HTTP connection to fetch multiple nars, and the remote server
signals that the connection should be closed.

* guix/scripts/substitute.scm (process-substitution): Close connections to
substitute servers when a Connection: close header is specified in the
response.
---
 guix/scripts/substitute.scm | 17 ++++++++++++++---
 1 file changed, 14 insertions(+), 3 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 96f425eaa0..208b8f1273 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -464,7 +464,9 @@ PORT."
     (case (uri-scheme uri)
       ((file)
        (let ((port (open-file (uri-path uri) "r0b")))
-         (values port (stat:size (stat port)))))
+         (values port
+                 (stat:size (stat port))
+                 (const #t))))          ; no cleanup to do
       ((http https)
        (guard (c ((http-get-error? c)
                   (leave (G_ "download from '~a' failed: ~a, ~s~%")
@@ -487,7 +489,12 @@ PORT."
                                        #:keep-alive? #t
                                        #:buffered? #f)))
                (values raw
-                       (response-content-length response)))))))
+                       (response-content-length response)
+                       (match (assq 'connection (response-headers response))
+                         (('connection 'close)
+                          (lambda ()
+                            (close-port port)))
+                         (_ (const #t)))))))))
       (else
        (leave (G_ "unsupported substitute URI scheme: ~a~%")
               (uri->string uri)))))
@@ -504,7 +511,7 @@ PORT."
       (format (current-error-port)
               (G_ "Downloading ~a...~%") (uri->string uri)))
 
-    (let*-values (((raw download-size)
+    (let*-values (((raw download-size post-fetch-cleanup)
                    ;; 'guix publish' without '--cache' doesn't specify a
                    ;; Content-Length, so DOWNLOAD-SIZE is #f in this case.
                    (fetch uri))
@@ -565,6 +572,10 @@ PORT."
       ;; Wait for the reporter to finish.
       (every (compose zero? cdr waitpid) pids)
 
+      ;; Do post-fetch cleanup, maybe closing the HTTP connection if HTTP is
+      ;; being used, and the connection should be closed
+      (post-fetch-cleanup)
+
       ;; Skip a line after what 'progress-reporter/file' printed, and another
       ;; one to visually separate substitutions.  When PRINT-BUILD-TRACE? is
       ;; true, leave it up to (guix status) to prettify things.
-- 
2.30.1

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

[Mathieu Othacehe]

Hello Chis,

> * guix/http-client.scm (http-fetch): Return the response as the second value,
> rather than the response-content-length.

I think there is a missing adaptation in the call-with-nar procedure of
the (guix scripts challenge) module.

Otherwise, looks fine!

Thanks,

Mathieu

[bug#47174] [PATCH v2 2/2] substitute: Handle closing connections to substitute servers.

[Mathieu Othacehe]

> +                       (match (assq 'connection (response-headers response))
> +                         (('connection 'close)
> +                          (lambda ()
> +                            (close-port port)))

You could maybe factorize it in a close-connection? procedure. Out of
curiosity, when does the remote server asks for connection closing?

Thanks,

Mathieu

[bug#47174] [PATCH v2 2/2] substitute: Handle closing connections to substitute servers.

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 641 bytes --]


Mathieu Othacehe <othacehe@gnu.org> writes:

>> +                       (match (assq 'connection (response-headers response))
>> +                         (('connection 'close)
>> +                          (lambda ()
>> +                            (close-port port)))
>
> You could maybe factorize it in a close-connection? procedure. Out of
> curiosity, when does the remote server asks for connection closing?

A server can at any time ask for the connection to be closed. With NGinx
for example, by default, it'll close connections after 1000 requests:

  http://nginx.org/en/docs/http/ngx_http_upstream_module.html#keepalive_requests

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 987 bytes --]

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

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 475 bytes --]


Mathieu Othacehe <othacehe@gnu.org> writes:

> Hello Chis,
>
>> * guix/http-client.scm (http-fetch): Return the response as the second value,
>> rather than the response-content-length.
>
> I think there is a missing adaptation in the call-with-nar procedure of
> the (guix scripts challenge) module.

Indeed, I've fixed that and I'll send a v3 series.

> Otherwise, looks fine!

Great, I'll try and do some testing of this at some point, as I haven't
done any testing yet.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 987 bytes --]

[bug#47174] [PATCH v3 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/challenge.scm  |  6 ++++--
 guix/scripts/substitute.scm | 12 ++++++++----
 5 files changed, 27 insertions(+), 17 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 b14db42352..d2006cc1fd 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)
@@ -706,7 +707,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)))
@@ -716,9 +717,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 10bc278023..189535079b 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -81,11 +81,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.
@@ -123,7 +123,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 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."
 NARINFO."
   (let*-values (((uri compression size)
                  (narinfo-best-uri narinfo))
-                ((port actual-size)
+                ((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 8e4eae00b3..96f425eaa0 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -61,6 +61,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?
             %reply-file-descriptor
@@ -480,10 +481,13 @@ 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-values (((raw response)
+                           (http-fetch uri #:text? #f
+                                       #:port port
+                                       #:keep-alive? #t
+                                       #:buffered? #f)))
+               (values raw
+                       (response-content-length response)))))))
       (else
        (leave (G_ "unsupported substitute URI scheme: ~a~%")
               (uri->string uri)))))
-- 
2.31.1

[bug#47174] [PATCH v3 2/2] substitute: Handle closing connections to substitute servers.

[Christopher Baines]

When reusing a HTTP connection to fetch multiple nars, and the remote server
signals that the connection should be closed.

* guix/scripts/substitute.scm (process-substitution): Close connections to
substitute servers when a Connection: close header is specified in the
response.
---
 guix/scripts/substitute.scm | 17 ++++++++++++++---
 1 file changed, 14 insertions(+), 3 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 96f425eaa0..208b8f1273 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -464,7 +464,9 @@ PORT."
     (case (uri-scheme uri)
       ((file)
        (let ((port (open-file (uri-path uri) "r0b")))
-         (values port (stat:size (stat port)))))
+         (values port
+                 (stat:size (stat port))
+                 (const #t))))          ; no cleanup to do
       ((http https)
        (guard (c ((http-get-error? c)
                   (leave (G_ "download from '~a' failed: ~a, ~s~%")
@@ -487,7 +489,12 @@ PORT."
                                        #:keep-alive? #t
                                        #:buffered? #f)))
                (values raw
-                       (response-content-length response)))))))
+                       (response-content-length response)
+                       (match (assq 'connection (response-headers response))
+                         (('connection 'close)
+                          (lambda ()
+                            (close-port port)))
+                         (_ (const #t)))))))))
       (else
        (leave (G_ "unsupported substitute URI scheme: ~a~%")
               (uri->string uri)))))
@@ -504,7 +511,7 @@ PORT."
       (format (current-error-port)
               (G_ "Downloading ~a...~%") (uri->string uri)))
 
-    (let*-values (((raw download-size)
+    (let*-values (((raw download-size post-fetch-cleanup)
                    ;; 'guix publish' without '--cache' doesn't specify a
                    ;; Content-Length, so DOWNLOAD-SIZE is #f in this case.
                    (fetch uri))
@@ -565,6 +572,10 @@ PORT."
       ;; Wait for the reporter to finish.
       (every (compose zero? cdr waitpid) pids)
 
+      ;; Do post-fetch cleanup, maybe closing the HTTP connection if HTTP is
+      ;; being used, and the connection should be closed
+      (post-fetch-cleanup)
+
       ;; Skip a line after what 'progress-reporter/file' printed, and another
       ;; one to visually separate substitutions.  When PRINT-BUILD-TRACE? is
       ;; true, leave it up to (guix status) to prettify things.
-- 
2.31.1

[bug#47174] [PATCH 0/2] substitute: Handle closing connections to substitute servers.

[Ludovic Courtès]

Hi Chris,

Christopher Baines <mail@cbaines.net> skribis:

> 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.

Nitpick: use “http-client:” rather than “guix:” as the subject line.

> +       (let-values (((port resp)

Conventionally we’d spell it out: ‘response’.

Otherwise LGTM.

Thanks,
Ludo’.

[bug#47174] [PATCH 0/2] substitute: Handle closing connections to substitute servers.

[Ludovic Courtès]

Christopher Baines <mail@cbaines.net> skribis:

> When reusing a HTTP connection to fetch multiple nars, and the remote server
> signals that the connection should be closed.

Incomplete sentence?

> * guix/scripts/substitute.scm (process-substitution): Close connections to
> substitute servers when a Connection: close header is specified in the
> response.
> ---
>  guix/scripts/substitute.scm | 17 ++++++++++++++---
>  1 file changed, 14 insertions(+), 3 deletions(-)
>
> diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
> index 96f425eaa0..208b8f1273 100755
> --- a/guix/scripts/substitute.scm
> +++ b/guix/scripts/substitute.scm
> @@ -464,7 +464,9 @@ PORT."
>      (case (uri-scheme uri)
>        ((file)
>         (let ((port (open-file (uri-path uri) "r0b")))
> -         (values port (stat:size (stat port)))))
> +         (values port
> +                 (stat:size (stat port))
> +                 (const #t))))          ; no cleanup to do
>        ((http https)
>         (guard (c ((http-get-error? c)
>                    (leave (G_ "download from '~a' failed: ~a, ~s~%")
> @@ -487,7 +489,12 @@ PORT."
>                                         #:keep-alive? #t
>                                         #:buffered? #f)))
>                 (values raw
> -                       (response-content-length response)))))))
> +                       (response-content-length response)
> +                       (match (assq 'connection (response-headers response))
> +                         (('connection 'close)
> +                          (lambda ()
> +                            (close-port port)))
> +                         (_ (const #t)))))))))
>        (else
>         (leave (G_ "unsupported substitute URI scheme: ~a~%")
>                (uri->string uri)))))
> @@ -504,7 +511,7 @@ PORT."
>        (format (current-error-port)
>                (G_ "Downloading ~a...~%") (uri->string uri)))
>  
> -    (let*-values (((raw download-size)
> +    (let*-values (((raw download-size post-fetch-cleanup)
>                     ;; 'guix publish' without '--cache' doesn't specify a
>                     ;; Content-Length, so DOWNLOAD-SIZE is #f in this case.
>                     (fetch uri))
> @@ -565,6 +572,10 @@ PORT."
>        ;; Wait for the reporter to finish.
>        (every (compose zero? cdr waitpid) pids)
>  
> +      ;; Do post-fetch cleanup, maybe closing the HTTP connection if HTTP is
> +      ;; being used, and the connection should be closed
> +      (post-fetch-cleanup)

How about returning a Boolean as the third value, ‘close?’, indicating
whether the port should be closed upon completion?  That seems
marginally clearer to me that the post-cleanup thunk.

Otherwise LGTM, thanks!

Ludo’.