05/10: pull: Fail if cache directory ownership is suspect.

[guix-commits]

nckx pushed a commit to branch master
in repository guix.

commit 7c52cad0464175370c44bd4695e4c01a62b8268f
Author: Tobias Geerinckx-Rice <me@tobias.gr>
AuthorDate: Sun Jun 5 02:00:05 2022 +0200

    pull: Fail if cache directory ownership is suspect.
    
    New users frequently run ‘sudo guix pull’ which breaks subsequent
    unprivileged ‘guix pull’s until manually fixed with chmod -R.
    
    * guix/scripts/pull.scm (guix-pull): Fail if the cache directory (or
    its innermost extant parent) is not owned by the user pulling the Guix,
    with a hint about ‘sudo -i’.
---
 guix/scripts/pull.scm | 28 ++++++++++++++++++++++++++++
 1 file changed, 28 insertions(+)

diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index f01764637b..24151f7ed3 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -49,6 +49,7 @@
   #:autoload   (gnu packages bootstrap) (%bootstrap-guile)
   #:autoload   (gnu packages certs) (le-certs)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
@@ -810,6 +811,33 @@ Use '~/.config/guix/channels.scm' instead."))
         ((assoc-ref opts 'generation)
          (process-generation-change opts profile))
         (else
+         ;; Bail out early when users accidentally run, e.g., ’sudo guix pull’.
+         ;; If CACHE-DIRECTORY doesn't yet exist, test where it would end up.
+         (let-values (((stats dir) (let loop ((dir (cache-directory)))
+                                     (let ((stats (stat dir #f)))
+                                       (if stats
+                                           (values stats dir)
+                                           (loop (dirname dir)))))))
+           (let ((dir:uid (stat:uid stats))
+                 (our:uid (getuid)))
+             (unless (= dir:uid our:uid)
+               (let* ((user (lambda (uid)    ; handle the unthinkable invalid 
UID
+                              (or (false-if-exception (passwd:name
+                                                       (getpwuid uid)))
+                                  uid)))
+                      (our:user (user our:uid))
+                      (dir:user (user dir:uid)))
+                 (raise
+                  (condition
+                   (&message
+                    (message
+                     (format #f (G_ "directory ‘~a’ is not owned by user ~a")
+                             dir dir:user)))
+                   (&fix-hint
+                    (hint
+                     (format #f (G_ "You should run this command as ~a; use 
‘sudo -i’ or equivalent if you really want to pull as ~a.")
+                             dir:user our:user)))))))))
+
          (with-store store
            (with-status-verbosity (assoc-ref opts 'verbosity)
              (parameterize ((%current-system (assoc-ref opts 'system))