diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-02-03 09:50:09 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-02-04 02:13:43 +0100 |
| commit | cf98d342b0899be3b72438d2dd5a2350f0f78f33 (patch) | |
| tree | 29a34dca104d20256b732761b517aa6e7a82902e /gnu/tests | |
| parent | 33f7b5d20e6c983c6d57048f552d9c055996e9cf (diff) | |
| download | guix-cf98d342b0899be3b72438d2dd5a2350f0f78f33.tar.gz | |
activation: Set the right owner for home directories.
This fixes a regression introduced in ae763b5b0b7d5e7316a3d0efe991fe8ab2261031 whereby home directories and skeletons would be root-owned. * gnu/build/activation.scm (copy-account-skeletons): Make 'directory' a keyword parameter. Add #:uid and #:gid and honor them. [set-owner]: New procedure. (activate-user-home): Add call to 'getpw' and 'chown'. Pass UID and GID to 'copy-account-skeletons'. * gnu/tests/base.scm (run-basic-test)["skeletons in home directories"]: Test file ownership under HOME.
Diffstat (limited to 'gnu/tests')
| -rw-r--r-- | gnu/tests/base.scm | 36 |
1 files changed, 28 insertions, 8 deletions
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 756d3df800..8a6a7a1568 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -166,21 +166,41 @@ info --version") marionette))) (test-assert "skeletons in home directories" - (let ((homes + (let ((users+homes '#$(filter-map (lambda (account) (and (user-account-create-home-directory? account) (not (user-account-system? account)) - (user-account-home-directory account))) + (list (user-account-name account) + (user-account-home-directory + account)))) (operating-system-user-accounts os)))) (marionette-eval `(begin - (use-modules (srfi srfi-1) (ice-9 ftw)) - (every (lambda (home) - (null? (lset-difference string=? - (scandir "/etc/skel/") - (scandir home)))) - ',homes)) + (use-modules (srfi srfi-1) (ice-9 ftw) + (ice-9 match)) + + (every (match-lambda + ((user home) + ;; Make sure HOME has all the skeletons... + (and (null? (lset-difference string=? + (scandir "/etc/skel/") + (scandir home))) + + ;; ... and that everything is user-owned. + (let* ((pw (getpwnam user)) + (uid (passwd:uid pw)) + (gid (passwd:gid pw)) + (st (lstat home))) + (define (user-owned? file) + (= uid (stat:uid (lstat file)))) + + (and (= uid (stat:uid st)) + (eq? 'directory (stat:type st)) + (every user-owned? + (find-files home + #:directories? #t))))))) + ',users+homes)) marionette))) (test-equal "login on tty1" |