File: //bin/pg_backupcluster
#!/usr/bin/perl -wT
# simple pg_basebackup front-end
#
# Copyright (C) 2021 Christoph Berg <myon@debian.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
use strict;
use warnings;
use Fcntl qw(LOCK_EX);
use Getopt::Long;
use JSON;
use PgCommon;
use POSIX qw(strftime);
my ($version, $cluster);
# untaint environment
$ENV{'PATH'} = '/sbin:/bin:/usr/sbin:/usr/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
chdir '/';
umask 027;
sub help () {
print "Syntax: $0 [options] <version> <cluster> <action>
Actions:
createdirectory Create /var/backups/version-cluster
basebackup Backup using pg_basebackup
dump Backup using pg_dump
expiredumps <N> Remove all but last N dumps
expirebasebackups <N> Remove all but last N basebackups
receivewal Launch pg_receivewal
compresswal Compress WAL files in archive
archivecleanup Remove obsolete WAL files from archive
list Show dumps, basebackups, and WAL
Options:
-k --keep-on-error Keep faulty backup directory on error
-v --verbose Verbose output
";
}
my $keep_on_error;
my $verbose;
exit 1 unless GetOptions (
'k|keep-on-error' => \$keep_on_error,
'v|verbose' => \$verbose,
);
$verbose = 1 if (-t 1); # verbose output when running on terminal
# accept both "version cluster action" and "version[-/]cluster action"
if (@ARGV >= 2 and $ARGV[0] =~ m!^(\d+\.?\d)[-/]([^/]+)$!) {
($version, $cluster) = ($1, $2);
shift @ARGV;
} elsif (@ARGV >= 3 and $ARGV[0] =~ /^(\d+\.?\d)$/) {
$version = $1;
($cluster) = ($ARGV[1]) =~ m!^([^/]+)$!;
shift @ARGV;
shift @ARGV;
} else {
help();
exit 1;
}
my $action = $ARGV[0];
error "specified cluster $version $cluster does not exist" unless $version && $cluster && cluster_exists $version, $cluster;
my %info = cluster_info($version, $cluster);
validate_cluster_owner \%info;
my $rootdir = "/var/backups/postgresql";
my $clusterdir = "$rootdir/$version-$cluster";
my $waldir = "$clusterdir/wal";
# functions to be run as root
sub create_directory() {
if (! -d $rootdir) {
my ($pg_uid, $pg_gid) = (getpwnam 'postgres')[2,3];
($pg_uid and $pg_gid) or error "getpwnam postgres: $!";
mkdir $rootdir, 0755 or error "mkdir $rootdir: $!";
chown $pg_uid, $pg_gid, $rootdir or error "chown $rootdir: $!";
}
if (! -d $clusterdir) {
mkdir($clusterdir, 0750) or error "mkdir $clusterdir: $!";
chown $info{owneruid}, $info{ownergid}, $clusterdir or error "chown $clusterdir: $!";
}
}
sub switch_to_cluster_owner() {
change_ugid $info{owneruid}, $info{ownergid};
}
# backup functions
sub get_backupdir($) {
my $suffix = shift;
my $timestamp = strftime("%FT%H%M%SZ", gmtime);
my $backupdir = "$clusterdir/$timestamp.$suffix";
error "$backupdir already exists" if (-d $backupdir);
print "Creating $suffix in $backupdir\n" if ($verbose);
return $backupdir;
}
sub remove_backup_on_error($) {
my $backupdir = shift;
if ($keep_on_error) {
print "Not removing $backupdir (--keep-on-error)\n";
} else {
print "Removing $backupdir ...\n" if ($verbose);
system_or_error "rm", "-rf", $backupdir;
}
}
sub create_basebackup($) {
my $backupdir = shift;
system_or_error "pg_basebackup",
"--cluster", "$version/$cluster",
"--verbose",
(-t 2 ? "--progress" : ()),
"--format", "tar", "--gzip",
($version < 10 ? "--xlog" : ()),
"-D", $backupdir;
}
sub create_dumpall($) {
my $backupdir = shift;
mkdir($backupdir, 0750) or error "mkdir $backupdir: $!";
my $clusterquery = "SELECT concat(
format('--encoding %s --lc-collate %s --lc-ctype %s', pg_catalog.pg_encoding_to_char(encoding), datcollate, datctype),
CASE WHEN current_setting('data_checksums')::boolean THEN ' -- --data-checksums' END)
FROM pg_database WHERE datname = 'template0'";
system_or_error "psql",
"--cluster", "$version/$cluster",
"-XAtc", $clusterquery,
"-o", "$backupdir/createcluster.opts";
system_or_error "pg_dumpall",
"--cluster", "$version/$cluster",
"--globals-only",
"--file", "$backupdir/globals.sql";
my $dbquery = "/* database creation */
SELECT
format('CREATE DATABASE %I WITH OWNER = %I TEMPLATE = template0 ENCODING = %L LC_COLLATE %L LC_CTYPE %L;', datname, rolname, pg_encoding_to_char(encoding), datcollate, datctype) AS command
FROM pg_database
LEFT JOIN pg_roles r ON r.oid = datdba
WHERE datallowconn AND datname NOT IN ('postgres', 'template1')
UNION ALL
/* database options */
SELECT
CASE
WHEN rolname IS NULL THEN format('ALTER DATABASE %I', datname)
ELSE format('ALTER ROLE %I IN DATABASE %I', rolname, datname)
END ||
format(' SET %I = ', match[1]) ||
CASE
WHEN match[1] IN ('local_preload_libraries', 'search_path', 'session_preload_libraries', 'shared_preload_libraries', 'temp_tablespaces', 'unix_socket_directories')
THEN match[2]
ELSE quote_literal(match[2])
END ||
';' AS command
FROM pg_db_role_setting s
JOIN pg_database d ON d.oid = setdatabase
LEFT JOIN pg_roles r ON r.oid = setrole,
unnest(setconfig) u(setting),
regexp_matches(setting, '(.+)=(.+)') m(match)";
system_or_error "psql",
"--cluster", "$version/$cluster",
"-XAtc", $dbquery,
"-o", "$backupdir/databases.sql";
my $dblist = 'SELECT datname FROM pg_database WHERE datallowconn ORDER BY datname';
my $databases = `psql --cluster '$version/$cluster' -XAtc '$dblist'`;
for my $datname ($databases =~ /(.+)/g) {
print "Dumping $datname to $backupdir/$datname.dump ...\n" if ($verbose);
system_or_error "pg_dump",
"--cluster", "$version/$cluster",
"--format=custom",
"--file", "$backupdir/$datname.dump",
$datname;
}
}
sub create_configbackup($) {
my $backupdir = shift;
$info{configdir} or error "cluster has no configdir";
system_or_error "tar",
"-C", $info{configdir},
"-cz", "-f", "$backupdir/config.tar.gz",
".";
}
sub create_status($$$$) {
my ($type, $starttime, $backupdir, $status) = @_;
my $statusfile = "$backupdir/status";
my $endtime = time;
my $statusjson = {
cluster => $cluster,
duration => $endtime - $starttime,
end => scalar(gmtime($endtime)),
start => scalar(gmtime($starttime)),
status => $status,
type => $type,
version => $version,
};
open F, '>', $statusfile or error "$statusfile: $!";
print F encode_json($statusjson) . "\n" or error "$statusfile: $!";
close F or error "$$statusfile: $!";
}
sub sync($) {
my $backupdir = shift;
system_or_error "sync $backupdir/*";
}
sub expire_backups($$) {
my ($suffix, $number) = @_;
my @backups = glob("$clusterdir/*.$suffix");
my $found = 0;
for my $backup (reverse @backups) {
# iterate reversely over backups until we have found enough valid ones
if ($found >= $number) {
print "Removing $backup ...\n" if ($verbose);
$backup =~ /(.*)/; # untaint
system_or_error "rm", "-rf", $1;
} else {
if (-f "$backup/status") {
$found++;
}
}
}
}
sub delete_broken() {
my @backups = (glob("$clusterdir/*.backup"), glob("$clusterdir/*.dump"));
for my $backup (@backups) {
if (! -f "$backup/status") {
print "Removing $backup ...\n" if ($verbose);
$backup =~ /(.*)/; # untaint
system_or_error "rm", "-rf", $1;
}
}
}
# wal handling
sub create_wal_directory() {
if (! -d $waldir) {
mkdir($waldir, 0750) or error "mkdir $waldir: $!";
}
}
sub receivewal() {
my $pg_receivewal = $version >= 10 ? 'pg_receivewal' : 'pg_receivexlog';
# create slot
system_or_error $pg_receivewal, "--cluster=$version/$cluster", "--slot", "pg_receivewal_service", "--create-slot", "--if-not-exists";
# launch pg_receivewal
$ENV{PGAPPNAME} = "pg_receivewal\@$version-$cluster.service";
exec {$pg_receivewal} $pg_receivewal, "--cluster", "$version/$cluster",
"-D", $waldir, "--slot", "pg_receivewal_service"
or error "exec $pg_receivewal: $!";
}
sub compresswal() {
chdir $waldir or return; # ok if not yet created
open my $lock, $waldir or error "open $waldir: $!"; # protect against concurrent runs
flock $lock, LOCK_EX or error "flock $waldir: $!";
for my $wal (glob "0???????????????????????") {
$wal =~ /^([0-9A-F]+)$/ or continue;
$wal = $1; # untaint
if (-f "$wal.gz") {
print STDERR "$waldir/$wal.gz already exists, skipping compression\n";
next;
}
system_or_error "if ! gzip < $wal > $wal.tmp.gz; then rm -f $wal.tmp.gz; exit 1; fi";
system_or_error "touch --reference=$wal $wal.tmp.gz";
system_or_error "mv $wal.tmp.gz $wal.gz";
system_or_error "sync", "$wal.gz";
unlink $wal;
}
close $lock;
}
sub archivecleanup() {
chdir $waldir or return; # ok if not yet created
my @backups = sort glob "$clusterdir/*.backup";
for my $backup (@backups) {
next unless (-f "$backup/status");
$backup =~ /(.*)/; # untaint
my $basetar = "$1/base.tar.gz";
my $backup_label = `tar --extract --occurrence=1 --to-stdout --file '$basetar' backup_label` or error "failed to extract backup_label from $basetar";
# START WAL LOCATION: 0/2B000028 (file 00000001000000000000002B)
$backup_label =~ /^START WAL LOCATION: .* \(file ([0-9A-F]+)\)/ or error "no start wal location in $basetar";
my $keep_file = $1;
system_or_error "pg_archivecleanup", "-x", ".gz", $waldir, $keep_file;
return 0; # process first backup only
}
error "no valid basebackups found in $clusterdir";
}
# info functions
sub dirsize($) {
my $dir = shift;
my $size = 0;
my $files = 0;
for my $f (glob "$dir/*") {
$size += (stat $f)[7];
$files++;
}
return $size, $files;
}
sub list() {
print "Cluster $version $cluster backups in $clusterdir:\n";
my $totalsize = 0;
print "Dumps:\n";
for my $dir (sort glob "$clusterdir/*.dump") {
my ($size, $files) = dirsize($dir);
my $status = -f "$dir/status" ? '' : ' BROKEN';
print " $dir: $size Bytes$status\n";
$totalsize += $size;
}
print "Basebackups:\n";
for my $dir (sort glob "$clusterdir/*.backup") {
my ($size, $files) = dirsize($dir);
my $status = -f "$dir/status" ? '' : ' BROKEN';
print " $dir: $size Bytes$status\n";
$totalsize += $size;
}
if (-d "$clusterdir/wal") {
print "WAL:\n";
my ($size, $files) = dirsize("$clusterdir/wal");
print " $clusterdir/wal: $size Bytes, $files Files\n";
$totalsize += $size;
}
print "Total: $totalsize Bytes\n";
}
# main
if ($action eq 'createdirectory') {
create_directory();
} elsif ($action eq 'basebackup') {
error "basebackups of pre-9.1 servers are not supported" if ($version < 9.1);
my $starttime = time;
create_directory();
switch_to_cluster_owner();
my $backupdir = get_backupdir('backup');
$SIG{__DIE__} = sub { remove_backup_on_error($backupdir) };
create_basebackup($backupdir);
create_configbackup($backupdir);
create_status($action, $starttime, $backupdir, 'ok');
$SIG{__DIE__} = undef;
sync($backupdir);
compresswal();
} elsif ($action eq 'dump') {
error "dumps of pre-9.3 servers are not supported" if ($version < 9.3);
my $starttime = time;
create_directory();
switch_to_cluster_owner();
my $backupdir = get_backupdir('dump');
$SIG{__DIE__} = sub { remove_backup_on_error($backupdir) };
create_dumpall($backupdir);
create_configbackup($backupdir);
create_status($action, $starttime, $backupdir, 'ok');
$SIG{__DIE__} = undef;
sync($backupdir);
} elsif ($action eq 'expiredumps' and @ARGV == 2 and $ARGV[1] =~ /^(\d+)$/) {
switch_to_cluster_owner();
expire_backups('dump', $1);
} elsif ($action eq 'expirebasebackups' and @ARGV == 2 and $ARGV[1] =~ /^(\d+)$/) {
switch_to_cluster_owner();
expire_backups('backup', $1);
archivecleanup();
compresswal();
} elsif ($action eq 'deletebroken') {
switch_to_cluster_owner();
delete_broken();
} elsif ($action eq 'receivewal') {
create_directory();
switch_to_cluster_owner();
create_wal_directory();
receivewal();
} elsif ($action eq 'compresswal') {
switch_to_cluster_owner();
compresswal();
} elsif ($action eq 'archivecleanup') {
switch_to_cluster_owner();
archivecleanup();
compresswal();
} elsif ($action eq 'list') {
switch_to_cluster_owner();
list();
} else {
help();
exit(1);
}
__END__
=head1 NAME
pg_backupcluster - simple pg_basebackup and pg_dump front-end
=head1 SYNOPSIS
B<pg_backupcluster> [I<options>] I<version> I<cluster> I<action>
=head1 DESCRIPTION
B<pg_backupcluster> provides a simple interface to create PostgreSQL cluster
backups using L<pg_basebackup(1)> and L<pg_dump(1)>.
To ease integration with B<systemd> operation, the alternative syntax
"B<pg_basebackup> I<version>B<->I<cluster> I<action>" is also supported.
=head1 ACTIONS
=over 4
=item B<createdirectory>
Create /var/backups and /var/backups/I<version>-I<cluster>.
This action can be run as root to create the directories required for backups.
All other actions will also attempt to create the directories when missing, but
can of course only do that when running as root. They will switch to the
cluster owner after this step.
=item B<basebackup>
Backup using L<pg_basebackup(1)>. The resulting basebackup contains the WAL
files required to run recovery on startup.
=item B<dump>
Backup using L<pg_dump(1)>. Global objects (users, tablespaces) are dumped
using L<pg_dumpall(1)> B<--globals-only>. Individual databases are dumped into
PostgreSQL's custom format.
=item B<expirebasebackups> I<N>
Remove all but last the I<N> basebackups.
=item B<expiredumps> I<N>
Remove all but last the I<N> dumps.
=item B<receivewal>
Launch pg_receivewal.
=item B<compresswal>
Compress WAL files in archive.
=item B<archivecleanup>
Remove obsolete WAL files from archive using L<pg_archivecleanup(1)>.
=item B<list>
Show dumps, basebackups, and WAL, with size.
=back
=head1 OPTIONS
=over 4
=item B<-k --keep-on-error>
Keep faulty backup directory on error. By default backups are delete on error.
=item B<-v --verbose>
Verbose output, even when not running on a terminal.
=back
=head1 FILES
=over 4
=item /var/backups
Default root directory for cluster backup directories.
=item /var/backups/I<version>-I<cluster>
Default directory for cluster backups.
=item /var/backups/I<version>-I<cluster>/I<timestamp>B<.basebackup>
Backup from B<pg_backupcluster ... basebackup>.
=over 4
=item C<config.tar.gz>
Tarball of cluster configuration directory (postgresql.conf, pg_hba.conf, ...)
in /etc/postgresql.
=item I<tablespace>C<.tar.gz>, C<pg_wal.tar.gz>, C<backup_manifest>
Tablespace and WAL tarballs and backup info written by B<pg_basebackup>.
=item C<status>
Completion timestamp of backup run.
=back
=item /var/backups/I<version>-I<cluster>/I<timestamp>B<.dump>
Backup from B<pg_backupcluster ... dump>.
=over 4
=item C<config.tar.gz>
Tarball of cluster configuration directory (postgresql.conf, pg_hba.conf, ...)
in /etc/postgresql.
=item C<createcluster.opts>
Options (encoding, locale, data checksums) to be passed to B<pg_createcluster>
for restoring this cluster.
=item C<globals.sql>
Global objects (roles, tablespaces) from B<pg_dumpall --globals-only>.
=item C<databases.sql>
SQL commands to create databases and restore database-level options.
=item I<database>C<.dump>
Database dumps from B<pg_dump --format=custom>.
=item C<status>
Completion timestamp of backup run.
=back
=item /var/backups/I<version>-I<cluster>/B<wal>
WAL files from B<pg_receivewal>.
=back
=head1 CAVEATS
For dump-style backups, not all properties of the original cluster are preserved:
=over 2
=item * In PostgreSQL 10 and earlier, ALTER ROLE ... IN DATABASE is not supported.
=item * Not all B<initdb> options are carried over. Currently supported are B<--encoding>,
B<--lc-collate>, B<--lc-collate>, and B<-k --data-checksums>.
=back
The earliest PostgreSQL version supported for dumps is 9.3.
For basebackups, the earliest supported version is 9.1.
B<receivewal> (and hence archive recovery) are supported in 9.5 and later.
=head1 SEE ALSO
L<pg_restorecluster(1)>,
L<pg_dump(1)>, L<pg_dumpall(1)>,
L<pg_basebackup(1)>, L<pg_receivewal(1)>, L<pg_archivecleanup(1)>.
=head1 AUTHOR
Christoph Berg L<E<lt>myon@debian.orgE<gt>>