GNU bug report logs - #44700
services: setuid: More configurable setuid support.

Previous Next

Package: guix-patches;

Reported by: Christopher Lemmer Webber <cwebber <at> dustycloud.org>

Date: Mon, 16 Nov 2020 23:31:02 UTC

Severity: normal

Done: Christine Lemmer-Webber <cwebber <at> dustycloud.org>

Bug is archived. No further changes may be made.

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 44700 in the body.
You can then email your comments to 44700 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

View this report as an mbox folder, status mbox, maintainer mbox


Report forwarded to guix-patches <at> gnu.org:
bug#44700; Package guix-patches. (Mon, 16 Nov 2020 23:31:02 GMT) Full text and rfc822 format available.

Acknowledgement sent to Christopher Lemmer Webber <cwebber <at> dustycloud.org>:
New bug report received and forwarded. Copy sent to guix-patches <at> gnu.org. (Mon, 16 Nov 2020 23:31:02 GMT) Full text and rfc822 format available.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Christopher Lemmer Webber <cwebber <at> dustycloud.org>
To: guix-patches <at> gnu.org
Subject: services: setuid: More configurable setuid support.
Date: Mon, 16 Nov 2020 18:29:11 -0500
[Message part 1 (text/plain, inline)]
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.

[0001-services-setuid-More-configurable-setuid-support.patch (text/x-patch, inline)]
From eadac673fb22132c555a4e1cee57a6308ecfdad4 Mon Sep 17 00:00:00 2001
From: Christopher Lemmer Webber <cwebber <at> 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(-)

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


Information forwarded to guix-patches <at> gnu.org:
bug#44700; Package guix-patches. (Tue, 17 Nov 2020 09:47:01 GMT) Full text and rfc822 format available.

Message #8 received at 44700 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Christopher Lemmer Webber <cwebber <at> dustycloud.org>
Cc: 44700 <at> debbugs.gnu.org
Subject: Re: [bug#44700] services: setuid: More configurable setuid support.
Date: Tue, 17 Nov 2020 10:46:03 +0100
Hello!

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

>>From eadac673fb22132c555a4e1cee57a6308ecfdad4 Mon Sep 17 00:00:00 2001
> From: Christopher Lemmer Webber <cwebber <at> 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? ;-)).

