#!/usr/bin/perl
#
# BackupPC_ovz
# Version: __appVersion__
#
# OpenVZ integration for BackupPC allowing the latter to backup OpenVZ VE's
# with ovz awareness to improve backup and restore efficiency and features.
#
# FIXME: signal handling to clean up mount point and snapshot on termination

use strict;
use Socket;
use File::Basename;
use File::Path;
#use IO::File;
use Proc::PID::File;

# Various constants
my @script_ext = qw(start stop mount umount);
my @velist = ();
my $pidfile = "/tmp/".basename($0).".pid";
my $vzsnap = 'vzsnap'; # Mount point and lv names.  Mount is relative to /.
my $snapsize = '25g';
my $hnlistFile = "/etc/backuppc/".basename($0).".hnlist";
my $velistFile = $ENV{HOME}."/log/".basename($0).".velist";

# Write to the debug file only if it is already present
my $dbgfn = "/tmp/BackupPC_ovz.debug";
my $dbgf;
if ( ! -f $dbgfn) {
  $dbgfn = "/dev/null";
}
open $dbgf, ">>$dbgfn" || die "Cannot open debug file $dbgfn";

sub mydie($)
{
  my ($text) = @_;

  print $dbgf ": die $text\n";
  die $text;
}

sub cmdExecOrEval
{
  my($cmd, @args) = @_;
  
  if ( (ref($cmd) eq "ARRAY" ? $cmd->[0] : $cmd) =~ /^\&/ ) {
    $cmd = join(" ", $cmd) if ( ref($cmd) eq "ARRAY" );
    eval($cmd);
    print(STDERR "Perl code fragment for exec shouldn't return!!\n");
    exit(1);
  } else {
    $cmd = [split(/\s+/, $cmd)] if ( ref($cmd) ne "ARRAY" );
    print $dbgf ": execing command $cmd\n";
    alarm(0);
    $cmd = [map { m/(.*)/ } @$cmd];	# untaint
    #
    # force list-form of exec(), ie: no shell even for 1 arg
    #
    exec { $cmd->[0] } @$cmd;
    print(STDERR "Exec failed for @$cmd\n");
    exit(1);
  }
}

# FIXME: this guy sometimes needs to use /dev/null as stdin, stdout and stderr
# so that it doesn't pollute the stream back to the backup server.
sub cmdSystemOrEval
{
  my($cmd, @args) = @_;
  
  $? = 0;
  $cmd = join(" ", $cmd) if ( ref($cmd) eq "ARRAY" );
  if ( (ref($cmd) eq "ARRAY" ? $cmd->[0] : $cmd) =~ /^\&/ ) {
    print $dbgf ": evaluating command $cmd\n";
    eval($cmd);
  } else {
    print $dbgf ": running command $cmd\n";
    system($cmd);
  }
}

