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

OpenSubmitted by Attila Lendvai.
Details
2 participants
  • Attila Lendvai
  • Ludovic Courtès
Owner
unassigned
Severity
normal
A
A
Attila Lendvai wrote on 10 Apr 15:34 +0200
(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 15:35 +0200
[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 15:41 +0200
[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 15:41 +0200
[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 15:41 +0200
[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 14:44 +0200
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 14:45 +0200
(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 09:28 +0200
(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 18:37 +0200
(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 22:53 +0200
(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 12:22 +0200
[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
?