diff options
| -rw-r--r-- | gnu/build/activation.scm | 26 | ||||
| -rw-r--r-- | gnu/tests/base.scm | 36 |
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" |