[bug#63652] [PATCH] services: screen-locker-service-type: Configurable PAM and setuid.

[muradm <mail@muradm.net>]

screen-locker-service-type by default does both define PAM entry
and make program setuid binary. Normally both methods are
mutually exclusive, if binary has setuid set it does not really
needs PAM, otherway around also similar, if PAM is enabled
binary should not relay on setuid.

Recent swaylock package now compiled with PAM support. When PAM
support is compiled in, swaylock rejects executing if binary is
also setuid program.

This change turns screen-locker-configuration from strict
PAM AND setuid to more flexible PAM AND/OR setuid. Allowing
swaylock to be configured properly while supporting other
screen locker preferences.

* gnu/services/xorg.scm (screen-locker-configuration): Switch from
define-record-type to define-configuration.
[using-pam?]: New field to control PAM entry existence.
[using-setuid?]: New field to control setuid binary existence.
(screen-locker-pam-services): Should not make unix-pam-service if
using-pam? is set to #f.
(screen-locker-setuid-programs): Should not make program setuid
program if using-setuid? is set to #f.
(screen-locker-generate-doc): Internal function to generate
configuration documentation.
(screen-locker-service): Adapt to new screen-locker-configuration.
* gnu/services/desktop.scm (desktop-services-for-system): Adapt to
new screen-locker-configuration.
* doc/guix.texi: Reflect new changes to screen-locker-configuration.
---
 doc/guix.texi            | 32 +++++++++++++++++++----
 gnu/services/desktop.scm |  8 ++++--
 gnu/services/xorg.scm    | 55 ++++++++++++++++++++++++++++------------
 3 files changed, 72 insertions(+), 23 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index f4cca66d76..079afaeba5 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -22474,9 +22474,14 @@ X Window
 
 @defvar screen-locker-service-type
 Type for a service that adds a package for a screen locker or screen
-saver to the set of setuid programs and add a PAM entry for it.  The
+saver to the set of setuid programs and/or add a PAM entry for it.  The
 value for this service is a @code{<screen-locker-configuration>} object.
 
+While default behavior is to setup both setuid program and PAM entry,
+they are effectively mutually exclusive.  Screen locker programs may
+prevent executing when PAM is configured, and @code{setuid} is set on
+executable.  Then @code{using-setuid?} can be set to @code{#f}.
+
 For example, to make XlockMore usable:
 
 @lisp
@@ -22486,25 +22491,42 @@ X Window
 @end lisp
 
 makes the good ol' XlockMore usable.
+
+For example, swaylock fails to execute when compiled with PAM support
+and setuid enabled, then one can disable setuid:
+
+@lisp
+(service screen-locker-service-type
+         (screen-locker-configuration
+           "swaylock" (file-append xlockmore "/bin/xlock") #f #t #f))
+@end lisp
+
 @end defvar
 
 @deftp {Data Type} screen-locker-configuration
-Data type representing the configuration of
-@code{screen-locker-service-type}.
+Available @code{screen-locker-configuration} fields are:
 
 @table @asis
 @item @code{name} (type: string)
 Name of the screen locker.
 
-@item @code{program} (type: gexp)
+@item @code{program} (type: file-like)
 Path to the executable for the screen locker as a G-Expression.
 
-@item @code{allow-empty-password?} (type: boolean)
+@item @code{allow-empty-password?} (default: @code{#f}) (type: boolean)
 Whether to allow empty passwords.
 
+@item @code{using-pam?} (default: @code{#t}) (type: boolean)
+Whether to setup PAM entry.
+
+@item @code{using-setuid?} (default: @code{#t}) (type: boolean)
+Whether to setup program as setuid binary.
+
 @end table
+
 @end deftp
 
+
 @node Printing Services
 @subsection Printing Services
 
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 64eac1117d..639e99ff79 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -1839,10 +1839,14 @@ (define* (desktop-services-for-system #:optional
          ;; Screen lockers are a pretty useful thing and these are small.
          (service screen-locker-service-type
                   (screen-locker-configuration
-                   "slock" (file-append slock "/bin/slock") #f))
+                   (name "slock")
+                   (program (file-append slock "/bin/slock"))
+                   (allow-empty-password? #f)))
          (service screen-locker-service-type
                   (screen-locker-configuration
-                   "xlock" (file-append xlockmore "/bin/xlock") #f))
+                   (name "xlock")
+                   (program (file-append xlock "/bin/xlock"))
+                   (allow-empty-password? #f)))
 
          ;; Add udev rules for MTP devices so that non-root users can access
          ;; them.
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 8b6080fd26..b6c1636660 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -13,6 +13,7 @@
 ;;; Copyright © 2021 Josselin Poiret <josselin.poiret@protonmail.ch>
 ;;; Copyright © 2022 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2023 muradm <mail@muradm.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -112,6 +113,8 @@ (define-module (gnu services xorg)
             screen-locker-configuration-name
             screen-locker-configuration-program
             screen-locker-configuration-allow-empty-password?
+            screen-locker-configuration-using-pam?
+            screen-locker-configuration-using-setuid?
             screen-locker-service-type
             screen-locker-service  ; deprecated
 
@@ -703,13 +706,22 @@ (define slim-service-type
 ;;; Screen lockers & co.
 ;;;
 
-(define-record-type <screen-locker-configuration>
-  (screen-locker-configuration name program allow-empty-password?)
-  screen-locker-configuration?
-  (name    screen-locker-configuration-name)           ;string
-  (program screen-locker-configuration-program)        ;gexp
+(define-configuration/no-serialization screen-locker-configuration
+  (name
+   string
+   "Name of the screen locker.")
+  (program
+   file-like
+   "Path to the executable for the screen locker as a G-Expression.")
   (allow-empty-password?
-   screen-locker-configuration-allow-empty-password?)) ;Boolean
+   (boolean #f)
+   "Whether to allow empty passwords.")
+  (using-pam?
+   (boolean #t)
+   "Whether to setup PAM entry.")
+  (using-setuid?
+   (boolean #t)
+   "Whether to setup program as setuid binary."))
 
 (define-deprecated/public-alias
   screen-locker
@@ -719,14 +731,21 @@ (define-deprecated/public-alias
   screen-locker?
   screen-locker-configuration?)
 
-(define screen-locker-pam-services
-  (match-lambda
-    (($ <screen-locker-configuration> name _ empty?)
-     (list (unix-pam-service name
-                             #:allow-empty-passwords? empty?)))))
+(define (screen-locker-pam-services config)
+  (match-record config <screen-locker-configuration>
+    (name allow-empty-password? using-pam?)
+    (if using-pam?
+        (list (unix-pam-service name
+                                #:allow-empty-passwords?
+                                allow-empty-password?))
+        '())))
 
-(define screen-locker-setuid-programs
-  (compose list file-like->setuid-program screen-locker-configuration-program))
+(define (screen-locker-setuid-programs config)
+  (match-record config <screen-locker-configuration>
+    (name program using-setuid?)
+    (if using-setuid?
+        (list (file-like->setuid-program program))
+        '())))
 
 (define screen-locker-service-type
   (service-type (name 'screen-locker)
@@ -740,6 +759,9 @@ (define screen-locker-service-type
 the graphical server by making it setuid-root, so it can authenticate users,
 and by creating a PAM service for it.")))
 
+(define (screen-locker-generate-doc)
+  (configuration->documentation 'screen-locker-configuration))
+
 (define-deprecated (screen-locker-service package
                                           #:optional
                                           (program (package-name package))
@@ -755,9 +777,10 @@ (define-deprecated (screen-locker-service package
 
 makes the good ol' XlockMore usable."
   (service screen-locker-service-type
-           (screen-locker-configuration program
-                                        (file-append package "/bin/" program)
-                                        allow-empty-passwords?)))
+           (screen-locker-configuration
+            (name program)
+            (program (file-append package "/bin/" program))
+            (allow-empty-password? allow-empty-passwords?))))
 
 \f
 ;;;

base-commit: dff1689bb37e5303868584d3f1d7a33cbcb7f51e
-- 
2.40.1