#! @PERL@
###
### Run backups as instructed by a configuration file
###
### (c) 2011 Mark Wooding
###

###----- Licensing notice ---------------------------------------------------
###
### This program is free software; you can redistribute it and/or modify
### it under the terms of the GNU General Public License as published by
### the Free Software Foundation; either version 2 of the License, or
### (at your option) any later version.
###
### This program is distributed in the hope that it will be useful,
### but WITHOUT ANY WARRANTY; without even the implied warranty of
### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
### GNU General Public License for more details.
###
### You should have received a copy of the GNU General Public License
### along with this program; if not, write to the Free Software Foundation,
### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

use Data::Dumper;
use Errno qw(:POSIX);
use Fcntl qw(:mode);
use Getopt::Long qw(:config gnu_compat bundling no_ignore_case);
use IO::Handle;
use MIME::Base64;
use POSIX;
use Text::ParseWords;

our $VERSION = "@VERSION@";

our %C = ( etc		=> "@sysconfdir@",
	   sbin		=> "@sbindir@",
	   libexec	=> "@pkglibexecdir@",
	   bkp		=> "@bkplibexecdir@" );

###--------------------------------------------------------------------------
### Utilities.

our $EVAL = 0;
(our $QUIS = $0) =~ s:^.*/::;
sub whine ($) { my ($msg) = @_; print STDERR "$QUIS: $msg\n"; }
sub fail ($) {
  my ($msg) = @_;
  if ($EVAL) { die $msg . "\n"; }
  else { whine $msg; exit $! || ($? >> 8) || 255; }
}

sub try (&) { my ($body) = @_; local $EVAL = 1; &$body (); }

sub decodewait ($) {
  my ($rc) = @_;
  ## Return a string describing the process exit status RC.

  if (!$rc) { return "ok"; }
  elsif ($rc & 255) { return sprintf "signal %d", $rc & 127; }
  else { return sprintf "rc = %d", $rc >> 8; }
}

sub shellquote ($) {
  my ($word) = @_;
  ## Quotify WORD so that a shell won't mangle it.

  $word =~ s/'/'\\''/g;
  return "'" . $word . "'";
}

sub run ($@) {
  my ($what, @args) = @_;
  ## Run a program with ARGS, collecting and returning its output.

  open my $f, "-|", @args or fail "open pipe ($what): $!";
  chomp (my @out = <$f>);
  if (!close $f) {
    $? and fail "$what failed: " . decodewait $?;
    fail "close pipe ($what)";
  }
  return wantarray ? @out : $out[0];
}

sub now () {
  ## Report the current time.

  return strftime "%Y-%m-%d %H:%M:%S %z", localtime;
}

###--------------------------------------------------------------------------
### Parse command line.

our $USAGE = "usage: $QUIS [-n] [-a ASSET] [-c FILE] [KEY=VALUE ...]";
sub version { print "$QUIS, version $VERSION\n"; }
sub help {
  print <<EOF;
$USAGE

Options:
  -h, --help		Show this help text.
  -v, --version		Show the program version number.
  -a, --asset=ASSET	Back up ASSET, rather than all assets.
  -c, --config=FILE	Use configuration FILE, not $CONF.
  -n, --noact		Don't actually run the dump programs.
EOF
}

our $CONF = "$C{etc}/bkptab";
our @ASSET = ();
our $NOACT = 0;
GetOptions('help|h|?'		=> sub { version; help; exit; },
	   'version|v'		=> sub { version; exit; },
	   'asset|a=s'		=> \@ASSET,
	   'config-file|c=s'	=> \$CONF,
	   'noact|n'		=> \$NOACT)
  or do { print STDERR $USAGE, "\n"; exit 1; };

###--------------------------------------------------------------------------
### Parse the configuration file.

our %OVERRIDE = ();
our %SECMAP = ( CONFIG	=> sub {
		  my ($k, $v) = @_;
		  $C{$k} = $v unless $OVERRIDE{$k};
		} );

our %DUMP = ();
our @ORDER = ();
our %ASSET = map { $_ => 1 } @ASSET;

## Override configuration from the environment.
while (my ($e, $v) = each %ENV) {
  next unless $e =~ /^BKP_([_A-Za-z0-9]+)$/;
  (my $k = $1) =~ tr/_A-Z/-a-z/;
  $C{$k} = $v;
  $OVERRIDE{$k} = 1;
}

## Handy sub for extracting a configuration variable.
sub config ($) {
  my ($k) = @_;
  exists $C{$k} or fail "$CONF:$.: unknown config variable `$k'";
  return $C{$k};
}

