services: Add screen-locker service.

* gnu/system/linux.scm (base-pam-services): Remove "xlock" and
  "xscreensaver".
* gnu/services/xorg.scm (<screen-locker>): New record type.
  (screen-locker-pam-services, screen-locker-setuid-programs,
  screen-locker-service): New procedures.
  (screen-locker-service-type): New variable.
* gnu/services/desktop.scm (%desktop-services): Use them.
* doc/guix.texi (X Window): Document 'screen-locker-service'.
  (Desktop Services): Mention it.
This commit is contained in:
Ludovic Courtès 2015-10-29 19:00:14 +01:00
parent e502bf8953
commit 6726282b20
4 changed files with 76 additions and 4 deletions

View file

@ -6496,6 +6496,19 @@ Last, @var{extra-config} is a list of strings or objects appended to the
verbatim to the configuration file. verbatim to the configuration file.
@end deffn @end deffn
@deffn {Scheme Procedure} screen-locker-service @var{package} [@var{name}]
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.
@end deffn
@node Desktop Services @node Desktop Services
@subsubsection Desktop Services @subsubsection Desktop Services
@ -6513,7 +6526,8 @@ This is a list of services that builds upon @var{%base-services} and
adds or adjust services for a typical ``desktop'' setup. adds or adjust services for a typical ``desktop'' setup.
In particular, it adds a graphical login manager (@pxref{X Window, In particular, it adds a graphical login manager (@pxref{X Window,
@code{slim-service}}), a network management tool (@pxref{Networking @code{slim-service}}), screen lockers,
a network management tool (@pxref{Networking
Services, @code{wicd-service}}), energy and color management services, Services, @code{wicd-service}}), energy and color management services,
the @code{elogind} login and seat manager, the Polkit privilege service, the @code{elogind} login and seat manager, the Polkit privilege service,
the GeoClue location service, an NTP client (@pxref{Networking the GeoClue location service, an NTP client (@pxref{Networking

View file

@ -34,6 +34,8 @@ (define-module (gnu services desktop)
#:use-module (gnu packages gnome) #:use-module (gnu packages gnome)
#:use-module (gnu packages avahi) #:use-module (gnu packages avahi)
#:use-module (gnu packages polkit) #:use-module (gnu packages polkit)
#:use-module (gnu packages xdisorg)
#:use-module (gnu packages suckless)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix store) #:use-module (guix store)
@ -643,6 +645,10 @@ (define %desktop-services
;; List of services typically useful for a "desktop" use case. ;; List of services typically useful for a "desktop" use case.
(cons* (slim-service) (cons* (slim-service)
;; Screen lockers are a pretty useful thing and these are small.
(screen-locker-service slock)
(screen-locker-service xlockmore "xlock")
;; The D-Bus clique. ;; The D-Bus clique.
(avahi-service) (avahi-service)
(wicd-service) (wicd-service)

View file

@ -32,16 +32,21 @@ (define-module (gnu services xorg)
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix packages)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix records) #:use-module (guix records)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (xorg-configuration-file #:export (xorg-configuration-file
xorg-start-command xorg-start-command
%default-slim-theme %default-slim-theme
%default-slim-theme-name %default-slim-theme-name
slim-service)) slim-service
screen-locker-service-type
screen-locker-service))
;;; Commentary: ;;; Commentary:
;;; ;;;
@ -350,4 +355,52 @@ (define* (slim-service #:key (slim slim)
(auto-login-session auto-login-session) (auto-login-session auto-login-session)
(startx startx)))) (startx startx))))
;;;
;;; 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 ;;; xorg.scm ends here

View file

@ -182,8 +182,7 @@ (define* (base-pam-services #:key allow-empty-passwords?)
;; These programs are setuid-root. ;; These programs are setuid-root.
(map (cut unix-pam-service <> (map (cut unix-pam-service <>
#:allow-empty-passwords? allow-empty-passwords?) #:allow-empty-passwords? allow-empty-passwords?)
'("su" "passwd" "sudo" '("su" "passwd" "sudo"))
"xlock" "xscreensaver"))
;; These programs are not setuid-root, and we want root to be able ;; These programs are not setuid-root, and we want root to be able
;; to run them without having to authenticate (notably because ;; to run them without having to authenticate (notably because