#!/usr/bin/perl -w
use POSIX 'strftime';
use File::Temp 'tempdir';
use File::Basename;
use DateTime::Format::Strptime 'strptime'; # apt-get install libdatetime-format-strptime-perl
use IPC::Run qw(run);
use Carp;
use Sys::Hostname;

########################################################################
# usage is documented by the following code                            #
########################################################################
BEGIN {
use constant fsck_only => $0 =~ /.*\/,fsck-lvm-snapshots/;
sub usage {
  if ($0 =~ /fsck-lvm-snapshots/) {
    return "$0 [--usage]\n" .
	   "$0 <mountpoint> [mountpoint2 ...]\n";
  } elsif ($0 =~ /push-lvm-snapshots|push-snapshot/) {
    return
	   "$0 [--usage]\n" .
	   "$0 <dest>\n" .
	   "$0 [rsync-options] <source> <dest> [[rsync-options] <source2> <dest2> ...]\n";
  } else {
    return "bad command name: $0; try push-lvm-snapshots, push-snapshot, or fsck-lvm-snapshots";
  }
}
die usage if grep { /^--usage/ } @ARGV;
} # BEGIN
########################################################################

# TODO: getopt long options replace constants
# TODO: create all snapshots "simultaneously" before rsyncing -- if there's enough free space

use constant minimum_snapshot_size => 1000; # megs
use constant maximum_snapshot_size => 0.5; # multiple of LV size
use constant snapshot_time_format => "%F--%T";
use constant global_rsync_options => qw(-xa --fuzzy);
use constant log_file => undef;
use constant verbose => 0;
use constant default_remote_destination => 'hydra:/backup';
use constant hostname_of_script_author => 'bucky';

# die with a message showing command output on failure; otherwise return stdout
sub Run
{
  my @cmd = @_;
  warn "+ @cmd\n" if verbose;
  my ($w, $r, $e);
  run \@cmd, \$w, \$r, \$e;
  unless ($?) {
    # warn $e;
    return unless $r;
    return wantarray ? split /\n/, $r : $r;
  }

  my $msg = "$r$e";
  if ($msg) {
    $msg =~ s/\n*$/\n/ if $msg;
    $msg =~ s/^/  /gm if $msg;
    $msg = "\n\n$msg" if $msg;
  }

  my $short_cmd = @cmd > 1 ? $cmd[0] : (split ' ', $cmd[0], 2)[0];
  if    ($? < 0)   { die         "error executing command '$short_cmd': $!\n" }
  elsif ($? & 127) { die sprintf "command '$short_cmd' died with signal %d%s\n", $? & 127, $msg }
  elsif ($?)       { die         "command '$short_cmd' failed with exit status $?$msg\n"; }
}

sub System
{
  my @cmd = @_;
  warn "+ @cmd\n" if verbose;
  system(@cmd);
  my $short_cmd = @cmd > 1 ? $cmd[0] : (split ' ', $cmd[0], 2)[0];
  if    ($? < 0)   { die         "error executing command '$short_cmd': $!\n" }
  elsif ($? & 127) { die sprintf "command '$short_cmd' died with signal %d\n", $? & 127 }
  elsif ($?)       { die         "command '$short_cmd' failed with exit status $?\n"; }
}

sub pv_free
{
  my $pv_free = 0;
  $pv_free += $_ for qx(pvs --noheadings --nosuffix --units m -o pv_free);
  die "pvs: $?" if $?;
  $pv_free;
}

sub maxcount($)
{
  my ($dev, $fh) = (shift, undef);
  open $fh, '-|', qw(tune2fs -l), $dev or return 0;
  for (<$fh>) {
    if (m/^Maximum mount count:\s+(\d+)$/) {
      close $fh;
      return $1;
    }
  }
  close $fh;
  return 0;
}

sub mountpoint_info
{
  my $mountpoint = shift;
  $mountpoint =~ s{(?<=.)/+$}{};
  open MOUNTS, '</proc/mounts' or die $!;
  my %mountinfo = map { my @a = split / /; ($a[1], [@a[0,2]]) } <MOUNTS>;
  close MOUNTS;

  my ($dev, $fstype) = @{ $mountinfo{$mountpoint} };
  die "no device for mountpoint '$mountpoint'" unless $dev;
  while (-l $dev) {
    my $link = readlink $dev;
    if ($link =~ m#^/#) {
      $dev = $link;
    } else {
      $dev = dirname($dev) . "/$link";
    }
  }
  return ($dev, $fstype);
}

sub make_snapshot
{
  my $source_dev = shift;

  my $pv_free = pv_free;
  die "not enough free space: ${pv_free}m\n" unless $pv_free >= minimum_snapshot_size;

  my $lv_size = qx(lvs --noheadings  --nosuffix --units m -o lv_size $source_dev);
  die "lvs $source_dev: $?" if $?;

  my $snapshot_size = $pv_free > maximum_snapshot_size * $lv_size
		      ? maximum_snapshot_size * $lv_size
		      : $pv_free;

  my $lv_path = qx(lvs $source_dev --separator / --noheadings -o vg_name,lv_name);
  die "lvs: $?" if $?;
  chomp $lv_path;
  $lv_path =~ s/^\s+//;

  my $now = time;
  my $snapshot_name = basename($lv_path) . strftime("--snapshot--%F", localtime $now);
  Run(qw(lvcreate --snapshot --size), "${snapshot_size}m", '--name', $snapshot_name, $lv_path);

  return sprintf("/dev/%s/%s", dirname($lv_path), $snapshot_name), $now;
}

