Ludovic Courtès skribis:
> If you do, as a regular user:
>
> guix pull
> sudo guix system reconfigure …
>
> the ‘guix system reconfigure’, as part of the downgrade-detection
> machinery, triggers an update of the channel checkout(s) in
> ~root/.cache, even though ~USER/.cache is already up-to-date.
>
> One way to avoid it might be to special-case the checkout cache
> directory for when ‘SUDO_USER’ is set.
Attached is a prototype that first clones/fetches from ~USER/.cache into
~root/.cache, in the hope that this avoids the need to access the
upstream repo. (It requires ‘set-remote-url!’, which is only in
Guile-Git ‘master’.)
It’s a bit hacky but I can’t think of a better way to address this
issue. In particular, having root use ~USER/.cache directly is not an
option: it could end up creating root-owned files there.
Thoughts?
Ludo’.
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?
-
