Commit | Line | Data |
---|---|---|
db4fdc04 | 1 | ;;; GNU Guix --- Functional package management for GNU |
c510cbb4 | 2 | ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> |
4bd43bbe | 3 | ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> |
db4fdc04 LC |
4 | ;;; |
5 | ;;; This file is part of GNU Guix. | |
6 | ;;; | |
7 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
8 | ;;; under the terms of the GNU General Public License as published by | |
9 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
10 | ;;; your option) any later version. | |
11 | ;;; | |
12 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
13 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;;; GNU General Public License for more details. | |
16 | ;;; | |
17 | ;;; You should have received a copy of the GNU General Public License | |
18 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
19 | ||
20 | (define-module (gnu services xorg) | |
84dfb458 | 21 | #:use-module (gnu artwork) |
db4fdc04 | 22 | #:use-module (gnu services) |
0190c1c0 | 23 | #:use-module (gnu services shepherd) |
6e828634 | 24 | #:use-module (gnu system pam) |
bdb36958 LC |
25 | #:use-module ((gnu packages base) #:select (canonical-package)) |
26 | #:use-module (gnu packages guile) | |
db4fdc04 LC |
27 | #:use-module (gnu packages xorg) |
28 | #:use-module (gnu packages gl) | |
5fd66a37 | 29 | #:use-module (gnu packages display-managers) |
9e4eddb4 | 30 | #:use-module (gnu packages gnustep) |
db4fdc04 LC |
31 | #:use-module (gnu packages admin) |
32 | #:use-module (gnu packages bash) | |
b5f4e686 | 33 | #:use-module (guix gexp) |
e87f0591 | 34 | #:use-module (guix store) |
6726282b | 35 | #:use-module (guix packages) |
db4fdc04 | 36 | #:use-module (guix derivations) |
ffc3a02b | 37 | #:use-module (guix records) |
d2e59637 | 38 | #:use-module (srfi srfi-1) |
6726282b | 39 | #:use-module (srfi srfi-9) |
d2e59637 LC |
40 | #:use-module (srfi srfi-26) |
41 | #:use-module (ice-9 match) | |
d1cdd7ba | 42 | #:export (xorg-configuration-file |
79fd74fa | 43 | %default-xorg-modules |
d1cdd7ba | 44 | xorg-start-command |
f2901d82 DC |
45 | xinitrc |
46 | ||
0ecc3bf3 LC |
47 | %default-slim-theme |
48 | %default-slim-theme-name | |
4b7513e0 DT |
49 | slim-configuration |
50 | slim-service-type | |
6726282b LC |
51 | slim-service |
52 | ||
24e96431 TČ |
53 | screen-locker |
54 | screen-locker? | |
6726282b LC |
55 | screen-locker-service-type |
56 | screen-locker-service)) | |
db4fdc04 LC |
57 | |
58 | ;;; Commentary: | |
59 | ;;; | |
60 | ;;; Services that relate to the X Window System. | |
61 | ;;; | |
62 | ;;; Code: | |
63 | ||
12422c9d LC |
64 | (define* (xorg-configuration-file #:key (drivers '()) (resolutions '()) |
65 | (extra-config '())) | |
d1cdd7ba LC |
66 | "Return a configuration file for the Xorg server containing search paths for |
67 | all the common drivers. | |
f703413e LC |
68 | |
69 | @var{drivers} must be either the empty list, in which case Xorg chooses a | |
70 | graphics driver automatically, or a list of driver names that will be tried in | |
d2e59637 LC |
71 | this order---e.g., @code{(\"modesetting\" \"vesa\")}. |
72 | ||
73 | Likewise, when @var{resolutions} is the empty list, Xorg chooses an | |
74 | appropriate screen resolution; otherwise, it must be a list of | |
12422c9d LC |
75 | resolutions---e.g., @code{((1024 768) (640 480))}. |
76 | ||
77 | Last, @var{extra-config} is a list of strings or objects appended to the | |
be1c2c54 LC |
78 | @code{mixed-text-file} argument list. It is used to pass extra text to be |
79 | added verbatim to the configuration file." | |
f703413e LC |
80 | (define (device-section driver) |
81 | (string-append " | |
82 | Section \"Device\" | |
83 | Identifier \"device-" driver "\" | |
84 | Driver \"" driver "\" | |
85 | EndSection")) | |
db4fdc04 | 86 | |
d2e59637 LC |
87 | (define (screen-section driver resolutions) |
88 | (string-append " | |
89 | Section \"Screen\" | |
90 | Identifier \"screen-" driver "\" | |
91 | Device \"device-" driver "\" | |
92 | SubSection \"Display\" | |
93 | Modes " | |
94 | (string-join (map (match-lambda | |
d1cdd7ba LC |
95 | ((x y) |
96 | (string-append "\"" (number->string x) | |
97 | "x" (number->string y) "\""))) | |
d2e59637 LC |
98 | resolutions)) " |
99 | EndSubSection | |
100 | EndSection")) | |
101 | ||
be1c2c54 | 102 | (apply mixed-text-file "xserver.conf" " |
db4fdc04 | 103 | Section \"Files\" |
d1ccd094 EB |
104 | FontPath \"" font-alias "/share/fonts/X11/75dpi\" |
105 | FontPath \"" font-alias "/share/fonts/X11/100dpi\" | |
106 | FontPath \"" font-alias "/share/fonts/X11/misc\" | |
107 | FontPath \"" font-alias "/share/fonts/X11/cyrillic\" | |
378377eb | 108 | FontPath \"" font-adobe75dpi "/share/fonts/X11/75dpi\" |
db4fdc04 | 109 | ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\" |
0adb027b | 110 | ModulePath \"" xf86-video-fbdev "/lib/xorg/modules/drivers\" |
3fc4eb21 | 111 | ModulePath \"" xf86-video-modesetting "/lib/xorg/modules/drivers\" |
0adb027b LC |
112 | ModulePath \"" xf86-video-cirrus "/lib/xorg/modules/drivers\" |
113 | ModulePath \"" xf86-video-intel "/lib/xorg/modules/drivers\" | |
114 | ModulePath \"" xf86-video-mach64 "/lib/xorg/modules/drivers\" | |
ca63770a | 115 | ModulePath \"" xf86-video-nouveau "/lib/xorg/modules/drivers\" |
0adb027b | 116 | ModulePath \"" xf86-video-nv "/lib/xorg/modules/drivers\" |
2c37a34c | 117 | ModulePath \"" xf86-video-sis "/lib/xorg/modules/drivers\" |
c2ee19e6 LC |
118 | |
119 | # Libinput is the new thing and is recommended over evdev/synaptics | |
120 | # by those who know: | |
121 | # <http://who-t.blogspot.fr/2015/01/xf86-input-libinput-compatibility-with.html>. | |
122 | ModulePath \"" xf86-input-libinput "/lib/xorg/modules/input\" | |
123 | ||
073cd609 | 124 | ModulePath \"" xf86-input-evdev "/lib/xorg/modules/input\" |
db4fdc04 | 125 | ModulePath \"" xf86-input-keyboard "/lib/xorg/modules/input\" |
0adb027b LC |
126 | ModulePath \"" xf86-input-mouse "/lib/xorg/modules/input\" |
127 | ModulePath \"" xf86-input-synaptics "/lib/xorg/modules/input\" | |
db4fdc04 LC |
128 | ModulePath \"" xorg-server "/lib/xorg/modules\" |
129 | ModulePath \"" xorg-server "/lib/xorg/modules/extensions\" | |
130 | ModulePath \"" xorg-server "/lib/xorg/modules/multimedia\" | |
131 | EndSection | |
132 | ||
133 | Section \"ServerFlags\" | |
e30442b5 | 134 | Option \"AllowMouseOpenFail\" \"on\" |
db4fdc04 | 135 | EndSection |
f703413e | 136 | " |
12422c9d | 137 | (string-join (map device-section drivers) "\n") "\n" |
d2e59637 LC |
138 | (string-join (map (cut screen-section <> resolutions) |
139 | drivers) | |
12422c9d LC |
140 | "\n") |
141 | ||
142 | "\n" | |
143 | extra-config)) | |
db4fdc04 | 144 | |
79fd74fa AW |
145 | (define %default-xorg-modules |
146 | (list xf86-video-vesa | |
147 | xf86-video-fbdev | |
148 | xf86-video-modesetting | |
149 | xf86-video-cirrus | |
150 | xf86-video-intel | |
151 | xf86-video-mach64 | |
152 | xf86-video-nouveau | |
153 | xf86-video-nv | |
154 | xf86-video-sis | |
155 | xf86-input-libinput | |
156 | xf86-input-evdev | |
157 | xf86-input-keyboard | |
158 | xf86-input-mouse | |
159 | xf86-input-synaptics)) | |
160 | ||
161 | (define (xorg-configuration-directory modules) | |
162 | "Return a directory that contains the @code{.conf} files for X.org that | |
163 | includes the @code{share/X11/xorg.conf.d} directories of each package listed | |
164 | in @var{modules}." | |
4ee96a79 LC |
165 | (with-imported-modules '((guix build utils)) |
166 | (computed-file "xorg.conf.d" | |
167 | #~(begin | |
168 | (use-modules (guix build utils) | |
169 | (srfi srfi-1)) | |
170 | ||
171 | (define files | |
172 | (append-map (lambda (module) | |
173 | (find-files (string-append | |
174 | module | |
175 | "/share/X11/xorg.conf.d") | |
176 | "\\.conf$")) | |
177 | (list #$@modules))) | |
178 | ||
179 | (mkdir #$output) | |
180 | (for-each (lambda (file) | |
181 | (symlink file | |
182 | (string-append #$output "/" | |
183 | (basename file)))) | |
184 | files) | |
185 | #t)))) | |
79fd74fa | 186 | |
d1cdd7ba LC |
187 | (define* (xorg-start-command #:key |
188 | (guile (canonical-package guile-2.0)) | |
be1c2c54 | 189 | (configuration-file (xorg-configuration-file)) |
79fd74fa | 190 | (modules %default-xorg-modules) |
d1cdd7ba LC |
191 | (xorg-server xorg-server)) |
192 | "Return a derivation that builds a @var{guile} script to start the X server | |
193 | from @var{xorg-server}. @var{configuration-file} is the server configuration | |
194 | file or a derivation that builds it; when omitted, the result of | |
195 | @code{xorg-configuration-file} is used. | |
196 | ||
197 | Usually the X server is started by a login manager." | |
be1c2c54 LC |
198 | (define exp |
199 | ;; Write a small wrapper around the X server. | |
200 | #~(begin | |
201 | (setenv "XORG_DRI_DRIVER_PATH" (string-append #$mesa "/lib/dri")) | |
202 | (setenv "XKB_BINDIR" (string-append #$xkbcomp "/bin")) | |
203 | ||
204 | (apply execl (string-append #$xorg-server "/bin/X") | |
205 | (string-append #$xorg-server "/bin/X") ;argv[0] | |
206 | "-logverbose" "-verbose" | |
207 | "-xkbdir" (string-append #$xkeyboard-config "/share/X11/xkb") | |
208 | "-config" #$configuration-file | |
79fd74fa | 209 | "-configdir" #$(xorg-configuration-directory modules) |
be1c2c54 LC |
210 | "-nolisten" "tcp" "-terminate" |
211 | ||
212 | ;; Note: SLiM and other display managers add the | |
213 | ;; '-auth' flag by themselves. | |
214 | (cdr (command-line))))) | |
215 | ||
216 | (program-file "start-xorg" exp)) | |
db4fdc04 | 217 | |
9e4eddb4 | 218 | (define* (xinitrc #:key |
bdb36958 | 219 | (guile (canonical-package guile-2.0)) |
24d56899 SB |
220 | fallback-session) |
221 | "Return a system-wide xinitrc script that starts the specified X session, | |
222 | which should be passed to this script as the first argument. If not, the | |
223 | @var{fallback-session} will be used." | |
8779d342 LC |
224 | (define builder |
225 | #~(begin | |
226 | (use-modules (ice-9 match)) | |
227 | ||
16c33bfb LC |
228 | (define (close-all-fdes) |
229 | ;; Close all the open file descriptors except 0 to 2. | |
230 | (let loop ((fd 3)) | |
231 | (when (< fd 4096) ;FIXME: use sysconf + _SC_OPEN_MAX | |
232 | (false-if-exception (close-fdes fd)) | |
233 | (loop (+ 1 fd))))) | |
234 | ||
b2bd7c25 LC |
235 | (define (exec-from-login-shell command . args) |
236 | ;; Run COMMAND from a login shell so that it gets to see the same | |
237 | ;; environment variables that one gets when logging in on a tty, for | |
238 | ;; instance. | |
239 | (let* ((pw (getpw (getuid))) | |
e0b85670 SB |
240 | (shell (passwd:shell pw))) |
241 | ;; Close any open file descriptors. This is all the more | |
242 | ;; important that SLiM itself exec's us directly without closing | |
243 | ;; its own file descriptors! | |
244 | (close-all-fdes) | |
245 | ||
246 | ;; The '--login' option is supported at least by Bash and zsh. | |
247 | (execl shell shell "--login" "-c" | |
248 | (string-join (cons command args))))) | |
249 | ||
250 | (let* ((home (getenv "HOME")) | |
251 | (xsession-file (string-append home "/.xsession")) | |
252 | (session (match (command-line) | |
c510cbb4 LC |
253 | ((_) (list #$fallback-session)) |
254 | ((_ x ..1) x)))) | |
e0b85670 SB |
255 | (if (file-exists? xsession-file) |
256 | ;; Run ~/.xsession when it exists. | |
f2ab9250 | 257 | (apply exec-from-login-shell xsession-file session) |
e0b85670 | 258 | ;; Otherwise, start the specified session. |
c510cbb4 LC |
259 | (apply exec-from-login-shell session))))) |
260 | ||
be1c2c54 | 261 | (program-file "xinitrc" builder)) |
9e4eddb4 | 262 | |
0ecc3bf3 LC |
263 | \f |
264 | ;;; | |
265 | ;;; SLiM log-in manager. | |
266 | ;;; | |
267 | ||
0ecc3bf3 LC |
268 | (define %default-slim-theme |
269 | ;; Theme based on work by Felipe López. | |
270 | #~(string-append #$%artwork-repository "/slim")) | |
271 | ||
272 | (define %default-slim-theme-name | |
273 | ;; This must be the name of the sub-directory in %DEFAULT-SLIM-THEME that | |
274 | ;; contains the actual theme files. | |
cf2abac8 | 275 | "0.x") |
0ecc3bf3 | 276 | |
0adfe95a LC |
277 | (define-record-type* <slim-configuration> |
278 | slim-configuration make-slim-configuration | |
279 | slim-configuration? | |
280 | (slim slim-configuration-slim | |
281 | (default slim)) | |
282 | (allow-empty-passwords? slim-configuration-allow-empty-passwords?) | |
283 | (auto-login? slim-configuration-auto-login?) | |
284 | (default-user slim-configuration-default-user) | |
285 | (theme slim-configuration-theme) | |
286 | (theme-name slim-configuration-theme-name) | |
287 | (xauth slim-configuration-xauth | |
288 | (default xauth)) | |
26b94866 AK |
289 | (shepherd slim-configuration-shepherd |
290 | (default shepherd)) | |
0adfe95a LC |
291 | (bash slim-configuration-bash |
292 | (default bash)) | |
293 | (auto-login-session slim-configuration-auto-login-session) | |
294 | (startx slim-configuration-startx)) | |
295 | ||
296 | (define (slim-pam-service config) | |
297 | "Return a PAM service for @command{slim}." | |
298 | (list (unix-pam-service | |
299 | "slim" | |
300 | #:allow-empty-passwords? | |
301 | (slim-configuration-allow-empty-passwords? config)))) | |
302 | ||
d4053c71 | 303 | (define (slim-shepherd-service config) |
0adfe95a LC |
304 | (define slim.cfg |
305 | (let ((xinitrc (xinitrc #:fallback-session | |
306 | (slim-configuration-auto-login-session config))) | |
307 | (slim (slim-configuration-slim config)) | |
308 | (xauth (slim-configuration-xauth config)) | |
309 | (startx (slim-configuration-startx config)) | |
26b94866 | 310 | (shepherd (slim-configuration-shepherd config)) |
0adfe95a LC |
311 | (theme-name (slim-configuration-theme-name config))) |
312 | (mixed-text-file "slim.cfg" " | |
313 | default_path /run/current-system/profile/bin | |
314 | default_xserver " startx " | |
315 | xserver_arguments :0 vt7 | |
316 | xauth_path " xauth "/bin/xauth | |
317 | authfile /var/run/slim.auth | |
318 | ||
319 | # The login command. '%session' is replaced by the chosen session name, one | |
320 | # of the names specified in the 'sessions' setting: 'wmaker', 'xfce', etc. | |
321 | login_cmd exec " xinitrc " %session | |
322 | sessiondir /run/current-system/profile/share/xsessions | |
323 | session_msg session (F1 to change): | |
324 | ||
26b94866 AK |
325 | halt_cmd " shepherd "/sbin/halt |
326 | reboot_cmd " shepherd "/sbin/reboot\n" | |
0adfe95a LC |
327 | (if (slim-configuration-auto-login? config) |
328 | (string-append "auto_login yes\ndefault_user " | |
329 | (slim-configuration-default-user config) "\n") | |
330 | "") | |
331 | (if theme-name | |
332 | (string-append "current_theme " theme-name "\n") | |
333 | "")))) | |
334 | ||
335 | (define theme | |
336 | (slim-configuration-theme config)) | |
337 | ||
d4053c71 | 338 | (list (shepherd-service |
0adfe95a LC |
339 | (documentation "Xorg display server") |
340 | (provision '(xorg-server)) | |
341 | (requirement '(user-processes host-name udev)) | |
342 | (start | |
343 | #~(lambda () | |
344 | ;; A stale lock file can prevent SLiM from starting, so remove it to | |
345 | ;; be on the safe side. | |
346 | (false-if-exception (delete-file "/var/run/slim.lock")) | |
347 | ||
348 | (fork+exec-command | |
349 | (list (string-append #$slim "/bin/slim") "-nodaemon") | |
350 | #:environment-variables | |
351 | (list (string-append "SLIM_CFGFILE=" #$slim.cfg) | |
352 | #$@(if theme | |
353 | (list #~(string-append "SLIM_THEMESDIR=" #$theme)) | |
354 | #~()))))) | |
355 | (stop #~(make-kill-destructor)) | |
356 | (respawn? #t)))) | |
357 | ||
358 | (define slim-service-type | |
359 | (service-type (name 'slim) | |
360 | (extensions | |
d4053c71 AK |
361 | (list (service-extension shepherd-root-service-type |
362 | slim-shepherd-service) | |
0adfe95a | 363 | (service-extension pam-root-service-type |
e9b82124 LC |
364 | slim-pam-service) |
365 | ||
366 | ;; Unconditionally add xterm to the system profile, to | |
367 | ;; avoid bad surprises. | |
368 | (service-extension profile-service-type | |
369 | (const (list xterm))))))) | |
0adfe95a | 370 | |
db4fdc04 LC |
371 | (define* (slim-service #:key (slim slim) |
372 | (allow-empty-passwords? #t) auto-login? | |
373 | (default-user "") | |
0ecc3bf3 LC |
374 | (theme %default-slim-theme) |
375 | (theme-name %default-slim-theme-name) | |
26b94866 | 376 | (xauth xauth) (shepherd shepherd) (bash bash) |
24d56899 SB |
377 | (auto-login-session #~(string-append #$windowmaker |
378 | "/bin/wmaker")) | |
be1c2c54 | 379 | (startx (xorg-start-command))) |
db4fdc04 | 380 | "Return a service that spawns the SLiM graphical login manager, which in |
51da7ca0 LC |
381 | turn starts the X display server with @var{startx}, a command as returned by |
382 | @code{xorg-start-command}. | |
db4fdc04 | 383 | |
04e4e6ab LC |
384 | @cindex X session |
385 | ||
386 | SLiM automatically looks for session types described by the @file{.desktop} | |
387 | files in @file{/run/current-system/profile/share/xsessions} and allows users | |
388 | to choose a session from the log-in screen using @kbd{F1}. Packages such as | |
389 | @var{xfce}, @var{sawfish}, and @var{ratpoison} provide @file{.desktop} files; | |
390 | adding them to the system-wide set of packages automatically makes them | |
391 | available at the log-in screen. | |
392 | ||
393 | In addition, @file{~/.xsession} files are honored. When available, | |
394 | @file{~/.xsession} must be an executable that starts a window manager | |
395 | and/or other X clients. | |
396 | ||
51da7ca0 LC |
397 | When @var{allow-empty-passwords?} is true, allow logins with an empty |
398 | password. When @var{auto-login?} is true, log in automatically as | |
24d56899 | 399 | @var{default-user} with @var{auto-login-session}. |
0ecc3bf3 LC |
400 | |
401 | If @var{theme} is @code{#f}, the use the default log-in theme; otherwise | |
402 | @var{theme} must be a gexp denoting the name of a directory containing the | |
403 | theme to use. In that case, @var{theme-name} specifies the name of the | |
4bd43bbe | 404 | theme." |
0adfe95a LC |
405 | (service slim-service-type |
406 | (slim-configuration | |
407 | (slim slim) | |
408 | (allow-empty-passwords? allow-empty-passwords?) | |
409 | (auto-login? auto-login?) (default-user default-user) | |
410 | (theme theme) (theme-name theme-name) | |
26b94866 | 411 | (xauth xauth) (shepherd shepherd) (bash bash) |
0adfe95a LC |
412 | (auto-login-session auto-login-session) |
413 | (startx startx)))) | |
db4fdc04 | 414 | |
6726282b LC |
415 | \f |
416 | ;;; | |
417 | ;;; Screen lockers & co. | |
418 | ;;; | |
419 | ||
420 | (define-record-type <screen-locker> | |
421 | (screen-locker name program empty?) | |
422 | screen-locker? | |
423 | (name screen-locker-name) ;string | |
424 | (program screen-locker-program) ;gexp | |
425 | (empty? screen-locker-allows-empty-passwords?)) ;Boolean | |
426 | ||
427 | (define screen-locker-pam-services | |
428 | (match-lambda | |
429 | (($ <screen-locker> name _ empty?) | |
430 | (list (unix-pam-service name | |
431 | #:allow-empty-passwords? empty?))))) | |
432 | ||
433 | (define screen-locker-setuid-programs | |
434 | (compose list screen-locker-program)) | |
435 | ||
436 | (define screen-locker-service-type | |
437 | (service-type (name 'screen-locker) | |
438 | (extensions | |
439 | (list (service-extension pam-root-service-type | |
440 | screen-locker-pam-services) | |
441 | (service-extension setuid-program-service-type | |
442 | screen-locker-setuid-programs))))) | |
443 | ||
444 | (define* (screen-locker-service package | |
445 | #:optional | |
446 | (program (package-name package)) | |
447 | #:key allow-empty-passwords?) | |
448 | "Add @var{package}, a package for a screen-locker or screen-saver whose | |
449 | command is @var{program}, to the set of setuid programs and add a PAM entry | |
450 | for it. For example: | |
451 | ||
452 | @lisp | |
453 | (screen-locker-service xlockmore \"xlock\") | |
454 | @end lisp | |
455 | ||
456 | makes the good ol' XlockMore usable." | |
457 | (service screen-locker-service-type | |
458 | (screen-locker program | |
459 | #~(string-append #$package | |
460 | #$(string-append "/bin/" program)) | |
461 | allow-empty-passwords?))) | |
462 | ||
db4fdc04 | 463 | ;;; xorg.scm ends here |