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

OpenSubmitted by Christopher Baines.
Details
3 participants
  • Ludovic Courtès
  • Christopher Baines
  • Mathieu Othacehe
Owner
unassigned
Severity
normal
C
C
Christopher Baines wrote on 15 Mar 2021 20:21
(address . guix-patches@gnu.org)
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(-)
-----BEGIN PGP SIGNATURE-----

iQKlBAEBCgCPFiEEPonu50WOcg2XVOCyXiijOwuE9XcFAmBPs8VfFIAAAAAALgAo
aXNzdWVyLWZwckBub3RhdGlvbnMub3BlbnBncC5maWZ0aGhvcnNlbWFuLm5ldDNF
ODlFRUU3NDU4RTcyMEQ5NzU0RTBCMjVFMjhBMzNCMEI4NEY1NzcRHG1haWxAY2Jh
aW5lcy5uZXQACgkQXiijOwuE9Xef2A/+Lm+zmZgKgVlBPQz+dN6k5H9MnTXQNU3m
iPPZ0BeaY9d8ZTg1zSnwLeF9kRQsm3Z/VlU0wmwv56AO3RS2U6q8iXzk+V6kmui/
0a+c84k+TsIkFcyEJmQlGXXvcoGZpGi2BHMo4fdAsKdKkTW3nIk+fHfc0fJ31wuO
skHZF5Q6KRIGyURtym9w2NB4fBjoesjJqsZ7Q55OXgViGITfDqCGprdlF1cxdGvt
bNNCoNj26bOzlT7D10rW9IFZWJrG+6CGxfM0+d2LaW30viO+P8RPxLs5UfkcGsTE
41/1VCXUoCBAR2/GRoPGiZsYNIznLuV+/hqD+vNLh1nIctybX0cld74uttSROImp
4RiJy4YBdjnYu4e//rzui0jIU7QfX/iVSCYtgt6ymmsNVNfklzU0CEgrBHln8Dha
RRWVGY2R4SWN57K2p5CSjDQiQzH37IP+N1WRKeebCR8Brub7mcA3d5kFprvz/BS3
2AvrNUkVnxBw2D4Vk30QB2OMDofIfxLBJmNsZbPsG87BUjaspOB8kPvzSl00RnBr
WFICIPwEa5vAFv/N6fOQrkNCH2eNbK3R/2LEcLeNWTRq7UiXu1zL7kNtfjyZ4sXZ
C/zE+xMXGkCcLD9QeubMCuW3usRJAQgdNra6pl71FCE1VxyjC30/JBOTjBlXmHPG
ICJyXcsD3QQ=
=SskM
-----END PGP SIGNATURE-----

C
C
Christopher Baines wrote on 15 Mar 2021 20:24
[PATCH 2/2] substitute: Handle closing connections to substitute servers.
(address . 47174@debbugs.gnu.org)
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
C
C
Christopher Baines wrote on 15 Mar 2021 20:24
[PATCH 1/2] guix: Alter http-fetch to return the response.
(address . 47174@debbugs.gnu.org)
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
L
L
Ludovic Courtès wrote on 15 Mar 2021 21:36
Re: bug#47174: [PATCH 0/2] substitute: Handle closing connections to substitute servers.
(name . Christopher Baines)(address . mail@cbaines.net)(address . 47174@debbugs.gnu.org)
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’.
C
C
Christopher Baines wrote on 15 Mar 2021 21:42
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 47174@debbugs.gnu.org)
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].

-----BEGIN PGP SIGNATURE-----

