summaryrefslogtreecommitdiff
path: root/gnu/tests/base.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-02-03 09:50:09 +0100
committerLudovic Courtès <ludo@gnu.org>2017-02-04 02:13:43 +0100
commitcf98d342b0899be3b72438d2dd5a2350f0f78f33 (patch)
tree29a34dca104d20256b732761b517aa6e7a82902e /gnu/tests/base.scm
parent33f7b5d20e6c983c6d57048f552d9c055996e9cf (diff)
downloadpatches-cf98d342b0899be3b72438d2dd5a2350f0f78f33.tar
patches-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/base.scm')
-rw-r--r--gnu/tests/base.scm36
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"