Commit | Line | Data |
---|---|---|
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 | ||
26 | use Data::Dumper; | |
27 | use Errno qw(:POSIX); | |
28 | use Fcntl qw(:mode); | |
29 | use Getopt::Long qw(:config gnu_compat bundling no_ignore_case); | |
30 | use IO::Handle; | |
31 | use MIME::Base64; | |
32 | use POSIX; | |
33 | use Text::ParseWords; | |
34 | ||
35 | our $VERSION = "@VERSION@"; | |
36 | ||
37 | our %C = ( etc => "@sysconfdir@", | |
38 | sbin => "@sbindir@", | |
39 | libexec => "@pkglibexecdir@", | |
40 | bkp => "@bkplibexecdir@" ); | |
41 | ||
42 | ###-------------------------------------------------------------------------- | |
43 | ### Utilities. | |
44 | ||
45 | our $EVAL = 0; | |
46 | (our $QUIS = $0) =~ s:^.*/::; | |
47 | sub whine ($) { my ($msg) = @_; print STDERR "$QUIS: $msg\n"; } | |
48 | sub fail ($) { | |
49 | my ($msg) = @_; | |
50 | if ($EVAL) { die $msg . "\n"; } | |
51 | else { whine $msg; exit $! || ($? >> 8) || 255; } | |
52 | } | |
53 | ||
54 | sub try (&) { my ($body) = @_; local $EVAL = 1; &$body (); } | |
55 | ||
56 | sub 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 | ||
65 | sub 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 | ||
73 | sub 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 | ||
86 | sub 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 | ||
95 | our $USAGE = "usage: $QUIS [-n] [-a ASSET] [-c FILE] [KEY=VALUE ...]"; | |
96 | sub version { print "$QUIS, version $VERSION\n"; } | |
97 | sub help { | |
98 | print <<EOF; | |
99 | $USAGE | |
100 | ||
101 | Options: | |
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. | |
107 | EOF | |
108 | } | |
109 | ||
110 | our $CONF = "$C{etc}/bkptab"; | |
111 | our @ASSET = (); | |
112 | our $NOACT = 0; | |
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; }; | |
119 | ||
120 | ###-------------------------------------------------------------------------- | |
121 | ### Parse the configuration file. | |
122 | ||
123 | our %OVERRIDE = (); | |
124 | our %SECMAP = ( CONFIG => sub { | |
125 | my ($k, $v) = @_; | |
126 | $C{$k} = $v unless $OVERRIDE{$k}; | |
127 | } ); | |
128 | ||
129 | our %DUMP = (); | |
130 | our @ORDER = (); | |
131 | our %ASSET = map { $_ => 1 } @ASSET; | |
132 | ||
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/; | |
137 | $C{$k} = $v; | |
138 | $OVERRIDE{$k} = 1; | |
139 | } | |
140 | ||
141 | ## Handy sub for extracting a configuration variable. | |
142 | sub 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. | |
149 | open CF, "<", $CONF or fail "open config ($CONF): $!"; | |
150 | my $kvfunc = $SECMAP{CONFIG}; | |
151 | while (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. | |
193 | close CF or fail "close config ($CONF): $!"; | |
194 | @ORDER or fail "no matching assets to dump"; | |
195 | ||
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/; | |
200 | $ENV{$k} = $v; | |
201 | } | |
202 | ||
203 | ###-------------------------------------------------------------------------- | |
204 | ### Establish a safe temporary directory. | |
205 | ||
206 | sysopen RAND, "/dev/urandom", O_RDONLY or fail "open (random): $!"; | |
207 | my $win = 0; | |
208 | our $TMPDIR; | |
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; | |
217 | } | |
218 | $win or fail "failed to make temp directory"; | |
219 | $ENV{BKP_TMPDIR} = $TMPDIR; | |
220 | END { chdir "/"; system "rm", "-rf", $TMPDIR if defined $TMPDIR; } | |
221 | close RAND; | |
222 | ||
223 | chdir $TMPDIR or fail "chdir ($TMPDIR): $!"; | |
224 | ||
225 | ###-------------------------------------------------------------------------- | |
226 | ### Wade through the list of things to do, dumping assets. | |
227 | ||
228 | sub 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. | |
238 | bkpadmin "mount"; | |
239 | ||
240 | ## Go through each asset dumping all of the tags. | |
241 | for 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 -------------------------------------------------- |