diff options
| -rw-r--r-- | gnu/tests.scm | 43 | ||||
| -rw-r--r-- | gnu/tests/base.scm | 30 | ||||
| -rw-r--r-- | gnu/tests/mail.scm | 25 | ||||
| -rw-r--r-- | gnu/tests/messaging.scm | 27 | ||||
| -rw-r--r-- | gnu/tests/networking.scm | 57 | ||||
| -rw-r--r-- | gnu/tests/ssh.scm | 30 | ||||
| -rw-r--r-- | gnu/tests/web.scm | 26 |
7 files changed, 88 insertions, 150 deletions
diff --git a/gnu/tests.scm b/gnu/tests.scm index 8abe6c608b..e84d1ebb20 100644 --- a/gnu/tests.scm +++ b/gnu/tests.scm @@ -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 @@ -190,6 +196,41 @@ the system under test." ;;; +;;; 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. ;;; diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 000a4ddecb..bcb8299c73 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -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 diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm index 47328a54ae..d5c08b7f09 100644 --- a/gnu/tests/mail.scm +++ b/gnu/tests/mail.scm @@ -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,23 +29,15 @@ #: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* - (dhcp-client-service) - (service opensmtpd-service-type - (opensmtpd-configuration - (config-file - (plain-file "smtpd.conf" " + (simple-operating-system + (dhcp-client-service) + (service opensmtpd-service-type + (opensmtpd-configuration + (config-file + (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." diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm index b0c8254ce0..cefb52534a 100644 --- a/gnu/tests/messaging.scm +++ b/gnu/tests/messaging.scm @@ -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)) diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm index 53c80a4ac1..cfcb490874 100644 --- a/gnu/tests/networking.scm +++ b/gnu/tests/networking.scm @@ -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,35 +30,27 @@ (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) - (service inetd-service-type - (inetd-configuration - (entries (list - (inetd-entry - (name "echo") - (socket-type 'stream) - (protocol "tcp") - (wait? #f) - (user "root")) - (inetd-entry - (name "dict") - (socket-type 'stream) - (protocol "tcp") - (wait? #f) - (user "root") - (program (file-append bash - "/bin/bash")) - (arguments - (list "bash" (plain-file "my-dict.sh" "\ + (simple-operating-system + (dhcp-client-service) + (service inetd-service-type + (inetd-configuration + (entries (list + (inetd-entry + (name "echo") + (socket-type 'stream) + (protocol "tcp") + (wait? #f) + (user "root")) + (inetd-entry + (name "dict") + (socket-type 'stream) + (protocol "tcp") + (wait? #f) + (user "root") + (program (file-append bash + "/bin/bash")) + (arguments + (list "bash" (plain-file "my-dict.sh" "\ while read line do if [[ $line =~ ^DEFINE\\ (.*)$ ]] @@ -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 diff --git a/gnu/tests/ssh.scm b/gnu/tests/ssh.scm index c1582c4737..02931e982a 100644 --- a/gnu/tests/ssh.scm +++ b/gnu/tests/ssh.scm @@ -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 diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm index bae0e8fad7..cdc5791237 100644 --- a/gnu/tests/web.scm +++ b/gnu/tests/web.scm @@ -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) - (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)))) + (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))) (define* (run-nginx-test #:optional (http-port 8042)) "Run tests in %NGINX-OS, which has nginx running and listening on |