[distorted-backup] / bkp.in

#! @PERL@
###
### Run backups as instructed by a configuration file
###
### (c) 2011 Mark Wooding
###

###----- Licensing notice ---------------------------------------------------
###
### This program is free software; you can redistribute it and/or modify
### it under the terms of the GNU General Public License as published by
### the Free Software Foundation; either version 2 of the License, or
### (at your option) any later version.
###
### This program is distributed in the hope that it will be useful,
### but WITHOUT ANY WARRANTY; without even the implied warranty of
### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
### GNU General Public License for more details.
###
### You should have received a copy of the GNU General Public License
### along with this program; if not, write to the Free Software Foundation,
### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

use Data::Dumper;
use Errno qw(:POSIX);
use Fcntl qw(:mode);
use Getopt::Long qw(:config gnu_compat bundling no_ignore_case);
use IO::Handle;
use MIME::Base64;
use POSIX;
use Text::ParseWords;

our $VERSION = "@VERSION@";

our %C = ( etc		=> "@sysconfdir@",
	   sbin		=> "@sbindir@",
	   libexec	=> "@pkglibexecdir@",
	   bkp		=> "@bkplibexecdir@" );

###--------------------------------------------------------------------------
### Utilities.

our $EVAL = 0;
(our $QUIS = $0) =~ s:^.*/::;
sub whine ($) { my ($msg) = @_; print STDERR "$QUIS: $msg\n"; }
sub fail ($) {
  my ($msg) = @_;
  if ($EVAL) { die $msg . "\n"; }
  else { whine $msg; exit $! || ($? >> 8) || 255; }
}

sub try (&) { my ($body) = @_; local $EVAL = 1; &$body (); }

sub decodewait ($) {
  my ($rc) = @_;
  ## Return a string describing the process exit status RC.

  if (!$rc) { return "ok"; }
  elsif ($rc & 255) { return sprintf "signal %d", $rc & 127; }
  else { return sprintf "rc = %d", $rc >> 8; }
}

sub shellquote ($) {
  my ($word) = @_;
  ## Quotify WORD so that a shell won't mangle it.

  $word =~ s/'/'\\''/g;
  return "'" . $word . "'";
}

sub run ($@) {
  my ($what, @args) = @_;
  ## Run a program with ARGS, collecting and returning its output.

  open my $f, "-|", @args or fail "open pipe ($what): $!";
  chomp (my @out = <$f>);
  if (!close $f) {
    $? and fail "$what failed: " . decodewait $?;
    fail "close pipe ($what)";
  }
  return wantarray ? @out : $out[0];
}

sub now () {
  ## Report the current time.

  return strftime "%Y-%m-%d %H:%M:%S %z", localtime;
}

###--------------------------------------------------------------------------
### Parse command line.

our $USAGE = "usage: $QUIS [-n] [-a ASSET] [-c FILE] [KEY=VALUE ...]";
sub version { print "$QUIS, version $VERSION\n"; }
sub help {
  print <<EOF;
$USAGE

Options:
  -h, --help		Show this help text.
  -v, --version		Show the program version number.
  -a, --asset=ASSET	Back up ASSET, rather than all assets.
  -c, --config=FILE	Use configuration FILE, not $CONF.
  -n, --noact		Don't actually run the dump programs.
EOF
}

our $CONF = "$C{etc}/bkptab";
our @ASSET = ();
our $NOACT = 0;
GetOptions('help|h|?'		=> sub { version; help; exit; },
	   'version|v'		=> sub { version; exit; },
	   'asset|a=s'		=> \@ASSET,
	   'config-file|c=s'	=> \$CONF,
	   'noact|n'		=> \$NOACT)
  or do { print STDERR $USAGE, "\n"; exit 1; };

###--------------------------------------------------------------------------
### Parse the configuration file.

our %OVERRIDE = ();
our %SECMAP = ( CONFIG	=> sub {
		  my ($k, $v) = @_;
		  $C{$k} = $v unless $OVERRIDE{$k};
		} );

our %DUMP = ();
our @ORDER = ();
our %ASSET = map { $_ => 1 } @ASSET;

## Override configuration from the environment.
while (my ($e, $v) = each %ENV) {
  next unless $e =~ /^BKP_([_A-Za-z0-9]+)$/;
  (my $k = $1) =~ tr/_A-Z/-a-z/;
  $C{$k} = $v;
  $OVERRIDE{$k} = 1;
}

## Handy sub for extracting a configuration variable.
sub config ($) {
  my ($k) = @_;
  exists $C{$k} or fail "$CONF:$.: unknown config variable `$k'";
  return $C{$k};
}

