ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 22:08:16 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

git: Add ssh authentication support.

Browse source 
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.
This commit is contained in:
Mathieu Othacehe 2020-02-03 18:05:02 +01:00
parent 8d9317e1f0
commit c357474994
No known key found for this signature in database
GPG key ID: 8354763531769CA6
1 changed files with 19 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
guix/git.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -108,6 +108,10 @@ (define* (url-cache-directory url
(string-append "R:" url) (string-append "R:" url)
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) (define (clone* url directory)
"Clone git repository at URL into DIRECTORY. Upon failure, "Clone git repository at URL into DIRECTORY. Upon failure,
make sure no empty directory is left behind." make sure no empty directory is left behind."
@ -119,7 +123,13 @@ (define (clone* url directory)
;; value in Guile-Git: <https://bugs.gnu.org/29238>. ;; value in Guile-Git: <https://bugs.gnu.org/29238>.
(if (module-defined? (resolve-interface '(git)) (if (module-defined? (resolve-interface '(git))
'clone-init-options) '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))) (clone url directory)))
(lambda _ (lambda _
(false-if-exception (rmdir directory))))) (false-if-exception (rmdir directory)))))
@ -276,12 +286,17 @@ (define canonical-ref
(with-libgit2 (with-libgit2
(let* ((cache-exists? (openable-repository? cache-directory)) (let* ((cache-exists? (openable-repository? cache-directory))
(repository (if cache-exists? (repository (if cache-exists?
(repository-open cache-directory) (repository-open (pk cache-directory))
(clone* url cache-directory)))) (clone* url cache-directory))))
;; Only fetch remote if it has not been cloned just before. ;; Only fetch remote if it has not been cloned just before.
(when (and cache-exists? (when (and cache-exists?
(not (reference-available? repository ref))) (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? (when recursive?
(update-submodules repository #:log-port log-port)) (update-submodules repository #:log-port log-port))
(let ((oid (switch-to-ref repository canonical-ref))) (let ((oid (switch-to-ref repository canonical-ref)))