me
/
guix
Archived
1
0
Fork 0

git: Require Guile-Git 0.3.0 or later.

* guix/git.scm (auth-supported?): Remove.
(clone*): Inline code that was dependent on AUTH-SUPPORTED?.
(update-cached-checkout): Likewise.
(resolve-reference): Remove check for 'object-lookup-prefix' and use it
unconditionally.
(load-git-submodules): Remove.
(update-submodules): Use 'repository-submodules', 'submodule-lookup',
etc. unconditionally.
(update-cached-checkout): Use 'repository-close!' unconditionally.
* m4/guix.m4 (GUIX_CHECK_GUILE_GIT): New macro.
* configure.ac: Use it and error out when it fails.
* doc/guix.texi (Requirements): Bump to Guile-Git 0.3.0.
master
Ludovic Courtès 2020-10-12 21:47:14 +02:00
parent 830ea72799
commit 59bb1ae3a9
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 52 additions and 63 deletions

View File

@ -144,6 +144,11 @@ if test "x$guix_cv_have_recent_guile_gcrypt" != "xyes"; then
AC_MSG_ERROR([A recent Guile-Gcrypt could not be found; please install it.]) AC_MSG_ERROR([A recent Guile-Gcrypt could not be found; please install it.])
fi fi
GUIX_CHECK_GUILE_GIT
if test "x$guix_cv_have_recent_guile_git" != "xyes"; then
AC_MSG_ERROR([A recent Guile-Git could not be found; please install it.])
fi
dnl Check for Guile-zlib. dnl Check for Guile-zlib.
GUILE_MODULE_AVAILABLE([have_guile_zlib], [(zlib)]) GUILE_MODULE_AVAILABLE([have_guile_zlib], [(zlib)])
if test "x$have_guile_zlib" != "xyes"; then if test "x$have_guile_zlib" != "xyes"; then

View File

