~ruther/guix-local

41f76ae08a7a830cdeb1eaac271d714cb58fbce3 — Ludovic Courtès 8 years ago a20e00d
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(-)

M gnu/build/activation.scm
M gnu/tests/base.scm
M gnu/build/activation.scm => gnu/build/activation.scm +8 -1
@@ 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)))

M gnu/tests/base.scm => gnu/tests/base.scm +22 -0
@@ 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