services: setuid: More configurable setuid support.

DoneSubmitted by Christopher Lemmer Webber.
Details
4 participants
  • Brice Waegeneire
  • Christopher Lemmer Webber
  • Ludovic Courtès
  • Maxim Cournoyer
Owner
unassigned
Severity
normal
C
C
Christopher Lemmer Webber wrote on 17 Nov 2020 00:29
(address . guix-patches@gnu.org)
874klog9tk.fsf@dustycloud.org
This patch allows for configuring the specific user, group, and whether
to set the setuid and setgid bits.

See also:

But I thought I'd open this here so we could track changes since this is
technically independent of the postfix stuff. Anyway, patch attached.
One change since the last email above is that I added support for
string-based username/groups.

This also needs documentation, I suppose, so that should be done.
But it would be good to know if this patch looks like it's on the "right
path" or not.
From eadac673fb22132c555a4e1cee57a6308ecfdad4 Mon Sep 17 00:00:00 2001
From: Christopher Lemmer Webber <cwebber@dustycloud.org>
Date: Sun, 15 Nov 2020 16:58:52 -0500
Subject: [PATCH] services: setuid: More configurable setuid support.

New record <setuid-program> with fields for setting the specific user and
group, as well as specifically selecting the setuid and setgid bits, for a
program within the setuid-program-service.

* gnu/services.scm (<setuid-program>): New record type.
(setuid-program, make-setuid-program, setuid-program?)
(setuid-program-program, stuid-program-setuid?, setuid-program-setgid?)
(setuid-program-user, setuid-program-group): New variables, export them.
(setuid-program-entry): New variable, a procedure used for the
service-extension of activation-service-type as set up by
setuid-program-service-type. Unpacks the <setuid-program> record,
handing off within the gexp to activate-setuid-programs.
(setuid-program-service-type): Make use of setuid-program-entry.
* gnu/build/activation.scm (activate-setuid-programs): Update to expect a
ftagged list for each program entry, pre-unpacked from the <setuid-program>
record before being handed to this procedure.
---
gnu/build/activation.scm | 46 +++++++++++++++++++++----------------
gnu/services.scm | 49 +++++++++++++++++++++++++++++++++++++---
2 files changed, 73 insertions(+), 22 deletions(-)

