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