Merge branch 'master' into core-updates

6 files changed, 51 insertions, 14 deletions

diff --git a/gnu/services/avahi.scm b/gnu/services/avahi.scm
index e8da6be5f5..48a2c75927 100644
--- a/gnu/services/avahi.scm
+++ b/gnu/services/avahi.scm
@@ -96,7 +96,8 @@ sockets."
                     (mkdir-p "/var/run/avahi-daemon")))
 
       (user-groups (list (user-group
-                          (name "avahi"))))
+                          (name "avahi")
+                          (system? #t))))
       (user-accounts (list (user-account
                             (name "avahi")
                             (group "avahi")
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 55ee5c4b08..e1d247e8d3 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -25,10 +25,12 @@
   #:use-module (gnu system linux)                 ; 'pam-service', etc.
   #:use-module (gnu packages admin)
   #:use-module ((gnu packages linux)
-                #:select (udev kbd))
+                #:select (udev kbd e2fsprogs))
   #:use-module ((gnu packages base)
                 #:select (glibc-final))
   #:use-module (gnu packages package-management)
+  #:use-module ((guix build linux-initrd)
+                #:select (mount-flags->bit-mask))
   #:use-module (guix gexp)
   #:use-module (guix monads)
   #:use-module (srfi srfi-1)
@@ -96,11 +98,14 @@ This service must be the root of the service dependency graph so that its
       (respawn? #f)))))
 
 (define* (file-system-service device target type
-                              #:key (check? #t) options (title 'any))
+                              #:key (flags '()) (check? #t)
+                              create-mount-point? options (title 'any))
   "Return a service that mounts DEVICE on TARGET as a file system TYPE with
 OPTIONS.  TITLE is a symbol specifying what kind of name DEVICE is: 'label for
 a partition label, 'device for a device file name, or 'any.  When CHECK? is
-true, check the file system before mounting it."
+true, check the file system before mounting it.  When CREATE-MOUNT-POINT? is
+true, create TARGET if it does not exist yet.  FLAGS is a list of symbols,
+such as 'read-only' etc."
   (with-monad %store-monad
     (return
      (service
@@ -109,10 +114,22 @@ true, check the file system before mounting it."
       (documentation "Check, mount, and unmount the given file system.")
       (start #~(lambda args
                  (let ((device (canonicalize-device-spec #$device '#$title)))
+                   #$(if create-mount-point?
+                         #~(mkdir-p #$target)
+                         #~#t)
                    #$(if check?
-                         #~(check-file-system device #$type)
+                         #~(begin
+                             ;; Make sure fsck.ext2 & co. can be found.
+                             (setenv "PATH"
+                                     (string-append
+                                      #$e2fsprogs "/sbin:"
+                                      "/run/current-system/profile/sbin:"
+                                      (getenv "PATH")))
+                             (check-file-system device #$type))
                          #~#t)
-                   (mount device #$target #$type 0 #$options))
+                   (mount device #$target #$type
+                          #$(mount-flags->bit-mask flags)
+                          #$options))
                  #t))
       (stop #~(lambda args
                 ;; Normally there are no processes left at this point, so
@@ -455,6 +472,7 @@ passed to @command{guix-daemon}."
              (user-accounts accounts)
              (user-groups (list (user-group
                                  (name builder-group)
+                                 (system? #t)
 
                                  ;; Use a fixed GID so that we can create the
                                  ;; store with the right owner.
@@ -466,8 +484,13 @@ passed to @command{guix-daemon}."
   (with-monad %store-monad
     (return (service
              (provision '(udev))
+
+             ;; Udev needs /dev to be a 'devtmpfs' mount so that new device
+             ;; nodes can be added: see
+             ;; <http://www.linuxfromscratch.org/lfs/view/development/chapter07/udev.html>.
              (requirement '(root-file-system))
-             (documentation "Populate the /dev directory.")
+
+             (documentation "Populate the /dev directory, dynamically.")
              (start #~(lambda ()
                         (define udevd
                           (string-append #$udev "/libexec/udev/udevd"))
diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
index 6076317ee5..5da7f14605 100644
--- a/gnu/services/dbus.scm
+++ b/gnu/services/dbus.scm
@@ -86,7 +86,8 @@ and policy files.  For example, to allow avahi-daemon to use the system bus,
                       (string-append "--config-file=" #$conf "/system.conf"))))
       (stop #~(make-kill-destructor))
       (user-groups (list (user-group
-                          (name "messagebus"))))
+                          (name "messagebus")
+                          (system? #t))))
       (user-accounts (list (user-account
                             (name "messagebus")
                             (group "messagebus")
diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm
index 74adb27885..dfda2708f5 100644
--- a/gnu/services/dmd.scm
+++ b/gnu/services/dmd.scm
@@ -49,6 +49,7 @@
 
           (use-modules (ice-9 ftw)
                        (guix build syscalls)
+                       (guix build utils)
                        ((guix build linux-initrd)
                         #:select (check-file-system canonicalize-device-spec)))
 
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 502b0d85f1..6a7d194659 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -107,7 +107,8 @@ policy) as the @code{tor} unprivileged user."
       (stop #~(make-kill-destructor))
 
       (user-groups   (list (user-group
-                            (name "tor"))))
+                            (name "tor")
+                            (system? #t))))
       (user-accounts (list (user-account
                             (name "tor")
                             (group "tor")
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 7ca0d3f7db..a34129a8ed 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -97,7 +97,12 @@ EndSection
     #~(begin
         (use-modules (ice-9 match))
 
-        ;; TODO: Check for ~/.xsession.
+        ;; First, try to run ~/.xsession.
+        (let* ((home (getenv "HOME"))
+               (file (string-append home "/.xsession")))
+          (false-if-exception (execl file file)))
+
+        ;; Then try a pre-configured session type.
         (match (command-line)
           ((_ "ratpoison")
            (execl (string-append #$ratpoison "/bin/ratpoison")))
@@ -146,10 +151,15 @@ reboot_cmd " dmd "/sbin/reboot
       (provision '(xorg-server))
       (requirement '(user-processes host-name udev))
       (start
-       #~(make-forkexec-constructor
-          (list (string-append #$slim "/bin/slim") "-nodaemon")
-          #:environment-variables
-          (list (string-append "SLIM_CFGFILE=" #$slim.cfg))))
+       #~(lambda ()
+           ;; A stale lock file can prevent SLiM from starting, so remove it
+           ;; to be on the safe side.
+           (false-if-exception (delete-file "/var/run/slim.lock"))
+
+           (fork+exec-command
+            (list (string-append #$slim "/bin/slim") "-nodaemon")
+            #:environment-variables
+            (list (string-append "SLIM_CFGFILE=" #$slim.cfg)))))
       (stop #~(make-kill-destructor))
       (respawn? #t)
       (pam-services