#!/usr/bin/perl -wT

# Upgrade a PostgreSQL cluster to a newer major version.
#
# (C) 2005-2009 Martin Pitt <mpitt@debian.org>
# (C) 2013 Peter Eisentraut <petere@debian.org>
# (C) 2013-2025 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 PgCommon;
use File::Temp qw(tempfile);
use Getopt::Long;
use POSIX qw(lchown);

# untaint environment
$ENV{'PATH'} = '/bin:/usr/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

# global variables
my ($version, $newversion, $cluster, $newcluster);
my (%info, %newinfo);
my ($encoding, $old_lc_ctype, $old_lc_collate); # old cluster encoding
my ($old_locale_provider, $old_icu_locale, $old_icu_rules);
my $maintenance_db = 'template1';
my $keep_on_error = 0;

# do not trip over cwd not being accessible to postgres superuser
chdir '/';

sub pre_upgrade_check($$$) {
    my ($oldversion, $newversion, $force_packages) = @_;

    return 1 if ($version == $newversion);

    my @new_packages = package_list("postgresql*-$newversion*");

    my $missing = 0;
    for my $oldpkg (package_list("postgresql*-$oldversion*")) {
        next if ($oldpkg =~ /-(dbgsym|doc)/);
        my $newpkg = $oldpkg;
        $newpkg =~ s/-$oldversion/-$newversion/;

        next if ($newpkg =~ /^postgresql-contrib-/ and $newversion >= 10); # postgresql-contrib-NN merged into postgresql-NN in 10+

        if (not grep {$_ eq $newpkg} @new_packages) {
            print "$oldpkg is installed, but $newpkg is missing\n";
            $missing++;
        }
    }

    if ($missing) {
        print "$missing package(s) from version $oldversion missing for version $newversion\n";
        if ($force_packages) {
            print "Ignoring as --force-package was used\n";
        } else {
            print "Install the missing packages and try pg_upgradecluster again. To ignore the issue, use --force-packages\n";
            return 0;
        }
    }

    return 1;
}

