summaryrefslogtreecommitdiff
path: root/guix/build
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-07-20 11:42:02 +0200
committerLudovic Courtès <ludo@gnu.org>2016-07-20 11:42:17 +0200
commit7575655212ecfbcd1f04e429c8a7a41f8720d027 (patch)
tree558982d3cf50ef6b19ef293850de1f485fde66a6 /guix/build
parent5d4c90ae02f1e0b42d575bba2d828d63aaf79be5 (diff)
parent5f01078129f4eaa4760a14f22761cf357afb6738 (diff)
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/build')
-rw-r--r--guix/build/download.scm14
-rw-r--r--guix/build/svn.scm21
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