diff options
| author | Christopher Baines <mail@cbaines.net> | 2021-06-16 13:43:32 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2021-06-16 13:44:00 +0100 |
| commit | 0dc05982cde052c985bb440dc026cbe3334ee50b (patch) | |
| tree | eaeedc6f2763488bf8b354824b82bcf9f4bc89fe | |
| parent | 673d762e681568fb5c5598d456df8312e8d40cae (diff) | |
| download | data-service-0dc05982cde052c985bb440dc026cbe3334ee50b.tar data-service-0dc05982cde052c985bb440dc026cbe3334ee50b.tar.gz | |
Try to adapt the PostgreSQL paramstring to use with sqitch
| -rw-r--r-- | guix-data-service/database.scm | 20 | ||||
| -rw-r--r-- | scripts/guix-data-service.in | 38 |
2 files changed, 47 insertions, 11 deletions
diff --git a/guix-data-service/database.scm b/guix-data-service/database.scm index 546c678..1204bb4 100644 --- a/guix-data-service/database.scm +++ b/guix-data-service/database.scm @@ -21,7 +21,9 @@ #:use-module (ice-9 threads) #:use-module (squee) #:use-module (guix-data-service config) - #:export (with-postgresql-connection + #:export (get-database-config + + with-postgresql-connection with-postgresql-connection-per-thread with-thread-postgresql-connection @@ -39,6 +41,22 @@ (define pg-conn-finish (@@ (squee) pg-conn-finish)) +(define (paramstring->alist s) + (map + (lambda (param) + (match (string-split param #\=) + ((key val) + (cons key val)))) + (string-split s #\space))) + +(define (get-database-config) + (let ((paramstring (getenv "GUIX_DATA_SERVICE_DATABASE_PARAMSTRING"))) + (if paramstring + (paramstring->alist paramstring) + `(("dbname" . ,(%config 'database-name)) + ("user" . ,(%config 'database-user)) + ("host" . ,(%config 'database-host)))))) + (define (open-postgresql-connection name statement-timeout) (define paramstring (string-append diff --git a/scripts/guix-data-service.in b/scripts/guix-data-service.in index ade3ca3..481e87d 100644 --- a/scripts/guix-data-service.in +++ b/scripts/guix-data-service.in @@ -141,18 +141,36 @@ (list (%config 'sqitch) "deploy" "--db-client" (%config 'sqitch-psql) - "--chdir" (dirname (%config 'sqitch-plan)) + "--chdir" (dirname (dirname (%config 'sqitch-plan))) "--plan-file" (%config 'sqitch-plan) - (string-append "db:pg://" - (%config 'database-user) - "@" - (if (string=? (%config 'database-host) - "localhost") - "" ; This means the unix socket + (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 - (%config 'database-host)) - "/" - (%config 'database-name))))) + (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)) |