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