Toggle diff (137 lines)
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index 4b67926e88..fd17ce0434 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -229,13 +229,6 @@ they already exist."
 (define (activate-setuid-programs programs)
   "Turn PROGRAMS, a list of file names, into setuid programs stored under
 %SETUID-DIRECTORY."
-  (define (make-setuid-program prog)
-    (let ((target (string-append %setuid-directory
-                                 "/" (basename prog))))
-      (copy-file prog target)
-      (chown target 0 0)
-      (chmod target #o6555)))
-
   (format #t "setting up setuid programs in '~a'...~%"
           %setuid-directory)
   (if (file-exists? %setuid-directory)
@@ -247,18 +240,33 @@ they already exist."
                          string<?))
       (mkdir-p %setuid-directory))
 
-  (for-each (lambda (program)
-              (catch 'system-error
-                (lambda ()
-                  (make-setuid-program program))
-                (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
-                  ;; incorrect file names: <https://bugs.gnu.org/38800>.
-                  (format (current-error-port)
-                          "warning: failed to make '~a' setuid-root: ~a~%"
-                          program (strerror (system-error-errno args))))))
+  (for-each (match-lambda
+              [('setuid-program src-path setuid? setgid? user group)
+               (let ((uid (match user
+                            [(? string?) (passwd:uid (getpwnam user))]
+                            [(? integer?) user]))
+                     (gid (match group
+                            [(? string?) (group:gid (getgrnam user))]
+                            [(? integer?) group])))
+                 (catch 'system-error
+                   (lambda ()
+                     (let ((target (string-append %setuid-directory
+                                                  "/" (basename src-path)))
+                           (mode (+ #o0555                   ; base permissions
+                                    (if setuid? #o4000 0)    ; setuid bit
+                                    (if setgid? #o2000 0)))) ; setgid bit
+                       (copy-file src-path target)
+                       (chown target uid gid)
+                       (chmod target mode)))
+                   (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
+                     ;; incorrect file names: <https://bugs.gnu.org/38800>.
+                     (format (current-error-port)
+                             "warning: failed to make '~a' setuid-root: ~a~%"
+                             (setuid-program-program program)
+                             (strerror (system-error-errno args))))))])
             programs))
 
 (define (activate-special-files special-files)
diff --git a/gnu/services.scm b/gnu/services.scm
index 4b30399adc..a5b4734152 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -87,6 +87,14 @@
             ambiguous-target-service-error-service
             ambiguous-target-service-error-target-type
 
+            setuid-program
+            setuid-program?
+            setuid-program-program
+            setuid-program-setuid?
+            setuid-program-setgid?
+            setuid-program-user
+            setuid-program-group
+
             system-service-type
             provenance-service-type
             sexp->system-provenance
@@ -773,13 +781,48 @@ directory."
 FILES must be a list of name/file-like object pairs."
   (service etc-service-type files))
 
+(define-record-type* <setuid-program> setuid-program make-setuid-program
+  setuid-program?
+  ;; Path to program to link with setuid permissions
+  (program       setuid-program-program)          ;string
+  ;; Whether to set user setuid bit
+  (setuid?       setuid-program-setuid?           ;boolean
+                 (default #t))
+  ;; Whether to set user setgid bit
+  (setgid?       setuid-program-setgid?           ;boolean
+                 (default #t))
+  ;; The user this should be set to (defaults to root)
+  (user          setuid-program-user              ;integer or string
+                 (default 0))
+  ;; Group we want to set this to (defaults to root)
+  (group         setuid-program-group             ;integer or string
+                 (default 0)))
+
+(define (setuid-program-entry programs)
+  #~(activate-setuid-programs
+     ;; convert into a tagged list structure as expected by
+     ;; activate-setuid-programs
+     (list #$@(map (match-lambda
+                     [(? setuid-program? sp)
+                      #~(list 'setuid-program
+                              #$(setuid-program-program sp)
+                              #$(setuid-program-setuid? sp)
+                              #$(setuid-program-setgid? sp)
+                              #$(setuid-program-user sp)
+                              #$(setuid-program-group sp))]
+                     ;; legacy, non-<setuid-program> structure
+                     [program
+                      ;; TODO: Spit out a warning here?
+                      #~(list 'setuid-program
+                              #$program
+                              #t #t 0 0)])
+                   programs))))
+
 (define setuid-program-service-type
   (service-type (name 'setuid-program)
                 (extensions
                  (list (service-extension activation-service-type
-                                          (lambda (programs)
-                                            #~(activate-setuid-programs
-                                               (list #$@programs))))))
+                                          setuid-program-entry)))
                 (compose concatenate)
                 (extend append)
                 (description
-- 
2.29.1
L
L
Ludovic Courtès wrote on 17 Nov 2020 10:46
(name . Christopher Lemmer Webber)(address . cwebber@dustycloud.org)(address . 44700@debbugs.gnu.org)
87r1oss4dg.fsf@gnu.org
Hello!

Christopher Lemmer Webber <cwebber@dustycloud.org> skribis:

Toggle quote (22 lines)
>>From eadac673fb22132c555a4e1cee57a6308ecfdad4 Mon Sep 17 00:00:00 2001
> From: Christopher Lemmer Webber <cwebber@dustycloud.org>
> Date: Sun, 15 Nov 2020 16:58:52 -0500
> Subject: [PATCH] services: setuid: More configurable setuid support.
>
> New record <setuid-program> with fields for setting the specific user and
> group, as well as specifically selecting the setuid and setgid bits, for a
> program within the setuid-program-service.
>
> * gnu/services.scm (<setuid-program>): New record type.
> (setuid-program, make-setuid-program, setuid-program?)
> (setuid-program-program, stuid-program-setuid?, setuid-program-setgid?)
> (setuid-program-user, setuid-program-group): New variables, export them.
> (setuid-program-entry): New variable, a procedure used for the
> service-extension of activation-service-type as set up by
> setuid-program-service-type. Unpacks the <setuid-program> record,
> handing off within the gexp to activate-setuid-programs.
> (setuid-program-service-type): Make use of setuid-program-entry.
> * gnu/build/activation.scm (activate-setuid-programs): Update to expect a
> ftagged list for each program entry, pre-unpacked from the <setuid-program>
> record before being handed to this procedure.

This looks like the right approach to me!

Toggle quote (19 lines)
> + (for-each (match-lambda
> + [('setuid-program src-path setuid? setgid? user group)
> + (let ((uid (match user
> + [(? string?) (passwd:uid (getpwnam user))]
> + [(? integer?) user]))
> + (gid (match group
> + [(? string?) (group:gid (getgrnam user))]
> + [(? integer?) group])))
> + (catch 'system-error
> + (lambda ()
> + (let ((target (string-append %setuid-directory
> + "/" (basename src-path)))
> + (mode (+ #o0555 ; base permissions
> + (if setuid? #o4000 0) ; setuid bit
> + (if setgid? #o2000 0)))) ; setgid bit
> + (copy-file src-path target)
> + (chown target uid gid)
> + (chmod target mode)))

Nitpick: I’d write “program” or “source” instead of “src-path” and avoid
square brackets for consistency with the rest of the code base (you
spent time in Racket-land, didn’t you? ;-)).

Toggle quote (20 lines)
> +(define (setuid-program-entry programs)
> + #~(activate-setuid-programs
> + ;; convert into a tagged list structure as expected by
> + ;; activate-setuid-programs
> + (list #$@(map (match-lambda
> + [(? setuid-program? sp)
> + #~(list 'setuid-program
> + #$(setuid-program-program sp)
> + #$(setuid-program-setuid? sp)
> + #$(setuid-program-setgid? sp)
> + #$(setuid-program-user sp)
> + #$(setuid-program-group sp))]
> + ;; legacy, non-<setuid-program> structure
> + [program
> + ;; TODO: Spit out a warning here?
> + #~(list 'setuid-program
> + #$program
> + #t #t 0 0)])
> + programs))))

Maybe what we could do is rename ‘operating-system-setuid-programs’ to
’%operating-system-setuid-programs’, keep that internal, and add a new
‘operating-system-setuid-programs’ that calls the other one and
“canonicalizes” list entries so that they’re all <setuid-program>
records.

It would call:

(warning log (G_ "representing setuid programs with strings is \
deprecated; use 'setuid-program' instead~%"))

WDYT?

Could you also update the “Setuid Programs” section of the manual?

In a subsequent commit, we need to adjust all the services that extend
‘setuid-program-service-type’ so they pass a <setuid-program> and not a
string.

Thanks!

Ludo’.
M
M
Maxim Cournoyer wrote on 17 Nov 2020 17:29
(name . Christopher Lemmer Webber)(address . cwebber@dustycloud.org)(address . 44700@debbugs.gnu.org)
875z64aqvw.fsf@gmail.com
Hello Christopher,

Christopher Lemmer Webber <cwebber@dustycloud.org> writes:

Toggle quote (24 lines)
> This patch allows for configuring the specific user, group, and whether
> to set the setuid and setgid bits.
>
> See also:
> https://lists.gnu.org/archive/html/guix-devel/2020-11/msg00369.html
>
> But I thought I'd open this here so we could track changes since this is
> technically independent of the postfix stuff. Anyway, patch attached.
> One change since the last email above is that I added support for
> string-based username/groups.
>
> This also needs documentation, I suppose, so that should be done.
> But it would be good to know if this patch looks like it's on the "right
> path" or not.
>
> From eadac673fb22132c555a4e1cee57a6308ecfdad4 Mon Sep 17 00:00:00 2001
> From: Christopher Lemmer Webber <cwebber@dustycloud.org>
> Date: Sun, 15 Nov 2020 16:58:52 -0500
> Subject: [PATCH] services: setuid: More configurable setuid support.
>
> New record <setuid-program> with fields for setting the specific user and
> group, as well as specifically selecting the setuid and setgid bits, for a
> program within the setuid-program-service.

Please make this a full sentence, e.g. "This adds a new record [...]".

Toggle quote (12 lines)
>
> * gnu/services.scm (<setuid-program>): New record type.
> (setuid-program, make-setuid-program, setuid-program?)
> (setuid-program-program, stuid-program-setuid?, setuid-program-setgid?)
> (setuid-program-user, setuid-program-group): New variables, export them.
> (setuid-program-entry): New variable, a procedure used for the
> service-extension of activation-service-type as set up by
> setuid-program-service-type. Unpacks the <setuid-program> record,
> handing off within the gexp to activate-setuid-programs.
> (setuid-program-service-type): Make use of setuid-program-entry.
> * gnu/build/activation.scm (activate-setuid-programs): Update to expect a
> ftagged list for each program entry, pre-unpacked from the <setuid-program>
^tagged
Toggle quote (2 lines)
> record before being handed to this procedure.

The doc needs to be updated, as well as the current uses in the code
base.

Toggle quote (21 lines)
> ---
> gnu/build/activation.scm | 46 +++++++++++++++++++++----------------
> gnu/services.scm | 49 +++++++++++++++++++++++++++++++++++++---
> 2 files changed, 73 insertions(+), 22 deletions(-)
>
> diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
> index 4b67926e88..fd17ce0434 100644
> --- a/gnu/build/activation.scm
> +++ b/gnu/build/activation.scm
> @@ -229,13 +229,6 @@ they already exist."
> (define (activate-setuid-programs programs)
> "Turn PROGRAMS, a list of file names, into setuid programs stored under
> %SETUID-DIRECTORY."
> - (define (make-setuid-program prog)
> - (let ((target (string-append %setuid-directory
> - "/" (basename prog))))
> - (copy-file prog target)
> - (chown target 0 0)
> - (chmod target #o6555)))
> -

I think it'd be nicer to keep that procedure here and extend it with the
logic added below, for readability.

Toggle quote (21 lines)
> (format #t "setting up setuid programs in '~a'...~%"
> %setuid-directory)
> (if (file-exists? %setuid-directory)
> @@ -247,18 +240,33 @@ they already exist."
> string<?))
> (mkdir-p %setuid-directory))
>
> - (for-each (lambda (program)
> - (catch 'system-error
> - (lambda ()
> - (make-setuid-program program))
> - (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
> - ;; incorrect file names: <https://bugs.gnu.org/38800>.
> - (format (current-error-port)
> - "warning: failed to make '~a' setuid-root: ~a~%"
> - program (strerror (system-error-errno args))))))
> + (for-each (match-lambda
> + [('setuid-program src-path setuid? setgid? user group)
^
There's a convention to not use square brackets in
the Guix code base, for uniformity.

Toggle quote (7 lines)
> + (let ((uid (match user
> + [(? string?) (passwd:uid (getpwnam user))]
> + [(? integer?) user]))
> + (gid (match group
> + [(? string?) (group:gid (getgrnam user))]
> + [(? integer?) group])))

The above code raise an un-handled exception, for example if the user or
group used doesn't exist. It should be moved to the above
MAKE-SETUID-PROGRAM procedure and called inside the guard.

Toggle quote (18 lines)
> + (catch 'system-error
> + (lambda ()
> + (let ((target (string-append %setuid-directory
> + "/" (basename src-path)))
> + (mode (+ #o0555 ; base permissions
> + (if setuid? #o4000 0) ; setuid bit
> + (if setgid? #o2000 0)))) ; setgid bit
> + (copy-file src-path target)
> + (chown target uid gid)
> + (chmod target mode)))
> + (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
> + ;; incorrect file names: <https://bugs.gnu.org/38800>.
> + (format (current-error-port)
> + "warning: failed to make '~a' setuid-root: ~a~%"

The above message should be adapted to say "failed to make ~s
setuid/setgid: ~a~%"

Toggle quote (39 lines)
> + (setuid-program-program program)
> + (strerror (system-error-errno args))))))])
> programs))
>
> (define (activate-special-files special-files)
> diff --git a/gnu/services.scm b/gnu/services.scm
> index 4b30399adc..a5b4734152 100644
> --- a/gnu/services.scm
> +++ b/gnu/services.scm
> @@ -87,6 +87,14 @@
> ambiguous-target-service-error-service
> ambiguous-target-service-error-target-type
>
> + setuid-program
> + setuid-program?
> + setuid-program-program
> + setuid-program-setuid?
> + setuid-program-setgid?
> + setuid-program-user
> + setuid-program-group
> +
> system-service-type
> provenance-service-type
> sexp->system-provenance
> @@ -773,13 +781,48 @@ directory."
> FILES must be a list of name/file-like object pairs."
> (service etc-service-type files))
>
> +(define-record-type* <setuid-program> setuid-program make-setuid-program
> + setuid-program?
> + ;; Path to program to link with setuid permissions
> + (program setuid-program-program) ;string
> + ;; Whether to set user setuid bit
> + (setuid? setuid-program-setuid? ;boolean
> + (default #t))
> + ;; Whether to set user setgid bit
> + (setgid? setuid-program-setgid? ;boolean
> + (default #t))

This departs from the previous default (not setgid was set). It's
probably more explicit to be set to #f as default, since the service is
still named 'setuid-program-service-type', so having it do gid stuff by
default could come as a surprise.

Toggle quote (22 lines)
> + ;; The user this should be set to (defaults to root)
> + (user setuid-program-user ;integer or string
> + (default 0))
> + ;; Group we want to set this to (defaults to root)
> + (group setuid-program-group ;integer or string
> + (default 0)))
> +(define (setuid-program-entry programs)
> + #~(activate-setuid-programs
> + ;; convert into a tagged list structure as expected by
> + ;; activate-setuid-programs
> + (list #$@(map (match-lambda
> + [(? setuid-program? sp)
> + #~(list 'setuid-program
> + #$(setuid-program-program sp)
> + #$(setuid-program-setuid? sp)
> + #$(setuid-program-setgid? sp)
> + #$(setuid-program-user sp)
> + #$(setuid-program-group sp))]
> + ;; legacy, non-<setuid-program> structure
> + [program
> + ;; TODO: Spit out a warning here?

A deprecation message should be printed, urging the users to use the new
interface, yes.

Toggle quote (17 lines)
> + #~(list 'setuid-program
> + #$program
> + #t #t 0 0)])
> + programs))))
> +
> (define setuid-program-service-type
> (service-type (name 'setuid-program)
> (extensions
> (list (service-extension activation-service-type
> - (lambda (programs)
> - #~(activate-setuid-programs
> - (list #$@programs))))))
> + setuid-program-entry)))
> (compose concatenate)
> (extend append)
> (description

With the above comments, this looks like a good change to me! I haven't
tested it yet, but intend to do so when I have a chance!

Thank you for working on it,

Maxim
C
C
Christopher Lemmer Webber wrote on 17 Nov 2020 17:31
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 44700@debbugs.gnu.org)
87sg98djxq.fsf@dustycloud.org
Ludovic Courtès writes:

Toggle quote (51 lines)
> Hello!
>
> Christopher Lemmer Webber <cwebber@dustycloud.org> skribis:
>
>>>From eadac673fb22132c555a4e1cee57a6308ecfdad4 Mon Sep 17 00:00:00 2001
>> From: Christopher Lemmer Webber <cwebber@dustycloud.org>
>> Date: Sun, 15 Nov 2020 16:58:52 -0500
>> Subject: [PATCH] services: setuid: More configurable setuid support.
>>
>> New record <setuid-program> with fields for setting the specific user and
>> group, as well as specifically selecting the setuid and setgid bits, for a
>> program within the setuid-program-service.
>>
>> * gnu/services.scm (<setuid-program>): New record type.
>> (setuid-program, make-setuid-program, setuid-program?)
>> (setuid-program-program, stuid-program-setuid?, setuid-program-setgid?)
>> (setuid-program-user, setuid-program-group): New variables, export them.
>> (setuid-program-entry): New variable, a procedure used for the
>> service-extension of activation-service-type as set up by
>> setuid-program-service-type. Unpacks the <setuid-program> record,
>> handing off within the gexp to activate-setuid-programs.
>> (setuid-program-service-type): Make use of setuid-program-entry.
>> * gnu/build/activation.scm (activate-setuid-programs): Update to expect a
>> ftagged list for each program entry, pre-unpacked from the <setuid-program>
>> record before being handed to this procedure.
>
> This looks like the right approach to me!
>
>> + (for-each (match-lambda
>> + [('setuid-program src-path setuid? setgid? user group)
>> + (let ((uid (match user
>> + [(? string?) (passwd:uid (getpwnam user))]
>> + [(? integer?) user]))
>> + (gid (match group
>> + [(? string?) (group:gid (getgrnam user))]
>> + [(? integer?) group])))
>> + (catch 'system-error
>> + (lambda ()
>> + (let ((target (string-append %setuid-directory
>> + "/" (basename src-path)))
>> + (mode (+ #o0555 ; base permissions
>> + (if setuid? #o4000 0) ; setuid bit
>> + (if setgid? #o2000 0)))) ; setgid bit
>> + (copy-file src-path target)
>> + (chown target uid gid)
>> + (chmod target mode)))
>
> Nitpick: I’d write “program” or “source” instead of “src-path” and avoid
> square brackets for consistency with the rest of the code base (you
> spent time in Racket-land, didn’t you? ;-)).

Sounds good. And yes, Racket influence is shining through, oops!

Toggle quote (26 lines)
>> +(define (setuid-program-entry programs)
>> + #~(activate-setuid-programs
>> + ;; convert into a tagged list structure as expected by
>> + ;; activate-setuid-programs
>> + (list #$@(map (match-lambda
>> + [(? setuid-program? sp)
>> + #~(list 'setuid-program
>> + #$(setuid-program-program sp)
>> + #$(setuid-program-setuid? sp)
>> + #$(setuid-program-setgid? sp)
>> + #$(setuid-program-user sp)
>> + #$(setuid-program-group sp))]
>> + ;; legacy, non-<setuid-program> structure
>> + [program
>> + ;; TODO: Spit out a warning here?
>> + #~(list 'setuid-program
>> + #$program
>> + #t #t 0 0)])
>> + programs))))
>
> Maybe what we could do is rename ‘operating-system-setuid-programs’ to
> ’%operating-system-setuid-programs’, keep that internal, and add a new
> ‘operating-system-setuid-programs’ that calls the other one and
> “canonicalizes” list entries so that they’re all <setuid-program>
> records.

"rename"? There is no operating-system-setuid-programs so I'm not sure
what you mean to rename from... setuid-program-entry, or presumably
activate-setuid-programs...?

Toggle quote (5 lines)
> It would call:
>
> (warning log (G_ "representing setuid programs with strings is \
> deprecated; use 'setuid-program' instead~%"))

Aha, I wasn't sure what to use for deprecation warnings actually, so
this is helpful, thanks!

Toggle quote (4 lines)
> WDYT?
>
> Could you also update the “Setuid Programs” section of the manual?

Happy to do it.

Toggle quote (4 lines)
> In a subsequent commit, we need to adjust all the services that extend
> ‘setuid-program-service-type’ so they pass a <setuid-program> and not a
> string.

Yes... let's worry about that once this interface is hammered out. :)

Glad it seems like the general approach was right though!

Toggle quote (3 lines)
> Thanks!
>
> Ludo’.
L
L
Ludovic Courtès wrote on 17 Nov 2020 21:48
(name . Christopher Lemmer Webber)(address . cwebber@dustycloud.org)(address . 44700@debbugs.gnu.org)
87d00bpv5h.fsf@gnu.org
Hi Chris!

Christopher Lemmer Webber <cwebber@dustycloud.org> skribis:

Toggle quote (2 lines)
> Ludovic Courtès writes:

[...]

Toggle quote (10 lines)
>> Maybe what we could do is rename ‘operating-system-setuid-programs’ to
>> ’%operating-system-setuid-programs’, keep that internal, and add a new
>> ‘operating-system-setuid-programs’ that calls the other one and
>> “canonicalizes” list entries so that they’re all <setuid-program>
>> records.
>
> "rename"? There is no operating-system-setuid-programs so I'm not sure
> what you mean to rename from... setuid-program-entry, or presumably
> activate-setuid-programs...?

I’m referring to the <operating-system> accessor called
‘operating-system-setuid-programs’, in (gnu system).

Does that make sense?

Thanks,
Ludo’.
C
C
Christopher Lemmer Webber wrote on 14 Apr 2021 19:06
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 44700@debbugs.gnu.org)
87v98o94ob.fsf@dustycloud.org
Ludovic Courtès writes:

Toggle quote (21 lines)
> Hi Chris!
>
> Christopher Lemmer Webber <cwebber@dustycloud.org> skribis:
>
>> Ludovic Courtès writes:
>
> [...]
>
>>> Maybe what we could do is rename ‘operating-system-setuid-programs’ to
>>> ’%operating-system-setuid-programs’, keep that internal, and add a new
>>> ‘operating-system-setuid-programs’ that calls the other one and
>>> “canonicalizes” list entries so that they’re all <setuid-program>
>>> records.
>>
>> "rename"? There is no operating-system-setuid-programs so I'm not sure
>> what you mean to rename from... setuid-program-entry, or presumably
>> activate-setuid-programs...?
>
> I’m referring to the <operating-system> accessor called
> ‘operating-system-setuid-programs’, in (gnu system).

I think it makes sense from the fog of my memory of this issue. But I'm
also going to note: I haven't gotten to this in a while, and I feel
guilty about that. :(

I'm very overwhelmed right now. If nobody picks this up where I left it
off I probably can, but I am probably blocked for the next couple of
months with urgent tasks... which is a shame for something that looked
so close to landing. If anyone wants to get this to the last mile and
address Ludo's feedback they are welcome to in the meanwhile.
B
B
Brice Waegeneire wrote on 3 Jul 2021 18:51
[PATCH v2 0/2] services: setuid: More configurable setuid support.
(address . 44700@debbugs.gnu.org)(address . cwebber@dustycloud.org)
20210703165127.12316-1-brice@waegenei.re
Hello Christopher,

Some times ago I continued your patch from where you left it. If I recall
correctly it should address all the suggestions from Ludo' and Maxim. I'm
using it for several month now without any issue.

Thank your for your work on this issue Christopher!

Cheers,
- Brice

Brice Waegeneire (1):
services: Migrate to <setuid-program>.

Christopher Lemmer Webber (1):
services: setuid: More configurable setuid support.

gnu/build/activation.scm | 38 ++++++++++++++++++++-------
gnu/services.scm | 45 ++++++++++++++++++++++++++++---
gnu/services/dbus.scm | 13 ++++++---
gnu/services/desktop.scm | 26 +++++++++++-------
gnu/services/docker.scm | 9 ++++---
gnu/services/xorg.scm | 4 ++-
gnu/system.scm | 45 +++++++++++++++++--------------
gnu/system/setuid.scm | 57 ++++++++++++++++++++++++++++++++++++++++
8 files changed, 186 insertions(+), 51 deletions(-)
create mode 100644 gnu/system/setuid.scm

--
2.31.1
B
B
Brice Waegeneire wrote on 3 Jul 2021 18:51
[PATCH v2 2/2] services: Migrate to <setuid-program>.
(address . 44700@debbugs.gnu.org)(address . cwebber@dustycloud.org)
20210703165127.12316-3-brice@waegenei.re
* 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.
---
gnu/services/dbus.scm | 13 +++++++++----
gnu/services/desktop.scm | 26 ++++++++++++++++----------
gnu/services/docker.scm | 9 ++++++---
gnu/services/xorg.scm | 4 +++-
gnu/system.scm | 31 ++++++++++++++++---------------
5 files changed, 50 insertions(+), 33 deletions(-)

Toggle diff (213 lines)
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..6297b8eb0b 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 96b45ede96..8a70f86457 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -1074,22 +1074,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'
-- 
2.31.1
B
B
Brice Waegeneire wrote on 3 Jul 2021 18:51
[PATCH v2 1/2] services: setuid: More configurable setuid support.
(address . 44700@debbugs.gnu.org)
20210703165127.12316-2-brice@waegenei.re
From: Christopher Lemmer Webber <cwebber@dustycloud.org>

New record <setuid-program> with fields for setting the specific user
and group, as well as specifically selecting the setuid and setgid bits,
for a program within the setuid-program-service.

* gnu/services.scm (setuid-program-file-like-deprecated): New function.
(setuid-program-service-type): Make use of
setuid-program->activation-gexp. Adjust the extend property to handle
<setuid-program>.
* gnu/build/activation.scm (activate-setuid-programs): Update to expect a
<setuid-record> list for each program entry.
* gnu/system.scm: (operating-system-setuid-programs): Renamed to
%operating-system-setuid-programs and replace it with new procedure.
(operating-system-default-essential-services,
hurd-default-essential-services): Replace
operating-system-setuid-programs with %operating-system-setuid-programs.
* gnu/system/setuid.scm: New file.

Co-authored-by: Brice Waegeneire <brice@waegenei.re>
---
gnu/build/activation.scm | 38 ++++++++++++++++++++-------
gnu/services.scm | 45 ++++++++++++++++++++++++++++---
gnu/system.scm | 14 +++++++---
gnu/system/setuid.scm | 57 ++++++++++++++++++++++++++++++++++++++++
4 files changed, 136 insertions(+), 18 deletions(-)
create mode 100644 gnu/system/setuid.scm

Toggle diff (277 lines)
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index 2af1d44b5f..ab9255d095 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -6,6 +6,8 @@
 ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2020 Christopher Lemmer Webber <cwebber@dustycloud.org>
+;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,6 +26,7 @@
 
 (define-module (gnu build activation)
   #:use-module (gnu system accounts)
+  #:use-module (gnu system setuid)
   #:use-module (gnu build accounts)
   #:use-module (gnu build linux-boot)
   #:use-module (guix build utils)
@@ -279,14 +282,17 @@ they already exist."
   "/run/setuid-programs")
 
 (define (activate-setuid-programs programs)
-  "Turn PROGRAMS, a list of file names, into setuid programs stored under
-%SETUID-DIRECTORY."
-  (define (make-setuid-program prog)
+  "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
-                                 "/" (basename prog))))
-      (copy-file prog target)
-      (chown target 0 0)
-      (chmod target #o4555)))
+                                 "/" (basename program)))
+          (mode (+ #o0555                   ; base permissions
+                   (if setuid? #o4000 0)    ; setuid bit
+                   (if setgid? #o2000 0)))) ; setgid bit
+      (copy-file program target)
+      (chown target uid gid)
+      (chmod target mode)))
 
   (format #t "setting up setuid programs in '~a'...~%"
           %setuid-directory)
@@ -302,15 +308,27 @@ they already exist."
   (for-each (lambda (program)
               (catch 'system-error
                 (lambda ()
-                  (make-setuid-program program))
+                  (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))
+                         (uid (match user
+                                ((? string?) (passwd:uid (getpwnam user)))
+                                ((? integer?) user)))
+                         (gid (match group
+                                ((? string?) (group:gid (getgrnam group)))
+                                ((? integer?) group))))
+                    (make-setuid-program program-name setuid? setgid? uid gid)))
                 (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
                   ;; incorrect file names: <https://bugs.gnu.org/38800>.
                   (format (current-error-port)
-                          "warning: failed to make '~a' setuid-root: ~a~%"
-                          program (strerror (system-error-errno args))))))
+                          "warning: failed to make ~s setuid/setgid: ~a~%"
+                          (setuid-program-program program)
+                          (strerror (system-error-errno args))))))
             programs))
 
 (define (activate-special-files special-files)
diff --git a/gnu/services.scm b/gnu/services.scm
index 8d413e198e..2f5f67b3a1 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -4,6 +4,8 @@
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com>
+;;; Copyright © 2020 Christopher Lemmer Webber <cwebber@dustycloud.org>
+;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -40,6 +42,7 @@
   #: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)
@@ -801,15 +804,49 @@ directory."
 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-file-like-deprecated file-like)
+  (match file-like
+    ((? file-like? program)
+     (warning
+      (G_ "representing setuid programs with '~a' is \
+deprecated; use 'setuid-program' instead~%") program)
+     (setuid-program (program program)))
+    ((? setuid-program? program)
+     program)))
+
 (define setuid-program-service-type
   (service-type (name 'setuid-program)
                 (extensions
                  (list (service-extension activation-service-type
-                                          (lambda (programs)
-                                            #~(activate-setuid-programs
-                                               (list #$@programs))))))
+                                          setuid-program->activation-gexp)))
                 (compose concatenate)
-                (extend append)
+                (extend (lambda (config extensions)
+                          (map setuid-program-file-like-deprecated
+                               (append config extensions))))
                 (description
                  "Populate @file{/run/setuid-programs} with the specified
 executables, making them setuid-root.")))
diff --git a/gnu/system.scm b/gnu/system.scm
index 8a3ae27d04..96b45ede96 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -7,7 +7,7 @@
 ;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com>
 ;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>
 ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
-;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <jannek@gnu.org>
@@ -74,6 +74,7 @@
   #:use-module (gnu system locale)
   #:use-module (gnu system pam)
   #:use-module (gnu system linux-initrd)
+  #:use-module (gnu system setuid)
   #:use-module (gnu system uuid)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system mapped-devices)
@@ -267,7 +268,7 @@
 
   (pam-services operating-system-pam-services     ; list of PAM services
                 (default (base-pam-services)))
-  (setuid-programs operating-system-setuid-programs
+  (setuid-programs %operating-system-setuid-programs
                    (default %setuid-programs))    ; list of string-valued gexps
 
   (sudoers-file operating-system-sudoers-file     ; file-like
@@ -671,7 +672,7 @@ bookkeeping."
             (operating-system-environment-variables os))
            host-name procs root-fs
            (service setuid-program-service-type
-                    (operating-system-setuid-programs os))
+                    (%operating-system-setuid-programs os))
            (service profile-service-type
                     (operating-system-packages os))
            other-fs
@@ -701,7 +702,7 @@ bookkeeping."
           (pam-root-service (operating-system-pam-services os))
           (operating-system-etc-service os)
           (service setuid-program-service-type
-                   (operating-system-setuid-programs os))
+                   (%operating-system-setuid-programs os))
           (service profile-service-type (operating-system-packages os)))))
 
 (define* (operating-system-services os)
@@ -1065,6 +1066,11 @@ use 'plain-file' instead~%")
     ;; TODO: Remove when glibc@2.23 is long gone.
     ("GUIX_LOCPATH" . "/run/current-system/locale")))
 
+(define (operating-system-setuid-programs os)
+  "Return the setuid programs for OS, as a list of setuid-program record."
+  (map file-like->setuid-program
+         (%operating-system-setuid-programs os)))
+
 (define %setuid-programs
   ;; Default set of setuid-root programs.
   (let ((shadow (@ (gnu packages admin) shadow)))
diff --git a/gnu/system/setuid.scm b/gnu/system/setuid.scm
new file mode 100644
index 0000000000..e8b9c0df81
--- /dev/null
+++ b/gnu/system/setuid.scm
@@ -0,0 +1,57 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system setuid)
+  #:use-module (guix records)
+  #:export (setuid-program
+            setuid-program?
+            setuid-program-program
+            setuid-program-setuid?
+            setuid-program-setgid?
+            setuid-program-user
+            setuid-program-group
+
+            file-like->setuid-program))
+
+;;; Commentary:
+;;;
+;;; Data structures representing setuid/setgid programs.  This is meant to be
+;;; used both on the host side and at run time--e.g., in activation snippets.
+;;;
+;;; Code:
+
+(define-record-type* <setuid-program>
+  setuid-program make-setuid-program
+  setuid-program?
+  ;; Path to program to link with setuid permissions
+  (program       setuid-program-program) ;file-like
+  ;; Whether to set user setuid bit
+  (setuid?       setuid-program-setuid? ;boolean
+                 (default #t))
+  ;; Whether to set user setgid bit
+  (setgid?       setuid-program-setgid? ;boolean
+                 (default #f))
+  ;; The user this should be set to (defaults to root)
+  (user          setuid-program-user    ;integer or string
+                 (default 0))
+  ;; Group we want to set this to (defaults to root)
+  (group         setuid-program-group   ;integer or string
+                 (default 0)))
+
+(define (file-like->setuid-program program)
+  (setuid-program (program program)))
-- 
2.31.1
C
C
Chris Lemmer-Webber wrote on 5 Jul 2021 17:28
Re: [PATCH v2 2/2] services: Migrate to <setuid-program>.
(name . Brice Waegeneire)(address . brice@waegenei.re)(address . 44700@debbugs.gnu.org)
87v95oeq58.fsf@dustycloud.org
Brice Waegeneire writes:

Toggle quote (10 lines)
> * 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.

Again, probably want to indent consistently here. I think two spaces.

(However I guess this kind of indentation is not actually considered
standard for GNU changelog style, but Guix folks including myself tend
to do it...)

Toggle quote (42 lines)
> * gnu/system.scm (%setuid-programs): Return setuid-programs.
> ---
> gnu/services/dbus.scm | 13 +++++++++----
> gnu/services/desktop.scm | 26 ++++++++++++++++----------
> gnu/services/docker.scm | 9 ++++++---
> gnu/services/xorg.scm | 4 +++-
> gnu/system.scm | 31 ++++++++++++++++---------------
> 5 files changed, 50 insertions(+), 33 deletions(-)
>
> 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")))))))

Ooh, nice job updating all these other places to use the
<setuid-program> record also!

Toggle quote (179 lines)
> (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..6297b8eb0b 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 96b45ede96..8a70f86457 100644
> --- a/gnu/system.scm
> +++ b/gnu/system.scm
> @@ -1074,22 +1074,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'

This looks very good. The comments I made were minor (my name, some
indentation stuff). Otherwise else I think it looks good to merge.

With those changes (indentation stuff, and then my name change) I think
it's good to push! This will be a great thing to get in... then
hopefully postfix can come next!
B
B
Brice Waegeneire wrote on 6 Jul 2021 22:03
[PATCH v3 0/2] More configurable setuid/setgid support
(address . 44700@debbugs.gnu.org)(address . cwebber@dustycloud.org)
20210706200320.27113-1-brice@waegenei.re
I have changed Chris name, identend the commit message. And documented that
new record.

Brice Waegeneire (1):
services: Migrate to <setuid-program>.

Chris Lemmer-Webber (1):
services: setuid: More configurable setuid support.

doc/guix.texi | 43 ++++++++++++++++++++++++------
gnu/build/activation.scm | 38 ++++++++++++++++++++-------
gnu/services.scm | 45 ++++++++++++++++++++++++++++---
gnu/services/dbus.scm | 13 ++++++---
gnu/services/desktop.scm | 26 +++++++++++-------
gnu/services/docker.scm | 9 ++++---
gnu/services/xorg.scm | 4 ++-
gnu/system.scm | 45 +++++++++++++++++--------------
gnu/system/setuid.scm | 57 ++++++++++++++++++++++++++++++++++++++++
9 files changed, 221 insertions(+), 59 deletions(-)
create mode 100644 gnu/system/setuid.scm

--
2.31.1
B
B
Brice Waegeneire wrote on 6 Jul 2021 22:03
[PATCH v3 1/2] services: setuid: More configurable setuid support.
(address . 44700@debbugs.gnu.org)
20210706200320.27113-2-brice@waegenei.re
From: Chris Lemmer-Webber <cwebber@dustycloud.org>

New record <setuid-program> with fields for setting the specific user
and group, as well as specifically selecting the setuid and setgid bits,
for a program within the setuid-program-service.

* gnu/services.scm (setuid-program-file-like-deprecated): New function.
(setuid-program-service-type): Make use of
setuid-program->activation-gexp. Adjust the extend property to handle
<setuid-program>.
* gnu/build/activation.scm (activate-setuid-programs): Update to expect a
<setuid-record> list for each program entry.
* gnu/system.scm: (operating-system-setuid-programs): Renamed to
%operating-system-setuid-programs and replace it with new procedure.
(operating-system-default-essential-services,
hurd-default-essential-services): Replace
operating-system-setuid-programs with
%operating-system-setuid-programs.
* gnu/system/setuid.scm: New file.
* doc/guix.texi (Setuid Programs): Document <setuid-program>.

Co-authored-by: Brice Waegeneire <brice@waegenei.re>
---
doc/guix.texi | 24 +++++++++++++++++
gnu/build/activation.scm | 38 ++++++++++++++++++++-------
gnu/services.scm | 45 ++++++++++++++++++++++++++++---
gnu/system.scm | 14 +++++++---
gnu/system/setuid.scm | 57 ++++++++++++++++++++++++++++++++++++++++
5 files changed, 160 insertions(+), 18 deletions(-)
create mode 100644 gnu/system/setuid.scm

Toggle diff (312 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index 94e430b647..f7a72b9885 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -32430,6 +32430,30 @@ package, can be designated by this G-expression (@pxref{G-Expressions}):
 #~(string-append #$shadow "/bin/passwd")
 @end example
 
+@deftp {Data Type} setuid-program
+This data type represents a program with a setuid or setgid bit set.
+
+@table @asis
+@item @code{program}
+A file-like object having its setuid and/or setgid bit set.
+
+@item @code{setuid?} (default: @code{#t})
+Whether to set user setuid bit.
+
+@item @code{setgid?} (default: @code{#f})
+Whether to set group setgid bit.
+
+@item @code{user} (default: @code{0})
+UID (integer) or user name (string) for the user owner of the program,
+defaults to root.
+
+@item @code{group} (default: @code{0})
+GID (integer) goup name (string) for the group owner of the program,
+defaults to root.
+
+@end table
+@end deftp
+
 A default set of setuid programs is defined by the
 @code{%setuid-programs} variable of the @code{(gnu system)} module.
 
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index 2af1d44b5f..04559014cb 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -6,6 +6,8 @@
 ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2020 Chris Lemmer-Webber <cwebber@dustycloud.org>
+;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,6 +26,7 @@
 
 (define-module (gnu build activation)
   #:use-module (gnu system accounts)
+  #:use-module (gnu system setuid)
   #:use-module (gnu build accounts)
   #:use-module (gnu build linux-boot)
   #:use-module (guix build utils)
@@ -279,14 +282,17 @@ they already exist."
   "/run/setuid-programs")
 
 (define (activate-setuid-programs programs)
-  "Turn PROGRAMS, a list of file names, into setuid programs stored under
-%SETUID-DIRECTORY."
-  (define (make-setuid-program prog)
+  "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
-                                 "/" (basename prog))))
-      (copy-file prog target)
-      (chown target 0 0)
-      (chmod target #o4555)))
+                                 "/" (basename program)))
+          (mode (+ #o0555                   ; base permissions
+                   (if setuid? #o4000 0)    ; setuid bit
+                   (if setgid? #o2000 0)))) ; setgid bit
+      (copy-file program target)
+      (chown target uid gid)
+      (chmod target mode)))
 
   (format #t "setting up setuid programs in '~a'...~%"
           %setuid-directory)
@@ -302,15 +308,27 @@ they already exist."
   (for-each (lambda (program)
               (catch 'system-error
                 (lambda ()
-                  (make-setuid-program program))
+                  (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))
+                         (uid (match user
+                                ((? string?) (passwd:uid (getpwnam user)))
+                                ((? integer?) user)))
+                         (gid (match group
+                                ((? string?) (group:gid (getgrnam group)))
+                                ((? integer?) group))))
+                    (make-setuid-program program-name setuid? setgid? uid gid)))
                 (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
                   ;; incorrect file names: <https://bugs.gnu.org/38800>.
                   (format (current-error-port)
-                          "warning: failed to make '~a' setuid-root: ~a~%"
-                          program (strerror (system-error-errno args))))))
+                          "warning: failed to make ~s setuid/setgid: ~a~%"
+                          (setuid-program-program program)
+                          (strerror (system-error-errno args))))))
             programs))
 
 (define (activate-special-files special-files)
diff --git a/gnu/services.scm b/gnu/services.scm
index de9d1a0bb8..bd2a0b3acc 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -4,6 +4,8 @@
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com>
+;;; Copyright © 2020 Chris Lemmer-Webber <cwebber@dustycloud.org>
+;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -40,6 +42,7 @@
   #: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)
@@ -796,15 +799,49 @@ directory."
 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-file-like-deprecated file-like)
+  (match file-like
+    ((? file-like? program)
+     (warning
+      (G_ "representing setuid programs with '~a' is \
+deprecated; use 'setuid-program' instead~%") program)
+     (setuid-program (program program)))
+    ((? setuid-program? program)
+     program)))
+
 (define setuid-program-service-type
   (service-type (name 'setuid-program)
                 (extensions
                  (list (service-extension activation-service-type
-                                          (lambda (programs)
-                                            #~(activate-setuid-programs
-                                               (list #$@programs))))))
+                                          setuid-program->activation-gexp)))
                 (compose concatenate)
-                (extend append)
+                (extend (lambda (config extensions)
+                          (map setuid-program-file-like-deprecated
+                               (append config extensions))))
                 (description
                  "Populate @file{/run/setuid-programs} with the specified
 executables, making them setuid-root.")))
diff --git a/gnu/system.scm b/gnu/system.scm
index a173bcbee5..385c36a484 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -7,7 +7,7 @@
 ;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com>
 ;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>
 ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
-;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <jannek@gnu.org>
@@ -76,6 +76,7 @@
   #:use-module (gnu system locale)
   #:use-module (gnu system pam)
   #:use-module (gnu system linux-initrd)
+  #:use-module (gnu system setuid)
   #:use-module (gnu system uuid)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system mapped-devices)
@@ -269,7 +270,7 @@
 
   (pam-services operating-system-pam-services     ; list of PAM services
                 (default (base-pam-services)))
-  (setuid-programs operating-system-setuid-programs
+  (setuid-programs %operating-system-setuid-programs
                    (default %setuid-programs))    ; list of string-valued gexps
 
   (sudoers-file operating-system-sudoers-file     ; file-like
@@ -714,7 +715,7 @@ bookkeeping."
             (operating-system-environment-variables os))
            host-name procs root-fs
            (service setuid-program-service-type
-                    (operating-system-setuid-programs os))
+                    (%operating-system-setuid-programs os))
            (service profile-service-type
                     (operating-system-packages os))
            (service modprobe-service-type)
@@ -745,7 +746,7 @@ bookkeeping."
           (pam-root-service (operating-system-pam-services os))
           (operating-system-etc-service os)
           (service setuid-program-service-type
-                   (operating-system-setuid-programs os))
+                   (%operating-system-setuid-programs os))
           (service profile-service-type (operating-system-packages os)))))
 
 (define* (operating-system-services os)
@@ -1096,6 +1097,11 @@ use 'plain-file' instead~%")
     ;; TODO: Remove when glibc@2.23 is long gone.
     ("GUIX_LOCPATH" . "/run/current-system/locale")))
 
+(define (operating-system-setuid-programs os)
+  "Return the setuid programs for OS, as a list of setuid-program record."
+  (map file-like->setuid-program
+         (%operating-system-setuid-programs os)))
+
 (define %setuid-programs
   ;; Default set of setuid-root programs.
   (let ((shadow (@ (gnu packages admin) shadow)))
diff --git a/gnu/system/setuid.scm b/gnu/system/setuid.scm
new file mode 100644
index 0000000000..83111d932c
--- /dev/null
+++ b/gnu/system/setuid.scm
@@ -0,0 +1,57 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system setuid)
+  #:use-module (guix records)
+  #:export (setuid-program
+            setuid-program?
+            setuid-program-program
+            setuid-program-setuid?
+            setuid-program-setgid?
+            setuid-program-user
+            setuid-program-group
+
+            file-like->setuid-program))
+
+;;; Commentary:
+;;;
+;;; Data structures representing setuid/setgid programs.  This is meant to be
+;;; used both on the host side and at run time--e.g., in activation snippets.
+;;;
+;;; Code:
+
+(define-record-type* <setuid-program>
+  setuid-program make-setuid-program
+  setuid-program?
+  ;; Path to program to link with setuid permissions
+  (program       setuid-program-program) ;file-like
+  ;; Whether to set user setuid bit
+  (setuid?       setuid-program-setuid? ;boolean
+                 (default #t))
+  ;; Whether to set group setgid bit
+  (setgid?       setuid-program-setgid? ;boolean
+                 (default #f))
+  ;; The user this should be set to (defaults to root)
+  (user          setuid-program-user    ;integer or string
+                 (default 0))
+  ;; Group we want to set this to (defaults to root)
+  (group         setuid-program-group   ;integer or string
+                 (default 0)))
+
+(define (file-like->setuid-program program)
+  (setuid-program (program program)))
-- 
2.31.1
B
B
Brice Waegeneire wrote on 6 Jul 2021 22:03
[PATCH v3 2/2] services: Migrate to <setuid-program>.
(address . 44700@debbugs.gnu.org)(address . cwebber@dustycloud.org)
20210706200320.27113-3-brice@waegenei.re
* 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(-)

Toggle diff (259 lines)
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'
-- 
2.31.1
C
C
Chris Lemmer-Webber wrote on 7 Jul 2021 19:41
(name . Brice Waegeneire)(address . brice@waegenei.re)(address . 44700@debbugs.gnu.org)
87sg0qc98z.fsf@dustycloud.org
Looks good to me. I'd say push it... let's not let this bitrot again!

Brice Waegeneire writes:

Toggle quote (278 lines)
> * 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'
C
C
Christine Lemmer-Webber wrote on 29 Jul 2021 18:04
(name . Brice Waegeneire)(address . brice@waegenei.re)(address . 44700@debbugs.gnu.org)
87mtq5ksxz.fsf@dustycloud.org
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:

Toggle quote (282 lines)
> 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'
C
C
Christine Lemmer-Webber wrote on 29 Jul 2021 18:16
(name . Brice Waegeneire)(address . brice@waegenei.re)(address . 44700@debbugs.gnu.org)
87k0l9ksdj.fsf@dustycloud.org
Got the all clear to push to master. Rebased and pushed! :)

Christine Lemmer-Webber writes:

Toggle quote (293 lines)
> 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'
C
C
Christine Lemmer-Webber wrote on 29 Jul 2021 18:18
(name . Brice Waegeneire)(address . brice@waegenei.re)(address . 44700-done@debbugs.gnu.org)
87h7gdks9y.fsf@dustycloud.org
Oh, forgot to close it.

Christine Lemmer-Webber writes:

Toggle quote (297 lines)
> 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'
Closed
L
L
Ludovic Courtès wrote on 12 Aug 2021 12:37
Re: bug#44700: services: setuid: More configurable setuid support.
(name . Christine Lemmer-Webber)(address . cwebber@dustycloud.org)
87wnorgd9f.fsf_-_@gnu.org
Howdy Christine & all!

I’ve just pushed minor tweaks to ‘setuid-programs’ deprecation handling:

8b9a5641bc system: install, hurd: Use 'setuid-programs'.
2826f488e4 system: Accept gexps in 'setuid-programs'.
e0bd47b4fd system: Handle 'setuid-programs' deprecation handling as a field sanitizer.
5291fd7a42 records: Support field sanitizers.

This uses the “field sanitizers” that landed in core-updates a few weeks
ago, and it allows us to emit only one warning per ‘setuid-programs’
field, with source location info:

gnu/system/hurd.scm:105:2: warning: representing setuid programs with file-like objects is deprecated; use 'setuid-program' instead

Let me know if anything’s amiss!

Ludo’.
C
C
Christine Lemmer-Webber wrote on 12 Aug 2021 18:06
(name . Ludovic Courtès)(address . ludo@gnu.org)
878s16abrl.fsf@dustycloud.org
This sounds really good, thank you!

Ludovic Courtès writes:

Toggle quote (18 lines)
> Howdy Christine & all!
>
> I’ve just pushed minor tweaks to ‘setuid-programs’ deprecation handling:
>
> 8b9a5641bc system: install, hurd: Use 'setuid-programs'.
> 2826f488e4 system: Accept gexps in 'setuid-programs'.
> e0bd47b4fd system: Handle 'setuid-programs' deprecation handling as a field sanitizer.
> 5291fd7a42 records: Support field sanitizers.
>
> This uses the “field sanitizers” that landed in core-updates a few weeks
> ago, and it allows us to emit only one warning per ‘setuid-programs’
> field, with source location info:
>
> gnu/system/hurd.scm:105:2: warning: representing setuid programs with file-like objects is deprecated; use 'setuid-program' instead
>
> Let me know if anything’s amiss!
>
> Ludo’.
?
Your comment

This issue is archived.

To comment on this conversation send email to 44700@debbugs.gnu.org