[bug#49814] [PATCH] accounts: Add <group-membership>.

[bug#49814] [PATCH] accounts: Add <group-membership>.

[Brice Waegeneire]

Support adding supplementary groups to defined users by extending
'account-service-type'.

* gnu/system/accounts.scm (group-membership): New record.
  (additional-group-members): New procedure.
* gnu/system/shadow.scm (group-memberships->users-groups): New
  procedure.
  (account-activation accounts+groups): Add additional group memberships
  to the defined users.
---
 gnu/system/accounts.scm | 19 +++++++++++++++++++
 gnu/system/shadow.scm   | 30 +++++++++++++++++++++++++++++-
 2 files changed, 48 insertions(+), 1 deletion(-)

As I was answerd on IRC, it's already possible to add groups to an already
defined 'operating-system' by modifying it's 'user' field.  However this isn't
that practical in my point of view.

I would prefer to do such change from a service to be able to keep a potential
new group and its members in proximity in the code.  For example when adding a
sgid dumpcap binary to be used by the wireshark group members, it makes sense
to keep the membership of that group close to the definition of the new group
and its sgid binary:

--8<---------------cut here---------------start------------->8---
(simple-service 'wireshark-account account-service-type
                (list (user-group (name "wireshark") (system? #t))
                      (additional-group-members "wireshark" %sysadmins)))
(simple-service 'wireshark-dumpcap setuid-program-service-type
                (list (setuid-program
                       (program (file-append wireshark "/bin/dumpcap"))
                       (setuid? #f)
                       (setgid? #t)
                       (group "wireshark"))))
--8<---------------cut here---------------end--------------->8---

This patch add a new <group-membership> record to be used as as some of the
values for the 'account-service-type' which already support 3 other different
types.

diff --git a/gnu/system/accounts.scm b/gnu/system/accounts.scm
index 586cff1842..c12f5644d0 100644
--- a/gnu/system/accounts.scm
+++ b/gnu/system/accounts.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -39,6 +40,12 @@
             user-group-id
             user-group-system?
 
+            group-membership
+            group-membership?
+            group-membership-name
+            group-membership-additional-members
+            additional-group-members
+
             sexp->user-account
             sexp->user-group
 
@@ -85,6 +92,12 @@
   (system?        user-group-system?              ; Boolean
                   (default #f)))
 
+(define-record-type* <group-membership>
+  group-membership make-group-membership
+  group-membership?
+  (name                 group-membership-name)                  ; string
+  (additional-members   group-membership-additional-members))   ; list of strings
+
 (define (default-home-directory account)
   "Return the default home directory for ACCOUNT."
   (string-append "/home/" (user-account-name account)))
@@ -112,3 +125,9 @@ user-account record."
                    (create-home-directory? create-home-directory?)
                    (shell shell) (password password)
                    (system? system?)))))
+
+(define (additional-group-members group members)
+  "Return a <group-membership> object with name GROUPS and additional
+MEMEBERS."
+  (group-membership (name group)
+                    (additional-members members)))
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index 7c57222716..273c1f6d87 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -316,12 +317,39 @@ of user '~a' is undeclared")
       #$(user-account-password account)
       #$(user-account-system? account)))
 
+(define (group-memberships->users-groups groups-memberships)
+  "Turn GROUP-MEMBERSHIPS, a list of <group-membership> object, into an alist
+of users with additional group membership."
+  (let ((users (delete-duplicates (append-map group-membership-additional-members
+                                              groups-memberships))))
+    (map (lambda (user)
+           (cons user
+                 (filter-map
+                  (lambda (group)
+                    (and (member user (group-membership-additional-members group))
+                         (group-membership-name group)))
+                  groups-memberships)))
+         users)))
+
 (define (account-activation accounts+groups)
   "Return a gexp that activates ACCOUNTS+GROUPS, a list of <user-account> and
 <user-group> objects.  Raise an error if a user account refers to a undefined
 group."
+  (define users-additional-groups
+    (group-memberships->users-groups (filter group-membership? accounts+groups)))
+
   (define accounts
-    (delete-duplicates (filter user-account? accounts+groups) eq?))
+    (map (lambda (user)
+           (let ((additional-groups (assoc-ref users-additional-groups
+                                               (user-account-name user))))
+             (if additional-groups
+                 (user-account
+                  (inherit user)
+                  (supplementary-groups
+                   (delete-duplicates (append (user-account-supplementary-groups user)
+                                              additional-groups))))
+                 user)))
+         (delete-duplicates (filter user-account? accounts+groups) eq?)))
 
   (define user-specs
     (map user-account->gexp accounts))
-- 
2.32.0

[bug#49814] [PATCH] accounts: Add <group-membership>.

[Ludovic Courtès]

Hello,

Brice Waegeneire <brice@waegenei.re> skribis:

> As I was answerd on IRC, it's already possible to add groups to an already
> defined 'operating-system' by modifying it's 'user' field.  However this isn't
> that practical in my point of view.
>
> I would prefer to do such change from a service to be able to keep a potential
> new group and its members in proximity in the code.  For example when adding a
> sgid dumpcap binary to be used by the wireshark group members, it makes sense
> to keep the membership of that group close to the definition of the new group
> and its sgid binary:
>
> (simple-service 'wireshark-account account-service-type
>                 (list (user-group (name "wireshark") (system? #t))
>                       (additional-group-members "wireshark" %sysadmins)))
> (simple-service 'wireshark-dumpcap setuid-program-service-type
>                 (list (setuid-program
>                        (program (file-append wireshark "/bin/dumpcap"))
>                        (setuid? #f)
>                        (setgid? #t)
>                        (group "wireshark"))))

I understand the desire to keep these things close to one another, but I
must say I’m not convinced by this style.  I would do that along these
lines:

  (define (extend-account-membership group accounts)
    ;; Make ACCOUNTS members of GROUP.
    (map (lambda (account)
           (user-account
             (inherit account)
             (supplementary-groups
               (cons group (user-account-supplementary-groups account)))))
         accounts))

   (operating-system
     ;; …
     (users (extend-account-membership "wireshark" (list …))))

WDYT?

> This patch add a new <group-membership> record to be used as as some of the
> values for the 'account-service-type' which already support 3 other different
> types.

Any service could modify any other account using this, right?  There
might be cases where it’s nice to have such a sledgehammer, but it has
the downside that it makes it harder to reason about who does what in
the OS config—pretty much like NixOS modules can touch anything anywhere
in the config.

Thanks,
Ludo’.