Subject: [PATCH] gnu: home: services: Add 'wayland-display' service.

From: Sisiutl <[email-masked]>
Date: Sat, 1 Mar 2025 21:02:15 +0100

* gnu/home/services/desktop.scm (wayland-shepherd-service): New procedure.
(home-wayland-service-type): New variable.
* doc/guix.texi (Desktop Home Services): Document it.

Change-Id: Iab6be6cda732e30213bdddcb5c9a7e53814585d0
---
 doc/guix.texi                 | 36 ++++++++++++++++
 gnu/home/services/desktop.scm | 79 +++++++++++++++++++++++++++++++++++
 2 files changed, 115 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index bb5f29277f..36b86cffe1 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -47839,6 +47839,42 @@ In the example above, @code{x11-display} is instructed to set
 @env{DISPLAY} to @code{:3}.
 @end defvar
 
+@defvar home-wayland-service-type
+This is the service type representing a Wayland compositor.  It
+functions as an equivalent of @code{x11-service-type} for Wayland.
+
+Like X11, Wayland compositors are started by services like
+@code{gdm-service-type}, described in the system configuration.  At the
+level of Guix Home, as an unprivileged user, we cannot start our Wayland
+compositor; all we can do is check whether it is running.   This is what
+this service does.
+
+As a user, you probably don't need to worry or explicitly instantiate
+@code{home-wayland-service-type}.  Services that require an Wayland
+graphical display instantiate this service and depend on its
+corresponding @code{wayland-display} Shepherd service (@pxref{Shepherd
+Home Service}).
+
+If you're writing a Shepherd service that requires the presence of a
+Wayland compositor, you need to depend on this service to ensure Wayland
+is accessible from your service.
+
+When the Wayland compositor is running, the @code{wayland-display}
+Shepherd service starts and sets the @env{WAYLAND_DISPLAY} environment
+variable of the @command{shepherd} process, using its original value if
+it was already set; otherwise, it fails to start.
+
+The service can also be forced to use a given value for
+@env{WAYLAND_DISPLAY}, like so:
+
+@example
+herd start wayland-display wayland-2
+@end example
+
+In the example above, @code{wayland-display} is instructed to set
+@env{WAYLAND_DISPLAY} to @code{wayland-2}.
+@end defvar
+
 @defvar home-redshift-service-type
 This is the service type for @uref{https://github.com/jonls/redshift,
 Redshift}, a program that adjusts the display color temperature
diff --git a/gnu/home/services/desktop.scm b/gnu/home/services/desktop.scm
index fc96ce9295..d12014f997 100644
--- a/gnu/home/services/desktop.scm
+++ b/gnu/home/services/desktop.scm
@@ -33,6 +33,8 @@ (define-module (gnu home services desktop)
   #:use-module (ice-9 match)
   #:export (home-x11-service-type
 
+            home-wayland-service-type
+
             home-redshift-configuration
             home-redshift-configuration?
             home-redshift-service-type
@@ -121,6 +123,83 @@ (define home-x11-service-type
 during that time, the @code{x11-display} service is marked as failing to
 start.")))
 
+
+;;;
+;;; Waiting for Wayland.
+;;;
+
+(define (wayland-shepherd-service delay)
+  (list (shepherd-service
+         (provision '(wayland-display))
+         (modules '((ice-9 ftw)
+                    (ice-9 regex)
+                    (ice-9 match)
+                    (srfi srfi-1)
+                    (shepherd support)))
+         (start
+          #~(lambda* (#:optional (env-wayland-display (getenv "WAYLAND_DISPLAY")))
+
+              (define wayland-socket-regex "wayland-[0-9]+$")
+
+              (define (find-socket directory regex)
+                (find (match-lambda
+                        ((or "." "..") #f)
+                        (name
+                         (let ((name (in-vicinity directory
+                                                  name)))
+                           (and (string-match regex name)
+                                (access? name O_RDWR)))))
+                      ;; Wayland names its sockets ‘wayland-n’. With
+                      ;; ‘reverse’, we pick up on the last Wayland instance
+                      ;; created (essentially what we always want to do).
+                      (or (reverse (scandir directory)) '())))
+
+              (define (find-display delay)
+                (let loop ((attempts delay))
+
+                  (define wayland-display
+                    (or env-wayland-display
+                        (find-socket %user-runtime-dir "wayland-[0-9]+$")))
+
+                  (unless wayland-display
+                    (unless (zero? attempts)
+                      (sleep 1)
+                      (loop (- attempts 1)))
+
+                    (format (current-error-port)
+                            "Wayland server did not show up; giving up.\n"))
+
+                  wayland-display))
+
+              (when wayland-display
+                (format #t "Wayland display found at ~s.~%" wayland-display)
+                ;; Note: 'make-forkexec-constructor' calls take their
+                ;; default #:environment-variables value before this service
+                ;; is started and are thus unaffected by the 'setenv' call
+                ;; below.  Users of this service have to explicitly query
+                ;; its value.
+                (setenv "WAYLAND_DISPLAY" wayland-display))
+
+              wayland-display))
+
+         (stop #~(lambda (_)
+                   (unsetenv "WAYLAND_DISPLAY")
+                   #f))
+         (respawn? #f))))
+
+(define home-wayland-service-type
+  (service-type
+   (name 'home-wayland-display)
+   (extensions (list (service-extension home-shepherd-service-type
+                                        wayland-shepherd-service)))
+   (default-value 10)
+   (description
+    "Create a @code{wayland-display} Shepherd service that waits for a Wayland
+compositor to be up and running, up to a configurable delay, and sets the
+@code{WAYLAND_DISPLAY} environment variable of @command{shepherd} itself
+accordingly.  If no accessible Wayland server shows up during that time, the
+@code{wayland-display} service is marked as failing to start.")))
+
 
 ;;;
 ;;; Redshift.
-- 
2.48.1