summary refs log tree commit diff
path: root/gnu/services/xorg.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services/xorg.scm')
-rw-r--r--gnu/services/xorg.scm205
1 files changed, 190 insertions, 15 deletions
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 3ff290c197..7f1f0bb581 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -12,6 +12,7 @@
 ;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2021 Josselin Poiret <josselin.poiret@protonmail.ch>
 ;;; Copyright © 2022 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,6 +33,7 @@
   #:autoload   (gnu services sddm) (sddm-service-type)
   #:use-module (gnu artwork)
   #:use-module (gnu services)
+  #:use-module (gnu services configuration)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system pam)
   #:use-module (gnu system setuid)
@@ -63,6 +65,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:export (xorg-configuration
             xorg-configuration?
@@ -113,6 +116,13 @@
             localed-configuration?
             localed-service-type
 
+            dconf-keyfile
+            dconf-profile
+            dconf-profile-name
+            dconf-profile-content
+            dconf-profile-keyfile
+            dconf-service-type
+
             gdm-configuration
             gdm-service-type
 
@@ -663,13 +673,7 @@ reboot_cmd " shepherd "/sbin/reboot\n"
                    (list (service-extension shepherd-root-service-type
                                             slim-shepherd-service)
                          (service-extension pam-root-service-type
-                                            slim-pam-service)
-
-                         ;; Unconditionally add xterm to the system profile, to
-                         ;; avoid bad surprises.
-                         (service-extension profile-service-type
-                                            (const (list xterm)))))
-
+                                            slim-pam-service)))
                   (default-value (slim-configuration))
                   (description
                    "Run the SLiM graphical login manager for X11."))))
@@ -804,6 +808,106 @@ the GNOME desktop environment.")
 
 
 ;;;
