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

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