From ddf372637089957e8c62d53c7eca07cfa9155a04 Mon Sep 17 00:00:00 2001
From: Florian Pelz <pelzflorian@pelzflorian.de>
Date: Wed, 4 Dec 2019 09:33:08 +0100
Subject: [PATCH] gnu: shepherd: Patch Shepherd to set supplementary groups to
 those of #:user.

Fixes <https://bugs.gnu.org/38438>.

* gnu/packages/patches/shepherd-set-supplementary-groups.patch: New file.
* gnu/local.mk (dist_patch_DATA): Add it.
* gnu/packages/admin.scm (shepherd): Use it.
---
 gnu/local.mk                                  |  1 +
 gnu/packages/admin.scm                        |  4 +-
 .../shepherd-set-supplementary-groups.patch   | 43 +++++++++++++++++++
 3 files changed, 47 insertions(+), 1 deletion(-)
 create mode 100644 gnu/packages/patches/shepherd-set-supplementary-groups.patch

diff --git a/gnu/local.mk b/gnu/local.mk
index 9ddd1349da..b807e3879c 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1348,6 +1348,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/seahorse-gkr-use-0-on-empty-flags.patch	\
   %D%/packages/patches/seq24-rename-mutex.patch			\
   %D%/packages/patches/sharutils-CVE-2018-1000097.patch		\
+  %D%/packages/patches/shepherd-set-supplementary-groups.patch	\
   %D%/packages/patches/shishi-fix-libgcrypt-detection.patch	\
   %D%/packages/patches/slim-session.patch			\
   %D%/packages/patches/slim-config.patch			\
diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index 6e5648d159..3f94b45623 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -201,7 +201,9 @@ and provides a \"top-like\" mode (monitoring).")
                                   version ".tar.gz"))
               (sha256
                (base32
-                "1xn6mb5bh8bpfgdrh09ja31jk0ln7bmxbbf0vjcqxkkixs2wl6sk"))))
+                "1xn6mb5bh8bpfgdrh09ja31jk0ln7bmxbbf0vjcqxkkixs2wl6sk"))
+              (patches
+               (search-patches "shepherd-set-supplementary-groups.patch"))))
     (build-system gnu-build-system)
     (arguments
      '(#:configure-flags '("--localstatedir=/var")))
diff --git a/gnu/packages/patches/shepherd-set-supplementary-groups.patch b/gnu/packages/patches/shepherd-set-supplementary-groups.patch
new file mode 100644
index 0000000000..8cac24417d
--- /dev/null
+++ b/gnu/packages/patches/shepherd-set-supplementary-groups.patch
@@ -0,0 +1,43 @@
+diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
+index bd7e379..2344915 100644
+--- a/modules/shepherd/service.scm
++++ b/modules/shepherd/service.scm
+@@ -758,6 +758,28 @@ daemon writing FILE is running in a separate PID namespace."
+               (try-again)
+               (apply throw args)))))))
+ 
++(define (supplementary-gids user)
++  "Return a vector with the gid for each supplementary group USER belongs to.
++USER is the user name as a string."
++  ;; TODO: To find them, we loop through the group database, but maybe using
++  ;; glibc’s getgrouplist would be better.  But it is not exported from Guile
++  ;; and it seems it is not part of POSIX (?).
++  (list->vector
++   (delete-duplicates
++    (dynamic-wind
++        (lambda () (setgrent))
++        (lambda ()
++          (let loop ((supgids '()))
++            (let ((group (getgrent)))
++              (define (user-among-group? group)
++                (member user (group:mem group)))
++              (match group
++                     (#f supgids)
++                     ((? user-among-group?)
++                      (loop (cons (group:gid group) supgids)))
++                     (else (loop supgids))))))
++        (lambda () (endgrent))))))
++
+ (define* (exec-command command
+                        #:key
+                        (user #f)
+@@ -826,7 +848,8 @@ false."
+      (when user
+        (catch #t
+          (lambda ()
+-           (setuid (passwd:uid (getpw user))))
++           (setuid (passwd:uid (getpw user)))
++           (setgroups (supplementary-gids user)))
+          (lambda (key . args)
+            (format (current-error-port)
+                    "failed to change to user ~s:~%" user)
-- 
2.24.0