~ruther/guix-local

08d94fe20eca47b69678b3eced8749dd02c700a4 — Ludovic Courtès 2 years ago 331d858
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
2 files changed, 135 insertions(+), 8 deletions(-)

M doc/guix.texi
M gnu/home/services/desktop.scm
M doc/guix.texi => doc/guix.texi +34 -0
@@ 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

M gnu/home/services/desktop.scm => gnu/home/services/desktop.scm +101 -8
@@ 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



@@ 45,6 47,79 @@


;;;
;;; 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