Merge branch 'master' into core-updates

4 files changed, 79 insertions, 116 deletions

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 40d4740d46..84bac94d9f 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -568,25 +568,24 @@ given @var{config}---an @code{<nscd-configuration>} object.  Optionally,
                               (shadow shadow))
   "Return a list of COUNT user accounts for Guix build users, with UIDs
 starting at FIRST-UID, and under GID."
-  (with-monad %store-monad
-    (return (unfold (cut > <> count)
-                    (lambda (n)
-                      (user-account
-                       (name (format #f "guixbuilder~2,'0d" n))
-                       (system? #t)
-                       (uid (+ first-uid n -1))
-                       (group group)
-
-                       ;; guix-daemon expects GROUP to be listed as a
-                       ;; supplementary group too:
-                       ;; <http://lists.gnu.org/archive/html/bug-guix/2013-01/msg00239.html>.
-                       (supplementary-groups (list group "kvm"))
-
-                       (comment (format #f "Guix Build User ~2d" n))
-                       (home-directory "/var/empty")
-                       (shell #~(string-append #$shadow "/sbin/nologin"))))
-                    1+
-                    1))))
+  (unfold (cut > <> count)
+          (lambda (n)
+            (user-account
+             (name (format #f "guixbuilder~2,'0d" n))
+             (system? #t)
+             (uid (+ first-uid n -1))
+             (group group)
+
+             ;; guix-daemon expects GROUP to be listed as a
+             ;; supplementary group too:
+             ;; <http://lists.gnu.org/archive/html/bug-guix/2013-01/msg00239.html>.
+             (supplementary-groups (list group "kvm"))
+
+             (comment (format #f "Guix Build User ~2d" n))
+             (home-directory "/var/empty")
+             (shell #~(string-append #$shadow "/sbin/nologin"))))
+          1+
+          1))
 
 (define (hydra-key-authorization guix)
   "Return a gexp with code to register the hydra.gnu.org public key with
@@ -636,8 +635,7 @@ passed to @command{guix-daemon}."
     (and authorize-hydra-key?
          (hydra-key-authorization guix)))
 
-  (mlet %store-monad ((accounts (guix-build-accounts build-accounts
-                                                     #:group builder-group)))
+  (with-monad %store-monad
     (return (service
              (provision '(guix-daemon))
              (requirement '(user-processes))
@@ -650,7 +648,8 @@ passed to @command{guix-daemon}."
                               '("--no-substitutes"))
                        #$@extra-options)))
              (stop #~(make-kill-destructor))
-             (user-accounts accounts)
+             (user-accounts (guix-build-accounts build-accounts
+                                                 #:group builder-group))
              (user-groups (list (user-group
                                  (name builder-group)
                                  (system? #t)
diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm
index 4bf76e01ec..618df91c5e 100644
--- a/gnu/services/dmd.scm
+++ b/gnu/services/dmd.scm
@@ -17,6 +17,8 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu services dmd)
+  #:use-module (guix ui)
+  #:use-module (guix sets)
   #:use-module (guix gexp)
   #:use-module (guix store)
   #:use-module (guix monads)
@@ -24,6 +26,8 @@
   #:use-module (gnu services)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:export (dmd-configuration-file))
 
 ;;; Commentary:
@@ -32,6 +36,26 @@
 ;;;
 ;;; Code:
 
+(define (assert-no-duplicates services)
+  "Raise an error if SERVICES provide the same dmd service more than once.
+
+This is a constraint that dmd's 'register-service' verifies but we'd better
+verify it here statically than wait until PID 1 halts with an assertion
+failure."
+  (fold (lambda (service set)
+          (define (assert-unique symbol)
+            (when (set-contains? set symbol)
+              (raise (condition
+                      (&message
+                       (message
+                        (format #f (_ "service '~a' provided more than once")
+                                symbol)))))))
+
+          (for-each assert-unique (service-provision service))
+          (fold set-insert set (service-provision service)))
+        (setq)
+        services))
+
 (define (dmd-configuration-file services)
   "Return the dmd configuration file for SERVICES."
   (define modules
@@ -40,6 +64,8 @@
       (gnu build file-systems)
       (guix build utils)))
 
+  (assert-no-duplicates services)
+
   (mlet %store-monad ((modules  (imported-modules modules))
                       (compiled (compiled-modules modules)))
     (define config
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index a2d8e3a045..af8dd43bd6 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -286,6 +286,14 @@ configuration file."
      (service
       (provision '(bitlbee))
       (requirement '(user-processes loopback))
+      (activate #~(begin
+                    (use-modules (guix build utils))
+
+                    ;; This directory is used to store OTR data.
+                    (mkdir-p "/var/lib/bitlbee")
+                    (let ((user (getpwnam "bitlbee")))
+                      (chown "/var/lib/bitlbee"
+                             (passwd:uid user) (passwd:gid user)))))
       (start #~(make-forkexec-constructor
                 (list (string-append #$bitlbee "/sbin/bitlbee")
                       "-n" "-F" "-u" "bitlbee" "-c" #$conf)))
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 562f57ffa0..c687b46bc2 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,9 +26,7 @@
   #:use-module (gnu packages xorg)
   #:use-module (gnu packages gl)
   #:use-module (gnu packages slim)
-  #:use-module (gnu packages ratpoison)
   #:use-module (gnu packages gnustep)
-  #:use-module (gnu packages sawfish)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages bash)
   #:use-module (guix gexp)
@@ -39,14 +38,6 @@
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
   #:export (xorg-start-command
-            %default-xsessions
-            %ratpoison-session-type
-            %windowmaker-session-type
-            %sawfish-session-type
-
-            session-type?
-            session-type-name
-
             %default-slim-theme
             %default-slim-theme-name
             slim-service))
@@ -167,26 +158,26 @@ which should be passed to this script as the first argument.  If not, the
           ;; environment variables that one gets when logging in on a tty, for
           ;; instance.
           (let* ((pw    (getpw (getuid)))
-                 (shell (passwd:shell pw))
-                 (st    (stat command #f)))
-            (when (and st (not (zero? (logand (stat:mode st) #o100))))
-              ;; Close any open file descriptors.  This is all the more
-              ;; important that SLiM itself exec's us directly without closing
-              ;; its own file descriptors!
-              (close-all-fdes)
-
-              ;; The '--login' option is supported at least by Bash and zsh.
-              (execl shell shell "--login" "-c"
-                     (string-join (cons command args))))))
-
-        (let ((home (getenv "HOME"))
-              (session (match (command-line)
-                         ((_ x) x)
-                         (_     #$fallback-session))))
-          ;; First, try to run ~/.xsession.
-          (exec-from-login-shell (string-append home "/.xsession"))
-          ;; Then try to start the specified session.
-          (exec-from-login-shell session))))
+                 (shell (passwd:shell pw)))
+            ;; Close any open file descriptors.  This is all the more
+            ;; important that SLiM itself exec's us directly without closing
+            ;; its own file descriptors!
+            (close-all-fdes)
+
+            ;; The '--login' option is supported at least by Bash and zsh.
+            (execl shell shell "--login" "-c"
+                   (string-join (cons command args)))))
+
+        (let* ((home          (getenv "HOME"))
+               (xsession-file (string-append home "/.xsession"))
+               (session       (match (command-line)
+                                ((_ x) x)
+                                (_     #$fallback-session))))
+          (if (file-exists? xsession-file)
+              ;; Run ~/.xsession when it exists.
+              (exec-from-login-shell xsession-file session)
+              ;; Otherwise, start the specified session.
+              (exec-from-login-shell session)))))
   (gexp->script "xinitrc" builder))
 
 
@@ -194,61 +185,6 @@ which should be passed to this script as the first argument.  If not, the
 ;;; SLiM log-in manager.
 ;;;
 
-(define-record-type* <session-type> session-type make-session-type
-  session-type?
-  (name         session-type-name)                ;string
-  (executable   session-type-executable))         ;string-valued gexp
-
-(define %windowmaker-session-type
-  (session-type
-   (name "WindowMaker")
-   (executable #~(string-append #$windowmaker "/bin/wmaker"))))
-
-(define %ratpoison-session-type
-  (session-type
-   (name "Ratpoison")
-   (executable #~(string-append #$ratpoison "/bin/ratpoison"))))
-
-(define %sawfish-session-type
-  (session-type
-   (name "Sawfish")
-   (executable #~(string-append #$sawfish "/bin/sawfish"))))
-
-(define %default-xsessions
-  ;; Default session types available to the log-in manager.
-  (list %windowmaker-session-type %ratpoison-session-type))
-
-(define (xsessions-directory sessions)
-  "Return a directory containing SESSIONS, a list of <session-type> objects.
-The alphabetical order of the files in that directory match the order of the
-elements in SESSIONS."
-  (define builder
-    #~(begin
-        (use-modules (srfi srfi-1)
-                     (ice-9 format))
-
-        (mkdir #$output)
-        (chdir #$output)
-        (fold (lambda (name executable number)
-                ;; Create file names such that the order of the items in
-                ;; SESSION is respected.  SLiM gets them in lexicographic
-                ;; order and uses the first one as the default session.
-                (let ((file (format #f "~2,'0d-~a.desktop"
-                                    number (string-downcase name))))
-                  (call-with-output-file file
-                    (lambda (port)
-                      (format port "[Desktop Entry]
-Name=~a
-Exec=~a
-Type=Application~%"
-                              name executable)))
-                  (+ 1 number)))
-              1
-              '#$(map session-type-name sessions)
-              (list #$@(map session-type-executable sessions)))))
-
-  (gexp->derivation "xsessions-dir" builder))
-
 (define %default-slim-theme
   ;; Theme based on work by Felipe López.
   #~(string-append #$%artwork-repository "/slim"))
@@ -264,7 +200,6 @@ Type=Application~%"
                        (theme %default-slim-theme)
                        (theme-name %default-slim-theme-name)
                        (xauth xauth) (dmd dmd) (bash bash)
-                       (sessions %default-xsessions)
                        (auto-login-session #~(string-append #$windowmaker
                                                             "/bin/wmaker"))
                        startx)
@@ -279,17 +214,12 @@ password.  When @var{auto-login?} is true, log in automatically as
 If @var{theme} is @code{#f}, the use the default log-in theme; otherwise
 @var{theme} must be a gexp denoting the name of a directory containing the
 theme to use.  In that case, @var{theme-name} specifies the name of the
-theme.
-
-Last, @var{session} is a list of @code{<session-type>} objects denoting the
-available session types that can be chosen from the log-in screen.  The first
-one is chosen by default."
+theme."
 
   (define (slim.cfg)
     (mlet %store-monad ((startx  (or startx (xorg-start-command)))
                         (xinitrc (xinitrc #:fallback-session
-                                          auto-login-session))
-                        (sessiondir (xsessions-directory sessions)))
+                                          auto-login-session)))
       (text-file* "slim.cfg"  "
 default_path /run/current-system/profile/bin
 default_xserver " startx "
@@ -300,7 +230,7 @@ authfile /var/run/slim.auth
 # The login command.  '%session' is replaced by the chosen session name, one
 # of the names specified in the 'sessions' setting: 'wmaker', 'xfce', etc.
 login_cmd  exec " xinitrc " %session
-sessiondir " sessiondir "
+sessiondir /run/current-system/profile/share/xsessions
 session_msg session (F1 to change):
 
 halt_cmd " dmd "/sbin/halt