Merge branch 'master' into staging

4 files changed, 43 insertions, 5 deletions

diff --git a/guix/least-authority.scm b/guix/least-authority.scm
index d871816fca..bfd7275e7c 100644
--- a/guix/least-authority.scm
+++ b/guix/least-authority.scm
@@ -51,7 +51,7 @@
   "Return a wrapper of PROGRAM that executes it with the least authority.
 
 PROGRAM is executed in separate namespaces according to NAMESPACES, a list of
-symbols; it turns with GUEST-UID and GUEST-GID.  MAPPINGS is a list of
+symbols; it runs with GUEST-UID and GUEST-GID.  MAPPINGS is a list of
 <file-system-mapping> records indicating directories mirrored inside the
 execution environment of PROGRAM.  DIRECTORY is the working directory of the
 wrapped process.  Each environment listed in PRESERVED-ENVIRONMENT-VARIABLES
diff --git a/guix/packages.scm b/guix/packages.scm
index 7425389618..715a6397ed 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -3,7 +3,7 @@
 ;;; Copyright © 2014, 2015, 2017, 2018, 2019 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
-;;; Copyright © 2017, 2019, 2020 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2017, 2019, 2020, 2022 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
@@ -149,6 +149,8 @@
 
             transitive-input-references
 
+            %32bit-supported-systems
+            %64bit-supported-systems
             %supported-systems
             %hurd-systems
             %cuirass-supported-systems
@@ -400,11 +402,19 @@ from forcing GEXP-PROMISE."
                       #:guile-for-build guile)))
 
 
+(define %32bit-supported-systems
+  ;; This is the list of 32-bit system types that are supported.
+  '("i686-linux" "armhf-linux" "i586-gnu" "powerpc-linux"))
+
+(define %64bit-supported-systems
+  ;; This is the list of 64-bit system types that are supported.
+  '("x86_64-linux" "mips64el-linux" "aarch64-linux" "powerpc64le-linux"
+    "riscv64-linux"))
+
 (define %supported-systems
   ;; This is the list of system types that are supported.  By default, we
   ;; expect all packages to build successfully here.
-  '("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux" "mips64el-linux" "i586-gnu"
-    "powerpc64le-linux" "powerpc-linux" "riscv64-linux"))
+  (append %32bit-supported-systems %64bit-supported-systems))
 
 (define %hurd-systems
   ;; The GNU/Hurd systems for which support is being developed.
diff --git a/guix/platform.scm b/guix/platform.scm
index 361241cb2e..19d4527e29 100644
--- a/guix/platform.scm
+++ b/guix/platform.scm
@@ -121,7 +121,7 @@ otherwise."
 (define (platform-target->system target)
   "Return the system matching the given TARGET if it exists or false
 otherwise."
-  (let ((platform (lookup-platform-by-target system)))
+  (let ((platform (lookup-platform-by-target target)))
     (and=> platform platform-system)))
 
 
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))