From 8018438b714e7dbc2504d1e00aa4e295649b4001 Mon Sep 17 00:00:00 2001 From: Wojtek Kosior Date: Mon, 22 Jan 2024 20:50:24 +0100 Subject: system: Allow adding elsewhere-defined system users to extra groups. * gnu/system.scm (define-module): Export `operating-system-extra-groups`. ()[extra-groups]: New field. (operating-system-default-essential-services): Also pass extra groups to account-service. (hurd-default-essential-services): Same here. * gnu/system/accounts.scm (define-module): Use (ice-9 vlist), (srfi srfi-8) and (srfi srfi-26). Export `user-extra-groups`* and `merge-extra-groups-data`. (): New record type. (user-account-extend): New procedure. (merge-extra-groups-data): New procedure. * gnu/system/shadow.scm (define-module): Re-export `user-extra-groups`*. (account-service-type)[extend]: Handle records, move field intializer upward to be able to use `compose`. Change-Id: I3f489ac794d342267b7627db1d28315ea4b69db2 --- gnu/system.scm | 9 +++++++-- gnu/system/accounts.scm | 41 +++++++++++++++++++++++++++++++++++++++++ gnu/system/shadow.scm | 13 +++++++++---- 3 files changed, 57 insertions(+), 6 deletions(-) (limited to 'gnu') diff --git a/gnu/system.scm b/gnu/system.scm index cb6e719ca6..5334fffc17 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -111,6 +111,7 @@ (define-module (gnu system) operating-system-initrd operating-system-users operating-system-groups + operating-system-extra-groups operating-system-issue operating-system-timezone operating-system-locale @@ -270,6 +271,8 @@ (define-record-type* operating-system (default %base-user-accounts)) (groups operating-system-groups ; list of user groups (default %base-groups)) + (extra-groups operating-system-extra-groups ; list of extra membership + (default '())) (skeletons operating-system-skeletons ; list of name/file-like value (default (default-skeletons))) @@ -799,7 +802,8 @@ (define known-fs (pam-root-service (operating-system-pam-services os)) (account-service (append (operating-system-accounts os) - (operating-system-groups os)) + (operating-system-groups os) + (operating-system-extra-groups os)) (operating-system-skeletons os)) (operating-system-etc-service os) ;; XXX: hosts-file is deprecated @@ -839,7 +843,8 @@ (define (hurd-default-essential-services os) (service user-processes-service-type) (account-service (append (operating-system-accounts os) - (operating-system-groups os)) + (operating-system-groups os) + (operating-system-extra-groups os)) (operating-system-skeletons os)) (root-file-system-service) (service file-system-service-type '()) 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 +;;; Copyright © 2024 Wojtek Kosior +;;; 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 @@ (define-module (gnu system accounts) 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 @@ (define-record-type* (system? user-group-system? ; Boolean (default #f))) +(define-record-type* 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 (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 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))) diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index d9f13271d8..699331e911 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -61,7 +61,12 @@ (define-module (gnu system shadow) user-group-name user-group-password user-group-id - user-group-system?) + user-group-system? + + user-extra-groups + user-extra-groups? + user-extra-groups-user + user-extra-groups-groups) #:export (%default-bashrc %default-bash-profile @@ -493,10 +498,10 @@ (define (etc-files arguments) (define account-service-type (service-type (name 'account) - ;; Concatenate , , and skeleton - ;; lists. + ;; Concatenate , , + ;; and skeleton lists. + (extend (compose merge-extra-groups-data append)) (compose concatenate) - (extend append) (extensions (list (service-extension activation-service-type -- cgit v1.2.3