diff options
| -rw-r--r-- | guix-data-service/database.scm | 60 | ||||
| -rw-r--r-- | scripts/guix-data-service-process-jobs.in | 2 | ||||
| -rw-r--r-- | scripts/guix-data-service.in | 52 |
3 files changed, 64 insertions, 50 deletions
diff --git a/guix-data-service/database.scm b/guix-data-service/database.scm index 8ed87de..d087e60 100644 --- a/guix-data-service/database.scm +++ b/guix-data-service/database.scm @@ -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 diff --git a/scripts/guix-data-service-process-jobs.in b/scripts/guix-data-service-process-jobs.in index fb0385e..6ad1ec9 100644 --- a/scripts/guix-data-service-process-jobs.in +++ b/scripts/guix-data-service-process-jobs.in @@ -65,6 +65,8 @@ %default-options)) (let ((opts (parse-options (cdr (program-arguments))))) + (run-sqitch) + (with-postgresql-connection "process-jobs" (lambda (conn) diff --git a/scripts/guix-data-service.in b/scripts/guix-data-service.in index 1398aa0..6a41413 100644 --- a/scripts/guix-data-service.in +++ b/scripts/guix-data-service.in @@ -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 () |