# To be called by the BackupPC server in a preuser script.  These are the
# actions that if attempting in-line with a backup -- that is as part of the
# client invocation -- will cause the backup to hang indefinitely.
sub refreshConfig()
{
  # Write the VEs on all HNs to a config file on the BackupPC server for
  # later use.
  my @HNS = ();

  print $dbgf ": refreshConfig\n";
  open my $cfg, "<$hnlistFile" || mydie "Cannot read $hnlistFile";
  while (<$cfg>) {
    chomp;
    push(@HNS, split(' ')) if (! /^#/);
  }
  close($cfg);
  mydie "No HNs defined in $hnlistFile" if ($#HNS < 0);

  open my $out, ">$velistFile" || mydie "Cannot write to $velistFile";
  foreach my $hn (@HNS) {
    open my $fh, "ssh -l root $hn vzlist -a |" ||
	mydie "Can run remote vzlist command";
    while (<$fh>) {
      chomp;
      my ($veid, $junk, $running, $junk, $hostname) = split(' ');
      if ($veid =~ /[0-9]+/ && $hostname ne '-') {
	if ($running eq "running") {
	  $running = 1;
	} else {
	  $running = 0;
	}
	print $out "$hostname,$veid,$hn,$running\n";
      }
    }
    close($fh);
  }
  close($out);

  # Copy the script to the HNs
  my $remoteCmd = "/usr/bin/".basename($0);
  foreach my $hn (@HNS) {
    my $cmd = "rsync -aq -e ssh $0 root\@$hn:$remoteCmd";
    #print "Executing '$cmd'\n";
    cmdSystemOrEval($cmd);
  }
}

# For use on the BackupPC server.
sub loadVeList()
{
  open my $fh, "<$velistFile" ||
      mydie "Cannot read from $velistFile. Set a preuser script.";

  while (<$fh>) {
    chomp;
    my ($hostname, $veid, $host, $running) = split(',');
    push(@velist, {
      "hostname" => $hostname,
      "VEID" => $veid,
      "HN" => $host,
      "running" => $running
    });
  }
  close($fh);
}

# For use on the HN.  Derive the VE record from its VEID.
sub localVe($)
{
  my ($veid) = @_;
  mydie "HN: no veid" if (!defined($veid));

  my $vzdir = '/etc/vz';
  mydie "HN is not running OpenVZ" if (!defined($vzdir));

  my $lockdir = undef;
  my $dumpdir = undef;
  my $private = undef;
  my $root = undef;
  open my $fh, "<$vzdir/vz.conf" || mydie "Cannot open $vzdir/vz.conf";
  while (<$fh>) {
    chomp;
    my ($name, $value) = split('=');
    if ($name eq 'LOCKDIR') {
      $lockdir = $value;
      mydie "OpenVZ LOCKDIR ($lockdir) is invalid" if (! -d $lockdir);
    } elsif ($name eq 'DUMPDIR') {
      $dumpdir = $value;
      mydie "OpenVZ DUMPDIR ($dumpdir) is invalid" if (! -d $dumpdir);
    } elsif ($name eq 'VE_PRIVATE') {
      $private = $value;
    } elsif ($name eq 'VE_ROOT') {
      $root = $value;
    }
  }
  close($fh);

  my $confdir = "$vzdir/conf";
  mydie "OpenVZ conf dir ($confdir) not found" if (! -d $confdir);

  my $hostname = undef;
  my $conffile = "$confdir/$veid.conf";
  open $fh, "<$conffile" || mydie "Cannot open $conffile";
  while (<$fh>) {
    chomp;
    my ($name, $value) = split('=');
    $private = $value if ($name eq 'VE_PRIVATE');
    $root = $value if ($name eq 'VE_ROOT');
    if ($name eq 'HOSTNAME') {
      $value =~ s/"//g;
      $hostname = gethostbyaddr(gethostbyname($value), AF_INET);
    }
  }
  close($fh);

  $private =~ s/"//g;
  $private =~ s|/\$VEID|/$veid|g;
  mydie "VE_PRIVATE is not defined" if (!defined($private));
  mydie "VE $veid private dir ($private) not found" if (! -d $private);

  $root =~ s|/\$VEID|/$veid|g;
  $root =~ s/"//g;
  mydie "VE_ROOT is not defined" if (!defined($root));
  mydie "VE $veid root dir ($root) not found" if (! -d $root);

  mydie "VE $veid has no HOSTNAME" if (!defined($hostname));

  my $status = `vzctl status $veid`;
  my $running = 0;
  $running = 1 if ($status =~ /running/);

  return {
    "vzdir" => $vzdir,
    "lockdir" => $lockdir,
    "dumpdir" => $dumpdir,
    "confdir" => $confdir,
    "conffile" => $conffile,
    "private" => $private,
    "root" => $root,
    "hostname" => $hostname,
    "VEID" => $veid,
    "running" => $running
  };
}

sub getVeEntry($$)
{
  my ($field, $arg) = @_;
  for (my $i = 0; $i <= $#velist; $i++) {
    my $ve = ${\$velist[$i]};
    return $ve if ($ve->{$field} eq $arg);
  }
  return undef;
}

sub getVeByHostname($)
{
  my ($host) = @_;

  my $hostname = gethostbyaddr(gethostbyname($host), AF_INET);
  mydie "Host $host not found" if (!defined($hostname));

  my $ve = getVeEntry('hostname', $hostname);
  mydie "Host $hostname is not a VE" if (!defined($ve));
  return $ve;
}

sub getVeEntries($$)
{
  my ($field, $host) = @_;
  my @entries;

  for (my $i = 0; $i <= $#velist; $i++) {
    my $ve = ${\$velist[$i]};
    push(@entries, $ve) if ($ve->{$field} eq $host);
  }
  return @entries;
}

sub printVeEntry($)
{
  my ($ve) = @_;

  mydie "No VE to print" if (!defined($ve));
  print STDERR '{   ';
  #foreach my $k (keys %{$velist[0]}) {
  foreach my $k (keys %{$ve}) {
    print STDERR $k.' => '.$ve->{$k}."\n  ";
  }
  print STDERR "}\n";
}

sub delSnapshot($)
{
  my ($ve) = @_;
  print $dbgf ": delSnapshot\n";
  mydie "No VE record for delSnapshot" if (!defined($ve));

  #print "delSnapshot: doing nothing for now\n";
  #printVeEntry($ve);
  #return;

  my $dir = $ve->{'snaproot'};
  if (defined($dir) && -d $dir) {
    #cmdSystemOrEval("rm -rf $dir/etc/vzdump");
    print $dbgf ": delSnapshot snapshot mounted at $dir\n";
    cmdSystemOrEval("umount $dir");
    cmdSystemOrEval("rmdir $dir");
  }

  my $dev = $ve->{'snapdev'};
  #cmdSystemOrEval("lvremove -f $dev >/dev/null 2>&1") if (-b $dev);
  if (-b $dev) {
    print $dbgf ": removing LV $dev\n";
    system("lvremove -f $dev >>$dbgfn 2>&1")
  } else {
    print $dbgf ": lvremove: $dev is not block special\n";
  }
}

sub getDevice($)
{
  my ($dir) = @_;

  open my $fh, "df -P '$dir'|" || mydie "Unable to exec df";
  <$fh>; # skip header
  my $df = <$fh>;
  close($fh);
  chomp($df);
  my ($dev, $junk, $junk, $junk, $junk, $mpoint) = split (/\s+/, $df);

  my $vg = undef;
  my $lv = undef;
  open $fh, "lvscan|" || mydie "Unable to exec lvscan";
  while (my $line = <$fh>) {
    if ($line =~ m|^\s+ACTIVE\s+\'/dev/([^/]+)/([^\']+)\'\s|) {
      # vg is $1, lv is $2
      if ($dev eq "/dev/$1/$2" || $dev eq "/dev/mapper/$1-$2") {
	$vg = $1;
	$lv = $2;
      }
    }
  }
  close($fh);

  mydie "Device $dev has no LVM entry for volume group" if (!defined($vg));
  mydie "Device $dev has no LVM entry for logical volume" if (!defined($lv));
  return ($dev, $mpoint, $vg, $lv);
}

sub makeSnapshot($)
{
  my ($ve) = @_;
  mydie "No VE record for snapshot" if (!defined($ve));

  my ($dev, $lvmpath, $vg, $lv) = getDevice($ve->{'private'});
  #print "snapshot: dev=$dev, lvmpath=$lvmpath, vg=$vg, lm=$lv\n";
  mydie "Can't find device for VE filesystem" if (!defined($dev));

  my $snaproot = "/$vzsnap";

  mkpath "$snaproot" ||
      mydie "Can't create snapshot directory (backup in progress?)";
  $ve->{'snaproot'} = $snaproot;

  my $snapdev = "/dev/$vg/$vzsnap";
  mydie "Snapshot dev $snapdev exists (backup in progress?)" if (-b $snapdev);
  # FIXME: xfs_freeze hangs; without it we are likely to fail at some point.
  # FIXME: finding the mount point instead of hard coding.
  #cmdSystemOrEval("xfs_freeze -f /var/lib/vz/private");
  cmdSystemOrEval("lvcreate --size $snapsize --snapshot --name $vzsnap /dev/$vg/$lv >/dev/null 2>&1");
  #cmdSystemOrEval("xfs_freeze -u /var/lib/vz/private");
  if (! -b $snapdev) {
    delSnapshot($ve);
    mydie "Failed to create snapshot device"
  }
  $ve->{'snapdev'} = $snapdev;
  cmdSystemOrEval("mount -o noatime,nodiratime $snapdev $snaproot");

  my $snapprivate = $ve->{'private'};
  $snapprivate =~ s|/?$lvmpath/?|/$vzsnap/|;
  #print "snapshot: snapprivate = $snapprivate\n";
  if ($snapprivate !~ /$vzsnap/ || ! -d $snapprivate) {
    delSnapshot($ve);
    mydie "Wrong lvm mount point $lvmpath";
  }
  $ve->{'snapprivate'} = $snapprivate;

  if (! -d "/$snapprivate/etc") {
    delSnapshot($ve);
    mydie "Mount failure or filesystem doesn't belong to a VE";
  }
}

sub saveConfigs($)
{
  my ($ve) = @_;
  mydie "No VE record for saveConfigs" if (!defined($ve));

  # Copy configuration and other scripts belonging to VE into VE's snapshot.
  # Do this in a manner similar to that supported by vzdump for consistency.
  my $snapprivate = $ve->{'snapprivate'};
  mkpath "$snapprivate/etc/vzdump";
  my $conffile = $ve->{'conffile'};
  cmdSystemOrEval("cp $conffile $snapprivate/etc/vzdump/vps.conf");
  foreach my $ext (@script_ext) {
    my $fn = $ve->{'confdir'}."/".$ve->{'VEID'}.".$ext";
    cmdSystemOrEval("cp $fn $snapprivate/etc/vzdump/vps.$ext") if (-f $fn);
  }
}

# Because of the complexities involved with restoring VE configuartions and
# knowing when and how to do so, this feature is not currently implemented.
sub restoreConfigs($)
{
  my ($ve) = @_;
  mydie "No VE record for restoreConfigs" if (!defined($ve));

  my $private = $ve->{'private'};
  mydie "Can't restore invalid private dir $private" if (! -d $private);
  my $qprivate = $private;
  $qprivate =~ s|/|\\\/|g;
  $qprivate =~ s|/$ve->{'VEID'}$|/\$VEID|;

  my $root = $ve->{'root'};
  mydie "Can't restore invalid root dir $root" if (! -d $root);
  my $qroot = $root;
  $qroot =~ s|/|\\\/|g;
  $qroot =~ s|/$ve->{'VEID'}$|/\$VEID|;

  my $conffile = $ve->{'conffile'};
  my $cmd = "sed -e 's/VE_ROOT=.*/VE_ROOT=\\\"$qroot\\\"/' -e 's/VE_PRIVATE=.*/VE_PRIVATE=\\\"$qprivate\\\"/'  <'$private/etc/vzdump/vps.conf' >'$conffile'";
  cmdSystemOrEval($cmd);

  foreach my $s (@script_ext) {
    my $cfgdir = $ve->{'confdir'};
    my $src = $ve->{'private'}."/etc/vzdump/vps.$s";
    my $dest = "$cfgdir/".$ve->{'VEID'}.".$s";
    cmdSystemOrEval("mv '$src' '$dest'") if (-f $src);
  }

  rmtree "$private/etc/vzdump";

  # FIXME: on error, if there was no private dir to start, we should
  # remove everything we added.?
}

sub checkRunningClient()
{
  print $dbgf ": checkRunningClient, vzsnap=$vzsnap\n";
  mydie "A backup or restore operation are already in progress"
    if (Proc::PID::File->running({ dir => '/tmp', verify => 1 }));

  # Clean up any prior backup's mount point and snapshot, if it exists.
  # Note that the snapshot is small, so we don't really want it lying around!
  # There are cases where the snapshot will not show as a snapshot, and in
  # these cases the LV will not be removed by this function.
  my $vg = undef;
  open my $fh, "lvscan|" || mydie "Unable to exec lvscan";
  while (my $line = <$fh>) {
    #print $dbgf ": checkRunningClient lvscan line=$line\n";
    if ($line =~ m|^\s+ACTIVE\s+Snapshot\s+\'/dev/([^/]+)/$vzsnap\'\s|) {
      $vg = $1;
      #print $dbgf ": checkRunningClient vg=$vg\n";
    }
  }
  close($fh);
  if (defined($vg)) {
    my $dev = "/dev/mapper/$vg-$vzsnap";
    print $dbgf ": found vzsnap lv $dev\n";
    cmdSystemOrEval("umount /$vzsnap");
    cmdSystemOrEval("rmdir /$vzsnap") if (-d "/$vzsnap");
    #cmdSystemOrEval("lvremove -f $dev >/dev/null 2>&1") if (-b $dev);
    system("lvremove -f $dev >>$dbgfn 2>&1") if (-b $dev);
  }
}

sub runPing()
{
  # This command generates ping output by pinging the host specified in the
  # ping command still within @ARGV.  However, if the host listed therein is
  # a VE, the HN must be pinged instead.

  # Get the host
  my $host = shift(@ARGV);
  my $cmd = join(' ', @ARGV);

  print $dbgf ": runPing host=$host, cmd=$cmd\n";
  # Find $host in the list of VEs
  loadVeList();
  my $hostname = gethostbyaddr(gethostbyname($host), AF_INET);
  mydie "Host $host not found" if (!defined($hostname));
  my $ve = getVeEntry('hostname', $hostname);
  if (defined($ve)) {
    $hostname = $ve->{'HN'};
    mydie "HN is undefined for host $host" if (!defined($hostname));
    $cmd =~ s/$host/$hostname/g;
    print $dbgf ": ping request for $host remapped to HN $hostname\n";
  }

  cmdExecOrEval($cmd);
}

sub runClient($)
{
  my ($restore) = @_;

  print $dbgf ": runClient restore=$restore\n";
  checkRunningClient();

  my $veid = shift(@ARGV);
  mydie "HN needs a VEID argument" if (!defined($veid));
  mydie "HN: no command to execute after VEID" if ($#ARGV < 0);

  # We (the HN where this code is running) must be hosting the requested VE.
  my $ve = localVe($veid);
  mydie "VE $veid not found on this HN" if (!defined($ve));
  #printVeEntry($ve);

  if (!$restore) {
    cmdSystemOrEval("vzctl stop $veid >/dev/null 2>&1") if ($ve->{'running'});
    makeSnapshot($ve);
    cmdSystemOrEval("vzctl start $veid >/dev/null 2>&1") if ($ve->{'running'});
    mydie "Failed to make snapshot of filesystem for VE $veid"
	if (!defined($ve->{'snaproot'}));

    # Save the VE configuration from its hosted HN into the filesystem.  If
    # /etc is backed up, so will the VE configuration.
    saveConfigs($ve);

    # Make and exec the backup command.  Do it in a chroot to the snapshot
    # of the VEs root dir so that any relative path information in the
    # backup command is accurate.  This does mean that each VE needs rsync,
    # etc.
    my $cmd = "chroot ".$ve->{'snapprivate'}." ".join(' ', @ARGV);
    #print "HN: cmd |$cmd|\n";
    $? = 0;
    cmdSystemOrEval($cmd);
    my $ret = $?; # FIXME - modify cmdSystemOrEval to get a return value.

    # Remove snapshot, we're done
    delSnapshot($ve);

    print $dbgf ": runClient complete\n";

    # Pass the return code back
    #exit $ret; FIXME: currently, cmdSystemOrEval doesn't return a retcode.
    exit 0;
  } else {
    # Restores work off the VE's live root filesystem.  A full restore
    # should be done to the HN host, redirecting the restore to the VE's
    # private directory on the HN when the VE is stopped.
    my $cmd = "chroot ".$ve->{'private'}." ".join(' ', @ARGV);
    #print "HN: cmd |$cmd|\n";
    # A restore can exec, because we have no cleanup to do.
    cmdExecOrEval($cmd);
  }
}

sub runServer($)
{
  my ($restore) = @_;
  my $host = shift(@ARGV);

  print $dbgf ": runServer restore=$restore, host=$host\n";
  mydie "Hostname argument required" if (!defined($host));
  mydie "No command to execute after hostname" if ($#ARGV < 0);

  # Find $host in the list of VEs
  loadVeList();
  my $ve = getVeByHostname($host);
  mydie "$host is not a VE or list of HNs in $0 is wrong" if (!defined($ve));
  #printVeEntry($ve);

  # The client command is bisected by the next occurrence of $host. Everything
  # before is the ssh command to reach the client and everything after is the
  # xfer command sent to the client via ssh.
  my @sshCmd;
  my @xferCmd;
  my $foundHost = 0;
  foreach my $arg (@ARGV) {
    if ($arg eq $host) {
      $foundHost = 1;
    } else {
      if ($foundHost) {
	push(@xferCmd, $arg);
      } else {
	push(@sshCmd, $arg);
      }
    }
  }
  mydie "No ssh command found" if ($#sshCmd < 0);
  mydie "No xfer command found" if ($#xferCmd < 0);
  #print "ssh command: |".join(' ', @sshCmd)."|\n";
  #print "xfer command: |".join(' ', @xferCmd)."|\n";

  # Create the command line to initiate the client side of the backup.  We
  # contact the HN hosting the VE and run an invocation of this script there
  # to perform the required operations for VE backup or restore.
  my $cmd;
  $cmd = join(' ', @sshCmd)." ".$ve->{'HN'}." /usr/bin/".basename($0)." ".
      ($restore ? "restore " : "").$ve->{'VEID'}." ".join(' ', @xferCmd);
  #print "remote command: |$cmd|\n";
  cmdExecOrEval($cmd);
}

## MAIN

# Determine how to run this script.  Each option is valid by itself.  Only the
# options server and restore may be seen together.
my $server = 0;
if ($ARGV[0] eq "server") {
  shift(@ARGV);
  $server = 1;
}

my $refresh = 0;
if ($ARGV[0] eq "refresh") {
  shift(@ARGV);
  $refresh = 1;
}

my $restore = 0;
if ($ARGV[0] eq "restore") {
  shift(@ARGV);
  $restore = 1;
  #print "Restore mode\n";
}

my $ping  = 0;
if ($ARGV[0] eq "ping") {
  shift(@ARGV);
  $ping = 1;
  #print "Ping mode\n";
}

print $dbgf ": server=$server, refresh=$refresh, restore=$restore ping=$ping";
print $dbgf " on ".`date`;
if ($server) {
  runServer($restore);
} elsif ($refresh) {
  refreshConfig();
} elsif ($ping) {
  runPing();
} else {
  runClient($restore);
}