[bug#54836] [PATCH 1/2] http-client: Fix redirection.

[bug#54836] [PATCH 1/2] http-client: Fix redirection.

[Attila Lendvai]

* guix/http-client.scm (http-fetch): Use the right uri variable in case of
redirection.
---
 guix/http-client.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/guix/http-client.scm b/guix/http-client.scm
index 8a5b3deecd..b8689a22ed 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -148,7 +148,7 @@ (define uri*
                             (or (not (uri-host uri))
                                 (string=? host (uri-host uri)))
                             port)
-                       (open-connection uri*
+                       (open-connection uri
                                         #:verify-certificate?
                                         verify-certificate?
                                         #:timeout timeout)))))
-- 
2.34.0

[bug#54836] [PATCH 2/2] http-client: Factor out open-connection*, rename variables.

[Attila Lendvai]

This is an idempotent refactor.

* guix/http-client.scm (http-fetch): Introduce open-connection*. Rename some
variables to turn programmer mistakes into compile errors.
---
 guix/http-client.scm | 48 ++++++++++++++++++++++----------------------
 1 file changed, 24 insertions(+), 24 deletions(-)

diff --git a/guix/http-client.scm b/guix/http-client.scm
index b8689a22ed..3c5115068d 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -103,15 +103,17 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
 When ACCEPT-ALL-RESPONSE-CODES? is false then raise an '&http-get-error'
 condition if downloading fails, otherwise return the response regardless
 of the reponse code."
-  (define uri*
+  (define parsed-initial-uri
     (if (string? uri) (string->uri uri) uri))
 
-  (let loop ((uri uri*)
-             (port (or port (open-connection uri*
-                                             #:verify-certificate?
-                                             verify-certificate?
-                                             #:timeout timeout))))
-    (let ((headers (match (uri-userinfo uri)
+  (define (open-connection* uri)
+    (open-connection uri
+                     #:verify-certificate? verify-certificate?
+                     #:timeout timeout))
+
+  (let loop ((current-uri parsed-initial-uri)
+             (current-port (or port (open-connection parsed-initial-uri))))
+    (let ((headers (match (uri-userinfo current-uri)
                      ((? string? str)
                       (cons (cons 'Authorization
                                   (string-append "Basic "
@@ -119,10 +121,10 @@ (define uri*
                                                   (string->utf8 str))))
                             headers))
                      (_ headers))))
-      (unless (or buffered? (not (file-port? port)))
-        (setvbuf port 'none))
+      (unless (or buffered? (not (file-port? current-port)))
+        (setvbuf current-port 'none))
       (let*-values (((resp data)
-                     (http-get uri #:streaming? #t #:port port
+                     (http-get current-uri #:streaming? #t #:port current-port
                                #:keep-alive? keep-alive?
                                #:headers headers))
                     ((code)
@@ -135,28 +137,26 @@ (define uri*
             303                                   ; see other
             307                                   ; temporary redirection
             308)                                  ; permanent redirection
-           (let ((host (uri-host uri))
-                 (uri  (resolve-uri-reference (response-location resp) uri)))
+           (let ((host (uri-host current-uri))
+                 (new-uri (resolve-uri-reference (response-location resp)
+                                                 current-uri)))
              (if keep-alive?
                  (dump-port data (%make-void-port "w0")
                             (response-content-length resp))
-                 (close-port port))
+                 (close-port current-port))
              (format log-port (G_ "following redirection to `~a'...~%")
-                     (uri->string uri))
-             (loop uri
+                     (uri->string new-uri))
+             (loop new-uri
                    (or (and keep-alive?
-                            (or (not (uri-host uri))
-                                (string=? host (uri-host uri)))
-                            port)
-                       (open-connection uri
-                                        #:verify-certificate?
-                                        verify-certificate?
-                                        #:timeout timeout)))))
+                            (or (not (uri-host new-uri))
+                                (string=? host (uri-host new-uri)))
+                            current-port)
+                       (open-connection* new-uri)))))
           (else
            (if accept-all-response-codes?
                (values data (response-content-length resp))
                (raise (condition (&http-get-error
-                                  (uri uri)
+                                  (uri current-uri)
                                   (code code)
                                   (reason (response-reason-phrase resp))
                                   (headers (response-headers resp)))
@@ -165,7 +165,7 @@ (define uri*
                                    (format
                                     #f
                                     (G_ "~a: HTTP download failed: ~a (~s)")
-                                    (uri->string uri) code
+                                    (uri->string current-uri) code
                                     (response-reason-phrase resp)))))))))))))
 
 (define-syntax-rule (false-if-networking-error exp)
-- 
2.34.0

[bug#54836] [PATCH v2 1/3] http-client: Added accept-all-response-codes? argument.

[Attila Lendvai]

This is needed when dealing with golang packages, as per:
https://golang.org/ref/mod#vcs-find

A page may return 404, but at the same time also contain the sought after
`go-import` meta tag.  An example for such a project/page is:
https://www.gonum.org/v1/gonum?go-get=1

It's not enough to just handle the thrown exception, because we need to be
able to get hold of the fetched content, too.

* guix/http-client.scm (http-fetch): Add #:accept-all-response-codes? keyword
argument defaulting to #f, and implement the logic.
---

oops, resending because the first version doesn't apply on master.

v2 also contains an initial commit, a feature addition that is needed
for my (soon to be sent) improvements to the go importer.

 guix/http-client.scm | 33 +++++++++++++++++++--------------
 1 file changed, 19 insertions(+), 14 deletions(-)

diff --git a/guix/http-client.scm b/guix/http-client.scm
index 143ed6de31..8a5b3deecd 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -82,7 +82,8 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
                      (verify-certificate? #t)
                      (headers '((user-agent . "GNU Guile")))
                      (log-port (current-error-port))
-                     timeout)
+                     timeout
+                     (accept-all-response-codes? #f))
   "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
@@ -99,7 +100,9 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
 
 Write information about redirects to LOG-PORT.
 
-Raise an '&http-get-error' condition if downloading fails."
+When ACCEPT-ALL-RESPONSE-CODES? is false then raise an '&http-get-error'
+condition if downloading fails, otherwise return the response regardless
+of the reponse code."
   (define uri*
     (if (string? uri) (string->uri uri) uri))
 
@@ -150,18 +153,20 @@ (define uri*
                                         verify-certificate?
                                         #:timeout timeout)))))
           (else
-           (raise (condition (&http-get-error
-                              (uri uri)
-                              (code code)
-                              (reason (response-reason-phrase resp))
-                              (headers (response-headers resp)))
-                             (&message
-                              (message
-                               (format
-                                #f
-                                (G_ "~a: HTTP download failed: ~a (~s)")
-                                (uri->string uri) code
-                                (response-reason-phrase resp))))))))))))
+           (if accept-all-response-codes?
+               (values data (response-content-length resp))
+               (raise (condition (&http-get-error
+                                  (uri uri)
+                                  (code code)
+                                  (reason (response-reason-phrase resp))
+                                  (headers (response-headers resp)))
+                                 (&message
+                                  (message
+                                   (format
+                                    #f
+                                    (G_ "~a: HTTP download failed: ~a (~s)")
+                                    (uri->string uri) code
+                                    (response-reason-phrase resp)))))))))))))
 
 (define-syntax-rule (false-if-networking-error exp)
   "Return #f if EXP triggers a network related exception as can occur when
-- 
2.34.0

[bug#54836] [PATCH 2/3] http-client: Fix redirection.

[Attila Lendvai]

* guix/http-client.scm (http-fetch): Use the right uri variable in case of
redirection.
---
 guix/http-client.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/guix/http-client.scm b/guix/http-client.scm
index 8a5b3deecd..b8689a22ed 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -148,7 +148,7 @@ (define uri*
                             (or (not (uri-host uri))
                                 (string=? host (uri-host uri)))
                             port)
-                       (open-connection uri*
+                       (open-connection uri
                                         #:verify-certificate?
                                         verify-certificate?
                                         #:timeout timeout)))))
-- 
2.34.0

[bug#54836] [PATCH 1/2] http-client: Fix redirection.

[Ludovic Courtès]

Hi,

Attila Lendvai <attila@lendvai.name> skribis:

> * guix/http-client.scm (http-fetch): Use the right uri variable in case of
> redirection.
> ---
>  guix/http-client.scm | 2 +-
>  1 file changed, 1 insertion(+), 1 deletion(-)
>
> diff --git a/guix/http-client.scm b/guix/http-client.scm
> index 8a5b3deecd..b8689a22ed 100644
> --- a/guix/http-client.scm
> +++ b/guix/http-client.scm
> @@ -148,7 +148,7 @@ (define uri*
>                              (or (not (uri-host uri))
>                                  (string=? host (uri-host uri)))
>                              port)
> -                       (open-connection uri*
> +                       (open-connection uri

Good catch!  This fixes <https://issues.guix.gnu.org/54609>.

Applied.

Ludo’.

[bug#54836] [PATCH 3/3] http-client: Factor out open-connection*, rename variables.

[Attila Lendvai]

This is an idempotent refactor.

* guix/http-client.scm (http-fetch): Introduce open-connection*. Rename some
variables to turn programmer mistakes into compile errors.
---
 guix/http-client.scm | 48 ++++++++++++++++++++++----------------------
 1 file changed, 24 insertions(+), 24 deletions(-)

diff --git a/guix/http-client.scm b/guix/http-client.scm
index b8689a22ed..3c5115068d 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -103,15 +103,17 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
 When ACCEPT-ALL-RESPONSE-CODES? is false then raise an '&http-get-error'
 condition if downloading fails, otherwise return the response regardless
 of the reponse code."
-  (define uri*
+  (define parsed-initial-uri
     (if (string? uri) (string->uri uri) uri))
 
-  (let loop ((uri uri*)
-             (port (or port (open-connection uri*
-                                             #:verify-certificate?
-                                             verify-certificate?
-                                             #:timeout timeout))))
-    (let ((headers (match (uri-userinfo uri)
+  (define (open-connection* uri)
+    (open-connection uri
+                     #:verify-certificate? verify-certificate?
+                     #:timeout timeout))
+
+  (let loop ((current-uri parsed-initial-uri)
+             (current-port (or port (open-connection parsed-initial-uri))))
+    (let ((headers (match (uri-userinfo current-uri)
                      ((? string? str)
                       (cons (cons 'Authorization
                                   (string-append "Basic "
@@ -119,10 +121,10 @@ (define uri*
                                                   (string->utf8 str))))
                             headers))
                      (_ headers))))
-      (unless (or buffered? (not (file-port? port)))
-        (setvbuf port 'none))
+      (unless (or buffered? (not (file-port? current-port)))
+        (setvbuf current-port 'none))
       (let*-values (((resp data)
-                     (http-get uri #:streaming? #t #:port port
+                     (http-get current-uri #:streaming? #t #:port current-port
                                #:keep-alive? keep-alive?
                                #:headers headers))
                     ((code)
@@ -135,28 +137,26 @@ (define uri*
             303                                   ; see other
             307                                   ; temporary redirection
             308)                                  ; permanent redirection
-           (let ((host (uri-host uri))
-                 (uri  (resolve-uri-reference (response-location resp) uri)))
+           (let ((host (uri-host current-uri))
+                 (new-uri (resolve-uri-reference (response-location resp)
+                                                 current-uri)))
              (if keep-alive?
                  (dump-port data (%make-void-port "w0")
                             (response-content-length resp))
-                 (close-port port))
+                 (close-port current-port))
              (format log-port (G_ "following redirection to `~a'...~%")
-                     (uri->string uri))
-             (loop uri
+                     (uri->string new-uri))
+             (loop new-uri
                    (or (and keep-alive?
-                            (or (not (uri-host uri))
-                                (string=? host (uri-host uri)))
-                            port)
-                       (open-connection uri
-                                        #:verify-certificate?
-                                        verify-certificate?
-                                        #:timeout timeout)))))
+                            (or (not (uri-host new-uri))
+                                (string=? host (uri-host new-uri)))
+                            current-port)
+                       (open-connection* new-uri)))))
           (else
            (if accept-all-response-codes?
                (values data (response-content-length resp))
                (raise (condition (&http-get-error
-                                  (uri uri)
+                                  (uri current-uri)
                                   (code code)
                                   (reason (response-reason-phrase resp))
                                   (headers (response-headers resp)))
@@ -165,7 +165,7 @@ (define uri*
                                    (format
                                     #f
                                     (G_ "~a: HTTP download failed: ~a (~s)")
-                                    (uri->string uri) code
+                                    (uri->string current-uri) code
                                     (response-reason-phrase resp)))))))))))))
 
 (define-syntax-rule (false-if-networking-error exp)
-- 
2.34.0

[bug#54836] [PATCH 1/2] http-client: Fix redirection.

[Ludovic Courtès]

Hi,

Attila Lendvai <attila@lendvai.name> skribis:

> This is needed when dealing with golang packages, as per:
> https://golang.org/ref/mod#vcs-find
>
> A page may return 404, but at the same time also contain the sought after
> `go-import` meta tag.  An example for such a project/page is:
> https://www.gonum.org/v1/gonum?go-get=1
>
> It's not enough to just handle the thrown exception, because we need to be
> able to get hold of the fetched content, too.

Would it make sense, then, to use the lower-level ‘http-get’ from (web
client)?  That would let the code deal with all the HTTP idiosyncrasies.

Ludo’.

[bug#54836] [PATCH 1/2] http-client: Fix redirection.

[Attila Lendvai]

> > It's not enough to just handle the thrown exception, because we need to be
> > able to get hold of the fetched content, too.
>
> Would it make sense, then, to use the lower-level ‘http-get’ from (web
> client)? That would let the code deal with all the HTTP idiosyncrasies.


i think it boils down to this trade-off:

1) keep http-fetch simpler, at the expense of reimplementing parts of
   it in the go importer (e.g. the redirection logic)

2) add this extra complexity to http-fetch, and avoid the extra
   complexity of a local, potentially half-assed %http-fetch in the go
   importer.

3) something else i'm not aware of

please advise how to reshape this patch/feature, because it's needed
to file my go importer patches.

--
• attila lendvai
• PGP: 963F 5D5F 45C7 DFCD 0A39
--
The use of power is only needed when you want to do something harmful, otherwise love is enough to get everything done.

[bug#54836] [PATCH 1/2] http-client: Fix redirection.

[Attila Lendvai]

> i think it boils down to this trade-off:
>
> 1) keep http-fetch simpler, at the expense of reimplementing parts of
> it in the go importer (e.g. the redirection logic)
>
> 2) add this extra complexity to http-fetch, and avoid the extra
> complexity of a local, potentially half-assed %http-fetch in the go
> importer.
>
> 3) something else i'm not aware of
>
> please advise how to reshape this patch/feature, because it's needed
> to file my go importer patches.


can someone with authority please decide how to proceed with this?

(the reason is that i'd like to file my golang importer improvements
before it develops a painful merge conflict with master.)

--
• attila lendvai
• PGP: 963F 5D5F 45C7 DFCD 0A39
--
“Your living is determined not so much by what life brings to you as by the attitude you bring to life; not so much by what happens to you as by the way your mind looks at what happens.”
	— Khalil Gibran (1883–1931)

[bug#54836] [PATCH 1/2] http-client: Fix redirection.

[Ludovic Courtès]

Hi,

And sorry for the delay.

Attila Lendvai <attila@lendvai.name> skribis:

>> > It's not enough to just handle the thrown exception, because we need to be
>> > able to get hold of the fetched content, too.
>>
>> Would it make sense, then, to use the lower-level ‘http-get’ from (web
>> client)? That would let the code deal with all the HTTP idiosyncrasies.
>
>
> i think it boils down to this trade-off:
>
> 1) keep http-fetch simpler, at the expense of reimplementing parts of
>    it in the go importer (e.g. the redirection logic)
>
> 2) add this extra complexity to http-fetch, and avoid the extra
>    complexity of a local, potentially half-assed %http-fetch in the go
>    importer.
>
> 3) something else i'm not aware of

For now, I’m somewhat in favor of #1.

My take would be: try to implement whatever’s needed specifically for
the Go importer; from there, we can eventually revisit that situation
and maybe switch to something that’s more like #2.

How does that sound?

Thanks,
Ludo’.

[bug#54836] [PATCH 1/2] http-client: Fix redirection.

[Maxim Cournoyer]

Hi Attila,

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

> Hi,
>
> And sorry for the delay.
>
> Attila Lendvai <attila@lendvai.name> skribis:
>
>>> > It's not enough to just handle the thrown exception, because we need to be
>>> > able to get hold of the fetched content, too.
>>>
>>> Would it make sense, then, to use the lower-level ‘http-get’ from (web
>>> client)? That would let the code deal with all the HTTP idiosyncrasies.
>>
>>
>> i think it boils down to this trade-off:
>>
>> 1) keep http-fetch simpler, at the expense of reimplementing parts of
>>    it in the go importer (e.g. the redirection logic)
>>
>> 2) add this extra complexity to http-fetch, and avoid the extra
>>    complexity of a local, potentially half-assed %http-fetch in the go
>>    importer.
>>
>> 3) something else i'm not aware of
>
> For now, I’m somewhat in favor of #1.
>
> My take would be: try to implement whatever’s needed specifically for
> the Go importer; from there, we can eventually revisit that situation
> and maybe switch to something that’s more like #2.
>
> How does that sound?

I think we're missing your reworked 1/3 patch here, taking into account the above
feedback from Ludo.

-- 
Thanks,
Maxim

[bug#54836] [PATCH v3] http-client: Factor out open-connection*, rename variables.

[Attila Lendvai]

This is an idempotent refactor.

* guix/http-client.scm (http-fetch): Introduce open-connection*. Rename some
variables to turn programmer mistakes into compile time errors.
---

v3: i have reordered the commits so that i can send this idempotent
refactor. i think this would be a useful addition to master. it makes
the code more defensive against future programmer mistakes, but
other than that it shouldn't change the semantics.

apply this as you see fit. the rest i'll do in the go importer's module.

 guix/http-client.scm | 66 ++++++++++++++++++++++----------------------
 1 file changed, 33 insertions(+), 33 deletions(-)

diff --git a/guix/http-client.scm b/guix/http-client.scm
index a367c41afa..6c61fd3d8e 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -100,15 +100,17 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
 Write information about redirects to LOG-PORT.
 
 Raise an '&http-get-error' condition if downloading fails."
-  (define uri*
+  (define parsed-initial-uri
     (if (string? uri) (string->uri uri) uri))
 
-  (let loop ((uri uri*)
-             (port (or port (open-connection uri*
-                                             #:verify-certificate?
-                                             verify-certificate?
-                                             #:timeout timeout))))
-    (let ((headers (match (uri-userinfo uri)
+  (define (open-connection* uri)
+    (open-connection uri
+                     #:verify-certificate? verify-certificate?
+                     #:timeout timeout))
+
+  (let loop ((current-uri parsed-initial-uri)
+             (current-port (or port (open-connection parsed-initial-uri))))
+    (let ((headers (match (uri-userinfo current-uri)
                      ((? string? str)
                       (cons (cons 'Authorization
                                   (string-append "Basic "
@@ -116,10 +118,10 @@ (define uri*
                                                   (string->utf8 str))))
                             headers))
                      (_ headers))))
-      (unless (or buffered? (not (file-port? port)))
-        (setvbuf port 'none))
+      (unless (or buffered? (not (file-port? current-port)))
+        (setvbuf current-port 'none))
       (let*-values (((resp data)
-                     (http-get uri #:streaming? #t #:port port
+                     (http-get current-uri #:streaming? #t #:port current-port
                                #:keep-alive? keep-alive?
                                #:headers headers))
                     ((code)
@@ -132,36 +134,34 @@ (define uri*
             303                                   ; see other
             307                                   ; temporary redirection
             308)                                  ; permanent redirection
-           (let ((host (uri-host uri))
-                 (uri  (resolve-uri-reference (response-location resp) uri)))
+           (let ((host (uri-host current-uri))
+                 (new-uri (resolve-uri-reference (response-location resp)
+                                                 current-uri)))
              (if keep-alive?
                  (dump-port data (%make-void-port "w0")
                             (response-content-length resp))
-                 (close-port port))
+                 (close-port current-port))
              (format log-port (G_ "following redirection to `~a'...~%")
-                     (uri->string uri))
-             (loop uri
+                     (uri->string new-uri))
+             (loop new-uri
                    (or (and keep-alive?
-                            (or (not (uri-host uri))
-                                (string=? host (uri-host uri)))
-                            port)
-                       (open-connection uri
-                                        #:verify-certificate?
-                                        verify-certificate?
-                                        #:timeout timeout)))))
+                            (or (not (uri-host new-uri))
+                                (string=? host (uri-host new-uri)))
+                            current-port)
+                       (open-connection* new-uri)))))
           (else
            (raise (condition (&http-get-error
-                              (uri uri)
-                              (code code)
-                              (reason (response-reason-phrase resp))
-                              (headers (response-headers resp)))
-                             (&message
-                              (message
-                               (format
-                                #f
-                                (G_ "~a: HTTP download failed: ~a (~s)")
-                                (uri->string uri) code
-                                (response-reason-phrase resp))))))))))))
+                                  (uri current-uri)
+                                  (code code)
+                                  (reason (response-reason-phrase resp))
+                                  (headers (response-headers resp)))
+                                 (&message
+                                  (message
+                                   (format
+                                    #f
+                                    (G_ "~a: HTTP download failed: ~a (~s)")
+                                    (uri->string current-uri) code
+                                    (response-reason-phrase resp))))))))))))
 
 (define-syntax-rule (false-if-networking-error exp)
   "Return #f if EXP triggers a network related exception as can occur when
-- 
2.35.1

[bug#54836] [PATCH v4 1/2] http-client: Factor out open-connection*, rename variables.

[Attila Lendvai]

This is an idempotent refactor.

* guix/http-client.scm (http-fetch): Introduce open-connection*. Rename some
variables to turn programmer mistakes into compile time errors.
---

i'm (re)sending the two commits that are sitting in my local branch.

i freshly rebased them.

the conlusion was to not add the accept-all-response-codes? argument,
and accordingly i have added a duplicate of http-fetch into the go
importer. my fix was applied by Ludo in his own commit. this is why
the 3 commits got reduced to one.

i'm only proposing to push the first patch. what the second one does
was rejected by Ludo.

ratinale for the first patch: it renames variables in a way that is
less confusing for the programmer, and hence helps avoiding mistakes
that i have fixed in my first original commit. an uri and an uri*
variable in the same lexical scope is simply calling for mistakes...

 guix/http-client.scm | 66 ++++++++++++++++++++++----------------------
 1 file changed, 33 insertions(+), 33 deletions(-)

diff --git a/guix/http-client.scm b/guix/http-client.scm
index 9138a627ac..2d48a882e1 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -100,15 +100,17 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
 Write information about redirects to LOG-PORT.
 
 Raise an '&http-get-error' condition if downloading fails."
-  (define uri*
+  (define parsed-initial-uri
     (if (string? uri) (string->uri uri) uri))
 
-  (let loop ((uri uri*)
-             (port (or port (open-connection uri*
-                                             #:verify-certificate?
-                                             verify-certificate?
-                                             #:timeout timeout))))
-    (let ((headers (match (uri-userinfo uri)
+  (define (open-connection* uri)
+    (open-connection uri
+                     #:verify-certificate? verify-certificate?
+                     #:timeout timeout))
+
+  (let loop ((current-uri parsed-initial-uri)
+             (current-port (or port (open-connection parsed-initial-uri))))
+    (let ((headers (match (uri-userinfo current-uri)
                      ((? string? str)
                       (cons (cons 'Authorization
                                   (string-append "Basic "
@@ -116,10 +118,10 @@ (define uri*
                                                   (string->utf8 str))))
                             headers))
                      (_ headers))))
-      (unless (or buffered? (not (file-port? port)))
-        (setvbuf port 'none))
+      (unless (or buffered? (not (file-port? current-port)))
+        (setvbuf current-port 'none))
       (let*-values (((resp data)
-                     (http-get uri #:streaming? #t #:port port
+                     (http-get current-uri #:streaming? #t #:port current-port
                                #:keep-alive? keep-alive?
                                #:headers headers))
                     ((code)
@@ -132,36 +134,34 @@ (define uri*
             303                                   ; see other
             307                                   ; temporary redirection
             308)                                  ; permanent redirection
-           (let ((host (uri-host uri))
-                 (uri  (resolve-uri-reference (response-location resp) uri)))
+           (let ((host (uri-host current-uri))
+                 (new-uri (resolve-uri-reference (response-location resp)
+                                                 current-uri)))
              (if keep-alive?
                  (dump-port data (%make-void-port "w0")
                             (response-content-length resp))
-                 (close-port port))
+                 (close-port current-port))
              (format log-port (G_ "following redirection to `~a'...~%")
-                     (uri->string uri))
-             (loop uri
+                     (uri->string new-uri))
+             (loop new-uri
                    (or (and keep-alive?
-                            (or (not (uri-host uri))
-                                (string=? host (uri-host uri)))
-                            port)
-                       (open-connection uri
-                                        #:verify-certificate?
-                                        verify-certificate?
-                                        #:timeout timeout)))))
+                            (or (not (uri-host new-uri))
+                                (string=? host (uri-host new-uri)))
+                            current-port)
+                       (open-connection* new-uri)))))
           (else
            (raise (condition (&http-get-error
-                              (uri uri)
-                              (code code)
-                              (reason (response-reason-phrase resp))
-                              (headers (response-headers resp)))
-                             (&message
-                              (message
-                               (format
-                                #f
-                                (G_ "~a: HTTP download failed: ~a (~s)")
-                                (uri->string uri) code
-                                (response-reason-phrase resp))))))))))))
+                                  (uri current-uri)
+                                  (code code)
+                                  (reason (response-reason-phrase resp))
+                                  (headers (response-headers resp)))
+                                 (&message
+                                  (message
+                                   (format
+                                    #f
+                                    (G_ "~a: HTTP download failed: ~a (~s)")
+                                    (uri->string current-uri) code
+                                    (response-reason-phrase resp))))))))))))
 
 (define-syntax-rule (false-if-networking-error exp)
   "Return #f if EXP triggers a network related exception as can occur when
-- 
2.35.1

[bug#54836] [PATCH v4 2/2] http-client: Added accept-all-response-codes? argument.

[Attila Lendvai]

This is needed when dealing with golang packages, as per:
https://golang.org/ref/mod#vcs-find

A page may return 404, but at the same time also contain the sought after
`go-import` meta tag.  An example for such a project/page is:
https://www.gonum.org/v1/gonum?go-get=1

It's not enough to just handle the thrown exception, because we need to be
able to get hold of the fetched content, too.

* guix/http-client.scm (http-fetch): Add #:accept-all-response-codes? keyword
argument defaulting to #f, and implement the logic.
---
 guix/http-client.scm | 13 +++++++++----
 1 file changed, 9 insertions(+), 4 deletions(-)

diff --git a/guix/http-client.scm b/guix/http-client.scm
index 2d48a882e1..341dd7414a 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -82,7 +82,8 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
                      (verify-certificate? #t)
                      (headers '((user-agent . "GNU Guile")))
                      (log-port (current-error-port))
-                     timeout)
+                     timeout
+                     (accept-all-response-codes? #f))
   "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
@@ -99,7 +100,9 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
 
 Write information about redirects to LOG-PORT.
 
-Raise an '&http-get-error' condition if downloading fails."
+When ACCEPT-ALL-RESPONSE-CODES? is false then raise an '&http-get-error'
+condition if downloading fails, otherwise return the response regardless
+of the reponse code."
   (define parsed-initial-uri
     (if (string? uri) (string->uri uri) uri))
 
@@ -150,7 +153,9 @@ (define (open-connection* uri)
                             current-port)
                        (open-connection* new-uri)))))
           (else
-           (raise (condition (&http-get-error
+           (if accept-all-response-codes?
+               (values data (response-content-length resp))
+               (raise (condition (&http-get-error
                                   (uri current-uri)
                                   (code code)
                                   (reason (response-reason-phrase resp))
@@ -161,7 +166,7 @@ (define (open-connection* uri)
                                     #f
                                     (G_ "~a: HTTP download failed: ~a (~s)")
                                     (uri->string current-uri) code
-                                    (response-reason-phrase resp))))))))))))
+                                    (response-reason-phrase resp)))))))))))))
 
 (define-syntax-rule (false-if-networking-error exp)
   "Return #f if EXP triggers a network related exception as can occur when
-- 
2.35.1