git.8kb.co.uk Git - postgresql/pg_upgrade_conf/blob - pg_upgrade_conf.pl

   1 #!/usr/bin/perl
   2
   3 # Script: pg_upgrade_conf.pl
   4 # Copyright: 28/12/2014: Glyn Astill <glyn@8kb.co.uk>
   5 # Requires: Perl 5.10.1+
   6 #
   7 # This script is a command-line utility to transplant PostgreSQL
   8 # server settings from one conf file or server to another.
   9 # Primarily intended for copying current settings in postgresql.conf
  10 # into the default copy provided by a newer version to maintain
  11 # information regarding new settings and defaults.
  12 #
  13 # This script is free software: you can redistribute it and/or modify
  14 # it under the terms of the GNU General Public License as published by
  15 # the Free Software Foundation, either version 3 of the License, or
  16 # (at your option) any later version.
  17 #
  18 # This script is distributed in the hope that it will be useful,
  19 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  21 # GNU General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this script. If not, see <http://www.gnu.org/licenses/>.
  25
  26 use strict;
  27 use warnings;
  28 use DBI;
  29 use v5.10.1;
  30 use File::Copy;
  31 use Getopt::Long qw/GetOptions/;
  32 Getopt::Long::Configure qw/no_ignore_case/;
  33
  34 use constant false => 0;
  35 use constant true => 1;
  36
  37 my $g_debug = false;
  38 my %g_gucs;
  39 my %g_gucs_src;
  40 my $g_non_default_count = 0;
  41 my $g_change_count = 0;
  42 my $g_usage = 'pg_upgrade_conf.pl { -f <path> [ -a <path> ] | -c <conninfo> } { -F <path> | -C <conninfo> }
  43
  44 -f --old_file           Path to the old configuration file to read settings from
  45 -a --old_auto_file      Path to the old auto configuration file to read settings set vial ALTER SYSTEM from
  46 -c --old_conninfo       Conninfo of the old server to read settings from
  47 -F --new_file           Path to the new configuration file to alter
  48 -C --new_conninfo       Conninfo of the new server to apply settings via ALTER SYSTEM';
  49
  50
  51 use vars qw{%opt};
  52 die $g_usage unless GetOptions(\%opt, 'old_file|f=s', 'old_auto_file|a=s', 'new_file|F=s', 'old_conninfo|c=s', 'new_conninfo|C=s')
  53     and keys %opt and ! @ARGV;
  54
  55 if (defined($opt{old_file})) {
  56     loadSourceFromFile($opt{old_file});
  57     if (defined($opt{old_auto_file})) {
  58         loadSourceFromFile($opt{old_auto_file});
  59     }
  60 }
  61 elsif (defined($opt{old_conninfo})) {
  62     loadSourceFromConninfo($opt{old_conninfo});
  63 }
  64
  65 print "Found $g_non_default_count non-default settings in old configuration\n";
  66
  67 if (defined($opt{new_file})) {
  68     $g_change_count = modifyNewFile($opt{new_file});
  69 }
  70 elsif (defined($opt{new_conninfo})) {
  71     $g_change_count = modifyNewConninfo($opt{new_conninfo});
  72     if ($g_change_count > 0) {
  73         print "WARNING: $g_change_count changes made to postgresql.auto.conf using ALTER SYSTEM; these will override any values set in postgresql.conf\n";
  74     }
  75 }
  76
  77 print "Made $g_change_count changes to new configuration\n";
  78
  79 sub loadSourceFromFile {
  80     my $old_file = shift;
  81     my $key;
  82     my $value;
  83     my $src;
  84     my @fields;
  85
  86     if (open(OLDFILE, "<", $old_file)) {
  87         foreach (<OLDFILE>) {
  88             chomp $_;
  89             unless ($_ =~ /^#/) {
  90                 for ($_) {
  91                     s/\r//;
  92                     s/#(?=(?:(?:[^']|[^"]*+'){2})*+[^']|[^"]*+\z).*//;
  93                 }
  94                 if (length(trim($_))) {
  95                     @fields = split('=', $_, 2);
  96                     $key = trim($fields[0]);
  97                     $value = trim($fields[1]);
  98                     $src = $old_file;
  99                     if ($g_debug) {
 100                         print "DEBUG: Source file key = $key value = $value src = $src\n";
 101                     }
 102                     if (exists($g_gucs{$key})) {
 103                         print "WARNING: Source value for $key specified more than once, overwriting $g_gucs{$key} from $g_gucs_src{$key} with $value from $src\n";
 104                     }
 105                     else {
 106                         $g_non_default_count++;
 107                     }
 108                     $g_gucs{$key} = $value;
 109                     $g_gucs_src{$key} = $src;
 110                 }
 111             }
 112         }
 113         close (OLDFILE);
 114     }
 115     else {
 116         print "ERROR: Unable to open $old_file for reading\n";
 117     }
 118 }
 119
 120 sub loadSourceFromConninfo {
 121     my $old_conninfo = shift;
 122
 123     my $key;
 124     my $value;
 125     my $src;
 126     my @fields;
 127
 128     my $dsn;
 129     my $dbh;
 130     my $sth;
 131     my $query;
 132
 133     $dsn = "DBI:Pg:$old_conninfo;";
 134     eval {
 135         $dbh = DBI->connect($dsn, '', '', {RaiseError => 1});
 136         $query = "SELECT name, CASE vartype WHEN 'string' THEN quote_literal(reset_val) ELSE reset_val END, sourcefile
 137                     FROM pg_catalog.pg_settings WHERE boot_val <> reset_val AND source = 'configuration file'
 138                     AND context <> 'internal'";
 139         $sth = $dbh->prepare($query);
 140         $sth->execute();
 141         while (my @fields = $sth->fetchrow) {
 142             $key = trim($fields[0]);
 143             $value = trim($fields[1]);
 144             $src = trim($fields[2]);
 145             if ($g_debug) {
 146                 print "DEBUG: Source setting key = $key value = $value src = $src\n";
 147             }
 148             $g_gucs{$key} = $value;
 149             $g_gucs_src{$key} = $src;
 150             $g_non_default_count++;
 151         }
 152         $sth->finish;
 153     };
 154     if ($@) {
 155         print "ERROR: $@\n";
 156     }
 157 }
 158
 159 sub modifyNewFile {
 160     my $new_file = shift;
 161     my $key;
 162     my $value;
 163     my @lines;
 164     my @fields;
 165     my $pushed;
 166     my $comment;
 167     my $setting = 0;
 168     my $change_count = 0;
 169     my $not_written = false;
 170
 171     if (open(NEWFILE, "<", $new_file)) {
 172         foreach (<NEWFILE>) {
 173             chomp $_;
 174             $pushed = false;
 175             $comment = true;
 176             if ($_ =~ /=/) {
 177                 @fields = split('=', $_, 2);
 178                 $key = $fields[0];
 179                 $key =~ s/^#(.*)$/$1/;
 180                 $key = trim($key);
 181                 $value = trim($fields[1]);
 182                 for ($value) {
 183                     s/\r//;
 184                     s/#(?=(?:(?:[^']|[^"]*+'){2})*+[^']|[^"]*+\z).*//;
 185                 }
 186                 $value = trim($value);
 187                 if ($g_debug) {
 188                     print "DEBUG: Target file key = $key value = $value\n";
 189                 }
 190                 if (exists($g_gucs{$key})) {
 191                     if (($_ !~ /^#/) && ($value eq $g_gucs{$key})) {
 192                             $setting++;
 193                             # Setting is already present and not commented out/default
 194                             print "$setting) Not setting $key : already the values are already the same $value = $g_gucs{$key}\n";
 195                             $g_gucs{$key} = '[written]';
 196                     }
 197                     else {
 198                         if ($_ !~ /^#/) {
 199                             $_ = '#' . $_;
 200                             $comment = false;
 201                         }
 202                         push(@lines, $_);
 203                         $pushed = true;
 204                         if ($g_gucs{$key} ne '[written]') {
 205                             $setting++;
 206                             print "$setting) Setting $key to $g_gucs{$key} : was " . (($comment)?"commented out / set to default":"set to") . " $value\n";
 207                             push(@lines, $key . ' = ' . $g_gucs{$key});
 208                             $g_gucs{$key} = '[written]';
 209                             $change_count++;
 210                         }
 211                     }
 212                 }
 213             }
 214             unless ($pushed) {
 215                     push(@lines, $_);
 216             }
 217         }
 218         close(NEWFILE);
 219
 220
 221         foreach $key (keys %g_gucs) {
 222             if ($g_gucs{$key} ne '[written]') {
 223                 $not_written = true;
 224                 last;
 225             }
 226         }
 227
 228         if ($not_written) {
 229             push(@lines, '');
 230             push(@lines, '#' . '-'x78);
 231             push(@lines, '# Unmatched settings written by pg_upgrade_conf.pl');
 232             push(@lines, '#' . '-'x78);
 233             foreach $key (keys %g_gucs) {
 234                 if ($g_gucs{$key} ne '[written]') {
 235                     $setting++;
 236                     print "$setting) No place holder for setting $key : adding $key = $g_gucs{$key}\n";
 237                     push(@lines, $key . ' = ' . $g_gucs{$key});
 238                 }
 239             }
 240         }
 241
 242         copy($new_file, $new_file . '.bak');
 243
 244         if (open(NEWFILE, ">", $new_file)) {
 245             foreach (@lines) {
 246                 if ($g_debug) {
 247                     print "DEBUG: Line = $_\n";
 248                 }
 249                 print NEWFILE "$_\n";
 250             }
 251             close(NEWFILE);
 252         }
 253         else {
 254             print "ERROR: Unable to open $new_file for writing\n";
 255         }
 256     }
 257     else {
 258         print "ERROR: Unable to open $new_file for reading\n";
 259     }
 260     return $change_count;
 261 }
 262
 263 sub modifyNewConninfo {
 264     my $new_conninfo = shift;
 265     my $version;
 266     my $key;
 267     my $value;
 268
 269     my $setting = 0;
 270     my $change_count = 0;
 271     my $dsn;
 272     my $dbh;
 273     my $sth;
 274     my $query;
 275
 276     $dsn = "DBI:Pg:$new_conninfo;";
 277     eval {
 278         $dbh = DBI->connect($dsn, '', '', {RaiseError => 1});
 279         $query = "SHOW server_version";
 280         $sth = $dbh->prepare($query);
 281         $sth->execute();
 282         $version = $sth->fetchrow;
 283
 284         unless (substr($version,0,3) >= 9.4) {
 285             die "PostgreSQL server version 9.4 or later required to apply changes with ALTER SYSTEM\n";
 286         }
 287
 288         foreach $key (keys %g_gucs) {
 289             $setting++;
 290             $query = "SELECT CASE vartype WHEN 'string' THEN quote_literal(reset_val) ELSE reset_val END
 291                     FROM pg_catalog.pg_settings WHERE lower(name) = lower(?)";
 292             $sth = $dbh->prepare($query);
 293             $sth->bind_param(1, $key);
 294             $sth->execute();
 295             $value = $sth->fetchrow;
 296             if ($g_debug) {
 297                 print "$setting) KEY: $key SVAL: $value VAL: $g_gucs{$key}\n";
 298             }
 299             if ($value eq $g_gucs{$key}) {
 300                 print "$setting) Not setting $key : already the values are already the same $value = $g_gucs{$key}\n";
 301             }
 302             else {
 303                 print "$setting) Setting $key to $g_gucs{$key} : was set to $value\n";
 304                 $query = "ALTER SYSTEM SET " . qtrim($key) . " TO ?";
 305                 $sth = $dbh->prepare($query);
 306                 $sth->bind_param(1, qtrim($g_gucs{$key}));
 307                 $sth->execute();
 308                 $change_count++;
 309             }
 310         }
 311
 312         $sth->finish();
 313     };
 314     if ($@) {
 315         print "ERROR: $@\n";
 316     }
 317     return $change_count;
 318 }
 319
 320 sub trim {
 321     my $string = shift;
 322     $string =~ s/^\s+//;
 323     $string =~ s/\s+$//;
 324     return $string;
 325 }
 326
 327 sub qtrim {
 328     my $string = shift;
 329     $string =~ s/^('|")+//;
 330     $string =~ s/('|")+$//;
 331     return $string;
 332 }