chiark - git - mdw - distorted-backup/blob - bkp.in

   1 #! @PERL@
   2 ###
   3 ### Run backups as instructed by a configuration file
   4 ###
   5 ### (c) 2011 Mark Wooding
   6 ###
   7
   8 ###----- Licensing notice ---------------------------------------------------
   9 ###
  10 ### This file is part of the distorted.org.uk backup suite.
  11 ###
  12 ### distorted-backup is free software; you can redistribute it and/or modify
  13 ### it under the terms of the GNU General Public License as published by
  14 ### the Free Software Foundation; either version 2 of the License, or
  15 ### (at your option) any later version.
  16 ###
  17 ### distorted-backup is distributed in the hope that it will be useful,
  18 ### but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ### GNU General Public License for more details.
  21 ###
  22 ### You should have received a copy of the GNU General Public License along
  23 ### with distorted-backup; if not, write to the Free Software Foundation,
  24 ### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  25
  26 use Data::Dumper;
  27 use Errno qw(:POSIX);
  28 use Fcntl qw(:mode);
  29 use Getopt::Long qw(:config gnu_compat bundling no_ignore_case);
  30 use IO::Handle;
  31 use MIME::Base64;
  32 use POSIX;
  33 use Text::ParseWords;
  34
  35 our $VERSION = "@VERSION@";
  36
  37 our %C = ( etc          => "@sysconfdir@",
  38            sbin         => "@sbindir@",
  39            libexec      => "@pkglibexecdir@",
  40            bkp          => "@bkplibexecdir@" );
  41
  42 ###--------------------------------------------------------------------------
  43 ### Utilities.
  44
  45 our $EVAL = 0;
  46 (our $QUIS = $0) =~ s:^.*/::;
  47 sub whine ($) { my ($msg) = @_; print STDERR "$QUIS: $msg\n"; }
  48 sub fail ($) {
  49   my ($msg) = @_;
  50   if ($EVAL) { die $msg . "\n"; }
  51   else { whine $msg; exit $! || ($? >> 8) || 255; }
  52 }
  53
  54 sub try (&) { my ($body) = @_; local $EVAL = 1; &$body (); }
  55
  56 sub decodewait ($) {
  57   my ($rc) = @_;
  58   ## Return a string describing the process exit status RC.
  59
  60   if (!$rc) { return "ok"; }
  61   elsif ($rc & 255) { return sprintf "signal %d", $rc & 127; }
  62   else { return sprintf "rc = %d", $rc >> 8; }
  63 }
  64
  65 sub shellquote ($) {
  66   my ($word) = @_;
  67   ## Quotify WORD so that a shell won't mangle it.
  68
  69   $word =~ s/'/'\\''/g;
  70   return "'" . $word . "'";
  71 }
  72
  73 sub run ($@) {
  74   my ($what, @args) = @_;
  75   ## Run a program with ARGS, collecting and returning its output.
  76
  77   open my $f, "-|", @args or fail "open pipe ($what): $!";
  78   chomp (my @out = <$f>);
  79   if (!close $f) {
  80     $? and fail "$what failed: " . decodewait $?;
  81     fail "close pipe ($what)";
  82   }
  83   return wantarray ? @out : $out[0];
  84 }
  85
  86 sub now () {
  87   ## Report the current time.
  88
  89   return strftime "%Y-%m-%d %H:%M:%S %z", localtime;
  90 }
  91
  92 ###--------------------------------------------------------------------------
  93 ### Parse command line.
  94
  95 our $USAGE = "usage: $QUIS [-n] [-a ASSET] [-c FILE] [KEY=VALUE ...]";
  96 sub version { print "$QUIS, version $VERSION\n"; }
  97 sub help {
  98   print <<EOF;
  99 $USAGE
 100
 101 Options:
 102   -h, --help            Show this help text.
 103   -v, --version         Show the program version number.
 104   -a, --asset=ASSET     Back up ASSET, rather than all assets.
 105   -c, --config=FILE     Use configuration FILE, not $CONF.
 106   -n, --noact           Don't actually run the dump programs.
 107 EOF
 108 }
 109
 110 our $CONF = "$C{etc}/bkptab";
 111 our @ASSET = ();
 112 our $NOACT = 0;
 113 GetOptions('help|h|?'           => sub { version; help; exit; },
 114            'version|v'          => sub { version; exit; },
 115            'asset|a=s'          => \@ASSET,
 116            'config-file|c=s'    => \$CONF,
 117            'noact|n'            => \$NOACT)
 118   or do { print STDERR $USAGE, "\n"; exit 1; };
 119
 120 ###--------------------------------------------------------------------------
 121 ### Parse the configuration file.
 122
 123 our %OVERRIDE = ();
 124 our %SECMAP = ( CONFIG  => sub {
 125                   my ($k, $v) = @_;
 126                   $C{$k} = $v unless $OVERRIDE{$k};
 127                 } );
 128
 129 our %DUMP = ();
 130 our @ORDER = ();
 131 our %ASSET = map { $_ => 1 } @ASSET;
 132
 133 ## Override configuration from the environment.
 134 while (my ($e, $v) = each %ENV) {
 135   next unless $e =~ /^BKP_([_A-Za-z0-9]+)$/;
 136   (my $k = $1) =~ tr/_A-Z/-a-z/;
 137   $C{$k} = $v;
 138   $OVERRIDE{$k} = 1;
 139 }
 140
 141 ## Handy sub for extracting a configuration variable.
 142 sub config ($) {
 143   my ($k) = @_;
 144   exists $C{$k} or fail "$CONF:$.: unknown config variable `$k'";
 145   return $C{$k};
 146 }
 147
 148 ## Parse the configuration file proper.
 149 open CF, "<", $CONF or fail "open config ($CONF): $!";
 150 my $kvfunc = $SECMAP{CONFIG};
 151 while (my $line = <CF>) {
 152
 153   ## Handle continuation lines and comments.
 154   chomp $line;
 155   while ($line =~ /\\\s*$/) {
 156     chomp (my $more = <CF>);
 157     $line =~ s/\\\s*$/$more/;
 158   }
 159   next if $line =~ /^\s*([#;]|$)/;
 160
 161   if ($line =~ /^\s*\[\s*(\S.*\S|\S|)\s*\]\s*/) {
 162     ## Section header: set the kvfunc appropriately.
 163
 164     if (exists $SECMAP{$1}) {
 165       $kvfunc = $SECMAP{$1};
 166     } elsif (!@ASSET || $ASSET{$1}) {
 167       my $asset = $1;
 168       if (!exists $DUMP{$asset}) {
 169         $DUMP{$asset} = [];
 170         push @ORDER, $asset;
 171       }
 172       $kvfunc = sub {
 173         my ($k, $v) = @_;
 174         push @{$DUMP{$asset}}, [$k, shellwords $v];
 175       }
 176     } else {
 177       $kvfunc = sub { };
 178     }
 179   } elsif ($line =~ /\s*(\S.*\S|\S)\s*[=:]\s*(\S.*\S|\S|)\s*$/) {
 180     ## Assignment line.  Process this according to the current kvfunc.
 181
 182     my ($k, $v) = ($1, $2);
 183     $v =~ s/\$\{([^}]+)\}/config $1/ge;
 184     $kvfunc->($1, $2);
 185   } else {
 186     ## Something else: it's an error.
 187
 188     fail "$CONF:$.: unrecognized line";
 189   }
 190 }
 191
 192 ## Done.
 193 close CF or fail "close config ($CONF): $!";
 194 @ORDER or fail "no matching assets to dump";
 195
 196 ## Export the configuration.
 197 while (my ($k, $v) = each %C) {
 198   next unless $k =~ /^[-A-Za-z0-9]+$/;
 199   (my $e = $k) = tr/-a-z/_A-Z/;
 200   $ENV{$k} = $v;
 201 }
 202
 203 ###--------------------------------------------------------------------------
 204 ### Establish a safe temporary directory.
 205
 206 sysopen RAND, "/dev/urandom", O_RDONLY or fail "open (random): $!";
 207 my $win = 0;
 208 our $TMPDIR;
 209 for (my $i = 0; $i < 1000; $i++) {
 210   my $n = sysread RAND, my $buf, 12;
 211   if (!defined $n) { fail "read (random): $!"; }
 212   elsif ($n < 12) { fail "short read (random)"; }
 213   my $rand = encode_base64 $buf, "";
 214   $TMPDIR = ($ENV{TMPDIR} // "/tmp") . "/bkp.$$.$rand";
 215   $win = 1, last if mkdir $TMPDIR, 0700;
 216   fail "mkdir (tmp): $!" unless $! == ENOENT;
 217 }
 218 $win or fail "failed to make temp directory";
 219 $ENV{BKP_TMPDIR} = $TMPDIR;
 220 END { chdir "/"; system "rm", "-rf", $TMPDIR if defined $TMPDIR; }
 221 close RAND;
 222
 223 chdir $TMPDIR or fail "chdir ($TMPDIR): $!";
 224
 225 ###--------------------------------------------------------------------------
 226 ### Wade through the list of things to do, dumping assets.
 227
 228 sub bkpadmin ($@) {
 229   my ($op, @args) = @_;
 230   ## Invoke an administration operation.
 231
 232   return run "bkpadmin $op",
 233     "ssh", $C{host},
 234     join " ", map { shellquote $_ } qw(userv root bkpadmin), $op, @args;
 235 }
 236
 237 ## Make sure there's a volume mounted.
 238 bkpadmin "mount";
 239
 240 ## Go through each asset dumping all of the tags.
 241 for my $asset (@ORDER) {
 242
 243   ## Start a log for this asset.
 244   if ($NOACT) {
 245     open LOG, ">&", STDERR or fail "dup stderr (log)";
 246   } else {
 247     open LOG, ">", "$asset.log" or fail "open ($asset.log): $!";
 248   }
 249
 250   ## Find out when the last dump was done.
 251   my ($level, $date, $time, $tz) = split " ", bkpadmin "level", $asset;
 252   $ENV{BKP_LEVEL} = $level;
 253   $ENV{BKP_LASTDATE} = my $lastdate = "$date $time $tz";
 254   $ENV{BKP_ASSET} = $asset;
 255
 256   ## Prepare the dump.
 257   unless ($NOACT) {
 258     my $target = bkpadmin "prep", $asset, $level;
 259     $ENV{BKP_TARGET} = $target;
 260   }
 261
 262   ## Make sure we can dispose of the results if there's a Perl failure
 263   ## somewhere here.
 264   try {
 265
 266     ## Start writing the log.
 267     printf LOG "%s: Commence dump of asset `%s' at level %d (since %s)\n",
 268       now, $asset, $level, $lastdate;
 269
 270     ## Dump the individual tags.
 271     my $lose = 0;
 272     for my $dump (@{$DUMP{$asset}}) {
 273       my ($tag, $type, @args) = @$dump;
 274
 275       ## Make a log note.
 276       printf LOG "%s: Dump tag `%s' (%s) begins\n", now, $tag, $type;
 277       flush LOG or fail "write ($asset.log): $!";
 278
 279       ## Run the dump helper.
 280       if ($NOACT) { $? = 0; }
 281       else {
 282         defined (my $kid = fork) or fail "fork: $!";
 283         unless ($kid) {
 284           open STDOUT, ">&", LOG and
 285             open STDERR, ">&", LOG or
 286               fail "dup: $!";
 287           exec "$C{bkp}/bkp.$type", "$tag", @args;
 288           fail "exec (bkp.$type): $!";
 289         }
 290         waitpid $kid, 0 or fail "waitpid: $!";
 291       }
 292
 293       ## Deal with the aftermath.
 294       if ($?) {
 295         printf LOG "%s: Dump tag `%s' failed (%s)\n", now, $tag,
 296           decodewait $?;
 297         printf STDERR "%s: %s: Dump asset `%s' tag `%s' FAILED\n",
 298           $QUIS, now, $asset, $tag;
 299         $lose++;
 300       } elsif ($NOACT) {
 301         printf LOG "%s: Dump tag `%s' not performed (--noact)\n", now, $tag;
 302       } else {
 303         printf LOG "%s: Dump tag `%s' ok\n", now, $tag;
 304       }
 305     }
 306
 307     ## Report completion of the asset.
 308     printf LOG "%s: Dump of asset `%s' completed %s\n", now, $asset,
 309       $lose == 0 ? "successfully" : "with $lose failures";
 310     error LOG and fail "write ($asset.log): $!";
 311     close LOG or fail "close ($asset.log): $!";
 312
 313     ## Copy the log to the server and commit it.
 314     unless ($NOACT) {
 315       run "scp $asset.log",
 316         "scp", "$asset.log", "$C{host}:$target/$asset.log";
 317       bkpadmin $lose ? "fail" : "commit", $asset;
 318     }
 319   };
 320
 321   ## If anything failed above, then try to mark the asset as a failure and
 322   ## abort.
 323   if ($@) {
 324     try { bkpadmin "fail", $asset; };
 325     fail $@;
 326   }
 327 }
 328
 329 ###----- That's all, folks --------------------------------------------------