gnu: deutex: Update to 5.1.2.
[jackhill/guix/guix.git] / gnu / services / xorg.scm
CommitLineData
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
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
126all the common drivers.
f703413e 127
d344f5a5
LC
128@var{modules} must be a list of @dfn{module packages} loaded by the Xorg
129server---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
134graphics driver automatically, or a list of driver names that will be tried in
d2e59637
LC
135this order---e.g., @code{(\"modesetting\" \"vesa\")}.
136
137Likewise, when @var{resolutions} is the empty list, Xorg chooses an
138appropriate screen resolution; otherwise, it must be a list of
12422c9d
LC
139resolutions---e.g., @code{((1024 768) (640 480))}.
140
141Last, @var{extra-config} is a list of strings or objects appended to the
d344f5a5 142configuration file. It is used to pass extra text to be
be1c2c54 143added 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
161Section \"Device\"
162 Identifier \"device-" driver "\"
163 Driver \"" driver "\"
164EndSection"))
db4fdc04 165
d344f5a5
LC
166 (define (screen-section driver resolutions)
167 (string-append "
d2e59637
LC
168Section \"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
179EndSection"))
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 211Section \"ServerFlags\"
e30442b5 212 Option \"AllowMouseOpenFail\" \"on\"
d344f5a5 213EndSection\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
234includes the @code{share/X11/xorg.conf.d} directories of each package listed
235in @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
265from @var{xorg-server}. @var{configuration-file} is the server configuration
266file 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
268in 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
293packages, 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
295used 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,
313which 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
315desktop 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" "
462default_path /run/current-system/profile/bin
463default_xserver " startx "
464xserver_arguments :0 vt7
465xauth_path " xauth "/bin/xauth
466authfile /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.
470login_cmd exec " xinitrc " %session
471sessiondir /run/current-system/profile/share/xsessions
472session_msg session (F1 to change):
736e45a2
DM
473sessionstart_cmd " sessreg "/bin/sessreg -a -l $DISPLAY %user
474sessionstop_cmd " sessreg "/bin/sessreg -d -l $DISPLAY %user
0adfe95a 475
26b94866
AK
476halt_cmd " shepherd "/sbin/halt
477reboot_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
532turn 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
537SLiM automatically looks for session types described by the @file{.desktop}
538files in @file{/run/current-system/profile/share/xsessions} and allows users
539to 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;
541adding them to the system-wide set of packages automatically makes them
542available at the log-in screen.
543
544In addition, @file{~/.xsession} files are honored. When available,
545@file{~/.xsession} must be an executable that starts a window manager
546and/or other X clients.
547
51da7ca0
LC
548When @var{allow-empty-passwords?} is true, allow logins with an empty
549password. When @var{auto-login?} is true, log in automatically as
24d56899 550@var{default-user} with @var{auto-login-session}.
0ecc3bf3
LC
551
552If @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
554theme to use. In that case, @var{theme-name} specifies the name of the
4bd43bbe 555theme."
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
600command is @var{program}, to the set of setuid programs and add a PAM entry
601for it. For example:
602
603@lisp
9e41130b 604 (screen-locker-service xlockmore \"xlock\")
6726282b
LC
605@end lisp
606
607makes 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
734starts the X display server with @var{X}, a command as returned by
735@code{xorg-wrapper}.
736
737@cindex X session
738
739GDM automatically looks for session types described by the @file{.desktop}
740files in @file{/run/current-system/profile/share/xsessions} and allows users
741to 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;
743adding them to the system-wide set of packages automatically makes them
744available at the log-in screen.
745
746In addition, @file{~/.xsession} files are honored. When available,
747@file{~/.xsession} must be an executable that starts a window manager
748and/or other X clients.
749
750When @var{allow-empty-passwords?} is true, allow logins with an empty
751password."
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