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

[Christine Lemmer-Webber <cwebber@dustycloud.org>]

Oh, forgot to close it.

Christine Lemmer-Webber writes:

> Got the all clear to push to master.  Rebased and pushed! :)
>
> Christine Lemmer-Webber writes:
>
>> I rebased the patches and created the branch origin/wip-setuid.
>> (I also updated my name... again.  Should be the final update.)
>>
>> Looks like the tests all pass.  I don't want to let this bitrot again.
>> Does anyone have an objection to me pushing this to master?
>>
>> If nobody objects I'm gonna do it!
>>
>>
>> Chris Lemmer-Webber writes:
>>
>>> 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'