diff mbox series

[bug#44700,v3,2/2] services: Migrate to <setuid-program>.

Message ID 20210706200320.27113-3-brice@waegenei.re
State New
Headers show
Series More configurable setuid/setgid support | expand

Checks

Context Check Description
cbaines/applying patch fail View Laminar job
cbaines/issue success View issue

Commit Message

Brice Waegeneire July 6, 2021, 8:03 p.m. UTC
* gnu/services/dbus.scm (dbus-setuid-programs, polkit-setuid-programs):
  Return setuid-programs.
* gnu/services/desktop.scm (enlightenment-setuid-programs): Return
 setuid-programs.
 (%desktop-services)[mount-setuid-helpers]: Use setuid-programs.
* gnu/services/docker.scm (singularity-setuid-programs): Return
 setuid-programs.
* gnu/services/xorg.scm(screen-locker-setuid-programs): Return
 setuid-programs.
* gnu/system.scm (%setuid-programs): Return setuid-programs.
* doc/guix.texi (Setuid Programs, operating-system Reference): Replace
  'list of G-expressions' with 'list of <setuid-program>'.
---
 doc/guix.texi            | 19 +++++++++++--------
 gnu/services/dbus.scm    | 13 +++++++++----
 gnu/services/desktop.scm | 26 ++++++++++++++++----------
 gnu/services/docker.scm  |  9 ++++++---
 gnu/services/xorg.scm    |  4 +++-
 gnu/system.scm           | 31 ++++++++++++++++---------------
 6 files changed, 61 insertions(+), 41 deletions(-)

Comments

Chris Lemmer-Webber July 7, 2021, 5:41 p.m. UTC | #1
Looks good to me.  I'd say push it... let's not let this bitrot again!

Brice Waegeneire writes:

> * gnu/services/dbus.scm (dbus-setuid-programs, polkit-setuid-programs):
>   Return setuid-programs.
> * gnu/services/desktop.scm (enlightenment-setuid-programs): Return
>  setuid-programs.
>  (%desktop-services)[mount-setuid-helpers]: Use setuid-programs.
> * gnu/services/docker.scm (singularity-setuid-programs): Return
>  setuid-programs.
> * gnu/services/xorg.scm(screen-locker-setuid-programs): Return
>  setuid-programs.
> * gnu/system.scm (%setuid-programs): Return setuid-programs.
> * doc/guix.texi (Setuid Programs, operating-system Reference): Replace
>   'list of G-expressions' with 'list of <setuid-program>'.
> ---
>  doc/guix.texi            | 19 +++++++++++--------
>  gnu/services/dbus.scm    | 13 +++++++++----
>  gnu/services/desktop.scm | 26 ++++++++++++++++----------
>  gnu/services/docker.scm  |  9 ++++++---
>  gnu/services/xorg.scm    |  4 +++-
>  gnu/system.scm           | 31 ++++++++++++++++---------------
>  6 files changed, 61 insertions(+), 41 deletions(-)
>
> diff --git a/doc/guix.texi b/doc/guix.texi
> index f7a72b9885..7919332521 100644
> --- a/doc/guix.texi
> +++ b/doc/guix.texi
> @@ -13860,8 +13860,8 @@ Linux @dfn{pluggable authentication module} (PAM) services.
>  @c FIXME: Add xref to PAM services section.
>  
>  @item @code{setuid-programs} (default: @code{%setuid-programs})
> -List of string-valued G-expressions denoting setuid programs.
> -@xref{Setuid Programs}.
> +List of @code{<setuid-program>}.  @xref{Setuid Programs}, for more
> +information.
>  
>  @item @code{sudoers-file} (default: @code{%sudoers-specification})
>  @cindex sudoers file
> @@ -32421,13 +32421,15 @@ the store, we let the system administrator @emph{declare} which programs
>  should be setuid root.
>  
>  The @code{setuid-programs} field of an @code{operating-system}
> -declaration contains a list of G-expressions denoting the names of
> -programs to be setuid-root (@pxref{Using the Configuration System}).
> -For instance, the @command{passwd} program, which is part of the Shadow
> -package, can be designated by this G-expression (@pxref{G-Expressions}):
> +declaration contains a list of @code{<setuid-program>} denoting the
> +names of programs to have a setuid or setgid bit set (@pxref{Using the
> +Configuration System}).  For instance, the @command{passwd} program,
> +which is part of the Shadow package, with a setuid root can be
> +designated like this:
>  
>  @example
> -#~(string-append #$shadow "/bin/passwd")
> +(setuid-program
> +  (program (file-append #$shadow "/bin/passwd")))
>  @end example
>  
>  @deftp {Data Type} setuid-program
> @@ -32458,7 +32460,8 @@ A default set of setuid programs is defined by the
>  @code{%setuid-programs} variable of the @code{(gnu system)} module.
>  
>  @defvr {Scheme Variable} %setuid-programs
> -A list of G-expressions denoting common programs that are setuid-root.
> +A list of @code{<setuid-program>} denoting common programs that are
> +setuid-root.
>  
>  The list includes commands such as @command{passwd}, @command{ping},
>  @command{su}, and @command{sudo}.
> diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
> index af1a1e4c3a..e7b3dac166 100644
> --- a/gnu/services/dbus.scm
> +++ b/gnu/services/dbus.scm
> @@ -2,6 +2,7 @@
>  ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
>  ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
>  ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
> +;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -21,6 +22,7 @@
>  (define-module (gnu services dbus)
>    #:use-module (gnu services)
>    #:use-module (gnu services shepherd)
> +  #:use-module (gnu system setuid)
>    #:use-module (gnu system shadow)
>    #:use-module (gnu system pam)
>    #:use-module ((gnu packages glib) #:select (dbus))
> @@ -156,10 +158,12 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
>           (shell (file-append shadow "/sbin/nologin")))))
>  
>  (define dbus-setuid-programs
> -  ;; Return the file name of the setuid program that we need.
> +  ;; Return a list of <setuid-program> for the program that we need.
>    (match-lambda
>      (($ <dbus-configuration> dbus services)
> -     (list (file-append dbus "/libexec/dbus-daemon-launch-helper")))))
> +     (list (setuid-program
> +            (program (file-append
> +                      dbus "/libexec/dbus-daemon-launch-helper")))))))
>  
>  (define (dbus-activation config)
>    "Return an activation gexp for D-Bus using @var{config}."
> @@ -335,8 +339,9 @@ tuples, are all set as environment variables when the bus daemon launches it."
>  (define polkit-setuid-programs
>    (match-lambda
>      (($ <polkit-configuration> polkit)
> -     (list (file-append polkit "/lib/polkit-1/polkit-agent-helper-1")
> -           (file-append polkit "/bin/pkexec")))))
> +     (map file-like->setuid-program
> +          (list (file-append polkit "/lib/polkit-1/polkit-agent-helper-1")
> +                (file-append polkit "/bin/pkexec"))))))
>  
>  (define polkit-service-type
>    (service-type (name 'polkit)
> diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
> index cd800fcc2b..64d0e85301 100644
> --- a/gnu/services/desktop.scm
> +++ b/gnu/services/desktop.scm
> @@ -12,6 +12,7 @@
>  ;;; Copyright © 2019 David Wilson <david@daviwil.com>
>  ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
>  ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
> +;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -40,6 +41,7 @@
>    #:use-module ((gnu system file-systems)
>                  #:select (%elogind-file-systems file-system))
>    #:use-module (gnu system)
> +  #:use-module (gnu system setuid)
>    #:use-module (gnu system shadow)
>    #:use-module (gnu system pam)
>    #:use-module (gnu packages glib)
> @@ -1034,14 +1036,15 @@ rules."
>  
>  (define (enlightenment-setuid-programs enlightenment-desktop-configuration)
>    (match-record enlightenment-desktop-configuration
> -                <enlightenment-desktop-configuration>
> -                (enlightenment)
> -    (list (file-append enlightenment
> -                       "/lib/enlightenment/utils/enlightenment_sys")
> -          (file-append enlightenment
> -                       "/lib/enlightenment/utils/enlightenment_system")
> -          (file-append enlightenment
> -                       "/lib/enlightenment/utils/enlightenment_ckpasswd"))))
> +      <enlightenment-desktop-configuration>
> +    (enlightenment)
> +    (map file-like->setuid-program
> +         (list (file-append enlightenment
> +                            "/lib/enlightenment/utils/enlightenment_sys")
> +               (file-append enlightenment
> +                            "/lib/enlightenment/utils/enlightenment_system")
> +               (file-append enlightenment
> +                            "/lib/enlightenment/utils/enlightenment_ckpasswd")))))
>  
>  (define enlightenment-desktop-service-type
>    (service-type
> @@ -1204,8 +1207,11 @@ or setting its password with passwd.")))
>           ;; Allow desktop users to also mount NTFS and NFS file systems
>           ;; without root.
>           (simple-service 'mount-setuid-helpers setuid-program-service-type
> -                         (list (file-append nfs-utils "/sbin/mount.nfs")
> -                               (file-append ntfs-3g "/sbin/mount.ntfs-3g")))
> +                         (map (lambda (program)
> +                                (setuid-program
> +                                 (program program)))
> +                              (list (file-append nfs-utils "/sbin/mount.nfs")
> +                               (file-append ntfs-3g "/sbin/mount.ntfs-3g"))))
>  
>           ;; The global fontconfig cache directory can sometimes contain
>           ;; stale entries, possibly referencing fonts that have been GC'd,
> diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
> index be85316180..ef551480aa 100644
> --- a/gnu/services/docker.scm
> +++ b/gnu/services/docker.scm
> @@ -4,6 +4,7 @@
>  ;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
>  ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
>  ;;; Copyright © 2020 Jesse Dowell <jessedowell@gmail.com>
> +;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -26,6 +27,7 @@
>    #:use-module (gnu services base)
>    #:use-module (gnu services dbus)
>    #:use-module (gnu services shepherd)
> +  #:use-module (gnu system setuid)
>    #:use-module (gnu system shadow)
>    #:use-module (gnu packages docker)
>    #:use-module (gnu packages linux)               ;singularity
> @@ -195,9 +197,10 @@ bundles in Docker containers.")
>                                                             "-helper")))
>                                   '("action" "mount" "start")))))
>  
> -  (list (file-append helpers "/singularity-action-helper")
> -        (file-append helpers "/singularity-mount-helper")
> -        (file-append helpers "/singularity-start-helper")))
> +  (map file-like->setuid-program
> +       (list (file-append helpers "/singularity-action-helper")
> +             (file-append helpers "/singularity-mount-helper")
> +             (file-append helpers "/singularity-start-helper"))))
>  
>  (define singularity-service-type
>    (service-type (name 'singularity)
> diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
> index 8ffea3b9dd..d95f8beb7a 100644
> --- a/gnu/services/xorg.scm
> +++ b/gnu/services/xorg.scm
> @@ -8,6 +8,7 @@
>  ;;; Copyright © 2020 shtwzrd <shtwzrd@protonmail.com>
>  ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
>  ;;; Copyright © 2020 Alex Griffin <a@ajgrf.com>
> +;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -29,6 +30,7 @@
>    #:use-module (gnu services)
>    #:use-module (gnu services shepherd)
>    #:use-module (gnu system pam)
> +  #:use-module (gnu system setuid)
>    #:use-module (gnu system keyboard)
>    #:use-module (gnu services base)
>    #:use-module (gnu services dbus)
> @@ -681,7 +683,7 @@ reboot_cmd " shepherd "/sbin/reboot\n"
>                               #:allow-empty-passwords? empty?)))))
>  
>  (define screen-locker-setuid-programs
> -  (compose list screen-locker-program))
> +  (compose list file-like->setuid-program screen-locker-program))
>  
>  (define screen-locker-service-type
>    (service-type (name 'screen-locker)
> diff --git a/gnu/system.scm b/gnu/system.scm
> index 385c36a484..681dd33630 100644
> --- a/gnu/system.scm
> +++ b/gnu/system.scm
> @@ -1105,22 +1105,23 @@ use 'plain-file' instead~%")
>  (define %setuid-programs
>    ;; Default set of setuid-root programs.
>    (let ((shadow (@ (gnu packages admin) shadow)))
> -    (list (file-append shadow "/bin/passwd")
> -          (file-append shadow "/bin/sg")
> -          (file-append shadow "/bin/su")
> -          (file-append shadow "/bin/newgrp")
> -          (file-append shadow "/bin/newuidmap")
> -          (file-append shadow "/bin/newgidmap")
> -          (file-append inetutils "/bin/ping")
> -          (file-append inetutils "/bin/ping6")
> -          (file-append sudo "/bin/sudo")
> -          (file-append sudo "/bin/sudoedit")
> -          (file-append fuse "/bin/fusermount")
> +    (map file-like->setuid-program
> +         (list (file-append shadow "/bin/passwd")
> +               (file-append shadow "/bin/sg")
> +               (file-append shadow "/bin/su")
> +               (file-append shadow "/bin/newgrp")
> +               (file-append shadow "/bin/newuidmap")
> +               (file-append shadow "/bin/newgidmap")
> +               (file-append inetutils "/bin/ping")
> +               (file-append inetutils "/bin/ping6")
> +               (file-append sudo "/bin/sudo")
> +               (file-append sudo "/bin/sudoedit")
> +               (file-append fuse "/bin/fusermount")
>  
> -          ;; To allow mounts with the "user" option, "mount" and "umount" must
> -          ;; be setuid-root.
> -          (file-append util-linux "/bin/mount")
> -          (file-append util-linux "/bin/umount"))))
> +               ;; To allow mounts with the "user" option, "mount" and "umount" must
> +               ;; be setuid-root.
> +               (file-append util-linux "/bin/mount")
> +               (file-append util-linux "/bin/umount")))))
>  
>  (define %sudoers-specification
>    ;; Default /etc/sudoers contents: 'root' and all members of the 'wheel'
diff mbox series

Patch

diff --git a/doc/guix.texi b/doc/guix.texi
index f7a72b9885..7919332521 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -13860,8 +13860,8 @@  Linux @dfn{pluggable authentication module} (PAM) services.
 @c FIXME: Add xref to PAM services section.
 
 @item @code{setuid-programs} (default: @code{%setuid-programs})
-List of string-valued G-expressions denoting setuid programs.
-@xref{Setuid Programs}.
+List of @code{<setuid-program>}.  @xref{Setuid Programs}, for more
+information.
 
 @item @code{sudoers-file} (default: @code{%sudoers-specification})
 @cindex sudoers file
@@ -32421,13 +32421,15 @@  the store, we let the system administrator @emph{declare} which programs
 should be setuid root.
 
 The @code{setuid-programs} field of an @code{operating-system}
-declaration contains a list of G-expressions denoting the names of
-programs to be setuid-root (@pxref{Using the Configuration System}).
-For instance, the @command{passwd} program, which is part of the Shadow
-package, can be designated by this G-expression (@pxref{G-Expressions}):
+declaration contains a list of @code{<setuid-program>} denoting the
+names of programs to have a setuid or setgid bit set (@pxref{Using the
+Configuration System}).  For instance, the @command{passwd} program,
+which is part of the Shadow package, with a setuid root can be
+designated like this:
 
 @example
-#~(string-append #$shadow "/bin/passwd")
+(setuid-program
+  (program (file-append #$shadow "/bin/passwd")))
 @end example
 
 @deftp {Data Type} setuid-program
@@ -32458,7 +32460,8 @@  A default set of setuid programs is defined by the
 @code{%setuid-programs} variable of the @code{(gnu system)} module.
 
 @defvr {Scheme Variable} %setuid-programs
-A list of G-expressions denoting common programs that are setuid-root.
+A list of @code{<setuid-program>} denoting common programs that are
+setuid-root.
 
 The list includes commands such as @command{passwd}, @command{ping},
 @command{su}, and @command{sudo}.
diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
index af1a1e4c3a..e7b3dac166 100644
--- a/gnu/services/dbus.scm
+++ b/gnu/services/dbus.scm
@@ -2,6 +2,7 @@ 
 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +22,7 @@ 
 (define-module (gnu services dbus)
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
+  #:use-module (gnu system setuid)
   #:use-module (gnu system shadow)
   #:use-module (gnu system pam)
   #:use-module ((gnu packages glib) #:select (dbus))
@@ -156,10 +158,12 @@  includes the @code{etc/dbus-1/system.d} directories of each package listed in
          (shell (file-append shadow "/sbin/nologin")))))
 
 (define dbus-setuid-programs
-  ;; Return the file name of the setuid program that we need.
+  ;; Return a list of <setuid-program> for the program that we need.
   (match-lambda
     (($ <dbus-configuration> dbus services)
-     (list (file-append dbus "/libexec/dbus-daemon-launch-helper")))))
+     (list (setuid-program
+            (program (file-append
+                      dbus "/libexec/dbus-daemon-launch-helper")))))))
 
 (define (dbus-activation config)
   "Return an activation gexp for D-Bus using @var{config}."
@@ -335,8 +339,9 @@  tuples, are all set as environment variables when the bus daemon launches it."
 (define polkit-setuid-programs
   (match-lambda
     (($ <polkit-configuration> polkit)
-     (list (file-append polkit "/lib/polkit-1/polkit-agent-helper-1")
-           (file-append polkit "/bin/pkexec")))))
+     (map file-like->setuid-program
+          (list (file-append polkit "/lib/polkit-1/polkit-agent-helper-1")
+                (file-append polkit "/bin/pkexec"))))))
 
 (define polkit-service-type
   (service-type (name 'polkit)
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index cd800fcc2b..64d0e85301 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -12,6 +12,7 @@ 
 ;;; Copyright © 2019 David Wilson <david@daviwil.com>
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd@pantherx.org>
+;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -40,6 +41,7 @@ 
   #:use-module ((gnu system file-systems)
                 #:select (%elogind-file-systems file-system))
   #:use-module (gnu system)
+  #:use-module (gnu system setuid)
   #:use-module (gnu system shadow)
   #:use-module (gnu system pam)
   #:use-module (gnu packages glib)
@@ -1034,14 +1036,15 @@  rules."
 
 (define (enlightenment-setuid-programs enlightenment-desktop-configuration)
   (match-record enlightenment-desktop-configuration
-                <enlightenment-desktop-configuration>
-                (enlightenment)
-    (list (file-append enlightenment
-                       "/lib/enlightenment/utils/enlightenment_sys")
-          (file-append enlightenment
-                       "/lib/enlightenment/utils/enlightenment_system")
-          (file-append enlightenment
-                       "/lib/enlightenment/utils/enlightenment_ckpasswd"))))
+      <enlightenment-desktop-configuration>
+    (enlightenment)
+    (map file-like->setuid-program
+         (list (file-append enlightenment
+                            "/lib/enlightenment/utils/enlightenment_sys")
+               (file-append enlightenment
+                            "/lib/enlightenment/utils/enlightenment_system")
+               (file-append enlightenment
+                            "/lib/enlightenment/utils/enlightenment_ckpasswd")))))
 
 (define enlightenment-desktop-service-type
   (service-type
@@ -1204,8 +1207,11 @@  or setting its password with passwd.")))
          ;; Allow desktop users to also mount NTFS and NFS file systems
          ;; without root.
          (simple-service 'mount-setuid-helpers setuid-program-service-type
-                         (list (file-append nfs-utils "/sbin/mount.nfs")
-                               (file-append ntfs-3g "/sbin/mount.ntfs-3g")))
+                         (map (lambda (program)
+                                (setuid-program
+                                 (program program)))
+                              (list (file-append nfs-utils "/sbin/mount.nfs")
+                               (file-append ntfs-3g "/sbin/mount.ntfs-3g"))))
 
          ;; The global fontconfig cache directory can sometimes contain
          ;; stale entries, possibly referencing fonts that have been GC'd,
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index be85316180..ef551480aa 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -4,6 +4,7 @@ 
 ;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2020 Jesse Dowell <jessedowell@gmail.com>
+;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,6 +27,7 @@ 
   #:use-module (gnu services base)
   #:use-module (gnu services dbus)
   #:use-module (gnu services shepherd)
+  #:use-module (gnu system setuid)
   #:use-module (gnu system shadow)
   #:use-module (gnu packages docker)
   #:use-module (gnu packages linux)               ;singularity
@@ -195,9 +197,10 @@  bundles in Docker containers.")
                                                            "-helper")))
                                  '("action" "mount" "start")))))
 
