add wayland-display shepherd service

1 files changed, 72 insertions, 0 deletions

diff --git a/sigils/home/services/desktop.scm b/sigils/home/services/desktop.scm
new file mode 100644
index 0000000..388e1fa
--- /dev/null
+++ b/sigils/home/services/desktop.scm
@@ -0,0 +1,72 @@
+(define-module (sigils home services desktop)
+  #:use-module (guix gexp)
+  #:use-module (gnu home services)
+  #:use-module (gnu home services shepherd))
+
+(define (wayland-shepherd-service delay)
+  (list (shepherd-service
+         (provision '(wayland-display))
+         (modules '((ice-9 ftw)
+                    (ice-9 match)
+                    (ice-9 regex)
+                    (srfi srfi-1)))
+         (start
+          #~(lambda* (#:optional (display (getenv "WAYLAND_DISPLAY")))
+              (define xdg-runtime-directory
+                (or (getenv "XDG_RUNTIME_DIR")
+                    (string-append "/run/user" (getuid))))
+
+              (define (find-display delay)
+                ;; Wait for an accessible socket to show up in
+                ;; XDG-RUNTIME-DIRECTORY, up to DELAY seconds.
+                (let loop ((attempts delay))
+                  (define socket
+                    (find (match-lambda
+                            ((or "." "..") #f)
+                            (name
+                             (let ((name (in-vicinity xdg-runtime-directory
+                                                      name)))
+                               (and (string-match "wayland-[0-9]+" name)
+                                    (access? name O_RDWR)))))
+                          (or (scandir xdg-runtime-directory) '())))
+
+                  (if socket
+                      (begin
+                        (format #t "Wayland server found at ~s.~%" socket)
+                        socket)
+                      (if (zero? attempts)
+                          (begin
+                            (format (current-error-port)
+                                    "Wayland server did not show up; \
+giving up.\n")
+                            #f)
+                          (begin
+                            (sleep 1)
+                            (loop (- attempts 1)))))))
+
+              (let ((display (or display (find-display #$delay))))
+                (when 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" display))
+                display)))
+         (stop #~(lambda (_)
+                   (unsetenv "WAYLAND_DISPLAY")
+                   #f))
+         (respawn? #f))))
+
+(define-public 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.")))