# update the new cluster's conffiles
sub adapt_conffiles {
    my ($newversion, $newcluster, $configfile) = @_;
    my %c = read_cluster_conf_file $newversion, $newcluster, $configfile, 0;

    # Arguments: <ref to conf hash> <name> <comment>
    my $deprecate = sub {
        my ($conf, $guc, $comment) = @_;
        if (defined $conf->{$guc}) {
            PgCommon::disable_conf_value $newversion, $newcluster,
                $configfile, $guc, $comment;
        }
    };

    # Arguments: <ref to conf hash> <old name> <new name>
    my $rename = sub {
        my ($conf, $old, $new) = @_;
        if (defined ${$conf}{$old}) {
            PgCommon::replace_conf_value $newversion, $newcluster,
                $configfile, $old, "deprecated in favor of $new",
                $new, ${$conf}{$old};
        }
    };

    # Arguments: <config option> <value>
    my $set = sub {
        my ($guc, $val) = @_;
        PgCommon::set_conf_value $newversion, $newcluster, $configfile,
            $guc, $val;
    };

    # adapt paths to configuration files
    if ($configfile eq 'postgresql.conf') {
        $set->('data_directory', $newinfo{'pgdata'});
    } else {
        # fix bug in pg_upgradecluster 200..202
        $deprecate->(\%c, 'data_directory', 'not valid in postgresql.auto.conf');
    }
    for my $guc (qw(hba_file ident_file external_pid_file stats_temp_directory)) {
        next unless (defined $c{$guc});
        my $val = $c{$guc};
        $val =~ s/\b\Q$version\E\b/$newversion/g;
        $val =~ s/\b\Q$cluster\E\b/$newcluster/g if ($cluster ne $newcluster);
        $set->($guc, $val);
    }

    if ($newversion >= '8.2') {
        # preload_libraries -> shared_preload_libraries transition
        $rename->(\%c, 'preload_libraries', 'shared_preload_libraries');

	# australian_timezones -> timezone_abbreviations transition
	my $australian_timezones = config_bool $c{'australian_timezones'};
	if (defined $australian_timezones) {
            PgCommon::replace_conf_value $newversion, $newcluster, $configfile,
		    'australian_timezones', 'deprecated in favor of timezone_abbreviations', 
		    'timezone_abbreviations', ($australian_timezones ?  'Australia' : 'Default');
	}
    }

    if ($newversion >= '8.3') {
        $deprecate->(\%c, 'bgwriter_lru_percent', 'deprecated');
        $deprecate->(\%c, 'bgwriter_all_percent', 'deprecated');
        $deprecate->(\%c, 'bgwriter_all_maxpages', 'deprecated');

        $rename->(\%c, 'redirect_stderr', 'logging_collector');

        $rename->(\%c, 'stats_command_string', 'track_activities');
        $deprecate->(\%c, 'stats_start_collector', 'deprecated, always on now');
        $deprecate->(\%c, 'stats_reset_on_server_start', 'deprecated');

	# stats_block_level and stats_row_level are merged into track_counts
	if ($c{'stats_block_level'} || $c{'stats_row_level'}) {
	    $deprecate->(\%c, 'stats_block_level', 'deprecated in favor of track_counts');
	    $deprecate->(\%c, 'stats_row_level', 'deprecated in favor of track_counts');
            $set->('track_counts', (config_bool $c{'stats_block_level'} || config_bool $c{'stats_row_level'}) ? 'on' : 'off');
	}

        # archive_command now has to be enabled explicitly
        if ($c{'archive_command'}) {
            $set->('archive_mode', 'on');
        }
    }

    if ($newversion >= '8.4') {
        $deprecate->(\%c, 'max_fsm_pages', 'not needed anymore');
        $deprecate->(\%c, 'max_fsm_relations', 'not needed anymore');
        $deprecate->(\%c, 'krb_server_hostname', 'does not exist anymore');
        $deprecate->(\%c, 'krb_realm', 'does not exist anymore');
        $rename->(\%c, 'explain_pretty_print', 'debug_pretty_print');
    }

    if ($newversion >= '9.0') {
	$deprecate->(\%c, 'add_missing_from', 'does not exist anymore');
	$deprecate->(\%c, 'regex_flavor', 'does not exist anymore');
    }

    if ($newversion >= '9.2') {
	$deprecate->(\%c, 'wal_sender_delay', 'does not exist anymore');
	$deprecate->(\%c, 'silent_mode', 'does not exist anymore');
	$deprecate->(\%c, 'custom_variable_classes', 'does not exist anymore');
    }

    if ($newversion >= '9.3') {
        $rename->(\%c, 'unix_socket_directory', 'unix_socket_directories');
        $rename->(\%c, 'replication_timeout', 'wal_sender_timeout');
    }

    if ($newversion >= '9.4') {
        $deprecate->(\%c, 'krb_srvname', 'native krb5 authentication deprecated in favor of GSSAPI');
        # grab dsmt from the new config just written by initdb
        if (not $c{dynamic_shared_memory_type} and $configfile eq 'postgresql.conf') {
            $set->('dynamic_shared_memory_type', ($newinfo{config}->{dynamic_shared_memory_type} || 'mmap'));
        }
    }

    if ($newversion >= '9.5') {
        if (exists $c{checkpoint_segments}) {
            my $max_wal_size = 16*$c{checkpoint_segments} . 'MB';
            $rename->(\%c, 'checkpoint_segments', 'max_wal_size');
            $set->('max_wal_size', $max_wal_size);
        }
        $deprecate->(\%c, 'ssl_renegotiation_limit', 'does not exist anymore');
        # adapt cluster_name
        my $cluster_name = PgCommon::get_conf_value ($newversion, $newcluster, $configfile, 'cluster_name');
        if ($cluster_name) {
            $cluster_name =~ s/\Q$version\E/$newversion/g;
            $cluster_name =~ s/\Q$cluster\E/$newcluster/g;
            $set->('cluster_name', $cluster_name);
        }
    }

    if ($newversion >= '10') {
        $rename->(\%c, 'min_parallel_relation_size', 'min_parallel_table_scan_size');
        $deprecate->(\%c, 'sql_inheritance', 'does not exist anymore');
    }

    if ($newversion >= '11') {
        $deprecate->(\%c, 'replacement_sort_tuples', 'does not exist anymore');
    }

    if ($newversion >= '13') {
        if (exists $c{wal_keep_segments}) {
            my $wal_keep_size = 16*$c{wal_keep_segments} . 'MB';
            $rename->(\%c, 'wal_keep_segments', 'wal_keep_size');
            $set->('wal_keep_size', $wal_keep_size);
        }
    }

    if ($newversion >= '14') {
        $deprecate->(\%c, 'operator_precedence_warning', 'does not exist anymore');
        if ($c{password_encryption} and $c{password_encryption} =~ /^(on|off|true|false)$/) {
            $deprecate->(\%c, 'password_encryption', 'password_encryption is not a boolean anymore');
        }
        $deprecate->(\%c, 'vacuum_cleanup_index_scale_factor', 'does not exist anymore');
    }

    if ($newversion >= '15') {
        $deprecate->(\%c, 'stats_temp_directory', 'does not exist anymore');
    }

    if ($newversion >= '16') {
        $deprecate->(\%c, 'promote_trigger_file', 'does not exist anymore, use pg_promote() instead');
        $deprecate->(\%c, 'vacuum_defer_cleanup_age', 'does not exist anymore');
        $deprecate->(\%c, 'force_parallel_mode', 'does not exist anymore');
    }

    if ($newversion >= '17') {
        $deprecate->(\%c, 'db_user_namespace', 'does not exist anymore');
        $deprecate->(\%c, 'old_snapshot_threshold', 'does not exist anymore');
    }

    if ($newversion >= '18') {
        $deprecate->(\%c, 'extension_destdir', 'replaced by extension_control_path');
    }
}

