aboutsummaryrefslogtreecommitdiff
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
parent33f7b5d20e6c983c6d57048f552d9c055996e9cf (diff)
downloadguix-cf98d342b0899be3b72438d2dd5a2350f0f78f33.tar
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.
-rw-r--r--gnu/build/activation.scm26
-rw-r--r--gnu/tests/base.scm36
2 files changed, 49 insertions, 13 deletions
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index cff176e82a..e58304e83b 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -85,16 +85,27 @@
(chmod file (logior #o600 (stat:perms stat)))))
(define* (copy-account-skeletons home
- #:optional (directory %skeleton-directory))
- "Copy the account skeletons from DIRECTORY to HOME."
+ #:key
+ (directory %skeleton-directory)
+ uid gid)
+ "Copy the account skeletons from DIRECTORY to HOME. When UID is an integer,
+make it the owner of all the files created; likewise for GID."
+ (define (set-owner file)
+ (when (or uid gid)
+ (chown file (or uid -1) (or gid -1))))
+
(let ((files (scandir directory (negate dot-or-dot-dot?)
string<?)))
(mkdir-p home)
+ (set-owner home)
(for-each (lambda (file)
(let ((target (string-append home "/" file)))
(copy-recursively (string-append directory "/" file)
target
#:log (%make-void-port "w"))
+ (for-each set-owner
+ (find-files target (const #t)
+ #:directories? #t))
(make-file-writable target)))
files)))
@@ -277,9 +288,14 @@ they already exist."
((name uid group supplementary-groups comment home create-home?
shell password system?)
(unless (or (not home) (directory-exists? home))
- (mkdir-p home)
- (unless system?
- (copy-account-skeletons home))))))
+ (let* ((pw (getpwnam name))
+ (uid (passwd:uid pw))
+ (gid (passwd:gid pw)))
+ (mkdir-p home)
+ (chown home uid gid)
+ (unless system?
+ (copy-account-skeletons home
+ #:uid uid #:gid gid)))))))
(for-each ensure-user-home users))
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"