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

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