1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2017 Andy Wingo <wingo@igalia.com>
3 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
4 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
5 ;;; Copyright © 2018 Timothy Sample <samplet@ngyro.com>
7 ;;; This file is part of GNU Guix.
9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
10 ;;; under the terms of the GNU General Public License as published by
11 ;;; the Free Software Foundation; either version 3 of the License, or (at
12 ;;; your option) any later version.
14 ;;; GNU Guix is distributed in the hope that it will be useful, but
15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;;; GNU General Public License for more details.
19 ;;; You should have received a copy of the GNU General Public License
20 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
22 (define-module (gnu services xorg)
23 #:use-module (gnu artwork)
24 #:use-module (gnu services)
25 #:use-module (gnu services shepherd)
26 #:use-module (gnu system pam)
27 #:use-module (gnu services dbus)
28 #:use-module ((gnu packages base) #:select (canonical-package))
29 #:use-module (gnu packages guile)
30 #:use-module (gnu packages xorg)
31 #:use-module (gnu packages gl)
32 #:use-module (gnu packages display-managers)
33 #:use-module (gnu packages gnustep)
34 #:use-module (gnu packages gnome)
35 #:use-module (gnu packages admin)
36 #:use-module (gnu packages bash)
37 #:use-module (gnu system shadow)
38 #:use-module (guix gexp)
39 #:use-module (guix store)
40 #:use-module (guix packages)
41 #:use-module (guix derivations)
42 #:use-module (guix records)
43 #:use-module (guix deprecation)
44 #:use-module (srfi srfi-1)
45 #:use-module (srfi srfi-9)
46 #:use-module (srfi srfi-26)
47 #:use-module (ice-9 match)
48 #:export (xorg-configuration-file
56 %default-slim-theme-name
60 slim-configuration-slim
61 slim-configuration-allow-empty-passwords?
62 slim-configuration-auto-login?
63 slim-configuration-default-user
64 slim-configuration-theme
65 slim-configuration-theme-name
66 slim-configuration-xauth
67 slim-configuration-shepherd
68 slim-configuration-auto-login-session
69 slim-configuration-startx
76 screen-locker-service-type
85 ;;; Services that relate to the X Window System.
89 (define %default-xorg-modules
90 ;; Default list of modules loaded by the server. Note that the order
91 ;; matters since it determines which driver is going to be used when there's
103 ;; Libinput is the new thing and is recommended over evdev/synaptics:
104 ;; <http://who-t.blogspot.fr/2015/01/xf86-input-libinput-compatibility-with.html>.
110 xf86-input-synaptics))
112 (define %default-xorg-fonts
113 ;; Default list of fonts available to the X server.
114 (list (file-append font-alias "/share/fonts/X11/75dpi")
115 (file-append font-alias "/share/fonts/X11/100dpi")
116 (file-append font-alias "/share/fonts/X11/misc")
117 (file-append font-alias "/share/fonts/X11/cyrillic")
118 (file-append font-misc-misc ;default fonts for xterm
119 "/share/fonts/X11/misc")
120 (file-append font-adobe75dpi "/share/fonts/X11/75dpi")))
122 (define* (xorg-configuration-file #:key
123 (modules %default-xorg-modules)
124 (fonts %default-xorg-fonts)
125 (drivers '()) (resolutions '())
127 "Return a configuration file for the Xorg server containing search paths for
128 all the common drivers.
130 @var{modules} must be a list of @dfn{module packages} loaded by the Xorg
131 server---e.g., @code{xf86-video-vesa}, @code{xf86-input-keyboard}, and so on.
132 @var{fonts} must be a list of font directories to add to the server's
135 @var{drivers} must be either the empty list, in which case Xorg chooses a
136 graphics driver automatically, or a list of driver names that will be tried in
137 this order---e.g., @code{(\"modesetting\" \"vesa\")}.
139 Likewise, when @var{resolutions} is the empty list, Xorg chooses an
140 appropriate screen resolution; otherwise, it must be a list of
141 resolutions---e.g., @code{((1024 768) (640 480))}.
143 Last, @var{extra-config} is a list of strings or objects appended to the
144 configuration file. It is used to pass extra text to be
145 added verbatim to the configuration file."
147 ;; 'xorg-server' provides 'fbdevhw.so' etc.
148 (append modules (list xorg-server)))
152 (use-modules (ice-9 match)
156 (call-with-output-file #$output
161 (define (device-section driver)
164 Identifier \"device-" driver "\"
165 Driver \"" driver "\"
168 (define (screen-section driver resolutions)
171 Identifier \"screen-" driver "\"
172 Device \"device-" driver "\"
173 SubSection \"Display\"
175 (string-join (map (match-lambda
177 (string-append "\"" (number->string x)
178 "x" (number->string y) "\"")))
183 (define (expand modules)
184 ;; Append to MODULES the relevant /lib/xorg/modules
186 (append-map (lambda (module)
187 (filter-map (lambda (directory)
188 (let ((full (string-append module
190 (and (file-exists? full)
192 '("/lib/xorg/modules/drivers"
193 "/lib/xorg/modules/input"
194 "/lib/xorg/modules/multimedia"
195 "/lib/xorg/modules/extensions")))
198 (display "Section \"Files\"\n" port)
199 (for-each (lambda (font)
200 (format port " FontPath \"~a\"~%" font))
202 (for-each (lambda (module)
204 " ModulePath \"~a\"~%"
206 (append (expand '#$all-modules)
208 ;; For fbdevhw.so and so on.
209 (list #$(file-append xorg-server
210 "/lib/xorg/modules"))))
211 (display "EndSection\n" port)
213 Section \"ServerFlags\"
214 Option \"AllowMouseOpenFail\" \"on\"
217 (display (string-join (map device-section drivers) "\n")
220 (display (string-join
221 (map (cut screen-section <> '#$resolutions)
227 (for-each (lambda (config)
228 (display config port))
231 (computed-file "xserver.conf" build))
234 (define (xorg-configuration-directory modules)
235 "Return a directory that contains the @code{.conf} files for X.org that
236 includes the @code{share/X11/xorg.conf.d} directories of each package listed
238 (with-imported-modules '((guix build utils))
239 (computed-file "xorg.conf.d"
241 (use-modules (guix build utils)
245 (append-map (lambda (module)
246 (find-files (string-append
248 "/share/X11/xorg.conf.d")
253 (for-each (lambda (file)
255 (string-append #$output "/"
260 (define* (xorg-wrapper #:key
261 (guile (canonical-package guile-2.0))
262 (modules %default-xorg-modules)
263 (configuration-file (xorg-configuration-file
265 (xorg-server xorg-server))
266 "Return a derivation that builds a @var{guile} script to start the X server
267 from @var{xorg-server}. @var{configuration-file} is the server configuration
268 file or a derivation that builds it; when omitted, the result of
269 @code{xorg-configuration-file} is used. The resulting script should be used
270 in place of @code{/usr/bin/X}."
272 ;; Write a small wrapper around the X server.
274 (setenv "XORG_DRI_DRIVER_PATH" (string-append #$mesa "/lib/dri"))
275 (setenv "XKB_BINDIR" (string-append #$xkbcomp "/bin"))
277 (let ((X (string-append #$xorg-server "/bin/X")))
279 "-xkbdir" (string-append #$xkeyboard-config "/share/X11/xkb")
280 "-config" #$configuration-file
281 "-configdir" #$(xorg-configuration-directory modules)
282 (cdr (command-line))))))
284 (program-file "X-wrapper" exp))
286 (define* (xorg-start-command #:key
287 (guile (canonical-package guile-2.0))
288 (modules %default-xorg-modules)
289 (fonts %default-xorg-fonts)
291 (xorg-configuration-file #:modules modules
293 (xorg-server xorg-server))
294 "Return a @code{startx} script in which @var{modules}, a list of X module
295 packages, and @var{fonts}, a list of X font directories, are available. See
296 @code{xorg-wrapper} for more details on the arguments. The result should be
297 used in place of @code{startx}."
299 (xorg-wrapper #:guile guile
300 #:configuration-file configuration-file
302 #:xorg-server xorg-server))
304 ;; Write a small wrapper around the X server.
305 #~(apply execl #$X #$X ;; Second #$X is for argv[0].
306 "-logverbose" "-verbose" "-nolisten" "tcp" "-terminate"
307 (cdr (command-line))))
309 (program-file "startx" exp))
311 (define* (xinitrc #:key
312 (guile (canonical-package guile-2.0))
314 "Return a system-wide xinitrc script that starts the specified X session,
315 which should be passed to this script as the first argument. If not, the
316 @var{fallback-session} will be used or, if @var{fallback-session} is false, a
317 desktop session from the system or user profile will be used."
320 (use-modules (ice-9 match)
327 (define (close-all-fdes)
328 ;; Close all the open file descriptors except 0 to 2.
330 (when (< fd 4096) ;FIXME: use sysconf + _SC_OPEN_MAX
331 (false-if-exception (close-fdes fd))
334 (define (exec-from-login-shell command . args)
335 ;; Run COMMAND from a login shell so that it gets to see the same
336 ;; environment variables that one gets when logging in on a tty, for
338 (let* ((pw (getpw (getuid)))
339 (shell (passwd:shell pw)))
340 ;; Close any open file descriptors. This is all the more
341 ;; important that SLiM itself exec's us directly without closing
342 ;; its own file descriptors!
345 ;; The '--login' option is supported at least by Bash and zsh.
346 (execl shell shell "--login" "-c"
347 (string-join (cons command args)))))
349 (define system-profile
350 "/run/current-system/profile")
353 (and=> (getpw (getuid))
355 (string-append (passwd:dir pw) "/.guix-profile"))))
357 (define (xsession-command desktop-file)
358 ;; Read from DESKTOP-FILE its X session command and return it as a
361 (make-regexp "^[[:blank:]]*Exec=(.*)$"))
363 (call-with-input-file desktop-file
366 (match (read-line port)
368 ((= (cut regexp-exec exec-regexp <>) result)
370 (string-tokenize (match:substring result 1))
373 (define (find-session profile)
374 ;; Return an X session command from PROFILE or #f if none was found.
375 (let ((directory (string-append profile "/share/xsessions")))
376 (match (scandir directory
377 (cut string-suffix? ".desktop" <>))
381 (any xsession-command
382 (map (cut string-append directory "/" <>)
385 (let* ((home (getenv "HOME"))
386 (xsession-file (string-append home "/.xsession"))
387 (session (match (command-line)
389 #$(if fallback-session
390 #~(list #$fallback-session)
394 (if (file-exists? xsession-file)
395 ;; Run ~/.xsession when it exists.
396 (apply exec-from-login-shell xsession-file
398 ;; Otherwise, start the specified session or a fallback.
399 (apply exec-from-login-shell
401 (find-session user-profile)
402 (find-session system-profile)))))))
404 (program-file "xinitrc" builder))
408 ;;; SLiM log-in manager.
411 (define %default-slim-theme
412 ;; Theme based on work by Felipe López.
413 (file-append %artwork-repository "/slim"))
415 (define %default-slim-theme-name
416 ;; This must be the name of the sub-directory in %DEFAULT-SLIM-THEME that
417 ;; contains the actual theme files.
420 (define-record-type* <slim-configuration>
421 slim-configuration make-slim-configuration
423 (slim slim-configuration-slim
425 (allow-empty-passwords? slim-configuration-allow-empty-passwords?
427 (auto-login? slim-configuration-auto-login?
429 (default-user slim-configuration-default-user
431 (theme slim-configuration-theme
432 (default %default-slim-theme))
433 (theme-name slim-configuration-theme-name
434 (default %default-slim-theme-name))
435 (xauth slim-configuration-xauth
437 (shepherd slim-configuration-shepherd
439 (auto-login-session slim-configuration-auto-login-session
441 (startx slim-configuration-startx
442 (default (xorg-start-command)))
443 (sessreg slim-configuration-sessreg
446 (define (slim-pam-service config)
447 "Return a PAM service for @command{slim}."
448 (list (unix-pam-service
450 #:allow-empty-passwords?
451 (slim-configuration-allow-empty-passwords? config))))
453 (define (slim-shepherd-service config)
455 (let ((xinitrc (xinitrc #:fallback-session
456 (slim-configuration-auto-login-session config)))
457 (slim (slim-configuration-slim config))
458 (xauth (slim-configuration-xauth config))
459 (startx (slim-configuration-startx config))
460 (shepherd (slim-configuration-shepherd config))
461 (theme-name (slim-configuration-theme-name config))
462 (sessreg (slim-configuration-sessreg config)))
463 (mixed-text-file "slim.cfg" "
464 default_path /run/current-system/profile/bin
465 default_xserver " startx "
466 xserver_arguments :0 vt7
467 xauth_path " xauth "/bin/xauth
468 authfile /var/run/slim.auth
470 # The login command. '%session' is replaced by the chosen session name, one
471 # of the names specified in the 'sessions' setting: 'wmaker', 'xfce', etc.
472 login_cmd exec " xinitrc " %session
473 sessiondir /run/current-system/profile/share/xsessions
474 session_msg session (F1 to change):
475 sessionstart_cmd " sessreg "/bin/sessreg -a -l $DISPLAY %user
476 sessionstop_cmd " sessreg "/bin/sessreg -d -l $DISPLAY %user
478 halt_cmd " shepherd "/sbin/halt
479 reboot_cmd " shepherd "/sbin/reboot\n"
480 (if (slim-configuration-auto-login? config)
481 (string-append "auto_login yes\ndefault_user "
482 (slim-configuration-default-user config) "\n")
485 (string-append "current_theme " theme-name "\n")
489 (slim-configuration-theme config))
491 (list (shepherd-service
492 (documentation "Xorg display server")
493 (provision '(xorg-server))
494 (requirement '(user-processes host-name udev))
497 ;; A stale lock file can prevent SLiM from starting, so remove it to
498 ;; be on the safe side.
499 (false-if-exception (delete-file "/var/run/slim.lock"))
502 (list (string-append #$slim "/bin/slim") "-nodaemon")
503 #:environment-variables
504 (list (string-append "SLIM_CFGFILE=" #$slim.cfg)
506 (list #~(string-append "SLIM_THEMESDIR=" #$theme))
508 (stop #~(make-kill-destructor))
511 (define slim-service-type
512 (service-type (name 'slim)
514 (list (service-extension shepherd-root-service-type
515 slim-shepherd-service)
516 (service-extension pam-root-service-type
519 ;; Unconditionally add xterm to the system profile, to
520 ;; avoid bad surprises.
521 (service-extension profile-service-type
522 (const (list xterm)))))
523 (default-value (slim-configuration))))
525 (define-deprecated (slim-service #:key (slim slim)
526 (allow-empty-passwords? #t) auto-login?
528 (theme %default-slim-theme)
529 (theme-name %default-slim-theme-name)
530 (xauth xauth) (shepherd shepherd)
531 (auto-login-session #f)
532 (startx (xorg-start-command)))
534 "Return a service that spawns the SLiM graphical login manager, which in
535 turn starts the X display server with @var{startx}, a command as returned by
536 @code{xorg-start-command}.
540 SLiM automatically looks for session types described by the @file{.desktop}
541 files in @file{/run/current-system/profile/share/xsessions} and allows users
542 to choose a session from the log-in screen using @kbd{F1}. Packages such as
543 @var{xfce}, @var{sawfish}, and @var{ratpoison} provide @file{.desktop} files;
544 adding them to the system-wide set of packages automatically makes them
545 available at the log-in screen.
547 In addition, @file{~/.xsession} files are honored. When available,
548 @file{~/.xsession} must be an executable that starts a window manager
549 and/or other X clients.
551 When @var{allow-empty-passwords?} is true, allow logins with an empty
552 password. When @var{auto-login?} is true, log in automatically as
553 @var{default-user} with @var{auto-login-session}.
555 If @var{theme} is @code{#f}, the use the default log-in theme; otherwise
556 @var{theme} must be a gexp denoting the name of a directory containing the
557 theme to use. In that case, @var{theme-name} specifies the name of the
559 (service slim-service-type
562 (allow-empty-passwords? allow-empty-passwords?)
563 (auto-login? auto-login?) (default-user default-user)
564 (theme theme) (theme-name theme-name)
565 (xauth xauth) (shepherd shepherd)
566 (auto-login-session auto-login-session)
571 ;;; Screen lockers & co.
574 (define-record-type <screen-locker>
575 (screen-locker name program empty?)
577 (name screen-locker-name) ;string
578 (program screen-locker-program) ;gexp
579 (empty? screen-locker-allows-empty-passwords?)) ;Boolean
581 (define screen-locker-pam-services
583 (($ <screen-locker> name _ empty?)
584 (list (unix-pam-service name
585 #:allow-empty-passwords? empty?)))))
587 (define screen-locker-setuid-programs
588 (compose list screen-locker-program))
590 (define screen-locker-service-type
591 (service-type (name 'screen-locker)
593 (list (service-extension pam-root-service-type
594 screen-locker-pam-services)
595 (service-extension setuid-program-service-type
596 screen-locker-setuid-programs)))))
598 (define* (screen-locker-service package
600 (program (package-name package))
601 #:key allow-empty-passwords?)
602 "Add @var{package}, a package for a screen locker or screen saver whose
603 command is @var{program}, to the set of setuid programs and add a PAM entry
607 (screen-locker-service xlockmore \"xlock\")
610 makes the good ol' XlockMore usable."
611 (service screen-locker-service-type
612 (screen-locker program
613 (file-append package "/bin/" program)
614 allow-empty-passwords?)))
616 (define %gdm-accounts
617 (list (user-group (name "gdm") (system? #t))
622 (comment "GNOME Display Manager user")
623 (home-directory "/var/lib/gdm")
624 (shell (file-append shadow "/sbin/nologin")))))
626 (define-record-type* <gdm-configuration>
627 gdm-configuration make-gdm-configuration
629 (gdm gdm-configuration-gdm (default gdm))
630 (allow-empty-passwords? gdm-configuration-allow-empty-passwords? (default #t))
631 (auto-login? gdm-configuration-auto-login? (default #f))
632 (default-user gdm-configuration-default-user (default #f))
633 (x-server gdm-configuration-x-server
634 (default (xorg-wrapper))))
636 (define (gdm-etc-service config)
637 (define gdm-configuration-file
638 (mixed-text-file "gdm-custom.conf"
642 (if (gdm-configuration-auto-login? config)
644 "AutomaticLoginEnable=true\n"
646 (or (gdm-configuration-default-user config)
647 (error "missing default user for auto-login"))
650 "AutomaticLoginEnable=false\n"
651 "#AutomaticLogin=\n"))
652 "#TimedLoginEnable=false\n"
654 "#TimedLoginDelay=0\n"
655 "#InitialSetupEnable=true\n"
656 ;; Enable me once X is working.
657 "WaylandEnable=false\n"
663 "#DisallowTCP=true\n"
664 "#AllowRemoteAutoLogin=false\n"))
665 `(("gdm" ,(file-union
667 `(("custom.conf" ,gdm-configuration-file))))))
669 (define (gdm-pam-service config)
670 "Return a PAM service for @command{gdm}."
673 (inherit (unix-pam-service "gdm-autologin"))
674 (auth (list (pam-entry
675 (control "[success=ok default=1]")
676 (module (file-append (gdm-configuration-gdm config)
677 "/lib/security/pam_gdm.so")))
679 (control "sufficient")
680 (module "pam_permit.so")))))
682 (inherit (unix-pam-service "gdm-launch-environment"))
683 (auth (list (pam-entry
685 (module "pam_permit.so")))))
686 (unix-pam-service "gdm-password"
687 #:allow-empty-passwords?
688 (gdm-configuration-allow-empty-passwords? config))))
690 (define (gdm-shepherd-service config)
691 (list (shepherd-service
692 (documentation "Xorg display server (GDM)")
693 (provision '(xorg-server))
694 (requirement '(dbus-system user-processes host-name udev))
697 (list #$(file-append (gdm-configuration-gdm config)
699 #:environment-variables
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
708 "XDG_DATA_DIRS=/run/current-system/profile/share"
709 "PATH=/run/current-system/profile/bin"))))
710 (stop #~(make-kill-destructor))
713 (define gdm-service-type
714 (service-type (name 'gdm)
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
722 (service-extension etc-service-type
724 (service-extension dbus-root-service-type
726 gdm-configuration-gdm))))
727 (default-value (gdm-configuration))
729 "Run the GNOME Desktop Manager (GDM), a program that allows
730 you to log in in a graphical session, whether or not you use GNOME.")))
732 ;; This service isn't working yet; it gets as far as starting to run the
733 ;; greeter from gnome-shell but doesn't get any further. It is here because
734 ;; it doesn't hurt anyone and perhaps it inspires someone to fix it :)
735 (define-deprecated (gdm-service #:key (gdm gdm)
736 (allow-empty-passwords? #t)
737 (x-server (xorg-wrapper)))
739 "Return a service that spawns the GDM graphical login manager, which in turn
740 starts the X display server with @var{X}, a command as returned by
745 GDM automatically looks for session types described by the @file{.desktop}
746 files in @file{/run/current-system/profile/share/xsessions} and allows users
747 to choose a session from the log-in screen using @kbd{F1}. Packages such as
748 @var{xfce}, @var{sawfish}, and @var{ratpoison} provide @file{.desktop} files;
749 adding them to the system-wide set of packages automatically makes them
750 available at the log-in screen.
752 In addition, @file{~/.xsession} files are honored. When available,
753 @file{~/.xsession} must be an executable that starts a window manager
754 and/or other X clients.
756 When @var{allow-empty-passwords?} is true, allow logins with an empty
758 (service gdm-service-type
761 (allow-empty-passwords? allow-empty-passwords?)
762 (x-server x-server))))
764 ;;; xorg.scm ends here