services: postgresql-role: Add support for password files.

This commit adds a password-file to the postgresql-role field.  It
allows users to provision Postgres roles with a set password.

* gnu/services/databases.scm (postgresql-role): Add password-file field.
(postgresql-role-configuration): Add requirement field.
(postgresql-create-roles): Add support for setting passwords from a
file without leaking passwords to the command line.
(postgresql-role-shepherd-service): Add support for customizable
requirements.
(postgresql-role-service-type): Pass on postgresql-role-configuration
fields values by default, this way user configured fields are not lost.
* gnu/tests/databases.scm: Test it.
* doc/guix.texi: Document the new field and fix the extension point example.

Change-Id: I3aabaa10b0c5e826c5aa874e5649e25a3508a585
Signed-off-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>

3 files changed, 107 insertions, 12 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 354aa9ef95..dd3ee544b8 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -27745,9 +27745,10 @@ example:
 
 @lisp
 (service-extension postgresql-role-service-type
-                   (const (postgresql-role
-                           (name "alice")
-                           (create-database? #t))))
+                   (const (list
+                           (postgresql-role
+                            (name "alice")
+                            (create-database? #t)))))
 @end lisp
 @end defvar
 
@@ -27770,6 +27771,10 @@ The role permissions list.  Supported permissions are @code{bypassrls},
 @item @code{create-database?} (default: @code{#f})
 whether to create a database with the same name as the role.
 
+@item @code{password-file} (default: @code{#f})
+A string representing the path of a file that contains the password to be set
+for the role.
+
 @item @code{encoding} (default: @code{"UTF8"})
 The character set to use for storing text in the database.
 
@@ -27798,6 +27803,12 @@ The PostgreSQL host to connect to.
 @item @code{log} (default: @code{"/var/log/postgresql_roles.log"})
 File name of the log file.
 
+@item @code{shepherd-requirement} (default: @code{'(user-processes postgres)})
+
+The Shepherd services dependencies to use.  Add extra dependencies to
+@code{%default-postgresql-role-shepherd-requirement} to extend its
+value.
+
 @item @code{roles} (default: @code{'()})
 The initial PostgreSQL roles to create.
 @end table
diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm
index edc3198ad5..2a6779e8bf 100644
--- a/gnu/services/databases.scm
+++ b/gnu/services/databases.scm
@@ -9,6 +9,7 @@
 ;;; Copyright © 2020, 2022 Marius Bakke <marius@gnu.org>
 ;;; Copyright © 2021 David Larsson <david.larsson@selfhosted.xyz>
 ;;; Copyright © 2021 Aljosha Papsch <ep@stern-data.com>
+;;; Copyright © 2025 Giacomo Leidi <goodoldpaul@autistici.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,6 +33,7 @@
   #:autoload   (gnu system accounts) (default-shell)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages base)
+  #:use-module (gnu packages bash)
   #:use-module (gnu packages databases)
   #:use-module (guix build-system trivial)
   #:use-module (guix build union)
@@ -68,14 +70,18 @@
             postgresql-service
             postgresql-service-type
 
+            %default-postgresql-role-shepherd-requirement
+
             postgresql-role
             postgresql-role?
             postgresql-role-name
+            postgresql-role-password-file
             postgresql-role-permissions
             postgresql-role-create-database?
             postgresql-role-configuration
             postgresql-role-configuration?
             postgresql-role-configuration-host
+            postgresql-role-configuration-shepherd-requirement
             postgresql-role-configuration-roles
 
             postgresql-role-service-type
@@ -390,6 +396,8 @@ and stores the database cluster in @var{data-directory}."
   postgresql-role make-postgresql-role
   postgresql-role?
   (name             postgresql-role-name) ;string
+  (password-file    postgresql-role-password-file  ;string
+                    (default #f))
   (permissions      postgresql-role-permissions
                     (default '(createdb login))) ;list
   (create-database? postgresql-role-create-database?  ;boolean
@@ -403,9 +411,15 @@ and stores the database cluster in @var{data-directory}."
   (template postgresql-role-template ;string
             (default "template1")))
 
+(define %default-postgresql-role-shepherd-requirement
+  '(user-processes postgres))
+
 (define-record-type* <postgresql-role-configuration>
   postgresql-role-configuration make-postgresql-role-configuration
   postgresql-role-configuration?
+  (shepherd-requirement
+   postgresql-role-configuration-shepherd-requirement ;list-of-symbols
+   (default %default-postgresql-role-shepherd-requirement))
   (host             postgresql-role-configuration-host ;string
                     (default "/var/run/postgresql"))
   (log              postgresql-role-configuration-log ;string
@@ -425,19 +439,35 @@ and stores the database cluster in @var{data-directory}."
                                permissions)
                    " ")))
 
+  (define (password-value role)
+    (string-append "password_" (postgresql-role-name role)))
+
+  (define (role->password-variable role)
+    (let ((file-name (postgresql-role-password-file role)))
+      (if (string? file-name)
+          ;; This way passwords do not leak to the command line.
+          #~(string-append "-v \"" #$(password-value role)
+                           "=$(" #$coreutils "/bin/cat " #$file-name ")\"")
+          "")))
+
   (define (roles->queries roles)
     (apply mixed-text-file "queries"
            (append-map
             (lambda (role)
               (match-record role <postgresql-role>
                 (name permissions create-database? encoding collation ctype
-                      template)
+                      template password-file)
                 `("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)
+,(if (and (string? password-file)
+          (not (string-null? password-file)))
+     (string-append
+      "\nPASSWORD :'" (password-value role) "'")
+     "")
 ";\n"
 ,@(if create-database?
       `("CREATE DATABASE \"" ,name "\""
@@ -452,20 +482,30 @@ rolname = '" ,name "')) as not_exists;\n"
 
   (let ((host (postgresql-role-configuration-host config))
         (roles (postgresql-role-configuration-roles config)))
-    #~(let ((psql #$(file-append postgresql "/bin/psql")))
-        (list psql "-a" "-h" #$host "-f" #$(roles->queries roles)))))
+    (program-file "run-queries"
+      #~(let ((bash #$(file-append bash-minimal "/bin/bash"))
+              (psql #$(file-append postgresql "/bin/psql")))
+          (define command
+            (string-append
+             "set -e; exec " psql " -a -h " #$host " -f "
+             #$(roles->queries roles) " "
+             (string-join
+              (list
+               #$@(map role->password-variable roles))
+              " ")))
+          (execlp bash bash "-c" command)))))
 
 (define (postgresql-role-shepherd-service config)
   (match-record config <postgresql-role-configuration>
-    (log)
+    (log shepherd-requirement)
     (list (shepherd-service
-           (requirement '(user-processes postgres))
+           (requirement shepherd-requirement)
            (provision '(postgres-roles))
            (one-shot? #t)
            (start
             #~(lambda args
                 (zero? (spawn-command
-                        #$(postgresql-create-roles config)
+                        (list #$(postgresql-create-roles config))
                         #:user "postgres"
                         #:group "postgres"
                         ;; XXX: As of Shepherd 1.0.2, #:log-file is not
@@ -484,6 +524,7 @@ rolname = '" ,name "')) as not_exists;\n"
                           (match-record config <postgresql-role-configuration>
                             (host roles)
                             (postgresql-role-configuration
+                             (inherit config)
                              (host host)
                              (roles (append roles extended-roles))))))
                 (default-value (postgresql-role-configuration))
diff --git a/gnu/tests/databases.scm b/gnu/tests/databases.scm
index fd5041344b..0b2a8acfbb 100644
--- a/gnu/tests/databases.scm
+++ b/gnu/tests/databases.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
 ;;; Copyright © 2020, 2022 Marius Bakke <marius@gnu.org>
+;;; Copyright © 2025 Giacomo Leidi <goodoldpaul@autistici.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -142,6 +143,8 @@
 
 (define %postgresql-os
   (simple-operating-system
+   (extra-special-file "/password"
+                       (plain-file "password" "hello"))
    (service postgresql-service-type
             (postgresql-configuration
              (postgresql postgresql)
@@ -158,6 +161,10 @@
              (roles
               (list (postgresql-role
                      (name "root")
+                     (create-database? #t))
+                    (postgresql-role
+                     (name "a_database")
+                     (password-file "/password")
                      (create-database? #t))))))))
 
 (define (run-postgresql-test)
@@ -230,17 +237,53 @@
             (marionette-eval
              '(begin
                 (use-modules (gnu services herd)
+                             (srfi srfi-1)
                              (ice-9 popen))
                 (current-output-port
                  (open-file "/dev/console" "w0"))
+                (every
+                 (lambda (role)
+                   (let* ((port (open-pipe*
+                                 OPEN_READ
+                                 #$(file-append postgresql "/bin/psql")
+                                 "-tA" "-c"
+                                 (string-append
+                                  "SELECT 1 FROM pg_database WHERE"
+                                  " datname='" role "'")))
+                          (output (get-string-all port)))
+                     (close-pipe port)
+                     (string-contains output "1")))
+                 '("root" "a_database")))
+             marionette))
+
+          (test-assert "database use fails without a password"
+            (marionette-eval
+             '(begin
+                (setgid (passwd:gid (getpwnam "alice")))
+                (setuid (passwd:uid (getpw "alice")))
+                (not (zero?
+                      (system* #$(file-append postgresql "/bin/psql")
+                               "-tA" "-h" "localhost" "-U" "a_database" "-c"
+                               (string-append "SELECT 1 FROM pg_database "
+                                              "WHERE datname='a_database'")))))
+             marionette))
+
+          (test-assert "database passwords are set"
+            (marionette-eval
+             '(begin
+                (use-modules (ice-9 popen))
+                (setgid (passwd:gid (getpwnam "alice")))
+                (setuid (passwd:uid (getpw "alice")))
+                (setenv "PGPASSWORD"
+                        (call-with-input-file "/password" get-string-all))
                 (let* ((port (open-pipe*
                               OPEN_READ
                               #$(file-append postgresql "/bin/psql")
-                              "-tA" "-c" "SELECT 1 FROM pg_database WHERE
- datname='root'"))
+                              "-U" "a_database" "-tA" "-h" "localhost" "-c"
+                              "SELECT 1 FROM pg_database WHERE datname='a_database'"))
                        (output (get-string-all port)))
                   (close-pipe port)
-                  (string-contains output "1")))
+                  (string=? output "1\n")))
              marionette))
 
           (test-end))))