diff options
| author | David Thompson <davet@gnu.org> | 2016-06-28 09:36:34 -0400 |
|---|---|---|
| committer | David Thompson <davet@gnu.org> | 2016-06-29 08:51:41 -0400 |
| commit | 242ad41c0129eabfdc6678ae9eebd1c887ece55e (patch) | |
| tree | 02b31b395b32fb98c1b06e7e37848055d0bde1e3 | |
| parent | 8dec2229a2ac97e2bf340e9b7ddefdbf60dbb95d (diff) | |
| download | patches-242ad41c0129eabfdc6678ae9eebd1c887ece55e.tar patches-242ad41c0129eabfdc6678ae9eebd1c887ece55e.tar.gz | |
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.
| -rw-r--r-- | guix/build/download.scm | 14 | ||||
| -rw-r--r-- | 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 |