futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

activation: Set the right owner for home directories.

Browse Source 
This fixes a regression introduced in
ae763b5b0b 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.
This commit is contained in:
Ludovic Courtès 2017-02-03 09:50:09 +01:00
parent 33f7b5d20e
commit cf98d342b0
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 49 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
gnu/build/activation.scm
View File

@ -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))

36
gnu/tests/base.scm
View File

@ -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"