GNU bug report logs - #54241
[PATCH 0/4] 'github' importer gracefully handles rate limiting

Previous Next

Full log

Message #14 received at 54241 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 54241 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 3/4] http-client: Correctly handle redirects when
 #:keep-alive? #t.
Date: Thu,  3 Mar 2022 22:14:43 +0100

Previously PORT would be closed unconditionally, which broke redirects
when #:keep-alive? #t is given.

* guix/http-client.scm (http-fetch): Make 'port' a parameter of 'loop'.
Upon 3xx responses, do not close PORT is KEEP-ALIVE? is true, but consume
RESP's body.  Add second argument to 'loop'.
---
 guix/http-client.scm | 26 +++++++++++++++++---------
 1 file changed, 17 insertions(+), 9 deletions(-)

diff --git a/guix/http-client.scm b/guix/http-client.scm
index 4b01e31165..4784497e5f 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -102,12 +102,12 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
 Raise an '&http-get-error' condition if downloading fails."
   (let loop ((uri (if (string? uri)
                       (string->uri uri)
-                      uri)))
-    (let ((port (or port (open-connection uri
-                                          #:verify-certificate?
-                                          verify-certificate?
-                                          #:timeout timeout)))
-          (headers (match (uri-userinfo uri)
+                      uri))
+             (port (or port (open-connection uri
+                                             #:verify-certificate?
+                                             verify-certificate?
+                                             #:timeout timeout))))
+    (let ((headers (match (uri-userinfo uri)
                      ((? string? str)
                       (cons (cons 'Authorization
                                   (string-append "Basic "
@@ -131,11 +131,19 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
             303                                   ; see other
             307                                   ; temporary redirection
             308)                                  ; permanent redirection
-           (let ((uri (resolve-uri-reference (response-location resp) uri)))
-             (close-port port)
+           (let ((host (uri-host uri))
+                 (uri  (resolve-uri-reference (response-location resp) uri)))
+             (if keep-alive?
+                 (dump-port data (%make-void-port "w0")
+                            (response-content-length resp))
+                 (close-port port))
              (format log-port (G_ "following redirection to `~a'...~%")
                      (uri->string uri))
-             (loop uri)))
+             (loop uri
+                   (and keep-alive?
+                        (or (not (uri-host uri))
+                            (string=? host (uri-host uri)))
+                        port))))
           (else
            (raise (condition (&http-get-error
                               (uri uri)
-- 
2.34.0

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.