Toggle diff (82 lines)
diff --git a/guix/git.scm b/guix/git.scm
index a5103547d3..467d199e37 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -346,10 +346,7 @@ definitely available in REPOSITORY, false otherwise."
(check-out? #t)
starting-commit
(log-port (%make-void-port "w"))
- (cache-directory
- (url-cache-directory
- url (%repository-cache-directory)
- #:recursive? recursive?)))
+ (cache-directory *unspecified*))
"Update the cached checkout of URL to REF in CACHE-DIRECTORY. Return three
values: the cache directory name, and the SHA1 commit (a string) corresponding
to REF, and the relation of the new commit relative to STARTING-COMMIT (if
@@ -381,12 +378,41 @@ it unchanged."
(string-append "origin/" branch))))
(_ ref)))
+ (define default-cache-directory
+ (url-cache-directory url (%repository-cache-directory)
+ #:recursive? recursive?))
+
+ (when (and (zero? (getuid)) (getenv "SUDO_USER")
+ (unspecified? cache-directory))
+ ;; Fetch from the sudoer's cache before attempting to reach URL.
+ (let* ((home (and=> (false-if-exception (getpwnam (getenv "SUDO_USER")))
+ passwd:dir))
+ (peer (and home (url-cache-directory
+ url (string-append home "/.cache/guix/checkouts")
+ #:recursive? recursive?))))
+ (when (and peer (file-exists? peer))
+ ;; Fetch from PEER. After that, the "origin" remote points to PEER,
+ ;; but we change it back to URL below.
+ (update-cached-checkout (pk 'update peer)
+ #:ref ref
+ #:recursive? recursive?
+ #:check-out? #f
+ #:cache-directory
+ default-cache-directory))))
+
(with-libgit2
- (let* ((cache-exists? (openable-repository? cache-directory))
- (repository (if cache-exists?
- (repository-open cache-directory)
- (clone* url cache-directory))))
+ (let* ((cache-directory (if (unspecified? cache-directory)
+ default-cache-directory
+ cache-directory))
+ (cache-exists? (openable-repository? cache-directory))
+ (repository (if cache-exists?
+ (repository-open cache-directory)
+ (clone* url cache-directory))))
+ ;; Ensure the "origin" remote points to URL.
+ (set-remote-url! repository "origin" url)
+
;; Only fetch remote if it has not been cloned just before.
+ (pk 'x cache-directory 'avail? (reference-available? repository ref))
(when (and cache-exists?
(not (reference-available? repository ref)))
(let ((auth-method (%make-auth-ssh-agent)))
@@ -433,8 +459,6 @@ it unchanged."
#:key
recursive?
(log-port (%make-void-port "w"))
- (cache-directory
- (%repository-cache-directory))
(ref '(branch . "master")))
"Return two values: the content of the git repository at URL copied into a
store directory and the sha1 of the top level commit in this directory. The
@@ -464,10 +488,6 @@ Log progress and checkout info to LOG-PORT."
(update-cached-checkout url
#:recursive? recursive?
#:ref ref
- #:cache-directory
- (url-cache-directory url cache-directory
- #:recursive?
- recursive?)
#:log-port log-port))
((name)
(url+commit->name url commit)))
