[PATCH 0/5] Test guix-daemon on Guix System

  • Open
  • quality assurance status badge
Details
One participant
  • Ludovic Courtès
Owner
unassigned
Submitted by
Ludovic Courtès
Severity
normal
Blocked by

Debbugs page

Ludovic Courtès wrote 1 weeks ago
(address . guix-patches@gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
cover.1740736327.git.ludo@gnu.org
Hello Guix!

After writing system tests for Guix installation on Debian¹ and
in light of the need for tests with the “rootless” daemon changes²,
I realized we had no guix-daemon tests , I realized we had no
guix-daemon tests for Guix System—nothing that excercises chroot,
use of the separate build users, etc.

This patch series does that, factorizing most of the code with
the Debian install test (it depends on that patch series).

It also tidies up (gnu tests base).

Thoughts?

Ludo’.


Ludovic Courtès (5):
tests: Move mcron test to its own file.
tests: Move Avahi test to its own file.
tests: Add ‘guix-daemon’ test.
tests: Factorize ‘%hello-dependencies-manifest’.
tests: Factorize ‘guix-daemon’ test cases.

gnu/local.mk | 2 +
gnu/tests/avahi.scm | 183 +++++++++++++++++
gnu/tests/base.scm | 449 +++++++++++++++++++-----------------------
gnu/tests/foreign.scm | 107 +---------
gnu/tests/mcron.scm | 118 +++++++++++
5 files changed, 508 insertions(+), 351 deletions(-)
create mode 100644 gnu/tests/avahi.scm
create mode 100644 gnu/tests/mcron.scm


base-commit: 4d20e358c38b778b2447bd88ec6abe16b919abc4
--
2.48.1
Ludovic Courtès wrote 1 weeks ago
[PATCH 2/5] tests: Move Avahi test to its own file.
(address . 76636@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
e625aa6943ffd3f7d3d24334caf578b7517539ad.1740736327.git.ludo@gnu.org
This mirrors the (gnu services avahi) module.

* gnu/tests/base.scm (%avahi-os, run-nss-mdns-test, %test-nss-mdns):
Move to…
* gnu/tests/avahi.scm: … here. New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.

Change-Id: I04705e57408619d948c928873c40c470aa4e949d
---
gnu/local.mk | 1 +
gnu/tests/avahi.scm | 183 ++++++++++++++++++++++++++++++++++++++++++++
gnu/tests/base.scm | 156 -------------------------------------
3 files changed, 184 insertions(+), 156 deletions(-)
create mode 100644 gnu/tests/avahi.scm

Toggle diff (387 lines)
diff --git a/gnu/local.mk b/gnu/local.mk
index 4b31f8a4a0b..d923afd633e 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -838,6 +838,7 @@ GNU_SYSTEM_MODULES = \
\
%D%/tests.scm \
%D%/tests/audio.scm \
+ %D%/tests/avahi.scm \
%D%/tests/base.scm \
%D%/tests/cachefilesd.scm \
%D%/tests/ci.scm \
diff --git a/gnu/tests/avahi.scm b/gnu/tests/avahi.scm
new file mode 100644
index 00000000000..261ec8a7312
--- /dev/null
+++ b/gnu/tests/avahi.scm
@@ -0,0 +1,183 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016-2020, 2022, 2024 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests avahi)
+ #:use-module (gnu tests)
+ #:use-module (gnu system)
+ #:use-module (gnu system nss)
+ #:use-module (gnu system vm)
+ #:use-module (gnu services)
+ #:use-module (gnu services base)
+ #:use-module (gnu services dbus)
+ #:use-module (gnu services avahi)
+ #:use-module (gnu services networking)
+ #:use-module (guix gexp)
+ #:use-module (guix store)
+ #:use-module (guix monads)
+ #:export (%test-nss-mdns))
+
+;;;
+;;; Avahi and NSS-mDNS.
+;;;
+
+(define %avahi-os
+ (operating-system
+ (inherit (simple-operating-system))
+ (name-service-switch %mdns-host-lookup-nss)
+ (services (cons* (service avahi-service-type
+ (avahi-configuration (debug? #t)))
+ (service dbus-root-service-type)
+ (service dhcp-client-service-type) ;needed for multicast
+
+ ;; Enable heavyweight debugging output.
+ (modify-services (operating-system-user-services
+ %simple-os)
+ (nscd-service-type config
+ => (nscd-configuration
+ (inherit config)
+ (debug-level 3)
+ (log-file "/dev/console")))
+ (syslog-service-type config
+ =>
+ (syslog-configuration
+ (inherit config)
+ (config-file
+ (plain-file
+ "syslog.conf"
+ "*.* /dev/console\n")))))))))
+
+(define (run-nss-mdns-test)
+ ;; Test resolution of '.local' names via libc. Start the marionette service
+ ;; *after* nscd. Failing to do that, libc will try to connect to nscd,
+ ;; fail, then never try again (see '__nss_not_use_nscd_hosts' in libc),
+ ;; leading to '.local' resolution failures.
+ (define os
+ (marionette-operating-system
+ %avahi-os
+ #:requirements '(nscd)
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+
+ (define mdns-host-name
+ (string-append (operating-system-host-name os)
+ ".local"))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (srfi srfi-1)
+ (srfi srfi-64)
+ (ice-9 match))
+
+ (define marionette
+ (make-marionette (list #$(virtual-machine os))))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-runner-current (system-test-runner))
+ (test-begin "avahi")
+
+ (test-assert "nscd PID file is created"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'nscd))
+ marionette))
+
+ (test-assert "nscd is listening on its socket"
+ (marionette-eval
+ ;; XXX: Work around a race condition in nscd: nscd creates its
+ ;; PID file before it is listening on its socket.
+ '(let ((sock (socket PF_UNIX SOCK_STREAM 0)))
+ (let try ()
+ (catch 'system-error
+ (lambda ()
+ (connect sock AF_UNIX "/var/run/nscd/socket")
+ (close-port sock)
+ (format #t "nscd is ready~%")
+ #t)
+ (lambda args
+ (format #t "waiting for nscd...~%")
+ (usleep 500000)
+ (try)))))
+ marionette))
+
+ (test-assert "avahi is running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'avahi-daemon))
+ marionette))
+
+ (test-assert "network is up"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'networking))
+ marionette))
+
+ (test-equal "avahi-resolve-host-name"
+ 0
+ (marionette-eval
+ '(system*
+ "/run/current-system/profile/bin/avahi-resolve-host-name"
+ "-v" #$mdns-host-name)
+ marionette))
+
+ (test-equal "avahi-browse"
+ 0
+ (marionette-eval
+ '(system* "/run/current-system/profile/bin/avahi-browse" "-avt")
+ marionette))
+
+ (test-assert "getaddrinfo .local"
+ ;; Wait for the 'avahi-daemon' service and perform a resolution.
+ (match (marionette-eval
+ '(getaddrinfo #$mdns-host-name)
+ marionette)
+ (((? vector? addrinfos) ..1)
+ (pk 'getaddrinfo addrinfos)
+ (and (any (lambda (ai)
+ (= AF_INET (addrinfo:fam ai)))
+ addrinfos)
+ (any (lambda (ai)
+ (= AF_INET6 (addrinfo:fam ai)))
+ addrinfos)))))
+
+ (test-assert "gethostbyname .local"
+ (match (pk 'gethostbyname
+ (marionette-eval '(gethostbyname #$mdns-host-name)
+ marionette))
+ ((? vector? result)
+ (and (string=? (hostent:name result) #$mdns-host-name)
+ (= (hostent:addrtype result) AF_INET)))))
+
+
+ (test-end))))
+
+ (gexp->derivation "nss-mdns" test))
+
+(define %test-nss-mdns
+ (system-test
+ (name "nss-mdns")
+ (description
+ "Test Avahi's multicast-DNS implementation, and in particular, test its
+glibc name service switch (NSS) module.")
+ (value (run-nss-mdns-test))))
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index c3040002d37..89e797259dc 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -27,12 +27,9 @@ (define-module (gnu tests base)
#:autoload (gnu system image) (system-image)
#:use-module (gnu system privilege)
#:use-module (gnu system shadow)
- #:use-module (gnu system nss)
#:use-module (gnu system vm)
#:use-module (gnu services)
#:use-module (gnu services base)
- #:use-module (gnu services dbus)
- #:use-module (gnu services avahi)
#:use-module (gnu services shepherd)
#:use-module (gnu services networking)
#:use-module (gnu packages base)
@@ -59,7 +56,6 @@ (define-module (gnu tests base)
%test-halt
%test-root-unmount
%test-cleanup
- %test-nss-mdns
%test-activation))
(define %simple-os
@@ -870,158 +866,6 @@ (define %test-cleanup
non-ASCII names from /tmp.")
(value (run-cleanup-test name))))
-
-;;;
-;;; Avahi and NSS-mDNS.
-;;;
-
-(define %avahi-os
- (operating-system
- (inherit %simple-os)
- (name-service-switch %mdns-host-lookup-nss)
- (services (cons* (service avahi-service-type
- (avahi-configuration (debug? #t)))
- (service dbus-root-service-type)
- (service dhcp-client-service-type) ;needed for multicast
-
- ;; Enable heavyweight debugging output.
- (modify-services (operating-system-user-services
- %simple-os)
- (nscd-service-type config
- => (nscd-configuration
- (inherit config)
- (debug-level 3)
- (log-file "/dev/console")))
- (syslog-service-type config
- =>
- (syslog-configuration
- (inherit config)
- (config-file
- (plain-file
- "syslog.conf"
- "*.* /dev/console\n")))))))))
-
-(define (run-nss-mdns-test)
- ;; Test resolution of '.local' names via libc. Start the marionette service
- ;; *after* nscd. Failing to do that, libc will try to connect to nscd,
- ;; fail, then never try again (see '__nss_not_use_nscd_hosts' in libc),
- ;; leading to '.local' resolution failures.
- (define os
- (marionette-operating-system
- %avahi-os
- #:requirements '(nscd)
- #:imported-modules '((gnu services herd)
- (guix combinators))))
-
- (define mdns-host-name
- (string-append (operating-system-host-name os)
- ".local"))
-
- (define test
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (gnu build marionette)
- (srfi srfi-1)
- (srfi srfi-64)
- (ice-9 match))
-
- (define marionette
- (make-marionette (list #$(virtual-machine os))))
-
- (mkdir #$output)
- (chdir #$output)
-
- (test-runner-current (system-test-runner))
- (test-begin "avahi")
-
- (test-assert "nscd PID file is created"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'nscd))
- marionette))
-
- (test-assert "nscd is listening on its socket"
- (marionette-eval
- ;; XXX: Work around a race condition in nscd: nscd creates its
- ;; PID file before it is listening on its socket.
- '(let ((sock (socket PF_UNIX SOCK_STREAM 0)))
- (let try ()
- (catch 'system-error
- (lambda ()
- (connect sock AF_UNIX "/var/run/nscd/socket")
- (close-port sock)
- (format #t "nscd is ready~%")
- #t)
- (lambda args
- (format #t "waiting for nscd...~%")
- (usleep 500000)
- (try)))))
- marionette))
-
- (test-assert "avahi is running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'avahi-daemon))
- marionette))
-
- (test-assert "network is up"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'networking))
- marionette))
-
- (test-equal "avahi-resolve-host-name"
- 0
- (marionette-eval
- '(system*
- "/run/current-system/profile/bin/avahi-resolve-host-name"
- "-v" #$mdns-host-name)
- marionette))
-
- (test-equal "avahi-browse"
- 0
- (marionette-eval
- '(system* "/run/current-system/profile/bin/avahi-browse" "-avt")
- marionette))
-
- (test-assert "getaddrinfo .local"
- ;; Wait for the 'avahi-daemon' service and perform a resolution.
- (match (marionette-eval
- '(getaddrinfo #$mdns-host-name)
- marionette)
- (((? vector? addrinfos) ..1)
- (pk 'getaddrinfo addrinfos)
- (and (any (lambda (ai)
- (= AF_INET (addrinfo:fam ai)))
- addrinfos)
- (any (lambda (ai)
- (= AF_INET6 (addrinfo:fam ai)))
- addrinfos)))))
-
- (test-assert "gethostbyname .local"
- (match (pk 'gethostbyname
- (marionette-eval '(gethostbyname #$mdns-host-name)
- marionette))
- ((? vector? result)
- (and (string=? (hostent:name result) #$mdns-host-name)
- (= (hostent:addrtype result) AF_INET)))))
-
-
- (test-end))))
-
- (gexp->derivation "nss-mdns" test))
-
-(define %test-nss-mdns
- (system-test
- (name "nss-mdns")
- (description
- "Test Avahi's multicast-DNS implementation, and in particular, test its
-glibc name service switch (NSS) module.")
- (value (run-nss-mdns-test))))
-
;;;
;;; Activation: Order of activation scripts
--
2.48.1
Ludovic Courtès wrote 1 weeks ago
[PATCH 1/5] tests: Move mcron test to its own file.
(address . 76636@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
72781f922736d543f55abe13d439b91d16815dd7.1740736327.git.ludo@gnu.org
This mirrors the (gnu services mcron) module.

* gnu/tests/base.scm (%mcron-os, run-mcron-test, %test-mcron): Move to…
* gnu/tests/mcron.scm: … here. New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.

Change-Id: Id2830d08d8e797e008c5fec7964fb5f6a5ea2fad
---
gnu/local.mk | 1 +
gnu/tests/base.scm | 92 ----------------------------------
gnu/tests/mcron.scm | 118 ++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 119 insertions(+), 92 deletions(-)
create mode 100644 gnu/tests/mcron.scm

Toggle diff (255 lines)
diff --git a/gnu/local.mk b/gnu/local.mk
index b5c8c1a4665..4b31f8a4a0b 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -862,6 +862,7 @@ GNU_SYSTEM_MODULES = \
%D%/tests/lightdm.scm \
%D%/tests/linux-modules.scm \
%D%/tests/mail.scm \
+ %D%/tests/mcron.scm \
%D%/tests/messaging.scm \
%D%/tests/networking.scm \
%D%/tests/package-management.scm \
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index d9e30e9b1de..c3040002d37 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -33,7 +33,6 @@ (define-module (gnu tests base)
#:use-module (gnu services base)
#:use-module (gnu services dbus)
#:use-module (gnu services avahi)
- #:use-module (gnu services mcron)
#:use-module (gnu services shepherd)
#:use-module (gnu services networking)
#:use-module (gnu packages base)
@@ -60,7 +59,6 @@ (define-module (gnu tests base)
%test-halt
%test-root-unmount
%test-cleanup
- %test-mcron
%test-nss-mdns
%test-activation))
@@ -872,96 +870,6 @@ (define %test-cleanup
non-ASCII names from /tmp.")
(value (run-cleanup-test name))))
-
-;;;
-;;; Mcron.
-;;;
-
-(define %mcron-os
- ;; System with an mcron service, with one mcron job for "root" and one mcron
- ;; job for an unprivileged user.
- (let ((job1 #~(job '(next-second '(0 5 10 15 20 25 30 35 40 45 50 55))
- (lambda ()
- (unless (file-exists? "witness")
- (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")))
- (simple-operating-system
- (service mcron-service-type
- (mcron-configuration (jobs (list job1 job2 job3)))))))
-
-(define (run-mcron-test name)
- (define os
- (marionette-operating-system
- %mcron-os
- #:imported-modules '((gnu services herd)
- (guix combinators))))
-
- (define test
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (gnu build marionette)
- (srfi srfi-64)
- (ice-9 match))
-
- (define marionette
- (make-marionette (list #$(virtual-machine os))))
-
- (test-runner-current (system-test-runner #$output))
- (test-begin "mcron")
-
- (test-assert "service running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'mcron))
- marionette))
-
- ;; 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" marionette))
-
- ;; 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" marionette)
- ((1000 gid)
- (>= gid 100))))
-
- ;; Last, the job that uses a command; allows us to test whether
- ;; $PATH is sane.
- (test-equal "root's job with command"
- ""
- (wait-for-file "/root/witness-touch" marionette
- #:read '(@ (ice-9 rdelim) read-string)))
-
- ;; Make sure the 'schedule' action is accepted.
- (test-equal "schedule action"
- '(#t) ;one value, #t
- (marionette-eval '(with-shepherd-action 'mcron ('schedule) result
- result)
- marionette))
-
- (test-end))))
-
- (gexp->derivation name test))
-
-(define %test-mcron
- (system-test
- (name "mcron")
- (description "Make sure the mcron service works as advertised.")
- (value (run-mcron-test name))))
-
;;;
;;; Avahi and NSS-mDNS.
diff --git a/gnu/tests/mcron.scm b/gnu/tests/mcron.scm
new file mode 100644
index 00000000000..052c8439cc7
--- /dev/null
+++ b/gnu/tests/mcron.scm
@@ -0,0 +1,118 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016-2020, 2022, 2024 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests mcron)
+ #:use-module (gnu tests)
+ #:use-module (gnu system)
+ #:use-module (gnu system vm)
+ #:use-module (gnu services)
+ #:use-module (gnu services mcron)
+ #:use-module (guix gexp)
+ #:use-module (guix store)
+ #:use-module (guix monads)
+ #:export (%test-mcron))
+
+;;;
+;;; Mcron.
+;;;
+
+(define %mcron-os
+ ;; System with an mcron service, with one mcron job for "root" and one mcron
+ ;; job for an unprivileged user.
+ (let ((job1 #~(job '(next-second '(0 5 10 15 20 25 30 35 40 45 50 55))
+ (lambda ()
+ (unless (file-exists? "witness")
+ (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")))
+ (simple-operating-system
+ (service mcron-service-type
+ (mcron-configuration (jobs (list job1 job2 job3)))))))
+
+(define (run-mcron-test name)
+ (define os
+ (marionette-operating-system
+ %mcron-os
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (srfi srfi-64)
+ (ice-9 match))
+
+ (define marionette
+ (make-marionette (list #$(virtual-machine os))))
+
+ (test-runner-current (system-test-runner #$output))
+ (test-begin "mcron")
+
+ (test-assert "service running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'mcron))
+ marionette))
+
+ ;; 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" marionette))
+
+ ;; 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" marionette)
+ ((1000 gid)
+ (>= gid 100))))
+
+ ;; Last, the job that uses a command; allows us to test whether
+ ;; $PATH is sane.
+ (test-equal "root's job with command"
+ ""
+ (wait-for-file "/root/witness-touch" marionette
+ #:read '(@ (ice-9 rdelim) read-string)))
+
+ ;; Make sure the 'schedule' action is accepted.
+ (test-equal "schedule action"
+ '(#t) ;one value, #t
+ (marionette-eval '(with-shepherd-action 'mcron ('schedule) result
+ result)
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation name test))
+
+(define %test-mcron
+ (system-test
+ (name "mcron")
+ (description "Make sure the mcron service works as advertised.")
+ (value (run-mcron-test name))))
--
2.48.1
Ludovic Courtès wrote 1 weeks ago
[PATCH 3/5] tests: Add ‘guix-daemon ’ test.
(address . 76636@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
af8b65dd0950c40877f810f5144fa330672f26c2.1740736327.git.ludo@gnu.org
* 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
---
gnu/tests/base.scm | 191 ++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 190 insertions(+), 1 deletion(-)

Toggle diff (222 lines)
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 89e797259dc..38bd1e687fc 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -34,6 +34,8 @@ (define-module (gnu tests base)
#: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 @@ (define-module (gnu tests base)
#: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 @@ (define-module (gnu tests base)
%test-halt
%test-root-unmount
%test-cleanup
- %test-activation))
+ %test-activation
+ %test-guix-daemon))
(define %simple-os
(simple-operating-system))
@@ -981,3 +985,188 @@ (define %test-activation
(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)))))
--
2.48.1
Ludovic Courtès wrote 1 weeks ago
[PATCH 4/5] tests: Factorize ‘%hello-depend encies-manifest’.
(address . 76636@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
e7072155f14527e7c055b523c42294d0fc55de66.1740736327.git.ludo@gnu.org
* gnu/tests/base.scm (%hello-dependencies-manifest): Export.
* gnu/tests/foreign.scm (%installation-tarball-manifest): Use it.

Change-Id: Id92232f479ab5d1f0c48036b0546e3745aa63e52
---
gnu/tests/base.scm | 4 +++-
gnu/tests/foreign.scm | 36 +++---------------------------------
2 files changed, 6 insertions(+), 34 deletions(-)

Toggle diff (78 lines)
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 38bd1e687fc..f2122d7d0a5 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -60,6 +60,8 @@ (define-module (gnu tests base)
%test-root-unmount
%test-cleanup
%test-activation
+
+ %hello-dependencies-manifest
%test-guix-daemon))
(define %simple-os
@@ -998,7 +1000,7 @@ (define (manifest-entry-without-grafts entry)
(item (with-parameters ((%graft? #f))
(manifest-entry-item entry)))))
-(define %hello-dependencies-manifest ;TODO: Share with (gnu tests foreign).
+(define %hello-dependencies-manifest
;; Build dependencies of 'hello' needed to test 'guix build hello'.
(concatenate-manifests
(list (map-manifest-entries
diff --git a/gnu/tests/foreign.scm b/gnu/tests/foreign.scm
index a08622424a7..9aba803c4d8 100644
--- a/gnu/tests/foreign.scm
+++ b/gnu/tests/foreign.scm
@@ -26,6 +26,8 @@ (define-module (gnu tests foreign)
#:autoload (guix store) (%store-prefix %store-monad %graft?)
#:use-module (gnu compression)
#:use-module (gnu tests)
+ #:use-module ((gnu tests base)
+ #:select (%hello-dependencies-manifest))
#:use-module (gnu packages base)
#:use-module (gnu packages bootstrap)
#:use-module (gnu packages guile)
@@ -140,39 +142,7 @@ (define %installation-tarball-manifest
;; Manifest of the Guix installation tarball.
(concatenate-manifests
(list (packages->manifest (list guix))
-
- ;; Include the dependencies of 'hello' in addition to 'guix' so that
- ;; we can test 'guix build hello'.
- (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))))))
+ %hello-dependencies-manifest)))
(define %guix-install-script
;; The 'guix-install.sh' script.
--
2.48.1
Ludovic Courtès wrote 1 weeks ago
[PATCH 5/5] tests: Factorize ‘guix-daemon ’ test cases.
(address . 76636@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
15770d6384520d287f96d53047c799bfe51b6624.1740736327.git.ludo@gnu.org
* gnu/tests/base.scm (guix-daemon-test-cases): New procedure, with code
moved from…
(run-guix-daemon-test): … here. Use it.
* gnu/tests/foreign.scm (run-foreign-install-test): Likewise.

Change-Id: I6f2d03d30d7b7648b6eb7e77e36c3da54f80d79c
---
gnu/tests/base.scm | 160 ++++++++++++++++++++++--------------------
gnu/tests/foreign.scm | 73 +------------------
2 files changed, 87 insertions(+), 146 deletions(-)

Toggle diff (284 lines)
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index f2122d7d0a5..a7f8a5bf7c6 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -62,6 +62,7 @@ (define-module (gnu tests base)
%test-activation
%hello-dependencies-manifest
+ guix-daemon-test-cases
%test-guix-daemon))
(define %simple-os
@@ -1034,6 +1035,88 @@ (define %hello-dependencies-manifest
(packages->manifest (list (canonical-package guile-3.0)
%bootstrap-guile))))))
+(define (guix-daemon-test-cases marionette)
+ "Return a gexp with SRFI-64 test cases testing guix-daemon. Those test are
+evaluated in MARIONETTE, a gexp denoting a marionette (system under test).
+Assume that an unprivileged account for 'user' exists on the system under
+test."
+ #~(begin
+ (test-equal "guix describe"
+ 0
+ (marionette-eval '(system* "guix" "describe")
+ #$marionette))
+
+ (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, assuming that 'user' exists
+ ;; as an unprivileged user account.
+ (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))))
+
(define (run-guix-daemon-test os)
(define test-image
(image (operating-system os)
@@ -1070,82 +1153,7 @@ (define (run-guix-daemon-test os)
(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))
+ #$(guix-daemon-test-cases #~marionette)
(test-end))))
diff --git a/gnu/tests/foreign.scm b/gnu/tests/foreign.scm
index 9aba803c4d8..79436bf5f24 100644
--- a/gnu/tests/foreign.scm
+++ b/gnu/tests/foreign.scm
@@ -27,7 +27,8 @@ (define-module (gnu tests foreign)
#:use-module (gnu compression)
#:use-module (gnu tests)
#:use-module ((gnu tests base)
- #:select (%hello-dependencies-manifest))
+ #:select (%hello-dependencies-manifest
+ guix-daemon-test-cases))
#:use-module (gnu packages base)
#:use-module (gnu packages bootstrap)
#:use-module (gnu packages guile)
@@ -237,81 +238,13 @@ (define (run-foreign-install-test image name)
(%store-prefix))))))
marionette))
- (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 "create user account"
0
(marionette-eval '(system* "useradd" "-d" "/home/user" "-m"
"user")
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))
+ #$(guix-daemon-test-cases #~marionette)
(test-assert "screenshot after"
(marionette-control (string-append "screendump " #$output
--
2.48.1
Ludovic Courtès wrote 1 weeks ago
control message for bug #76636
(address . control@debbugs.gnu.org)
87o6ymtmb2.fsf@gnu.org
block 76636 by 76488
quit
?
Your comment

Commenting via the web interface is currently disabled.

To comment on this conversation send an email to 76636@debbugs.gnu.org

To respond to this issue using the mumi CLI, first switch to it
mumi current 76636
Then, you may apply the latest patchset in this issue (with sign off)
mumi am -- -s
Or, compose a reply to this issue
mumi compose
Or, send patches to this issue
mumi send-email *.patch
You may also tag this issue. See list of standard tags. For example, to set the confirmed and easy tags
mumi command -t +confirmed -t +easy
Or, remove the moreinfo tag and set the help tag
mumi command -t -moreinfo -t +help