unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: Christopher Baines <mail@cbaines.net>
To: 47174@debbugs.gnu.org
Subject: [bug#47174] [PATCH v3 1/2] guix: Alter http-fetch to return the response.
Date: Thu, 20 May 2021 13:04:12 +0100	[thread overview]
Message-ID: <20210520120413.21644-1-mail@cbaines.net> (raw)
In-Reply-To: <87y2eodxyy.fsf@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(-)

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





  parent reply	other threads:[~2021-05-20 12:05 UTC|newest]

Thread overview: 15+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-03-15 19:21 [bug#47174] [PATCH 0/2] substitute: Handle closing connections to substitute servers Christopher Baines
2021-03-15 19:24 ` [bug#47174] [PATCH 1/2] guix: Alter http-fetch to return the response Christopher Baines
2021-03-15 19:24   ` [bug#47174] [PATCH 2/2] substitute: Handle closing connections to substitute servers Christopher Baines
2021-03-15 20:36     ` [bug#47174] [PATCH 0/2] " Ludovic Courtès
2021-03-15 20:42       ` Christopher Baines
2021-05-16 22:11 ` [bug#47174] [PATCH v2 1/2] guix: Alter http-fetch to return the response Christopher Baines
2021-05-16 22:11   ` [bug#47174] [PATCH v2 2/2] substitute: Handle closing connections to substitute servers Christopher Baines
2021-05-17 14:46     ` Mathieu Othacehe
2021-05-20 10:59       ` Christopher Baines
2021-05-17 14:44   ` [bug#47174] [PATCH v2 1/2] guix: Alter http-fetch to return the response Mathieu Othacehe
2021-05-20 11:12     ` Christopher Baines
2021-05-20 12:04 ` Christopher Baines [this message]
2021-05-20 12:04   ` [bug#47174] [PATCH v3 2/2] substitute: Handle closing connections to substitute servers Christopher Baines
2021-05-29 21:46     ` [bug#47174] [PATCH 0/2] " Ludovic Courtès
2021-05-29 21:41   ` Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20210520120413.21644-1-mail@cbaines.net \
    --to=mail@cbaines.net \
    --cc=47174@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).