From 356a62b8e650867d107773120c33531ea429f189 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 5 May 2015 23:46:54 +0200
Subject: 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 file changed, 28 insertions(+), 3 deletions(-)

(limited to 'gnu')

diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index 0c60355a1c..8697d9d16d 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -78,6 +78,11 @@ (define %skeleton-directory
 (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 @@ (define* (copy-account-skeletons home
                         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 @@ (define* (add-user name group
                     ,@(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?
-- 
cgit v1.2.3