+;;; Dconf.
+;;;
+
+(define-maybe text-config)
+
+(define-configuration/no-serialization dconf-keyfile
+  (name string
+        "The file name of the associated keyfile, e.g. \"00-login-screen\".")
+  (content text-config "The content of the associated keyfile."))
+
+(define-configuration/no-serialization dconf-profile
+  (name string "The file name of the dconf system profile, which should match
+the name of a user for which the profile is to be used with.  To have the
+profile used, the environment variable \"DCONF_PROFILE\" should be set to the
+profile file, e.g.:
+@example
+ export DCONF_PROFILE=/etc/dconf/profile/gdm
+@end example")
+  (content maybe-text-config "The content of the Dconf profile.  Unless
+provided, it defaults to include the user database (\"user-db:NAME\") as well
+as the system database (\"system-db:NAME\"), which corresponds to the
+generated database, @file{/etc/dconf/db/NAME}.")
+  (keyfile dconf-keyfile "The keyfile associated with the profile"))
+
+(define dconf-profiles?
+  (list-of dconf-profile?))
+
+(define-configuration/no-serialization dconf-configuration
+  (profiles dconf-profiles "The list of <dconf-profile> objects to populate."))
+
+(define (dconf-profile->profile-file profile)
+  "Given PROFILE, a <dconf-profile> object, return a dconf profile file."
+  (let ((name (dconf-profile-name profile))
+        (content (dconf-profile-content profile)))
+    (apply mixed-text-file
+           name
+           (if (maybe-value-set? content)
+               (interpose content "\n" 'suffix)
+               (interpose (list (string-append "user-db:" name)
+                                (string-append "system-db:" name))
+                          "\n" 'suffix)))))
+
+(define (dconf-profile->db-keyfile profile)
+  "Given PROFILE, a <dconf-profile> object, return a dconf profile file."
+  (let ((keyfile (dconf-profile-keyfile profile)))
+    (apply mixed-text-file (dconf-keyfile-name keyfile)
+           (interpose (dconf-keyfile-content keyfile) "\n" 'suffix))))
+
+(define (dconf-profile->db-keyfile-dir profile)
+  "Wrap the keyfile in a directory, to satisfy 'dconf compile'."
+  (let ((name (dconf-profile-name profile))
+        (keyfile-name (dconf-keyfile-name (dconf-profile-keyfile profile))))
+    (computed-file name
+                   #~(begin
+                       (mkdir #$output)
+                       (symlink #$(dconf-profile->db-keyfile profile)
+                                (string-append #$output "/" #$keyfile-name))))))
+
+(define (dconf-profile->db profile)
+  "Compile the a <dconf-profile> object into a GVariant Database file."
+  (let ((name (dconf-profile-name profile)))
+    (computed-file
+     name
+     (with-imported-modules '((guix build utils))
+       #~(begin
+           (use-modules (guix build utils))
+           (setenv "DCONF_PROFILE" #$(dconf-profile->profile-file profile))
+           (invoke #$(file-append dconf "/bin/dconf") "compile"
+                   #$output #$(dconf-profile->db-keyfile-dir profile)))))))
+
+(define (dconf-profile->files profile)
+  "Given PROFILE, a <dconf-profile> object, return a dconf directory
+containing the associated profile, keyfile and database files to be assembled
+under /etc."
+  (let ((name (dconf-profile-name profile))
+        (keyfile-name (dconf-keyfile-name (dconf-profile-keyfile profile))))
+    (list (list (string-append "dconf/profile/" name)
+                (dconf-profile->profile-file profile))
+          (list (string-append "dconf/db/" name ".d/" keyfile-name)
+                (dconf-profile->db-keyfile profile))
+          (list (string-append "dconf/db/" name)
+                (dconf-profile->db profile)))))
+
+(define dconf-service-type
+  (service-type
+   (name 'dconf-profile)
+   (extensions
+    (list (service-extension etc-service-type
+                             (lambda (dconf-profiles)
+                               (append-map dconf-profile->files
+                                           dconf-profiles)))))
+   (compose concatenate)
+   (extend append)
+   (default-value '())
+   (description "Extend the @code{etc-service-type} to populate the file
+hierarchy under @file{/etc/dconf} with the <dconf-profile> objects provided as
+argument.")))
+
+
+;;;
 ;;; GNOME Desktop Manager.
 ;;;
 
@@ -876,6 +980,7 @@ the GNOME desktop environment.")
   (gdm gdm-configuration-gdm (default gdm))
   (allow-empty-passwords? gdm-configuration-allow-empty-passwords? (default #t))
   (auto-login? gdm-configuration-auto-login? (default #f))
+  (auto-suspend? gdm-configuration-auto-suspend? (default #t))
   (dbus-daemon gdm-configuration-dbus-daemon (default dbus-daemon-wrapper))
   (debug? gdm-configuration-debug? (default #f))
   (default-user gdm-configuration-default-user (default #f))
@@ -885,10 +990,36 @@ the GNOME desktop environment.")
                       (default (xorg-configuration)))
   (x-session gdm-configuration-x-session
              (default (xinitrc)))
+  (xdmcp? gdm-configuration-xdmcp?
+          (default #f))
   (wayland? gdm-configuration-wayland? (default #f))
   (wayland-session gdm-configuration-wayland-session
                    (default gdm-wayland-session-wrapper)))
 
+(define (gdm-dconf-profiles config)
+  (if (gdm-configuration-auto-suspend? config)
+      '()
+      ;; This custom gconf profile works around a lack of configuration option
+      ;; to disable auto-suspend when no users are physically logged in (see:
+      ;; https://gitlab.gnome.org/GNOME/gnome-control-center/-/issues/22).
+      (list (dconf-profile
+             (name "gdm")
+             (content (list #~(begin
+                                (use-modules (ice-9 textual-ports))
+                                (string-trim
+                                 (call-with-input-file
+                                     #$(file-append gdm "/share/dconf/profile/gdm")
+                                   get-string-all)))
+                            "system-db:gdm"))
+             (keyfile (dconf-keyfile
+                       (name "00-disable-suspend")
+                       (content
+                        (list "[org/gnome/settings-daemon/plugins/power]"
+                              "sleep-inactive-ac-type='nothing'"
+                              "sleep-inactive-battery-type='nothing'"
+                              "sleep-inactive-ac-timeout=0"
+                              "sleep-inactive-battery-timeout=0"))))))))
+
 (define (gdm-configuration-file config)
   (mixed-text-file "gdm-custom.conf"
                    "[daemon]\n"
@@ -913,18 +1044,20 @@ the GNOME desktop environment.")
                    ;; See also
                    ;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=39281>.
                    "InitialSetupEnable=false\n"
-                   "WaylandEnable=" (if (gdm-configuration-wayland? config)
-                                        "true"
-                                        "false") "\n"
+                   (format #f "WaylandEnable=~:[false~;true~]~%"
+                           (gdm-configuration-wayland? config))
                    "\n"
                    "[debug]\n"
-                   "Enable=" (if (gdm-configuration-debug? config)
-                                 "true"
-                                 "false") "\n"
+                   (format #f "Enable=~:[false~;true~]~%"
+                           (gdm-configuration-debug? config))
                    "\n"
                    "[security]\n"
                    "#DisallowTCP=true\n"
-                   "#AllowRemoteAutoLogin=false\n"))
+                   "#AllowRemoteAutoLogin=false\n"
+                   "\n"
+                   "[xdmcp]\n"
+                   (format #f "Enable=~:[false~;true~]~%"
+                           (gdm-configuration-xdmcp? config))))
 
 (define (gdm-pam-service config)
   "Return a PAM service for @command{gdm}."
@@ -959,7 +1092,10 @@ the GNOME desktop environment.")
                      (list #$(file-append (gdm-configuration-gdm config)
                                           "/bin/gdm"))
                      #:environment-variables
-                     (list (string-append
+                     (list #$@(if (gdm-configuration-auto-suspend? config)
+                                  #~()
+                                  #~("DCONF_PROFILE=/etc/dconf/profile/gdm"))
+                           (string-append
                             "GDM_CUSTOM_CONF="
                             #$(gdm-configuration-file config))
                            (string-append
@@ -995,6 +1131,41 @@ the GNOME desktop environment.")
          (stop #~(make-kill-destructor))
          (respawn? #t))))
 
+(define gdm-polkit-rules
+  (lambda (config)
+    (if (gdm-configuration-xdmcp? config)
+        ;; Allow remote (XDMCP) users to use colord; otherwise an
+        ;; authentication dialog would appear on the GDM screen (see the
+        ;; upstream bug:
+        ;; https://gitlab.gnome.org/GNOME/gnome-settings-daemon/-/issues/273).
+        (list (computed-file
+               "02-allow-colord.rules"
+               (with-imported-modules '((guix build utils))
+                 #~(begin
+                     (use-modules (guix build utils))
+
+                     (let* ((rules.d
+                             (string-append #$output
+                                            "/share/polkit-1"
+                                            "/rules.d"))
+                            (allow-colord.rules (string-append
+                                                 rules.d
+                                                 "/02-allow-colord.rules")))
+                       (mkdir-p rules.d)
+                       (call-with-output-file allow-colord.rules
+                         (lambda (port)
+                           ;; This workaround enables any local or remote in
+                           ;; the "users" group to use colord (see:
+                           ;; https://c-nergy.be/blog/?p=12073).
+                           (format port "\
+polkit.addRule(function(action, subject) {
+   if (action.id.match(\"org.freedesktop.color-manager\")) {
+      polkit.log(\"POLKIT DEBUG returning YES for action: \" + action);
+      return polkit.Result.YES;
+   }
+});~%"))))))))
+        '())))
+
 (define gdm-service-type
   (handle-xorg-configuration gdm-configuration
     (service-type (name 'gdm)
@@ -1003,8 +1174,12 @@ the GNOME desktop environment.")
                                             gdm-shepherd-service)
                          (service-extension account-service-type
                                             (const %gdm-accounts))
+                         (service-extension dconf-service-type
+                                            gdm-dconf-profiles)
                          (service-extension pam-root-service-type
                                             gdm-pam-service)
+                         (service-extension polkit-service-type
+                                            gdm-polkit-rules)
                          (service-extension profile-service-type
                                             gdm-configuration-gnome-shell-assets)
                          (service-extension dbus-root-service-type