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

[Maxim Cournoyer <maxim.cournoyer@gmail.com>]

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