Subject: [bug#44700] [PATCH v3 1/2] services: setuid: More configurable setuid support.

From: Brice Waegeneire <[email-masked]>
Date: Tue, 6 Jul 2021 22:03:19 +0200

From: Chris Lemmer-Webber <[email-masked]>

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 <[email-masked]>
---
 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 <[email-masked]>
 ;;; Copyright © 2018, 2019 Ricardo Wurmus <[email-masked]>
 ;;; Copyright © 2021 Maxime Devos <[email-masked]>
+;;; Copyright © 2020 Chris Lemmer-Webber <[email-masked]>
+;;; Copyright © 2021 Brice Waegeneire <[email-masked]>
 ;;;
 ;;; 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 <[email-masked]>
 ;;; Copyright © 2020, 2021 Ricardo Wurmus <[email-masked]>
 ;;; Copyright © 2021 raid5atemyhomework <[email-masked]>
+;;; Copyright © 2020 Chris Lemmer-Webber <[email-masked]>
+;;; Copyright © 2020, 2021 Brice Waegeneire <[email-masked]>
 ;;;
 ;;; 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 <[email-masked]>
 ;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <[email-masked]>
 ;;; Copyright © 2020 Danny Milosavljevic <[email-masked]>
-;;; Copyright © 2020 Brice Waegeneire <[email-masked]>
+;;; Copyright © 2020, 2021 Brice Waegeneire <[email-masked]>
 ;;; Copyright © 2020 Florian Pelz <[email-masked]>
 ;;; Copyright © 2020 Maxim Cournoyer <[email-masked]>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <[email-masked]>
@@ -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 [email-masked] 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 <[email-masked]>
+;;;
+;;; 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