summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorRicardo Wurmus <ricardo.wurmus@mdc-berlin.de>2015-12-16 11:12:46 +0100
committerRicardo Wurmus <ricardo.wurmus@mdc-berlin.de>2015-12-21 15:24:44 +0100
commit0cb5bc2cffbc176afa55a116730f81f5afc2dde5 (patch)
treea2b56d0a839642fa912dd4e31cb4de164a0d57a2 /guix
parent086e498bcfc82e7ed1572179282d25fcd7058d8d (diff)
http-client: Support basic authentication.
* guix/http-client.scm (http-fetch): Add Authorization header to request when the URI contains userinfo.
Diffstat (limited to 'guix')
-rw-r--r--guix/http-client.scm15
1 files changed, 12 insertions, 3 deletions
diff --git a/guix/http-client.scm b/guix/http-client.scm
index eb2c3f4d5f..c7cbc82aac 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -32,6 +32,7 @@
#: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 @@ Raise an '&http-get-error' condition if downloading fails."
(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