-  (list (file-append helpers "/singularity-action-helper")
-        (file-append helpers "/singularity-mount-helper")
-        (file-append helpers "/singularity-start-helper")))
+  (map file-like->setuid-program
+       (list (file-append helpers "/singularity-action-helper")
+             (file-append helpers "/singularity-mount-helper")
+             (file-append helpers "/singularity-start-helper"))))
 
 (define singularity-service-type
   (service-type (name 'singularity)
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 8ffea3b9dd..d95f8beb7a 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -8,6 +8,7 @@ 
 ;;; Copyright © 2020 shtwzrd <shtwzrd@protonmail.com>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;; Copyright © 2020 Alex Griffin <a@ajgrf.com>
+;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,6 +30,7 @@ 
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system pam)
+  #:use-module (gnu system setuid)
   #:use-module (gnu system keyboard)
   #:use-module (gnu services base)
   #:use-module (gnu services dbus)
@@ -681,7 +683,7 @@  reboot_cmd " shepherd "/sbin/reboot\n"
                              #:allow-empty-passwords? empty?)))))
 
 (define screen-locker-setuid-programs
-  (compose list screen-locker-program))
+  (compose list file-like->setuid-program screen-locker-program))
 
 (define screen-locker-service-type
   (service-type (name 'screen-locker)
diff --git a/gnu/system.scm b/gnu/system.scm
index 385c36a484..681dd33630 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -1105,22 +1105,23 @@  use 'plain-file' instead~%")
 (define %setuid-programs
   ;; Default set of setuid-root programs.
   (let ((shadow (@ (gnu packages admin) shadow)))
-    (list (file-append shadow "/bin/passwd")
-          (file-append shadow "/bin/sg")
-          (file-append shadow "/bin/su")
-          (file-append shadow "/bin/newgrp")
-          (file-append shadow "/bin/newuidmap")
-          (file-append shadow "/bin/newgidmap")
-          (file-append inetutils "/bin/ping")
-          (file-append inetutils "/bin/ping6")
-          (file-append sudo "/bin/sudo")
-          (file-append sudo "/bin/sudoedit")
-          (file-append fuse "/bin/fusermount")
+    (map file-like->setuid-program
+         (list (file-append shadow "/bin/passwd")
+               (file-append shadow "/bin/sg")
+               (file-append shadow "/bin/su")
+               (file-append shadow "/bin/newgrp")
+               (file-append shadow "/bin/newuidmap")
+               (file-append shadow "/bin/newgidmap")
+               (file-append inetutils "/bin/ping")
+               (file-append inetutils "/bin/ping6")
+               (file-append sudo "/bin/sudo")
+               (file-append sudo "/bin/sudoedit")
+               (file-append fuse "/bin/fusermount")
 
-          ;; To allow mounts with the "user" option, "mount" and "umount" must
-          ;; be setuid-root.
-          (file-append util-linux "/bin/mount")
-          (file-append util-linux "/bin/umount"))))
+               ;; To allow mounts with the "user" option, "mount" and "umount" must
+               ;; be setuid-root.
+               (file-append util-linux "/bin/mount")
+               (file-append util-linux "/bin/umount")))))
 
 (define %sudoers-specification
   ;; Default /etc/sudoers contents: 'root' and all members of the 'wheel'