Commit | Line | Data |
---|---|---|
db4fdc04 | 1 | ;;; GNU Guix --- Functional package management for GNU |
92753a8b | 2 | ;;; Copyright © 2017 Andy Wingo <wingo@igalia.com> |
01b3625d | 3 | ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org> |
4bd43bbe | 4 | ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> |
e57c2adb | 5 | ;;; Copyright © 2018, 2019 Timothy Sample <samplet@ngyro.com> |
24f11b06 | 6 | ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> |
bab7a495 | 7 | ;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de> |
db4fdc04 LC |
8 | ;;; |
9 | ;;; This file is part of GNU Guix. | |
10 | ;;; | |
11 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
12 | ;;; under the terms of the GNU General Public License as published by | |
13 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
14 | ;;; your option) any later version. | |
15 | ;;; | |
16 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
17 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;;; GNU General Public License for more details. | |
20 | ;;; | |
21 | ;;; You should have received a copy of the GNU General Public License | |
22 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
23 | ||
24 | (define-module (gnu services xorg) | |
84dfb458 | 25 | #:use-module (gnu artwork) |
db4fdc04 | 26 | #:use-module (gnu services) |
0190c1c0 | 27 | #:use-module (gnu services shepherd) |
6e828634 | 28 | #:use-module (gnu system pam) |
598757e0 | 29 | #:use-module (gnu system keyboard) |
607fcc75 | 30 | #:use-module (gnu services base) |
6e99c01b | 31 | #:use-module (gnu services dbus) |
bdb36958 LC |
32 | #:use-module ((gnu packages base) #:select (canonical-package)) |
33 | #:use-module (gnu packages guile) | |
db4fdc04 | 34 | #:use-module (gnu packages xorg) |
7e614198 | 35 | #:use-module (gnu packages fonts) |
db4fdc04 | 36 | #:use-module (gnu packages gl) |
1f564c15 | 37 | #:use-module (gnu packages glib) |
5fd66a37 | 38 | #:use-module (gnu packages display-managers) |
607fcc75 | 39 | #:use-module (gnu packages freedesktop) |
9e4eddb4 | 40 | #:use-module (gnu packages gnustep) |
6e99c01b | 41 | #:use-module (gnu packages gnome) |
db4fdc04 LC |
42 | #:use-module (gnu packages admin) |
43 | #:use-module (gnu packages bash) | |
6e99c01b | 44 | #:use-module (gnu system shadow) |
b5f4e686 | 45 | #:use-module (guix gexp) |
e87f0591 | 46 | #:use-module (guix store) |
6726282b | 47 | #:use-module (guix packages) |
db4fdc04 | 48 | #:use-module (guix derivations) |
ffc3a02b | 49 | #:use-module (guix records) |
65a67bf7 | 50 | #:use-module (guix deprecation) |
d2e59637 | 51 | #:use-module (srfi srfi-1) |
6726282b | 52 | #:use-module (srfi srfi-9) |
d2e59637 LC |
53 | #:use-module (srfi srfi-26) |
54 | #:use-module (ice-9 match) | |
b2e56451 LC |
55 | #:export (xorg-configuration |
56 | xorg-configuration? | |
57 | xorg-configuration-modules | |
58 | xorg-configuration-fonts | |
59 | xorg-configuration-drivers | |
60 | xorg-configuration-resolutions | |
61 | xorg-configuration-extra-config | |
62 | xorg-configuration-server | |
63 | xorg-configuration-server-arguments | |
64 | ||
79fd74fa | 65 | %default-xorg-modules |
d344f5a5 | 66 | %default-xorg-fonts |
92753a8b | 67 | xorg-wrapper |
d1cdd7ba | 68 | xorg-start-command |
f2901d82 DC |
69 | xinitrc |
70 | ||
0ecc3bf3 LC |
71 | %default-slim-theme |
72 | %default-slim-theme-name | |
b37f86d7 | 73 | |
4b7513e0 | 74 | slim-configuration |
b37f86d7 LC |
75 | slim-configuration? |
76 | slim-configuration-slim | |
77 | slim-configuration-allow-empty-passwords? | |
78 | slim-configuration-auto-login? | |
79 | slim-configuration-default-user | |
80 | slim-configuration-theme | |
81 | slim-configuration-theme-name | |
82 | slim-configuration-xauth | |
83 | slim-configuration-shepherd | |
84 | slim-configuration-auto-login-session | |
bab7a495 TG |
85 | slim-configuration-xorg |
86 | slim-configuration-sessreg | |
b37f86d7 | 87 | |
4b7513e0 | 88 | slim-service-type |
6726282b LC |
89 | slim-service |
90 | ||
24e96431 TČ |
91 | screen-locker |
92 | screen-locker? | |
6726282b | 93 | screen-locker-service-type |
6e99c01b AW |
94 | screen-locker-service |
95 | ||
607fcc75 LC |
96 | localed-configuration |
97 | localed-configuration? | |
98 | localed-service-type | |
99 | ||
6e99c01b AW |
100 | gdm-configuration |
101 | gdm-service-type | |
305a732a LC |
102 | gdm-service |
103 | set-xorg-configuration)) | |
db4fdc04 LC |
104 | |
105 | ;;; Commentary: | |
106 | ;;; | |
107 | ;;; Services that relate to the X Window System. | |
108 | ;;; | |
109 | ;;; Code: | |
110 | ||
d344f5a5 | 111 | (define %default-xorg-modules |
fd96f94f PN |
112 | ;; Default list of modules loaded by the server. When multiple drivers |
113 | ;; match, the first one in the list is loaded. | |
d344f5a5 LC |
114 | (list xf86-video-vesa |
115 | xf86-video-fbdev | |
fd96f94f | 116 | xf86-video-amdgpu |
d344f5a5 LC |
117 | xf86-video-ati |
118 | xf86-video-cirrus | |
119 | xf86-video-intel | |
120 | xf86-video-mach64 | |
121 | xf86-video-nouveau | |
122 | xf86-video-nv | |
123 | xf86-video-sis | |
124 | ||
125 | ;; Libinput is the new thing and is recommended over evdev/synaptics: | |
126 | ;; <http://who-t.blogspot.fr/2015/01/xf86-input-libinput-compatibility-with.html>. | |
127 | xf86-input-libinput | |
128 | ||
129 | xf86-input-evdev | |
130 | xf86-input-keyboard | |
131 | xf86-input-mouse | |
132 | xf86-input-synaptics)) | |
133 | ||
134 | (define %default-xorg-fonts | |
135 | ;; Default list of fonts available to the X server. | |
136 | (list (file-append font-alias "/share/fonts/X11/75dpi") | |
137 | (file-append font-alias "/share/fonts/X11/100dpi") | |
138 | (file-append font-alias "/share/fonts/X11/misc") | |
139 | (file-append font-alias "/share/fonts/X11/cyrillic") | |
4afc903a LC |
140 | (file-append font-misc-misc ;default fonts for xterm |
141 | "/share/fonts/X11/misc") | |
d344f5a5 LC |
142 | (file-append font-adobe75dpi "/share/fonts/X11/75dpi"))) |
143 | ||
b2e56451 LC |
144 | (define %default-xorg-server-arguments |
145 | ;; Default command-line arguments for X. | |
146 | '("-nolisten" "tcp")) | |
147 | ||
148 | ;; Configuration of an Xorg server. | |
149 | (define-record-type* <xorg-configuration> | |
150 | xorg-configuration make-xorg-configuration | |
151 | xorg-configuration? | |
152 | (modules xorg-configuration-modules ;list of packages | |
153 | (default %default-xorg-modules)) | |
154 | (fonts xorg-configuration-fonts ;list of packges | |
155 | (default %default-xorg-fonts)) | |
156 | (drivers xorg-configuration-drivers ;list of strings | |
157 | (default '())) | |
158 | (resolutions xorg-configuration-resolutions ;list of tuples | |
159 | (default '())) | |
598757e0 LC |
160 | (keyboard-layout xorg-configuration-keyboard-layout ;#f | <keyboard-layout> |
161 | (default #f)) | |
b2e56451 LC |
162 | (extra-config xorg-configuration-extra-config ;list of strings |
163 | (default '())) | |
164 | (server xorg-configuration-server ;package | |
165 | (default xorg-server)) | |
166 | (server-arguments xorg-configuration-server-arguments ;list of strings | |
167 | (default %default-xorg-server-arguments))) | |
168 | ||
169 | (define (xorg-configuration->file config) | |
170 | "Compute an Xorg configuration file corresponding to CONFIG, an | |
171 | <xorg-configuration> record." | |
d344f5a5 LC |
172 | (define all-modules |
173 | ;; 'xorg-server' provides 'fbdevhw.so' etc. | |
b2e56451 LC |
174 | (append (xorg-configuration-modules config) |
175 | (list xorg-server))) | |
d344f5a5 LC |
176 | |
177 | (define build | |
178 | #~(begin | |
179 | (use-modules (ice-9 match) | |
180 | (srfi srfi-1) | |
181 | (srfi srfi-26)) | |
182 | ||
183 | (call-with-output-file #$output | |
184 | (lambda (port) | |
185 | (define drivers | |
b2e56451 | 186 | '#$(xorg-configuration-drivers config)) |
d344f5a5 LC |
187 | |
188 | (define (device-section driver) | |
189 | (string-append " | |
f703413e LC |
190 | Section \"Device\" |
191 | Identifier \"device-" driver "\" | |
192 | Driver \"" driver "\" | |
193 | EndSection")) | |
db4fdc04 | 194 | |
d344f5a5 LC |
195 | (define (screen-section driver resolutions) |
196 | (string-append " | |
d2e59637 LC |
197 | Section \"Screen\" |
198 | Identifier \"screen-" driver "\" | |
199 | Device \"device-" driver "\" | |
200 | SubSection \"Display\" | |
201 | Modes " | |
202 | (string-join (map (match-lambda | |
d1cdd7ba LC |
203 | ((x y) |
204 | (string-append "\"" (number->string x) | |
205 | "x" (number->string y) "\""))) | |
d2e59637 LC |
206 | resolutions)) " |
207 | EndSubSection | |
208 | EndSection")) | |
209 | ||
598757e0 LC |
210 | (define (input-class-section layout variant model options) |
211 | (string-append " | |
212 | Section \"InputClass\" | |
213 | Identifier \"evdev keyboard catchall\" | |
214 | MatchIsKeyboard \"on\" | |
215 | Option \"XkbLayout\" " (object->string layout) | |
216 | (if variant | |
217 | (string-append " Option \"XkbVariant\" \"" | |
218 | variant "\"") | |
219 | "") | |
220 | (if model | |
221 | (string-append " Option \"XkbModel\" \"" | |
222 | model "\"") | |
223 | "") | |
224 | (match options | |
225 | (() | |
226 | "") | |
227 | (_ | |
228 | (string-append " Option \"XkbOptions\" \"" | |
229 | (string-join options ",") "\""))) " | |
230 | ||
231 | MatchDevicePath \"/dev/input/event*\" | |
232 | Driver \"evdev\" | |
233 | EndSection\n")) | |
234 | ||
d344f5a5 LC |
235 | (define (expand modules) |
236 | ;; Append to MODULES the relevant /lib/xorg/modules | |
237 | ;; sub-directories. | |
238 | (append-map (lambda (module) | |
239 | (filter-map (lambda (directory) | |
240 | (let ((full (string-append module | |
241 | directory))) | |
242 | (and (file-exists? full) | |
243 | full))) | |
244 | '("/lib/xorg/modules/drivers" | |
245 | "/lib/xorg/modules/input" | |
246 | "/lib/xorg/modules/multimedia" | |
247 | "/lib/xorg/modules/extensions"))) | |
248 | modules)) | |
db4fdc04 | 249 | |
d344f5a5 LC |
250 | (display "Section \"Files\"\n" port) |
251 | (for-each (lambda (font) | |
252 | (format port " FontPath \"~a\"~%" font)) | |
b2e56451 | 253 | '#$(xorg-configuration-fonts config)) |
d344f5a5 LC |
254 | (for-each (lambda (module) |
255 | (format port | |
256 | " ModulePath \"~a\"~%" | |
257 | module)) | |
258 | (append (expand '#$all-modules) | |
259 | ||
260 | ;; For fbdevhw.so and so on. | |
261 | (list #$(file-append xorg-server | |
262 | "/lib/xorg/modules")))) | |
263 | (display "EndSection\n" port) | |
264 | (display " | |
db4fdc04 | 265 | Section \"ServerFlags\" |
e30442b5 | 266 | Option \"AllowMouseOpenFail\" \"on\" |
d344f5a5 | 267 | EndSection\n" port) |
12422c9d | 268 | |
d344f5a5 LC |
269 | (display (string-join (map device-section drivers) "\n") |
270 | port) | |
271 | (newline port) | |
272 | (display (string-join | |
b2e56451 LC |
273 | (map (cut screen-section <> |
274 | '#$(xorg-configuration-resolutions config)) | |
d344f5a5 LC |
275 | drivers) |
276 | "\n") | |
277 | port) | |
278 | (newline port) | |
279 | ||
598757e0 LC |
280 | (let ((layout #$(and=> (xorg-configuration-keyboard-layout config) |
281 | keyboard-layout-name)) | |
282 | (variant #$(and=> (xorg-configuration-keyboard-layout config) | |
283 | keyboard-layout-variant)) | |
284 | (model #$(and=> (xorg-configuration-keyboard-layout config) | |
285 | keyboard-layout-model)) | |
70bb83b7 LC |
286 | (options '#$(and=> (xorg-configuration-keyboard-layout config) |
287 | keyboard-layout-options))) | |
598757e0 LC |
288 | (when layout |
289 | (display (input-class-section layout variant model options) | |
290 | port) | |
291 | (newline port))) | |
292 | ||
d344f5a5 LC |
293 | (for-each (lambda (config) |
294 | (display config port)) | |
b2e56451 | 295 | '#$(xorg-configuration-extra-config config)))))) |
d344f5a5 LC |
296 | |
297 | (computed-file "xserver.conf" build)) | |
db4fdc04 | 298 | |
79fd74fa AW |
299 | (define (xorg-configuration-directory modules) |
300 | "Return a directory that contains the @code{.conf} files for X.org that | |
301 | includes the @code{share/X11/xorg.conf.d} directories of each package listed | |
302 | in @var{modules}." | |
4ee96a79 LC |
303 | (with-imported-modules '((guix build utils)) |
304 | (computed-file "xorg.conf.d" | |
305 | #~(begin | |
306 | (use-modules (guix build utils) | |
307 | (srfi srfi-1)) | |
308 | ||
309 | (define files | |
310 | (append-map (lambda (module) | |
311 | (find-files (string-append | |
312 | module | |
313 | "/share/X11/xorg.conf.d") | |
314 | "\\.conf$")) | |
315 | (list #$@modules))) | |
316 | ||
317 | (mkdir #$output) | |
318 | (for-each (lambda (file) | |
319 | (symlink file | |
320 | (string-append #$output "/" | |
321 | (basename file)))) | |
322 | files) | |
323 | #t)))) | |
79fd74fa | 324 | |
b2e56451 LC |
325 | (define* (xorg-wrapper #:optional (config (xorg-configuration))) |
326 | "Return a derivation that builds a script to start the X server with the | |
327 | given @var{config}. The resulting script should be used in place of | |
328 | @code{/usr/bin/X}." | |
be1c2c54 LC |
329 | (define exp |
330 | ;; Write a small wrapper around the X server. | |
331 | #~(begin | |
332 | (setenv "XORG_DRI_DRIVER_PATH" (string-append #$mesa "/lib/dri")) | |
333 | (setenv "XKB_BINDIR" (string-append #$xkbcomp "/bin")) | |
334 | ||
b2e56451 | 335 | (let ((X (string-append #$(xorg-configuration-server config) "/bin/X"))) |
92753a8b AW |
336 | (apply execl X X |
337 | "-xkbdir" (string-append #$xkeyboard-config "/share/X11/xkb") | |
b2e56451 LC |
338 | "-config" #$(xorg-configuration->file config) |
339 | "-configdir" #$(xorg-configuration-directory | |
340 | (xorg-configuration-modules config)) | |
92753a8b AW |
341 | (cdr (command-line)))))) |
342 | ||
343 | (program-file "X-wrapper" exp)) | |
be1c2c54 | 344 | |
b2e56451 LC |
345 | (define* (xorg-start-command #:optional (config (xorg-configuration))) |
346 | "Return a @code{startx} script in which the modules, fonts, etc. specified | |
347 | in @var{config}, are available. The result should be used in place of | |
348 | @code{startx}." | |
92753a8b | 349 | (define X |
b2e56451 LC |
350 | (xorg-wrapper config)) |
351 | ||
92753a8b AW |
352 | (define exp |
353 | ;; Write a small wrapper around the X server. | |
354 | #~(apply execl #$X #$X ;; Second #$X is for argv[0]. | |
b2e56451 LC |
355 | "-logverbose" "-verbose" "-terminate" |
356 | #$@(xorg-configuration-server-arguments config) | |
24f11b06 | 357 | (cdr (command-line)))) |
be1c2c54 | 358 | |
92753a8b | 359 | (program-file "startx" exp)) |
db4fdc04 | 360 | |
956607e3 | 361 | (define* (xinitrc #:key fallback-session) |
24d56899 SB |
362 | "Return a system-wide xinitrc script that starts the specified X session, |
363 | which should be passed to this script as the first argument. If not, the | |
65c0f436 LC |
364 | @var{fallback-session} will be used or, if @var{fallback-session} is false, a |
365 | desktop session from the system or user profile will be used." | |
8779d342 LC |
366 | (define builder |
367 | #~(begin | |
65c0f436 LC |
368 | (use-modules (ice-9 match) |
369 | (ice-9 regex) | |
370 | (ice-9 ftw) | |
4e1efba4 | 371 | (ice-9 rdelim) |
65c0f436 LC |
372 | (srfi srfi-1) |
373 | (srfi srfi-26)) | |
8779d342 | 374 | |
16c33bfb LC |
375 | (define (close-all-fdes) |
376 | ;; Close all the open file descriptors except 0 to 2. | |
377 | (let loop ((fd 3)) | |
378 | (when (< fd 4096) ;FIXME: use sysconf + _SC_OPEN_MAX | |
379 | (false-if-exception (close-fdes fd)) | |
380 | (loop (+ 1 fd))))) | |
381 | ||
b2bd7c25 LC |
382 | (define (exec-from-login-shell command . args) |
383 | ;; Run COMMAND from a login shell so that it gets to see the same | |
384 | ;; environment variables that one gets when logging in on a tty, for | |
385 | ;; instance. | |
386 | (let* ((pw (getpw (getuid))) | |
e0b85670 SB |
387 | (shell (passwd:shell pw))) |
388 | ;; Close any open file descriptors. This is all the more | |
389 | ;; important that SLiM itself exec's us directly without closing | |
390 | ;; its own file descriptors! | |
391 | (close-all-fdes) | |
392 | ||
393 | ;; The '--login' option is supported at least by Bash and zsh. | |
394 | (execl shell shell "--login" "-c" | |
395 | (string-join (cons command args))))) | |
396 | ||
65c0f436 LC |
397 | (define system-profile |
398 | "/run/current-system/profile") | |
399 | ||
400 | (define user-profile | |
401 | (and=> (getpw (getuid)) | |
402 | (lambda (pw) | |
403 | (string-append (passwd:dir pw) "/.guix-profile")))) | |
404 | ||
405 | (define (xsession-command desktop-file) | |
406 | ;; Read from DESKTOP-FILE its X session command and return it as a | |
407 | ;; list. | |
408 | (define exec-regexp | |
409 | (make-regexp "^[[:blank:]]*Exec=(.*)$")) | |
410 | ||
411 | (call-with-input-file desktop-file | |
412 | (lambda (port) | |
413 | (let loop () | |
414 | (match (read-line port) | |
415 | ((? eof-object?) #f) | |
416 | ((= (cut regexp-exec exec-regexp <>) result) | |
417 | (if result | |
418 | (string-tokenize (match:substring result 1)) | |
419 | (loop)))))))) | |
420 | ||
421 | (define (find-session profile) | |
422 | ;; Return an X session command from PROFILE or #f if none was found. | |
423 | (let ((directory (string-append profile "/share/xsessions"))) | |
424 | (match (scandir directory | |
425 | (cut string-suffix? ".desktop" <>)) | |
426 | ((or () #f) | |
427 | #f) | |
428 | ((sessions ...) | |
429 | (any xsession-command | |
430 | (map (cut string-append directory "/" <>) | |
431 | sessions)))))) | |
432 | ||
e0b85670 SB |
433 | (let* ((home (getenv "HOME")) |
434 | (xsession-file (string-append home "/.xsession")) | |
435 | (session (match (command-line) | |
65c0f436 LC |
436 | ((_) |
437 | #$(if fallback-session | |
438 | #~(list #$fallback-session) | |
439 | #f)) | |
440 | ((_ x ..1) | |
441 | x)))) | |
e0b85670 SB |
442 | (if (file-exists? xsession-file) |
443 | ;; Run ~/.xsession when it exists. | |
617e87bf LC |
444 | (apply exec-from-login-shell xsession-file |
445 | (or session '())) | |
65c0f436 LC |
446 | ;; Otherwise, start the specified session or a fallback. |
447 | (apply exec-from-login-shell | |
448 | (or session | |
449 | (find-session user-profile) | |
450 | (find-session system-profile))))))) | |
c510cbb4 | 451 | |
be1c2c54 | 452 | (program-file "xinitrc" builder)) |
9e4eddb4 | 453 | |
0ecc3bf3 LC |
454 | \f |
455 | ;;; | |
456 | ;;; SLiM log-in manager. | |
457 | ;;; | |
458 | ||
0ecc3bf3 LC |
459 | (define %default-slim-theme |
460 | ;; Theme based on work by Felipe López. | |
9e41130b | 461 | (file-append %artwork-repository "/slim")) |
0ecc3bf3 LC |
462 | |
463 | (define %default-slim-theme-name | |
464 | ;; This must be the name of the sub-directory in %DEFAULT-SLIM-THEME that | |
465 | ;; contains the actual theme files. | |
cf2abac8 | 466 | "0.x") |
0ecc3bf3 | 467 | |
0adfe95a LC |
468 | (define-record-type* <slim-configuration> |
469 | slim-configuration make-slim-configuration | |
470 | slim-configuration? | |
471 | (slim slim-configuration-slim | |
472 | (default slim)) | |
b37f86d7 LC |
473 | (allow-empty-passwords? slim-configuration-allow-empty-passwords? |
474 | (default #t)) | |
475 | (auto-login? slim-configuration-auto-login? | |
476 | (default #f)) | |
477 | (default-user slim-configuration-default-user | |
478 | (default "")) | |
479 | (theme slim-configuration-theme | |
480 | (default %default-slim-theme)) | |
481 | (theme-name slim-configuration-theme-name | |
482 | (default %default-slim-theme-name)) | |
0adfe95a LC |
483 | (xauth slim-configuration-xauth |
484 | (default xauth)) | |
26b94866 AK |
485 | (shepherd slim-configuration-shepherd |
486 | (default shepherd)) | |
b37f86d7 | 487 | (auto-login-session slim-configuration-auto-login-session |
65c0f436 | 488 | (default #f)) |
554b8607 LC |
489 | (xorg-configuration slim-configuration-xorg |
490 | (default (xorg-configuration))) | |
736e45a2 DM |
491 | (sessreg slim-configuration-sessreg |
492 | (default sessreg))) | |
0adfe95a LC |
493 | |
494 | (define (slim-pam-service config) | |
495 | "Return a PAM service for @command{slim}." | |
496 | (list (unix-pam-service | |
497 | "slim" | |
498 | #:allow-empty-passwords? | |
499 | (slim-configuration-allow-empty-passwords? config)))) | |
500 | ||
d4053c71 | 501 | (define (slim-shepherd-service config) |
0adfe95a LC |
502 | (define slim.cfg |
503 | (let ((xinitrc (xinitrc #:fallback-session | |
504 | (slim-configuration-auto-login-session config))) | |
505 | (slim (slim-configuration-slim config)) | |
506 | (xauth (slim-configuration-xauth config)) | |
554b8607 | 507 | (startx (xorg-start-command (slim-configuration-xorg config))) |
26b94866 | 508 | (shepherd (slim-configuration-shepherd config)) |
736e45a2 DM |
509 | (theme-name (slim-configuration-theme-name config)) |
510 | (sessreg (slim-configuration-sessreg config))) | |
0adfe95a LC |
511 | (mixed-text-file "slim.cfg" " |
512 | default_path /run/current-system/profile/bin | |
513 | default_xserver " startx " | |
514 | xserver_arguments :0 vt7 | |
515 | xauth_path " xauth "/bin/xauth | |
516 | authfile /var/run/slim.auth | |
517 | ||
518 | # The login command. '%session' is replaced by the chosen session name, one | |
519 | # of the names specified in the 'sessions' setting: 'wmaker', 'xfce', etc. | |
520 | login_cmd exec " xinitrc " %session | |
521 | sessiondir /run/current-system/profile/share/xsessions | |
522 | session_msg session (F1 to change): | |
736e45a2 DM |
523 | sessionstart_cmd " sessreg "/bin/sessreg -a -l $DISPLAY %user |
524 | sessionstop_cmd " sessreg "/bin/sessreg -d -l $DISPLAY %user | |
0adfe95a | 525 | |
26b94866 AK |
526 | halt_cmd " shepherd "/sbin/halt |
527 | reboot_cmd " shepherd "/sbin/reboot\n" | |
0adfe95a LC |
528 | (if (slim-configuration-auto-login? config) |
529 | (string-append "auto_login yes\ndefault_user " | |
530 | (slim-configuration-default-user config) "\n") | |
531 | "") | |
532 | (if theme-name | |
533 | (string-append "current_theme " theme-name "\n") | |
534 | "")))) | |
535 | ||
536 | (define theme | |
537 | (slim-configuration-theme config)) | |
538 | ||
d4053c71 | 539 | (list (shepherd-service |
0adfe95a LC |
540 | (documentation "Xorg display server") |
541 | (provision '(xorg-server)) | |
542 | (requirement '(user-processes host-name udev)) | |
543 | (start | |
544 | #~(lambda () | |
545 | ;; A stale lock file can prevent SLiM from starting, so remove it to | |
546 | ;; be on the safe side. | |
547 | (false-if-exception (delete-file "/var/run/slim.lock")) | |
548 | ||
549 | (fork+exec-command | |
550 | (list (string-append #$slim "/bin/slim") "-nodaemon") | |
551 | #:environment-variables | |
552 | (list (string-append "SLIM_CFGFILE=" #$slim.cfg) | |
553 | #$@(if theme | |
554 | (list #~(string-append "SLIM_THEMESDIR=" #$theme)) | |
555 | #~()))))) | |
556 | (stop #~(make-kill-destructor)) | |
557 | (respawn? #t)))) | |
558 | ||
559 | (define slim-service-type | |
560 | (service-type (name 'slim) | |
561 | (extensions | |
d4053c71 AK |
562 | (list (service-extension shepherd-root-service-type |
563 | slim-shepherd-service) | |
0adfe95a | 564 | (service-extension pam-root-service-type |
e9b82124 LC |
565 | slim-pam-service) |
566 | ||
567 | ;; Unconditionally add xterm to the system profile, to | |
568 | ;; avoid bad surprises. | |
569 | (service-extension profile-service-type | |
b37f86d7 LC |
570 | (const (list xterm))))) |
571 | (default-value (slim-configuration)))) | |
0adfe95a | 572 | |
65a67bf7 LC |
573 | (define-deprecated (slim-service #:key (slim slim) |
574 | (allow-empty-passwords? #t) auto-login? | |
575 | (default-user "") | |
576 | (theme %default-slim-theme) | |
577 | (theme-name %default-slim-theme-name) | |
578 | (xauth xauth) (shepherd shepherd) | |
579 | (auto-login-session #f) | |
580 | (startx (xorg-start-command))) | |
581 | slim-service-type | |
db4fdc04 | 582 | "Return a service that spawns the SLiM graphical login manager, which in |
51da7ca0 LC |
583 | turn starts the X display server with @var{startx}, a command as returned by |
584 | @code{xorg-start-command}. | |
db4fdc04 | 585 | |
04e4e6ab LC |
586 | @cindex X session |
587 | ||
588 | SLiM automatically looks for session types described by the @file{.desktop} | |
589 | files in @file{/run/current-system/profile/share/xsessions} and allows users | |
590 | to choose a session from the log-in screen using @kbd{F1}. Packages such as | |
591 | @var{xfce}, @var{sawfish}, and @var{ratpoison} provide @file{.desktop} files; | |
592 | adding them to the system-wide set of packages automatically makes them | |
593 | available at the log-in screen. | |
594 | ||
595 | In addition, @file{~/.xsession} files are honored. When available, | |
596 | @file{~/.xsession} must be an executable that starts a window manager | |
597 | and/or other X clients. | |
598 | ||
51da7ca0 LC |
599 | When @var{allow-empty-passwords?} is true, allow logins with an empty |
600 | password. When @var{auto-login?} is true, log in automatically as | |
24d56899 | 601 | @var{default-user} with @var{auto-login-session}. |
0ecc3bf3 LC |
602 | |
603 | If @var{theme} is @code{#f}, the use the default log-in theme; otherwise | |
604 | @var{theme} must be a gexp denoting the name of a directory containing the | |
605 | theme to use. In that case, @var{theme-name} specifies the name of the | |
4bd43bbe | 606 | theme." |
0adfe95a LC |
607 | (service slim-service-type |
608 | (slim-configuration | |
609 | (slim slim) | |
610 | (allow-empty-passwords? allow-empty-passwords?) | |
611 | (auto-login? auto-login?) (default-user default-user) | |
612 | (theme theme) (theme-name theme-name) | |
94b9abd9 | 613 | (xauth xauth) (shepherd shepherd) |
554b8607 | 614 | (auto-login-session auto-login-session)))) |
db4fdc04 | 615 | |
6726282b LC |
616 | \f |
617 | ;;; | |
618 | ;;; Screen lockers & co. | |
619 | ;;; | |
620 | ||
621 | (define-record-type <screen-locker> | |
622 | (screen-locker name program empty?) | |
623 | screen-locker? | |
624 | (name screen-locker-name) ;string | |
625 | (program screen-locker-program) ;gexp | |
626 | (empty? screen-locker-allows-empty-passwords?)) ;Boolean | |
627 | ||
628 | (define screen-locker-pam-services | |
629 | (match-lambda | |
630 | (($ <screen-locker> name _ empty?) | |
631 | (list (unix-pam-service name | |
632 | #:allow-empty-passwords? empty?))))) | |
633 | ||
634 | (define screen-locker-setuid-programs | |
635 | (compose list screen-locker-program)) | |
636 | ||
637 | (define screen-locker-service-type | |
638 | (service-type (name 'screen-locker) | |
639 | (extensions | |
640 | (list (service-extension pam-root-service-type | |
641 | screen-locker-pam-services) | |
642 | (service-extension setuid-program-service-type | |
643 | screen-locker-setuid-programs))))) | |
644 | ||
645 | (define* (screen-locker-service package | |
646 | #:optional | |
647 | (program (package-name package)) | |
648 | #:key allow-empty-passwords?) | |
d64e1746 | 649 | "Add @var{package}, a package for a screen locker or screen saver whose |
6726282b LC |
650 | command is @var{program}, to the set of setuid programs and add a PAM entry |
651 | for it. For example: | |
652 | ||
653 | @lisp | |
9e41130b | 654 | (screen-locker-service xlockmore \"xlock\") |
6726282b LC |
655 | @end lisp |
656 | ||
657 | makes the good ol' XlockMore usable." | |
658 | (service screen-locker-service-type | |
659 | (screen-locker program | |
9e41130b | 660 | (file-append package "/bin/" program) |
6726282b LC |
661 | allow-empty-passwords?))) |
662 | ||
607fcc75 LC |
663 | \f |
664 | ;;; | |
665 | ;;; Locale service. | |
666 | ;;; | |
667 | ||
668 | (define-record-type* <localed-configuration> | |
669 | localed-configuration make-localed-configuration | |
670 | localed-configuration? | |
671 | (localed localed-configuration-localed | |
672 | (default localed)) | |
673 | (keyboard-layout localed-configuration-keyboard-layout | |
674 | (default #f))) | |
675 | ||
676 | (define (localed-dbus-service config) | |
677 | "Return the 'localed' D-Bus service for @var{config}, a | |
678 | @code{<localed-configuration>} record." | |
679 | (define keyboard-layout | |
680 | (localed-configuration-keyboard-layout config)) | |
681 | ||
682 | ;; The primary purpose of 'localed' is to tell GDM what the "current" Xorg | |
683 | ;; keyboard layout is. If 'localed' is missing, or if it's unable to | |
684 | ;; determine the current XKB layout, then GDM forcefully installs its | |
685 | ;; default XKB config (US English). Here we communicate the configured | |
686 | ;; layout through environment variables. | |
687 | ||
688 | (if keyboard-layout | |
689 | (let* ((layout (keyboard-layout-name keyboard-layout)) | |
690 | (variant (keyboard-layout-variant keyboard-layout)) | |
691 | (model (keyboard-layout-model keyboard-layout)) | |
692 | (options (keyboard-layout-options keyboard-layout))) | |
693 | (list (wrapped-dbus-service | |
694 | (localed-configuration-localed config) | |
695 | "libexec/localed/localed" | |
696 | `(("GUIX_XKB_LAYOUT" ,layout) | |
697 | ,@(if variant | |
698 | `(("GUIX_XKB_VARIANT" ,variant)) | |
699 | '()) | |
700 | ,@(if model | |
701 | `(("GUIX_XKB_MODEL" ,model)) | |
702 | '()) | |
703 | ,@(if (null? options) | |
704 | '() | |
705 | `(("GUIX_XKB_OPTIONS" | |
706 | ,(string-join options ",")))))))) | |
707 | (localed-configuration-localed config))) | |
708 | ||
709 | (define localed-service-type | |
710 | (let ((package (compose list localed-configuration-localed))) | |
711 | (service-type (name 'localed) | |
712 | (extensions | |
713 | (list (service-extension dbus-root-service-type | |
714 | localed-dbus-service) | |
715 | (service-extension udev-service-type package) | |
716 | (service-extension polkit-service-type package) | |
717 | ||
718 | ;; Add 'localectl' to the profile. | |
719 | (service-extension profile-service-type package))) | |
720 | ||
721 | ;; This service can be extended, typically by the X login | |
722 | ;; manager, to communicate the chosen Xorg keyboard layout. | |
723 | (compose first) | |
724 | (extend (lambda (config keyboard-layout) | |
725 | (localed-configuration | |
726 | (inherit config) | |
727 | (keyboard-layout keyboard-layout)))) | |
728 | (description | |
729 | "Run the locale daemon, @command{localed}, which can be used | |
730 | to control the system locale and keyboard mapping from user programs such as | |
731 | the GNOME desktop environment.") | |
732 | (default-value (localed-configuration))))) | |
733 | ||
734 | \f | |
735 | ;;; | |
736 | ;;; GNOME Desktop Manager. | |
737 | ;;; | |
738 | ||
6e99c01b AW |
739 | (define %gdm-accounts |
740 | (list (user-group (name "gdm") (system? #t)) | |
741 | (user-account | |
742 | (name "gdm") | |
743 | (group "gdm") | |
744 | (system? #t) | |
745 | (comment "GNOME Display Manager user") | |
746 | (home-directory "/var/lib/gdm") | |
747 | (shell (file-append shadow "/sbin/nologin"))))) | |
748 | ||
1f564c15 TS |
749 | (define dbus-daemon-wrapper |
750 | (program-file "gdm-dbus-wrapper" | |
751 | #~(begin | |
752 | (setenv "XDG_CONFIG_DIRS" | |
753 | "/run/current-system/profile/etc/xdg") | |
754 | (setenv "XDG_DATA_DIRS" | |
755 | "/run/current-system/profile/share") | |
756 | (apply execl (string-append #$dbus "/bin/dbus-daemon") | |
757 | (program-arguments))))) | |
758 | ||
6e99c01b AW |
759 | (define-record-type* <gdm-configuration> |
760 | gdm-configuration make-gdm-configuration | |
761 | gdm-configuration? | |
762 | (gdm gdm-configuration-gdm (default gdm)) | |
763 | (allow-empty-passwords? gdm-configuration-allow-empty-passwords? (default #t)) | |
6e99c01b | 764 | (auto-login? gdm-configuration-auto-login? (default #f)) |
1f564c15 | 765 | (dbus-daemon gdm-configuration-dbus-daemon (default dbus-daemon-wrapper)) |
6e99c01b | 766 | (default-user gdm-configuration-default-user (default #f)) |
7e614198 TS |
767 | (gnome-shell-assets gdm-configuration-gnome-shell-assets |
768 | (default (list adwaita-icon-theme font-cantarell))) | |
554b8607 LC |
769 | (xorg-configuration gdm-configuration-xorg |
770 | (default (xorg-configuration))) | |
41fa9f18 TS |
771 | (x-session gdm-configuration-x-session |
772 | (default (xinitrc)))) | |
6e99c01b | 773 | |
e57c2adb TS |
774 | (define (gdm-configuration-file config) |
775 | (mixed-text-file "gdm-custom.conf" | |
776 | "[daemon]\n" | |
777 | "#User=gdm\n" | |
778 | "#Group=gdm\n" | |
779 | (if (gdm-configuration-auto-login? config) | |
780 | (string-append | |
781 | "AutomaticLoginEnable=true\n" | |
782 | "AutomaticLogin=" | |
783 | (or (gdm-configuration-default-user config) | |
784 | (error "missing default user for auto-login")) | |
785 | "\n") | |
786 | (string-append | |
787 | "AutomaticLoginEnable=false\n" | |
788 | "#AutomaticLogin=\n")) | |
789 | "#TimedLoginEnable=false\n" | |
790 | "#TimedLogin=\n" | |
791 | "#TimedLoginDelay=0\n" | |
792 | "#InitialSetupEnable=true\n" | |
793 | ;; Enable me once X is working. | |
794 | "WaylandEnable=false\n" | |
795 | "\n" | |
796 | "[debug]\n" | |
797 | "#Enable=true\n" | |
798 | "\n" | |
799 | "[security]\n" | |
800 | "#DisallowTCP=true\n" | |
801 | "#AllowRemoteAutoLogin=false\n")) | |
6e99c01b AW |
802 | |
803 | (define (gdm-pam-service config) | |
804 | "Return a PAM service for @command{gdm}." | |
805 | (list | |
806 | (pam-service | |
807 | (inherit (unix-pam-service "gdm-autologin")) | |
808 | (auth (list (pam-entry | |
809 | (control "[success=ok default=1]") | |
810 | (module (file-append (gdm-configuration-gdm config) | |
811 | "/lib/security/pam_gdm.so"))) | |
812 | (pam-entry | |
813 | (control "sufficient") | |
814 | (module "pam_permit.so"))))) | |
815 | (pam-service | |
816 | (inherit (unix-pam-service "gdm-launch-environment")) | |
817 | (auth (list (pam-entry | |
818 | (control "required") | |
819 | (module "pam_permit.so"))))) | |
de409e82 TS |
820 | (unix-pam-service "gdm-password" |
821 | #:allow-empty-passwords? | |
822 | (gdm-configuration-allow-empty-passwords? config)))) | |
6e99c01b AW |
823 | |
824 | (define (gdm-shepherd-service config) | |
825 | (list (shepherd-service | |
826 | (documentation "Xorg display server (GDM)") | |
827 | (provision '(xorg-server)) | |
828 | (requirement '(dbus-system user-processes host-name udev)) | |
6e99c01b AW |
829 | (start #~(lambda () |
830 | (fork+exec-command | |
831 | (list #$(file-append (gdm-configuration-gdm config) | |
832 | "/bin/gdm")) | |
833 | #:environment-variables | |
834 | (list (string-append | |
e57c2adb TS |
835 | "GDM_CUSTOM_CONF=" |
836 | #$(gdm-configuration-file config)) | |
1f564c15 TS |
837 | (string-append |
838 | "GDM_DBUS_DAEMON=" | |
839 | #$(gdm-configuration-dbus-daemon config)) | |
e57c2adb | 840 | (string-append |
6e99c01b | 841 | "GDM_X_SERVER=" |
554b8607 LC |
842 | #$(xorg-wrapper |
843 | (gdm-configuration-xorg config))) | |
41fa9f18 TS |
844 | (string-append |
845 | "GDM_X_SESSION=" | |
846 | #$(gdm-configuration-x-session config)) | |
7e614198 TS |
847 | (string-append |
848 | "XDG_DATA_DIRS=" | |
849 | ((lambda (ls) (string-join ls ":")) | |
850 | (map (lambda (path) | |
851 | (string-append path "/share")) | |
852 | ;; XXX: Remove gnome-shell below when GDM | |
853 | ;; can depend on GNOME Shell directly. | |
854 | (cons #$gnome-shell | |
855 | '#$(gdm-configuration-gnome-shell-assets | |
856 | config))))))))) | |
6e99c01b AW |
857 | (stop #~(make-kill-destructor)) |
858 | (respawn? #t)))) | |
859 | ||
860 | (define gdm-service-type | |
861 | (service-type (name 'gdm) | |
862 | (extensions | |
863 | (list (service-extension shepherd-root-service-type | |
864 | gdm-shepherd-service) | |
865 | (service-extension account-service-type | |
866 | (const %gdm-accounts)) | |
867 | (service-extension pam-root-service-type | |
868 | gdm-pam-service) | |
7e614198 TS |
869 | (service-extension profile-service-type |
870 | gdm-configuration-gnome-shell-assets) | |
6e99c01b | 871 | (service-extension dbus-root-service-type |
01b3625d | 872 | (compose list |
607fcc75 LC |
873 | gdm-configuration-gdm)) |
874 | (service-extension localed-service-type | |
875 | (compose | |
876 | xorg-configuration-keyboard-layout | |
877 | gdm-configuration-xorg)))) | |
878 | ||
305a732a LC |
879 | ;; For convenience, this service can be extended with an |
880 | ;; <xorg-configuration> record. Take the first one that | |
881 | ;; comes. | |
0cf981a6 LC |
882 | (compose (lambda (extensions) |
883 | (match extensions | |
884 | (() #f) | |
885 | ((config . _) config)))) | |
305a732a | 886 | (extend (lambda (config xorg-configuration) |
0cf981a6 LC |
887 | (if xorg-configuration |
888 | (gdm-configuration | |
889 | (inherit config) | |
890 | (xorg-configuration xorg-configuration)) | |
891 | config))) | |
305a732a | 892 | |
01b3625d LC |
893 | (default-value (gdm-configuration)) |
894 | (description | |
895 | "Run the GNOME Desktop Manager (GDM), a program that allows | |
896 | you to log in in a graphical session, whether or not you use GNOME."))) | |
6e99c01b | 897 | |
65a67bf7 LC |
898 | (define-deprecated (gdm-service #:key (gdm gdm) |
899 | (allow-empty-passwords? #t) | |
900 | (x-server (xorg-wrapper))) | |
901 | gdm-service-type | |
6e99c01b AW |
902 | "Return a service that spawns the GDM graphical login manager, which in turn |
903 | starts the X display server with @var{X}, a command as returned by | |
904 | @code{xorg-wrapper}. | |
905 | ||
906 | @cindex X session | |
907 | ||
908 | GDM automatically looks for session types described by the @file{.desktop} | |
909 | files in @file{/run/current-system/profile/share/xsessions} and allows users | |
910 | to choose a session from the log-in screen using @kbd{F1}. Packages such as | |
911 | @var{xfce}, @var{sawfish}, and @var{ratpoison} provide @file{.desktop} files; | |
912 | adding them to the system-wide set of packages automatically makes them | |
913 | available at the log-in screen. | |
914 | ||
915 | In addition, @file{~/.xsession} files are honored. When available, | |
916 | @file{~/.xsession} must be an executable that starts a window manager | |
917 | and/or other X clients. | |
918 | ||
919 | When @var{allow-empty-passwords?} is true, allow logins with an empty | |
920 | password." | |
921 | (service gdm-service-type | |
922 | (gdm-configuration | |
923 | (gdm gdm) | |
554b8607 | 924 | (allow-empty-passwords? allow-empty-passwords?)))) |
6e99c01b | 925 | |
305a732a LC |
926 | (define* (set-xorg-configuration config |
927 | #:optional | |
928 | (login-manager-service-type | |
929 | gdm-service-type)) | |
930 | "Tell the log-in manager (of type @var{login-manager-service-type}) to use | |
931 | @var{config}, an <xorg-configuration> record." | |
932 | (simple-service 'set-xorg-configuration | |
933 | login-manager-service-type | |
934 | config)) | |
935 | ||
db4fdc04 | 936 | ;;; xorg.scm ends here |