Subject: [bug#28262] [PATCH] Handle the same HTTP redirects everywhere.

From: Tobias Geerinckx-Rice <[email-masked]>
Date: Mon, 28 Aug 2017 15:46:10 +0200

* guix/download.scm (http-fetch): Complete the hard-coded list of HTTP
redirect status codes.
* guix/http-client.scm (http-fetch): Likewise.
* guix/scripts/lint.scm (probe-uri): Likewise.
---

Guix,

There are three (that I know of) hard-coded lists of HTTP redirect status
codes in Guix. All were different, and all were incomplete.

This patch doesn't address the duplication, but does add all missing
codes. Specifically the newer HTTP/1.1 codes, including 303 ‘See Other’.
It's not strictly a plain redirect, but used as such in the wild[1], and
treating it as such is probably enough for our purposes.

This allows at least lightdm-gtk-greeter to be built again. Why its
sources waren't mirrored to begin with I do not know, nor did I check.

Kind regards,

T G-R

[1]: https://launchpad.net/lightdm-gtk-greeter/2.0/2.0.2/+download/lightdm-gtk-greeter-2.0.2.tar.gz

 guix/build/download.scm | 5 ++++-
 guix/http-client.scm    | 6 +++++-
 guix/scripts/lint.scm   | 7 ++++++-
 3 files changed, 15 insertions(+), 3 deletions(-)

diff --git a/guix/build/download.scm b/guix/build/download.scm
index 6ef623334..bcf22663b 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <[email-masked]>
 ;;; Copyright © 2015 Mark H Weaver <[email-masked]>
 ;;; Copyright © 2015 Steve Sprang <[email-masked]>
+;;; Copyright © 2017 Tobias Geerinckx-Rice <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -763,7 +764,9 @@ certificates; otherwise simply ignore them."
          file))
       ((301                                       ; moved permanently
         302                                       ; found (redirection)
-        307)                                      ; temporary redirection
+        303                                       ; see other
+        307                                       ; temporary redirection
+        308)                                      ; permanent redirection
        (let ((uri (resolve-uri-reference (response-location resp) uri)))
          (format #t "following redirection to `~a'...~%"
                  (uri->string uri))
diff --git a/guix/http-client.scm b/guix/http-client.scm
index 3c5441c38..8db332093 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <[email-masked]>
 ;;; Copyright © 2015 Mark H Weaver <[email-masked]>
 ;;; Copyright © 2012, 2015 Free Software Foundation, Inc.
+;;; Copyright © 2017 Tobias Geerinckx-Rice <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -259,7 +260,10 @@ Raise an '&http-get-error' condition if downloading fails."
           ((200)
            (values data (response-content-length resp)))
           ((301                                   ; moved permanently
-            302)                                  ; found (redirection)
+            302                                   ; found (redirection)
+            303                                   ; see also
+            307                                   ; temporary redirect
+            308)                                  ; permanent redirect
            (let ((uri (resolve-uri-reference (response-location resp) uri)))
              (close-port port)
              (format #t (G_ "following redirection to `~a'...~%")
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index aceafc674..b27732d39 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2016 Danny Milosavljevic <[email-masked]>
 ;;; Copyright © 2016 Hartmut Goebel <[email-masked]>
 ;;; Copyright © 2017 Alex Kost <[email-masked]>
+;;; Copyright © 2017 Tobias Geerinckx-Rice <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -411,7 +412,11 @@ for connections to complete; when TIMEOUT is #f, wait as long as needed."
                    (close-connection port))))
 
              (case (response-code response)
-               ((301 302 307)
+               ((301                    ; moved permanently
+                 302                    ; found (redirection)
+                 303                    ; see also
+                 307                    ; temporary redirect
+                 308)                   ; permanent redirect
                 (let ((location (response-location response)))
                   (if (or (not location) (member location visited))
                       (values 'http-response response)
-- 
2.13.1