services: user-homes: Do not create home directories marked as no-create.
Fixes a bug whereby GuixSD would create the /nonexistent directory, from user 'nobody', even though it has 'create-home-directory?' set to #f. * gnu/build/activation.scm (activate-users+groups): Add comment for \#:create-home?. (activate-user-home)[ensure-user-home]: Skip when CREATE-HOME? is #f or SYSTEM? is #t. * gnu/tests/base.scm (run-basic-test)["no extra home directories"]: New tests.
This commit is contained in:
parent
a20e00ddaf
commit
41f76ae08a
|
@ -227,7 +227,11 @@ numeric gid or #f."
|
||||||
#:supplementary-groups supplementary-groups
|
#:supplementary-groups supplementary-groups
|
||||||
#:comment comment
|
#:comment comment
|
||||||
#:home home
|
#:home home
|
||||||
|
|
||||||
|
;; Home directories of non-system accounts are created by
|
||||||
|
;; 'activate-user-home'.
|
||||||
#:create-home? (and create-home? system?)
|
#:create-home? (and create-home? system?)
|
||||||
|
|
||||||
#:shell shell
|
#:shell shell
|
||||||
#:password password)
|
#:password password)
|
||||||
|
|
||||||
|
@ -282,7 +286,10 @@ they already exist."
|
||||||
(match-lambda
|
(match-lambda
|
||||||
((name uid group supplementary-groups comment home create-home?
|
((name uid group supplementary-groups comment home create-home?
|
||||||
shell password system?)
|
shell password system?)
|
||||||
(unless (or (not home) (directory-exists? home))
|
;; The home directories of system accounts are created during
|
||||||
|
;; activation, not here.
|
||||||
|
(unless (or (not home) (not create-home?) system?
|
||||||
|
(directory-exists? home))
|
||||||
(let* ((pw (getpwnam name))
|
(let* ((pw (getpwnam name))
|
||||||
(uid (passwd:uid pw))
|
(uid (passwd:uid pw))
|
||||||
(gid (passwd:gid pw)))
|
(gid (passwd:gid pw)))
|
||||||
|
|
|
@ -199,6 +199,28 @@ info --version")
|
||||||
',users+homes))
|
',users+homes))
|
||||||
marionette)))
|
marionette)))
|
||||||
|
|
||||||
|
(test-equal "no extra home directories"
|
||||||
|
'()
|
||||||
|
|
||||||
|
;; Make sure the home directories that are not supposed to be
|
||||||
|
;; created are indeed not created.
|
||||||
|
(let ((nonexistent
|
||||||
|
'#$(filter-map (lambda (user)
|
||||||
|
(and (not
|
||||||
|
(user-account-create-home-directory?
|
||||||
|
user))
|
||||||
|
(user-account-home-directory user)))
|
||||||
|
(operating-system-user-accounts os))))
|
||||||
|
(marionette-eval
|
||||||
|
`(begin
|
||||||
|
(use-modules (srfi srfi-1))
|
||||||
|
|
||||||
|
;; Note: Do not flag "/var/empty".
|
||||||
|
(filter file-exists?
|
||||||
|
',(remove (cut string-prefix? "/var/" <>)
|
||||||
|
nonexistent)))
|
||||||
|
marionette)))
|
||||||
|
|
||||||
(test-equal "login on tty1"
|
(test-equal "login on tty1"
|
||||||
"root\n"
|
"root\n"
|
||||||
(begin
|
(begin
|
||||||
|
|
Loading…
Reference in New Issue