## Parse the configuration file proper.
open CF, "<", $CONF or fail "open config ($CONF): $!";
my $kvfunc = $SECMAP{CONFIG};
while (my $line = <CF>) {

  ## Handle continuation lines and comments.
  chomp $line;
  while ($line =~ /\\\s*$/) {
    chomp (my $more = <CF>);
    $line =~ s/\\\s*$/$more/;
  }
  next if $line =~ /^\s*([#;]|$)/;

  if ($line =~ /^\s*\[\s*(\S.*\S|\S|)\s*\]\s*/) {
    ## Section header: set the kvfunc appropriately.

    if (exists $SECMAP{$1}) {
      $kvfunc = $SECMAP{$1};
    } elsif (!@ASSET || $ASSET{$1}) {
      my $asset = $1;
      if (!exists $DUMP{$asset}) {
	$DUMP{$asset} = [];
	push @ORDER, $asset;
      }
      $kvfunc = sub {
	my ($k, $v) = @_;
	push @{$DUMP{$asset}}, [$k, shellwords $v];
      }
    } else {
      $kvfunc = sub { };
    }
  } elsif ($line =~ /\s*(\S.*\S|\S)\s*[=:]\s*(\S.*\S|\S|)\s*$/) {
    ## Assignment line.  Process this according to the current kvfunc.

    my ($k, $v) = ($1, $2);
    $v =~ s/\$\{([^}]+)\}/config $1/ge;
    $kvfunc->($1, $2);
  } else {
    ## Something else: it's an error.

    fail "$CONF:$.: unrecognized line";
  }
}

## Done.
close CF or fail "close config ($CONF): $!";
@ORDER or fail "no matching assets to dump";

## Export the configuration.
while (my ($k, $v) = each %C) {
  next unless $k =~ /^[-A-Za-z0-9]+$/;
  (my $e = $k) = tr/-a-z/_A-Z/;
  $ENV{$k} = $v;
}

###--------------------------------------------------------------------------
### Establish a safe temporary directory.

sysopen RAND, "/dev/urandom", O_RDONLY or fail "open (random): $!";
my $win = 0;
our $TMPDIR;
for (my $i = 0; $i < 1000; $i++) {
  my $n = sysread RAND, my $buf, 12;
  if (!defined $n) { fail "read (random): $!"; }
  elsif ($n < 12) { fail "short read (random)"; }
  my $rand = encode_base64 $buf, "";
  $TMPDIR = ($ENV{TMPDIR} // "/tmp") . "/bkp.$$.$rand";
  $win = 1, last if mkdir $TMPDIR, 0700;
  fail "mkdir (tmp): $!" unless $! == ENOENT;
}
$win or fail "failed to make temp directory";
$ENV{BKP_TMPDIR} = $TMPDIR;
END { chdir "/"; system "rm", "-rf", $TMPDIR if defined $TMPDIR; }
close RAND;

chdir $TMPDIR or fail "chdir ($TMPDIR): $!";

###--------------------------------------------------------------------------
### Wade through the list of things to do, dumping assets.

sub bkpadmin ($@) {
  my ($op, @args) = @_;
  ## Invoke an administration operation.

  return run "bkpadmin $op",
    "ssh", $C{host},
    join " ", map { shellquote $_ } qw(userv root bkpadmin), $op, @args;
}

## Make sure there's a volume mounted.
bkpadmin "mount";

## Go through each asset dumping all of the tags.
for my $asset (@ORDER) {

  ## Start a log for this asset.
  if ($NOACT) {
    open LOG, ">&", STDERR or fail "dup stderr (log)";
  } else {
    open LOG, ">", "$asset.log" or fail "open ($asset.log): $!";
  }

  ## Find out when the last dump was done.
  my ($level, $date, $time, $tz) = split " ", bkpadmin "level", $asset;
  $ENV{BKP_LEVEL} = $level;
  $ENV{BKP_LASTDATE} = my $lastdate = "$date $time $tz";
  $ENV{BKP_ASSET} = $asset;

  ## Prepare the dump.
  unless ($NOACT) {
    my $target = bkpadmin "prep", $asset, $level;
    $ENV{BKP_TARGET} = $target;
  }

  ## Make sure we can dispose of the results if there's a Perl failure
  ## somewhere here.
  try {

    ## Start writing the log.
    printf LOG "%s: Commence dump of asset `%s' at level %d (since %s)\n",
      now, $asset, $level, $lastdate;

    ## Dump the individual tags.
    my $lose = 0;
    for my $dump (@{$DUMP{$asset}}) {
      my ($tag, $type, @args) = @$dump;

      ## Make a log note.
      printf LOG "%s: Dump tag `%s' (%s) begins\n", now, $tag, $type;
      flush LOG or fail "write ($asset.log): $!";

      ## Run the dump helper.
      if ($NOACT) { $? = 0; }
      else {
	defined (my $kid = fork) or fail "fork: $!";
	unless ($kid) {
	  open STDOUT, ">&", LOG and
	    open STDERR, ">&", LOG or
	      fail "dup: $!";
	  exec "$C{bkp}/bkp.$type", "$tag", @args;
	  fail "exec (bkp.$type): $!";
	}
	waitpid $kid, 0 or fail "waitpid: $!";
      }

      ## Deal with the aftermath.
      if ($?) {
	printf LOG "%s: Dump tag `%s' failed (%s)\n", now, $tag,
	  decodewait $?;
	printf STDERR "%s: %s: Dump asset `%s' tag `%s' FAILED\n",
	  $QUIS, now, $asset, $tag;
	$lose++;
      } elsif ($NOACT) {
	printf LOG "%s: Dump tag `%s' not performed (--noact)\n", now, $tag;
      } else {
	printf LOG "%s: Dump tag `%s' ok\n", now, $tag;
      }
    }

    ## Report completion of the asset.
    printf LOG "%s: Dump of asset `%s' completed %s\n", now, $asset,
      $lose == 0 ? "successfully" : "with $lose failures";
    error LOG and fail "write ($asset.log): $!";
    close LOG or fail "close ($asset.log): $!";

    ## Copy the log to the server and commit it.
    unless ($NOACT) {
      run "scp $asset.log",
	"scp", "$asset.log", "$C{host}:$target/$asset.log";
      bkpadmin $lose ? "fail" : "commit", $asset;
    }
  };

  ## If anything failed above, then try to mark the asset as a failure and
  ## abort.
  if ($@) {
    try { bkpadmin "fail", $asset; };
    fail $@;
  }
}

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