From edc8a2e5ae3c89b78fb837d4351f0ddfab8fe474 Mon Sep 17 00:00:00 2001
From: Marius Bakke <marius@gnu.org>
Date: Thu, 16 Jun 2022 22:46:01 +0200
Subject: [PATCH] services: Shepherd can backup and restore PostgreSQL
databases.
* gnu/services/databases.scm (<postgresql-configuration>)[backup-directory]:
New field.
(postgresql-activation): Create it.
(postgresql-backup-action, postgresql-list-backups-action,
postgresql-restore-action): New variables.
(postgresql-shepherd-service)[actions]: Register them.
* gnu/tests/databases.scm (%postgresql-backup-directory): New variable.
(run-postgresql-test): Trim unused module imports from existing tests. Add
"insert test data", "backup database", "list backups", "drop database",
"restore database", "update test data", "restore again", and "verify restore"
tests.
---
gnu/services/databases.scm | 169 ++++++++++++++++++++++++++++++++++++-
gnu/tests/databases.scm | 117 ++++++++++++++++++++++++-
2 files changed, 278 insertions(+), 8 deletions(-)
@@ -6,7 +6,7 @@
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net>
-;;; Copyright © 2020 Marius Bakke <marius@gnu.org>
+;;; Copyright © 2020, 2022 Marius Bakke <marius@gnu.org>
;;; Copyright © 2021 David Larsson <david.larsson@selfhosted.xyz>
;;;
;;; This file is part of GNU Guix.
@@ -176,6 +176,8 @@ (define-record-type* <postgresql-configuration>
(default "/var/log/postgresql"))
(data-directory postgresql-configuration-data-directory
(default "/var/lib/postgresql/data"))
+ (backup-directory postgresql-configuration-backup-directory
+ (default "/var/lib/postgresql/backup"))
(extension-packages postgresql-configuration-extension-packages
(default '())))
@@ -213,7 +215,7 @@ (define (final-postgresql postgresql extension-packages)
(define postgresql-activation
(match-lambda
(($ <postgresql-configuration> postgresql port locale config-file
- log-directory data-directory
+ log-directory data-directory backup-directory
extension-packages)
#~(begin
(use-modules (guix build utils)
@@ -245,6 +247,11 @@ (define postgresql-activation
(mkdir-p #$log-directory)
(chown #$log-directory (passwd:uid user) (passwd:gid user)))
+ ;; Create the backup directory.
+ (when (string? #$backup-directory)
+ (mkdir-p #$backup-directory)
+ (chown #$backup-directory (passwd:uid user) (passwd:gid user)))
+
;; Drop privileges and init state directory in a new
;; process. Wait for it to finish before proceeding.
(match (primitive-fork)
@@ -265,10 +272,155 @@ (define postgresql-activation
(primitive-exit 1))))
(pid (waitpid pid))))))))
+(define (postgresql-backup-action postgresql backup-directory)
+ (shepherd-action
+ (name 'backup)
+ (documentation
+ "Back up a database on the running PostgreSQL server.")
+ (procedure
+ #~(lambda* (pid #:optional database #:rest rest)
+ (use-modules (guix build utils)
+ (ice-9 match)
+ (srfi srfi-19))
+ (if database
+ (let* ((user (getpwnam "postgres"))
+ (pg_dump #$(file-append postgresql "/bin/pg_dump"))
+ (options '("--create" "--clean" "--if-exists"
+ "--format=d"))
+ (start-time (current-time))
+ (date (time-utc->date start-time))
+ (date-stamp (date->string date "~1_~H-~M-~S"))
+ (file-name (string-append #$backup-directory "/"
+ database "@" date-stamp)))
+ ;; Fork so we can drop privileges.
+ (match (primitive-fork)
+ (0
+ ;; Exit with a non-zero status code if an exception is thrown.
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (setgid (passwd:gid user))
+ (setuid (passwd:uid user))
+ (umask #o027)
+ (format (current-output-port)
+ "postgres: creating backup ~a.~%"
+ (basename file-name))
+ (mkdir-p (dirname file-name))
+ (let* ((result (apply system* pg_dump database
+ "-f" file-name
+ options))
+ (exit-value (status:exit-val result)))
+ (if (= 0 exit-value)
+ (format (current-output-port)
+ "postgres: backup of ~a completed successfully.~%"
+ database)
+ (format (current-output-port)
+ "postgres: backup of ~a completed with errors.~%"
+ database))
+ (primitive-exit exit-value)))
+ (lambda ()
+ (format (current-output-port)
+ "postgres: backup of ~a failed.~%")
+ (primitive-exit 1))))
+ (pid (waitpid pid))))
+ (begin
+ (format #t "usage: herd backup postgres DATABASE~%")
+ #f))))))
+
+(define (postgresql-list-backups-action backup-directory)
+ (shepherd-action
+ (name 'list-backups)
+ (documentation
+ "List available PostgreSQL backups.")
+ (procedure
+ #~(lambda* (pid #:optional database #:rest rest)
+ (use-modules (ice-9 ftw)
+ (srfi srfi-26))
+ (if (file-exists? #$backup-directory)
+ (for-each (cut format #t "~a~%" <>)
+ (scandir #$backup-directory
+ (if database
+ (cut string-prefix? database <>)
+ (negate (cut member <> '("." ".."))))))
+ #f)))))
+
+(define (postgresql-restore-action postgresql backup-directory)
+ (shepherd-action
+ (name 'restore)
+ (documentation
+ "Restore a PostgreSQL backup.")
+ (procedure
+ #~(lambda* (pid #:optional file #:rest rest)
+ (use-modules (ice-9 match)
+ (ice-9 popen)
+ (ice-9 rdelim))
+
+ ;; The pg_restore arguments varies slightly if the database is
+ ;; missing vs already present, hence this procedure.
+ (define (database-exists? db)
+ (let* ((psql #$(file-append postgresql "/bin/psql"))
+ (separator "%")
+ (port (open-input-pipe (string-append psql " -lqtA"
+ " -F " separator))))
+ (let loop ((line (read-line port)))
+ (cond
+ ((eof-object? line)
+ (close-port port)
+ #f)
+ ((string-prefix? (string-append db separator) line)
+ (close-port port)
+ #t)
+ (else (loop (read-line port)))))))
+
+ (let ((user (getpwnam "postgres"))
+ (pg_restore #$(file-append postgresql "/bin/pg_restore")))
+ (if (and (string? file)
+ (file-exists? (string-append #$backup-directory "/" file)))
+ (match (primitive-fork)
+ (0
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (setgid (passwd:gid user))
+ (setuid (passwd:uid user))
+ (let* ((backup-file (string-append #$backup-directory
+ "/" file))
+ (database (match (string-split file #\@)
+ ((name date) name)))
+ (create? (not (database-exists? database)))
+ (options (list "--clean" "--if-exists"
+ (if create?
+ "--create"
+ "--single-transaction"))))
+ (format (current-output-port)
+ "postgres: restoring ~a.~%" file)
+ (let* ((result (apply system* pg_restore backup-file
+ "-d" (if create? "postgres" database)
+ options))
+ (exit-value (status:exit-val result)))
+ (if (= 0 exit-value)
+ (format (current-output-port)
+ "postgres: restore of ~a completed \
+successfully.~%"
+ database)
+ (format (current-output-port)
+ "postgres: restore of ~a completed \
+with errors.~%"
+ database))
+ (primitive-exit exit-value))))
+ (lambda ()
+ (format #t "postgres: could not restore ~a.~%" file)
+ (primitive-exit 1))))
+ (pid (waitpid pid)))
+ (begin
+ (format #t "usage: herd restore postgres BACKUP~%")
+ (format #t "hint: see 'herd list-backups postgres'~%")
+ #f)))))))
+
(define postgresql-shepherd-service
(match-lambda
(($ <postgresql-configuration> postgresql port locale config-file
- log-directory data-directory
+ log-directory data-directory backup-directory
extension-packages)
(let* ((pg_ctl-wrapper
;; Wrapper script that switches to the 'postgres' user before
@@ -309,8 +461,17 @@ (define postgresql-shepherd-service
(provision '(postgres))
(documentation "Run the PostgreSQL daemon.")
(requirement '(user-processes loopback syslogd))
- (modules `((ice-9 match)
+ (modules `((ice-9 ftw)
+ (ice-9 match)
+ (ice-9 popen)
+ (ice-9 rdelim)
+ (srfi srfi-19)
+ (srfi srfi-26)
,@%default-modules))
+ (actions (list
+ (postgresql-backup-action postgresql backup-directory)
+ (postgresql-list-backups-action backup-directory)
+ (postgresql-restore-action postgresql backup-directory)))
(start (action "start"))
(stop (action "stop"))))))))
@@ -134,6 +134,9 @@ (define %test-memcached
;;; The PostgreSQL service.
;;;
+(define %postgresql-backup-directory
+ "/var/lib/postgresql/backup")
+
(define %postgresql-log-directory
"/var/log/postgresql")
@@ -195,8 +198,6 @@ (define marionette
(test-assert "log-file"
(marionette-eval
'(begin
- (use-modules (ice-9 ftw)
- (ice-9 match))
(current-output-port
(open-file "/dev/console" "w0"))
(let ((server-log-file
@@ -227,8 +228,7 @@ (define marionette
(test-assert "database creation"
(marionette-eval
'(begin
- (use-modules (gnu services herd)
- (ice-9 popen))
+ (use-modules (ice-9 popen))
(current-output-port
(open-file "/dev/console" "w0"))
(let* ((port (open-pipe*
@@ -241,6 +241,115 @@ (define marionette
(string-contains output "1")))
marionette))
+ (test-eq "insert test data"
+ 0
+ (marionette-eval
+ '(begin
+ (current-output-port
+ (open-file "/dev/console" "w0"))
+ (let ((result (system*
+ #$(file-append postgresql "/bin/psql")
+ "-tA" "-c" "CREATE TABLE test (name VARCHAR,
+ status VARCHAR);
+INSERT INTO TEST VALUES ('backup', 'pending');"
+ "root")))
+ (status:exit-val result)))
+ marionette))
+
+ (test-assert "backup database"
+ (marionette-eval
+ '(with-shepherd-action 'postgres ('backup "root")
+ result
+ result)
+ marionette))
+
+ (test-assert "list backups"
+ (marionette-eval
+ '(with-shepherd-action 'postgres ('list-backups)
+ result
+ result)
+ marionette))
+
+ (test-eq "drop database"
+ 0
+ (marionette-eval
+ '(begin
+ (current-output-port
+ (open-file "/dev/console" "w0"))
+ (let ((result (system*
+ #$(file-append postgresql "/bin/psql")
+ "-tA" "-c" "DROP DATABASE root"
+ "postgres")))
+ (status:exit-val result)))
+ marionette))
+
+ (test-assert "restore database"
+ (let ((file-name (marionette-eval
+ '(begin
+ (use-modules (ice-9 ftw)
+ (srfi srfi-26))
+ (car (scandir #$%postgresql-backup-directory
+ (negate (cut member <>
+ '("." ".."))))))
+ marionette)))
+ (marionette-eval
+ `(with-shepherd-action 'postgres ('restore ,file-name)
+ result
+ result)
+ marionette)))
+
+ (test-equal "update test data"
+ "completed"
+ (marionette-eval
+ '(begin
+ (use-modules (ice-9 popen))
+ (current-output-port
+ (open-file "/dev/console" "w0"))
+ (let* ((port (open-pipe*
+ OPEN_READ
+ #$(file-append postgresql "/bin/psql")
+ "-tA" "-c" "
+UPDATE test SET status='completed' WHERE name='backup';
+SELECT status FROM test WHERE name='backup';"
+ "root"))
+ (output (get-string-all port)))
+ (close-pipe port)
+ (string-trim-right output)))
+ marionette))
+
+ (test-assert "restore again"
+ (let ((file-name (marionette-eval
+ '(begin
+ (use-modules (ice-9 ftw)
+ (srfi srfi-26))
+ (car (scandir #$%postgresql-backup-directory
+ (negate (cut member <>
+ '("." ".."))))))
+ marionette)))
+ (marionette-eval
+ `(with-shepherd-action 'postgres ('restore ,file-name)
+ result
+ result)
+ marionette)))
+
+ (test-equal "verify restore"
+ "pending"
+ (marionette-eval
+ '(begin
+ (use-modules (ice-9 popen))
+ (current-output-port
+ (open-file "/dev/console" "w0"))
+ (let* ((port (open-pipe*
+ OPEN_READ
+ #$(file-append postgresql "/bin/psql")
+ "-tA" "-c" "
+SELECT status FROM test WHERE name='backup'"
+ "root"))
+ (output (get-string-all port)))
+ (close-pipe port)
+ (string-trim-right output)))
+ marionette))
+
(test-end))))
(gexp->derivation "postgresql-test" test))
--
2.36.1