@@ -23561,6 +23561,24 @@ X Window
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}. Compared to the
+@code{xorg-start-command} it calls xinit, therefore it works well when
+executed from tty. If you are using a desktop environment, you are
+unlikely to have a need for this procedure.
+
+The resulting file should be invoked by user from the tty after login,
+common name for the program would be @code{startx}. Convenience link
+can be created by (for example) this home service:
+
+@lisp
+(simple-service 'home-files home-files-service-type
+ `(("bin/startx" ,(xorg-start-command-xinit))))
+@end lisp
+@end deffn
+
@defvar screen-locker-service-type
Type for a service that adds a package for a screen locker or screen
@@ -54,11 +54,13 @@ (define-module (gnu services xorg)
#: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 +88,7 @@ (define-module (gnu services xorg)
xorg-wrapper
xorg-start-command
+ xorg-start-command-xinit
xinitrc
xorg-server-service-type
@@ -416,6 +419,83 @@ (define* (xorg-start-command #:optional (config (xorg-configuration)))
(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 (= 0 (status:exit-val (close-pipe port)))
+ (string-trim-right data #\newline)
+ (error "command failed"))))
+
+ (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