06/06: home: services: Add 'x11-display' service.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 08d94fe20eca47b69678b3eced8749dd02c700a4
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Aug 16 19:37:25 2023 +0200

    home: services: Add 'x11-display' service.
    
    * gnu/home/services/desktop.scm (x11-shepherd-service): New procedure.
    (home-x11-service-type): New variable.
    (redshift-shepherd-service): Add 'requirement' field.
    (home-redshift-service-type): Extend 'home-x11-service-type'.
    * doc/guix.texi (Desktop Home Services): Document it.
    
    Change-Id: Ibd46d71cbb80fcdff8dbf3e8dbcfc3b24163bdb6
---
 doc/guix.texi                 |  34 +++++++++++++
 gnu/home/services/desktop.scm | 109 ++++++++++++++++++++++++++++++++++++++----
 2 files changed, 135 insertions(+), 8 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index b90078be06..9f06f1c325 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -44475,6 +44475,40 @@ The @code{(gnu home services desktop)} module provides 
services that you
 may find useful on ``desktop'' systems running a graphical user
 environment such as Xorg.
 
+@cindex X Window, for Guix Home services
+@cindex X11, in Guix Home
+@defvar home-x11-service-type
+This is the service type representing the X Window graphical display
+server (also referred to as ``X11'').
+
+X Window is necessarily started by a system service; on Guix System,
+starting it is the responsibility of @code{gdm-service-type} and similar
+services (@pxref{X Window}).  At the level of Guix Home, as an
+unprivileged user, we cannot start X Window; 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-x11-service-type}.  Services that require an X Window
+graphical display, such as @code{home-redshift-service-type} below,
+instantiate it and depend on its corresponding @code{x11-display}
+Shepherd service (@pxref{Shepherd Home Service}).
+
+When X Window is running, the @code{x11-display} Shepherd service starts
+and sets the @env{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{DISPLAY},
+like so:
+
+@example
+herd start x11-display :3
+@end example
+
+In the example above, @code{x11-display} is instructed to set
+@env{DISPLAY} to @code{:3}.
+@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 c4da116100..91465bf168 100644
--- a/gnu/home/services/desktop.scm
+++ b/gnu/home/services/desktop.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022-2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2022 ( <paren@disroot.org>
 ;;; Copyright © 2023 conses <contact@conses.eu>
 ;;; Copyright © 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
@@ -30,7 +30,9 @@
   #:use-module (guix gexp)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
-  #:export (home-redshift-configuration
+  #:export (home-x11-service-type
+
+            home-redshift-configuration
             home-redshift-configuration?
             home-redshift-service-type
 
@@ -44,6 +46,79 @@
             home-xmodmap-service-type))
 
 
+;;;
+;;; Waiting for X11.
+;;;
+
+(define (x11-shepherd-service delay)
+  (list (shepherd-service
+         (provision '(x11-display))
+         (modules '((ice-9 ftw)
+                    (ice-9 match)
+                    (srfi srfi-1)))
+         (start
+          #~(lambda* (#:optional (display (getenv "DISPLAY")))
+              (define x11-directory
+                "/tmp/.X11-unix")
+
+              (define (find-display delay)
+                ;; Wait for an accessible socket to show up in X11-DIRECTORY,
+                ;; up to DELAY seconds.
+                (let loop ((attempts delay))
+                  (define socket
+                    (find (match-lambda
+                            ((or "." "..") #f)
+                            (name
+                             (let ((name (in-vicinity x11-directory
+                                                      name)))
+                               (access? name O_RDWR))))
+                          (or (scandir x11-directory) '())))
+
+                  (if (and socket (string-prefix? "X" socket))
+                      (let ((display (string-append
+                                      ":" (string-drop socket 1))))
+                        (format #t "X11 display server found at ~s.~%"
+                                display)
+                        display)
+                      (if (zero? attempts)
+                          (begin
+                            (format (current-error-port)
+                                    "X11 display 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 "DISPLAY" display))
+                display)))
+         (stop #~(lambda (_)
+                   (unsetenv "DISPLAY")
+                   #f))
+         (respawn? #f))))
+
+(define home-x11-service-type
+  (service-type
+   (name 'home-x11-display)
+   (extensions (list (service-extension home-shepherd-service-type
+                                        x11-shepherd-service)))
+   (default-value 10)
+   (description
+    "Create a @code{x11-display} Shepherd service that waits for the X
+Window (or ``X11'') graphical display server to be up and running, up to a
+configurable delay, and sets the @code{DISPLAY} environment variable of
+@command{shepherd} itself accordingly.  If no accessible X11 server shows up
+during that time, the @code{x11-display} service is marked as failing to
+start.")))
+
+
 ;;;
 ;;; Redshift.
 ;;;
@@ -169,11 +244,25 @@ format."))
   (list (shepherd-service
          (documentation "Redshift program.")
          (provision '(redshift))
-         ;; FIXME: This fails to start if Home is first activated from a
-         ;; non-X11 session.
-         (start #~(make-forkexec-constructor
-                   (list #$(file-append (home-redshift-configuration-redshift 
config) "/bin/redshift")
-                         "-c" #$config-file)))
+
+         ;; Depend on 'x11-display', which sets 'DISPLAY' if an X11 server is
+         ;; available, and fails to start otherwise.
+         (requirement '(x11-display))
+
+         (modules '((srfi srfi-1)
+                    (srfi srfi-26)))
+         (start #~(lambda _
+                    (fork+exec-command
+                     (list #$(file-append
+                              (home-redshift-configuration-redshift config)
+                              "/bin/redshift")
+                           "-c" #$config-file)
+
+                     ;; Inherit the 'DISPLAY' variable set by 'x11-display'.
+                     #:environment-variables
+                     (cons (string-append "DISPLAY=" (getenv "DISPLAY"))
+                           (remove (cut string-prefix? "DISPLAY=" <>)
+                                   (default-environment-variables))))))
          (stop #~(make-kill-destructor))
          (actions (list (shepherd-configuration-action config-file))))))
 
@@ -181,7 +270,11 @@ format."))
   (service-type
    (name 'home-redshift)
    (extensions (list (service-extension home-shepherd-service-type
-                                        redshift-shepherd-service)))
+                                        redshift-shepherd-service)
+                     ;; Ensure 'home-x11-service-type' is instantiated so we
+                     ;; can depend on the Shepherd 'x11-display' service.
+                     (service-extension home-x11-service-type
+                                        (const #t))))
    (default-value (home-redshift-configuration))
    (description
     "Run Redshift, a program that adjusts the color temperature of display