iQKlBAEBCgCPFiEEPonu50WOcg2XVOCyXiijOwuE9XcFAmBPxrpfFIAAAAAALgAo
aXNzdWVyLWZwckBub3RhdGlvbnMub3BlbnBncC5maWZ0aGhvcnNlbWFuLm5ldDNF
ODlFRUU3NDU4RTcyMEQ5NzU0RTBCMjVFMjhBMzNCMEI4NEY1NzcRHG1haWxAY2Jh
aW5lcy5uZXQACgkQXiijOwuE9Xd0Jg//cyAQJF65Ezu0jNXzIoiUOwNZ5xc2mfsO
Rnbn/G3E+LiZnjzEBXRLLXobWuVON8jIwKcrmroVB+BIJbbEzTLCSu4hahmT/0SE
osbOr0hC9e0a9XcVTRxj0w9raRfyAhtvOl7IANH/Nl+SfM9ZXU1BOve5VRGPnBwZ
5QCLfh/m0naWoSErs8KTtz4zfFPJPS8K/3F7euiH6wzbgv27LK7e9z1Le4MnmbAJ
p47/Qt9i/mBPMYXkCs1uN0ciylC59u12lUPPLAyUk/5J+VBRyGCdy1rxRTVfogRv
k7PtVOPvkjSwwYWIRF1YAU/EGlM3IurHj/EnbBLAKM8Nuaa9V27puwzs44TCWCz5
weArBWRuusiYQuCXHoJSb2x14MXWADZacTslEnbVqCqmnsq8osqq8COvySJHg+HU
RSKWCXU+7g/ePqEjIfr4Wt/slBrawvl4eP6IYf4Gv8xAV5XeIQNdGBe8ZeqcBK6O
yB/R4rd9bnikZwHWTWiximsNdXoSoHCGthi5D+1jFrHOjM/u3FAD/7KOLUjaRcL8
12PVpMFfz2XY0T2obZa/DtZxLKadjAxJZ03L6uyLbC+diNMlyj/hiy3iJ4SRonRp
8A0siXnnPWcHb4yYbufKFs8Fhj9kA3oQsAPnwvkdZGq6bQkD1gZ80msDS7r7jRBn
EOtl2pIqcQY=
=PQKS
-----END PGP SIGNATURE-----

