diff --git a/gnu/packages/xdisorg.scm b/gnu/packages/xdisorg.scm index 7be995a438..72698aa28a 100644 --- a/gnu/packages/xdisorg.scm +++ b/gnu/packages/xdisorg.scm @@ -1655,8 +1655,16 @@ (define-public xscreensaver (lambda _ (substitute* '("driver/Makefile.in" "po/Makefile.in.in") (("@GTK_DATADIR@") "@datadir@") - (("@PO_DATADIR@") "@datadir@")) - #t))) + (("@PO_DATADIR@") "@datadir@")))) + (add-before 'configure 'adjust-default-path + (lambda _ + ;; On Guix System, give higher precedence to the setuid-root + ;; 'xscreensaver-auth' program compared to the one that lives in + ;; $libexecdir. This modifies code in the 'hack_environment' + ;; function, which changes $PATH. + (substitute* "driver/xscreensaver.c" + (("= DEFAULT_PATH_PREFIX") + "= \"/run/setuid-programs:\" DEFAULT_PATH_PREFIX"))))) #:configure-flags '("--with-pam" ;; Don't check /proc/interrupts in the build @@ -1704,7 +1712,11 @@ (define-public xscreensaver (license (license:non-copyleft (string-append "http://metadata.ftp-master.debian.org/changelogs/" - "/main/x/xscreensaver/xscreensaver_5.36-1_copyright"))))) + "/main/x/xscreensaver/xscreensaver_5.36-1_copyright"))) + (properties + ;; Tell 'screen-locker-service' which program should be setuid-root. + '((screen-locker-setuid-program + . "libexec/xscreensaver/xscreensaver-auth"))))) (define-public xssproxy (package diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index 0cbd9aa53b..8f99c0f023 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Andy Wingo -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès +;;; Copyright © 2013-2017, 2019-2020, 2022 Ludovic Courtès ;;; Copyright © 2015 Sou Bunnbu ;;; Copyright © 2018, 2019 Timothy Sample ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen @@ -680,12 +680,26 @@ (define slim-service-type ;;; (define-record-type - (screen-locker name program empty?) + (screen-locker name package empty?) screen-locker? (name screen-locker-name) ;string - (program screen-locker-program) ;gexp + (package screen-locker-package) ;file-like (empty? screen-locker-allows-empty-passwords?)) ;Boolean +(define (screen-locker-setuid-program-name locker) + "Return the name of the setuid program of LOCKER. It's usually LOCKER's +name but it might differ in some cases--e.g., 'xscreensaver-auth' for +XScreenSaver." + (let ((package (screen-locker-package locker))) + (or (and (package? package) + (assoc-ref (package-properties package) + 'screen-locker-setuid-program)) + (string-append "bin/" (screen-locker-name locker))))) + +(define (screen-locker-setuid-program locker) + (file-append (screen-locker-package locker) "/" + (screen-locker-setuid-program-name locker))) + (define screen-locker-pam-services (match-lambda (($ name _ empty?) @@ -693,7 +707,16 @@ (define screen-locker-pam-services #:allow-empty-passwords? empty?))))) (define screen-locker-setuid-programs - (compose list file-like->setuid-program screen-locker-program)) + (compose list file-like->setuid-program screen-locker-setuid-program)) + +(define (screen-locker-profile-entries locker) + ;; If LOCKER's program is setuid (e.g., 'slock'), then no need to add it to + ;; the main profile since it's already in /run/setuid-programs. Otherwise + ;; (e.g., 'xscreensaver-auth'), add it to the profile. + (if (string=? (screen-locker-setuid-program-name locker) + (string-append "bin/" (screen-locker-name locker))) + '() + (list (screen-locker-package locker)))) (define screen-locker-service-type (service-type (name 'screen-locker) @@ -701,7 +724,9 @@ (define screen-locker-service-type (list (service-extension pam-root-service-type screen-locker-pam-services) (service-extension setuid-program-service-type - screen-locker-setuid-programs))) + screen-locker-setuid-programs) + (service-extension profile-service-type + screen-locker-profile-entries))) (description "Allow the given program to be used as a screen locker for the graphical server by making it setuid-root, so it can authenticate users, @@ -721,8 +746,7 @@ (define* (screen-locker-service package makes the good ol' XlockMore usable." (service screen-locker-service-type - (screen-locker program - (file-append package "/bin/" program) + (screen-locker program package allow-empty-passwords?))) diff --git a/gnu/system/examples/lightweight-desktop.tmpl b/gnu/system/examples/lightweight-desktop.tmpl index d4330ecc8e..1ab6ecd4d2 100644 --- a/gnu/system/examples/lightweight-desktop.tmpl +++ b/gnu/system/examples/lightweight-desktop.tmpl @@ -3,9 +3,9 @@ ;; environments. (use-modules (gnu) (gnu system nss)) -(use-service-modules desktop) +(use-service-modules desktop xorg) (use-package-modules bootloaders certs emacs emacs-xyz ratpoison suckless wm - xorg) + xdisorg xorg) (operating-system (host-name "antelope") @@ -53,7 +53,9 @@ ;; Use the "desktop" services, which include the X11 ;; log-in service, networking with NetworkManager, and more. - (services %desktop-services) + (services (append (list (screen-locker-service slock) + (screen-locker-service xscreensaver)) + %desktop-services)) ;; Allow resolution of '.local' host names with mDNS. (name-service-switch %mdns-host-lookup-nss))