me/guix
Archived
1
0
Fork 0
Code Activity

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

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2017-01-13 18:22:53 +01:00
parent 4cd5ec801b
commit 608a50b66c
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 15 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
guix/http-client.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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 © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2012, 2015 Free Software Foundation, Inc. ;;; Copyright © 2012, 2015 Free Software Foundation, Inc.
;;; ;;;
@ -223,13 +223,14 @@ or if EOF is reached."
'shutdown (const #f)) 'shutdown (const #f))
(define* (http-fetch uri #:key port (text? #f) (buffered? #t) (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 "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 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 textual. Follow any HTTP redirection. When BUFFERED? is #f, return an
unbuffered port, suitable for use in `filtered-port'. When KEEP-ALIVE? is 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 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. 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 (let ((port (or port (open-connection-for-uri uri
#:verify-certificate? #:verify-certificate?
verify-certificate?))) verify-certificate?)))
(auth-header (match (uri-userinfo uri) (headers (match (uri-userinfo uri)
((? string? str) ((? string? str)
(list (cons 'Authorization (cons (cons 'Authorization
(string-append "Basic " (string-append "Basic "
(base64-encode (base64-encode
(string->utf8 str)))))) (string->utf8 str))))
(_ '())))) headers))
(_ headers))))
(unless (or buffered? (not (file-port? port))) (unless (or buffered? (not (file-port? port)))
(setvbuf port _IONBF)) (setvbuf port _IONBF))
(let*-values (((resp data) (let*-values (((resp data)
@ -254,10 +256,10 @@ Raise an '&http-get-error' condition if downloading fails."
(if (guile-version>? "2.0.7") (if (guile-version>? "2.0.7")
(http-get uri #:streaming? #t #:port port (http-get uri #:streaming? #t #:port port
#:keep-alive? #t #:keep-alive? #t
#:headers auth-header) ; 2.0.9+ #:headers headers) ; 2.0.9+
(http-get* uri #:decode-body? text? ; 2.0.7 (http-get* uri #:decode-body? text? ; 2.0.7
#:keep-alive? #t #:keep-alive? #t
#:port port #:headers auth-header))) #:port port #:headers headers)))
((code) ((code)
(response-code resp))) (response-code resp)))
(case code (case code

1
guix/import/github.scm
View file

@ -36,6 +36,7 @@
(guard (c ((and (http-get-error? c) (guard (c ((and (http-get-error? c)
(= 404 (http-get-error-code c))) (= 404 (http-get-error-code c)))
#f)) ;"expected" if package is unknown #f)) ;"expected" if package is unknown
;; Note: github.com returns 403 if we omit a 'User-Agent' header.
(let* ((port (http-fetch url)) (let* ((port (http-fetch url))
(result (json->scm port))) (result (json->scm port)))
(close-port port) (close-port port)