Commit | Line | Data |
---|---|---|
db4fdc04 LC |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> | |
3 | ;;; | |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | (define-module (gnu services xorg) | |
20 | #:use-module (gnu services) | |
21 | #:use-module (gnu system linux) ; 'pam-service' | |
22 | #:use-module ((gnu packages base) #:select (guile-final)) | |
23 | #:use-module (gnu packages xorg) | |
24 | #:use-module (gnu packages gl) | |
25 | #:use-module (gnu packages slim) | |
26 | #:use-module (gnu packages ratpoison) | |
27 | #:use-module (gnu packages admin) | |
28 | #:use-module (gnu packages bash) | |
29 | #:use-module (guix monads) | |
30 | #:use-module (guix derivations) | |
31 | #:export (xorg-start-command | |
32 | slim-service)) | |
33 | ||
34 | ;;; Commentary: | |
35 | ;;; | |
36 | ;;; Services that relate to the X Window System. | |
37 | ;;; | |
38 | ;;; Code: | |
39 | ||
40 | (define* (xorg-start-command #:key | |
41 | (guile guile-final) | |
42 | (xorg-server xorg-server)) | |
43 | "Return a derivation that builds a GUILE script to start the X server from | |
44 | XORG-SERVER. Usually the X server is started by a login manager." | |
45 | ||
46 | (define (xserver.conf) | |
47 | (text-file* "xserver.conf" " | |
48 | Section \"Files\" | |
49 | FontPath \"" font-adobe75dpi "/share/font/X11/75dpi\" | |
50 | ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\" | |
51 | ModulePath \"" xf86-input-mouse "/lib/xorg/modules/input\" | |
52 | ModulePath \"" xf86-input-keyboard "/lib/xorg/modules/input\" | |
53 | ModulePath \"" xorg-server "/lib/xorg/modules\" | |
54 | ModulePath \"" xorg-server "/lib/xorg/modules/extensions\" | |
55 | ModulePath \"" xorg-server "/lib/xorg/modules/multimedia\" | |
56 | EndSection | |
57 | ||
58 | Section \"ServerFlags\" | |
59 | Option \"AllowMouseOpenFail\" \"on"" | |
60 | EndSection | |
61 | ||
62 | Section \"Monitor\" | |
63 | Identifier \"Monitor[0]\" | |
64 | EndSection | |
65 | ||
66 | Section \"InputClass\" | |
67 | Identifier \"Generic keyboard\" | |
68 | MatchIsKeyboard \"on\" | |
69 | Option \"XkbRules\" \"base\" | |
70 | Option \"XkbModel\" \"pc104\" | |
71 | EndSection | |
72 | ||
73 | Section \"ServerLayout\" | |
74 | Identifier \"Layout\" | |
75 | Screen \"Screen-vesa\" | |
76 | EndSection | |
77 | ||
78 | Section \"Device\" | |
79 | Identifier \"Device-vesa\" | |
80 | Driver \"vesa\" | |
81 | EndSection | |
82 | ||
83 | Section \"Screen\" | |
84 | Identifier \"Screen-vesa\" | |
85 | Device \"Device-vesa\" | |
86 | EndSection")) | |
87 | ||
88 | (mlet %store-monad ((guile-bin (package-file guile "bin/guile")) | |
89 | (xorg-bin (package-file xorg-server "bin/X")) | |
90 | (dri (package-file mesa "lib/dri")) | |
91 | (xkbcomp-bin (package-file xkbcomp "bin")) | |
92 | (xkb-dir (package-file xkeyboard-config | |
93 | "share/X11/xkb")) | |
94 | (config (xserver.conf))) | |
95 | (define builder | |
96 | ;; Write a small wrapper around the X server. | |
97 | `(let ((out (assoc-ref %outputs "out"))) | |
98 | (call-with-output-file out | |
99 | (lambda (port) | |
100 | (format port "#!~a --no-auto-compile~%!#~%" ,guile-bin) | |
101 | (write '(begin | |
102 | (setenv "XORG_DRI_DRIVER_PATH" ,dri) | |
103 | (setenv "XKB_BINDIR" ,xkbcomp-bin) | |
104 | ||
105 | (apply execl | |
106 | ||
107 | ,xorg-bin "-ac" "-logverbose" "-verbose" | |
108 | "-xkbdir" ,xkb-dir | |
109 | "-config" ,(derivation->output-path config) | |
110 | "-nolisten" "tcp" "-terminate" | |
111 | ||
112 | ;; Note: SLiM and other display managers add the | |
113 | ;; '-auth' flag by themselves. | |
114 | (cdr (command-line)))) | |
115 | port))) | |
116 | (chmod out #o555) | |
117 | #t)) | |
118 | ||
119 | (mlet %store-monad ((inputs (lower-inputs | |
120 | `(("xorg" ,xorg-server) | |
121 | ("xkbcomp" ,xkbcomp) | |
122 | ("xkeyboard-config" ,xkeyboard-config) | |
123 | ("mesa" ,mesa) | |
124 | ("guile" ,guile) | |
125 | ("xorg.conf" ,config))))) | |
126 | (derivation-expression "start-xorg" builder | |
127 | #:inputs inputs)))) | |
128 | ||
129 | (define* (slim-service #:key (slim slim) | |
130 | (allow-empty-passwords? #t) auto-login? | |
131 | (default-user "") | |
132 | (xauth xauth) (dmd dmd) (bash bash) | |
133 | startx) | |
134 | "Return a service that spawns the SLiM graphical login manager, which in | |
135 | turn start the X display server with STARTX, a command as returned by | |
136 | 'xorg-start-command'. | |
137 | ||
138 | When ALLOW-EMPTY-PASSWORDS? is true, allow logins with an empty password. | |
139 | When AUTO-LOGIN? is true, log in automatically as DEFAULT-USER." | |
140 | (define (slim.cfg) | |
141 | ;; TODO: Run "bash -login ~/.xinitrc %session". | |
142 | (mlet %store-monad ((startx (or startx (xorg-start-command)))) | |
143 | (text-file* "slim.cfg" " | |
144 | default_path /run/current-system/bin | |
145 | default_xserver " startx " | |
146 | xserver_arguments :0 vt7 | |
147 | xauth_path " xauth "/bin/xauth | |
148 | authfile /var/run/slim.auth | |
149 | ||
150 | # The login command. '%session' is replaced by the chosen session name, one | |
151 | # of the names specified in the 'sessions' setting: 'wmaker', 'xfce', etc. | |
152 | login_cmd exec " ratpoison "/bin/ratpoison | |
153 | ||
154 | halt_cmd " dmd "/sbin/halt | |
155 | reboot_cmd " dmd "/sbin/reboot | |
156 | " (if auto-login? | |
157 | (string-append "auto_login yes\ndefault_user " default-user) | |
158 | "")))) | |
159 | ||
160 | (mlet %store-monad ((slim-bin (package-file slim "bin/slim")) | |
161 | (bash-bin (package-file bash "bin/bash")) | |
162 | (slim.cfg (slim.cfg))) | |
163 | (return | |
164 | (service | |
165 | (documentation "Xorg display server") | |
166 | (provision '(xorg-server)) | |
167 | (requirement '(host-name)) | |
168 | (start | |
169 | ;; XXX: Work around the inability to specify env. vars. directly. | |
170 | `(make-forkexec-constructor | |
171 | ,bash-bin "-c" | |
172 | ,(string-append "SLIM_CFGFILE=" (derivation->output-path slim.cfg) | |
173 | " " slim-bin | |
174 | " -nodaemon"))) | |
175 | (stop `(make-kill-destructor)) | |
176 | (inputs `(("slim" ,slim) | |
177 | ("slim.cfg" ,slim.cfg) | |
178 | ("bash" ,bash))) | |
179 | (respawn? #t) | |
180 | (pam-services | |
181 | ;; Tell PAM about 'slim'. | |
182 | (list (unix-pam-service | |
183 | "slim" | |
184 | #:allow-empty-passwords? allow-empty-passwords?))))))) | |
185 | ||
186 | ;;; xorg.scm ends here |