Skip to content
Snippets Groups Projects
Unverified Commit a78dcb3d authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

git: 'update-cached-checkout' avoids network access when unnecessary.

* guix/git.scm (reference-available?): New procedure.
(update-cached-checkout): Avoid call to 'remote-fetch' when REPOSITORY
already contains REF.
parent 961b95c9
No related branches found
No related tags found
No related merge requests found
...@@ -220,6 +220,21 @@ (define* (update-submodules repository ...@@ -220,6 +220,21 @@ (define* (update-submodules repository
(G_ "Support for submodules is missing; \ (G_ "Support for submodules is missing; \
please upgrade Guile-Git.~%")))) please upgrade Guile-Git.~%"))))
(define (reference-available? repository ref)
"Return true if REF, a reference such as '(commit . \"cabba9e\"), is
definitely available in REPOSITORY, false otherwise."
(match ref
(('commit . commit)
(catch 'git-error
(lambda ()
(->bool (commit-lookup repository (string->oid commit))))
(lambda (key error . rest)
(if (= GIT_ENOTFOUND (git-error-code error))
#f
(apply throw key error rest)))))
(_
#f)))
(define* (update-cached-checkout url (define* (update-cached-checkout url
#:key #:key
(ref '(branch . "master")) (ref '(branch . "master"))
...@@ -254,7 +269,8 @@ (define canonical-ref ...@@ -254,7 +269,8 @@ (define canonical-ref
(repository-open cache-directory) (repository-open 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 cache-exists? (when (and cache-exists?
(not (reference-available? repository ref)))
(remote-fetch (remote-lookup repository "origin"))) (remote-fetch (remote-lookup repository "origin")))
(when recursive? (when recursive?
(update-submodules repository #:log-port log-port)) (update-submodules repository #:log-port log-port))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment