| 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 -------------------------------------------------- |