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