diff options
| author | Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de> | 2015-12-16 11:12:46 +0100 |
|---|---|---|
| committer | Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de> | 2015-12-21 15:24:44 +0100 |
| commit | 0cb5bc2cffbc176afa55a116730f81f5afc2dde5 (patch) | |
| tree | a2b56d0a839642fa912dd4e31cb4de164a0d57a2 /guix | |
| parent | 086e498bcfc82e7ed1572179282d25fcd7058d8d (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.scm | 15 |
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 |