diff options
| -rw-r--r-- | guix/http-client.scm | 26 | ||||
| -rw-r--r-- | guix/import/github.scm | 1 |
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) |