chiark - git - mdw - distorted-backup/blob - snap.in

   1 #! @PERL@
   2 ###
   3 ### Create and remove snapshots of block devices
   4 ###
   5 ### (c) 2011 Mark Wooding
   6 ###
   7
   8 ###----- Licensing notice ---------------------------------------------------
   9 ###
  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
  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 ###
  17 ### distorted-backup is distributed in the hope that it will be useful,
  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 ###
  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,
  24 ### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  25
  26 use Getopt::Long qw(:config gnu_compat bundling no_ignore_case);
  27 use Text::ParseWords;
  28
  29 our $VERSION = "@VERSION@";
  30
  31 our %C = ( etc          => "@sysconfdir@",
  32            sbin         => "@sbindir@",
  33            snap         => "@snaplibexecdir@" );
  34
  35 ###--------------------------------------------------------------------------
  36 ### Utilities.
  37
  38 (our $QUIS = $0) =~ s:^.*/::;
  39 sub whine ($) { my ($msg) = @_; print STDERR "$QUIS: $msg\n"; }
  40 sub fail ($) { my ($msg) = @_; whine $msg; exit $! || ($? >> 8) || 255; }
  41
  42 ###--------------------------------------------------------------------------
  43 ### Parse command line.
  44
  45 our $USAGE = "usage: $QUIS [-u] [-c FILE] DEVICE [KEY=VALUE ...]";
  46 sub version { print "$QUIS, version $VERSION\n"; }
  47 sub help {
  48   print <<EOF;
  49 $USAGE
  50
  51 Options:
  52   -h, --help            Show this help text.
  53   -v, --version         Show the program version number.
  54   -c, --config=FILE     Use configuration FILE, not $CONF.
  55   -n, --no-act          Don't actually do anything; show what would be done.
  56   -u, --unsnap          Remove a snapshot taken earlier.
  57 EOF
  58 }
  59
  60 our $CONF = "$C{etc}/snaptab";
  61 our $OP = "snap";
  62 our $NOACT = 0;
  63 GetOptions('help|h|?'           => sub { version; help; exit; },
  64            'version|v'          => sub { version; exit; },
  65            'config-file|c=s'    => \$CONF,
  66            'no-act|n'           => \$NOACT,
  67            'unsnap|u'           => sub { $OP = "unsnap"; })
  68   and @ARGV >= 1
  69   or do { print STDERR $USAGE, "\n"; exit 1; };
  70
  71 our $DEV = shift;
  72 our $TYPE = undef;
  73
  74 ###--------------------------------------------------------------------------
  75 ### Parse the configuration file.
  76
  77 open CF, "<", $CONF or fail "open config ($CONF): $!";
  78 our @KV = ();
  79 our %DEF = ();
  80 while (my $line = <CF>) {
  81   chomp $line;
  82   while ($line =~ /\\\s*$/) {
  83     chomp (my $more = <CF>);
  84     $line =~ s/\\\s*$/$more/;
  85   }
  86   next if $line =~ /^\s*(\#|$)/;
  87   my ($dev, $type, @opts) = shellwords $line;
  88   my @nopts = ();
  89   for my $i (@opts) {
  90     if ($i !~ /^\*\.(.+)$/) { push @nopts, $i; next; }
  91     my $ty = $1;
  92     for my $o (@{$DEF{$ty}}) {
  93       $o =~ /^([^=]+)=(.*)$/;
  94       my ($k, $v) = ($1, $2);
  95       ($k, $ty) = ($1, $2) if $k =~ /^(.+)\.([^.]+)/;
  96       push @nopts, "$k.$ty=$v";
  97     }
  98   }
  99   @opts = @nopts;
 100   if ($dev eq "*") { push @{$DEF{$type}}, @opts; }
 101   elsif ($dev eq $DEV) { push @KV, "type=$type", @{$DEF{$type}}, @opts; }
 102 }
 103 close CF or fail "close config ($CONF): $!";
 104
 105 ###--------------------------------------------------------------------------
 106 ### Pick out the winning options.
 107
 108 our @OPT = ();
 109 my $seen = ();
 110
 111 for my $i (reverse @KV, "op=$OP", @ARGV) {
 112   $i =~ /^([^=]+)=(.*)$/ or fail "malformed option `$i': missing `='";
 113   my ($k, $v) = ($1, $2);
 114   unless (exists $seen{$k}) {
 115     $seen{$k} = 1;
 116     if ($k eq "type") { $TYPE = $v; }
 117     else { push @OPT, "$k=$v"; }
 118   }
 119 }
 120
 121 defined $TYPE or fail "no snapshot type for device `$DEV'";
 122 @OPT = reverse @OPT;
 123
 124 ###--------------------------------------------------------------------------
 125 ### Invoke the type-specific handler.
 126
 127 ## Fix up the path, to make sure our tools are available.
 128 my $path = $ENV{PATH};
 129 my %path = map { $_ => 1 } split /:/, $path;
 130 for my $p (qw( /bin /sbin /usr/bin /usr/sbin ), $C{sbin}) {
 131   $path = "$p:$path" unless exists $path{$p};
 132 }
 133 $ENV{PATH} = $path;
 134
 135 ## Prepare the arguments.
 136 my @args = ("$C{snap}/snap.$TYPE", $DEV, @OPT);
 137
 138 ## Do the job.
 139 if ($NOACT) {
 140   whine "run " . join(" ",
 141                       map { "`$_'" }
 142                       grep { s/'/\\'/g; 1 }
 143                       (my @x = @args));
 144 } else {
 145   exec @args;
 146   fail "exec (snap.$TYPE): $!";
 147 }
 148
 149 ###----- That's all, folks --------------------------------------------------
 150
 151 exit 0;