01/02: activation: Set the right owner for home directories.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit cf98d342b0899be3b72438d2dd5a2350f0f78f33
Author: Ludovic Courtès <address@hidden>
Date:   Fri Feb 3 09:50:09 2017 +0100

    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.
---
 gnu/build/activation.scm |   26 +++++++++++++++++++++-----
 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 cff176e..e58304e 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 756d3df..8a6a7a1 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"