gnu: shadow: Add record type for user groups.
* gnu/system/shadow.scm (<user-group>): New record type. (group-file): New procedure. * gnu/system/vm.scm (system-qemu-image): Use it.
This commit is contained in:
parent
bacadb026c
commit
16a0e9dc34
@ -30,7 +30,15 @@
|
||||
user-account-home-directory
|
||||
user-account-shell
|
||||
|
||||
passwd-file))
|
||||
user-group
|
||||
user-group?
|
||||
user-group-name
|
||||
user-group-password
|
||||
user-group-id
|
||||
user-group-members
|
||||
|
||||
passwd-file
|
||||
group-file))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
@ -49,6 +57,31 @@
|
||||
(home-directory user-account-home-directory)
|
||||
(shell user-account-shell (default "/bin/sh")))
|
||||
|
||||
(define-record-type* <user-group>
|
||||
user-group make-user-group
|
||||
user-group?
|
||||
(name user-group-name)
|
||||
(password user-group-password (default #f))
|
||||
(id user-group-id)
|
||||
(members user-group-members (default '())))
|
||||
|
||||
(define (group-file store groups)
|
||||
"Return a /etc/group file for GROUPS, a list of <user-group> objects."
|
||||
(define contents
|
||||
(let loop ((groups groups)
|
||||
(result '()))
|
||||
(match groups
|
||||
((($ <user-group> name _ gid (users ...)) rest ...)
|
||||
;; XXX: Ignore the group password.
|
||||
(loop rest
|
||||
(cons (string-append name "::" (number->string gid)
|
||||
":" (string-join users ","))
|
||||
result)))
|
||||
(()
|
||||
(string-join (reverse result) "\n" 'suffix)))))
|
||||
|
||||
(add-text-to-store store "group" contents))
|
||||
|
||||
(define* (passwd-file store accounts #:key shadow?)
|
||||
"Return a password file for ACCOUNTS, a list of <user-account> objects. If
|
||||
SHADOW? is true, then it is a /etc/shadow file, otherwise it is a /etc/passwd
|
||||
|
@ -484,8 +484,10 @@ Happy birthday, GNU! http://www.gnu.org/gnu30
|
||||
(shell bash-file))))
|
||||
(passwd (passwd-file store accounts))
|
||||
(shadow (passwd-file store accounts #:shadow? #t))
|
||||
(group (add-text-to-store store "group"
|
||||
"root:x:0:\n"))
|
||||
(group (group-file store
|
||||
(list (user-group
|
||||
(name "root")
|
||||
(id 0)))))
|
||||
(pam.d-drv (pam-services->directory store %pam-services))
|
||||
(pam.d (derivation->output-path pam.d-drv))
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user