services: setuid-program: Populate /run/privileged/bin.

Create /run/setuid-programs compatibility symlinks so that we can
migrate all users (both package and human) piecemeal at our leisure.

Apart from being symlinks, this should be a user-invisible change.

* gnu/build/activation.scm (%privileged-program-directory): New variable.
[activate-setuid-programs]: Put privileged copies in
%PRIVILEGED-PROGRAM-DIRECTORY, with compatibility symlinks to each in
%SETUID-DIRECTORY.
* gnu/services.scm (setuid-program-service-type): Update docstring.
* doc/guix.texi (Setuid Programs): Update @file{} name accordingly.

2 files changed, 43 insertions, 20 deletions

diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index d8c0cd22a3..249b84c076 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;; Copyright © 2020 Christine Lemmer-Webber <cwebber@dustycloud.org>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2022 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -279,14 +280,29 @@ they already exist."
                      string<?)))
 
 (define %setuid-directory
-  ;; Place where setuid programs are stored.
+  ;; Place where setuid programs used to be stored.  It exists for backwards
+  ;; compatibility & will be removed.  Use %PRIVILEGED-PROGRAM-DIRECTORY instead.
   "/run/setuid-programs")
 
+(define %privileged-program-directory
+  ;; Place where privileged copies of programs are stored.
+  "/run/privileged/bin")
+
 (define (activate-setuid-programs programs)
-  "Turn PROGRAMS, a list of file setuid-programs record, into setuid programs
-stored under %SETUID-DIRECTORY."
-  (define (make-setuid-program program setuid? setgid? uid gid)
-    (let ((target (string-append %setuid-directory
+  "Turn PROGRAMS, a list of file setuid-programs records, into privileged
+copies stored under %PRIVILEGED-PROGRAM-DIRECTORY."
+  (define (ensure-empty-directory directory)
+    (if (file-exists? directory)
+        (for-each (compose delete-file
+                           (cut string-append directory "/" <>))
+                  (scandir directory
+                           (lambda (file)
+                             (not (member file '("." ".."))))
+                           string<?))
+        (mkdir-p directory))    )
+
+  (define (make-privileged-program program setuid? setgid? uid gid)
+    (let ((target (string-append %privileged-program-directory
                                  "/" (basename program)))
           (mode (+ #o0555                   ; base permissions
                    (if setuid? #o4000 0)    ; setuid bit
@@ -295,16 +311,17 @@ stored under %SETUID-DIRECTORY."
       (chown target uid gid)
       (chmod target mode)))
 
-  (format #t "setting up setuid programs in '~a'...~%"
-          %setuid-directory)
-  (if (file-exists? %setuid-directory)
-      (for-each (compose delete-file
-                         (cut string-append %setuid-directory "/" <>))
-                (scandir %setuid-directory
-                         (lambda (file)
-                           (not (member file '("." ".."))))
-                         string<?))
-      (mkdir-p %setuid-directory))
+  (define (make-deprecated-wrapper program)
+    ;; This will eventually become a script that warns on usage, then vanish.
+    (symlink (string-append %privileged-program-directory
+                            "/" (basename program))
+             (string-append %setuid-directory
+                            "/" (basename program))))
+
+  (format #t "setting up privileged programs in '~a'...~%"
+          %privileged-program-directory)
+  (ensure-empty-directory %privileged-program-directory)
+  (ensure-empty-directory %setuid-directory)
 
   (for-each (lambda (program)
               (catch 'system-error
@@ -320,11 +337,12 @@ stored under %SETUID-DIRECTORY."
                          (gid (match group
                                 ((? string?) (group:gid (getgrnam group)))
                                 ((? integer?) group))))
-                    (make-setuid-program program-name setuid? setgid? uid gid)))
+                    (make-privileged-program program-name setuid? setgid? uid gid)
+                    (make-deprecated-wrapper program-name)))
                 (lambda args
                   ;; If we fail to create a setuid program, better keep going
-                  ;; so that we don't leave %SETUID-DIRECTORY empty or
-                  ;; half-populated.  This can happen if PROGRAMS contains
+                  ;; so that we don't leave %PRIVILEGED-PROGRAM-DIRECTORY empty
+                  ;; or half-populated.  This can happen if PROGRAMS contains
                   ;; incorrect file names: <https://bugs.gnu.org/38800>.
                   (format (current-error-port)
                           "warning: failed to make ~s setuid/setgid: ~a~%"
diff --git a/gnu/services.scm b/gnu/services.scm
index 88593e8091..98355c20f5 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com>
 ;;; Copyright © 2020 Christine Lemmer-Webber <cwebber@dustycloud.org>
 ;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2022 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2023 Brian Cully <bjc@spork.org>
 ;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
 ;;;
@@ -921,8 +922,12 @@ FILES must be a list of name/file-like object pairs."
                 (extend (lambda (config extensions)
                           (append config extensions)))
                 (description
-                 "Populate @file{/run/setuid-programs} with the specified
-executables, making them setuid and/or setgid.")))
+                 "Copy the specified executables to @file{/run/privileged/bin}
+and apply special privileges like setuid and/or setgid.
+
+The deprecated @file{/run/setuid-programs} directory is also populated with
+symbolic links to their @file{/run/privileged/bin} counterpart.  It will be
+removed in a future Guix release.")))
 
 (define (packages->profile-entry packages)
   "Return a system entry for the profile containing PACKAGES."