nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

tests: Use 'virtual-machine' records instead of monadic procedures. 

* gnu/tests/base.scm (%test-basic-os): Use 'let*' instead of 'mlet*' and
'virtual-machine' instead of 'system-qemu-image/shared-store-script'.
(run-mcron-test): Likewise.
(run-nss-mdns-test): Likewise.
* gnu/tests/dict.scm (run-dicod-test): Likewise.
* gnu/tests/mail.scm (run-opensmtpd-test): Likewise.
(run-exim-test): Likewise.
* gnu/tests/messaging.scm (run-xmpp-test): Likewise.
* gnu/tests/networking.scm (run-inetd-test): Likewise.
* gnu/tests/nfs.scm (run-nfs-test): Likewise.
* gnu/tests/ssh.scm (run-ssh-test): Likewise.
* gnu/tests/web.scm (run-nginx-test): Likewise.
master
Ludovic Courtès 2017-07-18 10:41:51 +02:00
parent ed419fa0c5
commit 8b113790fa
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
8 changed files with 744 additions and 741 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

264
gnu/tests/base.scm
View File

@ -34,7 +34,6 @@
#:use-module (gnu packages package-management) #:use-module (gnu packages package-management)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:export (run-basic-test #:export (run-basic-test
@ -393,17 +392,16 @@ info --version")
"Instrument %SIMPLE-OS, run it in a VM, and run a series of basic "Instrument %SIMPLE-OS, run it in a VM, and run a series of basic
functionality tests.") functionality tests.")
(value (value
(mlet* %store-monad ((os -> (marionette-operating-system (let* ((os (marionette-operating-system
%simple-os %simple-os
#:imported-modules '((gnu services herd) #:imported-modules '((gnu services herd)
(guix combinators)))) (guix combinators))))
(run (system-qemu-image/shared-store-script (vm (virtual-machine os)))
os #:graphic? #f)))
;; XXX: Add call to 'virtualized-operating-system' to get the exact same ;; XXX: Add call to 'virtualized-operating-system' to get the exact same
;; set of services as the OS produced by ;; set of services as the OS produced by
;; 'system-qemu-image/shared-store-script'. ;; 'system-qemu-image/shared-store-script'.
(run-basic-test (virtualized-operating-system os '()) (run-basic-test (virtualized-operating-system os '())
#~(list #$run)))))) #~(list #$vm))))))
;;; ;;;
@ -430,60 +428,60 @@ functionality tests.")
(mcron-service (list job1 job2 job3))))) (mcron-service (list job1 job2 job3)))))
(define (run-mcron-test name) (define (run-mcron-test name)
(mlet* %store-monad ((os -> (marionette-operating-system (define os
%mcron-os (marionette-operating-system
#:imported-modules '((gnu services herd) %mcron-os
(guix combinators)))) #:imported-modules '((gnu services herd)
(command (system-qemu-image/shared-store-script (guix combinators))))
os #:graphic? #f)))
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (gnu build marionette)
(srfi srfi-64)
(ice-9 match))
(define marionette (define test
(make-marionette (list #$command))) (with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (gnu build marionette)
(srfi srfi-64)
(ice-9 match))
(mkdir #$output) (define marionette
(chdir #$output) (make-marionette (list #$(virtual-machine os))))
(test-begin "mcron") (mkdir #$output)
(chdir #$output)
(test-eq "service running" (test-begin "mcron")
'running!
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'mcron)
'running!)
marionette))
;; Make sure root's mcron job runs, has its cwd set to "/root", and (test-eq "service running"
;; runs with the right UID/GID. 'running!
(test-equal "root's job" (marionette-eval
'(0 0) '(begin
(wait-for-file "/root/witness" marionette)) (use-modules (gnu services herd))
(start-service 'mcron)
'running!)
marionette))
;; Likewise for Alice's job. We cannot know what its GID is since ;; Make sure root's mcron job runs, has its cwd set to "/root", and
;; it's chosen by 'groupadd', but it's strictly positive. ;; runs with the right UID/GID.
(test-assert "alice's job" (test-equal "root's job"
(match (wait-for-file "/home/alice/witness" marionette) '(0 0)
((1000 gid) (wait-for-file "/root/witness" marionette))
(>= gid 100))))
;; Last, the job that uses a command; allows us to test whether ;; Likewise for Alice's job. We cannot know what its GID is since
;; $PATH is sane. (Note that 'marionette-eval' stringifies objects ;; it's chosen by 'groupadd', but it's strictly positive.
;; that don't have a read syntax, hence the string.) (test-assert "alice's job"
(test-equal "root's job with command" (match (wait-for-file "/home/alice/witness" marionette)
"#<eof>" ((1000 gid)
(wait-for-file "/root/witness-touch" marionette)) (>= gid 100))))
(test-end) ;; Last, the job that uses a command; allows us to test whether
(exit (= (test-runner-fail-count (test-runner-current)) 0))))) ;; $PATH is sane. (Note that 'marionette-eval' stringifies objects
;; that don't have a read syntax, hence the string.)
(test-equal "root's job with command"
"#<eof>"
(wait-for-file "/root/witness-touch" marionette))
(gexp->derivation name test))) (test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation name test))
(define %test-mcron (define %test-mcron
(system-test (system-test
@ -526,102 +524,102 @@ functionality tests.")
;; *after* nscd. Failing to do that, libc will try to connect to nscd, ;; *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), ;; fail, then never try again (see '__nss_not_use_nscd_hosts' in libc),
;; leading to '.local' resolution failures. ;; leading to '.local' resolution failures.
(mlet* %store-monad ((os -> (marionette-operating-system (define os
%avahi-os (marionette-operating-system
#:requirements '(nscd) %avahi-os
#:imported-modules '((gnu services herd) #:requirements '(nscd)
(guix combinators)))) #:imported-modules '((gnu services herd)
(run (system-qemu-image/shared-store-script (guix combinators))))
os #:graphic? #f)))
(define mdns-host-name
(string-append (operating-system-host-name os)
".local"))
(define test (define mdns-host-name
(with-imported-modules '((gnu build marionette)) (string-append (operating-system-host-name os)
#~(begin ".local"))
(use-modules (gnu build marionette)
(srfi srfi-1)
(srfi srfi-64)
(ice-9 match))
(define marionette (define test
(make-marionette (list #$run))) (with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (gnu build marionette)
(srfi srfi-1)
(srfi srfi-64)
(ice-9 match))
(mkdir #$output) (define marionette
(chdir #$output) (make-marionette (list #$(virtual-machine os))))
(test-begin "avahi") (mkdir #$output)
(chdir #$output)
(test-assert "wait for services" (test-begin "avahi")
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'nscd) (test-assert "wait for services"
(marionette-eval
'(begin
(use-modules (gnu services herd))
;; XXX: Work around a race condition in nscd: nscd creates its (start-service 'nscd)
;; 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~%"))
(lambda args
(format #t "waiting for nscd...~%")
(usleep 500000)
(try)))))
;; Wait for the other useful things. ;; XXX: Work around a race condition in nscd: nscd creates its
(start-service 'avahi-daemon) ;; PID file before it is listening on its socket.
(start-service 'networking) (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~%"))
(lambda args
(format #t "waiting for nscd...~%")
(usleep 500000)
(try)))))
#t) ;; Wait for the other useful things.
marionette)) (start-service 'avahi-daemon)
(start-service 'networking)
(test-equal "avahi-resolve-host-name" #t)
0 marionette))
(marionette-eval
'(system*
"/run/current-system/profile/bin/avahi-resolve-host-name"
"-v" #$mdns-host-name)
marionette))
(test-equal "avahi-browse" (test-equal "avahi-resolve-host-name"
0 0
(marionette-eval (marionette-eval
'(system* "avahi-browse" "-avt") '(system*
marionette)) "/run/current-system/profile/bin/avahi-resolve-host-name"
"-v" #$mdns-host-name)
marionette))
(test-assert "getaddrinfo .local" (test-equal "avahi-browse"
;; Wait for the 'avahi-daemon' service and perform a resolution. 0
(match (marionette-eval (marionette-eval
'(getaddrinfo #$mdns-host-name) '(system* "avahi-browse" "-avt")
marionette) 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" (test-assert "getaddrinfo .local"
(match (pk 'gethostbyname ;; Wait for the 'avahi-daemon' service and perform a resolution.
(marionette-eval '(gethostbyname #$mdns-host-name) (match (marionette-eval
marionette)) '(getaddrinfo #$mdns-host-name)
((? vector? result) marionette)
(and (string=? (hostent:name result) #$mdns-host-name) (((? vector? addrinfos) ..1)
(= (hostent:addrtype result) AF_INET))))) (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) (test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0))))) (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "nss-mdns" test))) (gexp->derivation "nss-mdns" test))
(define %test-nss-mdns (define %test-nss-mdns
(system-test (system-test

145
gnu/tests/dict.scm
View File

@ -27,7 +27,6 @@
#:use-module (gnu packages wordnet) #:use-module (gnu packages wordnet)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix modules) #:use-module (guix modules)
#:export (%test-dicod)) #:export (%test-dicod))
@ -54,86 +53,90 @@
(define* (run-dicod-test) (define* (run-dicod-test)
"Run tests of 'dicod-service-type'." "Run tests of 'dicod-service-type'."
(mlet* %store-monad ((os -> (marionette-operating-system (define os
%dicod-os (marionette-operating-system
#:imported-modules %dicod-os
(source-module-closure '((gnu services herd))))) #:imported-modules
(command (system-qemu-image/shared-store-script (source-module-closure '((gnu services herd)))))
os #:graphic? #f)))
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (ice-9 rdelim)
(ice-9 regex)
(srfi srfi-64)
(gnu build marionette))
(define marionette
;; Forward the guest's DICT port to local port 8000.
(make-marionette (list #$command "-net"
"user,hostfwd=tcp::8000-:2628")))
(define %dico-socket (define vm
(socket PF_INET SOCK_STREAM 0)) (virtual-machine
(operating-system os)
(port-forwardings '((8000 . 2628)))))
(mkdir #$output) (define test
(chdir #$output) (with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (ice-9 rdelim)
(ice-9 regex)
(srfi srfi-64)
(gnu build marionette))
(define marionette
;; Forward the guest's DICT port to local port 8000.
(make-marionette (list #$vm)))
(test-begin "dicod") (define %dico-socket
(socket PF_INET SOCK_STREAM 0))
;; Wait for the service to be started. (mkdir #$output)
(test-eq "service is running" (chdir #$output)
'running!
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'dicod)
'running!)
marionette))
;; Wait until dicod is actually listening. (test-begin "dicod")
;; TODO: Use a PID file instead.
(test-assert "connect inside"
(marionette-eval
'(begin
(use-modules (ice-9 rdelim))
(let ((sock (socket PF_INET SOCK_STREAM 0)))
(let loop ((i 0))
(pk 'try i)
(catch 'system-error
(lambda ()
(connect sock AF_INET INADDR_LOOPBACK 2628))
(lambda args
(pk 'connection-error args)
(when (< i 20)
(sleep 1)
(loop (+ 1 i))))))
(read-line sock 'concat)))
marionette))
(test-assert "connect" ;; Wait for the service to be started.
(let ((addr (make-socket-address AF_INET INADDR_LOOPBACK 8000))) (test-eq "service is running"
(connect %dico-socket addr) 'running!
(read-line %dico-socket 'concat))) (marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'dicod)
'running!)
marionette))
(test-equal "CLIENT" ;; Wait until dicod is actually listening.
"250 ok\r\n" ;; TODO: Use a PID file instead.
(begin (test-assert "connect inside"
(display "CLIENT \"GNU Guile\"\r\n" %dico-socket) (marionette-eval
(read-line %dico-socket 'concat))) '(begin
(use-modules (ice-9 rdelim))
(let ((sock (socket PF_INET SOCK_STREAM 0)))
(let loop ((i 0))
(pk 'try i)
(catch 'system-error
(lambda ()
(connect sock AF_INET INADDR_LOOPBACK 2628))
(lambda args
(pk 'connection-error args)
(when (< i 20)
(sleep 1)
(loop (+ 1 i))))))
(read-line sock 'concat)))
marionette))
(test-assert "DEFINE" (test-assert "connect"
(begin (let ((addr (make-socket-address AF_INET INADDR_LOOPBACK 8000)))
(display "DEFINE ! hello\r\n" %dico-socket) (connect %dico-socket addr)
(display "QUIT\r\n" %dico-socket) (read-line %dico-socket 'concat)))
(let ((result (read-string %dico-socket)))
(and (string-contains result "gcide")
(string-contains result "hello")
result))))
(test-end) (test-equal "CLIENT"
(exit (= (test-runner-fail-count (test-runner-current)) 0))))) "250 ok\r\n"
(begin
(display "CLIENT \"GNU Guile\"\r\n" %dico-socket)
(read-line %dico-socket 'concat)))
(gexp->derivation "dicod" test))) (test-assert "DEFINE"
(begin
(display "DEFINE ! hello\r\n" %dico-socket)
(display "QUIT\r\n" %dico-socket)
(let ((result (read-string %dico-socket)))
(and (string-contains result "gcide")
(string-contains result "hello")
result))))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "dicod" test))
(define %test-dicod (define %test-dicod
(system-test (system-test

342
gnu/tests/mail.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org> ;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org>
;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au> ;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au>
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -25,7 +26,6 @@
#:use-module (gnu services mail) #:use-module (gnu services mail)
#:use-module (gnu services networking) #:use-module (gnu services networking)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix store) #:use-module (guix store)
#:use-module (ice-9 ftw) #:use-module (ice-9 ftw)
#:export (%test-opensmtpd #:export (%test-opensmtpd
@ -44,105 +44,105 @@ accept from any for local deliver to mbox
(define (run-opensmtpd-test) (define (run-opensmtpd-test)
"Return a test of an OS running OpenSMTPD service." "Return a test of an OS running OpenSMTPD service."
(mlet* %store-monad ((command (system-qemu-image/shared-store-script (define vm
(marionette-operating-system (virtual-machine
%opensmtpd-os (operating-system (marionette-operating-system
#:imported-modules '((gnu services herd))) %opensmtpd-os
#:graphic? #f))) #:imported-modules '((gnu services herd))))
(define test (port-forwardings '((1025 . 25)))))
(with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (rnrs base)
(srfi srfi-64)
(ice-9 rdelim)
(ice-9 regex)
(gnu build marionette))
(define marionette (define test
(make-marionette (with-imported-modules '((gnu build marionette))
;; Enable TCP forwarding of the guest's port 25. #~(begin
'(#$command "-net" "user,hostfwd=tcp::1025-:25"))) (use-modules (rnrs base)
(srfi srfi-64)
(ice-9 rdelim)
(ice-9 regex)
(gnu build marionette))
(define (read-reply-code port) (define marionette
"Read a SMTP reply from PORT and return its reply code." (make-marionette '(#$vm)))
(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))))
(mkdir #$output) (define (read-reply-code port)
(chdir #$output) "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))))
(test-begin "opensmptd") (mkdir #$output)
(chdir #$output)
(test-assert "service is running" (test-begin "opensmptd")
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'smtpd)
#t)
marionette))
(test-assert "mbox is empty" (test-assert "service is running"
(marionette-eval (marionette-eval
'(and (file-exists? "/var/mail") '(begin
(not (file-exists? "/var/mail/root"))) (use-modules (gnu services herd))
marionette)) (start-service 'smtpd)
#t)
marionette))
(test-eq "accept an email" (test-assert "mbox is empty"
#t (marionette-eval
(let* ((smtp (socket AF_INET SOCK_STREAM 0)) '(and (file-exists? "/var/mail")
(addr (make-socket-address AF_INET INADDR_LOOPBACK 1025))) (not (file-exists? "/var/mail/root")))
(connect smtp addr) marionette))
;; Be greeted.
(read-reply-code smtp) ;220
;; Greet the server.
(write-line "EHLO somehost" smtp)
(read-reply-code smtp) ;250
;; Set sender email.
(write-line "MAIL FROM: <someone>" smtp)
(read-reply-code smtp) ;250
;; Set recipient email.
(write-line "RCPT TO: <root>" smtp)
(read-reply-code smtp) ;250
;; Send message.
(write-line "DATA" smtp)
(read-reply-code smtp) ;354
(write-line "Subject: Hello" smtp)
(newline smtp)
(write-line "Nice to meet you!" smtp)
(write-line "." smtp)
(read-reply-code smtp) ;250
;; Say goodbye.
(write-line "QUIT" smtp)
(read-reply-code smtp) ;221
(close smtp)
#t))
(test-assert "mail arrived" (test-eq "accept an email"
(marionette-eval #t
'(begin (let* ((smtp (socket AF_INET SOCK_STREAM 0))
(use-modules (ice-9 popen) (addr (make-socket-address AF_INET INADDR_LOOPBACK 1025)))
(ice-9 rdelim)) (connect smtp addr)
;; Be greeted.
(read-reply-code smtp) ;220
;; Greet the server.
(write-line "EHLO somehost" smtp)
(read-reply-code smtp) ;250
;; Set sender email.
(write-line "MAIL FROM: <someone>" smtp)
(read-reply-code smtp) ;250
;; Set recipient email.
(write-line "RCPT TO: <root>" smtp)
(read-reply-code smtp) ;250
;; Send message.
(write-line "DATA" smtp)
(read-reply-code smtp) ;354
(write-line "Subject: Hello" smtp)
(newline smtp)
(write-line "Nice to meet you!" smtp)
(write-line "." smtp)
(read-reply-code smtp) ;250
;; Say goodbye.
(write-line "QUIT" smtp)
(read-reply-code smtp) ;221
(close smtp)
#t))
(define (queue-empty?) (test-assert "mail arrived"
(eof-object? (marionette-eval
(read-line '(begin
(open-input-pipe "smtpctl show queue")))) (use-modules (ice-9 popen)
(ice-9 rdelim))
(let wait () (define (queue-empty?)
(if (queue-empty?) (eof-object?
(file-exists? "/var/mail/root") (read-line
(begin (sleep 1) (wait))))) (open-input-pipe "smtpctl show queue"))))
marionette))
(test-end) (let wait ()
(exit (= (test-runner-fail-count (test-runner-current)) 0))))) (if (queue-empty?)
(file-exists? "/var/mail/root")
(begin (sleep 1) (wait)))))
marionette))
(gexp->derivation "opensmtpd-test" test))) (test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "opensmtpd-test" test))
(define %test-opensmtpd (define %test-opensmtpd
(system-test (system-test
@ -179,100 +179,100 @@ acl_check_data:
(define (run-exim-test) (define (run-exim-test)
"Return a test of an OS running an Exim service." "Return a test of an OS running an Exim service."
(mlet* %store-monad ((command (system-qemu-image/shared-store-script (define vm
(marionette-operating-system (virtual-machine
%exim-os (operating-system (marionette-operating-system
#:imported-modules '((gnu services herd))) %exim-os
#:graphic? #f))) #:imported-modules '((gnu services herd))))
(define test (port-forwardings '((1025 . 25)))))
(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 (define test
(make-marionette (with-imported-modules '((gnu build marionette)
;; Enable TCP forwarding of the guest's port 25. (ice-9 ftw))
'(#$command "-net" "user,hostfwd=tcp::1025-:25"))) #~(begin
(use-modules (rnrs base)
(srfi srfi-64)
(ice-9 ftw)
(ice-9 rdelim)
(ice-9 regex)
(gnu build marionette))
(define (read-reply-code port) (define marionette
"Read a SMTP reply from PORT and return its reply code." (make-marionette '(#$vm)))
(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 (read-reply-code port)
(define addr (make-socket-address AF_INET INADDR_LOOPBACK 1025)) "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))))
(mkdir #$output) (define smtp (socket AF_INET SOCK_STREAM 0))
(chdir #$output) (define addr (make-socket-address AF_INET INADDR_LOOPBACK 1025))
(test-begin "exim") (mkdir #$output)
(chdir #$output)
(test-assert "service is running" (test-begin "exim")
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'exim)
#t)
marionette))
(sleep 1) ;; give the service time to start talking (test-assert "service is running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'exim)
#t)
marionette))
(connect smtp addr) (sleep 1) ;; give the service time to start talking
;; 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" (connect smtp addr)
1 ;; Be greeted.
(marionette-eval (test-eq "greeting received"
'(begin 220 (read-reply-code smtp))
(use-modules (ice-9 ftw)) ;; Greet the server.
(length (scandir "/var/spool/exim/msglog" (write-line "EHLO somehost" smtp)
(lambda (x) (not (string-prefix? "." x)))))) (test-eq "greeting successful"
marionette)) 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-end) (test-eq "the email is received"
(exit (= (test-runner-fail-count (test-runner-current)) 0))))) 1
(marionette-eval
'(begin
(use-modules (ice-9 ftw))
(length (scandir "/var/spool/exim/msglog"
(lambda (x) (not (string-prefix? "." x))))))
marionette))
(gexp->derivation "exim-test" test))) (test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "exim-test" test))
(define %test-exim (define %test-exim
(system-test (system-test

172
gnu/tests/messaging.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -26,108 +27,109 @@
#:use-module (gnu packages messaging) #:use-module (gnu packages messaging)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix monads)
#:export (%test-prosody)) #:export (%test-prosody))
(define (run-xmpp-test name xmpp-service pid-file create-account) (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." "Run a test of an OS running XMPP-SERVICE, which writes its PID to PID-FILE."
(mlet* %store-monad ((os -> (marionette-operating-system (define os
(simple-operating-system (dhcp-client-service) (marionette-operating-system
xmpp-service) (simple-operating-system (dhcp-client-service)
#:imported-modules '((gnu services herd)))) xmpp-service)
(command (system-qemu-image/shared-store-script #:imported-modules '((gnu services herd))))
os #:graphic? #f))
(username -> "alice")
(server -> "localhost")
(jid -> (string-append username "@" server))
(password -> "correct horse battery staple")
(port -> 15222)
(message -> "hello world")
(witness -> "/tmp/freetalk-witness"))
(define script.ft (define port 15222)
(scheme-file
"script.ft"
#~(begin
(define (handle-received-message time from nickname message)
(define (touch file-name)
(call-with-output-file file-name (const #t)))
(when (equal? message #$message)
(touch #$witness)))
(add-hook! ft-message-receive-hook handle-received-message)
(ft-set-jid! #$jid) (define vm
(ft-set-password! #$password) (virtual-machine
(ft-set-server! #$server) (operating-system os)
(ft-set-port! #$port) (port-forwardings `((,port . 5222)))))
(ft-set-sslconn! #f)
(ft-connect-blocking)
(ft-send-message #$jid #$message)
(ft-set-daemon) (define username "alice")
(ft-main-loop)))) (define server "localhost")
(define jid (string-append username "@" server))
(define password "correct horse battery staple")
(define message "hello world")
(define witness "/tmp/freetalk-witness")
(define test (define script.ft
(with-imported-modules '((gnu build marionette)) (scheme-file
#~(begin "script.ft"
(use-modules (gnu build marionette) #~(begin
(srfi srfi-64)) (define (handle-received-message time from nickname message)
(define (touch file-name)
(call-with-output-file file-name (const #t)))
(when (equal? message #$message)
(touch #$witness)))
(add-hook! ft-message-receive-hook handle-received-message)
(define marionette (ft-set-jid! #$jid)
;; Enable TCP forwarding of the guest's port 5222. (ft-set-password! #$password)
(make-marionette (list #$command "-net" (ft-set-server! #$server)
(string-append "user,hostfwd=tcp::" (ft-set-port! #$port)
(number->string #$port) (ft-set-sslconn! #f)
"-:5222")))) (ft-connect-blocking)
(ft-send-message #$jid #$message)
(define (host-wait-for-file file) (ft-set-daemon)
;; Wait until FILE exists in the host. (ft-main-loop))))
(let loop ((i 60))
(cond ((file-exists? file)
#t)
((> i 0)
(begin
(sleep 1))
(loop (- i 1)))
(else
(error "file didn't show up" file)))))
(mkdir #$output) (define test
(chdir #$output) (with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (gnu build marionette)
(srfi srfi-64))
(test-begin "xmpp") (define marionette
(make-marionette (list #$vm)))
;; Wait for XMPP service to be up and running. (define (host-wait-for-file file)
(test-eq "service running" ;; Wait until FILE exists in the host.
'running! (let loop ((i 60))
(marionette-eval (cond ((file-exists? file)
'(begin #t)
(use-modules (gnu services herd)) ((> i 0)
(start-service 'xmpp-daemon) (begin
'running!) (sleep 1))
marionette)) (loop (- i 1)))
(else
(error "file didn't show up" file)))))
;; Check XMPP service's PID. (mkdir #$output)
(test-assert "service process id" (chdir #$output)
(let ((pid (number->string (wait-for-file #$pid-file
marionette))))
(marionette-eval `(file-exists? (string-append "/proc/" ,pid))
marionette)))
;; Alice sends an XMPP message to herself, with Freetalk. (test-begin "xmpp")
(test-assert "client-to-server communication"
(let ((freetalk-bin (string-append #$freetalk "/bin/freetalk")))
(marionette-eval '(system* #$create-account #$jid #$password)
marionette)
;; Freetalk requires write access to $HOME.
(setenv "HOME" "/tmp")
(system* freetalk-bin "-s" #$script.ft)
(host-wait-for-file #$witness)))
(test-end) ;; Wait for XMPP service to be up and running.
(exit (= (test-runner-fail-count (test-runner-current)) 0))))) (test-eq "service running"
'running!
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'xmpp-daemon)
'running!)
marionette))
(gexp->derivation name test))) ;; Check XMPP service's PID.
(test-assert "service process id"
(let ((pid (number->string (wait-for-file #$pid-file
marionette))))
(marionette-eval `(file-exists? (string-append "/proc/" ,pid))
marionette)))
;; Alice sends an XMPP message to herself, with Freetalk.
(test-assert "client-to-server communication"
(let ((freetalk-bin (string-append #$freetalk "/bin/freetalk")))
(marionette-eval '(system* #$create-account #$jid #$password)
marionette)
;; Freetalk requires write access to $HOME.
(setenv "HOME" "/tmp")
(system* freetalk-bin "-s" #$script.ft)
(host-wait-for-file #$witness)))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation name test))
(define %create-prosody-account (define %create-prosody-account
(program-file (program-file

95
gnu/tests/networking.scm
View File

@ -74,60 +74,61 @@ done" ))))))))))
(define* (run-inetd-test) (define* (run-inetd-test)
"Run tests in %INETD-OS, where the inetd service provides an echo service on "Run tests in %INETD-OS, where the inetd service provides an echo service on
port 7, and a dict service on port 2628." port 7, and a dict service on port 2628."
(mlet* %store-monad ((os -> (marionette-operating-system %inetd-os)) (define os
(command (system-qemu-image/shared-store-script (marionette-operating-system %inetd-os))
os #:graphic? #f)))
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (ice-9 rdelim)
(srfi srfi-64)
(gnu build marionette))
(define marionette
;; Forward guest ports 7 and 2628 to host ports 8007 and 8628.
(make-marionette (list #$command "-net"
(string-append
"user"
",hostfwd=tcp::8007-:7"
",hostfwd=tcp::8628-:2628"))))
(mkdir #$output) (define vm
(chdir #$output) (virtual-machine
(operating-system os)
(port-forwardings `((8007 . 7)
(8628 . 2628)))))
(test-begin "inetd") (define test
(with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (ice-9 rdelim)
(srfi srfi-64)
(gnu build marionette))
(define marionette
(make-marionette (list #$vm)))
;; Make sure the PID file is created. (mkdir #$output)
(test-assert "PID file" (chdir #$output)
(marionette-eval
'(file-exists? "/var/run/inetd.pid")
marionette))
;; Test the echo service. (test-begin "inetd")
(test-equal "echo response"
"Hello, Guix!"
(let ((echo (socket PF_INET SOCK_STREAM 0))
(addr (make-socket-address AF_INET INADDR_LOOPBACK 8007)))
(connect echo addr)
(display "Hello, Guix!\n" echo)
(let ((response (read-line echo)))
(close echo)
response)))
;; Test the dict service ;; Make sure the PID file is created.
(test-equal "dict response" (test-assert "PID file"
"GNU Guix is a package management tool for the GNU system." (marionette-eval
(let ((dict (socket PF_INET SOCK_STREAM 0)) '(file-exists? "/var/run/inetd.pid")
(addr (make-socket-address AF_INET INADDR_LOOPBACK 8628))) marionette))
(connect dict addr)
(display "DEFINE Guix\n" dict)
(let ((response (read-line dict)))
(close dict)
response)))
(test-end) ;; Test the echo service.
(exit (= (test-runner-fail-count (test-runner-current)) 0))))) (test-equal "echo response"
"Hello, Guix!"
(let ((echo (socket PF_INET SOCK_STREAM 0))
(addr (make-socket-address AF_INET INADDR_LOOPBACK 8007)))
(connect echo addr)
(display "Hello, Guix!\n" echo)
(let ((response (read-line echo)))
(close echo)
response)))
(gexp->derivation "inetd-test" test))) ;; Test the dict service
(test-equal "dict response"
"GNU Guix is a package management tool for the GNU system."
(let ((dict (socket PF_INET SOCK_STREAM 0))
(addr (make-socket-address AF_INET INADDR_LOOPBACK 8628)))
(connect dict addr)
(display "DEFINE Guix\n" dict)
(let ((response (read-line dict)))
(close dict)
response)))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "inetd-test" test))
(define %test-inetd (define %test-inetd
(system-test (system-test

120
gnu/tests/nfs.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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 © 2016 John Darrington <jmd@gnu.org> ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; ;;;
@ -55,75 +55,75 @@
(define (run-nfs-test name socket) (define (run-nfs-test name socket)
"Run a test of an OS running RPC-SERVICE, which should create SOCKET." "Run a test of an OS running RPC-SERVICE, which should create SOCKET."
(mlet* %store-monad ((os -> (marionette-operating-system (define os
%base-os (marionette-operating-system
#:imported-modules '((gnu services herd) %base-os
(guix combinators)))) #:imported-modules '((gnu services herd)
(command (system-qemu-image/shared-store-script (guix combinators))))
os #:graphic? #f)))
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (gnu build marionette)
(srfi srfi-64))
(define marionette (define test
(make-marionette (list #$command))) (with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (gnu build marionette)
(srfi srfi-64))
(define (wait-for-socket file) (define marionette
;; Wait until SOCKET exists in the guest (make-marionette (list #$(virtual-machine os))))
(marionette-eval
`(let loop ((i 10))
(cond ((and (file-exists? ,file)
(eq? 'socket (stat:type (stat ,file))))
#t)
((> i 0)
(sleep 1)
(loop (- i 1)))
(else
(error "Socket didn't show up: " ,file))))
marionette))
(mkdir #$output) (define (wait-for-socket file)
(chdir #$output) ;; Wait until SOCKET exists in the guest
(marionette-eval
`(let loop ((i 10))
(cond ((and (file-exists? ,file)
(eq? 'socket (stat:type (stat ,file))))
#t)
((> i 0)
(sleep 1)
(loop (- i 1)))
(else
(error "Socket didn't show up: " ,file))))
marionette))
(test-begin "rpc-daemon") (mkdir #$output)
(chdir #$output)
;; Wait for the rpcbind daemon to be up and running. (test-begin "rpc-daemon")
(test-eq "RPC service running"
'running!
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'rpcbind-daemon)
'running!)
marionette))
;; Check the socket file and that the service is still running. ;; Wait for the rpcbind daemon to be up and running.
(test-assert "RPC socket exists" (test-eq "RPC service running"
(and 'running!
(wait-for-socket #$socket) (marionette-eval
(marionette-eval '(begin
'(begin (use-modules (gnu services herd))
(use-modules (gnu services herd) (start-service 'rpcbind-daemon)
(srfi srfi-1)) 'running!)
marionette))
(live-service-running ;; Check the socket file and that the service is still running.
(find (lambda (live) (test-assert "RPC socket exists"
(memq 'rpcbind-daemon (and
(live-service-provision live))) (wait-for-socket #$socket)
(current-services)))) (marionette-eval
marionette))) '(begin
(use-modules (gnu services herd)
(srfi srfi-1))
(test-assert "Probe RPC daemon" (live-service-running
(marionette-eval (find (lambda (live)
'(zero? (system* "rpcinfo" "-p")) (memq 'rpcbind-daemon
marionette)) (live-service-provision live)))
(current-services))))
marionette)))
(test-end) (test-assert "Probe RPC daemon"
(exit (= (test-runner-fail-count (test-runner-current)) 0))))) (marionette-eval
'(zero? (system* "rpcinfo" "-p"))
marionette))
(gexp->derivation name test))) (test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation name test))
(define %test-nfs (define %test-nfs
(system-test (system-test

240
gnu/tests/ssh.scm
View File

@ -27,7 +27,6 @@
#:use-module (gnu packages ssh) #:use-module (gnu packages ssh)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix monads)
#:export (%test-openssh #:export (%test-openssh
%test-dropbear)) %test-dropbear))
@ -37,142 +36,143 @@ SSH-SERVICE must be configured to listen on port 22 and to allow for root and
empty-password logins. empty-password logins.
When SFTP? is true, run an SFTP server test." When SFTP? is true, run an SFTP server test."
(mlet* %store-monad ((os -> (marionette-operating-system (define os
(simple-operating-system (marionette-operating-system
(dhcp-client-service) (simple-operating-system (dhcp-client-service) ssh-service)
ssh-service) #:imported-modules '((gnu services herd)
#:imported-modules '((gnu services herd) (guix combinators))))
(guix combinators)))) (define vm
(command (system-qemu-image/shared-store-script (virtual-machine
os #:graphic? #f))) (operating-system os)
(define test (port-forwardings '((2222 . 22)))))
(with-imported-modules '((gnu build marionette))
#~(begin
(eval-when (expand load eval)
;; Prepare to use Guile-SSH.
(set! %load-path
(cons (string-append #+guile2.0-ssh "/share/guile/site/"
(effective-version))
%load-path)))
(use-modules (gnu build marionette) (define test
(srfi srfi-26) (with-imported-modules '((gnu build marionette))
(srfi srfi-64) #~(begin
(ice-9 match) (eval-when (expand load eval)
(ssh session) ;; Prepare to use Guile-SSH.
(ssh auth) (set! %load-path
(ssh channel) (cons (string-append #+guile2.0-ssh "/share/guile/site/"
(ssh sftp)) (effective-version))
%load-path)))
(define marionette (use-modules (gnu build marionette)
;; Enable TCP forwarding of the guest's port 22. (srfi srfi-26)
(make-marionette (list #$command "-net" (srfi srfi-64)
"user,hostfwd=tcp::2222-:22"))) (ice-9 match)
(ssh session)
(ssh auth)
(ssh channel)
(ssh sftp))
(define (make-session-for-test) (define marionette
"Make a session with predefined parameters for a test." ;; Enable TCP forwarding of the guest's port 22.
(make-session #:user "root" (make-marionette (list #$vm)))
#:port 2222
#:host "localhost"
#:log-verbosity 'protocol))
(define (call-with-connected-session proc) (define (make-session-for-test)
"Call the one-argument procedure PROC with a freshly created and "Make a session with predefined parameters for a test."
(make-session #:user "root"
#:port 2222
#:host "localhost"
#:log-verbosity 'protocol))
(define (call-with-connected-session proc)
"Call the one-argument procedure PROC with a freshly created and
connected SSH session object, return the result of the procedure call. The connected SSH session object, return the result of the procedure call. The
session is disconnected when the PROC is finished." session is disconnected when the PROC is finished."
(let ((session (make-session-for-test))) (let ((session (make-session-for-test)))
(dynamic-wind (dynamic-wind
(lambda () (lambda ()
(let ((result (connect! session))) (let ((result (connect! session)))
(unless (equal? result 'ok) (unless (equal? result 'ok)
(error "Could not connect to a server" (error "Could not connect to a server"
session result)))) session result))))
(lambda () (proc session)) (lambda () (proc session))
(lambda () (disconnect! session))))) (lambda () (disconnect! session)))))
(define (call-with-connected-session/auth proc) (define (call-with-connected-session/auth proc)
"Make an authenticated session. We should be able to connect as "Make an authenticated session. We should be able to connect as
root with an empty password." root with an empty password."
(call-with-connected-session (call-with-connected-session
(lambda (session) (lambda (session)
;; Try the simple authentication methods. Dropbear requires ;; Try the simple authentication methods. Dropbear requires
;; 'none' when there are no passwords, whereas OpenSSH accepts ;; 'none' when there are no passwords, whereas OpenSSH accepts
;; 'password' with an empty password. ;; 'password' with an empty password.
(let loop ((methods (list (cut userauth-password! <> "") (let loop ((methods (list (cut userauth-password! <> "")
(cut userauth-none! <>)))) (cut userauth-none! <>))))
(match methods (match methods
(() (()
(error "all the authentication methods failed")) (error "all the authentication methods failed"))
((auth rest ...) ((auth rest ...)
(match (pk 'auth (auth session)) (match (pk 'auth (auth session))
('success ('success
(proc session)) (proc session))
('denied ('denied
(loop rest))))))))) (loop rest)))))))))
(mkdir #$output) (mkdir #$output)
(chdir #$output) (chdir #$output)
(test-begin "ssh-daemon") (test-begin "ssh-daemon")
;; Wait for sshd to be up and running. ;; Wait for sshd to be up and running.
(test-eq "service running" (test-eq "service running"
'running! 'running!
(marionette-eval (marionette-eval
'(begin '(begin
(use-modules (gnu services herd)) (use-modules (gnu services herd))
(start-service 'ssh-daemon) (start-service 'ssh-daemon)
'running!) 'running!)
marionette)) marionette))
;; Check sshd's PID file. ;; Check sshd's PID file.
(test-equal "sshd PID" (test-equal "sshd PID"
(wait-for-file #$pid-file marionette) (wait-for-file #$pid-file marionette)
(marionette-eval (marionette-eval
'(begin '(begin
(use-modules (gnu services herd) (use-modules (gnu services herd)
(srfi srfi-1)) (srfi srfi-1))
(live-service-running (live-service-running
(find (lambda (live) (find (lambda (live)
(memq 'ssh-daemon (memq 'ssh-daemon
(live-service-provision live))) (live-service-provision live)))
(current-services)))) (current-services))))
marionette)) marionette))
;; Connect to the guest over SSH. Make sure we can run a shell ;; Connect to the guest over SSH. Make sure we can run a shell
;; command there. ;; command there.
(test-equal "shell command" (test-equal "shell command"
'hello 'hello
(call-with-connected-session/auth (call-with-connected-session/auth
(lambda (session) (lambda (session)
;; FIXME: 'get-server-public-key' segfaults. ;; FIXME: 'get-server-public-key' segfaults.
;; (get-server-public-key session) ;; (get-server-public-key session)
(let ((channel (make-channel session))) (let ((channel (make-channel session)))
(channel-open-session channel) (channel-open-session channel)
(channel-request-exec channel "echo hello > /root/witness") (channel-request-exec channel "echo hello > /root/witness")
(and (zero? (channel-get-exit-status channel)) (and (zero? (channel-get-exit-status channel))
(wait-for-file "/root/witness" marionette)))))) (wait-for-file "/root/witness" marionette))))))
;; Connect to the guest over SFTP. Make sure we can write and ;; Connect to the guest over SFTP. Make sure we can write and
;; read a file there. ;; read a file there.
(unless #$sftp? (unless #$sftp?
(test-skip 1)) (test-skip 1))
(test-equal "SFTP file writing and reading" (test-equal "SFTP file writing and reading"
'hello 'hello
(call-with-connected-session/auth (call-with-connected-session/auth
(lambda (session) (lambda (session)
(let ((sftp-session (make-sftp-session session)) (let ((sftp-session (make-sftp-session session))
(witness "/root/sftp-witness")) (witness "/root/sftp-witness"))
(call-with-remote-output-file sftp-session witness (call-with-remote-output-file sftp-session witness
(cut display "hello" <>)) (cut display "hello" <>))
(call-with-remote-input-file sftp-session witness (call-with-remote-input-file sftp-session witness
read))))) read)))))
(test-end) (test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0))))) (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation name test))) (gexp->derivation name test))
(define %test-openssh (define %test-openssh
(system-test (system-test

107
gnu/tests/web.scm
View File

@ -27,7 +27,6 @@
#:use-module (gnu services networking) #:use-module (gnu services networking)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix monads)
#:export (%test-nginx)) #:export (%test-nginx))
(define %index.html-contents (define %index.html-contents
@ -65,68 +64,68 @@
(define* (run-nginx-test #:optional (http-port 8042)) (define* (run-nginx-test #:optional (http-port 8042))
"Run tests in %NGINX-OS, which has nginx running and listening on "Run tests in %NGINX-OS, which has nginx running and listening on
HTTP-PORT." HTTP-PORT."
(mlet* %store-monad ((os -> (marionette-operating-system (define os
%nginx-os (marionette-operating-system
#:imported-modules '((gnu services herd) %nginx-os
(guix combinators)))) #:imported-modules '((gnu services herd)
(command (system-qemu-image/shared-store-script (guix combinators))))
os #:graphic? #f)))
(define test
(with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (srfi srfi-11) (srfi srfi-64)
(gnu build marionette)
(web uri)
(web client)
(web response))
(define marionette (define vm
;; Forward the guest's HTTP-PORT, where nginx is listening, to (virtual-machine
;; port 8080 in the host. (operating-system os)
(make-marionette (list #$command "-net" (port-forwardings `((8080 . ,http-port)))))
(string-append
"user,hostfwd=tcp::8080-:"
#$(number->string http-port)))))
(mkdir #$output) (define test
(chdir #$output) (with-imported-modules '((gnu build marionette))
#~(begin
(use-modules (srfi srfi-11) (srfi srfi-64)
(gnu build marionette)
(web uri)
(web client)
(web response))
(test-begin "nginx") (define marionette
(make-marionette (list #$vm)))
;; Wait for nginx to be up and running. (mkdir #$output)
(test-eq "service running" (chdir #$output)
'running!
(marionette-eval
'(begin
(use-modules (gnu services herd))
(start-service 'nginx)
'running!)
marionette))
;; Make sure the PID file is created. (test-begin "nginx")
(test-assert "PID file"
(marionette-eval
'(file-exists? "/var/run/nginx/pid")
marionette))
;; Retrieve the index.html file we put in /srv. ;; Wait for nginx to be up and running.
(test-equal "http-get" (test-eq "service running"
'(200 #$%index.html-contents) 'running!
(let-values (((response text) (marionette-eval
(http-get "http://localhost:8080/index.html" '(begin
#:decode-body? #t))) (use-modules (gnu services herd))
(list (response-code response) text))) (start-service 'nginx)
'running!)
marionette))
;; There should be a log file in here. ;; Make sure the PID file is created.
(test-assert "log file" (test-assert "PID file"
(marionette-eval (marionette-eval
'(file-exists? "/var/log/nginx/access.log") '(file-exists? "/var/run/nginx/pid")
marionette)) marionette))
(test-end) ;; Retrieve the index.html file we put in /srv.
(exit (= (test-runner-fail-count (test-runner-current)) 0))))) (test-equal "http-get"
'(200 #$%index.html-contents)
(let-values (((response text)
(http-get "http://localhost:8080/index.html"
#:decode-body? #t)))
(list (response-code response) text)))
(gexp->derivation "nginx-test" test))) ;; There should be a log file in here.
(test-assert "log file"
(marionette-eval
'(file-exists? "/var/log/nginx/access.log")
marionette))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "nginx-test" test))
(define %test-nginx (define %test-nginx
(system-test (system-test