me/guix
Archived
1
0
Fork 0
Code Activity

download: Provide a 'User-Agent' field in HTTP requests.

Browse source 
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
1 changed files with 13 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
guix/build/download.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -201,6 +201,12 @@ which is not available during bootstrap."
(string>? (micro-version) "7") (string>? (micro-version) "7")
(string>? (version) "2.0.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) (let*-values (((connection)
(open-connection-for-uri uri)) (open-connection-for-uri uri))
((resp bv-or-port) ((resp bv-or-port)
@ -210,11 +216,14 @@ which is not available during bootstrap."
;; version. So keep this compatibility hack for now. ;; version. So keep this compatibility hack for now.
(if post-2.0.7? (if post-2.0.7?
(http-get uri #:port connection #:decode-body? #f (http-get uri #:port connection #:decode-body? #f
#:streaming? #t) #:streaming? #t
#:headers headers)
(if (module-defined? (resolve-interface '(web client)) (if (module-defined? (resolve-interface '(web client))
'http-get*) '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) ((code)
(response-code resp)) (response-code resp))
((size) ((size)