[distorted-backup] / bkp.in

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