Subject: [PATCH] services: Activate `setuid-program-service-type' in shepherd.

From: Brian Cully <[email-masked]>
Date: Sat, 8 Apr 2023 11:16:35 -0400

Activate using a one-shot Shepherd service on boot, rather than attaching to
`activation-service-type' to populate `/run/setuid-programs'.

In order to prevent a dependency cycle between (gnu services) and (gnu
services shepherd), introduce a new module (gnu services setuid) and deprecate
the import of `setuid-program-service-type' from (gnu services).

* gnu/local.mk (GNU_SYSTEM_MODULES): add setuid.scm.
* gnu/services.scm (setuid-program-service-type): deprecate.
* gnu/services/setuid.scm: new module.
* gnu/services/dbus.scm (gnu): import (gnu services setuid).
* gnu/services/desktop.scm (gnu): import (gnu services setuid).
* gnu/services/docker.scm (gnu): import (gnu services setuid).
* gnu/services/mail.scm (gnu): import (gnu services setuid).
* gnu/services/xorg.scm (gnu): import (gnu services setuid).
* gnu/system.scm (gnu): import (gnu services setuid).
---
 gnu/local.mk             |  1 +
 gnu/services.scm         | 40 +++---------------------------
 gnu/services/dbus.scm    |  1 +
 gnu/services/desktop.scm |  1 +
 gnu/services/docker.scm  |  1 +
 gnu/services/mail.scm    |  1 +
 gnu/services/setuid.scm  | 53 ++++++++++++++++++++++++++++++++++++++++
 gnu/services/xorg.scm    |  1 +
 gnu/system.scm           |  1 +
 9 files changed, 63 insertions(+), 37 deletions(-)
 create mode 100644 gnu/services/setuid.scm

diff --git a/gnu/local.mk b/gnu/local.mk
index b7e19b6bc2..55dae3426a 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -704,6 +704,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/services/rsync.scm			\
   %D%/services/samba.scm			\
   %D%/services/sddm.scm				\
+  %D%/services/setuid.scm			\
   %D%/services/spice.scm				\
   %D%/services/ssh.scm				\
   %D%/services/syncthing.scm			\
diff --git a/gnu/services.scm b/gnu/services.scm
index d6c7ad0553..f42d4bc15f 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -43,7 +43,6 @@ (define-module (gnu services)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
   #:use-module (gnu packages hurd)
-  #:use-module (gnu system setuid)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
@@ -110,7 +109,7 @@ (define-module (gnu services)
             extra-special-file
             etc-service-type
             etc-directory
-            setuid-program-service-type
+            setuid-program-service-type ; deprecated
             profile-service-type
             firmware-service-type
             gc-root-service-type
@@ -811,41 +810,8 @@ (define-deprecated (etc-service files)
 FILES must be a list of name/file-like object pairs."
   (service etc-service-type files))
 
-(define (setuid-program->activation-gexp programs)
-  "Return an activation gexp for setuid-program from PROGRAMS."
-  (let ((programs (map (lambda (program)
-                         ;; FIXME This is really ugly, I didn't managed to use
-                         ;; "inherit"
-                         (let ((program-name (setuid-program-program program))
-                               (setuid?      (setuid-program-setuid? program))
-                               (setgid?      (setuid-program-setgid? program))
-                               (user         (setuid-program-user program))
-                               (group        (setuid-program-group program)) )
-                           #~(setuid-program
-                              (setuid? #$setuid?)
-                              (setgid? #$setgid?)
-                              (user    #$user)
-                              (group   #$group)
-                              (program #$program-name))))
-                       programs)))
-    (with-imported-modules (source-module-closure
-                            '((gnu system setuid)))
-      #~(begin
-          (use-modules (gnu system setuid))
-
-          (activate-setuid-programs (list #$@programs))))))
-
-(define setuid-program-service-type
-  (service-type (name 'setuid-program)
-                (extensions
-                 (list (service-extension activation-service-type
-                                          setuid-program->activation-gexp)))
-                (compose concatenate)
-                (extend (lambda (config extensions)
-                          (append config extensions)))
-                (description
-                 "Populate @file{/run/setuid-programs} with the specified
-executables, making them setuid and/or setgid.")))
+(define-deprecated/public-alias setuid-program-service-type
+  (@ (gnu services setuid) setuid-program-service-type))
 
 (define (packages->profile-entry packages)
   "Return a system entry for the profile containing PACKAGES."
diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
index e9c9346f56..dd9f0122b1 100644
--- a/gnu/services/dbus.scm
+++ b/gnu/services/dbus.scm
@@ -21,6 +21,7 @@
 
 (define-module (gnu services dbus)
   #:use-module (gnu services)
+  #:use-module (gnu services setuid)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system setuid)
   #:use-module (gnu system shadow)
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index adea5b38dd..1ff7abd61e 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -33,6 +33,7 @@
 
 (define-module (gnu services desktop)
   #:use-module (gnu services)
+  #:use-module (gnu services setuid)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services base)
   #:use-module (gnu services dbus)
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 741bab5a8c..32ed9739bf 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -26,6 +26,7 @@ (define-module (gnu services docker)
   #:use-module (gnu services configuration)
   #:use-module (gnu services base)
   #:use-module (gnu services dbus)
+  #:use-module (gnu services setuid)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system setuid)
   #:use-module (gnu system shadow)
diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm
index bf4948dcfb..d6e35a07f8 100644
--- a/gnu/services/mail.scm
+++ b/gnu/services/mail.scm
@@ -27,6 +27,7 @@ (define-module (gnu services mail)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu services configuration)
+  #:use-module (gnu services setuid)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system pam)
   #:use-module (gnu system shadow)
diff --git a/gnu/services/setuid.scm b/gnu/services/setuid.scm
new file mode 100644
index 0000000000..4e46510733
--- /dev/null
+++ b/gnu/services/setuid.scm
@@ -0,0 +1,53 @@
+(define-module (gnu services setuid)
+  #:use-module (gnu services)
+  #:use-module (gnu services shepherd)
+  #:use-module (gnu system setuid)
+  #:use-module (guix gexp)
+  #:use-module (guix modules)
+  #:use-module (srfi srfi-1)
+  #:export (setuid-program-service-type))
+
+(define (setuid-programs->shepherd-service programs)
+  (let ((programs (map (lambda (program)
+                         ;; FIXME This is really ugly, I didn't managed to use
+                         ;; "inherit"
+                         (let ((program-name (setuid-program-program program))
+                               (setuid?      (setuid-program-setuid? program))
+                               (setgid?      (setuid-program-setgid? program))
+                               (user         (setuid-program-user program))
+                               (group        (setuid-program-group program)) )
+                           #~(setuid-program
+                              (setuid? #$setuid?)
+                              (setgid? #$setgid?)
+                              (user    #$user)
+                              (group   #$group)
+                              (program #$program-name))))
+                       programs)))
+    (with-imported-modules (source-module-closure
+                            '((gnu system setuid)
+                              (gnu build activation)))
+      (list (shepherd-service
+             (documentation "Populate @file{/run/setuid-programs}.")
+             (provision '(setuid-programs))
+             ;; TODO: actually need to require account service. maybe user-homes
+             ;; as a proxy?
+             (requirement '(file-systems))
+             (one-shot? #t)
+             (modules '((gnu system setuid)
+                        (gnu build activation)))
+             (start #~(lambda ()
+                        (activate-setuid-programs (list #$@programs))
+                        #t)))))))
+
+(define setuid-program-service-type
+  (service-type (name 'setuid-program)
+                (extensions
+                 (list
+                  (service-extension shepherd-root-service-type
+                                     setuid-programs->shepherd-service)))
+                (compose concatenate)
+                (extend append)
+                (default-value '())
+                (description
+                 "Populate @file{/run/setuid-programs} with the specified
+executables, making them setuid and/or setgid.")))
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 7295a45b59..9ed1977f66 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -34,6 +34,7 @@ (define-module (gnu services xorg)
   #:use-module (gnu artwork)
   #:use-module (gnu services)
   #:use-module (gnu services configuration)
+  #:use-module (gnu services setuid)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system pam)
   #:use-module (gnu system setuid)
diff --git a/gnu/system.scm b/gnu/system.scm
index c17c6e4e98..8faa3b4672 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -67,6 +67,7 @@ (define-module (gnu system)
   #:use-module (gnu packages text-editors)
   #:use-module (gnu packages wget)
   #:use-module (gnu services)
+  #:use-module (gnu services setuid)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services base)
   #:use-module (gnu bootloader)
-- 
2.39.2