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

[Attila Lendvai <attila@lendvai.name>]

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