diff options
| -rw-r--r-- | doc/guix.texi | 11 | ||||
| -rw-r--r-- | gnu/services/xorg.scm | 80 |
2 files changed, 90 insertions, 1 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index c1ff049f03..e59827d2bb 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -123,7 +123,7 @@ Copyright @copyright{} 2023 Foundation Devices, Inc.@* Copyright @copyright{} 2023 Thomas Ieong@* Copyright @copyright{} 2023 Saku Laesvuori@* Copyright @copyright{} 2023 Graham James Addis@* -Copyright @copyright{} 2023 Tomas Volf@* +Copyright @copyright{} 2023, 2024 Tomas Volf@* Copyright @copyright{} 2024 Herman Rimm@* Copyright @copyright{} 2024 Matthew Trzcinski@* Copyright @copyright{} 2024 Richard Sent@* @@ -23623,6 +23623,15 @@ in @var{config}, are available. The result should be used in place of Usually the X server is started by a login manager. @end deffn +@deffn {Procedure} xorg-start-command-xinit [config] +Return a @code{startx} script in which the modules, fonts, +etc. specified in @var{config} are available. The result should be used +in place of @code{startx} and should be invoked by the user from a tty +after login. Unlike @code{xorg-start-command}, this script calls +xinit. Therefore it works well when executed from a tty. If you are +using a desktop environment, you are unlikely to need this procedure. +@end deffn + @defvar screen-locker-service-type Type for a service that adds a package for a screen locker or screen diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index 51d704439e..0b9803c425 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -15,6 +15,7 @@ ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2023 muradm <mail@muradm.net> ;;; Copyright © 2024 Zheng Junjie <873216071@qq.com> +;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz> ;;; ;;; This file is part of GNU Guix. ;;; @@ -54,11 +55,13 @@ #:use-module (gnu packages gnome) #:use-module (gnu packages admin) #:use-module (gnu packages bash) + #:use-module (gnu packages linux) #:use-module (gnu system shadow) #:use-module (guix build-system glib-or-gtk) #:use-module (guix build-system trivial) #:use-module (guix gexp) #:use-module (guix store) + #:use-module ((guix modules) #:select (source-module-closure)) #:use-module (guix packages) #:use-module (guix derivations) #:use-module (guix records) @@ -86,6 +89,7 @@ xorg-wrapper xorg-start-command + xorg-start-command-xinit xinitrc xorg-server-service-type @@ -416,6 +420,82 @@ in @var{config}, are available. The result should be used in place of (program-file "startx" exp)) +(define* (xorg-start-command-xinit #:optional (config (xorg-configuration))) + "Return a @code{startx} script in which the modules, fonts, etc. specified +in @var{config}, are available. The result should be used in place of +@code{startx}. Compared to the @code{xorg-start-command} it calls xinit, +therefore it works well when executed from tty." + (define X + (xorg-wrapper config)) + + (define exp + ;; Small wrapper providing subset of functionality of typical startx + ;; script from distributions like alpine. + (with-imported-modules (source-module-closure '((guix build utils))) + #~(begin + (use-modules (guix build utils) + (ice-9 popen) + (ice-9 textual-ports)) + + (define (capture-stdout . prog+args) + (let* ((port (apply open-pipe* OPEN_READ prog+args)) + (data (get-string-all port))) + (if (zero? (status:exit-val (close-pipe port))) + (string-trim-right data #\newline) + (error "Command failed: " prog+args)))) + + (define (determine-unused-display n) + (let ((lock-file (format #f "/tmp/.X~a-lock" n)) + (sock-file (format #f "/tmp/.X11-unix/X~a" n))) + (if (or (file-exists? lock-file) + (false-if-exception + (eq? 'socket (stat:type (stat sock-file))))) + (determine-unused-display (+ n 1)) + (format #f ":~a" n)))) + (define (determine-vty) + (let ((fd0 (readlink "/proc/self/fd/0")) + (pref "/dev/tty")) + (if (string-prefix? pref fd0) + (string-append "vt" (substring fd0 (string-length pref))) + (error (format #f "Cannot determine VT from: ~a" fd0))))) + + (define (enable-xauth server-auth-file display) + ;; Configure and enable X authority + (or (getenv "XAUTHORITY") + (setenv "XAUTHORITY" (string-append (getenv "HOME") "/.Xauthority"))) + + (let* ((bin/xauth #$(file-append xauth "/bin/xauth")) + (bin/mcookie #$(file-append util-linux "/bin/mcookie")) + (mcookie (capture-stdout bin/mcookie))) + (invoke bin/xauth "-qf" server-auth-file + "add" display "." mcookie) + (invoke bin/xauth "-q" + "add" display "." mcookie))) + + (let* ((xinit #$(file-append xinit "/bin/xinit")) + (display (determine-unused-display 0)) + (vty (determine-vty)) + (server-auth-port (mkstemp "/tmp/serverauth.XXXXXX")) + (server-auth-file (port-filename server-auth-port))) + (close-port server-auth-port) + (enable-xauth server-auth-file display) + (apply execl + xinit + xinit + "--" + #$X + display + vty + "-keeptty" + "-auth" server-auth-file + ;; These are set by xorg-start-command, so do the same to keep + ;; it consistent. + "-logverbose" "-verbose" "-terminate" + #$@(xorg-configuration-server-arguments config) + (cdr (command-line))))))) + + (program-file "startx" exp)) + (define* (xinitrc #:key fallback-session) "Return a system-wide xinitrc script that starts the specified X session, which should be passed to this script as the first argument. If not, the |