gnu: tests: Fix unbound variable.
Record type descriptors were made private in a143e92446859bd1edc7a7aea85b2089c82c77da, but a usage of them was forgotten in the tests files. * gnu/tests/web.scm (patchwork-initial-database-setup-service): Use accessors to access field values instead of unexported type descriptor.
This commit is contained in:
parent
bea2134fe1
commit
5cd9cd644c
@ -521,42 +521,43 @@ HTTP-PORT."
|
||||
;;; Patchwork
|
||||
;;;
|
||||
|
||||
(define patchwork-initial-database-setup-service
|
||||
(match-lambda
|
||||
(($ <patchwork-database-configuration>
|
||||
engine name user password host port)
|
||||
(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)))))))
|
||||
|
||||
(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")
|
||||
#$user))
|
||||
(zero?
|
||||
(system* #$(file-append postgresql "/bin/createdb")
|
||||
"-O" #$user #$name)))
|
||||
0
|
||||
1)))
|
||||
(lambda ()
|
||||
(primitive-exit 1)))
|
||||
(zero? (cdr (waitpid pid)))))))
|
||||
|
||||
(shepherd-service
|
||||
(requirement '(postgres))
|
||||
(provision '(patchwork-postgresql-user-and-database))
|
||||
(start start-gexp)
|
||||
(stop #~(const #f))
|
||||
(respawn? #f)
|
||||
(documentation "Setup patchwork database.")))))
|
||||
(shepherd-service
|
||||
(requirement '(postgres))
|
||||
(provision '(patchwork-postgresql-user-and-database))
|
||||
(start start-gexp)
|
||||
(stop #~(const #f))
|
||||
(respawn? #f)
|
||||
(documentation "Setup patchwork database.")))
|
||||
|
||||
(define (patchwork-os patchwork)
|
||||
(simple-operating-system
|
||||
|
Loading…
Reference in New Issue
Block a user