Commit | Line | Data |
---|---|---|
db4fdc04 LC |
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' | |
bdb36958 LC |
22 | #:use-module ((gnu packages base) #:select (canonical-package)) |
23 | #:use-module (gnu packages guile) | |
db4fdc04 LC |
24 | #:use-module (gnu packages xorg) |
25 | #:use-module (gnu packages gl) | |
26 | #:use-module (gnu packages slim) | |
27 | #:use-module (gnu packages ratpoison) | |
9e4eddb4 | 28 | #:use-module (gnu packages gnustep) |
db4fdc04 LC |
29 | #:use-module (gnu packages admin) |
30 | #:use-module (gnu packages bash) | |
b5f4e686 | 31 | #:use-module (guix gexp) |
db4fdc04 LC |
32 | #:use-module (guix monads) |
33 | #:use-module (guix derivations) | |
34 | #:export (xorg-start-command | |
35 | slim-service)) | |
36 | ||
37 | ;;; Commentary: | |
38 | ;;; | |
39 | ;;; Services that relate to the X Window System. | |
40 | ;;; | |
41 | ;;; Code: | |
42 | ||
43 | (define* (xorg-start-command #:key | |
bdb36958 | 44 | (guile (canonical-package guile-2.0)) |
f703413e LC |
45 | (xorg-server xorg-server) |
46 | (drivers '())) | |
47 | "Return a derivation that builds a @var{guile} script to start the X server | |
48 | from @var{xorg-server}. Usually the X server is started by a login manager. | |
49 | ||
50 | @var{drivers} must be either the empty list, in which case Xorg chooses a | |
51 | graphics driver automatically, or a list of driver names that will be tried in | |
52 | this order---e.g., @code{(\"modesetting\" \"vesa\")}." | |
53 | ||
54 | (define (device-section driver) | |
55 | (string-append " | |
56 | Section \"Device\" | |
57 | Identifier \"device-" driver "\" | |
58 | Driver \"" driver "\" | |
59 | EndSection")) | |
db4fdc04 LC |
60 | |
61 | (define (xserver.conf) | |
62 | (text-file* "xserver.conf" " | |
63 | Section \"Files\" | |
378377eb | 64 | FontPath \"" font-adobe75dpi "/share/fonts/X11/75dpi\" |
db4fdc04 | 65 | ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\" |
0adb027b | 66 | ModulePath \"" xf86-video-fbdev "/lib/xorg/modules/drivers\" |
41d07f5e LC |
67 | # FIXME: Commented out due to libdrm incompatibility. |
68 | # ModulePath \"" xf86-video-modesetting "/lib/xorg/modules/drivers\" | |
0adb027b LC |
69 | ModulePath \"" xf86-video-cirrus "/lib/xorg/modules/drivers\" |
70 | ModulePath \"" xf86-video-intel "/lib/xorg/modules/drivers\" | |
71 | ModulePath \"" xf86-video-mach64 "/lib/xorg/modules/drivers\" | |
72 | ModulePath \"" xf86-video-nv "/lib/xorg/modules/drivers\" | |
db4fdc04 | 73 | ModulePath \"" xf86-input-keyboard "/lib/xorg/modules/input\" |
0adb027b LC |
74 | ModulePath \"" xf86-input-mouse "/lib/xorg/modules/input\" |
75 | ModulePath \"" xf86-input-synaptics "/lib/xorg/modules/input\" | |
db4fdc04 LC |
76 | ModulePath \"" xorg-server "/lib/xorg/modules\" |
77 | ModulePath \"" xorg-server "/lib/xorg/modules/extensions\" | |
78 | ModulePath \"" xorg-server "/lib/xorg/modules/multimedia\" | |
79 | EndSection | |
80 | ||
81 | Section \"ServerFlags\" | |
e30442b5 | 82 | Option \"AllowMouseOpenFail\" \"on\" |
db4fdc04 | 83 | EndSection |
f703413e LC |
84 | " |
85 | (string-join (map device-section drivers) "\n"))) | |
db4fdc04 | 86 | |
8779d342 LC |
87 | (mlet %store-monad ((config (xserver.conf))) |
88 | (define script | |
db4fdc04 | 89 | ;; Write a small wrapper around the X server. |
8779d342 LC |
90 | #~(begin |
91 | (setenv "XORG_DRI_DRIVER_PATH" (string-append #$mesa "/lib/dri")) | |
92 | (setenv "XKB_BINDIR" (string-append #$xkbcomp "/bin")) | |
93 | ||
94 | (apply execl (string-append #$xorg-server "/bin/X") | |
95 | "-ac" "-logverbose" "-verbose" | |
96 | "-xkbdir" (string-append #$xkeyboard-config "/share/X11/xkb") | |
97 | "-config" #$config | |
98 | "-nolisten" "tcp" "-terminate" | |
99 | ||
100 | ;; Note: SLiM and other display managers add the | |
101 | ;; '-auth' flag by themselves. | |
102 | (cdr (command-line))))) | |
103 | ||
104 | (gexp->script "start-xorg" script))) | |
db4fdc04 | 105 | |
9e4eddb4 | 106 | (define* (xinitrc #:key |
bdb36958 | 107 | (guile (canonical-package guile-2.0)) |
9e4eddb4 LC |
108 | (ratpoison ratpoison) |
109 | (windowmaker windowmaker)) | |
110 | "Return a system-wide xinitrc script that starts the specified X session." | |
8779d342 LC |
111 | (define builder |
112 | #~(begin | |
113 | (use-modules (ice-9 match)) | |
114 | ||
d9372161 LC |
115 | ;; First, try to run ~/.xsession. |
116 | (let* ((home (getenv "HOME")) | |
117 | (file (string-append home "/.xsession"))) | |
118 | (false-if-exception (execl file file))) | |
119 | ||
120 | ;; Then try a pre-configured session type. | |
8779d342 LC |
121 | (match (command-line) |
122 | ((_ "ratpoison") | |
123 | (execl (string-append #$ratpoison "/bin/ratpoison"))) | |
124 | (_ | |
125 | (execl (string-append #$windowmaker "/bin/wmaker")))))) | |
126 | ||
127 | (gexp->script "xinitrc" builder)) | |
9e4eddb4 | 128 | |
db4fdc04 LC |
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 | |
51da7ca0 LC |
135 | turn starts the X display server with @var{startx}, a command as returned by |
136 | @code{xorg-start-command}. | |
db4fdc04 | 137 | |
51da7ca0 LC |
138 | When @var{allow-empty-passwords?} is true, allow logins with an empty |
139 | password. When @var{auto-login?} is true, log in automatically as | |
140 | @var{default-user}." | |
db4fdc04 | 141 | (define (slim.cfg) |
9e4eddb4 LC |
142 | (mlet %store-monad ((startx (or startx (xorg-start-command))) |
143 | (xinitrc (xinitrc))) | |
db4fdc04 | 144 | (text-file* "slim.cfg" " |
b4140694 | 145 | default_path /run/current-system/profile/bin |
db4fdc04 LC |
146 | default_xserver " startx " |
147 | xserver_arguments :0 vt7 | |
148 | xauth_path " xauth "/bin/xauth | |
149 | authfile /var/run/slim.auth | |
150 | ||
151 | # The login command. '%session' is replaced by the chosen session name, one | |
152 | # of the names specified in the 'sessions' setting: 'wmaker', 'xfce', etc. | |
057d6ce5 | 153 | login_cmd exec " xinitrc " %session |
9e4eddb4 | 154 | sessions wmaker,ratpoison |
db4fdc04 LC |
155 | |
156 | halt_cmd " dmd "/sbin/halt | |
157 | reboot_cmd " dmd "/sbin/reboot | |
158 | " (if auto-login? | |
159 | (string-append "auto_login yes\ndefault_user " default-user) | |
160 | "")))) | |
161 | ||
b5f4e686 | 162 | (mlet %store-monad ((slim.cfg (slim.cfg))) |
db4fdc04 LC |
163 | (return |
164 | (service | |
165 | (documentation "Xorg display server") | |
166 | (provision '(xorg-server)) | |
8dbab712 | 167 | (requirement '(user-processes host-name udev)) |
db4fdc04 | 168 | (start |
47b73c34 LC |
169 | #~(lambda () |
170 | ;; A stale lock file can prevent SLiM from starting, so remove it | |
171 | ;; to be on the safe side. | |
172 | (false-if-exception (delete-file "/var/run/slim.lock")) | |
173 | ||
174 | (fork+exec-command | |
175 | (list (string-append #$slim "/bin/slim") "-nodaemon") | |
176 | #:environment-variables | |
177 | (list (string-append "SLIM_CFGFILE=" #$slim.cfg))))) | |
b5f4e686 | 178 | (stop #~(make-kill-destructor)) |
db4fdc04 LC |
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 |