summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-10-12 21:47:14 +0200
committerLudovic Courtès <ludo@gnu.org>2020-10-22 17:10:25 +0200
commit59bb1ae3a9aeae75a75b20090253613a7a8800d8 (patch)
tree8b7d4c08e53cf219d8e1e98f641dd052fadc6662
parent830ea72799f988b0fb334f9833f37ef147f7ca2c (diff)
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.
-rw-r--r--configure.ac5
-rw-r--r--doc/guix.texi4
-rw-r--r--guix/git.scm86
-rw-r--r--m4/guix.m422
4 files changed, 53 insertions, 64 deletions
diff --git a/configure.ac b/configure.ac
index 6861112eafa..6e718afdd1c 100644
--- a/configure.ac
+++ b/configure.ac
@@ -144,6 +144,11 @@ if test "x$guix_cv_have_recent_guile_gcrypt" != "xyes"; then
144 AC_MSG_ERROR([A recent Guile-Gcrypt could not be found; please install it.]) 144 AC_MSG_ERROR([A recent Guile-Gcrypt could not be found; please install it.])
145fi 145fi
146 146
147GUIX_CHECK_GUILE_GIT
148if test "x$guix_cv_have_recent_guile_git" != "xyes"; then
149 AC_MSG_ERROR([A recent Guile-Git could not be found; please install it.])
150fi
151
147dnl Check for Guile-zlib. 152dnl Check for Guile-zlib.
148GUILE_MODULE_AVAILABLE([have_guile_zlib], [(zlib)]) 153GUILE_MODULE_AVAILABLE([have_guile_zlib], [(zlib)])
149if test "x$have_guile_zlib" != "xyes"; then 154if test "x$have_guile_zlib" != "xyes"; then
diff --git a/doc/guix.texi b/doc/guix.texi
index fa6251e8e1b..b5061877e2b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -826,8 +826,8 @@ or later;
826@item @uref{https://notabug.org/guile-lzlib/guile-lzlib, Guile-lzlib}; 826@item @uref{https://notabug.org/guile-lzlib/guile-lzlib, Guile-lzlib};
827@item 827@item
828@c FIXME: Specify a version number once a release has been made. 828@c FIXME: Specify a version number once a release has been made.
829@uref{https://gitlab.com/guile-git/guile-git, Guile-Git}, from August 829@uref{https://gitlab.com/guile-git/guile-git, Guile-Git}, version 0.3.0
8302017 or later; 830or later;
831@item @uref{https://savannah.nongnu.org/projects/guile-json/, Guile-JSON} 831@item @uref{https://savannah.nongnu.org/projects/guile-json/, Guile-JSON}
8324.3.0 or later; 8324.3.0 or later;
833@item @url{https://www.gnu.org/software/make/, GNU Make}. 833@item @url{https://www.gnu.org/software/make/, GNU Make}.
diff --git a/guix/git.scm b/guix/git.scm
index 637936c16a3..cfb8d626f5e 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -20,6 +20,7 @@
20(define-module (guix git) 20(define-module (guix git)
21 #:use-module (git) 21 #:use-module (git)
22 #:use-module (git object) 22 #:use-module (git object)
23 #:use-module (git submodule)
23 #:use-module (guix i18n) 24 #:use-module (guix i18n)
24 #:use-module (guix base32) 25 #:use-module (guix base32)
25 #:use-module (gcrypt hash) 26 #:use-module (gcrypt hash)
@@ -116,10 +117,6 @@ the 'SSL_CERT_FILE' and 'SSL_CERT_DIR' environment variables."
116 (string-append "R:" url) 117 (string-append "R:" url)
117 url)))))) 118 url))))))
118 119
119;; Authentication appeared in Guile-Git 0.3.0, check if it is available.
120(define auth-supported?
121 (false-if-exception (resolve-interface '(git auth))))
122
123(define (clone* url directory) 120(define (clone* url directory)
124 "Clone git repository at URL into DIRECTORY. Upon failure, 121 "Clone git repository at URL into DIRECTORY. Upon failure,
125make sure no empty directory is left behind." 122make sure no empty directory is left behind."
@@ -127,18 +124,10 @@ make sure no empty directory is left behind."
127 (lambda () 124 (lambda ()
128 (mkdir-p directory) 125 (mkdir-p directory)
129 126
130 ;; Note: Explicitly pass options to work around the invalid default 127 (let ((auth-method (%make-auth-ssh-agent)))
131 ;; value in Guile-Git: <https://bugs.gnu.org/29238>. 128 (clone url directory
132 (if (module-defined? (resolve-interface '(git)) 129 (make-clone-options
133 'clone-init-options) 130 #:fetch-options (make-fetch-options auth-method)))))
134 (let ((auth-method (and auth-supported?
135 (%make-auth-ssh-agent))))
136 (clone url directory
137 (if auth-supported?
138 (make-clone-options
139 #:fetch-options (make-fetch-options auth-method))
140 (clone-init-options))))
141 (clone url directory)))
142 (lambda _ 131 (lambda _
143 (false-if-exception (rmdir directory))))) 132 (false-if-exception (rmdir directory)))))
144 133
@@ -167,12 +156,7 @@ corresponding Git object."
167 ;; read out-of-bounds when passed a string shorter than 40 chars, 156 ;; read out-of-bounds when passed a string shorter than 40 chars,
168 ;; which is why we delay calls to it below. 157 ;; which is why we delay calls to it below.
169 (if (< len 40) 158 (if (< len 40)
170 (if (module-defined? (resolve-interface '(git object)) 159 (object-lookup-prefix repository (string->oid commit) len)
171 'object-lookup-prefix)
172 (object-lookup-prefix repository (string->oid commit) len)
173 (raise (condition
174 (&message
175 (message "long Git object ID is required")))))
176 (object-lookup repository (string->oid commit))))) 160 (object-lookup repository (string->oid commit)))))
177 (('tag-or-commit . str) 161 (('tag-or-commit . str)
178 (if (or (> (string-length str) 40) 162 (if (or (> (string-length str) 40)
@@ -234,40 +218,23 @@ dynamic extent of EXP."
234 (lambda (key err) 218 (lambda (key err)
235 (report-git-error err)))) 219 (report-git-error err))))
236 220
237(define (load-git-submodules)
238 "Attempt to load (git submodules), which was missing until Guile-Git 0.2.0.
239Return true on success, false on failure."
240 (match (false-if-exception (resolve-interface '(git submodule)))
241 (#f
242 (set! load-git-submodules (const #f))
243 #f)
244 (iface
245 (module-use! (resolve-module '(guix git)) iface)
246 (set! load-git-submodules (const #t))
247 #t)))
248
249(define* (update-submodules repository 221(define* (update-submodules repository
250 #:key (log-port (current-error-port))) 222 #:key (log-port (current-error-port)))
251 "Update the submodules of REPOSITORY, a Git repository object." 223 "Update the submodules of REPOSITORY, a Git repository object."
252 ;; Guile-Git < 0.2.0 did not have (git submodule). 224 (for-each (lambda (name)
253 (if (load-git-submodules) 225 (let ((submodule (submodule-lookup repository name)))
254 (for-each (lambda (name) 226 (format log-port (G_ "updating submodule '~a'...~%")
255 (let ((submodule (submodule-lookup repository name))) 227 name)
256 (format log-port (G_ "updating submodule '~a'...~%") 228 (submodule-update submodule)
257 name) 229
258 (submodule-update submodule) 230 ;; Recurse in SUBMODULE.
259 231 (let ((directory (string-append
260 ;; Recurse in SUBMODULE. 232 (repository-working-directory repository)
261 (let ((directory (string-append 233 "/" (submodule-path submodule))))
262 (repository-working-directory repository) 234 (with-repository directory repository
263 "/" (submodule-path submodule)))) 235 (update-submodules repository
264 (with-repository directory repository 236 #:log-port log-port)))))
265 (update-submodules repository 237 (repository-submodules repository)))
266 #:log-port log-port)))))
267 (repository-submodules repository))
268 (format (current-error-port)
269 (G_ "Support for submodules is missing; \
270please upgrade Guile-Git.~%"))))
271 238
272(define-syntax-rule (false-if-git-not-found exp) 239(define-syntax-rule (false-if-git-not-found exp)
273 "Evaluate EXP, returning #false if a GIT_ENOTFOUND error is raised." 240 "Evaluate EXP, returning #false if a GIT_ENOTFOUND error is raised."
@@ -331,12 +298,9 @@ it unchanged."
331 ;; Only fetch remote if it has not been cloned just before. 298 ;; Only fetch remote if it has not been cloned just before.
332 (when (and cache-exists? 299 (when (and cache-exists?
333 (not (reference-available? repository ref))) 300 (not (reference-available? repository ref)))
334 (if auth-supported? 301 (let ((auth-method (%make-auth-ssh-agent)))
335 (let ((auth-method (and auth-supported? 302 (remote-fetch (remote-lookup repository "origin")
336 (%make-auth-ssh-agent)))) 303 #:fetch-options (make-fetch-options auth-method))))
337 (remote-fetch (remote-lookup repository "origin")
338 #:fetch-options (make-fetch-options auth-method)))
339 (remote-fetch (remote-lookup repository "origin"))))
340 (when recursive? 304 (when recursive?
341 (update-submodules repository #:log-port log-port)) 305 (update-submodules repository #:log-port log-port))
342 306
@@ -359,9 +323,7 @@ it unchanged."
359 323
360 ;; Reclaim file descriptors and memory mappings associated with 324 ;; Reclaim file descriptors and memory mappings associated with
361 ;; REPOSITORY as soon as possible. 325 ;; REPOSITORY as soon as possible.
362 (when (module-defined? (resolve-interface '(git repository)) 326 (repository-close! repository)
363 'repository-close!)
364 (repository-close! repository))
365 327
366 (values cache-directory (oid->string oid) relation))))) 328 (values cache-directory (oid->string oid) relation)))))
367 329
diff --git a/m4/guix.m4 b/m4/guix.m4
index 2fcc65e039c..4fa7cdf7374 100644
--- a/m4/guix.m4
+++ b/m4/guix.m4
@@ -204,6 +204,28 @@ AC_DEFUN([GUIX_CHECK_GUILE_GCRYPT], [
204 fi]) 204 fi])
205]) 205])
206 206
207dnl GUIX_CHECK_GUILE_GIT
208dnl
209dnl Check whether a recent-enough Guile-Git is available.
210AC_DEFUN([GUIX_CHECK_GUILE_GIT], [
211 dnl Check whether we're using Guile-Git 0.3.0 or later. 0.3.0
212 dnl introduced SSH authentication support and more.
213 AC_CACHE_CHECK([whether Guile-Git is available and recent enough],
214 [guix_cv_have_recent_guile_git],
215 [GUILE_CHECK([retval],
216 [(use-modules (git) (git auth) (git submodule))
217 (let ((auth (%make-auth-ssh-agent)))
218 repository-close!
219 object-lookup-prefix
220 (make-clone-options
221 #:fetch-options (make-fetch-options auth)))])
222 if test "$retval" = 0; then
223 guix_cv_have_recent_guile_git="yes"
224 else
225 guix_cv_have_recent_guile_git="no"
226 fi])
227])
228
207dnl GUIX_TEST_ROOT_DIRECTORY 229dnl GUIX_TEST_ROOT_DIRECTORY
208AC_DEFUN([GUIX_TEST_ROOT_DIRECTORY], [ 230AC_DEFUN([GUIX_TEST_ROOT_DIRECTORY], [
209 AC_CACHE_CHECK([for unit test root directory], 231 AC_CACHE_CHECK([for unit test root directory],