bug#45295: “sudo guix system reconfigure” triggers re-clone/update of Git checkout

[Ludovic Courtès]

Ludovic Courtès <ludo@gnu.org> 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?
-                                                     recursive?)
                                 #:log-port log-port))
        ((name)
         (url+commit->name url commit)))