diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2019-09-14 17:46:34 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2019-09-23 10:38:43 +0200 |
| commit | a78dcb3d599cc84b347578940bb0fd44b1ad50b4 (patch) | |
| tree | bd5164b4611f376c137d99919ad3e79d3ae74815 | |
| parent | 961b95c985991ed4421c2419c22026eb0153c1ba (diff) | |
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.
| -rw-r--r-- | guix/git.scm | 18 |
1 files changed, 17 insertions, 1 deletions
diff --git a/guix/git.scm b/guix/git.scm index de98fed40c..92a7353b5a 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -220,6 +220,21 @@ dynamic extent of EXP." (G_ "Support for submodules is missing; \ 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 #:key (ref '(branch . "master")) @@ -254,7 +269,8 @@ When RECURSIVE? is true, check out submodules as well, if any." (repository-open cache-directory) (clone* url cache-directory)))) ;; 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"))) (when recursive? (update-submodules repository #:log-port log-port)) |