summaryrefslogtreecommitdiff
path: root/gnu/tests/base.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/tests/base.scm')
-rw-r--r--gnu/tests/base.scm297
1 files changed, 209 insertions, 88 deletions
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 0f19449508..4fe779802b 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -24,13 +24,16 @@
#:use-module (gnu system shadow)
#:use-module (gnu system vm)
#:use-module (gnu services)
+ #:use-module (gnu services mcron)
#:use-module (gnu services shepherd)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix packages)
#:use-module (srfi srfi-1)
- #:export (%test-basic-os))
+ #:export (run-basic-test
+ %test-basic-os
+ %test-mcron))
(define %simple-os
(operating-system
@@ -56,109 +59,227 @@
%base-user-accounts))))
+(define* (run-basic-test os command #:optional (name "basic"))
+ "Return a derivation called NAME that tests basic features of the OS started
+using COMMAND, a gexp that evaluates to a list of strings. Compare some
+properties of running system to what's declared in OS, an <operating-system>."
+ (define test
+ #~(begin
+ (use-modules (gnu build marionette)
+ (srfi srfi-1)
+ (srfi srfi-26)
+ (srfi srfi-64)
+ (ice-9 match))
+
+ (define marionette
+ (make-marionette #$command))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "basic")
+
+ (test-assert "uname"
+ (match (marionette-eval '(uname) marionette)
+ (#("Linux" host-name version _ architecture)
+ (and (string=? host-name
+ #$(operating-system-host-name os))
+ (string-prefix? #$(package-version
+ (operating-system-kernel os))
+ version)
+ (string-prefix? architecture %host-type)))))
+
+ (test-assert "shell and user commands"
+ ;; Is everything in $PATH?
+ (zero? (marionette-eval '(system "
+. /etc/profile
+set -e -x
+guix --version
+ls --version
+grep --version
+info --version")
+ marionette)))
+
+ (test-assert "accounts"
+ (let ((users (marionette-eval '(begin
+ (use-modules (ice-9 match))
+ (let loop ((result '()))
+ (match (getpw)
+ (#f (reverse result))
+ (x (loop (cons x result))))))
+ marionette)))
+ (lset= string=?
+ (map passwd:name users)
+ (list
+ #$@(map user-account-name
+ (operating-system-user-accounts os))))))
+
+ (test-assert "shepherd services"
+ (let ((services (marionette-eval '(begin
+ (use-modules (gnu services herd))
+ (call-with-values current-services
+ append))
+ marionette)))
+ (lset= eq?
+ (pk 'services services)
+ '(root #$@(operating-system-shepherd-service-names os)))))
+
+ (test-equal "login on tty1"
+ "root\n"
+ (begin
+ (marionette-control "sendkey ctrl-alt-f1" marionette)
+ ;; Wait for the 'term-tty1' service to be running (using
+ ;; 'start-service' is the simplest and most reliable way to do
+ ;; that.)
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'term-tty1))
+ marionette)
+
+ ;; Now we can type.
+ (marionette-type "root\n\nid -un > logged-in\n" marionette)
+
+ ;; It can take a while before the shell commands are executed.
+ (let loop ((i 0))
+ (unless (or (file-exists? "/root/logged-in") (> i 15))
+ (sleep 1)
+ (loop (+ i 1))))
+ (marionette-eval '(use-modules (rnrs io ports)) marionette)
+ (marionette-eval '(call-with-input-file "/root/logged-in"
+ get-string-all)
+ marionette)))
+
+ (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 name test
+ #:modules '((gnu build marionette))))
+
(define %test-basic-os
- ;; Monadic derivation that instruments %SIMPLE-OS, runs it in a VM, and runs
- ;; a series of basic functionality tests.
- (mlet* %store-monad ((os -> (marionette-operating-system
- %simple-os
- #:imported-modules '((gnu services herd)
- (guix combinators))))
- (run (system-qemu-image/shared-store-script
- os #:graphic? #f)))
+ (system-test
+ (name "basic")
+ (description
+ "Instrument %SIMPLE-OS, run it in a VM, and run a series of basic
+functionality tests.")
+ (value
+ (mlet* %store-monad ((os -> (marionette-operating-system
+ %simple-os
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+ (run (system-qemu-image/shared-store-script
+ os #:graphic? #f)))
+ ;; XXX: Add call to 'virtualized-operating-system' to get the exact same
+ ;; set of services as the OS produced by
+ ;; 'system-qemu-image/shared-store-script'.
+ (run-basic-test (virtualized-operating-system os '())
+ #~(list #$run))))))
+
+
+;;;
+;;; Mcron.
+;;;
+
+(define %mcron-os
+ ;; System with an mcron service, with one mcron job for "root" and one mcron
+ ;; job for an unprivileged user (note: #:user is an 'mcron2' thing.)
+ (let ((job1 #~(job next-second-from
+ (lambda ()
+ (call-with-output-file "witness"
+ (lambda (port)
+ (display (list (getuid) (getgid)) port))))))
+ (job2 #~(job next-second-from
+ (lambda ()
+ (call-with-output-file "witness"
+ (lambda (port)
+ (display (list (getuid) (getgid)) port))))
+ #:user "alice"))
+ (job3 #~(job next-second-from ;to test $PATH
+ "touch witness-touch")))
+ (operating-system
+ (inherit %simple-os)
+ (services (cons (mcron-service (list job1 job2 job3))
+ (operating-system-user-services %simple-os))))))
+
+(define (run-mcron-test name)
+ (mlet* %store-monad ((os -> (marionette-operating-system
+ %mcron-os
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+ (command (system-qemu-image/shared-store-script
+ os #:graphic? #f)))
(define test
#~(begin
(use-modules (gnu build marionette)
- (srfi srfi-1)
- (srfi srfi-26)
(srfi srfi-64)
(ice-9 match))
(define marionette
- (make-marionette (list #$run)))
+ (make-marionette (list #$command)))
+
+ (define (wait-for-file file)
+ ;; Wait until FILE exists in the guest; 'read' its content and
+ ;; return it.
+ (marionette-eval
+ `(let loop ((i 10))
+ (cond ((file-exists? ,file)
+ (call-with-input-file ,file read))
+ ((> i 0)
+ (sleep 1)
+ (loop (- i 1)))
+ (else
+ (error "file didn't show up" ,file))))
+ marionette))
(mkdir #$output)
(chdir #$output)
- (test-begin "basic")
+ (test-begin "mcron")
- (test-assert "uname"
- (match (marionette-eval '(uname) marionette)
- (#("Linux" "komputilo" version _ "x86_64")
- (string-prefix? #$(package-version
- (operating-system-kernel os))
- version))))
+ (test-eq "service running"
+ 'running!
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'mcron)
+ 'running!)
+ marionette))
- (test-assert "shell and user commands"
- ;; Is everything in $PATH?
- (zero? (marionette-eval '(system "
-. /etc/profile
-set -e -x
-guix --version
-ls --version
-grep --version
-info --version")
- marionette)))
-
- (test-assert "accounts"
- (let ((users (marionette-eval '(begin
- (use-modules (ice-9 match))
- (let loop ((result '()))
- (match (getpw)
- (#f (reverse result))
- (x (loop (cons x result))))))
- marionette)))
- (lset= string=?
- (map passwd:name users)
- (list
- #$@(map user-account-name
- (operating-system-user-accounts os))))))
-
- (test-assert "shepherd services"
- (let ((services (marionette-eval '(begin
- (use-modules (gnu services herd))
- (call-with-values current-services
- append))
- marionette)))
- (lset= eq?
- (pk 'services services)
- '(root #$@(operating-system-shepherd-service-names
- (virtualized-operating-system os '()))))))
-
- (test-equal "login on tty1"
- "root\n"
- (begin
- (marionette-control "sendkey ctrl-alt-f1" marionette)
- ;; Wait for the 'term-tty1' service to be running (using
- ;; 'start-service' is the simplest and most reliable way to do
- ;; that.)
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'term-tty1))
- marionette)
-
- ;; Now we can type.
- (marionette-type "root\n\nid -un > logged-in\n" marionette)
-
- ;; It can take a while before the shell commands are executed.
- (let loop ((i 0))
- (unless (or (file-exists? "/root/logged-in") (> i 15))
- (sleep 1)
- (loop (+ i 1))))
- (marionette-eval '(use-modules (rnrs io ports)) marionette)
- (marionette-eval '(call-with-input-file "/root/logged-in"
- get-string-all)
- marionette)))
-
- (test-assert "screendump"
- (begin
- (marionette-control (string-append "screendump " #$output
- "/tty1.ppm")
- marionette)
- (file-exists? "tty1.ppm")))
+ ;; Make sure root's mcron job runs, has its cwd set to "/root", and
+ ;; runs with the right UID/GID.
+ (test-equal "root's job"
+ '(0 0)
+ (wait-for-file "/root/witness"))
+
+ ;; Likewise for Alice's job. We cannot know what its GID is since
+ ;; it's chosen by 'groupadd', but it's strictly positive.
+ (test-assert "alice's job"
+ (match (wait-for-file "/home/alice/witness")
+ ((1000 gid)
+ (>= gid 100))))
+
+ ;; Last, the job that uses a command; allows us to test whether
+ ;; $PATH is sane. (Note that 'marionette-eval' stringifies objects
+ ;; that don't have a read syntax, hence the string.)
+ (test-equal "root's job with command"
+ "#<eof>"
+ (wait-for-file "/root/witness-touch"))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0))))
- (gexp->derivation "basic" test
+ (gexp->derivation name test
#:modules '((gnu build marionette)))))
+
+(define %test-mcron
+ (system-test
+ (name "mcron")
+ (description "Make sure the mcron service works as advertised.")
+ (value (run-mcron-test name))))
generated by cgit v1.2.3 (git 2.45.2) at 2024-07-09 22:28:40 +0000