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)))