[jackhill/guix/guix.git] / gnu / services / xorg.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu services xorg)
  #:use-module (gnu services)
  #:use-module (gnu system linux)                 ; 'pam-service'
  #:use-module ((gnu packages base) #:select (guile-final))
  #:use-module (gnu packages xorg)
  #:use-module (gnu packages gl)
  #:use-module (gnu packages slim)
  #:use-module (gnu packages ratpoison)
  #:use-module (gnu packages gnustep)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages bash)
  #:use-module (guix monads)
  #:use-module (guix derivations)
  #:export (xorg-start-command
            slim-service))

;;; Commentary:
;;;
;;; Services that relate to the X Window System.
;;;
;;; Code:

(define* (xorg-start-command #:key
                             (guile guile-final)
                             (xorg-server xorg-server))
  "Return a derivation that builds a GUILE script to start the X server from
XORG-SERVER.  Usually the X server is started by a login manager."

  (define (xserver.conf)
    (text-file* "xserver.conf" "
Section \"Files\"
  FontPath \"" font-adobe75dpi "/share/font/X11/75dpi\"
  ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\"
  ModulePath \"" xf86-input-mouse "/lib/xorg/modules/input\"
  ModulePath \"" xf86-input-keyboard "/lib/xorg/modules/input\"
  ModulePath \"" xorg-server "/lib/xorg/modules\"
  ModulePath \"" xorg-server "/lib/xorg/modules/extensions\"
  ModulePath \"" xorg-server "/lib/xorg/modules/multimedia\"
EndSection

Section \"ServerFlags\"
  Option \"AllowMouseOpenFail\" \"on""
EndSection

Section \"Monitor\"
  Identifier \"Monitor[0]\"
EndSection

Section \"InputClass\"
  Identifier \"Generic keyboard\"
  MatchIsKeyboard \"on\"
  Option \"XkbRules\" \"base\"
  Option \"XkbModel\" \"pc104\"
EndSection

Section \"ServerLayout\"
  Identifier \"Layout\"
  Screen \"Screen-vesa\"
EndSection

Section \"Device\"
  Identifier \"Device-vesa\"
  Driver \"vesa\"
EndSection

Section \"Screen\"
  Identifier \"Screen-vesa\"
  Device \"Device-vesa\"
EndSection"))

  (mlet %store-monad ((guile-bin   (package-file guile "bin/guile"))
                      (xorg-bin    (package-file xorg-server "bin/X"))
                      (dri         (package-file mesa "lib/dri"))
                      (xkbcomp-bin (package-file xkbcomp "bin"))
                      (xkb-dir     (package-file xkeyboard-config
                                                 "share/X11/xkb"))
                      (config      (xserver.conf)))
    (define builder
      ;; Write a small wrapper around the X server.
      `(let ((out (assoc-ref %outputs "out")))
         (call-with-output-file out
           (lambda (port)
             (format port "#!~a --no-auto-compile~%!#~%" ,guile-bin)
             (write '(begin
                       (setenv "XORG_DRI_DRIVER_PATH" ,dri)
                       (setenv "XKB_BINDIR" ,xkbcomp-bin)

                       (apply execl

                              ,xorg-bin "-ac" "-logverbose" "-verbose"
                              "-xkbdir" ,xkb-dir
                              "-config" ,(derivation->output-path config)
                              "-nolisten" "tcp" "-terminate"

                              ;; Note: SLiM and other display managers add the
                              ;; '-auth' flag by themselves.
                              (cdr (command-line))))
                    port)))
         (chmod out #o555)
         #t))

    (mlet %store-monad ((inputs (lower-inputs
                                 `(("xorg" ,xorg-server)
                                   ("xkbcomp" ,xkbcomp)
                                   ("xkeyboard-config" ,xkeyboard-config)
                                   ("mesa" ,mesa)
                                   ("guile" ,guile)
                                   ("xorg.conf" ,config)))))
      (derivation-expression "start-xorg" builder
                             #:inputs inputs))))

(define* (xinitrc #:key
                  (guile guile-final)
                  (ratpoison ratpoison)
                  (windowmaker windowmaker))
  "Return a system-wide xinitrc script that starts the specified X session."
  (mlet %store-monad ((guile-bin     (package-file guile "bin/guile"))
                      (ratpoison-bin (package-file ratpoison "bin/ratpoison"))
                      (wmaker-bin    (package-file windowmaker "bin/wmaker"))
                      (inputs        (lower-inputs
                                      `(("raptoison" ,ratpoison)
                                        ("wmaker" ,windowmaker)))))
    (define builder
      `(let ((out (assoc-ref %outputs "out")))
         (call-with-output-file out
           (lambda (port)
             (format port "#!~a --no-auto-compile~%!#~%" ,guile-bin)
             (write '(begin
                       (use-modules (ice-9 match))

                       ;; TODO: Check for ~/.xsession.
                       (match (command-line)
                         ((_ "ratpoison")
                          (execl ,ratpoison-bin))
                         (_
                          (execl ,wmaker-bin))))
                    port)))
         (chmod out #o555)
         #t))

    (derivation-expression "xinitrc" builder #:inputs inputs)))

(define* (slim-service #:key (slim slim)
                       (allow-empty-passwords? #t) auto-login?
                       (default-user "")
                       (xauth xauth) (dmd dmd) (bash bash)
                       startx)
  "Return a service that spawns the SLiM graphical login manager, which in
turn start the X display server with STARTX, a command as returned by
'xorg-start-command'.

When ALLOW-EMPTY-PASSWORDS? is true, allow logins with an empty password.
When AUTO-LOGIN? is true, log in automatically as DEFAULT-USER."
  (define (slim.cfg)
    (mlet %store-monad ((startx  (or startx (xorg-start-command)))
                        (xinitrc (xinitrc)))
      (text-file* "slim.cfg"  "
default_path /run/current-system/bin
default_xserver " startx "
xserver_arguments :0 vt7
xauth_path " xauth "/bin/xauth
authfile /var/run/slim.auth

# The login command.  '%session' is replaced by the chosen session name, one
# of the names specified in the 'sessions' setting: 'wmaker', 'xfce', etc.
login_cmd  exec " xinitrc "%session
sessions   wmaker,ratpoison

halt_cmd " dmd "/sbin/halt
reboot_cmd " dmd "/sbin/reboot
" (if auto-login?
      (string-append "auto_login yes\ndefault_user " default-user)
      ""))))

  (mlet %store-monad ((slim-bin (package-file slim "bin/slim"))
                      (bash-bin (package-file bash "bin/bash"))
                      (slim.cfg (slim.cfg)))
    (return
     (service
      (documentation "Xorg display server")
      (provision '(xorg-server))
      (requirement '(host-name))
      (start
       ;; XXX: Work around the inability to specify env. vars. directly.
       `(make-forkexec-constructor
         ,bash-bin "-c"
         ,(string-append "SLIM_CFGFILE=" (derivation->output-path slim.cfg)
                         " " slim-bin
                         " -nodaemon")))
      (stop  `(make-kill-destructor))
      (inputs `(("slim" ,slim)
                ("slim.cfg" ,slim.cfg)
                ("bash" ,bash)))
      (respawn? #t)
      (pam-services
       ;; Tell PAM about 'slim'.
       (list (unix-pam-service
              "slim"
              #:allow-empty-passwords? allow-empty-passwords?)))))))

;;; xorg.scm ends here
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)
9e4eddb4	27	#:use-module (gnu packages gnustep)
db4fdc04 LC	28	#:use-module (gnu packages admin)
	29	#:use-module (gnu packages bash)
	30	#:use-module (guix monads)
	31	#:use-module (guix derivations)
	32	#:export (xorg-start-command
	33	slim-service))
	34
	35	;;; Commentary:
	36	;;;
	37	;;; Services that relate to the X Window System.
	38	;;;
	39	;;; Code:
	40
	41	(define* (xorg-start-command #:key
	42	(guile guile-final)
	43	(xorg-server xorg-server))
	44	"Return a derivation that builds a GUILE script to start the X server from
	45	XORG-SERVER. Usually the X server is started by a login manager."
	46
	47	(define (xserver.conf)
	48	(text-file* "xserver.conf" "
	49	Section \"Files\"
	50	FontPath \"" font-adobe75dpi "/share/font/X11/75dpi\"
	51	ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\"
	52	ModulePath \"" xf86-input-mouse "/lib/xorg/modules/input\"
	53	ModulePath \"" xf86-input-keyboard "/lib/xorg/modules/input\"
	54	ModulePath \"" xorg-server "/lib/xorg/modules\"
	55	ModulePath \"" xorg-server "/lib/xorg/modules/extensions\"
	56	ModulePath \"" xorg-server "/lib/xorg/modules/multimedia\"
	57	EndSection
	58
	59	Section \"ServerFlags\"
	60	Option \"AllowMouseOpenFail\" \"on""
	61	EndSection
	62
	63	Section \"Monitor\"
	64	Identifier \"Monitor[0]\"
	65	EndSection
	66
	67	Section \"InputClass\"
	68	Identifier \"Generic keyboard\"
	69	MatchIsKeyboard \"on\"
	70	Option \"XkbRules\" \"base\"
	71	Option \"XkbModel\" \"pc104\"
	72	EndSection
	73
	74	Section \"ServerLayout\"
	75	Identifier \"Layout\"
	76	Screen \"Screen-vesa\"
	77	EndSection
	78
	79	Section \"Device\"
	80	Identifier \"Device-vesa\"
	81	Driver \"vesa\"
	82	EndSection
	83
	84	Section \"Screen\"
	85	Identifier \"Screen-vesa\"
	86	Device \"Device-vesa\"
	87	EndSection"))
	88
	89	(mlet %store-monad ((guile-bin (package-file guile "bin/guile"))
	90	(xorg-bin (package-file xorg-server "bin/X"))
	91	(dri (package-file mesa "lib/dri"))
92	(xkbcomp-bin (package-file xkbcomp "bin"))
93	(xkb-dir (package-file xkeyboard-config
94	"share/X11/xkb"))
95	(config (xserver.conf)))
96	(define builder
97	;; Write a small wrapper around the X server.
98	`(let ((out (assoc-ref %outputs "out")))
99	(call-with-output-file out
100	(lambda (port)
101	(format port "#!~a --no-auto-compile~%!#~%" ,guile-bin)
102	(write '(begin
103	(setenv "XORG_DRI_DRIVER_PATH" ,dri)
104	(setenv "XKB_BINDIR" ,xkbcomp-bin)
105
106	(apply execl
107
108	,xorg-bin "-ac" "-logverbose" "-verbose"
109	"-xkbdir" ,xkb-dir
110	"-config" ,(derivation->output-path config)
111	"-nolisten" "tcp" "-terminate"
112
113	;; Note: SLiM and other display managers add the
114	;; '-auth' flag by themselves.
115	(cdr (command-line))))
116	port)))
117	(chmod out #o555)
118	#t))
119
120	(mlet %store-monad ((inputs (lower-inputs
121	`(("xorg" ,xorg-server)
122	("xkbcomp" ,xkbcomp)
123	("xkeyboard-config" ,xkeyboard-config)
124	("mesa" ,mesa)
125	("guile" ,guile)
126	("xorg.conf" ,config)))))
127	(derivation-expression "start-xorg" builder
128	#:inputs inputs))))
129
9e4eddb4 LC	130	(define* (xinitrc #:key
	131	(guile guile-final)
	132	(ratpoison ratpoison)
	133	(windowmaker windowmaker))
	134	"Return a system-wide xinitrc script that starts the specified X session."
	135	(mlet %store-monad ((guile-bin (package-file guile "bin/guile"))
	136	(ratpoison-bin (package-file ratpoison "bin/ratpoison"))
	137	(wmaker-bin (package-file windowmaker "bin/wmaker"))
	138	(inputs (lower-inputs
	139	`(("raptoison" ,ratpoison)
	140	("wmaker" ,windowmaker)))))
	141	(define builder
	142	`(let ((out (assoc-ref %outputs "out")))
	143	(call-with-output-file out
	144	(lambda (port)
	145	(format port "#!~a --no-auto-compile~%!#~%" ,guile-bin)
	146	(write '(begin
	147	(use-modules (ice-9 match))
	148
	149	;; TODO: Check for ~/.xsession.
	150	(match (command-line)
	151	((_ "ratpoison")
	152	(execl ,ratpoison-bin))
	153	(_
	154	(execl ,wmaker-bin))))
	155	port)))
	156	(chmod out #o555)
	157	#t))
	158
	159	(derivation-expression "xinitrc" builder #:inputs inputs)))
	160
db4fdc04 LC	161	(define* (slim-service #:key (slim slim)
	162	(allow-empty-passwords? #t) auto-login?
	163	(default-user "")
	164	(xauth xauth) (dmd dmd) (bash bash)
	165	startx)
	166	"Return a service that spawns the SLiM graphical login manager, which in
	167	turn start the X display server with STARTX, a command as returned by
	168	'xorg-start-command'.
	169
	170	When ALLOW-EMPTY-PASSWORDS? is true, allow logins with an empty password.
	171	When AUTO-LOGIN? is true, log in automatically as DEFAULT-USER."
	172	(define (slim.cfg)
9e4eddb4 LC	173	(mlet %store-monad ((startx (or startx (xorg-start-command)))
9e4eddb4 LC	174	(xinitrc (xinitrc)))
db4fdc04 LC	175	(text-file* "slim.cfg" "
	176	default_path /run/current-system/bin
	177	default_xserver " startx "
	178	xserver_arguments :0 vt7
	179	xauth_path " xauth "/bin/xauth
	180	authfile /var/run/slim.auth
	181
	182	# The login command. '%session' is replaced by the chosen session name, one
	183	# of the names specified in the 'sessions' setting: 'wmaker', 'xfce', etc.
9e4eddb4 LC	184	login_cmd exec " xinitrc "%session
9e4eddb4 LC	185	sessions wmaker,ratpoison
db4fdc04 LC	186
	187	halt_cmd " dmd "/sbin/halt
	188	reboot_cmd " dmd "/sbin/reboot
	189	" (if auto-login?
	190	(string-append "auto_login yes\ndefault_user " default-user)
	191	""))))
	192
	193	(mlet %store-monad ((slim-bin (package-file slim "bin/slim"))
	194	(bash-bin (package-file bash "bin/bash"))
	195	(slim.cfg (slim.cfg)))
	196	(return
	197	(service
	198	(documentation "Xorg display server")
	199	(provision '(xorg-server))
	200	(requirement '(host-name))
	201	(start
	202	;; XXX: Work around the inability to specify env. vars. directly.
	203	`(make-forkexec-constructor
	204	,bash-bin "-c"
	205	,(string-append "SLIM_CFGFILE=" (derivation->output-path slim.cfg)
	206	" " slim-bin
	207	" -nodaemon")))
	208	(stop `(make-kill-destructor))
	209	(inputs `(("slim" ,slim)
	210	("slim.cfg" ,slim.cfg)
	211	("bash" ,bash)))
	212	(respawn? #t)
	213	(pam-services
	214	;; Tell PAM about 'slim'.
	215	(list (unix-pam-service
	216	"slim"
	217	#:allow-empty-passwords? allow-empty-passwords?)))))))
	218
	219	;;; xorg.scm ends here