tests: Introduce 'simple-operating-system' and use it.
* gnu/tests.scm (%simple-os): New macro. (simple-operating-system): New macro. * gnu/tests/base.scm (%simple-os): Define using 'simple-operating-system'. (%mcron-os): Use 'simple-operating-system'. * gnu/tests/mail.scm (%opensmtpd-os): Likewise. * gnu/tests/messaging.scm (%base-os, os-with-service): Remove. (run-xmpp-test): Use 'simple-operating-system'. * gnu/tests/networking.scm (%inetd-os): Likewise. * gnu/tests/ssh.scm (%base-os, os-with-service): Remove. (run-ssh-test): Use 'simple-operating-system'. * gnu/tests/web.scm (%nginx-os): Likewise.master
Ludovic Courtès
parent
9af7ecd959
commit
892d9089a8
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
|
@ -21,7 +21,11 @@
|
|||
#:use-module (guix utils)
|
||||
#:use-module (guix records)
|
||||
#:use-module (gnu system)
|
||||
#:use-module (gnu system grub)
|
||||
#:use-module (gnu system file-systems)
|
||||
#:use-module (gnu system shadow)
|
||||
#:use-module (gnu services)
|
||||
#:use-module (gnu services base)
|
||||
#:use-module (gnu services shepherd)
|
||||
#:use-module ((gnu packages) #:select (scheme-modules))
|
||||
#:use-module (srfi srfi-1)
|
||||
|
|
@ -37,6 +41,8 @@
|
|||
marionette-operating-system
|
||||
define-os-with-source
|
||||
|
||||
simple-operating-system
|
||||
|
||||
system-test
|
||||
system-test?
|
||||
system-test-name
|
||||
|
|
@ -188,6 +194,41 @@ the system under test."
|
|||
(use-modules modules ...)
|
||||
(operating-system fields ...)))))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Simple operating systems.
|
||||
;;;
|
||||
|
||||
(define %simple-os
|
||||
(operating-system
|
||||
(host-name "komputilo")
|
||||
(timezone "Europe/Berlin")
|
||||
(locale "en_US.UTF-8")
|
||||
|
||||
(bootloader (grub-configuration (device "/dev/sdX")))
|
||||
(file-systems (cons (file-system
|
||||
(device "my-root")
|
||||
(title 'label)
|
||||
(mount-point "/")
|
||||
(type "ext4"))
|
||||
%base-file-systems))
|
||||
(firmware '())
|
||||
|
||||
(users (cons (user-account
|
||||
(name "alice")
|
||||
(comment "Bob's sister")
|
||||
(group "users")
|
||||
(supplementary-groups '("wheel" "audio" "video"))
|
||||
(home-directory "/home/alice"))
|
||||
%base-user-accounts))))
|
||||
|
||||
(define-syntax-rule (simple-operating-system user-services ...)
|
||||
"Return an operating system that includes USER-SERVICES in addition to
|
||||
%BASE-SERVICES."
|
||||
(operating-system (inherit %simple-os)
|
||||
(services (cons* user-services ... %base-services))))
|
||||
|
||||
|
||||
|
||||
;;;
|
||||
;;; Tests.
|
||||
|
|
|
|||
|
|
@ -19,8 +19,6 @@
|
|||
(define-module (gnu tests base)
|
||||
#:use-module (gnu tests)
|
||||
#:use-module (gnu system)
|
||||
#:use-module (gnu system grub)
|
||||
#:use-module (gnu system file-systems)
|
||||
#:use-module (gnu system shadow)
|
||||
#:use-module (gnu system nss)
|
||||
#:use-module (gnu system vm)
|
||||
|
|
@ -44,27 +42,7 @@
|
|||
%test-nss-mdns))
|
||||
|
||||
(define %simple-os
|
||||
(operating-system
|
||||
(host-name "komputilo")
|
||||
(timezone "Europe/Berlin")
|
||||
(locale "en_US.UTF-8")
|
||||
|
||||
(bootloader (grub-configuration (device "/dev/sdX")))
|
||||
(file-systems (cons (file-system
|
||||
(device "my-root")
|
||||
(title 'label)
|
||||
(mount-point "/")
|
||||
(type "ext4"))
|
||||
%base-file-systems))
|
||||
(firmware '())
|
||||
|
||||
(users (cons (user-account
|
||||
(name "alice")
|
||||
(comment "Bob's sister")
|
||||
(group "users")
|
||||
(supplementary-groups '("wheel" "audio" "video"))
|
||||
(home-directory "/home/alice"))
|
||||
%base-user-accounts))))
|
||||
(simple-operating-system))
|
||||
|
||||
|
||||
(define* (run-basic-test os command #:optional (name "basic")
|
||||
|
|
@ -420,10 +398,8 @@ functionality tests.")
|
|||
#: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))))))
|
||||
(simple-operating-system
|
||||
(mcron-service (list job1 job2 job3)))))
|
||||
|
||||
(define (run-mcron-test name)
|
||||
(mlet* %store-monad ((os -> (marionette-operating-system
|
||||
|
|
|
|||
|
|
@ -19,11 +19,8 @@
|
|||
(define-module (gnu tests mail)
|
||||
#:use-module (gnu tests)
|
||||
#:use-module (gnu system)
|
||||
#:use-module (gnu system file-systems)
|
||||
#:use-module (gnu system grub)
|
||||
#:use-module (gnu system vm)
|
||||
#:use-module (gnu services)
|
||||
#:use-module (gnu services base)
|
||||
#:use-module (gnu services mail)
|
||||
#:use-module (gnu services networking)
|
||||
#:use-module (guix gexp)
|
||||
|
|
@ -32,14 +29,7 @@
|
|||
#:export (%test-opensmtpd))
|
||||
|
||||
(define %opensmtpd-os
|
||||
(operating-system
|
||||
(host-name "komputilo")
|
||||
(timezone "Europe/Berlin")
|
||||
(locale "en_US.UTF-8")
|
||||
(bootloader (grub-configuration (device #f)))
|
||||
(file-systems %base-file-systems)
|
||||
(firmware '())
|
||||
(services (cons*
|
||||
(simple-operating-system
|
||||
(dhcp-client-service)
|
||||
(service opensmtpd-service-type
|
||||
(opensmtpd-configuration
|
||||
|
|
@ -47,8 +37,7 @@
|
|||
(plain-file "smtpd.conf" "
|
||||
listen on 0.0.0.0
|
||||
accept from any for local deliver to mbox
|
||||
"))))
|
||||
%base-services))))
|
||||
"))))))
|
||||
|
||||
(define (run-opensmtpd-test)
|
||||
"Return a test of an OS running OpenSMTPD service."
|
||||
|
|
|
|||
|
|
@ -19,12 +19,8 @@
|
|||
(define-module (gnu tests messaging)
|
||||
#:use-module (gnu tests)
|
||||
#:use-module (gnu system)
|
||||
#:use-module (gnu system grub)
|
||||
#:use-module (gnu system file-systems)
|
||||
#:use-module (gnu system shadow)
|
||||
#:use-module (gnu system vm)
|
||||
#:use-module (gnu services)
|
||||
#:use-module (gnu services base)
|
||||
#:use-module (gnu services messaging)
|
||||
#:use-module (gnu services networking)
|
||||
#:use-module (gnu packages messaging)
|
||||
|
|
@ -33,30 +29,11 @@
|
|||
#:use-module (guix monads)
|
||||
#:export (%test-prosody))
|
||||
|
||||
(define %base-os
|
||||
(operating-system
|
||||
(host-name "komputilo")
|
||||
(timezone "Europe/Berlin")
|
||||
(locale "en_US.UTF-8")
|
||||
|
||||
(bootloader (grub-configuration (device "/dev/sdX")))
|
||||
(file-systems %base-file-systems)
|
||||
(firmware '())
|
||||
(users %base-user-accounts)
|
||||
(services (cons (dhcp-client-service)
|
||||
%base-services))))
|
||||
|
||||
(define (os-with-service service)
|
||||
"Return a test operating system that runs SERVICE."
|
||||
(operating-system
|
||||
(inherit %base-os)
|
||||
(services (cons service
|
||||
(operating-system-user-services %base-os)))))
|
||||
|
||||
(define (run-xmpp-test name xmpp-service pid-file create-account)
|
||||
"Run a test of an OS running XMPP-SERVICE, which writes its PID to PID-FILE."
|
||||
(mlet* %store-monad ((os -> (marionette-operating-system
|
||||
(os-with-service xmpp-service)
|
||||
(simple-operating-system (dhcp-client-service)
|
||||
xmpp-service)
|
||||
#:imported-modules '((gnu services herd))))
|
||||
(command (system-qemu-image/shared-store-script
|
||||
os #:graphic? #f))
|
||||
|
|
|
|||
|
|
@ -19,12 +19,8 @@
|
|||
(define-module (gnu tests networking)
|
||||
#:use-module (gnu tests)
|
||||
#:use-module (gnu system)
|
||||
#:use-module (gnu system grub)
|
||||
#:use-module (gnu system file-systems)
|
||||
#:use-module (gnu system shadow)
|
||||
#:use-module (gnu system vm)
|
||||
#:use-module (gnu services)
|
||||
#:use-module (gnu services base)
|
||||
#:use-module (gnu services networking)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix store)
|
||||
|
|
@ -34,16 +30,8 @@
|
|||
|
||||
(define %inetd-os
|
||||
;; Operating system with 2 inetd services.
|
||||
(operating-system
|
||||
(host-name "komputilo")
|
||||
(timezone "Europe/Brussels")
|
||||
(locale "en_US.utf8")
|
||||
|
||||
(bootloader (grub-configuration (device "/dev/sdX")))
|
||||
(file-systems %base-file-systems)
|
||||
(firmware '())
|
||||
(users %base-user-accounts)
|
||||
(services (cons* (dhcp-client-service)
|
||||
(simple-operating-system
|
||||
(dhcp-client-service)
|
||||
(service inetd-service-type
|
||||
(inetd-configuration
|
||||
(entries (list
|
||||
|
|
@ -81,8 +69,7 @@ do
|
|||
else
|
||||
echo ERROR
|
||||
fi
|
||||
done" ))))))))
|
||||
%base-services))))
|
||||
done" ))))))))))
|
||||
|
||||
(define* (run-inetd-test)
|
||||
"Run tests in %INETD-OS, where the inetd service provides an echo service on
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
|
|
@ -20,12 +20,8 @@
|
|||
(define-module (gnu tests ssh)
|
||||
#:use-module (gnu tests)
|
||||
#:use-module (gnu system)
|
||||
#:use-module (gnu system grub)
|
||||
#:use-module (gnu system file-systems)
|
||||
#:use-module (gnu system shadow)
|
||||
#:use-module (gnu system vm)
|
||||
#:use-module (gnu services)
|
||||
#:use-module (gnu services base)
|
||||
#:use-module (gnu services ssh)
|
||||
#:use-module (gnu services networking)
|
||||
#:use-module (gnu packages ssh)
|
||||
|
|
@ -35,26 +31,6 @@
|
|||
#:export (%test-openssh
|
||||
%test-dropbear))
|
||||
|
||||
(define %base-os
|
||||
(operating-system
|
||||
(host-name "komputilo")
|
||||
(timezone "Europe/Berlin")
|
||||
(locale "en_US.UTF-8")
|
||||
|
||||
(bootloader (grub-configuration (device "/dev/sdX")))
|
||||
(file-systems %base-file-systems)
|
||||
(firmware '())
|
||||
(users %base-user-accounts)
|
||||
(services (cons (dhcp-client-service)
|
||||
%base-services))))
|
||||
|
||||
(define (os-with-service service)
|
||||
"Return a test operating system that runs SERVICE."
|
||||
(operating-system
|
||||
(inherit %base-os)
|
||||
(services (cons service
|
||||
(operating-system-user-services %base-os)))))
|
||||
|
||||
(define* (run-ssh-test name ssh-service pid-file #:key (sftp? #f))
|
||||
"Run a test of an OS running SSH-SERVICE, which writes its PID to PID-FILE.
|
||||
SSH-SERVICE must be configured to listen on port 22 and to allow for root and
|
||||
|
|
@ -62,7 +38,9 @@ empty-password logins.
|
|||
|
||||
When SFTP? is true, run an SFTP server test."
|
||||
(mlet* %store-monad ((os -> (marionette-operating-system
|
||||
(os-with-service ssh-service)
|
||||
(simple-operating-system
|
||||
(dhcp-client-service)
|
||||
ssh-service)
|
||||
#:imported-modules '((gnu services herd)
|
||||
(guix combinators))))
|
||||
(command (system-qemu-image/shared-store-script
|
||||
|
|
|
|||
|
|
@ -24,7 +24,6 @@
|
|||
#:use-module (gnu system shadow)
|
||||
#:use-module (gnu system vm)
|
||||
#:use-module (gnu services)
|
||||
#:use-module (gnu services base)
|
||||
#:use-module (gnu services web)
|
||||
#:use-module (gnu services networking)
|
||||
#:use-module (guix gexp)
|
||||
|
|
@ -55,23 +54,14 @@
|
|||
|
||||
(define %nginx-os
|
||||
;; Operating system under test.
|
||||
(operating-system
|
||||
(host-name "komputilo")
|
||||
(timezone "Europe/Berlin")
|
||||
(locale "en_US.utf8")
|
||||
|
||||
(bootloader (grub-configuration (device "/dev/sdX")))
|
||||
(file-systems %base-file-systems)
|
||||
(firmware '())
|
||||
(users %base-user-accounts)
|
||||
(services (cons* (dhcp-client-service)
|
||||
(simple-operating-system
|
||||
(dhcp-client-service)
|
||||
(service nginx-service-type
|
||||
(nginx-configuration
|
||||
(log-directory "/var/log/nginx")
|
||||
(server-blocks %nginx-servers)))
|
||||
(simple-service 'make-http-root activation-service-type
|
||||
%make-http-root)
|
||||
%base-services))))
|
||||
%make-http-root)))
|
||||
|
||||
(define* (run-nginx-test #:optional (http-port 8042))
|
||||
"Run tests in %NGINX-OS, which has nginx running and listening on
|
||||
|
|
|
|||
Reference in New Issue