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