* [PATCH 0/2] Add a test for the Prosody service.
@ 2017-02-05 18:58 Clément Lassieur
2017-02-05 18:58 ` [PATCH 1/2] service: shepherd: Replace spaces with hyphens in file names Clément Lassieur
2017-02-05 18:58 ` [PATCH 2/2] tests: Add 'prosody-service-type' test Clément Lassieur
0 siblings, 2 replies; 10+ messages in thread
From: Clément Lassieur @ 2017-02-05 18:58 UTC (permalink / raw)
To: guix-devel
These patches add a test for the Prosody service. I chose to use GNU Freetalk
as the XMPP client because it is scriptable through a Guile interface.
Thanks for your feedback!
Clément Lassieur (2):
service: shepherd: Replace spaces with hyphens in file names.
tests: Add 'prosody-service-type' test.
gnu/services/messaging.scm | 5 +-
gnu/services/shepherd.scm | 2 +
gnu/tests/messaging.scm | 175 +++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 180 insertions(+), 2 deletions(-)
create mode 100644 gnu/tests/messaging.scm
--
2.11.0
^ permalink raw reply [flat|nested] 10+ messages in thread
* [PATCH 1/2] service: shepherd: Replace spaces with hyphens in file names.
2017-02-05 18:58 [PATCH 0/2] Add a test for the Prosody service Clément Lassieur
@ 2017-02-05 18:58 ` Clément Lassieur
2017-02-08 14:40 ` Ludovic Courtès
2017-02-05 18:58 ` [PATCH 2/2] tests: Add 'prosody-service-type' test Clément Lassieur
1 sibling, 1 reply; 10+ messages in thread
From: Clément Lassieur @ 2017-02-05 18:58 UTC (permalink / raw)
To: guix-devel
* gnu/services/shepherd.scm (shepherd-service-file-name): Update
'match-lambda' accordingly.
This fixes a bug whereby names of files defining services would be invalid if
'provisions' contained more than one element.
---
gnu/services/shepherd.scm | 2 ++
1 file changed, 2 insertions(+)
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index d8d5006ab..583122054 100644
--- a/gnu/services/shepherd.scm
+++ b/gnu/services/shepherd.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -195,6 +196,7 @@ stored."
(string-append "shepherd-"
(string-map (match-lambda
(#\/ #\-)
+ (#\ #\-)
(chr chr))
provisions)
".scm")))
--
2.11.0
^ permalink raw reply related [flat|nested] 10+ messages in thread
* [PATCH 2/2] tests: Add 'prosody-service-type' test.
2017-02-05 18:58 [PATCH 0/2] Add a test for the Prosody service Clément Lassieur
2017-02-05 18:58 ` [PATCH 1/2] service: shepherd: Replace spaces with hyphens in file names Clément Lassieur
@ 2017-02-05 18:58 ` Clément Lassieur
2017-02-06 9:48 ` Clément Lassieur
2017-02-08 14:47 ` Ludovic Courtès
1 sibling, 2 replies; 10+ messages in thread
From: Clément Lassieur @ 2017-02-05 18:58 UTC (permalink / raw)
To: guix-devel
* gnu/tests/messaging.scm: New file.
* gnu/services/messaging.scm: New exported procedure.
(<shepherd-service>)[provision]: Add 'xmpp-daemon'.
---
gnu/services/messaging.scm | 5 +-
gnu/tests/messaging.scm | 175 +++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 178 insertions(+), 2 deletions(-)
create mode 100644 gnu/tests/messaging.scm
diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm
index aa398970b..9f59d6eac 100644
--- a/gnu/services/messaging.scm
+++ b/gnu/services/messaging.scm
@@ -40,7 +40,8 @@
mod-muc-configuration
ssl-configuration
- %default-modules-enabled))
+ %default-modules-enabled
+ prosody-configuration-pidfile))
;;; Commentary:
;;;
@@ -592,7 +593,7 @@ See also @url{http://prosody.im/doc/modules/mod_muc}."
(zero? (system* #$prosodyctl-bin #$@args))))))
(list (shepherd-service
(documentation "Run the Prosody XMPP server")
- (provision '(prosody))
+ (provision '(prosody xmpp-daemon))
(requirement '(networking syslogd user-processes))
(start (prosodyctl-action "start"))
(stop (prosodyctl-action "stop"))))))
diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm
new file mode 100644
index 000000000..b7f97ab98
--- /dev/null
+++ b/gnu/tests/messaging.scm
@@ -0,0 +1,175 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(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)
+ #:use-module (guix gexp)
+ #:use-module (guix store)
+ #: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)
+ #:imported-modules '((gnu services herd))))
+ (command (system-qemu-image/shared-store-script
+ os #:graphic? #f))
+ (username -> "alice")
+ (server -> "localhost")
+ (jid -> (string-append username "@" server))
+ (password -> "correct horse battery staple")
+ (port -> 15222)
+ (message -> "hello world"))
+
+ (define script.ft
+ (scheme-file
+ "script.ft"
+ #~(begin
+ (define (handle-received-message time from nickname message)
+ (if (equal? message #$message)
+ (ft-quit 0)
+ (ft-quit 1)))
+ (add-hook! ft-message-receive-hook handle-received-message)
+
+ (ft-set-jid! #$jid)
+ (ft-set-password! #$password)
+ (ft-set-server! #$server)
+ (ft-set-port! #$port)
+ (ft-set-sslconn! #f)
+ (ft-connect-blocking)
+ (ft-send-message #$jid #$message)
+ (ft-main-loop))))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (srfi srfi-64))
+
+ (define marionette
+ ;; Enable TCP forwarding of the guest's port 5222.
+ (make-marionette (list #$command "-net"
+ (string-append "user,hostfwd=tcp::"
+ (number->string #$port)
+ "-:5222"))))
+
+ (define (wait-for-file file)
+ ;; Wait until FILE exists in the guest; 'read' its content and
+ ;; return it.
+ (marionette-eval
+ `(let loop ((i 10))
+ (cond ((file-exists? ,file)
+ (call-with-input-file ,file read))
+ ((> i 0)
+ (begin
+ (sleep 1))
+ (loop (- i 1)))
+ (else
+ (error "file didn't show up" ,file))))
+ marionette))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "xmpp")
+
+ ;; Wait for XMPP service to be up and running.
+ (test-eq "service running"
+ 'running!
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'xmpp-daemon)
+ 'running!)
+ marionette))
+
+ ;; Check XMPP service's PID.
+ (test-assert "service process id"
+ (let ((pid (number->string (wait-for-file #$pid-file))))
+ (marionette-eval `(zero? (system* "ps" "-p" ,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")
+ (zero? (system* freetalk-bin "-s" #$script.ft))))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation name test)))
+
+(define %create-prosody-account
+ (program-file
+ "create-account"
+ #~(let* ((jid (cadr (command-line)))
+ (password (caddr (command-line)))
+ (password-input (string-append "\"" password "\n" password "\""))
+ (prosodyctl-bin #$(file-append prosody "/bin/prosodyctl")))
+ (system (string-join
+ `("echo" ,password-input "|" ,prosodyctl-bin "adduser" ,jid)
+ " ")))))
+
+(define %test-prosody
+ (let* ((config (prosody-configuration
+ (virtualhosts
+ (list
+ (virtualhost-configuration
+ (domain "localhost")))))))
+ (system-test
+ (name "prosody")
+ (description "Connect to a running Prosody daemon.")
+ (value (run-xmpp-test name
+ (service prosody-service-type config)
+ (prosody-configuration-pidfile config)
+ %create-prosody-account)))))
--
2.11.0
^ permalink raw reply related [flat|nested] 10+ messages in thread
* Re: [PATCH 2/2] tests: Add 'prosody-service-type' test.
2017-02-05 18:58 ` [PATCH 2/2] tests: Add 'prosody-service-type' test Clément Lassieur
@ 2017-02-06 9:48 ` Clément Lassieur
2017-02-08 14:47 ` Ludovic Courtès
1 sibling, 0 replies; 10+ messages in thread
From: Clément Lassieur @ 2017-02-06 9:48 UTC (permalink / raw)
To: guix-devel
> + (define script.ft
> + (scheme-file
> + "script.ft"
> + #~(begin
> + (define (handle-received-message time from nickname message)
> + (if (equal? message #$message)
> + (ft-quit 0)
> + (ft-quit 1)))
> + (add-hook! ft-message-receive-hook handle-received-message)
> +
> + (ft-set-jid! #$jid)
> + (ft-set-password! #$password)
> + (ft-set-server! #$server)
> + (ft-set-port! #$port)
> + (ft-set-sslconn! #f)
> + (ft-connect-blocking)
> + (ft-send-message #$jid #$message)
> + (ft-main-loop))))
Maybe I should add a timeout somewhere, so the test doesn't wait forever
if the message is not actually received. WDYT?
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: [PATCH 1/2] service: shepherd: Replace spaces with hyphens in file names.
2017-02-05 18:58 ` [PATCH 1/2] service: shepherd: Replace spaces with hyphens in file names Clément Lassieur
@ 2017-02-08 14:40 ` Ludovic Courtès
0 siblings, 0 replies; 10+ messages in thread
From: Ludovic Courtès @ 2017-02-08 14:40 UTC (permalink / raw)
To: Clément Lassieur; +Cc: guix-devel
Clément Lassieur <clement@lassieur.org> skribis:
> * gnu/services/shepherd.scm (shepherd-service-file-name): Update
> 'match-lambda' accordingly.
>
> This fixes a bug whereby names of files defining services would be invalid if
> 'provisions' contained more than one element.
Good catch! Applied, thanks.
Ludo’.
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: [PATCH 2/2] tests: Add 'prosody-service-type' test.
2017-02-05 18:58 ` [PATCH 2/2] tests: Add 'prosody-service-type' test Clément Lassieur
2017-02-06 9:48 ` Clément Lassieur
@ 2017-02-08 14:47 ` Ludovic Courtès
2017-02-10 18:17 ` [PATCH] " Clément Lassieur
2017-02-10 18:27 ` [PATCH 2/2] " Clément Lassieur
1 sibling, 2 replies; 10+ messages in thread
From: Ludovic Courtès @ 2017-02-08 14:47 UTC (permalink / raw)
To: Clément Lassieur; +Cc: guix-devel
Hello!
Clément Lassieur <clement@lassieur.org> skribis:
> * gnu/tests/messaging.scm: New file.
> * gnu/services/messaging.scm: New exported procedure.
> (<shepherd-service>)[provision]: Add 'xmpp-daemon'.
Awesome!
Please also add the new file to gnu/local.mk.
> +(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)
> + #:imported-modules '((gnu services herd))))
I think you can remove ‘os-with-service’ and simply add the Prosody
service explicitly in ‘%base-os’ (which could be rename ‘%prosody-os’
maybe).
> + (define script.ft
> + (scheme-file
> + "script.ft"
> + #~(begin
> + (define (handle-received-message time from nickname message)
> + (if (equal? message #$message)
> + (ft-quit 0)
> + (ft-quit 1)))
> + (add-hook! ft-message-receive-hook handle-received-message)
> +
> + (ft-set-jid! #$jid)
> + (ft-set-password! #$password)
> + (ft-set-server! #$server)
> + (ft-set-port! #$port)
> + (ft-set-sslconn! #f)
> + (ft-connect-blocking)
> + (ft-send-message #$jid #$message)
> + (ft-main-loop))))
Very neat that this can be done in Scheme too. :-)
If it’s possible, I agree that adding a timeout (say 1 minute) would be
nice.
> + ;; Check XMPP service's PID.
> + (test-assert "service process id"
> + (let ((pid (number->string (wait-for-file #$pid-file))))
> + (marionette-eval `(zero? (system* "ps" "-p" ,pid))
> + marionette)))
I think (file-exists? (string-append "/proc/" pid)) would be enough.
> +(define %create-prosody-account
> + (program-file
> + "create-account"
> + #~(let* ((jid (cadr (command-line)))
> + (password (caddr (command-line)))
Better use ‘match’ here. :-)
(match (command-line)
((command jid password)
…))
Could you send an updated patch?
Thank you!
Ludo’.
^ permalink raw reply [flat|nested] 10+ messages in thread
* [PATCH] tests: Add 'prosody-service-type' test.
2017-02-08 14:47 ` Ludovic Courtès
@ 2017-02-10 18:17 ` Clément Lassieur
2017-02-10 22:42 ` Ludovic Courtès
2017-02-10 18:27 ` [PATCH 2/2] " Clément Lassieur
1 sibling, 1 reply; 10+ messages in thread
From: Clément Lassieur @ 2017-02-10 18:17 UTC (permalink / raw)
To: guix-devel
* gnu/tests/messaging.scm: New file.
* gnu/services/messaging.scm: New exported procedure.
(<shepherd-service>)[provision]: Add 'xmpp-daemon'.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
---
gnu/local.mk | 1 +
gnu/services/messaging.scm | 5 +-
gnu/tests/messaging.scm | 194 +++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 198 insertions(+), 2 deletions(-)
create mode 100644 gnu/tests/messaging.scm
diff --git a/gnu/local.mk b/gnu/local.mk
index 4d6e4b05d..25fb3b44f 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -459,6 +459,7 @@ GNU_SYSTEM_MODULES = \
%D%/tests/nfs.scm \
%D%/tests/install.scm \
%D%/tests/mail.scm \
+ %D%/tests/messaging.scm \
%D%/tests/ssh.scm \
%D%/tests/web.scm
diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm
index aa398970b..9f59d6eac 100644
--- a/gnu/services/messaging.scm
+++ b/gnu/services/messaging.scm
@@ -40,7 +40,8 @@
mod-muc-configuration
ssl-configuration
- %default-modules-enabled))
+ %default-modules-enabled
+ prosody-configuration-pidfile))
;;; Commentary:
;;;
@@ -592,7 +593,7 @@ See also @url{http://prosody.im/doc/modules/mod_muc}."
(zero? (system* #$prosodyctl-bin #$@args))))))
(list (shepherd-service
(documentation "Run the Prosody XMPP server")
- (provision '(prosody))
+ (provision '(prosody xmpp-daemon))
(requirement '(networking syslogd user-processes))
(start (prosodyctl-action "start"))
(stop (prosodyctl-action "stop"))))))
diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm
new file mode 100644
index 000000000..b0c8254ce
--- /dev/null
+++ b/gnu/tests/messaging.scm
@@ -0,0 +1,194 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(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)
+ #:use-module (guix gexp)
+ #:use-module (guix store)
+ #: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)
+ #:imported-modules '((gnu services herd))))
+ (command (system-qemu-image/shared-store-script
+ 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
+ (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)
+ (ft-set-password! #$password)
+ (ft-set-server! #$server)
+ (ft-set-port! #$port)
+ (ft-set-sslconn! #f)
+ (ft-connect-blocking)
+ (ft-send-message #$jid #$message)
+
+ (ft-set-daemon)
+ (ft-main-loop))))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (srfi srfi-64))
+
+ (define marionette
+ ;; Enable TCP forwarding of the guest's port 5222.
+ (make-marionette (list #$command "-net"
+ (string-append "user,hostfwd=tcp::"
+ (number->string #$port)
+ "-:5222"))))
+
+ (define (guest-wait-for-file file)
+ ;; Wait until FILE exists in the guest; 'read' its content and
+ ;; return it.
+ (marionette-eval
+ `(let loop ((i 10))
+ (cond ((file-exists? ,file)
+ (call-with-input-file ,file read))
+ ((> i 0)
+ (begin
+ (sleep 1))
+ (loop (- i 1)))
+ (else
+ (error "file didn't show up" ,file))))
+ marionette))
+
+ (define (host-wait-for-file file)
+ ;; Wait until FILE exists in the host.
+ (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)
+ (chdir #$output)
+
+ (test-begin "xmpp")
+
+ ;; Wait for XMPP service to be up and running.
+ (test-eq "service running"
+ 'running!
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'xmpp-daemon)
+ 'running!)
+ marionette))
+
+ ;; Check XMPP service's PID.
+ (test-assert "service process id"
+ (let ((pid (number->string (guest-wait-for-file #$pid-file))))
+ (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
+ (program-file
+ "create-account"
+ #~(begin
+ (use-modules (ice-9 match))
+ (match (command-line)
+ ((command jid password)
+ (let ((password-input (format #f "\"~a~%~a\"" password password))
+ (prosodyctl #$(file-append prosody "/bin/prosodyctl")))
+ (system (string-join
+ `("echo" ,password-input "|" ,prosodyctl "adduser" ,jid)
+ " "))))))))
+
+(define %test-prosody
+ (let* ((config (prosody-configuration
+ (virtualhosts
+ (list
+ (virtualhost-configuration
+ (domain "localhost")))))))
+ (system-test
+ (name "prosody")
+ (description "Connect to a running Prosody daemon.")
+ (value (run-xmpp-test name
+ (service prosody-service-type config)
+ (prosody-configuration-pidfile config)
+ %create-prosody-account)))))
--
2.11.1
^ permalink raw reply related [flat|nested] 10+ messages in thread
* Re: [PATCH 2/2] tests: Add 'prosody-service-type' test.
2017-02-08 14:47 ` Ludovic Courtès
2017-02-10 18:17 ` [PATCH] " Clément Lassieur
@ 2017-02-10 18:27 ` Clément Lassieur
2017-02-10 22:24 ` Ludovic Courtès
1 sibling, 1 reply; 10+ messages in thread
From: Clément Lassieur @ 2017-02-10 18:27 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: guix-devel
Hi Ludovic,
Ludovic Courtès <ludo@gnu.org> writes:
> Hello!
>
> Clément Lassieur <clement@lassieur.org> skribis:
>
>> * gnu/tests/messaging.scm: New file.
>> * gnu/services/messaging.scm: New exported procedure.
>> (<shepherd-service>)[provision]: Add 'xmpp-daemon'.
>
> Awesome!
>
> Please also add the new file to gnu/local.mk.
Done.
>> +(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)
>> + #:imported-modules '((gnu services herd))))
>
> I think you can remove ‘os-with-service’ and simply add the Prosody
> service explicitly in ‘%base-os’ (which could be rename ‘%prosody-os’
> maybe).
But then, my test wouldn't be generic anymore, would it? I would like
it to be Prosody-independent, so that one can add, say, the ejabberd
service easily. That's why I call the service 'xmpp-daemon' instead of
'prosody'. WDYT?
>> + (define script.ft
>> + (scheme-file
>> + "script.ft"
>> + #~(begin
>> + (define (handle-received-message time from nickname message)
>> + (if (equal? message #$message)
>> + (ft-quit 0)
>> + (ft-quit 1)))
>> + (add-hook! ft-message-receive-hook handle-received-message)
>> +
>> + (ft-set-jid! #$jid)
>> + (ft-set-password! #$password)
>> + (ft-set-server! #$server)
>> + (ft-set-port! #$port)
>> + (ft-set-sslconn! #f)
>> + (ft-connect-blocking)
>> + (ft-send-message #$jid #$message)
>> + (ft-main-loop))))
>
> Very neat that this can be done in Scheme too. :-)
>
> If it’s possible, I agree that adding a timeout (say 1 minute) would be
> nice.
Done.
>> + ;; Check XMPP service's PID.
>> + (test-assert "service process id"
>> + (let ((pid (number->string (wait-for-file #$pid-file))))
>> + (marionette-eval `(zero? (system* "ps" "-p" ,pid))
>> + marionette)))
>
> I think (file-exists? (string-append "/proc/" pid)) would be enough.
Done.
>> +(define %create-prosody-account
>> + (program-file
>> + "create-account"
>> + #~(let* ((jid (cadr (command-line)))
>> + (password (caddr (command-line)))
>
> Better use ‘match’ here. :-)
>
> (match (command-line)
> ((command jid password)
> …))
Done.
> Could you send an updated patch?
Done! Thanks for the review!
Clément
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: [PATCH 2/2] tests: Add 'prosody-service-type' test.
2017-02-10 18:27 ` [PATCH 2/2] " Clément Lassieur
@ 2017-02-10 22:24 ` Ludovic Courtès
0 siblings, 0 replies; 10+ messages in thread
From: Ludovic Courtès @ 2017-02-10 22:24 UTC (permalink / raw)
To: Clément Lassieur; +Cc: guix-devel
Hello Clément,
Clément Lassieur <clement@lassieur.org> skribis:
> Ludovic Courtès <ludo@gnu.org> writes:
[...]
>>> +(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)
>>> + #:imported-modules '((gnu services herd))))
>>
>> I think you can remove ‘os-with-service’ and simply add the Prosody
>> service explicitly in ‘%base-os’ (which could be rename ‘%prosody-os’
>> maybe).
>
> But then, my test wouldn't be generic anymore, would it? I would like
> it to be Prosody-independent, so that one can add, say, the ejabberd
> service easily. That's why I call the service 'xmpp-daemon' instead of
> 'prosody'. WDYT?
I think you’re right. :-) I didn’t know you had this in mind, but it’s
a good idea.
Ludo’.
^ permalink raw reply [flat|nested] 10+ messages in thread
* Re: [PATCH] tests: Add 'prosody-service-type' test.
2017-02-10 18:17 ` [PATCH] " Clément Lassieur
@ 2017-02-10 22:42 ` Ludovic Courtès
0 siblings, 0 replies; 10+ messages in thread
From: Ludovic Courtès @ 2017-02-10 22:42 UTC (permalink / raw)
To: Clément Lassieur; +Cc: guix-devel
Clément Lassieur <clement@lassieur.org> skribis:
> * gnu/tests/messaging.scm: New file.
> * gnu/services/messaging.scm: New exported procedure.
> (<shepherd-service>)[provision]: Add 'xmpp-daemon'.
> * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
Pushed, thanks!
Ludo’.
^ permalink raw reply [flat|nested] 10+ messages in thread
end of thread, other threads:[~2017-02-10 22:42 UTC | newest]
Thread overview: 10+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2017-02-05 18:58 [PATCH 0/2] Add a test for the Prosody service Clément Lassieur
2017-02-05 18:58 ` [PATCH 1/2] service: shepherd: Replace spaces with hyphens in file names Clément Lassieur
2017-02-08 14:40 ` Ludovic Courtès
2017-02-05 18:58 ` [PATCH 2/2] tests: Add 'prosody-service-type' test Clément Lassieur
2017-02-06 9:48 ` Clément Lassieur
2017-02-08 14:47 ` Ludovic Courtès
2017-02-10 18:17 ` [PATCH] " Clément Lassieur
2017-02-10 22:42 ` Ludovic Courtès
2017-02-10 18:27 ` [PATCH 2/2] " Clément Lassieur
2017-02-10 22:24 ` Ludovic Courtès
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.