summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-02-10 00:03:34 +0100
committerLudovic Courtès <ludo@gnu.org>2014-02-10 00:03:34 +0100
commit2de227af4bca7204e93f48d52555d576c25f1ca9 (patch)
tree39869dd4eb0eadb0259fff81df75f6307df463ec /guix
parent06d275f67f9ad58ea041f3e31add95fe48631f50 (diff)
download: Provide a 'User-Agent' field in HTTP requests.
Fixes <http://bugs.gnu.org/16703>. Reported by Raimon Grau <raimonster@gmail.com>. * guix/build/download.scm (http-fetch)[headers]: New variable. Pass it as #:headers or #:extra-headers to 'http-get' and 'http-get*'.
Diffstat (limited to 'guix')
-rw-r--r--guix/build/download.scm17
1 files changed, 13 insertions, 4 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm
index ac2086d96e..f9715e10f7 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -201,6 +201,12 @@ which is not available during bootstrap."
(string>? (micro-version) "7")
(string>? (version) "2.0.7")))
+ (define headers
+ ;; Some web sites, such as http://dist.schmorp.de, would block you if
+ ;; there's no 'User-Agent' header, presumably on the assumption that
+ ;; you're a spammer. So work around that.
+ '((User-Agent . "GNU Guile")))
+
(let*-values (((connection)
(open-connection-for-uri uri))
((resp bv-or-port)
@@ -210,11 +216,14 @@ which is not available during bootstrap."
;; version. So keep this compatibility hack for now.
(if post-2.0.7?
(http-get uri #:port connection #:decode-body? #f
- #:streaming? #t)
+ #:streaming? #t
+ #:headers headers)
(if (module-defined? (resolve-interface '(web client))
'http-get*)
- (http-get* uri #:port connection #:decode-body? #f)
- (http-get uri #:port connection #:decode-body? #f))))
+ (http-get* uri #:port connection #:decode-body? #f
+ #:headers headers)
+ (http-get uri #:port connection #:decode-body? #f
+ #:extra-headers headers))))
((code)
(response-code resp))
((size)