unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: "Ludovic Courtès" <ludo@gnu.org>
To: 65343@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludo@gnu.org>
Subject: [bug#65343] [PATCH] home: services: Add 'x11-display' service.
Date: Wed, 16 Aug 2023 19:43:51 +0200	[thread overview]
Message-ID: <b9fa2dae291ec797b1869cce7d74d59cf5299a03.1692207625.git.ludo@gnu.org> (raw)

* 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.
---
 doc/guix.texi                 | 22 ++++++++++
 gnu/home/services/desktop.scm | 82 ++++++++++++++++++++++++++++++++---
 2 files changed, 99 insertions(+), 5 deletions(-)

Hello Guix!

This is an attempt to fix a longstanding issue with Home services
that depend on X11: how can we make sure that (1) they are not started
when X is not running, and (2) they get the correct ‘DISPLAY’
variable.

It’s a bit of a hack (the idea came up during a discussion on IRC
a few days ago), but it does the job.  I guess it could be
extended to Wayland as well, but I’m not familiar with it.

Thoughts?

Ludo’.

diff --git a/doc/guix.texi b/doc/guix.texi
index 22590b4f9c..a99ef8e5e8 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -44067,6 +44067,28 @@ Desktop Home Services
 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
+@code{DISPLAY} environment variable of the @command{shepherd} process;
+otherwise, it fails to start.
+@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 626918fd9e..b293031fd1 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 @@ (define-module (gnu home services desktop)
   #: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
 
@@ -43,6 +45,69 @@ (define-module (gnu home services desktop)
             home-xmodmap-configuration
             home-xmodmap-service-type))
 
+\f
+;;;
+;;; 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 ()
+                    (define x11-directory
+                      "/tmp/.X11-unix")
+
+                    ;; 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)
+                            (setenv "DISPLAY" display)
+                            display)
+                          (if (zero? attempts)
+                              (begin
+                                (display
+                                 "X11 display server did not show up; \
+giving up.\n"
+                                 (current-error-port))
+                                #f)
+                              (begin
+                                (sleep 1)
+                                (loop (- attempts 1))))))))
+         (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 5)
+   (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.")))
+
 \f
 ;;;
 ;;; Redshift.
@@ -169,8 +234,11 @@ (define (redshift-shepherd-service config)
   (list (shepherd-service
          (documentation "Redshift program.")
          (provision '(redshift))
-         ;; FIXME: This fails to start if Home is first activated from a
-         ;; non-X11 session.
+
+         ;; Depend on 'x11-display', which sets 'DISPLAY' if an X11 server is
+         ;; available, and fails to start otherwise.
+         (requirement '(x11-display))
+
          (start #~(make-forkexec-constructor
                    (list #$(file-append redshift "/bin/redshift")
                          "-c" #$config-file)))
@@ -181,7 +249,11 @@ (define home-redshift-service-type
   (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

base-commit: 880ada0bdb9e694573ec42200d48658b27744b9b
-- 
2.41.0





             reply	other threads:[~2023-08-16 17:45 UTC|newest]

Thread overview: 9+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2023-08-16 17:43 Ludovic Courtès [this message]
2023-08-16 19:03 ` [bug#65343] [PATCH] home: services: Add 'x11-display' service Oleg Pykhalov
2023-08-16 20:55   ` Brian Cully via Guix-patches via
2023-09-05 12:00     ` Andrew Tropin
2023-09-14 20:38     ` Ludovic Courtès
2023-09-14 22:39       ` Oleg Pykhalov
2023-10-20 21:09         ` [bug#65343] [PATCH v2] " Ludovic Courtès
2023-11-03 16:58           ` Oleg Pykhalov
2023-11-05 22:30             ` Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=b9fa2dae291ec797b1869cce7d74d59cf5299a03.1692207625.git.ludo@gnu.org \
    --to=ludo@gnu.org \
    --cc=65343@debbugs.gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).