From 0cb5bc2cffbc176afa55a116730f81f5afc2dde5 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 16 Dec 2015 11:12:46 +0100 Subject: http-client: Support basic authentication. * guix/http-client.scm (http-fetch): Add Authorization header to request when the URI contains userinfo. --- guix/http-client.scm | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) (limited to 'guix/http-client.scm') 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 -- cgit v1.2.3