guix
/
data-service
mirror of git://git.savannah.gnu.org/guix/data-service.git
2
0
Fork 0
Code Issues Releases Wiki Activity

Detach the database setup from the main guix-data-service process 

This will allow restarting them independently, leaving it up to the operator
to ensure that all processes are compatible.
This commit is contained in:
Christopher Baines 2023-06-09 13:27:12 +01:00
parent 5c9ec28cb5
commit 29d49ba31a
3 changed files with 64 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
guix-data-service/database.scm
View File

@ -25,6 +25,8 @@
#:export (get-database-config
%database-metrics-registry
run-sqitch
with-postgresql-connection
with-postgresql-connection-per-thread
@ -110,6 +112,64 @@
conn))
(define (run-sqitch)
(with-postgresql-connection
"sqitch"
(lambda (conn)
(with-advisory-session-lock
conn
'sqitch
(lambda ()
(let ((command
(list (%config 'sqitch)
"deploy"
"--db-client" (%config 'sqitch-psql)
;; For some reason, sqitch behaves differently when the
;; guix-data-service is packaged, and when it's not, so try
;; and hack around this here.
"--chdir" (let ((base (dirname (%config 'sqitch-plan))))
(if (string-prefix? "/gnu" (%config 'sqitch-plan))
base
(dirname base)))
"--plan-file" (%config 'sqitch-plan)
"--mode" "change" ; this helps when migrations don't
; have the revert bit implemented
(let* ((database-config (get-database-config))
(params (string-join
(map
(match-lambda
((key . val)
(string-append key "=" val)))
(filter
(match-lambda
((key . _)
(not (member key '("user"
"host"
"dbname")))))
database-config))
"&")))
(string-append "db:pg://"
(assoc-ref database-config "user")
"@"
(if (string=? (assoc-ref database-config "host")
"localhost")
"" ; This means the unix socket
; connection will be used
(assoc-ref database-config "host"))
"/"
(assoc-ref database-config "dbname")
(if (string-null? params)
""
"?")
params)))))
(simple-format #t "running command: ~A\n"
(string-join command))
(unless (zero? (apply system* command))
(simple-format
(current-error-port)
"error: sqitch command failed\n")
(exit 1))))))))
(define* (with-postgresql-connection name f #:key (statement-timeout #f))
(let ((conn (open-postgresql-connection name statement-timeout)))
(with-throw-handler

2
scripts/guix-data-service-process-jobs.in
View File

@ -65,6 +65,8 @@
%default-options))
(let ((opts (parse-options (cdr (program-arguments)))))
(run-sqitch)
(with-postgresql-connection
"process-jobs"
(lambda (conn)

52
scripts/guix-data-service.in
View File

@ -234,57 +234,9 @@
(simple-format port "~A\n" (getpid)))))
(when (assoc-ref opts 'update-database)
(let ((command
(list (%config 'sqitch)
"deploy"
"--db-client" (%config 'sqitch-psql)
;; For some reason, sqitch behaves differently when the
;; guix-data-service is packaged, and when it's not, so try
;; and hack around this here.
"--chdir" (let ((base (dirname (%config 'sqitch-plan))))
(if (string-prefix? "/gnu" (%config 'sqitch-plan))
base
(dirname base)))
"--plan-file" (%config 'sqitch-plan)
"--mode" "change" ; this helps when migrations don't
; have the revert bit implemented
(let* ((database-config (get-database-config))
(params (string-join
(map
(match-lambda
((key . val)
(string-append key "=" val)))
(filter
(match-lambda
((key . _)
(not (member key '("user"
"host"
"dbname")))))
database-config))
"&")))
(string-append "db:pg://"
(assoc-ref database-config "user")
"@"
(if (string=? (assoc-ref database-config "host")
"localhost")
"" ; This means the unix socket
; connection will be used
(assoc-ref database-config "host"))
"/"
(assoc-ref database-config "dbname")
(if (string-null? params)
""
"?")
params)))))
(simple-format #t "running command: ~A\n"
(string-join command))
(unless (zero? (apply system* command))
(simple-format
(current-error-port)
"error: sqitch command failed\n")
(exit 1))
(run-sqitch)
(atomic-box-set! startup-completed #t)))
(atomic-box-set! startup-completed #t))
(call-with-new-thread
(lambda ()