diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2014-02-10 00:03:34 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2014-02-10 00:03:34 +0100 |
| commit | 2de227af4bca7204e93f48d52555d576c25f1ca9 (patch) | |
| tree | 39869dd4eb0eadb0259fff81df75f6307df463ec | |
| parent | 06d275f67f9ad58ea041f3e31add95fe48631f50 (diff) | |
| download | guix-2de227af4bca7204e93f48d52555d576c25f1ca9.tar.gz | |
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*'.
| -rw-r--r-- | guix/build/download.scm | 17 |
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) |