summaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2021-01-18 11:10:28 +0100
committerMathieu Othacehe <othacehe@gnu.org>2021-01-28 12:57:27 +0100
commitec145a2ff9f6a69234ddd2f3656ac324b53d30d3 (patch)
treefad29c256a47c132d5485e147577e4fadd12851f /gnu
parent33687aa3d0c298d6bc587ed772a900cf8c3e8ba4 (diff)
services: postgresql: Add postgresql-role-service-type.
* gnu/services/databases.scm (postgresql-role, postgresql-role?, postgresql-role-name, postgresql-role-permissions, postgresql-role-create-database?, postgresql-role-configuration, postgresql-role-configuration?, postgresql-role-configuration-host, postgresql-role-configuration-roles, postgresql-role-service-type): New procedures. * gnu/tests/databases.scm: Test it. * doc/guix.texi: Document it.
Diffstat (limited to 'gnu')
-rw-r--r--gnu/services/databases.scm102
-rw-r--r--gnu/tests/databases.scm44
2 files changed, 145 insertions, 1 deletions
diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm
index 0d60616156..c11898693f 100644
--- a/gnu/services/databases.scm
+++ b/gnu/services/databases.scm
@@ -58,6 +58,18 @@
postgresql-service
postgresql-service-type
+ postgresql-role
+ postgresql-role?
+ postgresql-role-name
+ postgresql-role-permissions
+ postgresql-role-create-database?
+ postgresql-role-configuration
+ postgresql-role-configuration?
+ postgresql-role-configuration-host
+ postgresql-role-configuration-roles
+
+ postgresql-role-service-type
+
memcached-service-type
memcached-configuration
memcached-configuration?
@@ -343,6 +355,96 @@ and stores the database cluster in @var{data-directory}."
(data-directory data-directory)
(extension-packages extension-packages))))
+(define-record-type* <postgresql-role>
+ postgresql-role make-postgresql-role
+ postgresql-role?
+ (name postgresql-role-name) ;string
+ (permissions postgresql-role-permissions
+ (default '(createdb login))) ;list
+ (create-database? postgresql-role-create-database? ;boolean
+ (default #f)))
+
+(define-record-type* <postgresql-role-configuration>
+ postgresql-role-configuration make-postgresql-role-configuration
+ postgresql-role-configuration?
+ (host postgresql-role-configuration-host ;string
+ (default "/var/run/postgresql"))
+ (log postgresql-role-configuration-log ;string
+ (default "/var/log/postgresql_roles.log"))
+ (roles postgresql-role-configuration-roles
+ (default '()))) ;list
+
+(define (postgresql-create-roles config)
+ ;; See: https://www.postgresql.org/docs/current/sql-createrole.html for the
+ ;; complete permissions list.
+ (define (format-permissions permissions)
+ (let ((dict '(bypassrls createdb createrole login replication superuser)))
+ (string-join (filter-map (lambda (permission)
+ (and (member permission dict)
+ (string-upcase
+ (symbol->string permission))))
+ permissions)
+ " ")))
+
+ (define (roles->queries roles)
+ (apply mixed-text-file "queries"
+ (append-map
+ (lambda (role)
+ (match-record role <postgresql-role>
+ (name permissions create-database?)
+ `("SELECT NOT(EXISTS(SELECT 1 FROM pg_catalog.pg_roles WHERE \
+rolname = '" ,name "')) as not_exists;\n"
+"\\gset\n"
+"\\if :not_exists\n"
+"CREATE ROLE " ,name
+" WITH " ,(format-permissions permissions)
+";\n"
+,@(if create-database?
+ `("CREATE DATABASE " ,name
+ " OWNER " ,name ";\n")
+ '())
+"\\endif\n")))
+ roles)))
+
+ (let ((host (postgresql-role-configuration-host config))
+ (roles (postgresql-role-configuration-roles config)))
+ (program-file
+ "postgresql-create-roles"
+ #~(begin
+ (let ((psql #$(file-append postgresql "/bin/psql")))
+ (execl psql psql "-a"
+ "-h" #$host
+ "-f" #$(roles->queries roles)))))))
+
+(define (postgresql-role-shepherd-service config)
+ (match-record config <postgresql-role-configuration>
+ (log)
+ (list (shepherd-service
+ (requirement '(postgres))
+ (provision '(postgres-roles))
+ (one-shot? #t)
+ (start #~(make-forkexec-constructor
+ (list #$(postgresql-create-roles config))
+ #:user "postgres" #:group "postgres"
+ #:log-file #$log))
+ (documentation "Create PostgreSQL roles.")))))
+
+(define postgresql-role-service-type
+ (service-type (name 'postgresql-role)
+ (extensions
+ (list (service-extension shepherd-root-service-type
+ postgresql-role-shepherd-service)))
+ (compose concatenate)
+ (extend (lambda (config extended-roles)
+ (match-record config <postgresql-role-configuration>
+ (host roles)
+ (postgresql-role-configuration
+ (host host)
+ (roles (append roles extended-roles))))))
+ (default-value (postgresql-role-configuration))
+ (description "Ensure the specified PostgreSQL roles are
+created after the PostgreSQL database is started.")))
+
;;;
;;; Memcached
diff --git a/gnu/tests/databases.scm b/gnu/tests/databases.scm
index d881a8c3ee..e831d69f5a 100644
--- a/gnu/tests/databases.scm
+++ b/gnu/tests/databases.scm
@@ -217,6 +217,9 @@
(define %postgresql-log-directory
"/var/log/postgresql")
+(define %role-log-file
+ "/var/log/postgresql_roles.log")
+
(define %postgresql-os
(simple-operating-system
(service postgresql-service-type
@@ -229,7 +232,13 @@
("random_page_cost" 2)
("auto_explain.log_min_duration" "100 ms")
("work_mem" "500 MB")
- ("debug_print_plan" #t)))))))))
+ ("debug_print_plan" #t)))))))
+ (service postgresql-role-service-type
+ (postgresql-role-configuration
+ (roles
+ (list (postgresql-role
+ (name "root")
+ (create-database? #t))))))))
(define (run-postgresql-test)
"Run tests in %POSTGRESQL-OS."
@@ -282,6 +291,39 @@
#t))
marionette))
+ (test-assert "database ready"
+ (begin
+ (marionette-eval
+ '(begin
+ (let loop ((i 10))
+ (unless (or (zero? i)
+ (and (file-exists? #$%role-log-file)
+ (string-contains
+ (call-with-input-file #$%role-log-file
+ get-string-all)
+ ";\nCREATE DATABASE")))
+ (sleep 1)
+ (loop (- i 1)))))
+ marionette)))
+
+ (test-assert "database creation"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd)
+ (ice-9 popen))
+ (current-output-port
+ (open-file "/dev/console" "w0"))
+ (let* ((port (open-pipe*
+ OPEN_READ
+ #$(file-append postgresql "/bin/psql")
+ "-tAh" "/var/run/postgresql"
+ "-c" "SELECT 1 FROM pg_database WHERE
+ datname='root'"))
+ (output (get-string-all port)))
+ (close-pipe port)
+ (string-contains output "1")))
+ marionette))
+
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))