3 ### Run backups as instructed by a configuration file
5 ### (c) 2011 Mark Wooding
8 ###----- Licensing notice ---------------------------------------------------
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.
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.
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.
27 use Getopt::Long qw(:config gnu_compat bundling no_ignore_case);
33 our $VERSION = "@VERSION@";
35 our %C = ( etc => "@sysconfdir@",
37 libexec => "@pkglibexecdir@",
38 bkp => "@bkplibexecdir@" );
40 ###--------------------------------------------------------------------------
44 (our $QUIS = $0) =~ s:^.*/::;
45 sub whine ($) { my ($msg) = @_; print STDERR "$QUIS: $msg\n"; }
48 if ($EVAL) { die $msg . "\n"; }
49 else { whine $msg; exit $! || ($? >> 8) || 255; }
52 sub try (&) { my ($body) = @_; local $EVAL = 1; &$body (); }
56 ## Return a string describing the process exit status RC.
58 if (!$rc) { return "ok"; }
59 elsif ($rc & 255) { return sprintf "signal %d", $rc & 127; }
60 else { return sprintf "rc = %d", $rc >> 8; }
65 ## Quotify WORD so that a shell won't mangle it.
68 return "'" . $word . "'";
72 my ($what, @args) = @_;
73 ## Run a program with ARGS, collecting and returning its output.
75 open my $f, "-|", @args or fail "open pipe ($what): $!";
76 chomp (my @out = <$f>);
78 $? and fail "$what failed: " . decodewait $?;
79 fail "close pipe ($what)";
81 return wantarray ? @out : $out[0];
85 ## Report the current time.
87 return strftime "%Y-%m-%d %H:%M:%S %z", localtime;
90 ###--------------------------------------------------------------------------
91 ### Parse command line.
93 our $USAGE = "usage: $QUIS [-n] [-a ASSET] [-c FILE] [KEY=VALUE ...]";
94 sub version { print "$QUIS, version $VERSION\n"; }
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.
108 our $CONF = "$C{etc}/bkptab";
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; };
118 ###--------------------------------------------------------------------------
119 ### Parse the configuration file.
122 our %SECMAP = ( CONFIG => sub {
124 $C{$k} = $v unless $OVERRIDE{$k};
129 our %ASSET = map { $_ => 1 } @ASSET;
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/;
139 ## Handy sub for extracting a configuration variable.
142 exists $C{$k} or fail "$CONF:$.: unknown config variable `$k'";
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>) {
151 ## Handle continuation lines and comments.
153 while ($line =~ /\\\s*$/) {
154 chomp (my $more = <CF>);
155 $line =~ s/\\\s*$/$more/;
157 next if $line =~ /^\s*([#;]|$)/;
159 if ($line =~ /^\s*\[\s*(\S.*\S|\S|)\s*\]\s*/) {
160 ## Section header: set the kvfunc appropriately.
162 if (exists $SECMAP{$1}) {
163 $kvfunc = $SECMAP{$1};
164 } elsif (!@ASSET || $ASSET{$1}) {
166 if (!exists $DUMP{$asset}) {
172 push @{$DUMP{$asset}}, [$k, shellwords $v];
177 } elsif ($line =~ /\s*(\S.*\S|\S)\s*[=:]\s*(\S.*\S|\S|)\s*$/) {
178 ## Assignment line. Process this according to the current kvfunc.
180 my ($k, $v) = ($1, $2);
181 $v =~ s/\$\{([^}]+)\}/config $1/ge;
184 ## Something else: it's an error.
186 fail "$CONF:$.: unrecognized line";
191 close CF or fail "close config ($CONF): $!";
192 @ORDER or fail "no matching assets to dump";
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/;
201 ###--------------------------------------------------------------------------
202 ### Establish a safe temporary directory.
204 sysopen RAND, "/dev/urandom", O_RDONLY or fail "open (random): $!";
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;
216 $win or fail "failed to make temp directory";
217 $ENV{BKP_TMPDIR} = $TMPDIR;
218 END { chdir "/"; system "rm", "-rf", $TMPDIR if defined $TMPDIR; }
221 chdir $TMPDIR or fail "chdir ($TMPDIR): $!";
223 ###--------------------------------------------------------------------------
224 ### Wade through the list of things to do, dumping assets.
227 my ($op, @args) = @_;
228 ## Invoke an administration operation.
230 return run "bkpadmin $op",
232 join " ", map { shellquote $_ } qw(userv root bkpadmin), $op, @args;
235 ## Make sure there's a volume mounted.
238 ## Go through each asset dumping all of the tags.
239 for my $asset (@ORDER) {
241 ## Start a log for this asset.
243 open LOG, ">&", STDERR or fail "dup stderr (log)";
245 open LOG, ">", "$asset.log" or fail "open ($asset.log): $!";
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;
256 my $target = bkpadmin "prep", $asset, $level;
257 $ENV{BKP_TARGET} = $target;
260 ## Make sure we can dispose of the results if there's a Perl failure
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;
268 ## Dump the individual tags.
270 for my $dump (@{$DUMP{$asset}}) {
271 my ($tag, $type, @args) = @$dump;
274 printf LOG "%s: Dump tag `%s' (%s) begins\n", now, $tag, $type;
275 flush LOG or fail "write ($asset.log): $!";
277 ## Run the dump helper.
278 if ($NOACT) { $? = 0; }
280 defined (my $kid = fork) or fail "fork: $!";
282 open STDOUT, ">&", LOG and
283 open STDERR, ">&", LOG or
285 exec "$C{bkp}/bkp.$type", "$tag", @args;
286 fail "exec (bkp.$type): $!";
288 waitpid $kid, 0 or fail "waitpid: $!";
291 ## Deal with the aftermath.
293 printf LOG "%s: Dump tag `%s' failed (%s)\n", now, $tag,
295 printf STDERR "%s: %s: Dump asset `%s' tag `%s' FAILED\n",
296 $QUIS, now, $asset, $tag;
299 printf LOG "%s: Dump tag `%s' not performed (--noact)\n", now, $tag;
301 printf LOG "%s: Dump tag `%s' ok\n", now, $tag;
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): $!";
311 ## Copy the log to the server and commit it.
313 run "scp $asset.log",
314 "scp", "$asset.log", "$C{host}:$target/$asset.log";
315 bkpadmin $lose ? "fail" : "commit", $asset;
319 ## If anything failed above, then try to mark the asset as a failure and
322 try { bkpadmin "fail", $asset; };
327 ###----- That's all, folks --------------------------------------------------