aboutsummaryrefslogtreecommitdiff
path: root/gnu/tests
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/tests')
-rw-r--r--gnu/tests/base.scm51
-rw-r--r--gnu/tests/dict.scm9
-rw-r--r--gnu/tests/mail.scm135
-rw-r--r--gnu/tests/nfs.scm3
-rw-r--r--gnu/tests/ssh.scm2
-rw-r--r--gnu/tests/web.scm1
6 files changed, 177 insertions, 24 deletions
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index bcb8299c73..e5ac320b74 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -31,6 +31,7 @@
#:use-module (gnu services networking)
#:use-module (gnu packages imagemagick)
#:use-module (gnu packages ocr)
+ #:use-module (gnu packages package-management)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
@@ -56,7 +57,7 @@ passed a gexp denoting the marionette, and it must return gexp that is
inserted before the first test. This is used to introduce an extra
initialization step, such as entering a LUKS passphrase."
(define special-files
- (service-parameters
+ (service-value
(fold-services (operating-system-services os)
#:target-type special-files-service-type)))
@@ -198,6 +199,28 @@ info --version")
',users+homes))
marionette)))
+ (test-equal "no extra home directories"
+ '()
+
+ ;; Make sure the home directories that are not supposed to be
+ ;; created are indeed not created.
+ (let ((nonexistent
+ '#$(filter-map (lambda (user)
+ (and (not
+ (user-account-create-home-directory?
+ user))
+ (user-account-home-directory user)))
+ (operating-system-user-accounts os))))
+ (marionette-eval
+ `(begin
+ (use-modules (srfi srfi-1))
+
+ ;; Note: Do not flag "/var/empty".
+ (filter file-exists?
+ ',(remove (cut string-prefix? "/var/" <>)
+ nonexistent)))
+ marionette)))
+
(test-equal "login on tty1"
"root\n"
(begin
@@ -296,28 +319,24 @@ info --version")
(setlocale LC_ALL before))
marionette))
- (test-assert "/run/current-system is a GC root"
+ (test-eq "/run/current-system is a GC root"
+ 'success!
(marionette-eval '(begin
;; Make sure the (guix …) modules are found.
- (eval-when (expand load eval)
- (set! %load-path
- (cons
- (string-append
- "/run/current-system/profile/share/guile/site/"
- (effective-version))
- %load-path))
- (set! %load-compiled-path
- (cons
- (string-append
- "/run/current-system/profile/share/guile/site/"
- (effective-version))
- %load-compiled-path)))
+ ;;
+ ;; XXX: Currently shepherd and marionette run
+ ;; on Guile 2.0 whereas Guix is on 2.2. Yet
+ ;; we should be able to load the 2.0 Scheme
+ ;; files since it's pure Scheme.
+ (add-to-load-path
+ #+(file-append guix "/share/guile/site/2.2"))
(use-modules (srfi srfi-34) (guix store))
(let ((system (readlink "/run/current-system")))
(guard (c ((nix-protocol-error? c)
- (file-exists? system)))
+ (and (file-exists? system)
+ 'success!)))
(with-store store
(delete-paths store (list system))
#f))))
diff --git a/gnu/tests/dict.scm b/gnu/tests/dict.scm
index f7a48ab634..16b6edbd9e 100644
--- a/gnu/tests/dict.scm
+++ b/gnu/tests/dict.scm
@@ -97,15 +97,16 @@
'(begin
(use-modules (ice-9 rdelim))
(let ((sock (socket PF_INET SOCK_STREAM 0)))
- (let loop ()
- (pk 'try)
+ (let loop ((i 0))
+ (pk 'try i)
(catch 'system-error
(lambda ()
(connect sock AF_INET INADDR_LOOPBACK 2628))
(lambda args
(pk 'connection-error args)
- (sleep 1)
- (loop))))
+ (when (< i 20)
+ (sleep 1)
+ (loop (+ 1 i))))))
(read-line sock 'concat)))
marionette))
diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm
index d5c08b7f09..247f4f667f 100644
--- a/gnu/tests/mail.scm
+++ b/gnu/tests/mail.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org>
+;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -26,7 +27,9 @@
#:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix store)
- #:export (%test-opensmtpd))
+ #:use-module (ice-9 ftw)
+ #:export (%test-opensmtpd
+ %test-exim))
(define %opensmtpd-os
(simple-operating-system
@@ -146,3 +149,133 @@ accept from any for local deliver to mbox
(name "opensmtpd")
(description "Send an email to a running OpenSMTPD server.")
(value (run-opensmtpd-test))))
+
+
+(define %exim-os
+ (simple-operating-system
+ (dhcp-client-service)
+ (service mail-aliases-service-type '())
+ (service exim-service-type
+ (exim-configuration
+ (config-file
+ (plain-file "exim.conf" "
+primary_hostname = komputilo
+domainlist local_domains = @
+domainlist relay_to_domains =
+hostlist relay_from_hosts = localhost
+
+never_users =
+
+acl_smtp_rcpt = acl_check_rcpt
+acl_smtp_data = acl_check_data
+
+begin acl
+
+acl_check_rcpt:
+ accept
+acl_check_data:
+ accept
+"))))))
+
+(define (run-exim-test)
+ "Return a test of an OS running an Exim service."
+ (mlet* %store-monad ((command (system-qemu-image/shared-store-script
+ (marionette-operating-system
+ %exim-os
+ #:imported-modules '((gnu services herd)))
+ #:graphic? #f)))
+ (define test
+ (with-imported-modules '((gnu build marionette)
+ (ice-9 ftw))
+ #~(begin
+ (use-modules (rnrs base)
+ (srfi srfi-64)
+ (ice-9 ftw)
+ (ice-9 rdelim)
+ (ice-9 regex)
+ (gnu build marionette))
+
+ (define marionette
+ (make-marionette
+ ;; Enable TCP forwarding of the guest's port 25.
+ '(#$command "-net" "user,hostfwd=tcp::1025-:25")))
+
+ (define (read-reply-code port)
+ "Read a SMTP reply from PORT and return its reply code."
+ (let* ((line (read-line port))
+ (mo (string-match "([0-9]+)([ -]).*" line))
+ (code (string->number (match:substring mo 1)))
+ (finished? (string= " " (match:substring mo 2))))
+ (if finished?
+ code
+ (read-reply-code port))))
+
+ (define smtp (socket AF_INET SOCK_STREAM 0))
+ (define addr (make-socket-address AF_INET INADDR_LOOPBACK 1025))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "exim")
+
+ (test-assert "service is running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'exim)
+ #t)
+ marionette))
+
+ (sleep 1) ;; give the service time to start talking
+
+ (connect smtp addr)
+ ;; Be greeted.
+ (test-eq "greeting received"
+ 220 (read-reply-code smtp))
+ ;; Greet the server.
+ (write-line "EHLO somehost" smtp)
+ (test-eq "greeting successful"
+ 250 (read-reply-code smtp))
+ ;; Set sender email.
+ (write-line "MAIL FROM: test@example.com" smtp)
+ (test-eq "sender set"
+ 250 (read-reply-code smtp)) ;250
+ ;; Set recipient email.
+ (write-line "RCPT TO: root@komputilo" smtp)
+ (test-eq "recipient set"
+ 250 (read-reply-code smtp)) ;250
+ ;; Send message.
+ (write-line "DATA" smtp)
+ (test-eq "data begun"
+ 354 (read-reply-code smtp)) ;354
+ (write-line "Subject: Hello" smtp)
+ (newline smtp)
+ (write-line "Nice to meet you!" smtp)
+ (write-line "." smtp)
+ (test-eq "message sent"
+ 250 (read-reply-code smtp)) ;250
+ ;; Say goodbye.
+ (write-line "QUIT" smtp)
+ (test-eq "quit successful"
+ 221 (read-reply-code smtp)) ;221
+ (close smtp)
+
+ (test-eq "the email is received"
+ 1
+ (marionette-eval
+ '(begin
+ (use-modules (ice-9 ftw))
+ (length (scandir "/var/spool/exim/msglog"
+ (lambda (x) (not (string-prefix? "." x))))))
+ marionette))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation "exim-test" test)))
+
+(define %test-exim
+ (system-test
+ (name "exim")
+ (description "Send an email to a running an Exim server.")
+ (value (run-exim-test))))
diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm
index 1f28f5a5b8..9e1ac1d55a 100644
--- a/gnu/tests/nfs.scm
+++ b/gnu/tests/nfs.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 John Darrington <jmd@gnu.org>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -19,8 +20,8 @@
(define-module (gnu tests nfs)
#:use-module (gnu tests)
+ #:use-module (gnu bootloader grub)
#: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)
diff --git a/gnu/tests/ssh.scm b/gnu/tests/ssh.scm
index 02931e982a..5f06151081 100644
--- a/gnu/tests/ssh.scm
+++ b/gnu/tests/ssh.scm
@@ -51,7 +51,7 @@ When SFTP? is true, run an SFTP server test."
(eval-when (expand load eval)
;; Prepare to use Guile-SSH.
(set! %load-path
- (cons (string-append #$guile-ssh "/share/guile/site/"
+ (cons (string-append #+guile2.0-ssh "/share/guile/site/"
(effective-version))
%load-path)))
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm
index cdc5791237..bc7e3b89a9 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -19,7 +19,6 @@
(define-module (gnu tests web)
#: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)
generated by cgit v1.2.3 (git 2.45.0) at 2024-12-02 10:01:39 +0000