Strip redundant Emacs mode markers from Perl scripts.

[distorted-backup] / snap.rfreezefs.in

#! @PERL@
###
### Synchronize snapshot with remotely mounted filesystem
###
### (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 Socket;

###--------------------------------------------------------------------------
### Utilities.

(our $QUIS = $0) =~ s:^.*/::;
sub whine ($) { my ($msg) = @_; print STDERR "$QUIS: $msg\n"; }
sub fail ($) { my ($msg) = @_; whine $msg; exit $! || ($? >> 8) || 255; }

our @CLEANUP = ();
sub cleanup (&) { my ($func) = @_; unshift @CLEAUP, $func; }
END { local $?; for my $func (@CLEANUP) { &$func } }

sub gripelist ($@) {
  my ($gripe, @things) = @_;
  fail "$gripe: " . join(", ", @things) if @things;
}

###--------------------------------------------------------------------------
### Parse command line.

our $USAGE = "usage: $QUIS DEVICE [KEY=VALUE ...]";
sub version { print "$QUIS, version 1.0.0\n"; }
sub help {
  print <<EOF;
$USAGE

Option keys:
  dir=MOUNTPT		Mount point of filesystem on remote host [required].
  host=[USER@]NAME	Name or address of remote host [required].
  op=OPERATION		`snap' to create snapshot, or `unsnap' to remove.
  rfreezefs=PATH	Location of `rfreezefs' program on remote host.
  ssh=PATH		Location of remote-shell program on local host.
  subtype=TYPE		Type of snapshot to create [required].

Other option keys are passed to the underlying snapshot TYPE.
EOF
}
@ARGV >= 1 or do { print STDERR $USAGE, "\n"; exit 1; };
$ARGV[0] eq "-v" || $ARGV[0] eq "--version" and do { version; exit; };
$ARGV[0] eq "-h" || $ARGV[0] eq "--help" and do { version; help; exit; };

our $DEV = shift;
our %OPT = ( dir => undef,
	     host => undef,
	     op => "snap",
	     rfreezefs => "rfreezefs",
	     ssh => "ssh",
	     subtype => undef );
our @PASS = ();

for my $i (@ARGV) {
  $i =~ /^([^\s=]+)=(.*)$/ or fail "malformed option `$i'";
  my ($k, $v) = ($1, $2);
  if ($k =~ /^([^.]+)\.(.+)$/) {
    if ($2 eq "rfreezefs") { $k = $1; }
  }
  if (exists $OPT{$k}) { $OPT{$k} = $v; }
  else { push @PASS, $i; }
}
gripelist "missing arguments", grep { !defined $OPT{$_} } keys %OPT;

(my $host = $OPT{host}) =~ s/^.*@//;
my $addr = inet_aton $host or fail "failed to resolve `$OPT{host}'";

###--------------------------------------------------------------------------
### Remove a snapshot if requested.

if ($OPT{op} eq "unsnap") {

  ## This doesn't require negotiation with the remote end.
  if ($OPT{unsnap}) {
    exec "snap.$OPT{subtype}", $DEV, "op=unsnap", @PASS;
    fail "exec snap.$OPT{subtype}: $!";
  }

} elsif ($OPT{op} ne "snap") {
  fail "unknown operation `$OPT{op}'";
}

###--------------------------------------------------------------------------
### Run `rfreezefs' on the remote host and collect information.

(my $dir = $OPT{dir}) =~ s/\'/'\\''/g;
open SSH, "-|", $OPT{ssh}, $OPT{host}, "$OPT{rfreezefs} -n '$dir'"
  or fail "open(ssh): $!";
cleanup { close SSH };

our %INF = ( PORT => undef );
our %TOK = ();
our %RTOK = ();
our $PORT = undef;

while (<SSH>) {
  my @f = split;
  if ($f[0] eq "PORT") { $INF{$f[0]} = $f[1]; }
  elsif ($f[1] eq "TOKEN") { $TOK{$f[1]} = $f[2]; $RTOK{$f[2]} = $f[1]; }
  elsif ($f[0] eq "READY") { last; }
}

gripelist "missing information", grep { !defined $INF{$_} } keys %INF;
gripelist "missing tokens",
  grep { !exists $TOK{$_} } "FREEZE", "FROZEN", "THAW", "THAWED";

###--------------------------------------------------------------------------
### Create the snapshot.

## Connect to the socket.
socket SK, PF_INET, SOCK_STREAM, 0 or fail "socket: $!";
cleanup { close SK };
select SK; $| = 1;
connect SK, sockaddr_in($INF{PORT}, $addr) or fail "connect: $!";

## Communication with the server.
sub rffscmd ($;$) {
  my ($cmd, $rpl) = @_;
  print SK $TOK{$cmd}, "\n" or fail "write <$cmd>: $!";
  if ($rpl) {
    chomp (my $line = <SK>);
    if ($line ne $TOK{$rpl}) {
      my $what = exists $RTOK{$line} ? "<$RTOK{$line}>" : "`$line'";
      fail "unexpected response $what to <$cmd>";
    }
  }
}

## Freeze the remote filesystem.
rffscmd(FREEZE, FROZEN);

## Create the snapshot locally using the appropriate mechanism.  This will
## print the snapshot device name.
my $rc = system "snap.$OPT{subtype}", $DEV, @PASS;
$rc and fail "snap.$OPT{subtype} failed (rc = $rc)";

## Discard the snapshot again if anything goes wrong.
cleanup {
  if ($?) {
    my $rc = system "snap.$OPT{subtype}", $DEV, "unsnap", @PASS;
    $rc and
      whine "snap.$OPT{subtype} failed to unsnap (rc = $rc) " .
	"while recovering";
  }
};

## Thaw the remote filesystem.
rffscmd(THAW, THAWED);

###----- That's all, folks --------------------------------------------------

exit 0;