diff options
author | Ludovic Courtès <ludo@gnu.org> | 2016-07-20 11:42:02 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2016-07-20 11:42:17 +0200 |
commit | 7575655212ecfbcd1f04e429c8a7a41f8720d027 (patch) | |
tree | 558982d3cf50ef6b19ef293850de1f485fde66a6 /guix/build/download.scm | |
parent | 5d4c90ae02f1e0b42d575bba2d828d63aaf79be5 (diff) | |
parent | 5f01078129f4eaa4760a14f22761cf357afb6738 (diff) |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/build/download.scm')
-rw-r--r-- | guix/build/download.scm | 14 |
1 files changed, 12 insertions, 2 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)) |