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.

2 files changed, 30 insertions, 1 deletions

diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index beee56d4379..a1d2a9cc7d1 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -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)))
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 37aab8ef674..e5ac320b740 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -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