From 9a4385353dac7cf74c4950921bbf6f8ecc06d92a Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Wed, 16 Dec 2015 11:12:46 +0100 Subject: [PATCH] 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(-) diff --git a/guix/http-client.scm b/guix/http-client.scm index eb2c3f4..1feb428 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) @@ -213,12 +214,20 @@ Raise an '&http-get-error' condition if downloading fails." (let ((port (or port (open-connection-for-uri uri)))) (unless buffered? (setvbuf port _IONBF)) - (let*-values (((resp data) + (let*-values ((auth-header + (match (uri-userinfo uri) + ((str) (cons 'Authorization + (string-append "Basic " + (base64-encode + (string->utf8 str))))) + (_ '()))) + ((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 -- 2.1.0