diff mbox series

[bug#44700] services: setuid: More configurable setuid support.

Message ID 874klog9tk.fsf@dustycloud.org
State Accepted
Headers show
Series [bug#44700] services: setuid: More configurable setuid support. | expand

Checks

Context Check Description
cbaines/submitting builds success
cbaines/comparison success View comparision
cbaines/git branch success View Git branch
cbaines/applying patch fail View Laminar job
cbaines/issue success View issue

Commit Message

Christine Lemmer-Webber Nov. 16, 2020, 11:29 p.m. UTC
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.

Comments

Ludovic Courtès Nov. 17, 2020, 9:46 a.m. UTC | #1
Hello!

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

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

This looks like the right approach to me!

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

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

> +(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’.
Maxim Cournoyer Nov. 17, 2020, 4:29 p.m. UTC | #2
Hello Christopher,

Christopher Lemmer Webber <cwebber@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@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
Christine Lemmer-Webber Nov. 17, 2020, 4:31 p.m. UTC | #3
Ludovic Courtès writes:

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

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

>> +(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’.
Ludovic Courtès Nov. 17, 2020, 8:48 p.m. UTC | #4
Hi Chris!

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

> Ludovic Courtès writes:

[...]

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

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

Does that make sense?

Thanks,
Ludo’.
Christine Lemmer-Webber April 14, 2021, 5:06 p.m. UTC | #5
Ludovic Courtès writes:

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

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

I'm very overwhelmed right now.  If nobody picks this up where I left it
off I probably can, but I am probably blocked for the next couple of
months with urgent tasks... which is a shame for something that looked
so close to landing.  If anyone wants to get this to the last mile and
address Ludo's feedback they are welcome to in the meanwhile.
Brice Waegeneire July 3, 2021, 4:51 p.m. UTC | #6
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
diff mbox series

Patch

From eadac673fb22132c555a4e1cee57a6308ecfdad4 Mon Sep 17 00:00:00 2001
From: Christopher Lemmer Webber <cwebber@dustycloud.org>
Date: Sun, 15 Nov 2020 16:58:52 -0500
Subject: [PATCH] services: setuid: More configurable setuid support.

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

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

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