#! @PERL@ ### ### Create and remove snapshots of block devices ### ### (c) 2011 Mark Wooding ### ###----- Licensing notice --------------------------------------------------- ### ### This file is part of the distorted.org.uk backup suite. ### ### distorted-backup 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. ### ### distorted-backup 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 distorted-backup; if not, write to the Free Software Foundation, ### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. use Getopt::Long qw(:config gnu_compat bundling no_ignore_case); use Text::ParseWords; our $VERSION = "@VERSION@"; our %C = ( etc => "@sysconfdir@", sbin => "@sbindir@", snap => "@snaplibexecdir@" ); ###-------------------------------------------------------------------------- ### Utilities. (our $QUIS = $0) =~ s:^.*/::; sub whine ($) { my ($msg) = @_; print STDERR "$QUIS: $msg\n"; } sub fail ($) { my ($msg) = @_; whine $msg; exit $! || ($? >> 8) || 255; } ###-------------------------------------------------------------------------- ### Parse command line. our $USAGE = "usage: $QUIS [-u] [-c FILE] DEVICE [KEY=VALUE ...]"; sub version { print "$QUIS, version $VERSION\n"; } sub help { print < sub { version; help; exit; }, 'version|v' => sub { version; exit; }, 'config-file|c=s' => \$CONF, 'no-act|n' => \$NOACT, 'unsnap|u' => sub { $OP = "unsnap"; }) and @ARGV >= 1 or do { print STDERR $USAGE, "\n"; exit 1; }; our $DEV = shift; our $TYPE = undef; ###-------------------------------------------------------------------------- ### Parse the configuration file. open CF, "<", $CONF or fail "open config ($CONF): $!"; our @KV = (); our %DEF = (); while (my $line = ) { chomp $line; while ($line =~ /\\\s*$/) { chomp (my $more = ); $line =~ s/\\\s*$/$more/; } next if $line =~ /^\s*(\#|$)/; my ($dev, $type, @opts) = shellwords $line; my @nopts = (); for my $i (@opts) { if ($i !~ /^\*\.(.+)$/) { push @nopts, $i; next; } my $ty = $1; for my $o (@{$DEF{$ty}}) { $o =~ /^([^=]+)=(.*)$/; my ($k, $v) = ($1, $2); ($k, $ty) = ($1, $2) if $k =~ /^(.+)\.([^.]+)/; push @nopts, "$k.$ty=$v"; } } @opts = @nopts; if ($dev eq "*") { push @{$DEF{$type}}, @opts; } elsif ($dev eq $DEV) { push @KV, "type=$type", @{$DEF{$type}}, @opts; } } close CF or fail "close config ($CONF): $!"; ###-------------------------------------------------------------------------- ### Pick out the winning options. our @OPT = (); my $seen = (); for my $i (reverse @KV, "op=$OP", @ARGV) { $i =~ /^([^=]+)=(.*)$/ or fail "malformed option `$i': missing `='"; my ($k, $v) = ($1, $2); unless (exists $seen{$k}) { $seen{$k} = 1; if ($k eq "type") { $TYPE = $v; } else { push @OPT, "$k=$v"; } } } defined $TYPE or fail "no snapshot type for device `$DEV'"; @OPT = reverse @OPT; ###-------------------------------------------------------------------------- ### Invoke the type-specific handler. ## Fix up the path, to make sure our tools are available. my $path = $ENV{PATH}; my %path = map { $_ => 1 } split /:/, $path; for my $p (qw( /bin /sbin /usr/bin /usr/sbin ), $C{sbin}) { $path = "$p:$path" unless exists $path{$p}; } $ENV{PATH} = $path; ## Prepare the arguments. my @args = ("$C{snap}/snap.$TYPE", $DEV, @OPT); ## Do the job. if ($NOACT) { whine "run " . join(" ", map { "`$_'" } grep { s/'/\\'/g; 1 } (my @x = @args)); } else { exec @args; fail "exec (snap.$TYPE): $!"; } ###----- That's all, folks -------------------------------------------------- exit 0;