sub migrate_config_files() {
    # copy configuration files
    print "Copying old configuration files...\n";
    install_file $info{'configdir'}.'/postgresql.conf', $newinfo{'configdir'},
        $newinfo{'owneruid'}, $newinfo{'ownergid'}, "644";
    adapt_conffiles $newversion, $newcluster, 'postgresql.conf';
    # copy auto.conf after postgresql.conf has been updated
    # (otherwise read_cluster_conf_file would also read auto.conf)
    if ($version >= 9.4) {
        install_file $info{'pgdata'}.'/postgresql.auto.conf', $newinfo{'pgdata'},
            $newinfo{'owneruid'}, $newinfo{'ownergid'}, "600";
        adapt_conffiles $newversion, $newcluster, 'postgresql.auto.conf';
    }
    install_file $info{'configdir'}.'/pg_ident.conf', $newinfo{'configdir'},
        $newinfo{'owneruid'}, $newinfo{'ownergid'}, "640";
    install_file $info{'configdir'}.'/pg_hba.conf', $newinfo{'configdir'},
        $newinfo{'owneruid'}, $newinfo{'ownergid'}, "640";
    if ($version < 8.4 and $newversion >= 8.4) {
        print "Removing 'ident sameuser' from pg_hba.conf...\n";
        my $hba = "$PgCommon::confroot/$newversion/$newcluster/pg_hba.conf";
        open O, $hba or error "open $hba: $!";
        open N, ">$hba.new" or error "open $hba.new: $!";
        while (<O>) {
            s/ident\s+sameuser/ident/;
            print N $_;
        }
        close O;
        close N;
        lchown $newinfo{'owneruid'}, $newinfo{'ownergid'}, "$hba.new";
        chmod 0640, "$hba.new";
        rename "$hba.new", $hba or error "rename: $!";
    }
    if ( -e $info{'configdir'}.'/start.conf') {
        print "Copying old start.conf...\n";
        install_file $info{'configdir'}.'/start.conf', $newinfo{'configdir'},
            $newinfo{'owneruid'}, $newinfo{'ownergid'}, "644";
    }
    if ( -e $info{'configdir'}.'/pg_ctl.conf') {
        print "Copying old pg_ctl.conf...\n";
        install_file $info{'configdir'}.'/pg_ctl.conf', $newinfo{'configdir'},
            $newinfo{'owneruid'}, $newinfo{'ownergid'}, "644";
    }

    # copy SSL files (overwriting any file that pg_createcluster put there)
    for my $file (qw/server.crt server.key root.crt root.crl/) {
        if ( -e "$info{'pgdata'}/$file") {
            print "Copying old $file...\n";
            if (!fork) { # we don't use install_file because that converts symlinks to files
                change_ugid $info{'owneruid'}, $info{'ownergid'};
                system "cp -a $info{'pgdata'}/$file $newinfo{'pgdata'}";
                exit 0;
            }
            wait;
        }
    }
    if ($newversion >= 9.2) {
        # SSL certificate paths have an explicit option now, older versions use
        # a symlink
        for my $f (['server.crt', 'ssl_cert_file'],
            ['server.key', 'ssl_key_file'],
            ['root.crt', 'ssl_ca_file'],
            ['root.crl', 'ssl_crl_file']) {
            my $file = "$newinfo{'pgdata'}/$f->[0]";
            if (-l $file) { # migrate symlink to config entry with link target
                PgCommon::set_conf_value $newversion, $newcluster, 'postgresql.conf',
                    $f->[1], (readlink $file);
                unlink $file;
            } elsif (-e $file) { # plain file in data dir, put in config
                PgCommon::set_conf_value $newversion, $newcluster, 'postgresql.conf',
                    $f->[1], $file;
            }
        }
    }
}

# Write temporary pg_hba.conf.
# Arguments: <version> <cluster> <owner> <owneruid>
sub temp_hba_conf {
    my ($fh, $hba) = tempfile("pg_hba.XXXXXX", TMPDIR => 1, SUFFIX => ".conf");

    if ($_[0] >= '8.4') {
	print $fh "local all $_[2] ident\n";
    } else {
	print $fh "local all $_[2] ident sameuser\n";
    }
    close $fh;
    chmod 0400, $hba;
    lchown $_[3], 0, $hba;

    return $hba;
}

