diff options
Diffstat (limited to 'gnu/system/accounts.scm')
| -rw-r--r-- | gnu/system/accounts.scm | 41 |
1 files changed, 41 insertions, 0 deletions
diff --git a/gnu/system/accounts.scm b/gnu/system/accounts.scm index 586cff1842..d045dfd17b 100644 --- a/gnu/system/accounts.scm +++ b/gnu/system/accounts.scm @@ -1,5 +1,8 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2024 Wojtek Kosior <koszko@koszko.org> +;;; Additions and modifications by Wojtek Kosior are additionally +;;; dual-licensed under the Creative Commons Zero v1.0. ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,6 +22,9 @@ (define-module (gnu system accounts) #:use-module (guix records) #:use-module (ice-9 match) + #:use-module (ice-9 vlist) + #:use-module (srfi srfi-8) + #:use-module (srfi srfi-26) #:export (user-account user-account? user-account-name @@ -39,6 +45,13 @@ user-group-id user-group-system? + user-extra-groups + user-extra-groups? + user-extra-groups-user + user-extra-groups-groups + + merge-extra-groups-data + sexp->user-account sexp->user-group @@ -85,6 +98,34 @@ (system? user-group-system? ; Boolean (default #f))) +(define-record-type* <user-extra-groups> user-extra-groups + make-user-extra-groups + user-extra-groups? + (user user-extra-groups-user) + (groups user-extra-groups-groups)) ; list of strings + +(define (user-account-extend account extra-groups) + (match-record account <user-account> (name supplementary-groups) + (user-account + (inherit account) + (supplementary-groups (apply append supplementary-groups + (vhash-fold* cons '() + name extra-groups)))))) + +(define (merge-extra-groups-data accounts-data) + (let* ((extra-groups-alist (map (match-record-lambda <user-extra-groups> + (user groups) + (cons user groups)) + (filter user-extra-groups? accounts-data))) + (extra-groups (alist->vhash extra-groups-alist)) + (user-accounts (map (cut user-account-extend <> extra-groups) + (filter user-account? accounts-data))) + (other-records (filter (lambda (record) + (not (or (user-account? record) + (user-extra-groups? record)))) + accounts-data))) + (append other-records user-accounts))) + (define (default-home-directory account) "Return the default home directory for ACCOUNT." (string-append "/home/" (user-account-name account))) |