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

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