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 (srfi srfi-1)
44 #:use-module (srfi srfi-9)
45 #:use-module (srfi srfi-26)
46 #:use-module (ice-9 match)
47 #:export (xorg-configuration-file
55 %default-slim-theme-name
59 slim-configuration-slim
60 slim-configuration-allow-empty-passwords?
61 slim-configuration-auto-login?
62 slim-configuration-default-user
63 slim-configuration-theme
64 slim-configuration-theme-name
65 slim-configuration-xauth
66 slim-configuration-shepherd
67 slim-configuration-auto-login-session
68 slim-configuration-startx
75 screen-locker-service-type
84 ;;; Services that relate to the X Window System.
88 (define %default-xorg-modules
89 ;; Default list of modules loaded by the server. Note that the order
90 ;; matters since it determines which driver is going to be used when there's
102 ;; Libinput is the new thing and is recommended over evdev/synaptics:
103 ;; <http://who-t.blogspot.fr/2015/01/xf86-input-libinput-compatibility-with.html>.
109 xf86-input-synaptics))
111 (define %default-xorg-fonts
112 ;; Default list of fonts available to the X server.
113 (list (file-append font-alias "/share/fonts/X11/75dpi")
114 (file-append font-alias "/share/fonts/X11/100dpi")
115 (file-append font-alias "/share/fonts/X11/misc")
116 (file-append font-alias "/share/fonts/X11/cyrillic")
117 (file-append font-misc-misc ;default fonts for xterm
118 "/share/fonts/X11/misc")
119 (file-append font-adobe75dpi "/share/fonts/X11/75dpi")))
121 (define* (xorg-configuration-file #:key
122 (modules %default-xorg-modules)
123 (fonts %default-xorg-fonts)
124 (drivers '()) (resolutions '())
126 "Return a configuration file for the Xorg server containing search paths for
127 all the common drivers.
129 @var{modules} must be a list of @dfn{module packages} loaded by the Xorg
130 server---e.g., @code{xf86-video-vesa}, @code{xf86-input-keyboard}, and so on.
131 @var{fonts} must be a list of font directories to add to the server's
134 @var{drivers} must be either the empty list, in which case Xorg chooses a
135 graphics driver automatically, or a list of driver names that will be tried in
136 this order---e.g., @code{(\"modesetting\" \"vesa\")}.
138 Likewise, when @var{resolutions} is the empty list, Xorg chooses an
139 appropriate screen resolution; otherwise, it must be a list of
140 resolutions---e.g., @code{((1024 768) (640 480))}.
142 Last, @var{extra-config} is a list of strings or objects appended to the
143 configuration file. It is used to pass extra text to be
144 added verbatim to the configuration file."
146 ;; 'xorg-server' provides 'fbdevhw.so' etc.
147 (append modules (list xorg-server)))
151 (use-modules (ice-9 match)
155 (call-with-output-file #$output
160 (define (device-section driver)
163 Identifier \"device-" driver "\"
164 Driver \"" driver "\"
167 (define (screen-section driver resolutions)
170 Identifier \"screen-" driver "\"
171 Device \"device-" driver "\"
172 SubSection \"Display\"
174 (string-join (map (match-lambda
176 (string-append "\"" (number->string x)
177 "x" (number->string y) "\"")))
182 (define (expand modules)
183 ;; Append to MODULES the relevant /lib/xorg/modules
185 (append-map (lambda (module)
186 (filter-map (lambda (directory)
187 (let ((full (string-append module
189 (and (file-exists? full)
191 '("/lib/xorg/modules/drivers"
192 "/lib/xorg/modules/input"
193 "/lib/xorg/modules/multimedia"
194 "/lib/xorg/modules/extensions")))
197 (display "Section \"Files\"\n" port)
198 (for-each (lambda (font)
199 (format port " FontPath \"~a\"~%" font))
201 (for-each (lambda (module)
203 " ModulePath \"~a\"~%"
205 (append (expand '#$all-modules)
207 ;; For fbdevhw.so and so on.
208 (list #$(file-append xorg-server
209 "/lib/xorg/modules"))))
210 (display "EndSection\n" port)
212 Section \"ServerFlags\"
213 Option \"AllowMouseOpenFail\" \"on\"
216 (display (string-join (map device-section drivers) "\n")
219 (display (string-join
220 (map (cut screen-section <> '#$resolutions)
226 (for-each (lambda (config)
227 (display config port))
230 (computed-file "xserver.conf" build))
233 (define (xorg-configuration-directory modules)
234 "Return a directory that contains the @code{.conf} files for X.org that
235 includes the @code{share/X11/xorg.conf.d} directories of each package listed
237 (with-imported-modules '((guix build utils))
238 (computed-file "xorg.conf.d"
240 (use-modules (guix build utils)
244 (append-map (lambda (module)
245 (find-files (string-append
247 "/share/X11/xorg.conf.d")
252 (for-each (lambda (file)
254 (string-append #$output "/"
259 (define* (xorg-wrapper #:key
260 (guile (canonical-package guile-2.0))
261 (modules %default-xorg-modules)
262 (configuration-file (xorg-configuration-file
264 (xorg-server xorg-server))
265 "Return a derivation that builds a @var{guile} script to start the X server
266 from @var{xorg-server}. @var{configuration-file} is the server configuration
267 file or a derivation that builds it; when omitted, the result of
268 @code{xorg-configuration-file} is used. The resulting script should be used
269 in place of @code{/usr/bin/X}."
271 ;; Write a small wrapper around the X server.
273 (setenv "XORG_DRI_DRIVER_PATH" (string-append #$mesa "/lib/dri"))
274 (setenv "XKB_BINDIR" (string-append #$xkbcomp "/bin"))
276 (let ((X (string-append #$xorg-server "/bin/X")))
278 "-xkbdir" (string-append #$xkeyboard-config "/share/X11/xkb")
279 "-config" #$configuration-file
280 "-configdir" #$(xorg-configuration-directory modules)
281 (cdr (command-line))))))
283 (program-file "X-wrapper" exp))
285 (define* (xorg-start-command #:key
286 (guile (canonical-package guile-2.0))
287 (modules %default-xorg-modules)
288 (fonts %default-xorg-fonts)
290 (xorg-configuration-file #:modules modules
292 (xorg-server xorg-server))
293 "Return a @code{startx} script in which @var{modules}, a list of X module
294 packages, and @var{fonts}, a list of X font directories, are available. See
295 @code{xorg-wrapper} for more details on the arguments. The result should be
296 used in place of @code{startx}."
298 (xorg-wrapper #:guile guile
299 #:configuration-file configuration-file
301 #:xorg-server xorg-server))
303 ;; Write a small wrapper around the X server.
304 #~(apply execl #$X #$X ;; Second #$X is for argv[0].
305 "-logverbose" "-verbose" "-nolisten" "tcp" "-terminate"
306 (cdr (command-line))))
308 (program-file "startx" exp))
310 (define* (xinitrc #:key
311 (guile (canonical-package guile-2.0))
313 "Return a system-wide xinitrc script that starts the specified X session,
314 which should be passed to this script as the first argument. If not, the
315 @var{fallback-session} will be used or, if @var{fallback-session} is false, a
316 desktop session from the system or user profile will be used."
319 (use-modules (ice-9 match)
326 (define (close-all-fdes)
327 ;; Close all the open file descriptors except 0 to 2.
329 (when (< fd 4096) ;FIXME: use sysconf + _SC_OPEN_MAX
330 (false-if-exception (close-fdes fd))
333 (define (exec-from-login-shell command . args)
334 ;; Run COMMAND from a login shell so that it gets to see the same
335 ;; environment variables that one gets when logging in on a tty, for
337 (let* ((pw (getpw (getuid)))
338 (shell (passwd:shell pw)))
339 ;; Close any open file descriptors. This is all the more
340 ;; important that SLiM itself exec's us directly without closing
341 ;; its own file descriptors!
344 ;; The '--login' option is supported at least by Bash and zsh.
345 (execl shell shell "--login" "-c"
346 (string-join (cons command args)))))
348 (define system-profile
349 "/run/current-system/profile")
352 (and=> (getpw (getuid))
354 (string-append (passwd:dir pw) "/.guix-profile"))))
356 (define (xsession-command desktop-file)
357 ;; Read from DESKTOP-FILE its X session command and return it as a
360 (make-regexp "^[[:blank:]]*Exec=(.*)$"))
362 (call-with-input-file desktop-file
365 (match (read-line port)
367 ((= (cut regexp-exec exec-regexp <>) result)
369 (string-tokenize (match:substring result 1))
372 (define (find-session profile)
373 ;; Return an X session command from PROFILE or #f if none was found.
374 (let ((directory (string-append profile "/share/xsessions")))
375 (match (scandir directory
376 (cut string-suffix? ".desktop" <>))
380 (any xsession-command
381 (map (cut string-append directory "/" <>)
384 (let* ((home (getenv "HOME"))
385 (xsession-file (string-append home "/.xsession"))
386 (session (match (command-line)
388 #$(if fallback-session
389 #~(list #$fallback-session)
393 (if (file-exists? xsession-file)
394 ;; Run ~/.xsession when it exists.
395 (apply exec-from-login-shell xsession-file
397 ;; Otherwise, start the specified session or a fallback.
398 (apply exec-from-login-shell
400 (find-session user-profile)
401 (find-session system-profile)))))))
403 (program-file "xinitrc" builder))
407 ;;; SLiM log-in manager.
410 (define %default-slim-theme
411 ;; Theme based on work by Felipe López.
412 (file-append %artwork-repository "/slim"))
414 (define %default-slim-theme-name
415 ;; This must be the name of the sub-directory in %DEFAULT-SLIM-THEME that
416 ;; contains the actual theme files.
419 (define-record-type* <slim-configuration>
420 slim-configuration make-slim-configuration
422 (slim slim-configuration-slim
424 (allow-empty-passwords? slim-configuration-allow-empty-passwords?
426 (auto-login? slim-configuration-auto-login?
428 (default-user slim-configuration-default-user
430 (theme slim-configuration-theme
431 (default %default-slim-theme))
432 (theme-name slim-configuration-theme-name
433 (default %default-slim-theme-name))
434 (xauth slim-configuration-xauth
436 (shepherd slim-configuration-shepherd
438 (auto-login-session slim-configuration-auto-login-session
440 (startx slim-configuration-startx
441 (default (xorg-start-command)))
442 (sessreg slim-configuration-sessreg
445 (define (slim-pam-service config)
446 "Return a PAM service for @command{slim}."
447 (list (unix-pam-service
449 #:allow-empty-passwords?
450 (slim-configuration-allow-empty-passwords? config))))
452 (define (slim-shepherd-service config)
454 (let ((xinitrc (xinitrc #:fallback-session
455 (slim-configuration-auto-login-session config)))
456 (slim (slim-configuration-slim config))
457 (xauth (slim-configuration-xauth config))
458 (startx (slim-configuration-startx config))
459 (shepherd (slim-configuration-shepherd config))
460 (theme-name (slim-configuration-theme-name config))
461 (sessreg (slim-configuration-sessreg config)))
462 (mixed-text-file "slim.cfg" "
463 default_path /run/current-system/profile/bin
464 default_xserver " startx "
465 xserver_arguments :0 vt7
466 xauth_path " xauth "/bin/xauth
467 authfile /var/run/slim.auth
469 # The login command. '%session' is replaced by the chosen session name, one
470 # of the names specified in the 'sessions' setting: 'wmaker', 'xfce', etc.
471 login_cmd exec " xinitrc " %session
472 sessiondir /run/current-system/profile/share/xsessions
473 session_msg session (F1 to change):
474 sessionstart_cmd " sessreg "/bin/sessreg -a -l $DISPLAY %user
475 sessionstop_cmd " sessreg "/bin/sessreg -d -l $DISPLAY %user
477 halt_cmd " shepherd "/sbin/halt
478 reboot_cmd " shepherd "/sbin/reboot\n"
479 (if (slim-configuration-auto-login? config)
480 (string-append "auto_login yes\ndefault_user "
481 (slim-configuration-default-user config) "\n")
484 (string-append "current_theme " theme-name "\n")
488 (slim-configuration-theme config))
490 (list (shepherd-service
491 (documentation "Xorg display server")
492 (provision '(xorg-server))
493 (requirement '(user-processes host-name udev))
496 ;; A stale lock file can prevent SLiM from starting, so remove it to
497 ;; be on the safe side.
498 (false-if-exception (delete-file "/var/run/slim.lock"))
501 (list (string-append #$slim "/bin/slim") "-nodaemon")
502 #:environment-variables
503 (list (string-append "SLIM_CFGFILE=" #$slim.cfg)
505 (list #~(string-append "SLIM_THEMESDIR=" #$theme))
507 (stop #~(make-kill-destructor))
510 (define slim-service-type
511 (service-type (name 'slim)
513 (list (service-extension shepherd-root-service-type
514 slim-shepherd-service)
515 (service-extension pam-root-service-type
518 ;; Unconditionally add xterm to the system profile, to
519 ;; avoid bad surprises.
520 (service-extension profile-service-type
521 (const (list xterm)))))
522 (default-value (slim-configuration))))
524 (define* (slim-service #:key (slim slim) ;deprecated
525 (allow-empty-passwords? #t) auto-login?
527 (theme %default-slim-theme)
528 (theme-name %default-slim-theme-name)
529 (xauth xauth) (shepherd shepherd)
530 (auto-login-session #f)
531 (startx (xorg-start-command)))
532 "Return a service that spawns the SLiM graphical login manager, which in
533 turn starts the X display server with @var{startx}, a command as returned by
534 @code{xorg-start-command}.
538 SLiM automatically looks for session types described by the @file{.desktop}
539 files in @file{/run/current-system/profile/share/xsessions} and allows users
540 to choose a session from the log-in screen using @kbd{F1}. Packages such as
541 @var{xfce}, @var{sawfish}, and @var{ratpoison} provide @file{.desktop} files;
542 adding them to the system-wide set of packages automatically makes them
543 available at the log-in screen.
545 In addition, @file{~/.xsession} files are honored. When available,
546 @file{~/.xsession} must be an executable that starts a window manager
547 and/or other X clients.
549 When @var{allow-empty-passwords?} is true, allow logins with an empty
550 password. When @var{auto-login?} is true, log in automatically as
551 @var{default-user} with @var{auto-login-session}.
553 If @var{theme} is @code{#f}, the use the default log-in theme; otherwise
554 @var{theme} must be a gexp denoting the name of a directory containing the
555 theme to use. In that case, @var{theme-name} specifies the name of the
557 (service slim-service-type
560 (allow-empty-passwords? allow-empty-passwords?)
561 (auto-login? auto-login?) (default-user default-user)
562 (theme theme) (theme-name theme-name)
563 (xauth xauth) (shepherd shepherd)
564 (auto-login-session auto-login-session)
569 ;;; Screen lockers & co.
572 (define-record-type <screen-locker>
573 (screen-locker name program empty?)
575 (name screen-locker-name) ;string
576 (program screen-locker-program) ;gexp
577 (empty? screen-locker-allows-empty-passwords?)) ;Boolean
579 (define screen-locker-pam-services
581 (($ <screen-locker> name _ empty?)
582 (list (unix-pam-service name
583 #:allow-empty-passwords? empty?)))))
585 (define screen-locker-setuid-programs
586 (compose list screen-locker-program))
588 (define screen-locker-service-type
589 (service-type (name 'screen-locker)
591 (list (service-extension pam-root-service-type
592 screen-locker-pam-services)
593 (service-extension setuid-program-service-type
594 screen-locker-setuid-programs)))))
596 (define* (screen-locker-service package
598 (program (package-name package))
599 #:key allow-empty-passwords?)
600 "Add @var{package}, a package for a screen locker or screen saver whose
601 command is @var{program}, to the set of setuid programs and add a PAM entry
605 (screen-locker-service xlockmore \"xlock\")
608 makes the good ol' XlockMore usable."
609 (service screen-locker-service-type
610 (screen-locker program
611 (file-append package "/bin/" program)
612 allow-empty-passwords?)))
614 (define %gdm-accounts
615 (list (user-group (name "gdm") (system? #t))
620 (comment "GNOME Display Manager user")
621 (home-directory "/var/lib/gdm")
622 (shell (file-append shadow "/sbin/nologin")))))
624 (define-record-type* <gdm-configuration>
625 gdm-configuration make-gdm-configuration
627 (gdm gdm-configuration-gdm (default gdm))
628 (allow-empty-passwords? gdm-configuration-allow-empty-passwords? (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 (default (xorg-wrapper))))
634 (define (gdm-etc-service config)
635 (define gdm-configuration-file
636 (mixed-text-file "gdm-custom.conf"
640 (if (gdm-configuration-auto-login? config)
642 "AutomaticLoginEnable=true\n"
644 (or (gdm-configuration-default-user config)
645 (error "missing default user for auto-login"))
648 "AutomaticLoginEnable=false\n"
649 "#AutomaticLogin=\n"))
650 "#TimedLoginEnable=false\n"
652 "#TimedLoginDelay=0\n"
653 "#InitialSetupEnable=true\n"
654 ;; Enable me once X is working.
655 "WaylandEnable=false\n"
661 "#DisallowTCP=true\n"
662 "#AllowRemoteAutoLogin=false\n"))
663 `(("gdm" ,(file-union
665 `(("custom.conf" ,gdm-configuration-file))))))
667 (define (gdm-pam-service config)
668 "Return a PAM service for @command{gdm}."
671 (inherit (unix-pam-service "gdm-autologin"))
672 (auth (list (pam-entry
673 (control "[success=ok default=1]")
674 (module (file-append (gdm-configuration-gdm config)
675 "/lib/security/pam_gdm.so")))
677 (control "sufficient")
678 (module "pam_permit.so")))))
680 (inherit (unix-pam-service "gdm-launch-environment"))
681 (auth (list (pam-entry
683 (module "pam_permit.so")))))
684 (unix-pam-service "gdm-password"
685 #:allow-empty-passwords?
686 (gdm-configuration-allow-empty-passwords? config))))
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))
695 (list #$(file-append (gdm-configuration-gdm config)
697 #:environment-variables
700 #$(gdm-configuration-x-server config))
701 ;; XXX: GDM requires access to a handful of
702 ;; programs and components from Gnome (gnome-shell,
703 ;; dbus, and gnome-session among others). The
704 ;; following variables only work provided Gnome is
706 "XDG_DATA_DIRS=/run/current-system/profile/share"
707 "PATH=/run/current-system/profile/bin"))))
708 (stop #~(make-kill-destructor))
711 (define gdm-service-type
712 (service-type (name 'gdm)
714 (list (service-extension shepherd-root-service-type
715 gdm-shepherd-service)
716 (service-extension account-service-type
717 (const %gdm-accounts))
718 (service-extension pam-root-service-type
720 (service-extension etc-service-type
722 (service-extension dbus-root-service-type
724 gdm-configuration-gdm))))
725 (default-value (gdm-configuration))
727 "Run the GNOME Desktop Manager (GDM), a program that allows
728 you to log in in a graphical session, whether or not you use GNOME.")))
730 ;; This service isn't working yet; it gets as far as starting to run the
731 ;; greeter from gnome-shell but doesn't get any further. It is here because
732 ;; it doesn't hurt anyone and perhaps it inspires someone to fix it :)
733 (define* (gdm-service #:key (gdm gdm) ;deprecated
734 (allow-empty-passwords? #t)
735 (x-server (xorg-wrapper)))
736 "Return a service that spawns the GDM graphical login manager, which in turn
737 starts the X display server with @var{X}, a command as returned by
742 GDM automatically looks for session types described by the @file{.desktop}
743 files in @file{/run/current-system/profile/share/xsessions} and allows users
744 to choose a session from the log-in screen using @kbd{F1}. Packages such as
745 @var{xfce}, @var{sawfish}, and @var{ratpoison} provide @file{.desktop} files;
746 adding them to the system-wide set of packages automatically makes them
747 available at the log-in screen.
749 In addition, @file{~/.xsession} files are honored. When available,
750 @file{~/.xsession} must be an executable that starts a window manager
751 and/or other X clients.
753 When @var{allow-empty-passwords?} is true, allow logins with an empty
755 (service gdm-service-type
758 (allow-empty-passwords? allow-empty-passwords?)
759 (x-server x-server))))
761 ;;; xorg.scm ends here