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:
		
							parent
							
								
									e502bf8953
								
							
						
					
					
						commit
						6726282b20
					
				
					 4 changed files with 76 additions and 4 deletions
				
			
		| 
						 | 
					@ -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
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -34,6 +34,8 @@
 | 
				
			||||||
  #: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 @@ when they log out."
 | 
				
			||||||
  ;; 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)
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -32,16 +32,21 @@
 | 
				
			||||||
  #: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 @@ theme."
 | 
				
			||||||
            (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
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -182,8 +182,7 @@ authenticate to run COMMAND."
 | 
				
			||||||
          ;; 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
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue