diff options
Diffstat (limited to 'guix/build')
| -rw-r--r-- | guix/build/download.scm | 14 | ||||
| -rw-r--r-- | guix/build/svn.scm | 21 |
2 files changed, 26 insertions, 9 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/build/svn.scm b/guix/build/svn.scm index 74fe084da5..31c30edaf5 100644 --- a/guix/build/svn.scm +++ b/guix/build/svn.scm @@ -29,15 +29,22 @@ ;;; Code: (define* (svn-fetch url revision directory - #:key (svn-command "svn")) + #:key (svn-command "svn") + (user-name #f) + (password #f)) "Fetch REVISION from URL into DIRECTORY. REVISION must be an integer, and a valid Subversion revision. Return #t on success, #f otherwise." - (and (zero? (system* svn-command "checkout" "--non-interactive" - ;; Trust the server certificate. This is OK as we - ;; verify the checksum later. This can be removed when - ;; ca-certificates package is added. - "--trust-server-cert" "-r" (number->string revision) - url directory)) + (and (zero? (apply system* svn-command + "checkout" "--non-interactive" + ;; Trust the server certificate. This is OK as we + ;; verify the checksum later. This can be removed when + ;; ca-certificates package is added. + "--trust-server-cert" "-r" (number->string revision) + `(,@(if (and user-name password) + (list (string-append "--username=" user-name) + (string-append "--password=" password)) + '()) + ,url ,directory))) (with-directory-excursion directory (begin ;; The contents of '.svn' vary as a function of the current status |