aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix-data-service/database.scm20
-rw-r--r--scripts/guix-data-service.in38
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))