01/01: guix: Support authentication when fetching from SVN.

[Ricardo Wurmus]

rekado pushed a commit to branch master
in repository guix.

commit 140dd8f82c4b513c182a71bbd61a9cfa1360782a
Author: Ricardo Wurmus <address@hidden>
Date:   Thu Jun 30 15:43:23 2016 +0200

    guix: Support authentication when fetching from SVN.
    
    * guix/svn-download.scm (<svn-reference>): Add fields for optional
    credentials.
    (svn-fetch): Pass credentials to build-side "svn-fetch".
    * guix/build/svn.scm (svn-fetch): Pass optional credentials to svn
    command.
---
 guix/build/svn.scm    |   21 ++++++++++++++-------
 guix/svn-download.scm |   10 +++++++---
 2 files changed, 21 insertions(+), 10 deletions(-)

diff --git a/guix/build/svn.scm b/guix/build/svn.scm
index 74fe084..31c30ed 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
diff --git a/guix/svn-download.scm b/guix/svn-download.scm
index d6853ca..dddf648 100644
--- a/guix/svn-download.scm
+++ b/guix/svn-download.scm
@@ -41,8 +41,10 @@
 (define-record-type* <svn-reference>
   svn-reference make-svn-reference
   svn-reference?
-  (url      svn-reference-url)                    ; string
-  (revision svn-reference-revision))              ; number
+  (url       svn-reference-url)                    ; string
+  (revision  svn-reference-revision)               ; number
+  (user-name svn-reference-user-name (default #f))
+  (password  svn-reference-password (default #f)))
 
 (define (subversion-package)
   "Return the default Subversion package."
@@ -62,7 +64,9 @@ HASH-ALGO (a symbol).  Use NAME as the file name, or a 
generic name if #f."
         (svn-fetch '#$(svn-reference-url ref)
                    '#$(svn-reference-revision ref)
                    #$output
-                   #:svn-command (string-append #+svn "/bin/svn"))))
+                   #:svn-command (string-append #+svn "/bin/svn")
+                   #:user-name #$(svn-reference-user-name ref)
+                   #:password #$(svn-reference-password ref))))
 
   (mlet %store-monad ((guile (package->derivation guile system)))
     (gexp->derivation (or name "svn-checkout") build