From 40281c542490e56abea648b3405dd133c549469d Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 12 May 2014 23:37:13 +0200
Subject: system: Populate /etc/skel.

* gnu/system.scm (<operating-system>)[skeletons]: New field.
  (default-skeletons, skeleton-directory): New procedures.
  (etc-directory): Add #:skeletons parameter.  Call
  'skeleton-directory', and produce the 'skel' sub-directory.
  (operating-system-etc-directory): Pass #:skeletons to
  'etc-directory'.
---
 gnu/system.scm | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 61 insertions(+), 2 deletions(-)

(limited to 'gnu')

diff --git a/gnu/system.scm b/gnu/system.scm
index bd69532a89..ce5aad22bb 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -26,6 +26,7 @@
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
   #:use-module (gnu packages admin)
+  #:use-module (gnu packages guile-wm)
   #:use-module (gnu packages package-management)
   #:use-module (gnu services)
   #:use-module (gnu services dmd)
@@ -98,6 +99,9 @@
                           (name "root")
                           (id 0)))))
 
+  (skeletons operating-system-skeletons           ; list of name/monadic value
+             (default (default-skeletons)))
+
   (packages operating-system-packages             ; list of (PACKAGE OUTPUT...)
             (default (list coreutils              ; or just PACKAGE
                            grep
@@ -184,6 +188,11 @@ file."
 
   (gexp->derivation name builder))
 
+
+;;;
+;;; Services.
+;;;
+
 (define (other-file-system-services os)
   "Return file system services for the file systems of OS that are not marked
 as 'needed-for-boot'."
@@ -222,8 +231,54 @@ explicitly appear in OS."
        (essential (essential-services os)))
     (return (append essential user))))
 
+
+;;;
+;;; /etc.
+;;;
+
+(define (default-skeletons)
+  "Return the default skeleton files for /etc/skel.  These files are copied by
+'useradd' in the home directory of newly created user accounts."
+  (define copy-guile-wm
+    #~(begin
+        (use-modules (guix build utils))
+        (copy-file (car (find-files #$guile-wm "wm-init-sample.scm"))
+                   #$output)))
+
+  (mlet %store-monad ((bashrc (text-file "bashrc" "\
+# Allow non-login shells such as an xterm to get things right.
+test -f /etc/profile && source /etc/profile\n"))
+                      (guile-wm (gexp->derivation "guile-wm" copy-guile-wm
+                                                  #:modules
+                                                  '((guix build utils))))
+                      (xdefaults (text-file "Xdefaults" "\
+XTerm*utf8: always
+XTerm*metaSendsEscape: true\n")))
+    (return `((".bashrc" ,bashrc)
+              (".Xdefaults" ,xdefaults)
+              (".guile-wm" ,guile-wm)))))
+
+(define (skeleton-directory skeletons)
+  "Return a directory containing SKELETONS, a list of name/derivation pairs."
+  (gexp->derivation "skel"
+                    #~(begin
+                        (use-modules (ice-9 match))
+
+                        (mkdir #$output)
+                        (chdir #$output)
+
+                        ;; Note: copy the skeletons instead of symlinking
+                        ;; them like 'file-union' does, because 'useradd'
+                        ;; would just copy the symlinks as is.
+                        (for-each (match-lambda
+                                   ((target source)
+                                    (copy-file source target)))
+                                  '#$skeletons)
+                        #t)))
+
 (define* (etc-directory #:key
                         (locale "C") (timezone "Europe/Paris")
+                        (skeletons '())
                         (pam-services '())
                         (profile "/var/run/current-system/profile")
                         (sudoers ""))
@@ -261,7 +316,8 @@ export CPATH=$HOME/.guix-profile/include:" profile "/include
 export LIBRARY_PATH=$HOME/.guix-profile/lib:" profile "/lib
 alias ls='ls -p --color'
 alias ll='ls -l'
-")))
+"))
+       (skel      (skeleton-directory skeletons)))
     (file-union "etc"
                 `(("services" ,#~(string-append #$net-base "/etc/services"))
                   ("protocols" ,#~(string-append #$net-base "/etc/protocols"))
@@ -269,6 +325,7 @@ alias ll='ls -l'
                   ("pam.d" ,#~#$pam.d)
                   ("login.defs" ,#~#$login.defs)
                   ("issue" ,#~#$issue)
+                  ("skel" ,#~#$skel)
                   ("shells" ,#~#$shells)
                   ("profile" ,#~#$bashrc)
                   ("localtime" ,#~(string-append #$tzdata "/share/zoneinfo/"
@@ -313,8 +370,10 @@ alias ll='ls -l'
                      (delete-duplicates
                       (append (operating-system-pam-services os)
                               (append-map service-pam-services services))))
-       (profile-drv (operating-system-profile os)))
+       (profile-drv (operating-system-profile os))
+       (skeletons   (operating-system-skeletons os)))
    (etc-directory #:pam-services pam-services
+                  #:skeletons skeletons
                   #:locale (operating-system-locale os)
                   #:timezone (operating-system-timezone os)
                   #:sudoers (operating-system-sudoers os)
-- 
cgit 1.4.1