## Parse the configuration file proper.
open CF, "<", $CONF or fail "open config ($CONF): $!";
my $kvfunc = $SECMAP{CONFIG};
while (my $line = <CF>) {

  ## Handle continuation lines and comments.
  chomp $line;
  while ($line =~ /\\\s*$/) {
    chomp (my $more = <CF>);
    $line =~ s/\\\s*$/$more/;
  }
  next if $line =~ /^\s*([#;]|$)/;

  if ($line =~ /^\s*\[\s*(\S.*\S|\S|)\s*\]\s*/) {
    ## Section header: set the kvfunc appropriately.

    if (exists $SECMAP{$1}) {
      $kvfunc = $SECMAP{$1};
    } elsif (!@ASSET || $ASSET{$1}) {
      my $asset = $1;
      if (!exists $DUMP{$asset}) {
	$DUMP{$asset} = [];
	push @ORDER, $asset;
      }
      $kvfunc = sub {
	my ($k, $v) = @_;
	push @{$DUMP{$asset}}, [$k, shellwords $v];
      }
    } else {
      $kvfunc = sub { };
    }
  } elsif ($line =~ /\s*(\S.*\S|\S)\s*[=:]\s*(\S.*\S|\S|)\s*$/) {
    ## Assignment line.  Process this according to the current kvfunc.

    my ($k, $v) = ($1, $2);
    $v =~ s/\$\{([^}]+)\}/config $1/ge;
    $kvfunc->($1, $2);
  } else {
    ## Something else: it's an error.

    fail "$CONF:$.: unrecognized line";
  }
}

## Done.
close CF or fail "close config ($CONF): $!";
@ORDER or fail "no matching assets to dump";

## Export the configuration.
while (my ($k, $v) = each %C) {
  next unless $k =~ /^[-A-Za-z0-9]+$/;
  (my $e = $k) = tr/-a-z/_A-Z/;
  $ENV{$k} = $v;
}

###--------------------------------------------------------------------------
### Establish a safe temporary directory.

sysopen RAND, "/dev/urandom", O_RDONLY or fail "open (random): $!";
my $win = 0;
our $TMPDIR;
for (my $i = 0; $i < 1000; $i++) {
  my $n = sysread RAND, my $buf, 12;
  if (!defined $n) { fail "read (random): $!"; }
  elsif ($n < 12) { fail "short read (random)"; }
  my $rand = encode_base64 $buf, "";
  $TMPDIR = ($ENV{TMPDIR} // "/tmp") . "/bkp.$$.$rand";
  $win = 1, last if mkdir $TMPDIR, 0700;
  fail "mkdir (tmp): $!" unless $! == ENOENT;
}
$win or fail "failed to make temp directory";
$ENV{BKP_TMPDIR} = $TMPDIR;
END { chdir "/"; system "rm", "-rf", $TMPDIR if defined $TMPDIR; }
close RAND;

chdir $TMPDIR or fail "chdir ($TMPDIR): $!";

###--------------------------------------------------------------------------
### Wade through the list of things to do, dumping assets.

sub bkpadmin ($@) {
  my ($op, @args) = @_;
  ## Invoke an administration operation.

  return run "bkpadmin $op",
    "ssh", $C{host},
    join " ", map { shellquote $_ } qw(userv root bkpadmin), $op, @args;
}

## Make sure there's a volume mounted.
bkpadmin "mount";

## Go through each asset dumping all of the tags.
for my $asset (@ORDER) {

  ## Start a log for this asset.
  if ($NOACT) {
    open LOG, ">&", STDERR or fail "dup stderr (log)";
  } else {
    open LOG, ">", "$asset.log" or fail "open ($asset.log): $!";
  }

  ## Find out when the last dump was done.
  my ($level, $date, $time, $tz) = split " ", bkpadmin "level", $asset;
  $ENV{BKP_LEVEL} = $level;
  $ENV{BKP_LASTDATE} = my $lastdate = "$date $time $tz";
  $ENV{BKP_ASSET} = $asset;

  ## Prepare the dump.
  unless ($NOACT) {
    my $target = bkpadmin "prep", $asset, $level;
    $ENV{BKP_TARGET} = $target;
  }

  ## Make sure we can dispose of the results if there's a Perl failure
  ## somewhere here.
  try {

    ## Start writing the log.
    printf LOG "%s: Commence dump of asset `%s' at level %d (since %s)\n",
      now, $asset, $level, $lastdate;

    ## Dump the individual tags.
    my $lose = 0;
    for my $dump (@{$DUMP{$asset}}) {
      my ($tag, $type, @args) = @$dump;

      ## Make a log note.
      printf LOG "%s: Dump tag `%s' (%s) begins\n", now, $tag, $type;
      flush LOG or fail "write ($asset.log): $!";

      ## Run the dump helper.
      if ($NOACT) { $? = 0; }
      else {
	defined (my $kid = fork) or fail "fork: $!";
	unless ($kid) {
	  open STDOUT, ">&", LOG and
	    open STDERR, ">&", LOG or
	      fail "dup: $!";
	  exec "$C{bkp}/bkp.$type", "$tag", @args;
	  fail "exec (bkp.$type): $!";
	}
	waitpid $kid, 0 or fail "waitpid: $!";
      }

      ## Deal with the aftermath.
      if ($?) {
	printf LOG "%s: Dump tag `%s' failed (%s)\n", now, $tag,
	  decodewait $?;
	printf STDERR "%s: %s: Dump asset `%s' tag `%s' FAILED\n",
	  $QUIS, now, $asset, $tag;
	$lose++;
      } elsif ($NOACT) {
	printf LOG "%s: Dump tag `%s' not performed (--noact)\n", now, $tag;
      } else {
	printf LOG "%s: Dump tag `%s' ok\n", now, $tag;
      }
    }

    ## Report completion of the asset.
    printf LOG "%s: Dump of asset `%s' completed %s\n", now, $asset,
      $lose == 0 ? "successfully" : "with $lose failures";
    error LOG and fail "write ($asset.log): $!";
    close LOG or fail "close ($asset.log): $!";

    ## Copy the log to the server and commit it.
    unless ($NOACT) {
      run "scp $asset.log",
	"scp", "$asset.log", "$C{host}:$target/$asset.log";
      bkpadmin $lose ? "fail" : "commit", $asset;
    }
  };

  ## If anything failed above, then try to mark the asset as a failure and
  ## abort.
  if ($@) {
    try { bkpadmin "fail", $asset; };
    fail $@;
  }
}

###----- That's all, folks --------------------------------------------------