@@ -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)))
@@ -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))