tests: Add ‘guix-daemon’ test.

* gnu/tests/base.scm (manifest-entry-without-grafts): New procedure.
(%hello-dependencies-manifest): New variable.
(run-guix-daemon-test): New procedure.
(%test-guix-daemon): New variable.

Change-Id: Ia37966de1f61fb428e6fb2244271bf389a74af6d
This commit is contained in:
Ludovic Courtès 2025-02-27 11:51:49 +01:00
parent 75e3d34295
commit 9e07d889c4
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -34,6 +34,8 @@
#:use-module (gnu services networking)
#:use-module (gnu packages base)
#:use-module (gnu packages bash)
#:use-module (gnu packages bootstrap)
#:use-module (gnu packages guile)
#:use-module (gnu packages imagemagick)
#:use-module (gnu packages linux)
#:use-module (gnu packages ocr)
@ -45,6 +47,7 @@
#:use-module (guix monads)
#:use-module (guix modules)
#:use-module (guix packages)
#:use-module (guix profiles)
#:use-module (guix utils)
#:use-module ((srfi srfi-1) #:hide (partition))
#:use-module (ice-9 match)
@ -56,7 +59,8 @@
%test-halt
%test-root-unmount
%test-cleanup
%test-activation))
%test-activation
%test-guix-daemon))
(define %simple-os
(simple-operating-system))
@ -981,3 +985,188 @@ non-ASCII names from /tmp.")
(name "activation")
(description "Test that activation scripts are run in the correct order")
(value (run-activation-test name))))
;;;
;;; Build daemon.
;;;
(define (manifest-entry-without-grafts entry)
"Return ENTRY with grafts disabled on its contents."
(manifest-entry
(inherit entry)
(item (with-parameters ((%graft? #f))
(manifest-entry-item entry)))))
(define %hello-dependencies-manifest ;TODO: Share with (gnu tests foreign).
;; Build dependencies of 'hello' needed to test 'guix build hello'.
(concatenate-manifests
(list (map-manifest-entries
manifest-entry-without-grafts
(package->development-manifest hello))
;; Add the source of 'hello'.
(manifest
(list (manifest-entry
(name "hello-source")
(version (package-version hello))
(item (let ((file (origin-actual-file-name
(package-source hello))))
(computed-file
"hello-source"
#~(begin
;; Put the tarball in a subdirectory since
;; profile union crashes otherwise.
(mkdir #$output)
(mkdir (in-vicinity #$output "src"))
(symlink #$(package-source hello)
(in-vicinity #$output
(string-append "src/"
#$file))))))))))
;; Include 'guile-final', which is needed when building derivations
;; such as that of 'hello' but missing from the development manifest.
;; Add '%bootstrap-guile', used by 'guix install --bootstrap'.
(map-manifest-entries
manifest-entry-without-grafts
(packages->manifest (list (canonical-package guile-3.0)
%bootstrap-guile))))))
(define (run-guix-daemon-test os)
(define test-image
(image (operating-system os)
(format 'compressed-qcow2)
(volatile-root? #f)
(shared-store? #f)
(partition-table-type 'mbr)
(partitions
(list (partition
(size (* 4 (expt 2 30)))
(offset (* 512 2048)) ;leave room for GRUB
(flags '(boot))
(label "root"))))))
(define test
(with-imported-modules (source-module-closure
'((gnu build marionette)
(guix build utils)))
#~(begin
(use-modules (gnu build marionette)
(guix build utils)
(srfi srfi-64))
(define marionette
(make-marionette
(list (string-append #$qemu-minimal "/bin/" (qemu-command))
#$@(common-qemu-options (system-image test-image) '()
#:image-format "qcow2"
#:rw-image? #t)
"-m" "512"
"-nographic" "-serial" "stdio"
"-snapshot")))
(test-runner-current (system-test-runner #$output))
(test-begin "guix-daemon")
(test-equal "guix describe"
0
(marionette-eval '(system* "guix" "describe")
marionette))
;; XXX: What follows is largely copied form (gnu tests foreign).
(test-equal "hello not already built"
#f
;; Check that the next test will really build 'hello'.
(marionette-eval '(file-exists?
#$(with-parameters ((%graft? #f))
hello))
marionette))
(test-equal "guix build hello"
0
;; Check that guix-daemon is up and running and that the build
;; environment is properly set up (build users, etc.).
(marionette-eval '(system* "guix" "build" "hello" "--no-grafts")
marionette))
(test-assert "hello indeed built"
(marionette-eval '(file-exists?
#$(with-parameters ((%graft? #f))
hello))
marionette))
(test-equal "guix install hello"
0
;; Check that ~/.guix-profile & co. are properly created.
(marionette-eval '(let ((pw (getpwuid (getuid))))
(setenv "USER" (passwd:name pw))
(setenv "HOME" (pk 'home (passwd:dir pw)))
(system* "guix" "install" "hello"
"--no-grafts" "--bootstrap"))
marionette))
(test-equal "user profile created"
0
(marionette-eval '(system "ls -lad ~/.guix-profile")
marionette))
(test-equal "hello"
0
(marionette-eval '(system "~/.guix-profile/bin/hello")
marionette))
(test-equal "guix install hello, unprivileged user"
0
;; Check that 'guix' is in $PATH for new users and that
;; ~user/.guix-profile also gets created.
(marionette-eval '(system "su - user -c \
'guix install hello --no-grafts --bootstrap'")
marionette))
(test-equal "user hello"
0
(marionette-eval '(system "~user/.guix-profile/bin/hello")
marionette))
(test-equal "unprivileged user profile created"
0
(marionette-eval '(system "ls -lad ~user/.guix-profile")
marionette))
(test-equal "store is read-only"
EROFS
(marionette-eval '(catch 'system-error
(lambda ()
(mkdir (in-vicinity #$(%store-prefix)
"whatever"))
0)
(lambda args
(system-error-errno args)))
marionette))
(test-end))))
(gexp->derivation "guix-daemon-test" test))
(define %test-guix-daemon
(system-test
(name "guix-daemon")
(description
"Test 'guix-daemon' behavior on a multi-user system.")
(value
(let ((os (marionette-operating-system
(operating-system
(inherit (operating-system-with-gc-roots
%simple-os
(list (profile
(name "hello-build-dependencies")
(content %hello-dependencies-manifest)))))
(kernel-arguments '("console=ttyS0"))
(users (cons (user-account
(name "user")
(group "users"))
%base-user-accounts)))
#:imported-modules '((gnu services herd)
(guix combinators)))))
(run-guix-daemon-test os)))))