@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 muradm <mail@muradm.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -19,12 +20,15 @@
(define-module (gnu tests desktop)
#:use-module (gnu tests)
#:use-module (gnu services)
+ #:use-module (gnu services base)
#:use-module (gnu services dbus)
#:use-module (gnu services desktop)
+ #:use-module (gnu system)
#:use-module (gnu system vm)
#:use-module (guix gexp)
#:use-module (srfi srfi-1)
- #:export (%test-elogind))
+ #:export (%test-elogind
+ %test-minimal-desktop))
;;;
@@ -103,3 +107,188 @@
#:imported-modules '((gnu services herd)
(guix combinators)))))
(run-elogind-test (virtual-machine os))))))
+
+
+;;;
+;;; Seatd/greetd based minimal desktop
+;;;
+
+(define %minimal-services
+ (append
+ (list
+ (service seatd-service-type)
+ (service greetd-service-type
+ (greetd-configuration
+ (terminals
+ (list
+ (greetd-terminal-configuration (terminal-vt "1"))
+ (greetd-terminal-configuration (terminal-vt "2"))
+ (greetd-terminal-configuration (terminal-vt "3"))
+ (greetd-terminal-configuration (terminal-vt "4"))
+ (greetd-terminal-configuration (terminal-vt "5"))
+ (greetd-terminal-configuration (terminal-vt "6")))))))
+ (modify-services %base-services
+ (delete login-service-type)
+ (delete mingetty-service-type))))
+
+(define-syntax-rule (minimal-operating-system user-services ...)
+ "Return an operating system that includes USER-SERVICES in addition to
+minimal %BASE-SERVICES."
+ (operating-system (inherit %simple-os)
+ (services (cons* user-services ... %minimal-services))))
+
+(define (run-minimal-desktop-test os vm)
+ (define test
+ (with-imported-modules '((gnu build marionette)
+ (guix build syscalls))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (guix build syscalls)
+ (srfi srfi-1)
+ (srfi srfi-64)
+ (ice-9 pretty-print))
+
+ (define marionette
+ (make-marionette #$vm))
+
+ (define (file-get-all-strings fname)
+ (marionette-eval '(use-modules (rnrs io ports)) marionette)
+ (wait-for-file fname marionette #:read 'get-string-all))
+
+ (define (wait-for-unix-socket-m socket)
+ (wait-for-unix-socket socket marionette))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "minimal-desktop")
+
+ (test-assert "seatd is ready"
+ (wait-for-unix-socket-m "/run/seatd.sock"))
+
+ (test-equal "login user on tty1"
+ "alice\n"
+ (begin
+ ;; Wait for tty1.
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'term-tty1))
+ marionette)
+ (marionette-control "sendkey ctrl-alt-f1" marionette)
+
+ ;; login as root change alice password and exit
+ ;; then login as alice
+ (for-each
+ (lambda (cmd) (marionette-type cmd marionette) (sleep 1))
+ (list
+ "root\n"
+ "\n"
+ "passwd alice\n"
+ "alice\n"
+ "alice\n"
+ "exit\n"
+ "alice\n"
+ "alice\n"
+ "id -un > logged-in\n"))
+
+ (file-get-all-strings "/home/alice/logged-in")))
+
+ (test-equal "validate user environment"
+ '("SEATD_SOCK=/run/seatd.sock"
+ "XDG_RUNTIME_DIR=/run/user/1000"
+ "XDG_SEAT=seat0"
+ "XDG_VTNR=1")
+
+ (begin
+ (marionette-type "env > env\n" marionette)
+ (sleep 1)
+
+ (define user-env (string-tokenize
+ (file-get-all-strings "/home/alice/env")))
+
+ (define (expected-var var)
+ (any (lambda (s) (string-contains var s))
+ '("SEATD_SOCK"
+ "XDG_RUNTIME_DIR"
+ "XDG_SEAT"
+ "XDG_VTNR")))
+
+ (sort (filter expected-var user-env) string<?)))
+
+ (test-assert "validate SEATD_SOCK and GREETD_SOCK"
+ (begin
+ (marionette-type "env > env\n" marionette)
+ (sleep 1)
+
+ (define (sock-var? var)
+ (any (lambda (s) (string-contains var s))
+ '("SEATD_SOCK" "GREETD_SOCK")))
+
+ (define (sock-var-sock var)
+ (car (cdr (string-split var #\=))))
+
+ (let*
+ ((out (file-get-all-strings "/home/alice/env"))
+ (out (string-tokenize out))
+ (out (filter sock-var? out))
+ (socks (map sock-var-sock out))
+ (socks (map wait-for-unix-socket-m socks)))
+ (and (= 2 (length socks)) (every identity socks)))))
+
+ (test-assert "greetd is ready"
+ (begin
+ (marionette-type "ps -C greetd -o pid,args --no-headers > ps-greetd\n"
+ marionette)
+ (sleep 1)
+
+ (define (greetd-daemon? cmd)
+ (string-contains cmd "config"))
+
+ (define (greetd-cmd-to-pid cmd)
+ (car (string-split cmd #\space)))
+
+ (define (greetd-pid-to-sock pid)
+ (string-append "/run/greetd-" pid ".sock"))
+
+ (let* ((out (file-get-all-strings "/home/alice/ps-greetd"))
+ (out (string-split out #\newline))
+ (out (map string-trim-both out))
+ (out (filter greetd-daemon? out))
+ (pids (map greetd-cmd-to-pid out))
+ (socks (map greetd-pid-to-sock pids))
+ (socks (map wait-for-unix-socket-m socks)))
+ (every identity socks))))
+
+ ;; a bit weak, but tests everything at once actually
+ (test-equal "check /run/user/<uid> mounted and writable"
+ "alice\n"
+ (begin
+ (marionette-type "echo alice > /run/user/1000/test\n" marionette)
+ (file-get-all-strings "/run/user/1000/test")))
+
+ (test-assert "screendump"
+ (begin
+ (marionette-control (string-append "screendump " #$output
+ "/tty1.ppm")
+ marionette)
+ (file-exists? "tty1.ppm")))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation "minimal-desktop" test))
+
+(define %test-minimal-desktop
+ (system-test
+ (name "minimal-desktop")
+ (description
+ "Test whether we can log in when seatd and greetd is enabled")
+ (value
+ (let* ((os (marionette-operating-system
+ (minimal-operating-system)
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+ (vm (virtual-machine os)))
+ (run-minimal-desktop-test (virtualized-operating-system os '())
+ #~(list #$vm))))))