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