mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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.
This commit is contained in:
parent
4cd5ec801b
commit
608a50b66c
2 changed files with 15 additions and 12 deletions
|
@ -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 @@ (define (read-header-line port)
|
|||
'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 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
|
|||
(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 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t)
|
|||
(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
|
||||
|
|
|
@ -36,6 +36,7 @@ (define (json-fetch* url)
|
|||
(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)
|
||||
|
|
Loading…
Reference in a new issue