06/06: services: Add screen-locker service.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 6726282b20918f98ba7197ea1301376f29a248af
Author: Ludovic Courtès <address@hidden>
Date:   Thu Oct 29 19:00:14 2015 +0100

    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.
---
 doc/guix.texi            |   16 ++++++++++++-
 gnu/services/desktop.scm |    6 +++++
 gnu/services/xorg.scm    |   55 +++++++++++++++++++++++++++++++++++++++++++++-
 gnu/system/linux.scm     |    3 +-
 4 files changed, 76 insertions(+), 4 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index b5c08f5..844f9fa 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6496,6 +6496,19 @@ Last, @var{extra-config} is a list of strings or objects 
appended to the
 verbatim to the configuration file.
 @end deffn
 
address@hidden {Scheme Procedure} screen-locker-service @var{package} 
address@hidden
+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:
+
address@hidden
+(screen-locker-service xlockmore "xlock")
address@hidden lisp
+
+makes the good ol' XlockMore usable.
address@hidden deffn
+
+
 @node 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.
 
 In particular, it adds a graphical login manager (@pxref{X Window,
address@hidden), a network management tool (@pxref{Networking
address@hidden), screen lockers,
+a network management tool (@pxref{Networking
 Services, @code{wicd-service}}), energy and color management services,
 the @code{elogind} login and seat manager, the Polkit privilege service,
 the GeoClue location service, an NTP client (@pxref{Networking
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 69edc6d..f283008 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -34,6 +34,8 @@
   #:use-module (gnu packages gnome)
   #:use-module (gnu packages avahi)
   #:use-module (gnu packages polkit)
+  #:use-module (gnu packages xdisorg)
+  #:use-module (gnu packages suckless)
   #:use-module (guix records)
   #:use-module (guix packages)
   #:use-module (guix store)
@@ -643,6 +645,10 @@ when they log out."
   ;; List of services typically useful for a "desktop" use case.
   (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.
          (avahi-service)
          (wicd-service)
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 3a57891..639a541 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -32,16 +32,21 @@
   #: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
             xorg-start-command
             %default-slim-theme
             %default-slim-theme-name
-            slim-service))
+            slim-service
+
+            screen-locker-service-type
+            screen-locker-service))
 
 ;;; Commentary:
 ;;;
@@ -350,4 +355,52 @@ theme."
             (auto-login-session auto-login-session)
             (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:
+
address@hidden
+(screen-locker-service xlockmore \"xlock\")
address@hidden 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
diff --git a/gnu/system/linux.scm b/gnu/system/linux.scm
index cd14bc9..487d379 100644
--- a/gnu/system/linux.scm
+++ b/gnu/system/linux.scm
@@ -182,8 +182,7 @@ authenticate to run COMMAND."
           ;; These programs are setuid-root.
           (map (cut unix-pam-service <>
                     #:allow-empty-passwords? allow-empty-passwords?)
-               '("su" "passwd" "sudo"
-                 "xlock" "xscreensaver"))
+               '("su" "passwd" "sudo"))
 
           ;; These programs are not setuid-root, and we want root to be able
           ;; to run them without having to authenticate (notably because