aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2012-11-12 23:09:32 +0100
committerLudovic Courtès <ludo@gnu.org>2012-11-13 00:23:43 +0100
commit270246defe541778ceaea1a87b5812c01799eaea (patch)
treee9d0871bca6a1c529f9eb59dd62ff28254471c57
parent87f5d36630db13fee1f2c0563505dc0938f3787e (diff)
downloadpatches-270246defe541778ceaea1a87b5812c01799eaea.tar
patches-270246defe541778ceaea1a87b5812c01799eaea.tar.gz
download: Follow HTTP redirections.
* guix/build/download.scm (http-fetch): Follow the redirection when CODE is 302.
-rw-r--r--guix/build/download.scm24
1 files changed, 16 insertions, 8 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm
index f3487ce9a0..7043c1b398 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -101,14 +101,22 @@ which is not available during bootstrap."
(http-get uri #:port connection #:decode-body? #f))
((code)
(response-code resp)))
- (if (= 200 code)
- (begin
- (call-with-output-file file
- (lambda (p)
- (put-bytevector p bv)))
- file)
- (error "download failed" (uri->string uri)
- code (response-reason-phrase resp)))))
+ (case code
+ ((200) ; OK
+ (begin
+ (call-with-output-file file
+ (lambda (p)
+ (put-bytevector p bv)))
+ file))
+ ((302) ; found (redirection)
+ (let ((uri (response-location resp)))
+ (format #t "following redirection to `~a'...~%"
+ (uri->string uri))
+ (close connection)
+ (http-fetch uri file)))
+ (else
+ (error "download failed" (uri->string uri)
+ code (response-reason-phrase resp))))))
(define-syntax-rule (false-if-exception* body ...)