sub do_rsync
{
  return if fsck_only;
  my ($now, $source_dir, $backup_destination_dir, @rsync_options) = @_;
  my $backup_destination = $backup_destination_dir . strftime(snapshot_time_format, localtime $now);
  my @remote_listing = (Run 'rsync', $backup_destination_dir);
  die "backup destination not found: $backup_destination_dir\n" unless @remote_listing;
  my @existing_backups =
    map { $_->[1] }
    sort { $a->[0] <=> $b->[0] }
    grep { $_->[0] }
    map { my $time = 0; eval { $time = strptime(snapshot_time_format, $_) }; [$time, $_]; }
#   grep { m<^\d\d\d\d-\d\d-\d\d--\d\d:\d\d:\d\d$> } # no strptime :(
    map { chomp; my @f = split " ", $_, 5; $f[4] }
    grep { m<^d> }
    @remote_listing;

  push @rsync_options, "--link-dest=../$existing_backups[-1]" if @existing_backups;
  push @rsync_options, "--log-file=" . log_file if log_file;
  Run qw(rsync), global_rsync_options, @rsync_options, $source_dir, $backup_destination;
}

sub rsync_backup_lvm_snapshot
{
  my ($source, $backup_destination_dir, @rsync_options) = @_;
  s{/*$}{/} for $backup_destination_dir, $source; # want trailing /

  my ($source_dev, $fstype) = mountpoint_info $source;
  return unless $source_dev;

  my $rdev = ((stat $source_dev)[6]) or warn("stat $source_dev: $!"), return;
  if ($rdev >> 8 == 253) { # LVM volume

    my ($tempdir, $snapshot, $now);
    my %cleanup;
    undef $@;
    eval {
      ($snapshot, $now) = make_snapshot $source_dev;
      ++$cleanup{snapshot};
      $tempdir = tempdir(basename($snapshot) . ".XXXXXX", TMPDIR => 1);
      ++$cleanup{tempdir};
      if ($fstype =~ m/ext[234]/) {
	eval { Run qw(fsck -TVn), $snapshot; };
	if ($@) {
	  my $fsck_error = $@;
	  my $maxcount = maxcount $source_dev;
	  eval { Run qw(tune2fs -C), $maxcount + 1, $source_dev if $maxcount > 0 };
	  warn "$0: $fsck_error";
	  warn "$0: $@" if $@;
	} else {
	  eval { Run qw(tune2fs -T now -C 0), $source_dev };
	  warn "$0: $@" if $@;
	}
      }
      Run('mount', $snapshot, $tempdir);
      ++$cleanup{mount};
    };
    if ($@) {
      warn("$0: snapshotting partition $source failed: $@");
    } else {
      undef $@;
      eval { do_rsync($now, "$tempdir/", $backup_destination_dir, @rsync_options); };
      warn "$0: $@" if $@;
    }

    if ($cleanup{mount}) {
      undef $@; eval { Run 'umount', $tempdir };
      warn "$0: umount: $@" if $@;
    }
    if ($cleanup{snapshot}) {
      undef $@;
      eval { Run qw(lvremove -f), $snapshot };
      warn "$0: lvremove: $@" if $@;
    }
    if ($cleanup{tempdir}) {
      rmdir $tempdir or warn "$0: error removing directory '$tempdir': $!";
    }
  } else {
    # volume is not LVM; no snapshot
    undef $@;
    eval { do_rsync(time, $source, $backup_destination_dir, @rsync_options); };
    warn "$0: $@" if $@;
  }
}
sub fsck_lvm_snapshot($) { die unless fsck_only; rsync_backup_lvm_snapshot $_[0], '' }

my @non_option_arguments = grep { /^[^-]/ } @ARGV;
die usage unless @non_option_arguments;

if (fsck_only) {
  die usage if grep { /^-/ } @ARGV;
  fsck_lvm_snapshot $_ for @ARGV;
  exit;
}

my $remote_root;
if (@ARGV == 1) {
  my $remote_root = shift;
  $remote_root =~ s{/*$}{};
  die "invalid rsync target: $remote_root" unless $remote_root =~ m{^(?:root\@)[a-zA-Z][-a-zA-Z0-9]*:/};
}

# try all ext[234]|reiserfs mountpoints for LVM if the user specifies a destination but no sources 
my @backups;
if (@ARGV) {
  @backups = @ARGV;
} else {
  my $hostname = hostname;
  open MOUNTS, '</proc/mounts' or die $!;
  for (<MOUNTS>) {
    my @a = split / /;
    if ($a[2] =~ m/ext[234]|reiserfs/ and $a[1] ne '/tmp') {
      my $remote = $a[1] eq '/' ? '/root' : $a[1];
      $remote =~ s{^/}{$hostname-};
      $remote =~ y{/}{-};
      $remote = "$remote_root/$remote";
      push @backups, $a[1], $remote;
    }
  }
  close MOUNTS;
}

while (@backups >= 2) {
  my @opts;
  push @opts, shift @backups while @backups and $backups[0] =~ m/^-/;
  my ($source, $dest) = splice @backups, 0, 2;
  rsync_backup_lvm_snapshot $source, $dest, @opts;
}