branch master updated: git: Add ssh authentication support.

[guix-commits]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch master
in repository guix.

The following commit(s) were added to refs/heads/master by this push:
     new c357474  git: Add ssh authentication support.
c357474 is described below

commit c35747499411d4efc7b437d63745a6dbc6910df4
Author: Mathieu Othacehe <address@hidden>
AuthorDate: Mon Feb 3 18:05:02 2020 +0100

    git: Add ssh authentication support.
    
    If Guile-Git revision is >= 0.3.0, use SSH agent authentication method for
    both clone and fetch calls.
    
    * guix/git.scm (auth-supported?): New variable,
    (clone*): set auth-method to ssh-agent if the variable above is true,
    (update-cached-checkout): ditto.
---
 guix/git.scm | 23 +++++++++++++++++++----
 1 file changed, 19 insertions(+), 4 deletions(-)

diff --git a/guix/git.scm b/guix/git.scm
index a12f1ee..341a2b8 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
+;;; Copyright © 2017, 2020 Mathieu Othacehe <address@hidden>
 ;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -108,6 +108,10 @@ the 'SSL_CERT_FILE' and 'SSL_CERT_DIR' environment 
variables."
                               (string-append "R:" url)
                               url))))))
 
+;; Authentication appeared in Guile-Git 0.3.0, check if it is available.
+(define auth-supported?
+  (false-if-exception (resolve-interface '(git auth))))
+
 (define (clone* url directory)
   "Clone git repository at URL into DIRECTORY.  Upon failure,
 make sure no empty directory is left behind."
@@ -119,7 +123,13 @@ make sure no empty directory is left behind."
       ;; value in Guile-Git: <https://bugs.gnu.org/29238>.
       (if (module-defined? (resolve-interface '(git))
                            'clone-init-options)
-          (clone url directory (clone-init-options))
+          (let ((auth-method (and auth-supported?
+                                  (%make-auth-ssh-agent))))
+            (clone url directory
+                   (if auth-supported?
+                       (make-clone-options
+                        #:fetch-options (make-fetch-options auth-method))
+                       (clone-init-options))))
           (clone url directory)))
     (lambda _
       (false-if-exception (rmdir directory)))))
@@ -276,12 +286,17 @@ When RECURSIVE? is true, check out submodules as well, if 
any."
   (with-libgit2
    (let* ((cache-exists? (openable-repository? cache-directory))
           (repository    (if cache-exists?
-                             (repository-open cache-directory)
+                             (repository-open (pk cache-directory))
                              (clone* url cache-directory))))
      ;; Only fetch remote if it has not been cloned just before.
      (when (and cache-exists?
                 (not (reference-available? repository ref)))
-       (remote-fetch (remote-lookup repository "origin")))
+       (if auth-supported?
+           (let ((auth-method (and auth-supported?
+                                   (%make-auth-ssh-agent))))
+             (remote-fetch (remote-lookup repository "origin")
+                           #:fetch-options (make-fetch-options auth-method)))
+           (remote-fetch (remote-lookup repository "origin"))))
      (when recursive?
        (update-submodules repository #:log-port log-port))
      (let ((oid (switch-to-ref repository canonical-ref)))