ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-26 06:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

http-client: Support basic authentication.

Browse source 
* guix/http-client.scm (http-fetch): Add Authorization header to request
  when the URI contains userinfo.
This commit is contained in:
Ricardo Wurmus 2015-12-16 11:12:46 +01:00
parent 086e498bcf
commit 0cb5bc2cff
1 changed files with 12 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
guix/http-client.scm
View file

@ -32,6 +32,7 @@ (define-module (guix http-client)
#:use-module (rnrs bytevectors)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix base64)
#:use-module ((guix build utils)
#:select (mkdir-p dump-port))
#:use-module ((guix build download)
@ -210,15 +211,23 @@ (define* (http-fetch uri #:key port (text? #f) (buffered? #t))
(let loop ((uri (if (string? uri)
(string->uri uri)
uri)))
(let ((port (or port (open-connection-for-uri uri))))
(let ((port (or port (open-connection-for-uri uri)))
(auth-header (match (uri-userinfo uri)
((? string? str)
(list (cons 'Authorization
(string-append "Basic "
(base64-encode
(string->utf8 str))))))
(_ '()))))
(unless buffered?
(setvbuf port _IONBF))
(let*-values (((resp data)
;; Try hard to use the API du jour to get an input port.
(if (guile-version>? "2.0.7")
(http-get uri #:streaming? #t #:port port) ; 2.0.9+
(http-get uri #:streaming? #t #:port port
#:headers auth-header) ; 2.0.9+
(http-get* uri #:decode-body? text? ; 2.0.7
#:port port)))
#:port port #:headers auth-header)))
((code)
(response-code resp)))
(case code