From 84c60c3c3baf4a743e921e13f7887152a1dae450 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 6 Jun 2025 23:20:26 +0200
Subject: [PATCH] =?UTF-8?q?services:=20guix:=20Preserve=20=E2=80=98guix-da?=
 =?UTF-8?q?emon=E2=80=99=20user=20supplementary=20groups.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

When running ‘guix-daemon’ unprivileged, supplementary groups such as
“kvm” were dropped by ‘run-with-writable-store’.

* gnu/services/base.scm (run-with-writable-store): Use ‘read-group’ to
determine the list of supplementary groups for ‘user’ and pass that to
‘setgroups’.

Change-Id: I21cc546a91a1a24cc94cafb44fa93e088f8673a7
---
 gnu/services/base.scm | 23 +++++++++++++++++------
 1 file changed, 17 insertions(+), 6 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 1ad0e0c9c153b8ca4122e35850acda30cb82f0aa..09e599c89ec056b11e8106a066151d023859f174 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1931,9 +1931,12 @@ GID in a context where the store is writable, even if it was bind-mounted
 read-only via %IMMUTABLE-STORE (this wrapper must run as root)."
   (program-file "run-with-writable-store"
                 (with-imported-modules (source-module-closure
-                                        '((guix build syscalls)))
+                                        '((guix build syscalls)
+                                          (gnu build accounts)))
                   #~(begin
                       (use-modules (guix build syscalls)
+                                   (gnu build accounts)
+                                   (srfi srfi-1)
                                    (ice-9 match))
 
                       (define (ensure-writable-store store)
@@ -1948,11 +1951,19 @@ read-only via %IMMUTABLE-STORE (this wrapper must run as root)."
                       (match (command-line)
                         ((_ user group command args ...)
                          (ensure-writable-store #$(%store-prefix))
-                         (let ((uid (or (string->number user)
-                                        (passwd:uid (getpwnam user))))
-                               (gid (or (string->number group)
-                                        (group:gid (getgrnam group)))))
-                           (setgroups #())
+                         (let* ((uid (or (string->number user)
+                                         (passwd:uid (getpwnam user))))
+                                (gid (or (string->number group)
+                                         (group:gid (getgrnam group))))
+                                (user (passwd:name (getpwuid uid)))
+                                (groups (filter-map
+                                         (lambda (group)
+                                           (and (member user
+                                                        (group-entry-members
+                                                         group))
+                                                (group-entry-gid group)))
+                                         (read-group))))
+                           (setgroups (list->vector groups))
                            (setgid gid)
                            (setuid uid)
                            (apply execl command command args))))))))