Subject: [bug#43968] [PATCH 1/3] git: Require Guile-Git 0.3.0 or later.

From: Ludovic Courtès <[email-masked]>
Date: Mon, 12 Oct 2020 23:09:53 +0200

* 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.
---
 configure.ac  |  5 +++
 doc/guix.texi |  4 +--
 guix/git.scm  | 84 ++++++++++++++-------------------------------------
 m4/guix.m4    | 22 ++++++++++++++
 4 files changed, 52 insertions(+), 63 deletions(-)

diff --git a/configure.ac b/configure.ac
index 6861112eaf..6e718afdd1 100644
--- a/configure.ac
+++ b/configure.ac
@@ -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.])
 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.
 GUILE_MODULE_AVAILABLE([have_guile_zlib], [(zlib)])
 if test "x$have_guile_zlib" != "xyes"; then
diff --git a/doc/guix.texi b/doc/guix.texi
index 7150adeaa8..73156e9492 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -809,8 +809,8 @@ or later;
 @item @uref{https://notabug.org/guile-lzlib/guile-lzlib, Guile-lzlib};
 @item
 @c FIXME: Specify a version number once a release has been made.
-@uref{https://gitlab.com/guile-git/guile-git, Guile-Git}, from August
-2017 or later;
+@uref{https://gitlab.com/guile-git/guile-git, Guile-Git}, version 0.3.0
+or later;
 @item @uref{https://savannah.nongnu.org/projects/guile-json/, Guile-JSON}
 4.3.0 or later;
 @item @url{https://www.gnu.org/software/make/, GNU Make}.
diff --git a/guix/git.scm b/guix/git.scm
index 637936c16a..cfb8d626f5 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -20,6 +20,7 @@
 (define-module (guix git)
   #:use-module (git)
   #:use-module (git object)
+  #:use-module (git submodule)
   #:use-module (guix i18n)
   #:use-module (guix base32)
   #:use-module (gcrypt hash)
@@ -116,10 +117,6 @@ 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."
@@ -127,18 +124,10 @@ make sure no empty directory is left behind."
     (lambda ()
       (mkdir-p directory)
 
-      ;; Note: Explicitly pass options to work around the invalid default
-      ;; value in Guile-Git: <https://bugs.gnu.org/29238>.
-      (if (module-defined? (resolve-interface '(git))
-                           '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)))
+      (let ((auth-method (%make-auth-ssh-agent)))
+        (clone url directory
+               (make-clone-options
+                #:fetch-options (make-fetch-options auth-method)))))
     (lambda _
       (false-if-exception (rmdir directory)))))
 
@@ -167,12 +156,7 @@ corresponding Git object."
          ;; read out-of-bounds when passed a string shorter than 40 chars,
          ;; which is why we delay calls to it below.
          (if (< len 40)
-             (if (module-defined? (resolve-interface '(git object))
-                                  'object-lookup-prefix)
-                 (object-lookup-prefix repository (string->oid commit) len)
-                 (raise (condition
-                         (&message
-                          (message "long Git object ID is required")))))
+             (object-lookup-prefix repository (string->oid commit) len)
              (object-lookup repository (string->oid commit)))))
       (('tag-or-commit . str)
        (if (or (> (string-length str) 40)
@@ -234,40 +218,23 @@ dynamic extent of EXP."
     (lambda (key 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
                             #:key (log-port (current-error-port)))
   "Update the submodules of REPOSITORY, a Git repository object."
-  ;; Guile-Git < 0.2.0 did not have (git submodule).
-  (if (load-git-submodules)
-      (for-each (lambda (name)
-                  (let ((submodule (submodule-lookup repository name)))
-                    (format log-port (G_ "updating submodule '~a'...~%")
-                            name)
-                    (submodule-update submodule)
+  (for-each (lambda (name)
+              (let ((submodule (submodule-lookup repository name)))
+                (format log-port (G_ "updating submodule '~a'...~%")
+                        name)
+                (submodule-update submodule)
 
-                    ;; Recurse in SUBMODULE.
-                    (let ((directory (string-append
-                                      (repository-working-directory repository)
-                                      "/" (submodule-path submodule))))
-                      (with-repository directory repository
-                        (update-submodules repository
-                                           #:log-port log-port)))))
-                (repository-submodules repository))
-      (format (current-error-port)
-              (G_ "Support for submodules is missing; \
-please upgrade Guile-Git.~%"))))
+                ;; Recurse in SUBMODULE.
+                (let ((directory (string-append
+                                  (repository-working-directory repository)
+                                  "/" (submodule-path submodule))))
+                  (with-repository directory repository
+                    (update-submodules repository
+                                       #:log-port log-port)))))
+            (repository-submodules repository)))
 
 (define-syntax-rule (false-if-git-not-found exp)
   "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.
      (when (and cache-exists?
                 (not (reference-available? repository ref)))
-       (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"))))
+       (let ((auth-method (%make-auth-ssh-agent)))
+         (remote-fetch (remote-lookup repository "origin")
+                       #:fetch-options (make-fetch-options auth-method))))
      (when recursive?
        (update-submodules repository #:log-port log-port))
 
@@ -359,9 +323,7 @@ it unchanged."
 
        ;; Reclaim file descriptors and memory mappings associated with
        ;; REPOSITORY as soon as possible.
-       (when (module-defined? (resolve-interface '(git repository))
-                              'repository-close!)
-         (repository-close! repository))
+       (repository-close! repository)
 
        (values cache-directory (oid->string oid) relation)))))
 
diff --git a/m4/guix.m4 b/m4/guix.m4
index 2fcc65e039..4fa7cdf737 100644
--- a/m4/guix.m4
+++ b/m4/guix.m4
@@ -204,6 +204,28 @@ AC_DEFUN([GUIX_CHECK_GUILE_GCRYPT], [
      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
 AC_DEFUN([GUIX_TEST_ROOT_DIRECTORY], [
   AC_CACHE_CHECK([for unit test root directory],
-- 
2.28.0