> +(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’.




Information forwarded to guix-patches <at> gnu.org:
bug#44700; Package guix-patches. (Tue, 17 Nov 2020 16:30:02 GMT) Full text and rfc822 format available.

Message #11 received at 44700 <at> debbugs.gnu.org (full text, mbox):

From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
To: Christopher Lemmer Webber <cwebber <at> dustycloud.org>
Cc: 44700 <at> debbugs.gnu.org
Subject: Re: [bug#44700] services: setuid: More configurable setuid support.
Date: Tue, 17 Nov 2020 11:29:23 -0500
Hello Christopher,

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

> 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 <at> 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 [...]".

>
> * 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
>   record before being handed to this procedure.

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

> ---
>  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.

>    (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.

> +               (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.

> +                 (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~%"

> +                             (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.

> +  ;; 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.

> +                      #~(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




Information forwarded to guix-patches <at> gnu.org:
bug#44700; Package guix-patches. (Tue, 17 Nov 2020 16:33:02 GMT) Full text and rfc822 format available.

Message #14 received at 44700 <at> debbugs.gnu.org (full text, mbox):

From: Christopher Lemmer Webber <cwebber <at> dustycloud.org>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 44700 <at> debbugs.gnu.org
Subject: Re: [bug#44700] services: setuid: More configurable setuid support.
Date: Tue, 17 Nov 2020 11:31:13 -0500
Ludovic Courtès writes:

> Hello!
>
> Christopher Lemmer Webber <cwebber <at> dustycloud.org> skribis:
>
>>>From eadac673fb22132c555a4e1cee57a6308ecfdad4 Mon Sep 17 00:00:00 2001
>> From: Christopher Lemmer Webber <cwebber <at> 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!

>> +(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...?

> 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!

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

Happy to do it.

> 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!

> Thanks!
>
> Ludo’.





Information forwarded to guix-patches <at> gnu.org:
bug#44700; Package guix-patches. (Tue, 17 Nov 2020 20:49:02 GMT) Full text and rfc822 format available.

Message #17 received at 44700 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Christopher Lemmer Webber <cwebber <at> dustycloud.org>
Cc: 44700 <at> debbugs.gnu.org
Subject: Re: [bug#44700] services: setuid: More configurable setuid support.
Date: Tue, 17 Nov 2020 21:48:10 +0100
Hi Chris!

Christopher Lemmer Webber <cwebber <at> 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).

Does that make sense?

Thanks,
Ludo’.




Information forwarded to guix-patches <at> gnu.org:
bug#44700; Package guix-patches. (Wed, 14 Apr 2021 17:07:02 GMT) Full text and rfc822 format available.

Message #20 received at 44700 <at> debbugs.gnu.org (full text, mbox):

From: Christopher Lemmer Webber <cwebber <at> dustycloud.org>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 44700 <at> debbugs.gnu.org
Subject: Re: [bug#44700] services: setuid: More configurable setuid support.
Date: Wed, 14 Apr 2021 13:06:28 -0400
Ludovic Courtès writes:

> Hi Chris!
>
> Christopher Lemmer Webber <cwebber <at> 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.





Information forwarded to guix-patches <at> gnu.org:
bug#44700; Package guix-patches. (Sat, 03 Jul 2021 16:52:01 GMT) Full text and rfc822 format available.

Message #23 received at 44700 <at> debbugs.gnu.org (full text, mbox):

From: Brice Waegeneire <brice <at> waegenei.re>
To: 44700 <at> debbugs.gnu.org
Cc: cwebber <at> dustycloud.org
Subject: [PATCH v2 0/2] services: setuid: More configurable setuid support.
Date: Sat,  3 Jul 2021 18:51:25 +0200
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





Information forwarded to guix-patches <at> gnu.org:
bug#44700; Package guix-patches. (Sat, 03 Jul 2021 16:52:02 GMT) Full text and rfc822 format available.

Message #26 received at 44700 <at> debbugs.gnu.org (full text, mbox):

From: Brice Waegeneire <brice <at> waegenei.re>
To: 44700 <at> debbugs.gnu.org
Cc: cwebber <at> dustycloud.org
Subject: [PATCH v2 2/2] services: Migrate to <setuid-program>.
Date: Sat,  3 Jul 2021 18:51:27 +0200
* 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(-)

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 <at> gnu.org>
 ;;; Copyright © 2015 Sou Bunnbu <iyzsong <at> gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
+;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> daviwil.com>
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me <at> tobias.gr>
 ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd <at> pantherx.org>
+;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> gmail.com>
 ;;; Copyright © 2020 Efraim Flashner <efraim <at> flashner.co.il>
 ;;; Copyright © 2020 Jesse Dowell <jessedowell <at> gmail.com>
+;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> protonmail.com>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba <at> kadziolka.net>
 ;;; Copyright © 2020 Alex Griffin <a <at> ajgrf.com>
+;;; Copyright © 2021 Brice Waegeneire <brice <at> 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





Information forwarded to guix-patches <at> gnu.org:
bug#44700; Package guix-patches. (Sat, 03 Jul 2021 16:52:02 GMT) Full text and rfc822 format available.

Message #29 received at 44700 <at> debbugs.gnu.org (full text, mbox):

From: Brice Waegeneire <brice <at> waegenei.re>
To: 44700 <at> debbugs.gnu.org
Cc: cwebber <at> dustycloud.org, Brice Waegeneire <brice <at> waegenei.re>
Subject: [PATCH v2 1/2] services: setuid: More configurable setuid support.
Date: Sat,  3 Jul 2021 18:51:26 +0200
From: Christopher Lemmer Webber <cwebber <at> 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 <at> 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

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 <at> systemreboot.net>
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado <at> elephly.net>
 ;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
+;;; Copyright © 2020 Christopher Lemmer Webber <cwebber <at> dustycloud.org>
+;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> gnu.org>
 ;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado <at> elephly.net>
 ;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework <at> protonmail.com>
+;;; Copyright © 2020 Christopher Lemmer Webber <cwebber <at> dustycloud.org>
+;;; Copyright © 2020, 2021 Brice Waegeneire <brice <at> 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 <at> gmail.com>
 ;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835 <at> gmail.com>
 ;;; Copyright © 2020 Danny Milosavljevic <dannym <at> scratchpost.org>
-;;; Copyright © 2020 Brice Waegeneire <brice <at> waegenei.re>
+;;; Copyright © 2020, 2021 Brice Waegeneire <brice <at> waegenei.re>
 ;;; Copyright © 2020 Florian Pelz <pelzflorian <at> pelzflorian.de>
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <jannek <at> 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 <at> 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 <at> 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





Information forwarded to guix-patches <at> gnu.org:
bug#44700; Package guix-patches. (Mon, 05 Jul 2021 15:29:02 GMT) Full text and rfc822 format available.

Message #32 received at 44700 <at> debbugs.gnu.org (full text, mbox):

From: Chris Lemmer-Webber <cwebber <at> dustycloud.org>
To: Brice Waegeneire <brice <at> waegenei.re>
Cc: 44700 <at> debbugs.gnu.org
Subject: Re: [PATCH v2 2/2] services: Migrate to <setuid-program>.
Date: Mon, 05 Jul 2021 11:28:35 -0400
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.

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...)

> * 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 <at> gnu.org>
>  ;;; Copyright © 2015 Sou Bunnbu <iyzsong <at> gmail.com>
>  ;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
> +;;; Copyright © 2021 Brice Waegeneire <brice <at> 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!

>  (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 <at> daviwil.com>
>  ;;; Copyright © 2020 Tobias Geerinckx-Rice <me <at> tobias.gr>
>  ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd <at> pantherx.org>
> +;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> gmail.com>
>  ;;; Copyright © 2020 Efraim Flashner <efraim <at> flashner.co.il>
>  ;;; Copyright © 2020 Jesse Dowell <jessedowell <at> gmail.com>
> +;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> protonmail.com>
>  ;;; Copyright © 2020 Jakub Kądziołka <kuba <at> kadziolka.net>
>  ;;; Copyright © 2020 Alex Griffin <a <at> ajgrf.com>
> +;;; Copyright © 2021 Brice Waegeneire <brice <at> 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!




Information forwarded to guix-patches <at> gnu.org:
bug#44700; Package guix-patches. (Tue, 06 Jul 2021 20:04:02 GMT) Full text and rfc822 format available.

Message #35 received at 44700 <at> debbugs.gnu.org (full text, mbox):

From: Brice Waegeneire <brice <at> waegenei.re>
To: 44700 <at> debbugs.gnu.org
Cc: cwebber <at> dustycloud.org
Subject: [PATCH v3 0/2] More configurable setuid/setgid support
Date: Tue,  6 Jul 2021 22:03:18 +0200
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





Information forwarded to guix-patches <at> gnu.org:
bug#44700; Package guix-patches. (Tue, 06 Jul 2021 20:04:02 GMT) Full text and rfc822 format available.

Message #38 received at 44700 <at> debbugs.gnu.org (full text, mbox):

From: Brice Waegeneire <brice <at> waegenei.re>
To: 44700 <at> debbugs.gnu.org
Cc: cwebber <at> dustycloud.org, Brice Waegeneire <brice <at> waegenei.re>
Subject: [PATCH v3 1/2] services: setuid: More configurable setuid support.
Date: Tue,  6 Jul 2021 22:03:19 +0200
From: Chris Lemmer-Webber <cwebber <at> 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 <at> 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

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 <at> systemreboot.net>
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado <at> elephly.net>
 ;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
+;;; Copyright © 2020 Chris Lemmer-Webber <cwebber <at> dustycloud.org>
+;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> gnu.org>
 ;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado <at> elephly.net>
 ;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework <at> protonmail.com>
+;;; Copyright © 2020 Chris Lemmer-Webber <cwebber <at> dustycloud.org>
+;;; Copyright © 2020, 2021 Brice Waegeneire <brice <at> 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 <at> gmail.com>
 ;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835 <at> gmail.com>
 ;;; Copyright © 2020 Danny Milosavljevic <dannym <at> scratchpost.org>
-;;; Copyright © 2020 Brice Waegeneire <brice <at> waegenei.re>
+;;; Copyright © 2020, 2021 Brice Waegeneire <brice <at> waegenei.re>
 ;;; Copyright © 2020 Florian Pelz <pelzflorian <at> pelzflorian.de>
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <jannek <at> 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 <at> 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 <at> 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





Information forwarded to guix-patches <at> gnu.org:
bug#44700; Package guix-patches. (Tue, 06 Jul 2021 20:04:03 GMT) Full text and rfc822 format available.

Message #41 received at 44700 <at> debbugs.gnu.org (full text, mbox):

From: Brice Waegeneire <brice <at> waegenei.re>
To: 44700 <at> debbugs.gnu.org
Cc: cwebber <at> dustycloud.org
Subject: [PATCH v3 2/2] services: Migrate to <setuid-program>.
Date: Tue,  6 Jul 2021 22:03:20 +0200
* 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 <at> gnu.org>
 ;;; Copyright © 2015 Sou Bunnbu <iyzsong <at> gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
+;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> daviwil.com>
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me <at> tobias.gr>
 ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd <at> pantherx.org>
+;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> gmail.com>
 ;;; Copyright © 2020 Efraim Flashner <efraim <at> flashner.co.il>
 ;;; Copyright © 2020 Jesse Dowell <jessedowell <at> gmail.com>
+;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> protonmail.com>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba <at> kadziolka.net>
 ;;; Copyright © 2020 Alex Griffin <a <at> ajgrf.com>
+;;; Copyright © 2021 Brice Waegeneire <brice <at> 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





Information forwarded to guix-patches <at> gnu.org:
bug#44700; Package guix-patches. (Wed, 07 Jul 2021 17:42:02 GMT) Full text and rfc822 format available.

Message #44 received at 44700 <at> debbugs.gnu.org (full text, mbox):

From: Chris Lemmer-Webber <cwebber <at> dustycloud.org>
To: Brice Waegeneire <brice <at> waegenei.re>
Cc: 44700 <at> debbugs.gnu.org
Subject: Re: [PATCH v3 2/2] services: Migrate to <setuid-program>.
Date: Wed, 07 Jul 2021 13:41:00 -0400
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 <at> gnu.org>
>  ;;; Copyright © 2015 Sou Bunnbu <iyzsong <at> gmail.com>
>  ;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
> +;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> daviwil.com>
>  ;;; Copyright © 2020 Tobias Geerinckx-Rice <me <at> tobias.gr>
>  ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd <at> pantherx.org>
> +;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> gmail.com>
>  ;;; Copyright © 2020 Efraim Flashner <efraim <at> flashner.co.il>
>  ;;; Copyright © 2020 Jesse Dowell <jessedowell <at> gmail.com>
> +;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> protonmail.com>
>  ;;; Copyright © 2020 Jakub Kądziołka <kuba <at> kadziolka.net>
>  ;;; Copyright © 2020 Alex Griffin <a <at> ajgrf.com>
> +;;; Copyright © 2021 Brice Waegeneire <brice <at> 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'





Information forwarded to guix-patches <at> gnu.org:
bug#44700; Package guix-patches. (Thu, 29 Jul 2021 16:05:02 GMT) Full text and rfc822 format available.

Message #47 received at 44700 <at> debbugs.gnu.org (full text, mbox):

From: Christine Lemmer-Webber <cwebber <at> dustycloud.org>
To: Brice Waegeneire <brice <at> waegenei.re>
Cc: 44700 <at> debbugs.gnu.org
Subject: Re: [PATCH v3 2/2] services: Migrate to <setuid-program>.
Date: Thu, 29 Jul 2021 12:04:08 -0400
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 <at> gnu.org>
>>  ;;; Copyright © 2015 Sou Bunnbu <iyzsong <at> gmail.com>
>>  ;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
>> +;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> daviwil.com>
>>  ;;; Copyright © 2020 Tobias Geerinckx-Rice <me <at> tobias.gr>
>>  ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd <at> pantherx.org>
>> +;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> gmail.com>
>>  ;;; Copyright © 2020 Efraim Flashner <efraim <at> flashner.co.il>
>>  ;;; Copyright © 2020 Jesse Dowell <jessedowell <at> gmail.com>
>> +;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> protonmail.com>
>>  ;;; Copyright © 2020 Jakub Kądziołka <kuba <at> kadziolka.net>
>>  ;;; Copyright © 2020 Alex Griffin <a <at> ajgrf.com>
>> +;;; Copyright © 2021 Brice Waegeneire <brice <at> 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'





Information forwarded to guix-patches <at> gnu.org:
bug#44700; Package guix-patches. (Thu, 29 Jul 2021 16:17:01 GMT) Full text and rfc822 format available.

Message #50 received at 44700 <at> debbugs.gnu.org (full text, mbox):

From: Christine Lemmer-Webber <cwebber <at> dustycloud.org>
To: Brice Waegeneire <brice <at> waegenei.re>
Cc: 44700 <at> debbugs.gnu.org
Subject: Re: [PATCH v3 2/2] services: Migrate to <setuid-program>.
Date: Thu, 29 Jul 2021 12:16:24 -0400
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 <at> gnu.org>
>>>  ;;; Copyright © 2015 Sou Bunnbu <iyzsong <at> gmail.com>
>>>  ;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
>>> +;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> daviwil.com>
>>>  ;;; Copyright © 2020 Tobias Geerinckx-Rice <me <at> tobias.gr>
>>>  ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd <at> pantherx.org>
>>> +;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> gmail.com>
>>>  ;;; Copyright © 2020 Efraim Flashner <efraim <at> flashner.co.il>
>>>  ;;; Copyright © 2020 Jesse Dowell <jessedowell <at> gmail.com>
>>> +;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> protonmail.com>
>>>  ;;; Copyright © 2020 Jakub Kądziołka <kuba <at> kadziolka.net>
>>>  ;;; Copyright © 2020 Alex Griffin <a <at> ajgrf.com>
>>> +;;; Copyright © 2021 Brice Waegeneire <brice <at> 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'





Reply sent to Christine Lemmer-Webber <cwebber <at> dustycloud.org>:
You have taken responsibility. (Thu, 29 Jul 2021 16:19:02 GMT) Full text and rfc822 format available.

Notification sent to Christopher Lemmer Webber <cwebber <at> dustycloud.org>:
bug acknowledged by developer. (Thu, 29 Jul 2021 16:19:02 GMT) Full text and rfc822 format available.

Message #55 received at 44700-done <at> debbugs.gnu.org (full text, mbox):

From: Christine Lemmer-Webber <cwebber <at> dustycloud.org>
To: Brice Waegeneire <brice <at> waegenei.re>
Cc: 44700-done <at> debbugs.gnu.org
Subject: Re: [PATCH v3 2/2] services: Migrate to <setuid-program>.
Date: Thu, 29 Jul 2021 12:18:33 -0400
Oh, forgot to close it.

Christine Lemmer-Webber writes:

> Got the all clear to push to master.  Rebased and pushed! :)
>
> Christine Lemmer-Webber writes:
>
>> I rebased the patches and created the branch origin/wip-setuid.
>> (I also updated my name... again.  Should be the final update.)
>>
>> Looks like the tests all pass.  I don't want to let this bitrot again.
>> Does anyone have an objection to me pushing this to master?
>>
>> If nobody objects I'm gonna do it!
>>
>>
>> Chris Lemmer-Webber writes:
>>
>>> Looks good to me.  I'd say push it... let's not let this bitrot again!
>>>
>>> Brice Waegeneire writes:
>>>
>>>> * gnu/services/dbus.scm (dbus-setuid-programs, polkit-setuid-programs):
>>>>   Return setuid-programs.
>>>> * gnu/services/desktop.scm (enlightenment-setuid-programs): Return
>>>>  setuid-programs.
>>>>  (%desktop-services)[mount-setuid-helpers]: Use setuid-programs.
>>>> * gnu/services/docker.scm (singularity-setuid-programs): Return
>>>>  setuid-programs.
>>>> * gnu/services/xorg.scm(screen-locker-setuid-programs): Return
>>>>  setuid-programs.
>>>> * gnu/system.scm (%setuid-programs): Return setuid-programs.
>>>> * doc/guix.texi (Setuid Programs, operating-system Reference): Replace
>>>>   'list of G-expressions' with 'list of <setuid-program>'.
>>>> ---
>>>>  doc/guix.texi            | 19 +++++++++++--------
>>>>  gnu/services/dbus.scm    | 13 +++++++++----
>>>>  gnu/services/desktop.scm | 26 ++++++++++++++++----------
>>>>  gnu/services/docker.scm  |  9 ++++++---
>>>>  gnu/services/xorg.scm    |  4 +++-
>>>>  gnu/system.scm           | 31 ++++++++++++++++---------------
>>>>  6 files changed, 61 insertions(+), 41 deletions(-)
>>>>
>>>> diff --git a/doc/guix.texi b/doc/guix.texi
>>>> index f7a72b9885..7919332521 100644
>>>> --- a/doc/guix.texi
>>>> +++ b/doc/guix.texi
>>>> @@ -13860,8 +13860,8 @@ Linux @dfn{pluggable authentication module} (PAM) services.
>>>>  @c FIXME: Add xref to PAM services section.
>>>>  
>>>>  @item @code{setuid-programs} (default: @code{%setuid-programs})
>>>> -List of string-valued G-expressions denoting setuid programs.
>>>> -@xref{Setuid Programs}.
>>>> +List of @code{<setuid-program>}.  @xref{Setuid Programs}, for more
>>>> +information.
>>>>  
>>>>  @item @code{sudoers-file} (default: @code{%sudoers-specification})
>>>>  @cindex sudoers file
>>>> @@ -32421,13 +32421,15 @@ the store, we let the system administrator @emph{declare} which programs
>>>>  should be setuid root.
>>>>  
>>>>  The @code{setuid-programs} field of an @code{operating-system}
>>>> -declaration contains a list of G-expressions denoting the names of
>>>> -programs to be setuid-root (@pxref{Using the Configuration System}).
>>>> -For instance, the @command{passwd} program, which is part of the Shadow
>>>> -package, can be designated by this G-expression (@pxref{G-Expressions}):
>>>> +declaration contains a list of @code{<setuid-program>} denoting the
>>>> +names of programs to have a setuid or setgid bit set (@pxref{Using the
>>>> +Configuration System}).  For instance, the @command{passwd} program,
>>>> +which is part of the Shadow package, with a setuid root can be
>>>> +designated like this:
>>>>  
>>>>  @example
>>>> -#~(string-append #$shadow "/bin/passwd")
>>>> +(setuid-program
>>>> +  (program (file-append #$shadow "/bin/passwd")))
>>>>  @end example
>>>>  
>>>>  @deftp {Data Type} setuid-program
>>>> @@ -32458,7 +32460,8 @@ A default set of setuid programs is defined by the
>>>>  @code{%setuid-programs} variable of the @code{(gnu system)} module.
>>>>  
>>>>  @defvr {Scheme Variable} %setuid-programs
>>>> -A list of G-expressions denoting common programs that are setuid-root.
>>>> +A list of @code{<setuid-program>} denoting common programs that are
>>>> +setuid-root.
>>>>  
>>>>  The list includes commands such as @command{passwd}, @command{ping},
>>>>  @command{su}, and @command{sudo}.
>>>> diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
>>>> index af1a1e4c3a..e7b3dac166 100644
>>>> --- a/gnu/services/dbus.scm
>>>> +++ b/gnu/services/dbus.scm
>>>> @@ -2,6 +2,7 @@
>>>>  ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo <at> gnu.org>
>>>>  ;;; Copyright © 2015 Sou Bunnbu <iyzsong <at> gmail.com>
>>>>  ;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
>>>> +;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> daviwil.com>
>>>>  ;;; Copyright © 2020 Tobias Geerinckx-Rice <me <at> tobias.gr>
>>>>  ;;; Copyright © 2020 Reza Alizadeh Majd <r.majd <at> pantherx.org>
>>>> +;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> gmail.com>
>>>>  ;;; Copyright © 2020 Efraim Flashner <efraim <at> flashner.co.il>
>>>>  ;;; Copyright © 2020 Jesse Dowell <jessedowell <at> gmail.com>
>>>> +;;; Copyright © 2021 Brice Waegeneire <brice <at> 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 <at> protonmail.com>
>>>>  ;;; Copyright © 2020 Jakub Kądziołka <kuba <at> kadziolka.net>
>>>>  ;;; Copyright © 2020 Alex Griffin <a <at> ajgrf.com>
>>>> +;;; Copyright © 2021 Brice Waegeneire <brice <at> 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'





Information forwarded to guix-patches <at> gnu.org:
bug#44700; Package guix-patches. (Thu, 12 Aug 2021 10:38:01 GMT) Full text and rfc822 format available.

Message #58 received at 44700 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Christine Lemmer-Webber <cwebber <at> dustycloud.org>
Cc: 44700 <at> debbugs.gnu.org, Brice Waegeneire <brice <at> waegenei.re>
Subject: Re: bug#44700: services: setuid: More configurable setuid support.
Date: Thu, 12 Aug 2021 12:37:16 +0200
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’.




Information forwarded to guix-patches <at> gnu.org:
bug#44700; Package guix-patches. (Thu, 12 Aug 2021 16:07:02 GMT) Full text and rfc822 format available.

Message #61 received at 44700 <at> debbugs.gnu.org (full text, mbox):

From: Christine Lemmer-Webber <cwebber <at> dustycloud.org>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 44700 <at> debbugs.gnu.org, Brice Waegeneire <brice <at> waegenei.re>
Subject: Re: bug#44700: services: setuid: More configurable setuid support.
Date: Thu, 12 Aug 2021 12:06:06 -0400
This sounds really good, thank you!

Ludovic Courtès writes:

> 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’.





bug archived. Request was from Debbugs Internal Request <help-debbugs <at> gnu.org> to internal_control <at> debbugs.gnu.org. (Fri, 10 Sep 2021 11:24:04 GMT) Full text and rfc822 format available.

This bug report was last modified 2 years and 222 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.