gnu/services/xorg.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (gnu services xorg)
  20   #:use-module (gnu services)
  21   #:use-module (gnu system linux)                 ; 'pam-service'
  22   #:use-module ((gnu packages base) #:select (guile-final))
  23   #:use-module (gnu packages xorg)
  24   #:use-module (gnu packages gl)
  25   #:use-module (gnu packages slim)
  26   #:use-module (gnu packages ratpoison)
  27   #:use-module (gnu packages admin)
  28   #:use-module (gnu packages bash)
  29   #:use-module (guix monads)
  30   #:use-module (guix derivations)
  31   #:export (xorg-start-command
  32             slim-service))
  33
  34 ;;; Commentary:
  35 ;;;
  36 ;;; Services that relate to the X Window System.
  37 ;;;
  38 ;;; Code:
  39
  40 (define* (xorg-start-command #:key
  41                              (guile guile-final)
  42                              (xorg-server xorg-server))
  43   "Return a derivation that builds a GUILE script to start the X server from
  44 XORG-SERVER.  Usually the X server is started by a login manager."
  45
  46   (define (xserver.conf)
  47     (text-file* "xserver.conf" "
  48 Section \"Files\"
  49   FontPath \"" font-adobe75dpi "/share/font/X11/75dpi\"
  50   ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\"
  51   ModulePath \"" xf86-input-mouse "/lib/xorg/modules/input\"
  52   ModulePath \"" xf86-input-keyboard "/lib/xorg/modules/input\"
  53   ModulePath \"" xorg-server "/lib/xorg/modules\"
  54   ModulePath \"" xorg-server "/lib/xorg/modules/extensions\"
  55   ModulePath \"" xorg-server "/lib/xorg/modules/multimedia\"
  56 EndSection
  57
  58 Section \"ServerFlags\"
  59   Option \"AllowMouseOpenFail\" \"on""
  60 EndSection
  61
  62 Section \"Monitor\"
  63   Identifier \"Monitor[0]\"
  64 EndSection
  65
  66 Section \"InputClass\"
  67   Identifier \"Generic keyboard\"
  68   MatchIsKeyboard \"on\"
  69   Option \"XkbRules\" \"base\"
  70   Option \"XkbModel\" \"pc104\"
  71 EndSection
  72
  73 Section \"ServerLayout\"
  74   Identifier \"Layout\"
  75   Screen \"Screen-vesa\"
  76 EndSection
  77
  78 Section \"Device\"
  79   Identifier \"Device-vesa\"
  80   Driver \"vesa\"
  81 EndSection
  82
  83 Section \"Screen\"
  84   Identifier \"Screen-vesa\"
  85   Device \"Device-vesa\"
  86 EndSection"))
  87
  88   (mlet %store-monad ((guile-bin   (package-file guile "bin/guile"))
  89                       (xorg-bin    (package-file xorg-server "bin/X"))
  90                       (dri         (package-file mesa "lib/dri"))
  91                       (xkbcomp-bin (package-file xkbcomp "bin"))
  92                       (xkb-dir     (package-file xkeyboard-config
  93                                                  "share/X11/xkb"))
  94                       (config      (xserver.conf)))
  95     (define builder
  96       ;; Write a small wrapper around the X server.
  97       `(let ((out (assoc-ref %outputs "out")))
  98          (call-with-output-file out
  99            (lambda (port)
 100              (format port "#!~a --no-auto-compile~%!#~%" ,guile-bin)
 101              (write '(begin
 102                        (setenv "XORG_DRI_DRIVER_PATH" ,dri)
 103                        (setenv "XKB_BINDIR" ,xkbcomp-bin)
 104
 105                        (apply execl
 106
 107                               ,xorg-bin "-ac" "-logverbose" "-verbose"
 108                               "-xkbdir" ,xkb-dir
 109                               "-config" ,(derivation->output-path config)
 110                               "-nolisten" "tcp" "-terminate"
 111
 112                               ;; Note: SLiM and other display managers add the
 113                               ;; '-auth' flag by themselves.
 114                               (cdr (command-line))))
 115                     port)))
 116          (chmod out #o555)
 117          #t))
 118
 119     (mlet %store-monad ((inputs (lower-inputs
 120                                  `(("xorg" ,xorg-server)
 121                                    ("xkbcomp" ,xkbcomp)
 122                                    ("xkeyboard-config" ,xkeyboard-config)
 123                                    ("mesa" ,mesa)
 124                                    ("guile" ,guile)
 125                                    ("xorg.conf" ,config)))))
 126       (derivation-expression "start-xorg" builder
 127                              #:inputs inputs))))
 128
 129 (define* (slim-service #:key (slim slim)
 130                        (allow-empty-passwords? #t) auto-login?
 131                        (default-user "")
 132                        (xauth xauth) (dmd dmd) (bash bash)
 133                        startx)
 134   "Return a service that spawns the SLiM graphical login manager, which in
 135 turn start the X display server with STARTX, a command as returned by
 136 'xorg-start-command'.
 137
 138 When ALLOW-EMPTY-PASSWORDS? is true, allow logins with an empty password.
 139 When AUTO-LOGIN? is true, log in automatically as DEFAULT-USER."
 140   (define (slim.cfg)
 141     ;; TODO: Run "bash -login ~/.xinitrc %session".
 142     (mlet %store-monad ((startx (or startx (xorg-start-command))))
 143       (text-file* "slim.cfg"  "
 144 default_path /run/current-system/bin
 145 default_xserver " startx "
 146 xserver_arguments :0 vt7
 147 xauth_path " xauth "/bin/xauth
 148 authfile /var/run/slim.auth
 149
 150 # The login command.  '%session' is replaced by the chosen session name, one
 151 # of the names specified in the 'sessions' setting: 'wmaker', 'xfce', etc.
 152 login_cmd  exec " ratpoison "/bin/ratpoison
 153
 154 halt_cmd " dmd "/sbin/halt
 155 reboot_cmd " dmd "/sbin/reboot
 156 " (if auto-login?
 157       (string-append "auto_login yes\ndefault_user " default-user)
 158       ""))))
 159
 160   (mlet %store-monad ((slim-bin (package-file slim "bin/slim"))
 161                       (bash-bin (package-file bash "bin/bash"))
 162                       (slim.cfg (slim.cfg)))
 163     (return
 164      (service
 165       (documentation "Xorg display server")
 166       (provision '(xorg-server))
 167       (requirement '(host-name))
 168       (start
 169        ;; XXX: Work around the inability to specify env. vars. directly.
 170        `(make-forkexec-constructor
 171          ,bash-bin "-c"
 172          ,(string-append "SLIM_CFGFILE=" (derivation->output-path slim.cfg)
 173                          " " slim-bin
 174                          " -nodaemon")))
 175       (stop  `(make-kill-destructor))
 176       (inputs `(("slim" ,slim)
 177                 ("slim.cfg" ,slim.cfg)
 178                 ("bash" ,bash)))
 179       (respawn? #t)
 180       (pam-services
 181        ;; Tell PAM about 'slim'.
 182        (list (unix-pam-service
 183               "slim"
 184               #:allow-empty-passwords? allow-empty-passwords?)))))))
 185
 186 ;;; xorg.scm ends here