http-client: Provide 'User-Agent' header by default.

* guix/http-client.scm (http-fetch): Add #:headers parameter and honor
it.  Rename 'auth-header' to 'headers'.
* guix/import/github.scm (json-fetch*): Add comment about required
User-Agent.

2 files changed, 15 insertions, 12 deletions

diff --git a/guix/http-client.scm b/guix/http-client.scm
index 0090783524..78d39a0208 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2012, 2015 Free Software Foundation, Inc.
 ;;;
@@ -223,13 +223,14 @@ or if EOF is reached."
                 'shutdown (const #f))
 
 (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
-                     keep-alive? (verify-certificate? #t))
+                     keep-alive? (verify-certificate? #t)
+                     (headers '((user-agent . "GNU Guile"))))
   "Return an input port containing the data at URI, and the expected number of
 bytes available or #f.  If TEXT? is true, the data at URI is considered to be
 textual.  Follow any HTTP redirection.  When BUFFERED? is #f, return an
 unbuffered port, suitable for use in `filtered-port'.  When KEEP-ALIVE? is
 true, send a 'Connection: keep-alive' HTTP header, in which case PORT may be
-reused for future HTTP requests.
+reused for future HTTP requests.  HEADERS is an alist of extra HTTP headers.
 
 When VERIFY-CERTIFICATE? is true, verify HTTPS server certificates.
 
@@ -240,13 +241,14 @@ Raise an '&http-get-error' condition if downloading fails."
     (let ((port (or port (open-connection-for-uri uri
                                                   #:verify-certificate?
                                                   verify-certificate?)))
-          (auth-header (match (uri-userinfo uri)
-                         ((? string? str)
-                          (list (cons 'Authorization
-                                      (string-append "Basic "
-                                                     (base64-encode
-                                                      (string->utf8 str))))))
-                         (_ '()))))
+          (headers (match (uri-userinfo uri)
+                     ((? string? str)
+                      (cons (cons 'Authorization
+                                  (string-append "Basic "
+                                                 (base64-encode
+                                                  (string->utf8 str))))
+                            headers))
+                     (_ headers))))
       (unless (or buffered? (not (file-port? port)))
         (setvbuf port _IONBF))
       (let*-values (((resp data)
@@ -254,10 +256,10 @@ Raise an '&http-get-error' condition if downloading fails."
                      (if (guile-version>? "2.0.7")
                          (http-get uri #:streaming? #t #:port port
                                    #:keep-alive? #t
-                                   #:headers auth-header) ; 2.0.9+
+                                   #:headers headers)        ; 2.0.9+
                          (http-get* uri #:decode-body? text?        ; 2.0.7
                                     #:keep-alive? #t
-                                    #:port port #:headers auth-header)))
+                                    #:port port #:headers headers)))
                     ((code)
                      (response-code resp)))
         (case code
diff --git a/guix/import/github.scm b/guix/import/github.scm
index a41511aff6..df5a6b0e08 100644
--- a/guix/import/github.scm
+++ b/guix/import/github.scm
@@ -36,6 +36,7 @@
   (guard (c ((and (http-get-error? c)
                   (= 404 (http-get-error-code c)))
              #f))                       ;"expected" if package is unknown
+    ;; Note: github.com returns 403 if we omit a 'User-Agent' header.
     (let* ((port   (http-fetch url))
            (result (json->scm port)))
       (close-port port)