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

  • Open
  • quality assurance status badge
Details
3 participants
  • Attila Lendvai
  • Ludovic Courtès
  • Maxim Cournoyer
Owner
unassigned
Submitted by
Attila Lendvai
Severity
normal
A
A
Attila Lendvai wrote on 10 Apr 2022 15:34
(address . guix-patches@gnu.org)(name . Attila Lendvai)(address . attila@lendvai.name)
20220410133431.30058-1-attila@lendvai.name
* 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(-)

Toggle diff (15 lines)
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
A
A
Attila Lendvai wrote on 10 Apr 2022 15:35
[PATCH 2/2] http-client: Factor out open-connection*, rename variables.
(address . 54836@debbugs.gnu.org)(name . Attila Lendvai)(address . attila@lendvai.name)
20220410133536.30422-2-attila@lendvai.name
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(-)

Toggle diff (94 lines)
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
A
A
Attila Lendvai wrote on 10 Apr 2022 15:41
[PATCH v2 1/3] http-client: Added accept-all-response-codes? argument.
(address . 54836@debbugs.gnu.org)(name . Attila Lendvai)(address . attila@lendvai.name)
20220410134114.371-1-attila@lendvai.name
This is needed when dealing with golang packages, as per:

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:

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

Toggle diff (60 lines)
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
A
A
Attila Lendvai wrote on 10 Apr 2022 15:41
[PATCH 2/3] http-client: Fix redirection.
(address . 54836@debbugs.gnu.org)(name . Attila Lendvai)(address . attila@lendvai.name)
20220410134114.371-2-attila@lendvai.name
* 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(-)

Toggle diff (15 lines)
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
A
A
Attila Lendvai wrote on 10 Apr 2022 15:41
[PATCH 3/3] http-client: Factor out open-connection*, rename variables.
(address . 54836@debbugs.gnu.org)(name . Attila Lendvai)(address . attila@lendvai.name)
20220410134114.371-3-attila@lendvai.name
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(-)

Toggle diff (94 lines)
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
L
L
Ludovic Courtès wrote on 11 Apr 2022 14:44
Re: bug#54836: [PATCH 1/2] http-client: Fix redirection.
(name . Attila Lendvai)(address . attila@lendvai.name)(address . 54836@debbugs.gnu.org)
87zgkriyct.fsf_-_@gnu.org
Hi,

Attila Lendvai <attila@lendvai.name> skribis:

Toggle quote (17 lines)
> * 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’.
L
L
Ludovic Courtès wrote on 11 Apr 2022 14:45
(name . Attila Lendvai)(address . attila@lendvai.name)(address . 54836@debbugs.gnu.org)
87v8vfiya2.fsf_-_@gnu.org
Hi,

Attila Lendvai <attila@lendvai.name> skribis:

Toggle quote (10 lines)
> 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’.
A
A
Attila Lendvai wrote on 12 Apr 2022 09:28
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 54836@debbugs.gnu.org)
TEOfd1QUBofS5gzJHP15SC0Lq_iRfWnto0m99ZpFBNJYGIc41qK2tR79kaOhzZPSV_r-EYJdlDJ7Ib8rRO3OJYN_6wNtqTrPZvFwm-1i53E=@lendvai.name
Toggle quote (7 lines)
> > 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.
A
A
Attila Lendvai wrote on 27 Apr 2022 18:37
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 54836@debbugs.gnu.org)
T85_Nvw-LsLO7PH3chsQrAxbadvabr52b_En56SVdyZERm9P-7NbvA63h-eF-rUKePndSP99xYx5XfuTNu3UcmorvUS_yzFWTLLIVNMGt6M=@lendvai.name
Toggle quote (15 lines)
> 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)
L
L
Ludovic Courtès wrote on 27 Apr 2022 22:53
(name . Attila Lendvai)(address . attila@lendvai.name)(address . 54836@debbugs.gnu.org)
8735hyjlix.fsf@gnu.org
Hi,

And sorry for the delay.

Attila Lendvai <attila@lendvai.name> skribis:

Toggle quote (18 lines)
>> > 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’.
A
A
Attila Lendvai wrote on 28 Apr 2022 12:22
[PATCH v3] http-client: Factor out open-connection*, rename variables.
(address . 54836@debbugs.gnu.org)(name . Attila Lendvai)(address . attila@lendvai.name)
20220428102233.14558-1-attila@lendvai.name
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(-)

Toggle diff (103 lines)
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
M
M
Maxim Cournoyer wrote on 3 Jan 2023 23:29
Re: bug#54836: [PATCH 1/2] http-client: Fix redirection.
(name . Attila Lendvai)(address . attila@lendvai.name)
87wn63xnea.fsf_-_@gmail.com
Hi Attila,

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

Toggle quote (32 lines)
> 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
M
M
Maxim Cournoyer wrote on 3 Jan 2023 23:29
control message for bug #54836
(address . control@debbugs.gnu.org)
87v8lnxne5.fsf@gmail.com
tags 54836 + moreinfo
quit
A
A
Attila Lendvai wrote on 6 Jan 2023 19:46
[PATCH v4 1/2] http-client: Factor out open-connection*, rename variables.
(address . 54836@debbugs.gnu.org)(name . Attila Lendvai)(address . attila@lendvai.name)
20230106184654.28037-1-attila@lendvai.name
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(-)

Toggle diff (103 lines)
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
A
A
Attila Lendvai wrote on 6 Jan 2023 19:46
[PATCH v4 2/2] http-client: Added accept-all-response-codes? argument.
(address . 54836@debbugs.gnu.org)(name . Attila Lendvai)(address . attila@lendvai.name)
20230106184654.28037-2-attila@lendvai.name
This is needed when dealing with golang packages, as per:

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:

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

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