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*'.
This commit is contained in:
Ludovic Courtès 2014-02-10 00:03:34 +01:00
parent 06d275f67f
commit 2de227af4b

View file

@ -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 @@ (define post-2.0.7?
(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 @@ (define post-2.0.7?
;; 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)