diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2020-10-12 21:47:14 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2020-10-22 17:10:25 +0200 |
| commit | 59bb1ae3a9aeae75a75b20090253613a7a8800d8 (patch) | |
| tree | 8b7d4c08e53cf219d8e1e98f641dd052fadc6662 | |
| parent | 830ea72799f988b0fb334f9833f37ef147f7ca2c (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.ac | 5 | ||||
| -rw-r--r-- | doc/guix.texi | 4 | ||||
| -rw-r--r-- | guix/git.scm | 86 | ||||
| -rw-r--r-- | m4/guix.m4 | 22 |
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.]) |
| 145 | fi | 145 | fi |
| 146 | 146 | ||
| 147 | GUIX_CHECK_GUILE_GIT | ||
| 148 | if 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.]) | ||
| 150 | fi | ||
| 151 | |||
| 147 | dnl Check for Guile-zlib. | 152 | dnl Check for Guile-zlib. |
| 148 | GUILE_MODULE_AVAILABLE([have_guile_zlib], [(zlib)]) | 153 | GUILE_MODULE_AVAILABLE([have_guile_zlib], [(zlib)]) |
| 149 | if test "x$have_guile_zlib" != "xyes"; then | 154 | if 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 |
| 830 | 2017 or later; | 830 | or 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} |
| 832 | 4.3.0 or later; | 832 | 4.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, |
| 125 | make sure no empty directory is left behind." | 122 | make 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. | ||
| 239 | Return 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; \ | ||
| 270 | please 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 | ||
| 207 | dnl GUIX_CHECK_GUILE_GIT | ||
| 208 | dnl | ||
| 209 | dnl Check whether a recent-enough Guile-Git is available. | ||
| 210 | AC_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 | |||
| 207 | dnl GUIX_TEST_ROOT_DIRECTORY | 229 | dnl GUIX_TEST_ROOT_DIRECTORY |
| 208 | AC_DEFUN([GUIX_TEST_ROOT_DIRECTORY], [ | 230 | AC_DEFUN([GUIX_TEST_ROOT_DIRECTORY], [ |
| 209 | AC_CACHE_CHECK([for unit test root directory], | 231 | AC_CACHE_CHECK([for unit test root directory], |