C
C
Christopher Baines wrote on 17 May 2021 00:11
[PATCH v2 2/2] substitute: Handle closing connections to substitute servers.
(address . 47174@debbugs.gnu.org)
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
C
C
Christopher Baines wrote on 17 May 2021 00:11
[PATCH v2 1/2] guix: Alter http-fetch to return the response.
(address . 47174@debbugs.gnu.org)
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
M
M
Mathieu Othacehe wrote on 17 May 2021 16:44
(name . Christopher Baines)(address . mail@cbaines.net)(address . 47174@debbugs.gnu.org)
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
M
M
Mathieu Othacehe wrote on 17 May 2021 16:46
Re: [bug#47174] [PATCH v2 2/2] substitute: Handle closing connections to substitute servers.
(name . Christopher Baines)(address . mail@cbaines.net)(address . 47174@debbugs.gnu.org)
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
C
C
Christopher Baines wrote on 20 May 2021 12:59
(name . Mathieu Othacehe)(address . othacehe@gnu.org)(address . 47174@debbugs.gnu.org)
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:

-----BEGIN PGP SIGNATURE-----

iQKlBAEBCgCPFiEEPonu50WOcg2XVOCyXiijOwuE9XcFAmCmQPpfFIAAAAAALgAo
aXNzdWVyLWZwckBub3RhdGlvbnMub3BlbnBncC5maWZ0aGhvcnNlbWFuLm5ldDNF
ODlFRUU3NDU4RTcyMEQ5NzU0RTBCMjVFMjhBMzNCMEI4NEY1NzcRHG1haWxAY2Jh
aW5lcy5uZXQACgkQXiijOwuE9XfDnhAAtkDEx29yB3n4MYI0C9kqZ117qAKVpILo
ySQS0RrnKKpIJ2wcVgwFIfTesJPYkXvOmBxX08ZvDdlz9Ts0GAlJMkab2NuLT84U
STmzxvN/nGaIvnZx6ToZNcQQFFsSTliUdt/fH48UrPnDmi4wQCQfSfo+oW8yl/e2
d81YtWTulnsVu/suJ6yz3s9kU7y/usEJ1DPS1iEA/Eu1Vs+rBN/4yHDsJ9aDsXiC
MC+si2YdLrTZ7/hmevLYzdTePyJV6b+z+nJ8LPWH3Huca0yEXI9eTqeVFy7fTbPs
dxFkw15RUbb7IEK7k25rJNB8n4tg16+z8eMeCgK+oFt9bXjNgWKCSedO8Fv6t0Kl
nT2bTBXzRnb8Rul7Yy5UglEaOq6MjQSQkljX7ze1WxFs+cPEXhjhqnjFbKphqiAD
TTpIloTAvKUM3d36K9+/JTs0hDnmpluw3zNRGMpC2agaKZVcv8VtKsOncFXb+/rG
6seAWiLLYmCAu6DVmeKgSEiSlRP0xsnMfvxS0YjNghrX22rHunpdQXfov1MZK5Q8
qkSvjUvyQqA8jlXtrq8wuPJov7IMI2mvPW0O1pOjwf7Hxvmju1g062+moXPVVj9S
Oiq+9KXDJbW+2AK7M1MEeMo7/N8CDptEjKpe9QaIy6j+0ywh4pHGQvEPAcxrRoDf
bvQAobACPQs=
=9qvw
-----END PGP SIGNATURE-----

C
C
Christopher Baines wrote on 20 May 2021 13:12
Re: [bug#47174] [PATCH v2 1/2] guix: Alter http-fetch to return the response.
(name . Mathieu Othacehe)(address . othacehe@gnu.org)(address . 47174@debbugs.gnu.org)
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.
-----BEGIN PGP SIGNATURE-----

iQKlBAEBCgCPFiEEPonu50WOcg2XVOCyXiijOwuE9XcFAmCmRBJfFIAAAAAALgAo
aXNzdWVyLWZwckBub3RhdGlvbnMub3BlbnBncC5maWZ0aGhvcnNlbWFuLm5ldDNF
ODlFRUU3NDU4RTcyMEQ5NzU0RTBCMjVFMjhBMzNCMEI4NEY1NzcRHG1haWxAY2Jh
aW5lcy5uZXQACgkQXiijOwuE9Xcg1w//UD6w0Y1z/KBTDVyFbEqhK7cmeVy204ij
LMlY11N8vCrFJ94gQAt9n7xT58vt0o/03WOYrgNk8sMGjE+PFdMx0P43+z93lpxA
XoSP5893Nunx4bLhYGKynWOUY/jSZlPIfQxU2lyWhrGOAHbBksagLtRYDfMq++3+
idqABYhM/rdZFA4ZzcH8COWmsLmQfXG76mMYE77x6IXvk5eC1OrxpXBoDJ+E1vya
eUQQPOCc01aTUdiW+uq6QCiOjDN5DY1Owrs8C0jH1K033viff2/YcGdoJ3uLSjQQ
NQdxXtS4QHW2Sll85MT9dRiiZv+7rRtJWuTdimE6EeWfxREYms4U10lz0CPhYBAw
8X/NJ+5zbBhPQsaOLUO7NXxVOo/iCuunWUIMPYrgUhS1caKFwWvzXc1zuK5Dhgr/
qLXX1q7lVfEqOpstndFw2/Z/V+z+3WLoJ0DMa39F+ozW+IeKDgr8Z0RJ68WW4uDe
1elLoFIn604lduUGhhMqi/ktMeDoEv/T3UaNKU364uj6t+CQvkPlbFQNz4l7dqpT
/4I1fkFRmy48fE34EZsyCVj+NclptdsV1C+2dOLdcO18hkCSViNpDW5hEFwAjHzz
vmsnorm19JQHU91k8hqEHyqCO9XHrCLsuqyea5niDhfuM5LADtJW/JRHC59MdLuX
oN+GIb/Of40=
=/BdU
-----END PGP SIGNATURE-----

C
C
Christopher Baines wrote on 20 May 2021 14:04
[PATCH v3 1/2] guix: Alter http-fetch to return the response.
(address . 47174@debbugs.gnu.org)
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
C
C
Christopher Baines wrote on 20 May 2021 14:04
[PATCH v3 2/2] substitute: Handle closing connections to substitute servers.
(address . 47174@debbugs.gnu.org)
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
L
L
Ludovic Courtès wrote on 29 May 2021 23:41
Re: bug#47174: [PATCH 0/2] substitute: Handle closing connections to substitute servers.
(name . Christopher Baines)(address . mail@cbaines.net)(address . 47174@debbugs.gnu.org)
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’.
L
L
Ludovic Courtès wrote on 29 May 2021 23:46
(name . Christopher Baines)(address . mail@cbaines.net)(address . 47174@debbugs.gnu.org)
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’.
?