From 242ad41c0129eabfdc6678ae9eebd1c887ece55e Mon Sep 17 00:00:00 2001 From: David Thompson Date: Tue, 28 Jun 2016 09:36:34 -0400 Subject: [PATCH] download: Use basic authentication when userinfo is present in URI. * guix/download.scm (url-fetch): Include (guix base64) module on the build-side. * guix/build/download.scm (http-fetch): Add "Authorization" header when userinfo is present in the URI. --- guix/build/download.scm | 14 ++++++++++++-- guix/download.scm | 3 ++- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/guix/build/download.scm b/guix/build/download.scm index bd011ce878..103e784bb1 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -23,9 +23,11 @@ #:use-module (web http) #:use-module ((web client) #:hide (open-socket-for-uri)) #:use-module (web response) + #:use-module (guix base64) #:use-module (guix ftp-client) #:use-module (guix build utils) #:use-module (rnrs io ports) + #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) @@ -598,14 +600,22 @@ FILE on success." (string>? (version) "2.0.7"))) (define headers - '(;; Some web sites, such as http://dist.schmorp.de, would block you if + `(;; Some web sites, such as http://dist.schmorp.de, would block you if ;; there's no 'User-Agent' header, presumably on the assumption that ;; you're a spammer. So work around that. (User-Agent . "GNU Guile") ;; Some servers, such as https://alioth.debian.org, return "406 Not ;; Acceptable" when not explicitly told that everything is accepted. - (Accept . "*/*"))) + (Accept . "*/*") + + ;; Basic authentication, if needed. + ,@(match (uri-userinfo uri) + ((? string? str) + `((Authorization . ,(string-append "Basic " + (base64-encode + (string->utf8 str)))))) + (_ '())))) (let*-values (((connection) (open-connection-for-uri uri #:timeout timeout)) diff --git a/guix/download.scm b/guix/download.scm index 9b238dcbdf..c3f34f5520 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -328,7 +328,8 @@ in the store." #:modules '((guix build download) (guix build utils) (guix ftp-client) - (guix base32)) + (guix base32) + (guix base64)) ;; Use environment variables and a fixed script ;; name so there's only one script in store for