bug#57071: Xscreensaver not working since latest patch

[Ludovic Courtès]

Heya,

Ludovic Courtès <ludo@gnu.org> skribis:

> Rick Huijzer <ikbenrickhuyzer@gmail.com> skribis:
>
>> It seems that xscreensaver-auth needs to be setuid instead of the main
>> xscreensaver binary. The screen-locker-service in xorg.scm sets the
>> provided package setuid and sets the required pam configuration for the
>> provided package. The problem is that the pam configuration needs to be set
>> for xscreensaver (/etc/pam.d/xscreensaver) and setuid needs to be set for
>> xscreensaver-auth.
>>
>> Interestingly when I setuid xscreensaver-auth manually I run into the
>> following when unlocking:
>> Aug 10 13:35:02 localhost unix_chkpwd[2197]: check pass; user unknown
>> Aug 10 13:35:02 localhost unix_chkpwd[2197]: password check failed for user
>> (rhuijzer)
>> Aug 10 13:35:02 localhost xscreensaver-auth: pam_unix(xscreensaver:auth):
>> authentication failure; logname= uid=1000 euid=1000 tty=:0 ruser= rhost=
>>  user=rhuijzer
>>
>> But this might be fixed in time by [RFC PATCH] gnu: linux-pam: Change path
>> to unix_chkpwd helper <https://issues.guix.gnu.org/53468>.
>>
>> I don't know how to fix this elegantly, maybe create a dedicated service
>> for xscreensaver instead of the standard screen-locker-service?
>
> Yes, either that or a special case in ‘screen-locker-service’.

With the attached patch I can make ‘xscreensaver-auth’ setuid-root
(which is optional: it’s needed to tweak OOM behavior) while keeping the
‘xscreensaver’ PAM entry that’s needed.

However, authentication’s still failing due to ‘unix_chkpwd’ not working
on current ‘master’ where <https://issues.guix.gnu.org/53468> is
missing.

Ideas on how to work around that?  It’s not clear to me how
‘unix_chkpwd’ ends up being invoked in the first place…

Thanks,
Ludo’.

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 <wingo@igalia.com>
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès 
<ludo@gnu.org>
+;;; Copyright © 2013-2017, 2019-2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
 ;;; Copyright © 2018, 2019 Timothy Sample <samplet@ngyro.com>
 ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
@@ -680,12 +680,26 @@ (define slim-service-type
 ;;;
 
 (define-record-type <screen-locker>
-  (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
     (($ <screen-locker> 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))