aboutsummaryrefslogtreecommitdiff
path: root/gnu/build
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/build')
0 files changed, 0 insertions, 0 deletions
generated by cgit
'(begin (use-modules (gnu services herd)) (start-service 'term-tty1) (start-service 'elogind)) marionette) (marionette-control "sendkey ctrl-alt-f1" marionette) ;; Now we can type. (marionette-type "root\n" marionette) (marionette-type "loginctl list-users --no-legend > users\n" marionette) (marionette-type "loginctl list-seats --no-legend > seats\n" marionette) (marionette-type "loginctl list-sessions --no-legend > sessions\n" marionette) ;; Read the three files. (marionette-eval '(use-modules (rnrs io ports)) marionette) (let ((guest-file (lambda (file) (string-tokenize (wait-for-file file marionette #:read 'get-string-all))))) (list (guest-file "/root/sessions") (guest-file "/root/seats") (guest-file "/root/users"))))) (test-assert "screendump" (begin (let ((capture (string-append #$output "/tty1.ppm"))) (marionette-control (string-append "screendump " capture) marionette) (file-exists? capture)))) (test-end)))) (gexp->derivation "elogind" test)) (define %test-elogind (system-test (name "elogind") (description "Test whether we can log in when elogind is enabled, and whether 'loginctl' reports accurate user, session, and seat information.") (value (let ((os (marionette-operating-system (simple-operating-system (service elogind-service-type) (service polkit-service-type) (service dbus-root-service-type)) #:imported-modules '((gnu services herd) (guix combinators))))) (run-elogind-test (virtual-machine os)))))) ;;; ;;; Seatd/greetd based minimal desktop ;;; (define %minimal-services (append (modify-services %base-services ;; greetd-service-type provides "greetd" PAM service (delete login-service-type) ;; and can be used in place of mingetty-service-type (delete mingetty-service-type)) (list (service seatd-service-type) (service greetd-service-type (greetd-configuration (greeter-supplementary-groups '("input" "video")) (terminals (list ;; we can make any terminal active by default (greetd-terminal-configuration (terminal-vt "1") (terminal-switch #t)) ;; we can make environment without XDG_RUNTIME_DIR set ;; even provide our own environment variables (greetd-terminal-configuration (terminal-vt "2") (default-session-command (greetd-agreety-session (extra-env '(("MY_VAR" . "1"))) (xdg-env? #f)))) ;; we can use different shell instead of default bash (greetd-terminal-configuration (terminal-vt "3") (default-session-command (greetd-agreety-session (command (file-append zsh "/bin/zsh"))))) ;; we can use any other executable command as greeter (greetd-terminal-configuration (terminal-vt "4") (default-session-command (program-file "my-noop-greeter" #~(exit)))) (greetd-terminal-configuration (terminal-vt "5")) (greetd-terminal-configuration (terminal-vt "6")))))) ;; mingetty-service-type can be used in parallel ;; if needed to do so, do not (delete login-service-type) ;; as illustrated above #| (service mingetty-service-type (mingetty-configuration (tty "tty8"))) |#))) (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-runner-current (system-test-runner #$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" "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-equal "seatd.sock ownership" '("root" "seat") `(,(marionette-eval '(passwd:name (getpwuid (stat:uid (stat "/run/seatd.sock")))) marionette) ,(marionette-eval '(group:name (getgrgid (stat:gid (stat "/run/seatd.sock")))) marionette))) (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-equal "check greeter user has correct groups" "greeter input video\n" (begin (marionette-type "id -Gn greeter > /run/user/1000/greeter-groups\n" marionette) (file-get-all-strings "/run/user/1000/greeter-groups"))) (test-assert "screendump" (begin (marionette-control (string-append "screendump " #$output "/tty1.ppm") marionette) (file-exists? "tty1.ppm"))) (test-end)))) (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))))))
generated by cgit