1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2017 Andy Wingo <wingo@igalia.com>
3 ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
4 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
6 ;;; This file is part of GNU Guix.
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.
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.
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/>.
21 (define-module (gnu services xorg)
22 #:use-module (gnu artwork)
23 #:use-module (gnu services)
24 #:use-module (gnu services shepherd)
25 #:use-module (gnu system pam)
26 #:use-module (gnu services dbus)
27 #:use-module ((gnu packages base) #:select (canonical-package))
28 #:use-module (gnu packages guile)
29 #:use-module (gnu packages xorg)
30 #:use-module (gnu packages gl)
31 #:use-module (gnu packages display-managers)
32 #:use-module (gnu packages gnustep)
33 #:use-module (gnu packages gnome)
34 #:use-module (gnu packages admin)
35 #:use-module (gnu packages bash)
36 #:use-module (gnu system shadow)
37 #:use-module (guix gexp)
38 #:use-module (guix store)
39 #:use-module (guix packages)
40 #:use-module (guix derivations)
41 #:use-module (guix records)
42 #:use-module (srfi srfi-1)
43 #:use-module (srfi srfi-9)
44 #:use-module (srfi srfi-26)
45 #:use-module (ice-9 match)
46 #:export (xorg-configuration-file
54 %default-slim-theme-name
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
74 screen-locker-service-type
83 ;;; Services that relate to the X Window System.
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
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>.
108 xf86-input-synaptics))
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")
116 (file-append font-misc-misc ;default fonts for xterm
117 "/share/fonts/X11/misc")
118 (file-append font-adobe75dpi "/share/fonts/X11/75dpi")))
120 (define* (xorg-configuration-file #:key
121 (modules %default-xorg-modules)
122 (fonts %default-xorg-fonts)
123 (drivers '()) (resolutions '())
125 "Return a configuration file for the Xorg server containing search paths for
126 all the common drivers.
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
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
135 this order---e.g., @code{(\"modesetting\" \"vesa\")}.
137 Likewise, when @var{resolutions} is the empty list, Xorg chooses an
138 appropriate screen resolution; otherwise, it must be a list of
139 resolutions---e.g., @code{((1024 768) (640 480))}.
141 Last, @var{extra-config} is a list of strings or objects appended to the
142 configuration file. It is used to pass extra text to be
143 added verbatim to the configuration file."
145 ;; 'xorg-server' provides 'fbdevhw.so' etc.
146 (append modules (list xorg-server)))
150 (use-modules (ice-9 match)
154 (call-with-output-file #$output
159 (define (device-section driver)
162 Identifier \"device-" driver "\"
163 Driver \"" driver "\"
166 (define (screen-section driver resolutions)
169 Identifier \"screen-" driver "\"
170 Device \"device-" driver "\"
171 SubSection \"Display\"
173 (string-join (map (match-lambda
175 (string-append "\"" (number->string x)
176 "x" (number->string y) "\"")))
181 (define (expand modules)
182 ;; Append to MODULES the relevant /lib/xorg/modules
184 (append-map (lambda (module)
185 (filter-map (lambda (directory)
186 (let ((full (string-append module
188 (and (file-exists? full)
190 '("/lib/xorg/modules/drivers"
191 "/lib/xorg/modules/input"
192 "/lib/xorg/modules/multimedia"
193 "/lib/xorg/modules/extensions")))
196 (display "Section \"Files\"\n" port)
197 (for-each (lambda (font)
198 (format port " FontPath \"~a\"~%" font))
200 (for-each (lambda (module)
202 " ModulePath \"~a\"~%"
204 (append (expand '#$all-modules)
206 ;; For fbdevhw.so and so on.
207 (list #$(file-append xorg-server
208 "/lib/xorg/modules"))))
209 (display "EndSection\n" port)
211 Section \"ServerFlags\"
212 Option \"AllowMouseOpenFail\" \"on\"
215 (display (string-join (map device-section drivers) "\n")
218 (display (string-join
219 (map (cut screen-section <> '#$resolutions)
225 (for-each (lambda (config)
226 (display config port))
229 (computed-file "xserver.conf" build))
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
236 (with-imported-modules '((guix build utils))
237 (computed-file "xorg.conf.d"
239 (use-modules (guix build utils)
243 (append-map (lambda (module)
244 (find-files (string-append
246 "/share/X11/xorg.conf.d")
251 (for-each (lambda (file)
253 (string-append #$output "/"
258 (define* (xorg-wrapper #:key
259 (guile (canonical-package guile-2.0))
260 (modules %default-xorg-modules)
261 (configuration-file (xorg-configuration-file
263 (xorg-server xorg-server))
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
267 @code{xorg-configuration-file} is used. The resulting script should be used
268 in place of @code{/usr/bin/X}."
270 ;; Write a small wrapper around the X server.
272 (setenv "XORG_DRI_DRIVER_PATH" (string-append #$mesa "/lib/dri"))
273 (setenv "XKB_BINDIR" (string-append #$xkbcomp "/bin"))
275 (let ((X (string-append #$xorg-server "/bin/X")))
277 "-xkbdir" (string-append #$xkeyboard-config "/share/X11/xkb")
278 "-config" #$configuration-file
279 "-configdir" #$(xorg-configuration-directory modules)
280 (cdr (command-line))))))
282 (program-file "X-wrapper" exp))
284 (define* (xorg-start-command #:key
285 (guile (canonical-package guile-2.0))
286 (modules %default-xorg-modules)
287 (fonts %default-xorg-fonts)
289 (xorg-configuration-file #:modules modules
291 (xorg-server xorg-server))
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}."
297 (xorg-wrapper #:guile guile
298 #:configuration-file configuration-file
300 #:xorg-server xorg-server))
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))))
307 (program-file "startx" exp))
309 (define* (xinitrc #:key
310 (guile (canonical-package guile-2.0))
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
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."
318 (use-modules (ice-9 match)
325 (define (close-all-fdes)
326 ;; Close all the open file descriptors except 0 to 2.
328 (when (< fd 4096) ;FIXME: use sysconf + _SC_OPEN_MAX
329 (false-if-exception (close-fdes fd))
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
336 (let* ((pw (getpw (getuid)))
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!
343 ;; The '--login' option is supported at least by Bash and zsh.
344 (execl shell shell "--login" "-c"
345 (string-join (cons command args)))))
347 (define system-profile
348 "/run/current-system/profile")
351 (and=> (getpw (getuid))
353 (string-append (passwd:dir pw) "/.guix-profile"))))
355 (define (xsession-command desktop-file)
356 ;; Read from DESKTOP-FILE its X session command and return it as a
359 (make-regexp "^[[:blank:]]*Exec=(.*)$"))
361 (call-with-input-file desktop-file
364 (match (read-line port)
366 ((= (cut regexp-exec exec-regexp <>) result)
368 (string-tokenize (match:substring result 1))
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" <>))
379 (any xsession-command
380 (map (cut string-append directory "/" <>)
383 (let* ((home (getenv "HOME"))
384 (xsession-file (string-append home "/.xsession"))
385 (session (match (command-line)
387 #$(if fallback-session
388 #~(list #$fallback-session)
392 (if (file-exists? xsession-file)
393 ;; Run ~/.xsession when it exists.
394 (apply exec-from-login-shell xsession-file
396 ;; Otherwise, start the specified session or a fallback.
397 (apply exec-from-login-shell
399 (find-session user-profile)
400 (find-session system-profile)))))))
402 (program-file "xinitrc" builder))
406 ;;; SLiM log-in manager.
409 (define %default-slim-theme
410 ;; Theme based on work by Felipe López.
411 (file-append %artwork-repository "/slim"))
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.
418 (define-record-type* <slim-configuration>
419 slim-configuration make-slim-configuration
421 (slim slim-configuration-slim
423 (allow-empty-passwords? slim-configuration-allow-empty-passwords?
425 (auto-login? slim-configuration-auto-login?
427 (default-user slim-configuration-default-user
429 (theme slim-configuration-theme
430 (default %default-slim-theme))
431 (theme-name slim-configuration-theme-name
432 (default %default-slim-theme-name))
433 (xauth slim-configuration-xauth
435 (shepherd slim-configuration-shepherd
437 (auto-login-session slim-configuration-auto-login-session
439 (startx slim-configuration-startx
440 (default (xorg-start-command)))
441 (sessreg slim-configuration-sessreg
444 (define (slim-pam-service config)
445 "Return a PAM service for @command{slim}."
446 (list (unix-pam-service
448 #:allow-empty-passwords?
449 (slim-configuration-allow-empty-passwords? config))))
451 (define (slim-shepherd-service config)
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))
458 (shepherd (slim-configuration-shepherd config))
459 (theme-name (slim-configuration-theme-name config))
460 (sessreg (slim-configuration-sessreg config)))
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
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):
473 sessionstart_cmd " sessreg "/bin/sessreg -a -l $DISPLAY %user
474 sessionstop_cmd " sessreg "/bin/sessreg -d -l $DISPLAY %user
476 halt_cmd " shepherd "/sbin/halt
477 reboot_cmd " shepherd "/sbin/reboot\n"
478 (if (slim-configuration-auto-login? config)
479 (string-append "auto_login yes\ndefault_user "
480 (slim-configuration-default-user config) "\n")
483 (string-append "current_theme " theme-name "\n")
487 (slim-configuration-theme config))
489 (list (shepherd-service
490 (documentation "Xorg display server")
491 (provision '(xorg-server))
492 (requirement '(user-processes host-name udev))
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"))
500 (list (string-append #$slim "/bin/slim") "-nodaemon")
501 #:environment-variables
502 (list (string-append "SLIM_CFGFILE=" #$slim.cfg)
504 (list #~(string-append "SLIM_THEMESDIR=" #$theme))
506 (stop #~(make-kill-destructor))
509 (define slim-service-type
510 (service-type (name 'slim)
512 (list (service-extension shepherd-root-service-type
513 slim-shepherd-service)
514 (service-extension pam-root-service-type
517 ;; Unconditionally add xterm to the system profile, to
518 ;; avoid bad surprises.
519 (service-extension profile-service-type
520 (const (list xterm)))))
521 (default-value (slim-configuration))))
523 (define* (slim-service #:key (slim slim) ;deprecated
524 (allow-empty-passwords? #t) auto-login?
526 (theme %default-slim-theme)
527 (theme-name %default-slim-theme-name)
528 (xauth xauth) (shepherd shepherd)
529 (auto-login-session #f)
530 (startx (xorg-start-command)))
531 "Return a service that spawns the SLiM graphical login manager, which in
532 turn starts the X display server with @var{startx}, a command as returned by
533 @code{xorg-start-command}.
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.
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.
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
550 @var{default-user} with @var{auto-login-session}.
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
556 (service slim-service-type
559 (allow-empty-passwords? allow-empty-passwords?)
560 (auto-login? auto-login?) (default-user default-user)
561 (theme theme) (theme-name theme-name)
562 (xauth xauth) (shepherd shepherd)
563 (auto-login-session auto-login-session)
568 ;;; Screen lockers & co.
571 (define-record-type <screen-locker>
572 (screen-locker name program empty?)
574 (name screen-locker-name) ;string
575 (program screen-locker-program) ;gexp
576 (empty? screen-locker-allows-empty-passwords?)) ;Boolean
578 (define screen-locker-pam-services
580 (($ <screen-locker> name _ empty?)
581 (list (unix-pam-service name
582 #:allow-empty-passwords? empty?)))))
584 (define screen-locker-setuid-programs
585 (compose list screen-locker-program))
587 (define screen-locker-service-type
588 (service-type (name 'screen-locker)
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)))))
595 (define* (screen-locker-service package
597 (program (package-name package))
598 #:key allow-empty-passwords?)
599 "Add @var{package}, a package for a screen locker or screen saver whose
600 command is @var{program}, to the set of setuid programs and add a PAM entry
604 (screen-locker-service xlockmore \"xlock\")
607 makes the good ol' XlockMore usable."
608 (service screen-locker-service-type
609 (screen-locker program
610 (file-append package "/bin/" program)
611 allow-empty-passwords?)))
613 (define %gdm-accounts
614 (list (user-group (name "gdm") (system? #t))
619 (comment "GNOME Display Manager user")
620 (home-directory "/var/lib/gdm")
621 (shell (file-append shadow "/sbin/nologin")))))
623 (define-record-type* <gdm-configuration>
624 gdm-configuration make-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))
633 (define (gdm-etc-service config)
634 (define gdm-configuration-file
635 (mixed-text-file "gdm-custom.conf"
639 (if (gdm-configuration-auto-login? config)
641 "AutomaticLoginEnable=true\n"
643 (or (gdm-configuration-default-user config)
644 (error "missing default user for auto-login"))
647 "AutomaticLoginEnable=false\n"
648 "#AutomaticLogin=\n"))
649 "#TimedLoginEnable=false\n"
651 "#TimedLoginDelay=0\n"
652 "#InitialSetupEnable=true\n"
653 ;; Enable me once X is working.
654 "WaylandEnable=false\n"
660 "#DisallowTCP=true\n"
661 "#AllowRemoteAutoLogin=false\n"))
662 `(("gdm" ,(file-union
664 `(("custom.conf" ,gdm-configuration-file))))))
666 (define (gdm-pam-service config)
667 "Return a PAM service for @command{gdm}."
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")))
676 (control "sufficient")
677 (module "pam_permit.so")))))
679 (inherit (unix-pam-service "gdm-launch-environment"))
680 (auth (list (pam-entry
682 (module "pam_permit.so")))))
685 #:allow-empty-passwords? (gdm-configuration-allow-empty-passwords? config)
686 #:allow-root? (gdm-configuration-allow-root? 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))
693 ;; While this service isn't working properly, turn off auto-start.
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
725 (compose list gdm-configuration-gdm))))))
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
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.
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.
750 When @var{allow-empty-passwords?} is true, allow logins with an empty
752 (service gdm-service-type
755 (allow-empty-passwords? allow-empty-passwords?)
756 (x-server x-server))))
758 ;;; xorg.scm ends here