Adding upstream version 248.upstream/248upstream

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

1 files changed, 614 insertions, 0 deletions

diff --git a/pg_backupcluster b/pg_backupcluster
new file mode 100755
index 0000000..8fa49f2
--- /dev/null
+++ b/pg_backupcluster
@@ -0,0 +1,614 @@
+#!/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";
+    my @cmd = ($pg_receivewal, "--cluster", "$version/$cluster",
+        "-D", $waldir, "--slot", "pg_receivewal_service");
+    push @cmd, "--compress=5" if ($version >= 10);
+    exec {$pg_receivewal} @cmd 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();
+    compresswal();
+    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. WAL files are gzip-compressed in PG 10+.
+
+=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>>