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

Christopher Baines wrote on 15 Mar 2021 20:21

Recipients:(address . guix-patches@gnu.org)

Message-ID:87y2eodxyy.fsf@cbaines.net

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(-)

Christopher Baines wrote on 15 Mar 2021 20:24

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

Recipients:(address . 47174@debbugs.gnu.org)

Message-ID:20210315192449.16248-2-mail@cbaines.net

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(-)

Toggle diff (51 lines)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

Christopher Baines wrote on 15 Mar 2021 20:24

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

Recipients:(address . 47174@debbugs.gnu.org)

Message-ID:20210315192449.16248-1-mail@cbaines.net

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(-)

Toggle diff (131 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
@@ -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

Ludovic Courtès wrote on 15 Mar 2021 21:36

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

Recipients:(name . Christopher Baines)(address . mail@cbaines.net)(address . 47174@debbugs.gnu.org)

Message-ID:874khccfym.fsf_-_@gnu.org

Christopher Baines <mail@cbaines.net> skribis:

Toggle quote (7 lines)

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

Christopher Baines wrote on 15 Mar 2021 21:42

Recipients:(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 47174@debbugs.gnu.org)

Message-ID:87pn00du85.fsf@cbaines.net

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

Toggle quote (16 lines)> 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

Christopher Baines wrote on 17 May 2021 00:11

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

Recipients:(address . 47174@debbugs.gnu.org)

Message-ID:20210516221121.16705-2-mail@cbaines.net

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(-)

Toggle diff (51 lines)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

Christopher Baines wrote on 17 May 2021 00:11

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

Recipients:(address . 47174@debbugs.gnu.org)

Message-ID:20210516221121.16705-1-mail@cbaines.net

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(-)

Toggle diff (127 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
@@ -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

Mathieu Othacehe wrote on 17 May 2021 16:44

Recipients:(name . Christopher Baines)(address . mail@cbaines.net)(address . 47174@debbugs.gnu.org)

Message-ID:87o8d9a08w.fsf@gnu.org

Hello Chis,

Toggle quote (3 lines)

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

Mathieu Othacehe wrote on 17 May 2021 16:46

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

Recipients:(name . Christopher Baines)(address . mail@cbaines.net)(address . 47174@debbugs.gnu.org)

Message-ID:87k0nxa058.fsf@gnu.org

Toggle quote (5 lines)

> + (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

Christopher Baines wrote on 20 May 2021 12:59

Recipients:(name . Mathieu Othacehe)(address . othacehe@gnu.org)(address . 47174@debbugs.gnu.org)

Message-ID:87r1i1hds5.fsf@cbaines.net

Mathieu Othacehe <othacehe@gnu.org> writes:

Toggle quote (8 lines)

>> + (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

Christopher Baines wrote on 20 May 2021 13:12

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

Recipients:(name . Mathieu Othacehe)(address . othacehe@gnu.org)(address . 47174@debbugs.gnu.org)

Message-ID:87o8d5hd65.fsf@cbaines.net

Mathieu Othacehe <othacehe@gnu.org> writes:

Toggle quote (8 lines)

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

Toggle quote (2 lines)

> Otherwise, looks fine!

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

done any testing yet.

Christopher Baines wrote on 20 May 2021 14:04

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

Recipients:(address . 47174@debbugs.gnu.org)

Message-ID:20210520120413.21644-1-mail@cbaines.net

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(-)

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

Christopher Baines wrote on 20 May 2021 14:04

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

Recipients:(address . 47174@debbugs.gnu.org)

Message-ID:20210520120413.21644-2-mail@cbaines.net

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(-)

Toggle diff (51 lines)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

Ludovic Courtès wrote on 29 May 2021 23:41

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

Recipients:(name . Christopher Baines)(address . mail@cbaines.net)(address . 47174@debbugs.gnu.org)

Message-ID:87zgwd43qa.fsf_-_@gnu.org

Hi Chris,

Christopher Baines <mail@cbaines.net> skribis:

Toggle quote (10 lines)> 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.

Toggle quote (2 lines)

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

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

Otherwise LGTM.

Thanks,

Ludo’.

Ludovic Courtès wrote on 29 May 2021 23:46

Recipients:(name . Christopher Baines)(address . mail@cbaines.net)(address . 47174@debbugs.gnu.org)

Message-ID:87tuml43il.fsf_-_@gnu.org

Christopher Baines <mail@cbaines.net> skribis:

Toggle quote (3 lines)

> When reusing a HTTP connection to fetch multiple nars, and the remote server

> signals that the connection should be closed.

Incomplete sentence?

Toggle quote (53 lines)> * 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’.

is:open	open issues
is:done	closed issues
submitter:<who>	search issue submitter
author:<who>	search by message author
date:yesterday..now	search by issue date
mdate:3m..2d	search by message date