summaryrefslogtreecommitdiff
path: root/gnu/tests/web.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/tests/web.scm')
-rw-r--r--gnu/tests/web.scm62
1 files changed, 33 insertions, 29 deletions
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm
index 419b5f0b5bf..47879aa08f7 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -609,40 +609,32 @@ HTTP-PORT, along with php-fpm."
(define (patchwork-initial-database-setup-service configuration)
(define start-gexp
- #~(lambda ()
- (let ((pid (primitive-fork))
- (postgres (getpwnam "postgres")))
- (if (eq? pid 0)
- (dynamic-wind
- (const #t)
- (lambda ()
- (setgid (passwd:gid postgres))
- (setuid (passwd:uid postgres))
- (primitive-exit
- (if (and
- (zero?
- (system* #$(file-append postgresql "/bin/createuser")
- #$(patchwork-database-configuration-user
- configuration)))
- (zero?
- (system* #$(file-append postgresql "/bin/createdb")
- "-O"
- #$(patchwork-database-configuration-user
- configuration)
- #$(patchwork-database-configuration-name
- configuration))))
- 0
- 1)))
- (lambda ()
- (primitive-exit 1)))
- (zero? (cdr (waitpid pid)))))))
+ #~(primitive-exit
+ (if (and
+ (zero?
+ (system* #$(file-append postgresql "/bin/createuser")
+ #$(patchwork-database-configuration-user
+ configuration)))
+ (zero?
+ (system* #$(file-append postgresql "/bin/createdb")
+ "-O"
+ #$(patchwork-database-configuration-user
+ configuration)
+ #$(patchwork-database-configuration-name
+ configuration))))
+ 0
+ 1)))
(shepherd-service
(requirement '(postgres))
(provision '(patchwork-postgresql-user-and-database))
- (start start-gexp)
+ (start #~(lambda _
+ (zero? (spawn-command
+ '(#$(program-file "patchwork-initial-database-setup"
+ start-gexp))
+ #:user "postgres"
+ #:group "postgres"))))
(stop #~(const #f))
- (respawn? #f)
(documentation "Setup patchwork database.")))
(define (patchwork-os patchwork)
@@ -724,6 +716,18 @@ HTTP-PORT."
((pid) pid)))))
marionette))
+ (test-assert "patchwork-setup started"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (match (start-service 'patchwork-setup)
+ (#f #f)
+ (('service response-parts ...)
+ (match (assq-ref response-parts 'running)
+ ((#t) #t)
+ ((pid) pid)))))
+ marionette))
+
(test-assert "httpd running"
(marionette-eval
'(begin