diff --git a/doc/guix.texi b/doc/guix.texi index b5c08f5d9c..844f9fa75d 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 +@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 @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, -@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, 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 69edc6d9bb..f283008c4c 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 3a57891a96..639a541777 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 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 + (($ 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 diff --git a/gnu/system/linux.scm b/gnu/system/linux.scm index cd14bc97be..487d379e65 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