# Get encoding and locales of a running cluster
# Arguments: <version> <cluster>
sub get_encoding {
    my ($version, $cluster) = @_;
    $encoding = get_db_encoding $version, $cluster, $maintenance_db;
    if ($version <= '8.3') {
	($old_lc_ctype, $old_lc_collate) = get_cluster_locales $version, $cluster;
    } else {
	($old_lc_ctype, $old_lc_collate, $old_locale_provider, $old_icu_locale, $old_icu_rules) = get_db_locales $version, $cluster, $maintenance_db;
    }
    unless ($encoding && $old_lc_ctype && $old_lc_collate) {
	error 'could not get cluster locales';
    }
}

# RedHat's run-parts doesn't support any options, supply a minimalistic implementation here
# BUG: we don't care about validating the filenames yet
# Arguments: <directory> <argv to pass to scripts>
sub run_parts {
    my ($dir, @argv) = @_;
    for my $script (<$dir/*>) {
        my ($s) = $script =~ /(.*)/; # untaint
        system ($s, @argv);
        error "$s failed: $?" if ($?);
    }
}

sub run_upgrade_scripts($) {
    my $phase = shift;

    print "Running $phase phase upgrade hook scripts ...\n";
    if (!fork) {
        change_ugid $info{'owneruid'}, $info{'ownergid'};

        if ($PgCommon::rpm) {
            run_parts ("$PgCommon::common_confdir/pg_upgradecluster.d",
                $version, $newcluster, $newversion, $phase);
            exit;
        }

        my @argv = ('run-parts', '--lsbsysinit', '-a', $version, '-a', $newcluster,
            '-a', $newversion, '-a', $phase,
            "$PgCommon::common_confdir/pg_upgradecluster.d");
        error "$PgCommon::common_confdir/pg_upgradecluster.d script failed" if system @argv;
        exit;
    }
    wait;
    if ($? > 0) {
        unless ($keep_on_error) {
            print STDERR "Error during running upgrade hooks, removing new cluster\n";
            system 'pg_dropcluster', '--stop', $newversion, $newcluster;
        }
        exit 1;
    }
}

#
# Execution starts here
#

# command line arguments

my $newest_version = get_newest_version('postgres');
$newversion = $newest_version;

my $check_only = 0;
my $force_packages = 0;
my $method = 'dump';
my $link = 0;
my $clone = 0;
my $data_checksums; # default undef
my $keep_port = 0;
my $start = -1; # -1 = auto

my ($locale, $lc_collate, $lc_ctype, $lc_messages, $lc_monetary, $lc_numeric,
    $lc_time, $logfile, $old_bindir, $jobs);
GetOptions ('v|version=s' => \$newversion,
            'check' => \$check_only,
            'force-packages' => \$force_packages,
	    'locale=s' => \$locale,
	    'lc-collate=s' => \$lc_collate,
	    'lc-ctype=s' => \$lc_ctype,
	    'lc-messages=s' => \$lc_messages,
	    'lc-monetary=s' => \$lc_monetary,
	    'lc-numeric=s' => \$lc_numeric,
	    'lc-time=s' => \$lc_time,
	    'logfile=s' => \$logfile,
	    'm|method=s' => \$method,
	    'j|jobs=s', => \$jobs,
	    'k|link' => \$link,
            'clone' => \$clone,
            'data-checksums!' => \$data_checksums,
            'keep-port' => \$keep_port,
            'rename=s' => \$newcluster,
            'old-bindir=s' => \$old_bindir,
            'maintenance-db=s' => \$maintenance_db,
            'start!' => \$start,
            'keep-on-error' => \$keep_on_error,
    ) or exit 1;

if ($method eq 'dump') {
    error 'cannot use --link with --method=dump' if ($link);
    error 'cannot use --clone with --method=dump' if ($clone);
} elsif ($method eq 'link') {
    $method = 'upgrade';
    $link = 1;
} elsif ($method eq 'clone') {
    $method = 'upgrade';
    $clone = 1;
} elsif ($method ne 'upgrade') {
    error 'method must be "dump", "upgrade", "link", or "clone"';
}
if (defined $data_checksums and $method ne 'dump') {
    error "can only use --(no-)data-checksums with --method=dump";
}

# untaint
($newversion) = $newversion =~ /^(\d+\.?\d+)$/;
($locale) = $locale =~ /^([\w@._-]+)$/ if $locale;
($lc_collate) = $lc_collate =~ /^([\w@._-]+)$/ if $lc_collate;
($lc_ctype) = $lc_ctype =~ /^([\w@._-]+)$/ if $lc_ctype;
($lc_messages) = $lc_messages =~ /^([\w@._-]+)$/ if $lc_messages;
($lc_monetary) = $lc_monetary =~ /^([\w@._-]+)$/ if $lc_monetary;
($lc_numeric) = $lc_numeric =~ /^([\w@._-]+)$/ if $lc_numeric;
($lc_time) = $lc_time =~ /^([\w@._-]+)$/ if $lc_time;
($logfile) = $logfile =~ /^([^\n]+)$/ if $logfile;
($old_bindir) = $old_bindir =~ /^(\/.*)$/ if $old_bindir;
($maintenance_db) = $maintenance_db =~ /^([\w-]+)$/ if $maintenance_db;
if ($jobs) {
    ($jobs) = $jobs =~ /^(\d+)$/;
    $ENV{PGJOBS} = $jobs; # make setting available to upgrade hooks
}

if ($#ARGV < 1) {
    print "Usage: $0 [OPTIONS] <old version> <cluster name> [<new data directory>]\n";
    exit 1;
}

($version) = $ARGV[0] =~ /^(\d+\.?\d+)$/;
($cluster) = $ARGV[1] =~ /^([-.\w]+)$/;
$newcluster ||= $cluster; # use old cluster name by default
($newcluster) = $newcluster =~ /^([-.\w]+)$/;
my $datadir;
($datadir) = $ARGV[2] =~ /(.*)/ if defined $ARGV[2];

error 'specified cluster does not exist' unless cluster_exists $version, $cluster;
%info = cluster_info ($version, $cluster);
validate_cluster_owner \%info;
error 'cluster is disabled' if $info{'start'} eq 'disabled';

error "cluster $version/$cluster is already on version $newversion. " .
    "(The newest version installed on this system is $newest_version.)"
    if ($version eq $newversion and $cluster eq $newcluster);

if (cluster_exists $newversion, $newcluster) {
    error "target cluster $newversion/$newcluster already exists";
}

if (not pre_upgrade_check($version, $newversion, $force_packages)) {
    error "pg_upgradecluster pre-upgrade checks failed";
}

if ($check_only) {
    print "pg_upgradecluster pre-upgrade checks ok\n";
    exit;
}

print "Upgrading cluster $version/$cluster to $newversion/$newcluster ...\n";

my $oldcontrol = get_cluster_controldata ($version, $cluster);

my $oldsocket = get_cluster_socketdir $version, $cluster;
my $owner = getpwuid $info{'owneruid'};
error 'could not get name of cluster owner' unless $owner;
my $temp_hba_conf = temp_hba_conf $version, $cluster, $owner, $info{'owneruid'};

# stop old cluster
if ($info{'running'}) {
    get_encoding $version, $cluster;
    print "Stopping old cluster...\n";
    my @argv = ('pg_ctlcluster', $version, $cluster, 'stop');
    error "Could not stop old cluster" if system @argv;
}

if ($method eq 'dump' or ($method eq 'upgrade' and not $info{'running'})) {
    print "Restarting old cluster with restricted connections...\n";
    my @argv = ('pg_ctlcluster',
        ($old_bindir ? ("--bindir=$old_bindir") : ()),
        $version, $cluster, 'start', '-o', "-c hba_file=$temp_hba_conf");
    error "Could not restart old cluster" if system @argv;

    get_encoding $version, $cluster unless ($encoding); # if the cluster was not running before, get encoding now

    if ($method eq 'upgrade') {
	print "Stopping old cluster...\n";
        @argv = ('pg_ctlcluster', $version, $cluster, 'stop');
	error "Could not stop old cluster" if system @argv;
    }
}

# in dump mode, old cluster is running now
# in upgrade mode, old cluster is stopped

my $upgrade_port = next_free_port;

# create new cluster, preserving encoding and locales
my @argv = ('pg_createcluster', '-u', $info{'owneruid'}, '-g', $info{'ownergid'},
    '--socketdir', $info{'socketdir'}, '--port', $upgrade_port, '--no-status',
    $newversion, $newcluster);
push @argv, ('--datadir', $datadir) if $datadir;
push @argv, ('--logfile', $logfile) if $logfile;
push @argv, ('--encoding', $encoding) unless $locale or $lc_ctype;
$lc_ctype ||= $locale || $old_lc_ctype;
$lc_collate ||= $locale || $old_lc_collate;
push @argv, ('--locale', $locale) if $locale;
push @argv, ('--lc-collate', $lc_collate) if $lc_collate;
push @argv, ('--lc-ctype', $lc_ctype) if $lc_ctype;
push @argv, ('--lc-messages', $lc_messages) if $lc_messages;
push @argv, ('--lc-monetary', $lc_monetary) if $lc_monetary;
push @argv, ('--lc-numeric', $lc_numeric) if $lc_numeric;
push @argv, ('--lc-time', $lc_time) if $lc_time;
push @argv, ('--');
push @argv, ('--locale-provider', $old_locale_provider) if $old_locale_provider;
push @argv, ('--icu-locale', $old_icu_locale) if $old_icu_locale;
push @argv, ('--icu-rules', $old_icu_rules) if $old_icu_rules;
if ($oldcontrol->{'Data page checksum version'} or (defined $data_checksums and $data_checksums == 1)) { # oldcontrol 0 = off
    # enable data checksums if the old cluster had them
    push @argv, ('--data-checksums');
} else {
    if ($newversion >= 18 and ($method eq 'upgrade' or (defined $data_checksums and $data_checksums == 0))) {
        # disable data checksums when they would be enabled by default (18+), but the method uses doesn't allow transitioning
        push @argv, ('--no-data-checksums');
    }
}
push @argv, ('--encryption-key-command', $info{config}->{encryption_key_command}) if $info{config}->{encryption_key_command}; # PostgreSQL TDE

# call pg_createcluster
delete $ENV{'LC_ALL'};
error "Could not create target cluster" if system @argv;
print "\n";

# migrate config files to new cluster before running upgrade
%newinfo = cluster_info($newversion, $newcluster);
migrate_config_files();
set_cluster_port $newversion, $newcluster, $upgrade_port; # use free port during upgrade
%newinfo = cluster_info($newversion, $newcluster); # re-read info after migrate_config_files

if ($method eq 'dump') {
    print "Starting new cluster...\n";
    @argv = ('pg_ctlcluster', $newversion, $newcluster, 'start', '-o', "-c hba_file=$temp_hba_conf");
    error "Could not start target cluster" if system @argv;
}

# check whether upgrade scripts exist
my $upgrade_scripts = (-d "$PgCommon::common_confdir/pg_upgradecluster.d" &&
     ($PgCommon::rpm ? `ls $PgCommon::common_confdir/pg_upgradecluster.d` :
         `run-parts --test $PgCommon::common_confdir/pg_upgradecluster.d`));

# Run upgrade scripts in init phase
run_upgrade_scripts('init') if ($upgrade_scripts);
print "\n";

# dump cluster; drop to cluster owner privileges

if (!fork) {
    change_ugid $info{'owneruid'}, $info{'ownergid'};
    my $pg_dumpall = get_program_path 'pg_dumpall', $newversion;
    my $psql = get_program_path 'psql';
    my $newsocket = get_cluster_socketdir $newversion, $newcluster;

    # ensure we can upgrade DBs with default read-only transactions
    $ENV{PGOPTIONS} .= " -cdefault_transaction_read_only=off";

    if ($method eq 'dump') {
	# get list of read-only databases
        open F, '-|', $psql, '-h', $oldsocket, '-p', $info{'port'}, '-d', $maintenance_db, '-AXtc',
            "SELECT datname FROM pg_database WHERE NOT datallowconn AND datname <> 'template0'" or
	    error 'Could not get pg_database list';
        my $ro_databases = <F>;
	close F;
        error "some databases are not accepting connections, cannot upgrade cluster:\n$ro_databases" if ($ro_databases);

	# Upgrade databases
        print "Upgrading databases ...\n";
        my @argv = (
            '/usr/share/postgresql-common/pg_dumpcluster',
            -A => $pg_dumpall, -h => $oldsocket, -p => $info{port},
            -Q => $psql, -H => $newsocket, -P => $newinfo{port},
            -U => $owner);
        print "@argv\n";
        my $status = system @argv;
        exit 1 if ($status != 0);

    } else {
	# pg_upgrade

	use File::Temp qw(tempdir);

	my $pg_upgrade = get_program_path 'pg_upgrade', $newversion;
        $pg_upgrade or error "pg_upgrade $newversion not found";
	my @argv = ($pg_upgrade,
		 '-b', ($old_bindir || "$PgCommon::binroot$version/bin"),
		 '-B', "$PgCommon::binroot$newversion/bin",
		 '-p', $info{'port'},
		 '-P', $newinfo{'port'},
	    );
        if ($version <= 9.1) {
            push @argv, '-d', $info{pgdata}, '-o', "-D $info{configdir}"; # -o and -D configdir require $newversion >= 9.2
        } else {
            push @argv, '-d', $info{configdir};
        }
        push @argv, '-D', $newinfo{configdir};
	push @argv, "--link" if $link;
	push @argv, "--clone" if $clone;
	push @argv, '-j', $jobs if $jobs;

        # Make a directory for pg_upgrade to store its reports and log files.
	my $logdir = tempdir("/var/log/postgresql/pg_upgradecluster-$version-$newversion-$newcluster.XXXX");
	chdir $logdir;

	# Run pg_upgrade.
        print "@argv\n";
	my $status = system @argv;

	# Remove the PID file of the old cluster (normally removed by
	# pg_ctlcluster, but not by pg_upgrade).
	unlink "/var/run/postgresql/$version-$cluster.pid";

	# Move output files to our log directory
	if (-d (my $outdir =  "$newinfo{pgdata}/pg_upgrade_output.d")) {
	    system mv => $outdir, $logdir
		and error "Could not move $outdir to $logdir";
        }
        rmdir $logdir; # remove it if it's empty
        print "pg_upgradecluster: pg_upgrade output scripts are in $logdir\n" if (-d $logdir);

        exit 1 if ($status != 0);
    }

    exit 0;
}

wait;

if ($?) {
    print "\n";

    unless ($keep_on_error) {
        print STDERR "Error during cluster dumping, removing new cluster\n";
        system 'pg_dropcluster', '--stop', $newversion, $newcluster;
    }

    # Restart old cluster (two steps because we started without systemd)
    system 'pg_ctlcluster', $version, $cluster, 'stop'; # ignore errors, it might be down anyway
    if ($info{running}) {
        print "Starting old cluster again ...\n";
        if (system 'pg_ctlcluster', $version, $cluster, 'start') {
            error 'could not start old cluster, please do that manually';
        }
    }
    exit 1;
}

if ($method eq 'dump') {
    print "Stopping target cluster...\n";
    @argv = ('pg_ctlcluster', $newversion, $newcluster, 'stop');
    error "Could not stop target cluster" if system @argv;

    print "Stopping old cluster...\n";
    @argv = ('pg_ctlcluster', $version, $cluster, 'stop');
    error "Could not stop old cluster" if system @argv;
}

print "Disabling automatic startup of old cluster...\n";
my $startconf = $info{'configdir'}.'/start.conf';
if (open F, ">$startconf") {
    print F "# This cluster was upgraded to a newer major version. The old
# cluster has been preserved for backup purposes, but is not started
# automatically.

manual
";
    close F;
} else {
    error "could not create $startconf: $!";
}

my $free_port = next_free_port;
unless ($keep_port) {
    set_cluster_port $version, $cluster, $upgrade_port;
    set_cluster_port $newversion, $newcluster, $info{port};
    $newinfo{port} = $info{port};
}

# notify systemd that we modified the old start.conf
if (not exists $ENV{'PG_CLUSTER_CONF_ROOT'} and -d '/run/systemd/system' and $> == 0) {
    system 'systemctl daemon-reload';
}

# start cluster if it was running before, or upgrade scripts are present
$start = ($info{running} or $upgrade_scripts) if ($start == -1);
if ($start) {
    print "Starting upgraded cluster on port $newinfo{port}...\n";
    @argv = ('pg_ctlcluster', $newversion, $newcluster, 'start');
    error "Could not start upgraded cluster; please check configuration and log files" if system @argv;
}

# Run upgrade scripts in finish phase
if ($upgrade_scripts) {
    if ($start) {
        run_upgrade_scripts('finish');
    } else {
        print "Warning: Skipping upgrade scripts because --no-start was given\n";
    }
}

print "\nSuccess. Please check that the upgraded cluster works. If it does,
you can remove the old cluster with
    pg_dropcluster $version $cluster\n\n";

system 'pg_lsclusters', $version, $cluster;
system 'pg_lsclusters', $newversion, $newcluster;

__END__

=head1 NAME

pg_upgradecluster - upgrade an existing PostgreSQL cluster to a new major version.

=head1 SYNOPSIS

B<pg_upgradecluster> [B<-v> I<newversion>] I<oldversion> I<name> [I<newdatadir>]

=head1 DESCRIPTION

B<pg_upgradecluster> upgrades an existing PostgreSQL server cluster (i. e. a
collection of databases served by a B<postgres> instance) to a new version
specified by I<newversion> (default: latest available version).  The
configuration files of the old version are copied to the new cluster and
adjusted for the new version.

By default, L<pg_dump(1)> is used to migrate data and indexes to the new
cluster. This is slow, but safe. Upgrade variants based on L<pg_upgrade(1)> can
be selected using the B<--method=upgrade> parameter. This is faster, but care
must be taken when using it in the context of an operating system upgrade. The
sorting order ("collation") used in indexes is determined by B<libc> and
B<libicu>, and new versions of these libraries might have a differ ordering,
B<requiring index rebuilds after the upgrade>, or acknowledging that the
ordering did not change using the B<ALTER COLLATION REFRESH VERSION> command.
This step is not automated by B<pg_upgradecluster>.

The cluster of the old version will be configured to use a previously unused
port since the upgraded one will use the original port. The old cluster is not
automatically removed. After upgrading, please verify that the new cluster
indeed works as expected; if so, you should remove the old cluster with
L<pg_dropcluster(8)>. Please note that the old cluster is set to "manual"
startup mode, in order to avoid inadvertently changing it; this means that it
will not be started automatically on system boot, and you have to use
L<pg_ctlcluster(8)> to start/stop it. See section "STARTUP CONTROL" in
L<pg_createcluster(8)> for details.

The I<newdatadir> argument can be used to specify a non-default data directory
of the upgraded cluster. It is passed to B<pg_createcluster>. If not specified,
this defaults to /var/lib/postgresql/I<newversion>/I<name>.

=head1 OPTIONS

=over 4

=item B<-v> I<newversion>

Set the version to upgrade to (default: latest available).

=item B<--check>

Check if all packages required for the upgrade are installed.

=item B<--force-packages>

Proceed with upgrading even when not all packages from the old PostgreSQL
version are installed for the new version as well.

=item B<--logfile> I<filel>

Set a custom log file path for the upgraded database cluster.

=item B<--locale=>I<locale>

Set the default locale for the upgraded database cluster. If this option is not
specified, the locale is inherited from the old cluster.

When upgrading to PostgreSQL 11 or newer, this option no longer allows
switching the encoding of individual databases. (L<pg_dumpall(1)> was changed to
retain database encodings.)

=item B<--lc-collate=>I<locale>

=item B<--lc-ctype=>I<locale>

=item B<--lc-messages=>I<locale>

=item B<--lc-monetary=>I<locale>

=item B<--lc-numeric=>I<locale>

=item B<--lc-time=>I<locale>

Like B<--locale>, but only sets the locale in the specified category.

=item B<-m>, B<--method=>B<dump>|B<upgrade>|B<link>|B<clone>

Specify the upgrade method.  B<dump> uses L<pg_dumpall(1)>, B<upgrade> uses
L<pg_upgrade(1)>.  The default is B<dump>.

B<link> and B<clone> are shorthands for B<-m upgrade --link> and B<-m upgrade --clone>,
respectively.

=item B<-k>, B<--link>

In pg_upgrade mode, use hard links instead of copying files to the new
cluster.  This option is merely passed on to pg_upgrade.  See
L<pg_upgrade(1)> for details.

=item B<--clone>

In pg_upgrade mode, use efficient file cloning (also known as "reflinks"
on some systems) instead of copying files to the new cluster. This option
is merely passed on to pg_upgrade.  See L<pg_upgrade(1)> for details.

=item B<--data-checksums>, B<--no-data-checksums>

By default, the new cluster is set up to use data page checksums if the old
cluster already uses them. Additionally, when using the B<dump> upgrade method,
the new cluster will use data page checksums when upgrading to PostgreSQL 18 or
later (which enables data page checksums by default).

The B<--method=dump> behavior can explictly be controlled by the
B<--data-checksums> and B<--no-data-checksums> options.

=item B<-j>, B<--jobs>

In pg_upgrade mode, number of simultaneous processes to use. This
option is passed on to pg_upgrade. See L<pg_upgrade(1)> for details.
It is also used by the B<analyze> upgrade hook (via the B<PGJOBS> environment
variable).

=item B<--keep-port>

By default, the old cluster is moved to a new port, and the new cluster is
moved to the original port so clients will see the upgraded cluster. This
option disables that.

=item B<--rename=>I<new cluster name>

Use a different name for the upgraded cluster.

=item B<--old-bindir=>I<directory>

Passed to B<pg_upgrade>.

=item B<--maintenance-db=>I<database>

Database to connect to for maintenance queries.  The default is B<template1>.

=item B<--[no-]start>

Start the new database cluster after upgrading. The default is to start the new
cluster if the old cluster was running, or if upgrade hook scripts are present.

=item B<--keep-on-error>

If upgrading fails, the newly created cluster is removed. This option disables
that.

=back

=head1 HOOK SCRIPTS

Some PostgreSQL extensions like PostGIS need metadata in auxiliary tables which
must not be upgraded from the old version, but rather initialized for the new
version before copying the table data. For this purpose, extensions (as well as
administrators, of course) can drop upgrade hook scripts into 
C</etc/postgresql-common/pg_upgradecluster.d/>. Script file names must consist
entirely of upper and lower case letters, digits, underscores, and hyphens; in
particular, dots (i. e. file extensions) are not allowed.

Scripts in that directory will be called with the following arguments:

<old version> <cluster name> <new version> <phase>

Phases:

=over

=item B<init>

A virgin cluster of version I<new version> has been created, i. e.  this new
cluster will already have B<template1> and B<postgres>, but no user databases. Please note that
you should not create tables in this phase, since they will be overwritten by
the dump/restore or B<pg_upgrade> operation.

=item B<finish>

All data from the old version cluster has been restored into the new
one. The old cluster still exists, but is not running.

=back

Failing scripts will abort the upgrade.
The scripts are called as the user who owns the database.

=head1 SEE ALSO

L<pg_createcluster(8)>, L<pg_dropcluster(8)>, L<pg_lsclusters(1)>, L<pg_wrapper(1)>,
L<pg_dumpall(1)>, L<pg_upgrade(1)>

=head1 AUTHORS

Martin Pitt L<E<lt>mpitt@debian.orgE<gt>>, Christoph Berg L<E<lt>myon@debian.orgE<gt>>