3 ### Run backups as instructed by a configuration file
5 ### (c) 2011 Mark Wooding
8 ###----- Licensing notice ---------------------------------------------------
10 ### This file is part of the distorted.org.uk backup suite.
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.
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.
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.
29 use Getopt::Long qw(:config gnu_compat bundling no_ignore_case);
35 our $VERSION = "@VERSION@";
37 our %C = ( etc => "@sysconfdir@",
39 libexec => "@pkglibexecdir@",
40 bkp => "@bkplibexecdir@" );
42 ###--------------------------------------------------------------------------
46 (our $QUIS = $0) =~ s:^.*/::;
47 sub whine ($) { my ($msg) = @_; print STDERR "$QUIS: $msg\n"; }
50 if ($EVAL) { die $msg . "\n"; }
51 else { whine $msg; exit $! || ($? >> 8) || 255; }
54 sub try (&) { my ($body) = @_; local $EVAL = 1; &$body (); }
58 ## Return a string describing the process exit status RC.
60 if (!$rc) { return "ok"; }
61 elsif ($rc & 255) { return sprintf "signal %d", $rc & 127; }
62 else { return sprintf "rc = %d", $rc >> 8; }
67 ## Quotify WORD so that a shell won't mangle it.
70 return "'" . $word . "'";
74 my ($what, @args) = @_;
75 ## Run a program with ARGS, collecting and returning its output.
77 open my $f, "-|", @args or fail "open pipe ($what): $!";
78 chomp (my @out = <$f>);
80 $? and fail "$what failed: " . decodewait $?;
81 fail "close pipe ($what)";
83 return wantarray ? @out : $out[0];
87 ## Report the current time.
89 return strftime "%Y-%m-%d %H:%M:%S %z", localtime;
92 ###--------------------------------------------------------------------------
93 ### Parse command line.
95 our $USAGE = "usage: $QUIS [-n] [-a ASSET] [-c FILE] [KEY=VALUE ...]";
96 sub version { print "$QUIS, version $VERSION\n"; }
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.
110 our $CONF = "$C{etc}/bkptab";
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; };
120 ###--------------------------------------------------------------------------
121 ### Parse the configuration file.
124 our %SECMAP = ( CONFIG => sub {
126 $C{$k} = $v unless $OVERRIDE{$k};
131 our %ASSET = map { $_ => 1 } @ASSET;
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/;
141 ## Handy sub for extracting a configuration variable.
144 exists $C{$k} or fail "$CONF:$.: unknown config variable `$k'";
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>) {
153 ## Handle continuation lines and comments.
155 while ($line =~ /\\\s*$/) {
156 chomp (my $more = <CF>);
157 $line =~ s/\\\s*$/$more/;
159 next if $line =~ /^\s*([#;]|$)/;
161 if ($line =~ /^\s*\[\s*(\S.*\S|\S|)\s*\]\s*/) {
162 ## Section header: set the kvfunc appropriately.
164 if (exists $SECMAP{$1}) {
165 $kvfunc = $SECMAP{$1};
166 } elsif (!@ASSET || $ASSET{$1}) {
168 if (!exists $DUMP{$asset}) {
174 push @{$DUMP{$asset}}, [$k, shellwords $v];
179 } elsif ($line =~ /\s*(\S.*\S|\S)\s*[=:]\s*(\S.*\S|\S|)\s*$/) {
180 ## Assignment line. Process this according to the current kvfunc.
182 my ($k, $v) = ($1, $2);
183 $v =~ s/\$\{([^}]+)\}/config $1/ge;
186 ## Something else: it's an error.
188 fail "$CONF:$.: unrecognized line";
193 close CF or fail "close config ($CONF): $!";
194 @ORDER or fail "no matching assets to dump";
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/;
203 ###--------------------------------------------------------------------------
204 ### Establish a safe temporary directory.
206 sysopen RAND, "/dev/urandom", O_RDONLY or fail "open (random): $!";
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;
218 $win or fail "failed to make temp directory";
219 $ENV{BKP_TMPDIR} = $TMPDIR;
220 END { chdir "/"; system "rm", "-rf", $TMPDIR if defined $TMPDIR; }
223 chdir $TMPDIR or fail "chdir ($TMPDIR): $!";
225 ###--------------------------------------------------------------------------
226 ### Wade through the list of things to do, dumping assets.
229 my ($op, @args) = @_;
230 ## Invoke an administration operation.
232 return run "bkpadmin $op",
234 join " ", map { shellquote $_ } qw(userv root bkpadmin), $op, @args;
237 ## Make sure there's a volume mounted.
240 ## Go through each asset dumping all of the tags.
241 for my $asset (@ORDER) {
243 ## Start a log for this asset.
245 open LOG, ">&", STDERR or fail "dup stderr (log)";
247 open LOG, ">", "$asset.log" or fail "open ($asset.log): $!";
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;
258 my $target = bkpadmin "prep", $asset, $level;
259 $ENV{BKP_TARGET} = $target;
262 ## Make sure we can dispose of the results if there's a Perl failure
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;
270 ## Dump the individual tags.
272 for my $dump (@{$DUMP{$asset}}) {
273 my ($tag, $type, @args) = @$dump;
276 printf LOG "%s: Dump tag `%s' (%s) begins\n", now, $tag, $type;
277 flush LOG or fail "write ($asset.log): $!";
279 ## Run the dump helper.
280 if ($NOACT) { $? = 0; }
282 defined (my $kid = fork) or fail "fork: $!";
284 open STDOUT, ">&", LOG and
285 open STDERR, ">&", LOG or
287 exec "$C{bkp}/bkp.$type", "$tag", @args;
288 fail "exec (bkp.$type): $!";
290 waitpid $kid, 0 or fail "waitpid: $!";
293 ## Deal with the aftermath.
295 printf LOG "%s: Dump tag `%s' failed (%s)\n", now, $tag,
297 printf STDERR "%s: %s: Dump asset `%s' tag `%s' FAILED\n",
298 $QUIS, now, $asset, $tag;
301 printf LOG "%s: Dump tag `%s' not performed (--noact)\n", now, $tag;
303 printf LOG "%s: Dump tag `%s' ok\n", now, $tag;
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): $!";
313 ## Copy the log to the server and commit it.
315 run "scp $asset.log",
316 "scp", "$asset.log", "$C{host}:$target/$asset.log";
317 bkpadmin $lose ? "fail" : "commit", $asset;
321 ## If anything failed above, then try to mark the asset as a failure and
324 try { bkpadmin "fail", $asset; };
329 ###----- That's all, folks --------------------------------------------------