01/01: activation: Make user copies of the skeletons writable.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 356a62b8e650867d107773120c33531ea429f189
Author: Ludovic Courtès <address@hidden>
Date:   Tue May 5 23:46:54 2015 +0200

    activation: Make user copies of the skeletons writable.
    
    * gnu/build/activation.scm (make-file-writable,
      make-skeletons-writable): New procedures.
      (copy-account-skeletons): Call 'make-file-writable' after 'copy-file'.
      (add-user): Add call to 'make-skeletons-writable'.
---
 gnu/build/activation.scm |   31 ++++++++++++++++++++++++++++---
 1 files changed, 28 insertions(+), 3 deletions(-)

diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index 0c60355..8697d9d 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -78,6 +78,11 @@
 (define (dot-or-dot-dot? file)
   (member file '("." "..")))
 
+(define (make-file-writable file)
+  "Make FILE writable for its owner.."
+  (let ((stat (lstat file)))                      ;XXX: symlinks
+    (chmod file (logior #o600 (stat:perms stat)))))
+
 (define* (copy-account-skeletons home
                                  #:optional (directory %skeleton-directory))
   "Copy the account skeletons from DIRECTORY to HOME."
@@ -85,8 +90,21 @@
                         string<?)))
     (mkdir-p home)
     (for-each (lambda (file)
-                (copy-file (string-append directory "/" file)
-                           (string-append home "/" file)))
+                (let ((target (string-append home "/" file)))
+                  (copy-file (string-append directory "/" file) target)
+                  (make-file-writable target)))
+              files)))
+
+(define* (make-skeletons-writable home
+                                  #:optional (directory %skeleton-directory))
+  "Make sure that the files that have been copied from DIRECTORY to HOME are
+owner-writable in HOME."
+  (let ((files (scandir directory (negate dot-or-dot-dot?)
+                        string<?)))
+    (for-each (lambda (file)
+                (let ((target (string-append home "/" file)))
+                  (when (file-exists? target)
+                    (make-file-writable target))))
               files)))
 
 (define* (add-user name group
@@ -128,7 +146,14 @@ properties.  Return #t on success."
                     ,@(if password `("-p" ,password) '())
                     ,@(if system? '("--system") '())
                     ,name)))
-        (zero? (apply system* "useradd" args)))))
+        (and (zero? (apply system* "useradd" args))
+             (begin
+               ;; Since /etc/skel is a link to a directory in the store where
+               ;; all files have the writable bit cleared, and since 'useradd'
+               ;; preserves permissions when it copies them, explicitly make
+               ;; them writable.
+               (make-skeletons-writable home)
+               #t)))))
 
 (define* (modify-user name group
                       #:key uid comment home shell password system?