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:
Ludovic Courtès 2017-05-18 10:08:55 +02:00
parent a20e00ddaf
commit 41f76ae08a
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 30 additions and 1 deletions

View File

@ -227,7 +227,11 @@ numeric gid or #f."
#:supplementary-groups supplementary-groups
#:comment comment
#:home home
;; Home directories of non-system accounts are created by
;; 'activate-user-home'.
#:create-home? (and create-home? system?)
#:shell shell
#:password password)
@ -282,7 +286,10 @@ they already exist."
(match-lambda
((name uid group supplementary-groups comment home create-home?
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))
(uid (passwd:uid pw))
(gid (passwd:gid pw)))

View File

@ -199,6 +199,28 @@ info --version")
',users+homes))
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"
"root\n"
(begin