Package: guix-patches;
Reported by: Mathieu Othacehe <othacehe <at> gnu.org>
Date: Thu, 14 Jan 2021 13:37:02 UTC
Severity: normal
Done: Mathieu Othacehe <othacehe <at> gnu.org>
Bug is archived. No further changes may be made.
Message #32 received at 45860 <at> debbugs.gnu.org (full text, mbox):
From: Mathieu Othacehe <othacehe <at> gnu.org> To: 45860 <at> debbugs.gnu.org Cc: Mathieu Othacehe <othacehe <at> gnu.org>, mail <at> cbaines.net Subject: [PATCH v2 5/5] services: postgresql: Add postgresql-role-service-type. Date: Mon, 18 Jan 2021 11:16:28 +0100
* 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.
---
doc/guix.texi | 61 ++++++++++++++++++++++++
gnu/services/databases.scm | 95 ++++++++++++++++++++++++++++++++++++++
gnu/tests/databases.scm | 44 +++++++++++++++++-
3 files changed, 199 insertions(+), 1 deletion(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 22674e2804..13d95b36d1 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -19427,6 +19427,67 @@ here}.
@end table
@end deftp
+@deffn {Scheme Variable} postgresql-role-service-type
+This service allows to create PostgreSQL roles and databases after
+PostgreSQL service start. Here is an example of its use.
+
+@lisp
+(service postgresql-role-service-type
+ (postgresql-role-configuration
+ (roles
+ (list (postgresql-role
+ (name "test")
+ (create-database? #t))))))
+@end lisp
+
+This service can be extended with extra roles, as in this
+example:
+
+@lisp
+(service-extension postgresql-role-service-type
+ (const (postgresql-role
+ (name "alice")
+ (create-database? #t))))
+@end lisp
+@end deffn
+
+@deftp {Data Type} postgresql-role
+PostgreSQL manages database access permissions using the concept of
+roles. A role can be thought of as either a database user, or a group
+of database users, depending on how the role is set up. Roles can own
+database objects (for example, tables) and can assign privileges on
+those objects to other roles to control who has access to which objects.
+
+@table @asis
+@item @code{name}
+The role name.
+
+@item @code{permissions} (default: @code{'(createdb login)})
+The role permissions list. Supported permissions are @code{createdb}
+and @code{login}.
+
+@item @code{create-database?} (default: @code{#f})
+Whether to create a database with the same name as the role.
+
+@end table
+@end deftp
+
+@deftp {Data Type} postgresql-role-configuration
+Data type representing the configuration of
+@var{postgresql-role-service-type}.
+
+@table @asis
+@item @code{host} (default: @code{"/var/run/postgresql"})
+The PostgreSQL host to connect to.
+
+@item @code{log} (default: @code{"/var/log/postgresql_roles.log"})
+File name of the log file.
+
+@item @code{roles} (default: @code{'()})
+The initial PostgreSQL roles to create.
+@end table
+@end deftp
+
@subsubheading MariaDB/MySQL
@defvr {Scheme Variable} mysql-service-type
diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm
index 0d60616156..88e4b1813a 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,89 @@ 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 '((createdb . "CREATEDB")
+ (login . "LOGIN"))))
+ (string-join (map (lambda (permission)
+ (assq-ref dict permission))
+ permissions)
+ " ")))
+
+ (define (roles->queries roles)
+ (apply mixed-text-file "queries"
+ (append-map (lambda (role)
+ (match-record role <postgresql-role>
+ (name permissions create-database?)
+ `("CREATE ROLE " ,name
+ " WITH " ,(format-permissions permissions)
+ ";\n"
+ ,@(if create-database?
+ `("CREATE DATABASE " ,name
+ " OWNER " ,name ";\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)))))
--
2.29.2
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.