[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/03: tests: Introduce 'simple-operating-system' and use it.
|
From: |
Ludovic Courtès |
|
Subject: |
02/03: tests: Introduce 'simple-operating-system' and use it. |
|
Date: |
Fri, 31 Mar 2017 18:46:22 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 892d9089a88abaa2ef1127f16308d03f4f08a4ce
Author: Ludovic Courtès <address@hidden>
Date: Fri Mar 31 22:13:50 2017 +0200
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.
---
gnu/tests.scm | 43 +++++++++++++++++++++++++++++++++++-
gnu/tests/base.scm | 30 +++----------------------
gnu/tests/mail.scm | 25 ++++++---------------
gnu/tests/messaging.scm | 27 ++---------------------
gnu/tests/networking.scm | 57 +++++++++++++++++++-----------------------------
gnu/tests/ssh.scm | 30 ++++---------------------
gnu/tests/web.scm | 26 +++++++---------------
7 files changed, 88 insertions(+), 150 deletions(-)
diff --git a/gnu/tests.scm b/gnu/tests.scm
index 8abe6c6..e84d1eb 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 <address@hidden>
+;;; Copyright © 2016, 2017 Ludovic Courtès <address@hidden>
;;;
;;; 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 000a4dd..bcb8299 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 47328a5..d5c08b7 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 b0c8254..cefb525 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 53c80a4..cfcb490 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 c1582c4..02931e9 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 <address@hidden>
+;;; Copyright © 2016, 2017 Ludovic Courtès <address@hidden>
;;; Copyright © 2017 Clément Lassieur <address@hidden>
;;;
;;; 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 bae0e8f..cdc5791 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