gnu: Add draft of gdm service.
* gnu/services/xorg.scm (%gdm-accounts, <gdm-configuration>) (gdm-etc-service, gdm-pam-service, gdm-shepherd-service, gdm-service-programs) (gdm-service-type, gdm-service): New public variables. Not yet working.master
Andy Wingo
parent
b6d8066d4d
commit
6e99c01b4d
|
|
@ -23,14 +23,17 @@
|
|||
#:use-module (gnu services)
|
||||
#:use-module (gnu services shepherd)
|
||||
#:use-module (gnu system pam)
|
||||
#:use-module (gnu services dbus)
|
||||
#: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 display-managers)
|
||||
#:use-module (gnu packages gnustep)
|
||||
#:use-module (gnu packages gnome)
|
||||
#:use-module (gnu packages admin)
|
||||
#:use-module (gnu packages bash)
|
||||
#:use-module (gnu system shadow)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix store)
|
||||
#:use-module (guix packages)
|
||||
|
|
@ -55,7 +58,11 @@
|
|||
screen-locker
|
||||
screen-locker?
|
||||
screen-locker-service-type
|
||||
screen-locker-service))
|
||||
screen-locker-service
|
||||
|
||||
gdm-configuration
|
||||
gdm-service-type
|
||||
gdm-service))
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
|
|
@ -476,4 +483,142 @@ makes the good ol' XlockMore usable."
|
|||
(file-append package "/bin/" program)
|
||||
allow-empty-passwords?)))
|
||||
|
||||
(define %gdm-accounts
|
||||
(list (user-group (name "gdm") (system? #t))
|
||||
(user-account
|
||||
(name "gdm")
|
||||
(group "gdm")
|
||||
(system? #t)
|
||||
(comment "GNOME Display Manager user")
|
||||
(home-directory "/var/lib/gdm")
|
||||
(shell (file-append shadow "/sbin/nologin")))))
|
||||
|
||||
(define-record-type* <gdm-configuration>
|
||||
gdm-configuration make-gdm-configuration
|
||||
gdm-configuration?
|
||||
(gdm gdm-configuration-gdm (default gdm))
|
||||
(allow-empty-passwords? gdm-configuration-allow-empty-passwords? (default #t))
|
||||
(allow-root? gdm-configuration-allow-root? (default #t))
|
||||
(auto-login? gdm-configuration-auto-login? (default #f))
|
||||
(default-user gdm-configuration-default-user (default #f))
|
||||
(x-server gdm-configuration-x-server))
|
||||
|
||||
(define (gdm-etc-service config)
|
||||
(define gdm-configuration-file
|
||||
(mixed-text-file "gdm-custom.conf"
|
||||
"[daemon]\n"
|
||||
"#User=gdm\n"
|
||||
"#Group=gdm\n"
|
||||
(if (gdm-configuration-auto-login? config)
|
||||
(string-append
|
||||
"AutomaticLoginEnable=true\n"
|
||||
"AutomaticLogin="
|
||||
(or (gdm-configuration-default-user config)
|
||||
(error "missing default user for auto-login"))
|
||||
"\n")
|
||||
(string-append
|
||||
"AutomaticLoginEnable=false\n"
|
||||
"#AutomaticLogin=\n"))
|
||||
"#TimedLoginEnable=false\n"
|
||||
"#TimedLogin=\n"
|
||||
"#TimedLoginDelay=0\n"
|
||||
"#InitialSetupEnable=true\n"
|
||||
;; Enable me once X is working.
|
||||
"WaylandEnable=false\n"
|
||||
"\n"
|
||||
"[debug]\n"
|
||||
"Enable=true\n"
|
||||
"\n"
|
||||
"[security]\n"
|
||||
"#DisallowTCP=true\n"
|
||||
"#AllowRemoteAutoLogin=false\n"))
|
||||
`(("gdm" ,(file-union
|
||||
"gdm"
|
||||
`(("custom.conf" ,gdm-configuration-file))))))
|
||||
|
||||
(define (gdm-pam-service config)
|
||||
"Return a PAM service for @command{gdm}."
|
||||
(list
|
||||
(pam-service
|
||||
(inherit (unix-pam-service "gdm-autologin"))
|
||||
(auth (list (pam-entry
|
||||
(control "[success=ok default=1]")
|
||||
(module (file-append (gdm-configuration-gdm config)
|
||||
"/lib/security/pam_gdm.so")))
|
||||
(pam-entry
|
||||
(control "sufficient")
|
||||
(module "pam_permit.so")))))
|
||||
(pam-service
|
||||
(inherit (unix-pam-service "gdm-launch-environment"))
|
||||
(auth (list (pam-entry
|
||||
(control "required")
|
||||
(module "pam_permit.so")))))
|
||||
(unix-pam-service
|
||||
"gdm-password"
|
||||
#:allow-empty-passwords? (gdm-configuration-allow-empty-passwords? config)
|
||||
#:allow-root? (gdm-configuration-allow-root? config))))
|
||||
|
||||
(define (gdm-shepherd-service config)
|
||||
(list (shepherd-service
|
||||
(documentation "Xorg display server (GDM)")
|
||||
(provision '(xorg-server))
|
||||
(requirement '(dbus-system user-processes host-name udev))
|
||||
;; While this service isn't working properly, turn off auto-start.
|
||||
(auto-start? #f)
|
||||
(start #~(lambda ()
|
||||
(fork+exec-command
|
||||
(list #$(file-append (gdm-configuration-gdm config)
|
||||
"/bin/gdm"))
|
||||
#:environment-variables
|
||||
(list (string-append
|
||||
"GDM_X_SERVER="
|
||||
#$(gdm-configuration-x-server config))))))
|
||||
(stop #~(make-kill-destructor))
|
||||
(respawn? #t))))
|
||||
|
||||
(define gdm-service-type
|
||||
(service-type (name 'gdm)
|
||||
(extensions
|
||||
(list (service-extension shepherd-root-service-type
|
||||
gdm-shepherd-service)
|
||||
(service-extension account-service-type
|
||||
(const %gdm-accounts))
|
||||
(service-extension pam-root-service-type
|
||||
gdm-pam-service)
|
||||
(service-extension etc-service-type
|
||||
gdm-etc-service)
|
||||
(service-extension dbus-root-service-type
|
||||
(compose list gdm-configuration-gdm))))))
|
||||
|
||||
;; This service isn't working yet; it gets as far as starting to run the
|
||||
;; greeter from gnome-shell but doesn't get any further. It is here because
|
||||
;; it doesn't hurt anyone and perhaps it inspires someone to fix it :)
|
||||
(define* (gdm-service #:key (gdm gdm)
|
||||
(allow-empty-passwords? #t)
|
||||
(x-server (xorg-wrapper)))
|
||||
"Return a service that spawns the GDM graphical login manager, which in turn
|
||||
starts the X display server with @var{X}, a command as returned by
|
||||
@code{xorg-wrapper}.
|
||||
|
||||
@cindex X session
|
||||
|
||||
GDM automatically looks for session types described by the @file{.desktop}
|
||||
files in @file{/run/current-system/profile/share/xsessions} and allows users
|
||||
to choose a session from the log-in screen using @kbd{F1}. Packages such as
|
||||
@var{xfce}, @var{sawfish}, and @var{ratpoison} provide @file{.desktop} files;
|
||||
adding them to the system-wide set of packages automatically makes them
|
||||
available at the log-in screen.
|
||||
|
||||
In addition, @file{~/.xsession} files are honored. When available,
|
||||
@file{~/.xsession} must be an executable that starts a window manager
|
||||
and/or other X clients.
|
||||
|
||||
When @var{allow-empty-passwords?} is true, allow logins with an empty
|
||||
password."
|
||||
(service gdm-service-type
|
||||
(gdm-configuration
|
||||
(gdm gdm)
|
||||
(allow-empty-passwords? allow-empty-passwords?)
|
||||
(x-server x-server))))
|
||||
|
||||
;;; xorg.scm ends here
|
||||
|
|
|
|||
Loading…
Reference in New Issue