~ruther/guix-local

57d28987722cb6b830fae212ea0d6a704580ff9c — Tobias Geerinckx-Rice 8 years ago a4c1e99
Handle the same HTTP redirects everywhere.

* guix/build/download.scm (http-fetch): Complete the hard-coded list of HTTP
redirection status codes.
* guix/http-client.scm (http-fetch): Likewise.
* guix/scripts/lint.scm (probe-uri): Likewise.
3 files changed, 15 insertions(+), 3 deletions(-)

M guix/build/download.scm
M guix/http-client.scm
M guix/scripts/lint.scm
M guix/build/download.scm => guix/build/download.scm +4 -1
@@ 2,6 2,7 @@
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Steve Sprang <scs@stevesprang.com>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; 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))

M guix/http-client.scm => guix/http-client.scm +5 -1
@@ 2,6 2,7 @@
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2012, 2015 Free Software Foundation, Inc.
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; 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 other
            307                                   ; temporary redirection
            308)                                  ; permanent redirection
           (let ((uri (resolve-uri-reference (response-location resp) uri)))
             (close-port port)
             (format #t (G_ "following redirection to `~a'...~%")

M guix/scripts/lint.scm => guix/scripts/lint.scm +6 -1
@@ 6,6 6,7 @@
;;; Copyright © 2016 Danny Milosavljevic <dannym+a@scratchpost.org>
;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; 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 other
                 307                    ; temporary redirection
                 308)                   ; permanent redirection
                (let ((location (response-location response)))
                  (if (or (not location) (member location visited))
                      (values 'http-response response)