git.gag.com Git - debian/amanda/blob - application-src/ampgsql.pl

   1 #!@PERL@
   2 # Copyright (c) 2009-2012 Zmanda, Inc.  All Rights Reserved.
   3 #
   4 # This program is free software; you can redistribute it and/or
   5 # modify it under the terms of the GNU General Public License
   6 # as published by the Free Software Foundation; either version 2
   7 # of the License, or (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful, but
  10 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  11 # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  12 # for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License along
  15 # with this program; if not, write to the Free Software Foundation, Inc.,
  16 # 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  17 #
  18 # Contact information: Zmanda Inc., 465 S. Mathilda Ave., Suite 300
  19 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  20
  21 use lib '@amperldir@';
  22 use strict;
  23 use warnings;
  24 use Getopt::Long;
  25
  26 package Amanda::Application::ampgsql;
  27 use base qw(Amanda::Application);
  28 use Carp;
  29 use File::Copy;
  30 use File::Path;
  31 use IO::Dir;
  32 use IO::File;
  33 use IPC::Open3;
  34 use POSIX;
  35 use POSIX qw( ceil );
  36 use Sys::Hostname;
  37 use Symbol;
  38 use Amanda::Constants;
  39 use Amanda::Config qw( :init :getconf  config_dir_relative string_to_boolean );
  40 use Amanda::Debug qw( :logging );
  41 use Amanda::Paths;
  42 use Amanda::Util qw( :constants :encoding quote_string );
  43 use Amanda::MainLoop qw( :GIOCondition );
  44
  45 my $_DATA_DIR_TAR = "data_dir.tar";
  46 my $_ARCHIVE_DIR_TAR = "archive_dir.tar";
  47 my $_WAL_FILE_PAT = qr/\w{24}/;
  48
  49 my $_DATA_DIR_RESTORE = "data";
  50 my $_ARCHIVE_DIR_RESTORE = "archive";
  51
  52 sub new {
  53     my $class = shift @_;
  54     my $args = shift @_;
  55     my $self = $class->SUPER::new($args->{'config'});
  56     $self->{'args'} = $args;
  57     $self->{'label-prefix'} = 'amanda';
  58     $self->{'runtar'}  = "$Amanda::Paths::amlibexecdir/runtar";
  59
  60     # default arguments (application properties)
  61     $self->{'args'}->{'statedir'} ||= $Amanda::Paths::GNUTAR_LISTED_INCREMENTAL_DIR;
  62     $self->{'args'}->{'tmpdir'} ||= $AMANDA_TMPDIR;
  63     # XXX: when using runtar, this is not actually honored.
  64     # So, this only works for restore at the moment
  65     $self->{'args'}->{'gnutar-path'} ||= $Amanda::Constants::GNUTAR;
  66
  67     if (!defined $self->{'args'}->{'disk'}) {
  68         $self->{'args'}->{'disk'} = $self->{'args'}->{'device'};
  69     }
  70     if (!defined $self->{'args'}->{'device'}) {
  71         $self->{'args'}->{'device'} = $self->{'args'}->{'disk'};
  72     }
  73     # default properties
  74     $self->{'props'} = {
  75         'pg-db' => 'template1',
  76         'pg-cleanupwal' => 'yes',
  77         'pg-max-wal-wait' => 60,
  78     };
  79
  80     my @PROP_NAMES = qw(pg-host pg-port pg-db pg-user pg-password pg-passfile
  81                         psql-path pg-datadir pg-archivedir pg-cleanupwal
  82                         pg-max-wal-wait);
  83
  84     # config is loaded by Amanda::Application (and Amanda::Script_App)
  85     my $conf_props = getconf($CNF_PROPERTY);
  86     # check for properties like 'pg-host'
  87     foreach my $pname (@PROP_NAMES) {
  88         if ($conf_props->{$pname}) {
  89             debug("More than one value for $pname. Using the first.")
  90                 if scalar(@{$conf_props->{$pname}->{'values'}}) > 1;
  91             $self->{'props'}->{$pname} = $conf_props->{$pname}->{'values'}->[0];
  92         }
  93     }
  94
  95     # check for properties like 'foo-pg-host' where the diskname is 'foo'
  96     if ($self->{'args'}->{'disk'}) {
  97         foreach my $pname (@PROP_NAMES) {
  98             my $tmp = "$self->{'args'}->{'disk'}-$pname";
  99             if ($conf_props->{$tmp}) {
 100                 debug("More than one value for $tmp. Using the first.")
 101                     if scalar(@{$conf_props->{$tmp}->{'values'}}) > 1;
 102                 $self->{'props'}->{$pname} = $conf_props->{$tmp}->{'values'}->[0];
 103             }
 104         }
 105     }
 106
 107     # overwrite with dumptype properties if they are set.
 108     foreach my $pname (@PROP_NAMES) {
 109         my $pdumpname = $pname;
 110         $pdumpname =~ s/^pg-//g;
 111         $self->{'props'}->{$pname} = $self->{'args'}->{$pdumpname}
 112                                  if defined $self->{'args'}->{$pdumpname};
 113 debug("prop $pname set from dumpname $pdumpname: $self->{'args'}->{$pdumpname}")
 114 if defined $self->{'args'}->{$pdumpname};
 115     }
 116
 117     unless ($self->{'props'}->{'psql-path'}) {
 118         foreach my $pre (split(/:/, $ENV{PATH})) {
 119             my $psql = "$pre/psql";
 120             if (-x $psql) {
 121                 $self->{'props'}{'psql-path'} = $psql;
 122                 last;
 123             }
 124         }
 125     }
 126
 127     foreach my $aname (keys %{$self->{'args'}}) {
 128         if (defined($self->{'args'}->{$aname})) {
 129             debug("app property: $aname $self->{'args'}->{$aname}");
 130         } else {
 131             debug("app property: $aname (undef)");
 132         }
 133     }
 134
 135     foreach my $pname (keys %{$self->{'props'}}) {
 136         if (defined($self->{'props'}->{$pname})) {
 137             debug("client property: $pname $self->{'props'}->{$pname}");
 138         } else {
 139             debug("client property: $pname (undef)");
 140         }
 141     }
 142
 143     if (!exists $self->{'props'}->{'pg-datadir'}) {
 144         $self->{'props'}->{'pg-datadir'} =  $self->{'args'}->{'device'};
 145     }
 146
 147     return $self;
 148 }
 149
 150 sub command_support {
 151    my $self = shift;
 152
 153    print <<EOF;
 154 CONFIG YES
 155 HOST YES
 156 DISK YES
 157 MAX-LEVEL 9
 158 INDEX-LINE YES
 159 INDEX-XML NO
 160 MESSAGE-LINE YES
 161 MESSAGE-XML NO
 162 RECORD YES
 163 COLLECTION NO
 164 CLIENT-ESTIMATE YES
 165 MULTI-ESTIMATE NO
 166 CALCSIZE NO
 167 EOF
 168 }
 169
 170 sub _check {
 171     my ($desc, $succ_suf, $err_suf, $check, @check_args) = @_;
 172     my $ret = $check->(@check_args);
 173     my $msg = $ret? "OK $desc $succ_suf" :  "ERROR $desc $err_suf";
 174     debug($msg);
 175     print "$msg\n";
 176     $ret;
 177 }
 178
 179 sub _check_parent_dirs {
 180     my ($dir) = @_;
 181     my $ok = 1;
 182     my $is_abs = substr($dir, 0, 1) eq "/";
 183     _check("$dir is an absolute path?", "Yes", "No. It should start with '/'",
 184        sub {$is_abs});
 185
 186     my @parts = split('/', $dir);
 187     pop @parts; # don't test the last part
 188     my $partial_path = '';
 189     for my $path_part (@parts) {
 190         $partial_path .= $path_part . (($partial_path || $is_abs)? '/' : '');
 191         $ok &&=
 192             _check("$partial_path is executable?", "Yes", "No",
 193                sub {-x $_[0]}, $partial_path);
 194         $ok &&=
 195             _check("$partial_path is a directory?", "Yes", "No",
 196                sub {-d $_[0]}, $partial_path);
 197     }
 198     $ok;
 199 }
 200
 201 sub _ok_passfile_perms {
 202     my $passfile = shift @_;
 203     # libpq uses stat, so we use stat
 204     my @fstat = stat($passfile);
 205     return 0 unless @fstat;
 206     return 0 if 077 & $fstat[2];
 207     return -r $passfile;
 208 }
 209
 210 sub _run_psql_command {
 211     my ($self, $cmd) = @_;
 212
 213     # n.b. deprecated, passfile recommended for better security
 214     my $orig_pgpassword = $ENV{'PGPASSWORD'};
 215    $ENV{'PGPASSWORD'} = $self->{'props'}->{'pg-password'} if $self->{'props'}->{'pg-password'};
 216     # n.b. supported in 8.1+
 217     my $orig_pgpassfile = $ENV{'PGPASSFILE'};
 218     $ENV{'PGPASSFILE'} = $self->{'props'}->{'pg-passfile'} if $self->{'props'}->{'pg-passfile'};
 219
 220     my @cmd = ($self->{'props'}->{'psql-path'});
 221     push @cmd, "-X";
 222     push @cmd, "-h", $self->{'props'}->{'pg-host'} if ($self->{'props'}->{'pg-host'});
 223     push @cmd, "-p", $self->{'props'}->{'pg-port'} if ($self->{'props'}->{'pg-port'});
 224     push @cmd, "-U", $self->{'props'}->{'pg-user'} if ($self->{'props'}->{'pg-user'});
 225
 226     push @cmd, '--quiet', '--output', '/dev/null' if (!($cmd =~ /pg_xlogfile_name_offset/));
 227     push @cmd, '--command', $cmd, $self->{'props'}->{'pg-db'};
 228     debug("running " . join(" ", @cmd));
 229
 230     my ($wtr, $rdr);
 231     my $err = Symbol::gensym;
 232     my $pid = open3($wtr, $rdr, $err, @cmd);
 233     close($wtr);
 234
 235     my $file_to_close = 2;
 236     my $psql_stdout_src = Amanda::MainLoop::fd_source($rdr,
 237                                                 $G_IO_IN|$G_IO_HUP|$G_IO_ERR);
 238     my $psql_stderr_src = Amanda::MainLoop::fd_source($err,
 239                                                 $G_IO_IN|$G_IO_HUP|$G_IO_ERR);
 240     $psql_stdout_src->set_callback(sub {
 241         my $line = <$rdr>;
 242         if (!defined $line) {
 243             $file_to_close--;
 244             $psql_stdout_src->remove();
 245             Amanda::MainLoop::quit() if $file_to_close == 0;
 246             return;
 247         }
 248         chomp $line;
 249         return if $line =~ /^\s*$/;
 250         debug("psql stdout: $line");
 251         if ($cmd =~ /pg_xlogfile_name_offset/) {
 252             return if $line =~ /file_name/;
 253             return if $line =~ /------/;
 254             return if $line =~ /\(1 row\)/;
 255             if ($line =~ /^ ($_WAL_FILE_PAT)/) {
 256                 $self->{'switch_xlog_filename'} = $1;
 257                 return;
 258             }
 259         }
 260         if ($line =~ /NOTICE: pg_stop_backup complete, all required WAL segments have been archived/) {
 261         } else {
 262             $self->print_to_server("psql stdout: $line",
 263                                    $Amanda::Script_App::GOOD);
 264         }
 265     });
 266     $psql_stderr_src->set_callback(sub {
 267         my $line = <$err>;
 268         if (!defined $line) {
 269             $file_to_close--;
 270             $psql_stderr_src->remove();
 271             Amanda::MainLoop::quit() if $file_to_close == 0;
 272             return;
 273         }
 274         chomp $line;
 275         debug("psql stderr: $line");
 276         if ($line =~ /NOTICE: pg_stop_backup complete, all required WAL segments have been archived/) {
 277         } elsif ($line =~ /could not connect to server/) {
 278             $self->print_to_server("psql stderr: $line",
 279                                    $Amanda::Script_App::ERROR);
 280         } else {
 281             $self->print_to_server("psql stderr: $line",
 282                                    $Amanda::Script_App::GOOD);
 283         }
 284     });
 285
 286     close($wtr);
 287     Amanda::MainLoop::run();
 288     close($rdr);
 289     close($err);
 290
 291     waitpid $pid, 0;
 292     my $status = $?;
 293
 294     $ENV{'PGPASSWORD'} = $orig_pgpassword || '';
 295     $ENV{'PGPASSFILE'} = $orig_pgpassfile || '';
 296
 297     return 0 == ($status >> 8)
 298 }
 299
 300 sub command_selfcheck {
 301     my $self = shift;
 302
 303    # set up to handle errors correctly
 304    $self->{'die_cb'} = sub {
 305        my ($msg) = @_;
 306        debug("$msg");
 307        print "$msg\n";
 308        exit(1);
 309    };
 310
 311     $self->print_to_server("disk " . quote_string($self->{args}->{disk}));
 312
 313     $self->print_to_server("ampgsql version " . $Amanda::Constants::VERSION,
 314                            $Amanda::Script_App::GOOD);
 315
 316     for my $k (keys %{$self->{'args'}}) {
 317         print "OK application property: $k = $self->{'args'}->{$k}\n";
 318     }
 319
 320     _check("GNUTAR-PATH $self->{'args'}->{'gnutar-path'}",
 321            "is executable", "is NOT executable",
 322            sub {-x $_[0]}, $self->{'args'}->{'gnutar-path'});
 323     _check("GNUTAR-PATH $self->{'args'}->{'gnutar-path'}",
 324            "is not a directory (okay)", "is a directory (it shouldn't be)",
 325            sub {!(-d $_[0])}, $self->{'args'}->{'gnutar-path'});
 326     _check_parent_dirs($self->{'args'}->{'gnutar-path'});
 327
 328     _check("GNUTAR $Amanda::Constants::GNUTAR",
 329            "is executable", "is NOT executable",
 330            sub {-x $_[0]}, $Amanda::Constants::GNUTAR);
 331     _check("GNUTAR $Amanda::Constants::GNUTAR",
 332            "is not a directory (okay)", "is a directory (it shouldn't be)",
 333            sub {!(-d $_[0])}, $Amanda::Constants::GNUTAR);
 334     _check_parent_dirs($Amanda::Constants::GNUTAR);
 335
 336     _check("TMPDIR '$self->{'args'}->{'tmpdir'}'",
 337            "is an acessible directory", "is NOT an acessible directory",
 338            sub {$_[0] && -d $_[0] && -r $_[0] && -w $_[0] && -x $_[0]},
 339            $self->{'args'}->{'tmpdir'});
 340
 341     if (exists $self->{'props'}->{'pg-datadir'}) {
 342         _check("PG-DATADIR property is",
 343                "same as diskdevice", "differrent than diskdevice",
 344                sub { $_[0] eq $_[1] },
 345                $self->{'props'}->{'pg-datadir'}, $self->{'args'}->{'device'});
 346     } else {
 347         $self->{'props'}->{'pg-datadir'} = $self->{'args'}->{'device'};
 348     }
 349
 350     _check("PG-DATADIR property", "is set", "is NOT set",
 351            sub { $_[0] }, $self->{'props'}->{'pg-datadir'});
 352        # note that the backup user need not be able ot read this dir
 353
 354     _check("STATEDIR '$self->{'args'}->{'statedir'}'",
 355            "is an acessible directory", "is NOT an acessible directory",
 356            sub {$_[0] && -d $_[0] && -r $_[0] && -w $_[0] && -x $_[0]},
 357            $self->{'args'}->{'statedir'});
 358     _check_parent_dirs($self->{'args'}->{'statedir'});
 359
 360     if ($self->{'args'}->{'device'}) {
 361         my $try_connect = 1;
 362
 363         for my $k (keys %{$self->{'props'}}) {
 364             print "OK client property: $k = $self->{'props'}->{$k}\n";
 365         }
 366
 367         if (_check("PG-ARCHIVEDIR property", "is set", "is NOT set",
 368                sub { $_[0] }, $self->{'props'}->{'pg-archivedir'})) {
 369             _check("PG-ARCHIVEDIR $self->{'props'}->{'pg-archivedir'}",
 370                    "is a directory", "is NOT a directory",
 371                    sub {-d $_[0]}, $self->{'props'}->{'pg-archivedir'});
 372             _check("PG-ARCHIVEDIR $self->{'props'}->{'pg-archivedir'}",
 373                    "is readable", "is NOT readable",
 374                    sub {-r $_[0]}, $self->{'props'}->{'pg-archivedir'});
 375             _check("PG-ARCHIVEDIR $self->{'props'}->{'pg-archivedir'}",
 376                    "is executable", "is NOT executable",
 377                    sub {-x $_[0]}, $self->{'props'}->{'pg-archivedir'});
 378             _check_parent_dirs($self->{'props'}->{'pg-archivedir'});
 379         }
 380
 381         $try_connect &&=
 382             _check("Are both PG-PASSFILE and PG-PASSWORD set?",
 383                    "No (okay)",
 384                    "Yes. Please set only one or the other",
 385                    sub {!($self->{'props'}->{'pg-passfile'} and
 386                           $self->{'props'}->{'pg-password'})});
 387
 388         if ($self->{'props'}->{'pg-passfile'}) {
 389             $try_connect &&=
 390                 _check("PG-PASSFILE $self->{'props'}->{'pg-passfile'}",
 391                    "has correct permissions", "does not have correct permissions",
 392                    \&_ok_passfile_perms, $self->{'props'}->{'pg-passfile'});
 393             $try_connect &&=
 394                 _check_parent_dirs($self->{'props'}->{'pg-passfile'});
 395         }
 396
 397         if (_check("PSQL-PATH property", "is set", "is NOT set and psql is not in \$PATH",
 398                sub { $_[0] }, $self->{'props'}->{'psql-path'})) {
 399             $try_connect &&=
 400                 _check("PSQL-PATH $self->{'props'}->{'psql-path'}",
 401                        "is executable", "is NOT executable",
 402                        sub {-x $_[0]}, $self->{'props'}->{'psql-path'});
 403             $try_connect &&=
 404                 _check("PSQL-PATH $self->{'props'}->{'psql-path'}",
 405                        "is not a directory (okay)", "is a directory (it shouldn't be)",
 406                        sub {!(-d $_[0])}, $self->{'props'}->{'psql-path'});
 407             $try_connect &&=
 408                 _check_parent_dirs($self->{'props'}->{'psql-path'});
 409         } else {
 410             $try_connect = 0;
 411         }
 412
 413         if ($try_connect) {
 414             my @pv = `$self->{'props'}->{'psql-path'} --version`;
 415             if ($? >> 8 == 0) {
 416                 $pv[0] =~ /^[^0-9]*([0-9.]*)[^0-9]*$/;
 417                 my $pv = $1;
 418                 $self->print_to_server("ampgsql psql-version $pv",
 419                                        $Amanda::Script_App::GOOD);
 420             } else {
 421                 $self->print_to_server(
 422                 "[Can't get " . $self->{'props'}->{'psql-path'} . " version]\n",
 423                 $Amanda::Script_App::ERROR);
 424             }
 425         }
 426
 427         if ($try_connect) {
 428             $try_connect &&=
 429                 _check("Connecting to database server", "succeeded", "failed",
 430                    \&_run_psql_command, $self, '');
 431         }
 432
 433         {
 434             my @gv = `$self->{'args'}->{'gnutar-path'} --version`;
 435             if ($? >> 8 == 0) {
 436                 $gv[0] =~ /^[^0-9]*([0-9.]*)[^0-9]*$/;
 437                 my $gv = $1;
 438                 $self->print_to_server("ampgsql gtar-version $gv",
 439                                        $Amanda::Script_App::GOOD);
 440             } else {
 441                 $self->print_to_server(
 442                 "[Can't get " . $self->{'props'}->{'gnutar-path'} . " version]\n",
 443                 $Amanda::Script_App::ERROR);
 444             }
 445         }
 446     }
 447 }
 448
 449 sub _state_filename {
 450     my ($self, $level) = @_;
 451
 452     my @parts = ("ampgsql", hexencode($self->{'args'}->{'host'}), hexencode($self->{'args'}->{'disk'}), $level);
 453     my $statefile = $self->{'args'}->{'statedir'} . '/'  . join("-", @parts);
 454     debug("statefile: $statefile");
 455     return $statefile;
 456 }
 457
 458 sub _write_state_file {
 459     my ($self, $end_wal) = @_;
 460
 461     my $h = new IO::File(_state_filename($self, $self->{'args'}->{'level'}), "w");
 462     $h or return undef;
 463
 464     debug("writing state file");
 465     $h->print("VERSION: 0\n");
 466     $h->print("LAST WAL FILE: $end_wal\n");
 467     $h->close();
 468     1;
 469 }
 470
 471 sub _get_prev_state {
 472     my $self = shift @_;
 473     my $initial_level = shift;
 474     $initial_level = $self->{'args'}->{'level'} - 1 if !defined $initial_level;
 475
 476     my $end_wal;
 477     for (my $level = $initial_level; $level >= 0; $level--) {
 478         my $fn = _state_filename($self, $level);
 479         debug("reading state file: $fn");
 480         my $h = new IO::File($fn, "r");
 481         next unless $h;
 482         while (my $l = <$h>) {
 483             chomp $l;
 484             debug("  $l");
 485             if ($l =~ /^VERSION: (\d+)/) {
 486                 unless (0 == $1) {
 487                     $end_wal = undef;
 488                     last;
 489                 }
 490             } elsif ($l =~ /^LAST WAL FILE: ($_WAL_FILE_PAT)/) {
 491                 $end_wal = $1;
 492             }
 493         }
 494         $h->close();
 495         last if $end_wal;
 496     }
 497     $end_wal;
 498 }
 499
 500 sub _make_dummy_dir_base {
 501     my ($self) = @_;
 502
 503    my $dummydir = "$self->{'args'}->{'tmpdir'}/ampgsql-dummy-$$";
 504    mkpath("$dummydir/$_ARCHIVE_DIR_RESTORE");
 505
 506    return $dummydir;
 507 }
 508
 509 sub _make_dummy_dir {
 510     my ($self) = @_;
 511
 512    my $dummydir = "$self->{'args'}->{'tmpdir'}/ampgsql-dummy-$$";
 513    mkpath($dummydir);
 514    open(my $fh, ">$dummydir/empty-incremental");
 515    close($fh);
 516
 517    return $dummydir;
 518 }
 519
 520 sub _run_tar_totals {
 521     my ($self, @other_args) = @_;
 522
 523     my @cmd;
 524     @cmd = ($self->{'runtar'}, $self->{'args'}->{'config'},
 525         $Amanda::Constants::GNUTAR, '--create', '--totals', @other_args);
 526     debug("running: " . join(" ", @cmd));
 527
 528     local (*TAR_IN, *TAR_OUT, *TAR_ERR);
 529     open TAR_OUT, ">&", $self->{'out_h'};
 530     my $pid;
 531     eval { $pid = open3(\*TAR_IN, ">&TAR_OUT", \*TAR_ERR, @cmd); 1;} or
 532         $self->{'die_cb'}->("failed to run tar. error was $@");
 533     close(TAR_IN);
 534
 535     # read stderr
 536     my $size;
 537     while (my $l = <TAR_ERR>) {
 538         if ($l =~ /^Total bytes written: (\d+)/) {
 539             $size = $1;
 540         } else {
 541             chomp $l;
 542             $self->print_to_server($l, $Amanda::Script_App::ERROR);
 543             debug("TAR_ERR: $l");
 544         }
 545     }
 546     waitpid($pid, 0);
 547     my $status = POSIX::WEXITSTATUS($?);
 548
 549     close(TAR_ERR);
 550     debug("size of generated tar file: " . (defined($size)? $size : "undef"));
 551     if ($status == 1) {
 552         debug("ignored non-fatal tar exit status of 1");
 553     } elsif ($status) {
 554         $self->{'die_cb'}->("Tar failed (exit status $status)");
 555     }
 556     $size;
 557 }
 558
 559 sub command_estimate {
 560    my $self = shift;
 561
 562    $self->{'out_h'} = new IO::File("/dev/null", "w");
 563    $self->{'out_h'} or die("Could not open /dev/null");
 564    $self->{'index_h'} = new IO::File("/dev/null", "w");
 565    $self->{'index_h'} or die("Could not open /dev/null");
 566
 567    $self->{'done_cb'} = sub {
 568        my $size = shift @_;
 569        debug("done. size $size");
 570        $size = ceil($size/1024);
 571        debug("sending $self->{'args'}->{'level'} $size 1");
 572        print("$self->{'args'}->{'level'} $size 1\n");
 573    };
 574    $self->{'die_cb'} = sub {
 575        my $msg = shift @_;
 576        debug("$msg");
 577        $self->{'done_cb'}->(-1);
 578        die($msg);
 579    };
 580    $self->{'state_cb'} = sub {
 581        # do nothing
 582    };
 583    $self->{'unlink_cb'} = sub {
 584        # do nothing
 585    };
 586
 587    if ($self->{'args'}->{'level'} > 0) {
 588        _incr_backup($self);
 589    } else {
 590        _base_backup($self);
 591    }
 592 }
 593
 594 sub _get_backup_info {
 595     my ($self, $label) = @_;
 596
 597    my ($fname, $bfile, $start_wal, $end_wal);
 598    # wait up to 60s for the .backup file to be copied
 599    for (my $count = 0; $count < 60; $count++) {
 600        my $adir = new IO::Dir($self->{'props'}->{'pg-archivedir'});
 601        $adir or $self->{'die_cb'}->("Could not open archive WAL directory");
 602        while (defined($fname = $adir->read())) {
 603            if ($fname =~ /\.backup$/) {
 604                my $blabel;
 605                # use runtar to read a protected file, then grep the resulting tarfile (yes,
 606                # this works!)
 607                local *TAROUT;
 608                my $conf = $self->{'args'}->{'config'} || 'NOCONFIG';
 609                my $cmd = "$self->{'runtar'} $conf $Amanda::Constants::GNUTAR --create --file - --directory $self->{'props'}->{'pg-archivedir'} $fname | $Amanda::Constants::GNUTAR --file - --extract --to-stdout";
 610                debug("running: $cmd");
 611                open(TAROUT, "$cmd |");
 612                my ($start, $end, $lab);
 613                while (my $l = <TAROUT>) {
 614                    chomp($l);
 615                    if ($l =~ /^START WAL LOCATION:.*?\(file ($_WAL_FILE_PAT)\)$/) {
 616                        $start = $1;
 617                    } elsif($l =~ /^STOP WAL LOCATION:.*?\(file ($_WAL_FILE_PAT)\)$/) {
 618                        $end = $1;
 619                    } elsif ($l =~ /^LABEL: (.*)$/) {
 620                        $lab = $1;
 621                    }
 622                }
 623                close TAROUT;
 624                if ($lab and $lab eq $label) {
 625                    $start_wal = $start;
 626                    $end_wal = $end;
 627                    $bfile = $fname;
 628                    last;
 629                } else {
 630                    debug("logfile had non-matching label");
 631                }
 632            }
 633        }
 634        $adir->close();
 635        if ($start_wal and $end_wal) {
 636            debug("$bfile named WALs $start_wal .. $end_wal");
 637
 638            # try to cleanup a bit, although this may fail and that's ok
 639            my $filename = "$self->{'props'}->{'pg-archivedir'}/$bfile";
 640            if (unlink($filename) == 0) {
 641                debug("Failed to unlink '$filename': $!");
 642                $self->print_to_server("Failed to unlink '$filename': $!",
 643                                       $Amanda::Script_App::ERROR);
 644            }
 645            last;
 646        }
 647        sleep(1);
 648    }
 649
 650    ($start_wal, $end_wal);
 651 }
 652
 653 # return the postgres version as an integer
 654 sub _get_pg_version {
 655     my $self = shift;
 656
 657     local *VERSOUT;
 658
 659     my @cmd = ($self->{'props'}->{'psql-path'});
 660     push @cmd, "-X";
 661     push @cmd, "--version";
 662     my $pid = open3('>&STDIN', \*VERSOUT, '>&STDERR', @cmd)
 663         or $self->{'die_cb'}->("could not open psql to determine version");
 664     my @lines = <VERSOUT>;
 665     waitpid($pid, 0);
 666     $self->{'die_cb'}->("could not run psql to determine version") if (($? >> 8) != 0);
 667
 668     my ($maj, $min, $pat) = ($lines[0] =~ / ([0-9]+)\.([0-9]+)\.([0-9]+)$/);
 669     return $maj * 10000 + $min * 100 + $pat;
 670 }
 671
 672 # create a large table and immediately drop it; this can help to push a WAL file out
 673 sub _write_garbage_to_db {
 674     my $self = shift;
 675
 676     debug("writing garbage to database to force a WAL archive");
 677
 678     # note: lest ye be tempted to add "if exists" to the drop table here, note that
 679     # the clause was not supported in 8.1
 680     _run_psql_command($self, <<EOF) or
 681 CREATE TABLE _ampgsql_garbage AS SELECT * FROM GENERATE_SERIES(1, 500000);
 682 DROP TABLE _ampgsql_garbage;
 683 EOF
 684         $self->{'die_cb'}->("Failed to create or drop table _ampgsql_garbage");
 685 }
 686
 687 # wait up to pg-max-wal-wait seconds for a WAL file to appear
 688 sub _wait_for_wal {
 689     my ($self, $wal) = @_;
 690     my $pg_version = $self->_get_pg_version();
 691
 692     my $archive_dir = $self->{'props'}->{'pg-archivedir'};
 693     my $maxwait = 0+$self->{'props'}->{'pg-max-wal-wait'};
 694
 695     if ($maxwait) {
 696         debug("waiting $maxwait s for WAL $wal to be archived..");
 697     } else {
 698         debug("waiting forever for WAL $wal to be archived..");
 699     }
 700
 701     my $count = 0; # try at least 4 cycles
 702     my $stoptime = time() + $maxwait;
 703     while ($maxwait == 0 || time < $stoptime || $count++ < 4) {
 704         if (-f "$archive_dir/$wal") {
 705             sleep(1);
 706             return;
 707         }
 708
 709         # for versions 8.0 or 8.1, the only way to "force" a WAL archive is to write
 710         # garbage to the database.
 711         if ($pg_version < 80200) {
 712             $self->_write_garbage_to_db();
 713         } else {
 714             sleep(1);
 715         }
 716     }
 717
 718     $self->{'die_cb'}->("WAL file $wal was not archived in $maxwait seconds");
 719 }
 720
 721 sub _base_backup {
 722    my ($self) = @_;
 723
 724    debug("running _base_backup");
 725
 726    my $label = "$self->{'label-prefix'}-" . time();
 727
 728    -d $self->{'props'}->{'pg-archivedir'} or
 729         die("WAL file archive directory does not exist (or is not a directory)");
 730
 731    if ($self->{'action'} eq 'backup') {
 732        _run_psql_command($self, "SELECT pg_start_backup('$label')") or
 733            $self->{'die_cb'}->("Failed to call pg_start_backup");
 734    }
 735
 736    # tar data dir, using symlink to prefix
 737    # XXX: tablespaces and their symlinks?
 738    # See: http://www.postgresql.org/docs/8.0/static/manage-ag-tablespaces.html
 739    my $old_die_cb = $self->{'die_cb'};
 740    $self->{'die_cb'} = sub {
 741        my $msg = shift @_;
 742        if ($self->{'action'} eq 'backup') {
 743            unless(_run_psql_command($self, "SELECT pg_stop_backup()")) {
 744                $msg .= " and failed to call pg_stop_backup";
 745            }
 746        }
 747        $old_die_cb->($msg);
 748    };
 749    my $size = _run_tar_totals($self, '--file', "-",
 750        '--directory', $self->{'props'}->{'pg-datadir'},
 751        '--exclude', 'postmaster.pid',
 752        '--exclude', 'pg_xlog/*', # contains WAL files; will be handled below
 753        '--transform', "s,^,$_DATA_DIR_RESTORE/,S",
 754        ".");
 755    $self->{'die_cb'} = $old_die_cb;
 756
 757    if ($self->{'action'} eq 'backup') {
 758        unless (_run_psql_command($self, "SELECT pg_stop_backup()")) {
 759            $self->{'die_cb'}->("Failed to call pg_stop_backup");
 760        }
 761    }
 762
 763    # determine WAL files and append and create their tar file
 764    my $start_wal;
 765    my $end_wal;
 766
 767    if ($self->{'action'} eq 'backup') {
 768         ($start_wal, $end_wal)  = _get_backup_info($self, $label);
 769         ($start_wal and $end_wal)
 770                 or $self->{'die_cb'}->("A .backup file was never found in the archive "
 771                                     . "dir $self->{'props'}->{'pg-archivedir'}");
 772         $self->_wait_for_wal($end_wal);
 773    } else {
 774         $start_wal = undef;
 775         $end_wal = _get_prev_state($self, 0);
 776    }
 777
 778    # now grab all of the WAL files, *inclusive* of $start_wal
 779    my @wal_files;
 780    my $adir = new IO::Dir($self->{'props'}->{'pg-archivedir'});
 781    while (defined(my $fname = $adir->read())) {
 782        if ($fname =~ /^$_WAL_FILE_PAT$/) {
 783            if (!defined $end_wal ||
 784                (!defined $start_wal and ($fname le $end_wal)) ||
 785                (defined $start_wal and ($fname ge $start_wal) and
 786                 ($fname le $end_wal))) {
 787                push @wal_files, $fname;
 788                debug("will store: $fname");
 789            } elsif (defined $start_wal and $fname lt $start_wal) {
 790                $self->{'unlink_cb'}->("$self->{'props'}->{'pg-archivedir'}/$fname");
 791            }
 792        }
 793    }
 794    $adir->close();
 795
 796    if (@wal_files) {
 797        $size += _run_tar_totals($self, '--file', "-",
 798            '--directory', $self->{'props'}->{'pg-archivedir'},
 799            '--transform', "s,^,$_ARCHIVE_DIR_RESTORE/,S",
 800            @wal_files);
 801    } else {
 802        my $dummydir = $self->_make_dummy_dir_base();
 803        $self->{'done_cb'}->(_run_tar_totals($self, '--file', '-',
 804            '--directory', $dummydir, "$_ARCHIVE_DIR_RESTORE"));
 805        rmtree($dummydir);
 806    }
 807
 808    $self->{'state_cb'}->($self, $end_wal);
 809
 810    $self->{'done_cb'}->($size);
 811 }
 812
 813 sub _incr_backup {
 814    my ($self) = @_;
 815
 816    debug("running _incr_backup");
 817
 818    if ($self->{'action'} eq 'backup') {
 819       _run_psql_command($self, "SELECT file_name from pg_xlogfile_name_offset(pg_switch_xlog())");
 820       if (defined($self->{'switch_xlog_filename'})) {
 821          $self->_wait_for_wal($self->{'switch_xlog_filename'});
 822       }
 823    }
 824
 825    my $end_wal = _get_prev_state($self);
 826    if ($end_wal) {
 827        debug("previously ended at: $end_wal");
 828    } else {
 829        debug("no previous state found!");
 830        return _base_backup(@_);
 831    }
 832
 833    my $adir = new IO::Dir($self->{'props'}->{'pg-archivedir'});
 834    $adir or $self->{'die_cb'}->("Could not open archive WAL directory");
 835    my $max_wal = "";
 836    my ($fname, @wal_files);
 837    while (defined($fname = $adir->read())) {
 838        if (($fname =~ /^$_WAL_FILE_PAT$/) and ($fname gt $end_wal)) {
 839            $max_wal = $fname if $fname gt $max_wal;
 840            push @wal_files, $fname;
 841            debug("will store: $fname");
 842        }
 843    }
 844
 845    $self->{'state_cb'}->($self, $max_wal ? $max_wal : $end_wal);
 846
 847    if (@wal_files) {
 848        $self->{'done_cb'}->(_run_tar_totals($self, '--file', '-',
 849            '--directory', $self->{'props'}->{'pg-archivedir'}, @wal_files));
 850    } else {
 851        my $dummydir = $self->_make_dummy_dir();
 852        $self->{'done_cb'}->(_run_tar_totals($self, '--file', '-',
 853            '--directory', $dummydir, "empty-incremental"));
 854        rmtree($dummydir);
 855    }
 856 }
 857
 858 sub command_backup {
 859    my $self = shift;
 860
 861    $self->{'out_h'} = IO::Handle->new_from_fd(1, 'w');
 862    $self->{'out_h'} or die("Could not open data fd");
 863    my $msg_fd = IO::Handle->new_from_fd(3, 'w');
 864    $msg_fd or die("Could not open message fd");
 865    $self->{'index_h'} = IO::Handle->new_from_fd(4, 'w');
 866    $self->{'index_h'} or die("Could not open index fd");
 867
 868    $self->{'done_cb'} = sub {
 869        my $size = shift @_;
 870        debug("done. size $size");
 871        $size = ceil($size/1024);
 872        debug("sending size $size");
 873        $msg_fd->print("sendbackup: size $size\n");
 874
 875        $self->{'index_h'}->print("/PostgreSQL-Database-$self->{'args'}->{'level'}\n");
 876
 877        $msg_fd->print("sendbackup: end\n");
 878    };
 879    $self->{'die_cb'} = sub {
 880        my $msg = shift @_;
 881        debug("$msg");
 882        $msg_fd->print("! $msg\n");
 883        $self->{'done_cb'}->(0);
 884        exit(1);
 885    };
 886    $self->{'state_cb'} = sub {
 887        my ($self, $end_wal) = @_;
 888        _write_state_file($self, $end_wal) or $self->{'die_cb'}->("Failed to write state file");
 889    };
 890    my $cleanup_wal_val = $self->{'props'}->{'pg-cleanupwal'} || 'yes';
 891    my $cleanup_wal = string_to_boolean($cleanup_wal_val);
 892    if (!defined($cleanup_wal)) {
 893        $self->{'die_cb'}->("couldn't interpret PG-CLEANUPWAL value '$cleanup_wal_val' as a boolean");
 894    } elsif ($cleanup_wal) {
 895        $self->{'unlink_cb'} = sub {
 896            my $filename = shift @_;
 897            debug("unlinking WAL file $filename");
 898            if (unlink($filename) == 0) {
 899                debug("Failed to unlink '$filename': $!");
 900                $self->print_to_server("Failed to unlink '$filename': $!",
 901                                       $Amanda::Script_App::ERROR);
 902            }
 903        };
 904    } else {
 905        $self->{'unlink_cb'} = sub {
 906            # do nothing
 907        };
 908    }
 909
 910    if ($self->{'args'}->{'level'} > 0) {
 911        _incr_backup($self, \*STDOUT);
 912    } else {
 913        _base_backup($self, \*STDOUT);
 914    }
 915 }
 916
 917 sub command_restore {
 918     my $self = shift;
 919
 920     chdir(Amanda::Util::get_original_cwd());
 921     if (defined $self->{'args'}->{directory}) {
 922         if (!-d $self->{'args'}->{directory}) {
 923             $self->print_to_server_and_die("Directory $self->{directory}: $!",
 924                                            $Amanda::Script_App::ERROR);
 925         }
 926         if (!-w $self->{'args'}->{directory}) {
 927             $self->print_to_server_and_die("Directory $self->{directory}: $!",
 928                                            $Amanda::Script_App::ERROR);
 929         }
 930         chdir($self->{'args'}->{directory});
 931     }
 932     my $cur_dir = POSIX::getcwd();
 933
 934     if (!-d $_ARCHIVE_DIR_RESTORE) {
 935         mkdir($_ARCHIVE_DIR_RESTORE) or die("could not create archive WAL directory: $!");
 936     }
 937     my $status;
 938     if ($self->{'args'}->{'level'} > 0) {
 939         debug("extracting incremental backup to $cur_dir/$_ARCHIVE_DIR_RESTORE");
 940         $status = system($self->{'args'}->{'gnutar-path'},
 941                 '--extract',
 942                 '--file', '-',
 943                 '--ignore-zeros',
 944                 '--exclude', 'empty-incremental',
 945                 '--directory', $_ARCHIVE_DIR_RESTORE) >> 8;
 946         (0 == $status) or die("Failed to extract level $self->{'args'}->{'level'} backup (exit status: $status)");
 947     } else {
 948         debug("extracting base of full backup to $cur_dir/$_DATA_DIR_RESTORE");
 949         debug("extracting archive dir to $cur_dir/$_ARCHIVE_DIR_RESTORE");
 950         if (!-d $_DATA_DIR_RESTORE) {
 951             mkdir($_DATA_DIR_RESTORE) or die("could not create archive WAL directory: $!");
 952         }
 953         my @cmd = ($self->{'args'}->{'gnutar-path'}, '--extract',
 954                 '--file', '-',
 955                 '--ignore-zero',
 956                 '--transform', "s,^DATA/,$_DATA_DIR_RESTORE/,S",
 957                 '--transform', "s,^WAL/,$_ARCHIVE_DIR_RESTORE/,S");
 958         debug("run: " . join ' ',@cmd);
 959         $status = system(@cmd) >> 8;
 960         (0 == $status) or die("Failed to extract base backup (exit status: $status)");
 961
 962         if (-f $_ARCHIVE_DIR_TAR) {
 963             debug("extracting archive dir to $cur_dir/$_ARCHIVE_DIR_RESTORE");
 964             my @cmd = ($self->{'args'}->{'gnutar-path'}, '--extract',
 965                 '--exclude', 'empty-incremental',
 966                 '--file', $_ARCHIVE_DIR_TAR, '--directory',
 967                 $_ARCHIVE_DIR_RESTORE);
 968             debug("run: " . join ' ',@cmd);
 969             $status = system(@cmd) >> 8;
 970             (0 == $status) or die("Failed to extract archived WAL files from base backup (exit status: $status)");
 971             if (unlink($_ARCHIVE_DIR_TAR) == 0) {
 972                 debug("Failed to unlink '$_ARCHIVE_DIR_TAR': $!");
 973                 $self->print_to_server(
 974                                 "Failed to unlink '$_ARCHIVE_DIR_TAR': $!",
 975                                 $Amanda::Script_App::ERROR);
 976             }
 977         }
 978
 979         if (-f $_DATA_DIR_TAR) {
 980             debug("extracting data dir to $cur_dir/$_DATA_DIR_RESTORE");
 981             my @cmd = ($self->{'args'}->{'gnutar-path'}, '--extract',
 982                 '--file', $_DATA_DIR_TAR,
 983                 '--directory', $_DATA_DIR_RESTORE);
 984             debug("run: " . join ' ',@cmd);
 985             $status = system(@cmd) >> 8;
 986             (0 == $status) or die("Failed to extract data directory from base backup (exit status: $status)");
 987             if (unlink($_DATA_DIR_TAR) == 0) {
 988                 debug("Failed to unlink '$_DATA_DIR_TAR': $!");
 989                 $self->print_to_server("Failed to unlink '$_DATA_DIR_TAR': $!",
 990                                 $Amanda::Script_App::ERROR);
 991             }
 992         }
 993     }
 994 }
 995
 996 sub command_validate {
 997    my $self = shift;
 998
 999    # set up to handle errors correctly
1000    $self->{'die_cb'} = sub {
1001        my ($msg) = @_;
1002        debug("$msg");
1003        print "$msg\n";
1004        exit(1);
1005    };
1006
1007    if (!defined($self->{'args'}->{'gnutar-path'}) ||
1008        !-x $self->{'args'}->{'gnutar-path'}) {
1009       return $self->default_validate();
1010    }
1011
1012    my(@cmd) = ($self->{'args'}->{'gnutar-path'}, "--ignore-zeros", "-tf", "-");
1013    debug("cmd:" . join(" ", @cmd));
1014    my $pid = open3('>&STDIN', '>&STDOUT', '>&STDERR', @cmd) ||
1015       $self->print_to_server_and_die("Unable to run @cmd",
1016                                      $Amanda::Application::ERROR);
1017    waitpid $pid, 0;
1018    if ($? != 0){
1019        $self->print_to_server_and_die("$self->{gnutar} returned error",
1020                                       $Amanda::Application::ERROR);
1021    }
1022    exit($self->{error_status});
1023 }
1024
1025 package main;
1026
1027 sub usage {
1028     print <<EOF;
1029 Usage: ampgsql <command> --config=<config> --host=<host> --disk=<disk> --device=<device> --level=<level> --index=<yes|no> --message=<text> --collection=<no> --record=<yes|no> --calcsize.
1030 EOF
1031     exit(1);
1032 }
1033
1034 my $opts = {};
1035 my $opt_version;
1036
1037 GetOptions(
1038     $opts,
1039     'version' => \$opt_version,
1040     'config=s',
1041     'host=s',
1042     'disk=s',
1043     'device=s',
1044     'level=s',
1045     'index=s',
1046     'message=s',
1047     'collection=s',
1048     'record',
1049     'calcsize',
1050     'exclude-list=s@',
1051     'include-list=s@',
1052     'directory=s',
1053     # ampgsql-specific
1054     'statedir=s',
1055     'tmpdir=s',
1056     'gnutar-path=s',
1057     'cleanupwal=s',
1058     'archivedir=s',
1059     'db=s',
1060     'host=s',
1061     'max-wal-wait=s',
1062     'passfile=s',
1063     'port=s',
1064     'user=s',
1065     'psql-path=s'
1066 ) or usage();
1067
1068 if (defined $opt_version) {
1069     print "ampgsql-" . $Amanda::Constants::VERSION , "\n";
1070     exit(0);
1071 }
1072
1073 my $application = Amanda::Application::ampgsql->new($opts);
1074
1075 $application->do($ARGV[0]);