;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;;
;;; This file is part of GNU Guix.
(define-module (gnu services xorg)
#:use-module (gnu artwork)
#:use-module (gnu services)
- #:use-module (gnu services dmd)
- #:use-module (gnu system linux) ; 'pam-service'
+ #:use-module (gnu services shepherd)
+ #:use-module (gnu system pam)
#:use-module ((gnu packages base) #:select (canonical-package))
#:use-module (gnu packages guile)
#:use-module (gnu packages xorg)
#:use-module (gnu packages gl)
- #:use-module (gnu packages slim)
+ #:use-module (gnu packages display-managers)
#:use-module (gnu packages gnustep)
#:use-module (gnu packages admin)
#:use-module (gnu packages bash)
#:use-module (guix gexp)
#:use-module (guix store)
+ #:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix records)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:export (xorg-configuration-file
+ %default-xorg-modules
xorg-start-command
%default-slim-theme
%default-slim-theme-name
- slim-service))
+ slim-configuration
+ slim-service-type
+ slim-service
+
+ screen-locker
+ screen-locker?
+ screen-locker-service-type
+ screen-locker-service))
;;; Commentary:
;;;
(apply mixed-text-file "xserver.conf" "
Section \"Files\"
+ FontPath \"" font-alias "/share/fonts/X11/75dpi\"
+ FontPath \"" font-alias "/share/fonts/X11/100dpi\"
+ FontPath \"" font-alias "/share/fonts/X11/misc\"
+ FontPath \"" font-alias "/share/fonts/X11/cyrillic\"
FontPath \"" font-adobe75dpi "/share/fonts/X11/75dpi\"
ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\"
ModulePath \"" xf86-video-fbdev "/lib/xorg/modules/drivers\"
"\n"
extra-config))
+(define %default-xorg-modules
+ (list xf86-video-vesa
+ xf86-video-fbdev
+ xf86-video-modesetting
+ xf86-video-cirrus
+ xf86-video-intel
+ xf86-video-mach64
+ xf86-video-nouveau
+ xf86-video-nv
+ xf86-video-sis
+ xf86-input-libinput
+ xf86-input-evdev
+ xf86-input-keyboard
+ xf86-input-mouse
+ xf86-input-synaptics))
+
+(define (xorg-configuration-directory modules)
+ "Return a directory that contains the @code{.conf} files for X.org that
+includes the @code{share/X11/xorg.conf.d} directories of each package listed
+in @var{modules}."
+ (with-imported-modules '((guix build utils))
+ (computed-file "xorg.conf.d"
+ #~(begin
+ (use-modules (guix build utils)
+ (srfi srfi-1))
+
+ (define files
+ (append-map (lambda (module)
+ (find-files (string-append
+ module
+ "/share/X11/xorg.conf.d")
+ "\\.conf$"))
+ (list #$@modules)))
+
+ (mkdir #$output)
+ (for-each (lambda (file)
+ (symlink file
+ (string-append #$output "/"
+ (basename file))))
+ files)
+ #t))))
+
(define* (xorg-start-command #:key
(guile (canonical-package guile-2.0))
(configuration-file (xorg-configuration-file))
+ (modules %default-xorg-modules)
(xorg-server xorg-server))
"Return a derivation that builds a @var{guile} script to start the X server
from @var{xorg-server}. @var{configuration-file} is the server configuration
"-logverbose" "-verbose"
"-xkbdir" (string-append #$xkeyboard-config "/share/X11/xkb")
"-config" #$configuration-file
+ "-configdir" #$(xorg-configuration-directory modules)
"-nolisten" "tcp" "-terminate"
;; Note: SLiM and other display managers add the
(let* ((home (getenv "HOME"))
(xsession-file (string-append home "/.xsession"))
(session (match (command-line)
- ((_ x) x)
- (_ #$fallback-session))))
+ ((_) (list #$fallback-session))
+ ((_ x ..1) x))))
(if (file-exists? xsession-file)
;; Run ~/.xsession when it exists.
- (exec-from-login-shell xsession-file session)
+ (apply exec-from-login-shell xsession-file session)
;; Otherwise, start the specified session.
- (exec-from-login-shell session)))))
+ (apply exec-from-login-shell session)))))
+
(program-file "xinitrc" builder))
\f
(theme-name slim-configuration-theme-name)
(xauth slim-configuration-xauth
(default xauth))
- (dmd slim-configuration-dmd
- (default dmd))
+ (shepherd slim-configuration-shepherd
+ (default shepherd))
(bash slim-configuration-bash
(default bash))
(auto-login-session slim-configuration-auto-login-session)
#:allow-empty-passwords?
(slim-configuration-allow-empty-passwords? config))))
-(define (slim-dmd-service config)
+(define (slim-shepherd-service config)
(define slim.cfg
(let ((xinitrc (xinitrc #:fallback-session
(slim-configuration-auto-login-session config)))
(slim (slim-configuration-slim config))
(xauth (slim-configuration-xauth config))
(startx (slim-configuration-startx config))
- (dmd (slim-configuration-dmd config))
+ (shepherd (slim-configuration-shepherd config))
(theme-name (slim-configuration-theme-name config)))
(mixed-text-file "slim.cfg" "
default_path /run/current-system/profile/bin
sessiondir /run/current-system/profile/share/xsessions
session_msg session (F1 to change):
-halt_cmd " dmd "/sbin/halt
-reboot_cmd " dmd "/sbin/reboot\n"
+halt_cmd " shepherd "/sbin/halt
+reboot_cmd " shepherd "/sbin/reboot\n"
(if (slim-configuration-auto-login? config)
(string-append "auto_login yes\ndefault_user "
(slim-configuration-default-user config) "\n")
(define theme
(slim-configuration-theme config))
- (list (dmd-service
+ (list (shepherd-service
(documentation "Xorg display server")
(provision '(xorg-server))
(requirement '(user-processes host-name udev))
(define slim-service-type
(service-type (name 'slim)
(extensions
- (list (service-extension dmd-root-service-type
- slim-dmd-service)
+ (list (service-extension shepherd-root-service-type
+ slim-shepherd-service)
(service-extension pam-root-service-type
- slim-pam-service)))))
+ slim-pam-service)
+
+ ;; Unconditionally add xterm to the system profile, to
+ ;; avoid bad surprises.
+ (service-extension profile-service-type
+ (const (list xterm)))))))
(define* (slim-service #:key (slim slim)
(allow-empty-passwords? #t) auto-login?
(default-user "")
(theme %default-slim-theme)
(theme-name %default-slim-theme-name)
- (xauth xauth) (dmd dmd) (bash bash)
+ (xauth xauth) (shepherd shepherd) (bash bash)
(auto-login-session #~(string-append #$windowmaker
"/bin/wmaker"))
(startx (xorg-start-command)))
(allow-empty-passwords? allow-empty-passwords?)
(auto-login? auto-login?) (default-user default-user)
(theme theme) (theme-name theme-name)
- (xauth xauth) (dmd dmd) (bash bash)
+ (xauth xauth) (shepherd shepherd) (bash bash)
(auto-login-session auto-login-session)
(startx startx))))
+\f
+;;;
+;;; Screen lockers & co.
+;;;
+
+(define-record-type <screen-locker>
+ (screen-locker name program empty?)
+ screen-locker?
+ (name screen-locker-name) ;string
+ (program screen-locker-program) ;gexp
+ (empty? screen-locker-allows-empty-passwords?)) ;Boolean
+
+(define screen-locker-pam-services
+ (match-lambda
+ (($ <screen-locker> name _ empty?)
+ (list (unix-pam-service name
+ #:allow-empty-passwords? empty?)))))
+
+(define screen-locker-setuid-programs
+ (compose list screen-locker-program))
+
+(define screen-locker-service-type
+ (service-type (name 'screen-locker)
+ (extensions
+ (list (service-extension pam-root-service-type
+ screen-locker-pam-services)
+ (service-extension setuid-program-service-type
+ screen-locker-setuid-programs)))))
+
+(define* (screen-locker-service package
+ #:optional
+ (program (package-name package))
+ #:key allow-empty-passwords?)
+ "Add @var{package}, a package for a screen-locker or screen-saver whose
+command is @var{program}, to the set of setuid programs and add a PAM entry
+for it. For example:
+
+@lisp
+(screen-locker-service xlockmore \"xlock\")
+@end lisp
+
+makes the good ol' XlockMore usable."
+ (service screen-locker-service-type
+ (screen-locker program
+ #~(string-append #$package
+ #$(string-append "/bin/" program))
+ allow-empty-passwords?)))
+
;;; xorg.scm ends here