4 ### Run backups as instructed by a configuration file
6 ### (c) 2011 Mark Wooding
9 ###----- Licensing notice ---------------------------------------------------
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.
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.
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.
28 use Getopt::Long qw(:config gnu_compat bundling no_ignore_case);
34 our $VERSION = "@VERSION@";
36 our %C = ( etc => "@sysconfdir@",
38 libexec => "@pkglibexecdir@",
39 bkp => "@bkplibexecdir@" );
41 ###--------------------------------------------------------------------------
45 (our $QUIS = $0) =~ s:^.*/::;
46 sub whine ($) { my ($msg) = @_; print STDERR "$QUIS: $msg\n"; }
49 if ($EVAL) { die $msg . "\n"; }
50 else { whine $msg; exit $! || ($? >> 8) || 255; }
53 sub try (&) { my ($body) = @_; local $EVAL = 1; &$body (); }
57 ## Return a string describing the process exit status RC.
59 if (!$rc) { return "ok"; }
60 elsif ($rc & 255) { return sprintf "signal %d", $rc & 127; }
61 else { return sprintf "rc = %d", $rc >> 8; }
66 ## Quotify WORD so that a shell won't mangle it.
69 return "'" . $word . "'";
73 my ($what, @args) = @_;
74 ## Run a program with ARGS, collecting and returning its output.
76 open my $f, "-|", @args or fail "open pipe ($what): $!";
77 chomp (my @out = <$f>);
79 $? and fail "$what failed: " . decodewait $?;
80 fail "close pipe ($what)";
82 return wantarray ? @out : $out[0];
86 ## Report the current time.
88 return strftime "%Y-%m-%d %H:%M:%S %z", localtime;
91 ###--------------------------------------------------------------------------
92 ### Parse command line.
94 our $USAGE = "usage: $QUIS [-n] [-a ASSET] [-c FILE] [KEY=VALUE ...]";
95 sub version { print "$QUIS, version $VERSION\n"; }
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.
109 our $CONF = "$C{etc}/bkptab";
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; };
119 ###--------------------------------------------------------------------------
120 ### Parse the configuration file.
123 our %SECMAP = ( CONFIG => sub {
125 $C{$k} = $v unless $OVERRIDE{$k};
130 our %ASSET = map { $_ => 1 } @ASSET;
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/;
140 ## Handy sub for extracting a configuration variable.
143 exists $C{$k} or fail "$CONF:$.: unknown config variable `$k'";
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>) {
152 ## Handle continuation lines and comments.
154 while ($line =~ /\\\s*$/) {
155 chomp (my $more = <CF>);
156 $line =~ s/\\\s*$/$more/;
158 next if $line =~ /^\s*([#;]|$)/;
160 if ($line =~ /^\s*\[\s*(\S.*\S|\S|)\s*\]\s*/) {
161 ## Section header: set the kvfunc appropriately.
163 if (exists $SECMAP{$1}) {
164 $kvfunc = $SECMAP{$1};
165 } elsif (!@ASSET || $ASSET{$1}) {
167 if (!exists $DUMP{$asset}) {
173 push @{$DUMP{$asset}}, [$k, shellwords $v];
178 } elsif ($line =~ /\s*(\S.*\S|\S)\s*[=:]\s*(\S.*\S|\S|)\s*$/) {
179 ## Assignment line. Process this according to the current kvfunc.
181 my ($k, $v) = ($1, $2);
182 $v =~ s/\$\{([^}]+)\}/config $1/ge;
185 ## Something else: it's an error.
187 fail "$CONF:$.: unrecognized line";
192 close CF or fail "close config ($CONF): $!";
193 @ORDER or fail "no matching assets to dump";
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/;
202 ###--------------------------------------------------------------------------
203 ### Establish a safe temporary directory.
205 sysopen RAND, "/dev/urandom", O_RDONLY or fail "open (random): $!";
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;
217 $win or fail "failed to make temp directory";
218 $ENV{BKP_TMPDIR} = $TMPDIR;
219 END { chdir "/"; system "rm", "-rf", $TMPDIR if defined $TMPDIR; }
222 chdir $TMPDIR or fail "chdir ($TMPDIR): $!";
224 ###--------------------------------------------------------------------------
225 ### Wade through the list of things to do, dumping assets.
228 my ($op, @args) = @_;
229 ## Invoke an administration operation.
231 return run "bkpadmin $op",
233 join " ", map { shellquote $_ } qw(userv root bkpadmin), $op, @args;
236 ## Make sure there's a volume mounted.
239 ## Go through each asset dumping all of the tags.
240 for my $asset (@ORDER) {
242 ## Start a log for this asset.
244 open LOG, ">&", STDERR or fail "dup stderr (log)";
246 open LOG, ">", "$asset.log" or fail "open ($asset.log): $!";
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;
257 my $target = bkpadmin "prep", $asset, $level;
258 $ENV{BKP_TARGET} = $target;
261 ## Make sure we can dispose of the results if there's a Perl failure
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;
269 ## Dump the individual tags.
271 for my $dump (@{$DUMP{$asset}}) {
272 my ($tag, $type, @args) = @$dump;
275 printf LOG "%s: Dump tag `%s' (%s) begins\n", now, $tag, $type;
276 flush LOG or fail "write ($asset.log): $!";
278 ## Run the dump helper.
279 if ($NOACT) { $? = 0; }
281 defined (my $kid = fork) or fail "fork: $!";
283 open STDOUT, ">&", LOG and
284 open STDERR, ">&", LOG or
286 exec "$C{bkp}/bkp.$type", "$tag", @args;
287 fail "exec (bkp.$type): $!";
289 waitpid $kid, 0 or fail "waitpid: $!";
292 ## Deal with the aftermath.
294 printf LOG "%s: Dump tag `%s' failed (%s)\n", now, $tag,
296 printf STDERR "%s: %s: Dump asset `%s' tag `%s' FAILED\n",
297 $QUIS, now, $asset, $tag;
300 printf LOG "%s: Dump tag `%s' not performed (--noact)\n", now, $tag;
302 printf LOG "%s: Dump tag `%s' ok\n", now, $tag;
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): $!";
312 ## Copy the log to the server and commit it.
314 run "scp $asset.log",
315 "scp", "$asset.log", "$C{host}:$target/$asset.log";
316 bkpadmin $lose ? "fail" : "commit", $asset;
320 ## If anything failed above, then try to mark the asset as a failure and
323 try { bkpadmin "fail", $asset; };
328 ###----- That's all, folks --------------------------------------------------