@ -826,8 +826,8 @@ or later;
@item @uref{https://notabug.org/guile-lzlib/guile-lzlib, Guile-lzlib}; @item @uref{https://notabug.org/guile-lzlib/guile-lzlib, Guile-lzlib};
@item @item
@c FIXME: Specify a version number once a release has been made. @c FIXME: Specify a version number once a release has been made.
@uref{https://gitlab.com/guile-git/guile-git, Guile-Git}, from August @uref{https://gitlab.com/guile-git/guile-git, Guile-Git}, version 0.3.0
2017 or later; or later;
@item @uref{https://savannah.nongnu.org/projects/guile-json/, Guile-JSON} @item @uref{https://savannah.nongnu.org/projects/guile-json/, Guile-JSON}
4.3.0 or later; 4.3.0 or later;
@item @url{https://www.gnu.org/software/make/, GNU Make}. @item @url{https://www.gnu.org/software/make/, GNU Make}.

View File

@ -20,6 +20,7 @@
(define-module (guix git) (define-module (guix git)
#:use-module (git) #:use-module (git)
#:use-module (git object) #:use-module (git object)
#:use-module (git submodule)
#:use-module (guix i18n) #:use-module (guix i18n)
#:use-module (guix base32) #:use-module (guix base32)
#:use-module (gcrypt hash) #:use-module (gcrypt hash)
@ -116,10 +117,6 @@ the 'SSL_CERT_FILE' and 'SSL_CERT_DIR' environment variables."
(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."
@ -127,18 +124,10 @@ make sure no empty directory is left behind."
(lambda () (lambda ()
(mkdir-p directory) (mkdir-p directory)
;; Note: Explicitly pass options to work around the invalid default (let ((auth-method (%make-auth-ssh-agent)))
;; value in Guile-Git: <https://bugs.gnu.org/29238>. (clone url directory
(if (module-defined? (resolve-interface '(git)) (make-clone-options
'clone-init-options) #:fetch-options (make-fetch-options auth-method)))))
(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 _ (lambda _
(false-if-exception (rmdir directory))))) (false-if-exception (rmdir directory)))))
@ -167,12 +156,7 @@ corresponding Git object."
;; read out-of-bounds when passed a string shorter than 40 chars, ;; read out-of-bounds when passed a string shorter than 40 chars,
;; which is why we delay calls to it below. ;; which is why we delay calls to it below.
(if (< len 40) (if (< len 40)
(if (module-defined? (resolve-interface '(git object)) (object-lookup-prefix repository (string->oid commit) len)
'object-lookup-prefix)
(object-lookup-prefix repository (string->oid commit) len)
(raise (condition
(&message
(message "long Git object ID is required")))))
(object-lookup repository (string->oid commit))))) (object-lookup repository (string->oid commit)))))
(('tag-or-commit . str) (('tag-or-commit . str)
(if (or (> (string-length str) 40) (if (or (> (string-length str) 40)
@ -234,40 +218,23 @@ dynamic extent of EXP."
(lambda (key err) (lambda (key err)
(report-git-error err)))) (report-git-error err))))
(define (load-git-submodules)
"Attempt to load (git submodules), which was missing until Guile-Git 0.2.0.
Return true on success, false on failure."
(match (false-if-exception (resolve-interface '(git submodule)))
(#f
(set! load-git-submodules (const #f))
#f)
(iface
(module-use! (resolve-module '(guix git)) iface)
(set! load-git-submodules (const #t))
#t)))
(define* (update-submodules repository (define* (update-submodules repository
#:key (log-port (current-error-port))) #:key (log-port (current-error-port)))
"Update the submodules of REPOSITORY, a Git repository object." "Update the submodules of REPOSITORY, a Git repository object."
;; Guile-Git < 0.2.0 did not have (git submodule). (for-each (lambda (name)
(if (load-git-submodules) (let ((submodule (submodule-lookup repository name)))
(for-each (lambda (name) (format log-port (G_ "updating submodule '~a'...~%")
(let ((submodule (submodule-lookup repository name))) name)
(format log-port (G_ "updating submodule '~a'...~%") (submodule-update submodule)
name)
(submodule-update submodule)
;; Recurse in SUBMODULE. ;; Recurse in SUBMODULE.
(let ((directory (string-append (let ((directory (string-append
(repository-working-directory repository) (repository-working-directory repository)
"/" (submodule-path submodule)))) "/" (submodule-path submodule))))
(with-repository directory repository (with-repository directory repository
(update-submodules repository (update-submodules repository
#:log-port log-port))))) #:log-port log-port)))))
(repository-submodules repository)) (repository-submodules repository)))
(format (current-error-port)
(G_ "Support for submodules is missing; \
please upgrade Guile-Git.~%"))))
(define-syntax-rule (false-if-git-not-found exp) (define-syntax-rule (false-if-git-not-found exp)
"Evaluate EXP, returning #false if a GIT_ENOTFOUND error is raised." "Evaluate EXP, returning #false if a GIT_ENOTFOUND error is raised."
@ -331,12 +298,9 @@ it unchanged."
;; 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)))
(if auth-supported? (let ((auth-method (%make-auth-ssh-agent)))
(let ((auth-method (and auth-supported? (remote-fetch (remote-lookup repository "origin")
(%make-auth-ssh-agent)))) #:fetch-options (make-fetch-options auth-method))))
(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))
@ -359,9 +323,7 @@ it unchanged."
;; Reclaim file descriptors and memory mappings associated with ;; Reclaim file descriptors and memory mappings associated with
;; REPOSITORY as soon as possible. ;; REPOSITORY as soon as possible.
(when (module-defined? (resolve-interface '(git repository)) (repository-close! repository)
'repository-close!)
(repository-close! repository))
(values cache-directory (oid->string oid) relation))))) (values cache-directory (oid->string oid) relation)))))

View File

@ -204,6 +204,28 @@ AC_DEFUN([GUIX_CHECK_GUILE_GCRYPT], [
fi]) fi])
]) ])
dnl GUIX_CHECK_GUILE_GIT
dnl
dnl Check whether a recent-enough Guile-Git is available.
AC_DEFUN([GUIX_CHECK_GUILE_GIT], [
dnl Check whether we're using Guile-Git 0.3.0 or later. 0.3.0
dnl introduced SSH authentication support and more.
AC_CACHE_CHECK([whether Guile-Git is available and recent enough],
[guix_cv_have_recent_guile_git],
[GUILE_CHECK([retval],
[(use-modules (git) (git auth) (git submodule))
(let ((auth (%make-auth-ssh-agent)))
repository-close!
object-lookup-prefix
(make-clone-options
#:fetch-options (make-fetch-options auth)))])
if test "$retval" = 0; then
guix_cv_have_recent_guile_git="yes"
else
guix_cv_have_recent_guile_git="no"
fi])
])
dnl GUIX_TEST_ROOT_DIRECTORY dnl GUIX_TEST_ROOT_DIRECTORY
AC_DEFUN([GUIX_TEST_ROOT_DIRECTORY], [ AC_DEFUN([GUIX_TEST_ROOT_DIRECTORY], [
AC_CACHE_CHECK([for unit test root directory], AC_CACHE_CHECK([for unit test root directory],