2 files changed, 90 insertions(+), 1 deletions(-)

M doc/guix.texi
M gnu/services/xorg.scm

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

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