#!/usr/bin/perl -w
#
#    Copyright (C) 2007-2008 Proxmox Server Solutions GmbH
#
#    Copyright: vzdump is under GNU GPL, the GNU General Public License.
#
#    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; version 2 dated June, 1991.
#
#    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., 51 Franklin St, Fifth Floor, Boston,
#    MA 02110-1301, USA.
#
#    Author: Dietmar Maurer <dietmar@proxmox.com>
#

use strict;
use Getopt::Long;
use Fcntl ':flock';
use Sys::Syslog;
use File::Path;
use File::Basename;
use IO::File;
use IO::Select;
use IPC::Open3;
use POSIX qw(strftime);

my $opt_all;
my $opt_exclude;
my $opt_exclude_path;
my $opt_quiet;
my $opt_dumpdir;
my $opt_compress = 0;
my $opt_restore;
my $opt_mailto;
my $opt_stop;
my $opt_suspend;
my $opt_snap;
my $opt_node;
my $opt_tmpdir;
my $opt_bwlimit;
my $opt_lockwait;
my $opt_stopwait;
my $opt_snapsize;
my $opt_stdexcludes;

my $stopmode = '';

my $vzctl = 'vzctl';
my $qmctl = 'qm';
my $rsync = 'rsync';
my $lvcreate = 'lvcreate';
my $lvs = 'lvs';
my $lvremove = 'lvremove';
my $sendmail = 'sendmail';
my $pveca = 'pveca';
my $cpcmd = 'cp';

my $vzdir = '/etc/vz';
my $qmdir = '/etc/qemu-server';

my $logdir = '/var/log/vzdump';
my $lockfile = '/var/run/vzdump.lock';

my @script_ext = qw (start stop mount umount);

my $cmdline = join (' ', 'vzdump', @ARGV);

openlog ('vzdump', 'cons,pid', 'daemon');

# by default we set --rsyncable for gzip
$ENV{GZIP} = "--rsyncable" if !$ENV{GZIP};

my $debugstattxt = {
    err =>  'ERROR:',
    info => 'INFO:',
    warn => 'WARN:',
};

# helper functions

sub debugmsg {
    my ($mtype, $msg, $logfd, $syslog) = @_;

    chomp $msg;

    return if !$msg;

    my $pre = $debugstattxt->{$mtype} || $debugstattxt->{'err'};

    my $tstr = strftime ("%b %d %H:%M:%S", localtime);

    syslog ($mtype eq 'info' ? 'info' : 'err', $msg) if $syslog;

    foreach my $line (split (/\n/, $msg)) {
	print "$pre $line\n" if !$opt_quiet;
	print $logfd "$tstr $pre $line\n" if $logfd;
    }
}

sub run_command {
    my ($logfd, $cmdstr, $input, $timeout) = @_;

    my $reader = IO::File->new();
    my $writer = IO::File->new();
    my $error  = IO::File->new();

    my $orig_pid = $$;

    my $pid;
    eval {
	$pid = open3 ($writer, $reader, $error, ($cmdstr)) || die $!;
    };

    my $err = $@;

    # catch exec errors
    if ($orig_pid != $$) {
	debugmsg ('err', "command '$cmdstr' failed - fork failed", $logfd);
	POSIX::_exit (1); 
	kill ('KILL', $$); 
    }

    die $err if $err;

    print $writer $input if defined $input;
    close $writer;

    my $select = new IO::Select;
    $select->add ($reader);
    $select->add ($error);

    my ($ostream, $estream, $logout, $logerr) = ('', '', '', '');

    while ($select->count) {
	my @handles = $select->can_read ($timeout);

	if (defined ($timeout) && (scalar (@handles) == 0)) {
	    die "command '$cmdstr' failed: timeout";
	}

	foreach my $h (@handles) {
	    my $buf = '';
	    my $count = sysread ($h, $buf, 4096);
	    if (!defined ($count)) {
		waitpid ($pid, 0);
		die "command '$cmdstr' failed: $!";
	    }
	    $select->remove ($h) if !$count;

	    if ($h eq $reader) {
		$ostream .= $buf;
		$logout .= $buf;
		while ($logout =~ s/^([^\n]*\n)//s) {
		    my $line = $1;
		    debugmsg ('info', $line, $logfd);
		}
	    } elsif ($h eq $error) {
		$estream .= $buf;
		$logerr .= $buf;
		while ($logerr =~  s/^([^\n]*\n)//s) {
		    my $line = $1;
		    debugmsg ('info', $line, $logfd);
		}
	    }
	}
    }

    debugmsg ('info', $logout, $logfd);
    debugmsg ('info', $logerr, $logfd);

    waitpid ($pid, 0);
    my $ec = ($? >> 8);

    return $ostream if $ec == 24 && ($cmdstr =~ m/^$rsync/);

    die "command '$cmdstr' failed with exit code $ec\n" if $ec;

    return $ostream;
}

sub format_size {
    my $size = shift;

    my $kb = $size / 1024;

    if ($kb < 1024) {
	return int ($kb) . "KB";
    }

    my $mb = $size / (1024*1024);

    if ($mb < 1024) {
	return int ($mb) . "MB";
    } else {
	my $gb = $mb / 1024;
	return sprintf ("%.2fGB", $gb);
    } 
}

sub format_time {
    my $seconds = shift;

    my $hours = int ($seconds/3600);
    $seconds = $seconds - $hours*3600;
    my $min = int ($seconds/60);
    $seconds = $seconds - $min*60;

    return sprintf ("%02d:%02d:%02d", $hours, $min, $seconds);
}

sub remove_quotes {
    my $str = shift;

    $str =~ s/^\s*\"?//;
    $str =~ s/\"?\s*$//;

    return $str;
}

sub read_vzdump_defaults {

    my $fn = "/etc/vzdump.conf";

    my $res = {
	tmpdir => "/var/tmp",
	bwlimit => 10240,
	size => 1024,
	lockwait => 3*60, # 3 hours
	stopwait => 10, # 10 minutes
    };

    my $fh = IO::File->new ("<$fn");
    return $res if !$fh;
    
    my $line;
    while (defined ($line = <$fh>)) {
	next if $line =~ m/^\s*$/;
	next if $line =~ m/^\#/;

	if ($line =~ m/tmpdir:\s*(.*\S)\s*$/) {
	    $res->{tmpdir} = $1;
	} elsif ($line =~ m/dumpdir:\s*(.*\S)\s*$/) {
	    $res->{dumpdir} = $1;
	} elsif ($line =~ m/bwlimit:\s*(\d+)\s*$/) {
	    $res->{bwlimit} = int($1);
	} elsif ($line =~ m/lockwait:\s*(\d+)\s*$/) {
	    $res->{lockwait} = int($1);
	} elsif ($line =~ m/stopwait:\s*(\d+)\s*$/) {
	    $res->{stopwait} = int($1);
	} elsif ($line =~ m/size:\s*(\d+)\s*$/) {
	    $res->{size} = int($1);
	} elsif ($line =~ m/mode:\s*(stop|snapshot|suspend)\s*$/) {
	    $res->{mode} = $1;
	} else {
	    debugmsg ('warn', "unable to parse configuration file '$fn' - error at line " . $., undef, 1);
	}

    }
    close ($fh);
    return $res;
}

# read global vz.conf
sub read_glogal_vz_config {
 
    local $/;

    my $res = {
	rootdir => '/vz/root',
	privatedir => '/vz/private',
	dumpdir => '/vz/dump',
    };
    
    my $filename = "$vzdir/vz.conf";

    return $res if ! -f $filename;

    open (TMP, "<$filename");
    my $data = <TMP> || '';
    close (TMP);

    if ($data =~ m/^\s*VE_PRIVATE=(.*)$/m) {
	my $dir = remove_quotes ($1);
	$dir =~ s|/\$VEID$||;
	$res->{privatedir} = $dir;
    }
    if ($data =~ m/^\s*VE_ROOT=(.*)$/m) {
	my $dir = remove_quotes ($1);
	$dir =~ s|/\$VEID$||;
	$res->{rootdir} = $dir;
    }
    if ($data =~ m/^\s*DUMPDIR=(.*)$/m) {
	my $dir = remove_quotes ($1);
	$dir =~ s|/\$VEID$||;
	$res->{dumpdir} = $dir;
    }

    return $res;
}

sub read_vz_list {
    my ($vzconf, $vmlist) = @_;

    my $cfgdir = "$vzdir/conf";

    foreach my $conf (<$cfgdir/*.conf>) {

	next if $conf !~ m|/(\d\d\d+)\.conf$|;

	my $vpsid = $1;
	local $/;

	open (TMP, "<$conf");
	my $data = <TMP>;
	close (TMP);

	$vmlist->{$vpsid}->{type} = "openvz";
	$vmlist->{$vpsid}->{conffile} = $conf;

	if ($data =~ m/^\s*VE_PRIVATE=(.*)$/m) {
	    my $dir = remove_quotes ($1);
	    $dir =~ s/\$VEID/$vpsid/;
	    $vmlist->{$vpsid}->{dir} = $dir;
	} else {
	    $vmlist->{$vpsid}->{dir} = "$vzconf->{privatedir}/$vpsid";
	}

	if ($data =~ m/^\s*HOSTNAME=(.*)/m) {
	    $vmlist->{$vpsid}->{hostname} = remove_quotes ($1);
	} else {
	    $vmlist->{$vpsid}->{hostname} = "CT $vpsid";
	}
    }
}

sub read_qm_list {
    my ($vmlist) = @_;

    foreach my $conf (</etc/qemu-server/*.conf>) {
	next if $conf !~ m|/(\d\d\d+)\.conf$|;

	my $vpsid = $1;
	if (defined ($vmlist->{$vpsid})) {
	    debugmsg ('info', "found duplicate VPSID $vpsid");
	    next;
	}

	local $/;

	open (TMP, "<$conf");
	my $data = <TMP>;
	close (TMP);

	my $private = "/var/lib/vz/images/$vpsid";

	$vmlist->{$vpsid}->{type} = "qemu";
	$vmlist->{$vpsid}->{conffile} = $conf;
	$vmlist->{$vpsid}->{dir} = $private;

	if ($data =~ m/^\s*name:\s*(.*)\s*/im) {
	    $vmlist->{$vpsid}->{hostname} = $1;
	} else {
	    $vmlist->{$vpsid}->{hostname} = "VM $vpsid";
	}
    }
}

my @findexcl;

sub find_add_exclude {
    my ($excltype, $value) = @_;

    if (($excltype eq '-regex') || ($excltype eq '-files')) {
	$value = "\.$value";
    }

    if ($excltype eq '-files') {
	push @findexcl, "'('", '-not', '-type', 'd', '-regex' , "'$value'", "')'", '-o';

    } else {
	push @findexcl, "'('", $excltype , "'$value'", '-prune', "')'", '-o';
    }
}

find_add_exclude ('-type', 's'); # skip sockets

# argument parsing 

sub print_usage {
    my $msg = shift;

    print STDERR "ERROR: $msg\n\n" if $msg;

    print STDERR "usage: $0 OPTIONS [--all | VPSID]\n\n";
    print STDERR "\t--exclude VPSID\t\texclude VPSID (assumes --all)\n";
    print STDERR "\t--exclude-path REGEX\texclude certain files/directories\n";     print STDERR "\t--stdexcludes\t\texclude temorary files and logs\n\n";
 
    print STDERR "\t--compress\t\tcompress dump file (gzip)\n";
    print STDERR "\t--dumpdir DIR\t\tstore resulting files in DIR\n";
    print STDERR "\t--tmpdir DIR\t\tstore temporary files in DIR\n\n";

    print STDERR "\t--mailto EMAIL\t\tsend notification mail to EMAIL.\n";
    print STDERR "\t--quiet\t\t\tbe quiet.\n";
    print STDERR "\t--stop\t\t\tstop/start VPS if running\n";
    print STDERR "\t--suspend\t\tsuspend/resume VPS when running\n";
    print STDERR "\t--snapshot\t\tuse LVM snapshot when running\n";
    print STDERR "\t--size MB\t\tLVM snapshot size\n\n";

    print STDERR "\t--node CID\t\tonly run on pve cluster node CID\n";
    print STDERR "\t--lockwait MINUTES\tmaximal time to wait for the global lock\n";
    print STDERR "\t--stopwait MINUTES\tmaximal time to wait until a VM is stopped\n";
    print STDERR "\t--bwlimit KBPS\t\tlimit I/O bandwidth; KBytes per second\n\n";

    print STDERR "\t--restore FILENAME\trestore FILENAME\n";

    print STDERR "\n";
}

sub check_bin {
    my ($bin, $msg)  = @_;

    my $v = $$bin;

    my $path = "/sbin:/bin:/usr/sbin:/usr/bin:/usr/local/sbin:/usr/local/bin";

    foreach my $p (split (/:/, $path)) {
	my $fn = "$p/$v";
	if (-x $fn) {
	    $$bin = $fn;
	    return;
	}
    }

    if ($msg) {
	die "unable to find '$v' - $msg\n";
    } else {
	$$bin = undef;
    }
}

sub check_vpsid {
    my $vpsid = shift;

    if ($vpsid !~ m/^\d\d\d+$/) {
	print_usage ("strange VPS ID '${vpsid}'");
	exit (-1); 
    }
}

sub getlock {
    my ($maxwait) = @_;
 
    if (!open (SERVER_FLCK, ">>$lockfile")) {
	debugmsg ('err', "can't open lock on file '$lockfile' - $!", undef, 1);
	exit (-1);
    }

    
    if (flock (SERVER_FLCK, LOCK_EX|LOCK_NB)) {
	return;
    }

    if (!$maxwait) {
	debugmsg ('err', "can't aquire lock '$lockfile' (wait = 0)", undef, 1);
	exit (-1);
    }

    debugmsg('info', "trying to get global lock - waiting...", undef, 1);

    eval {
	alarm ($maxwait * 60);
	
	local $SIG{ALRM} = sub { alarm (0); die "got timeout\n"; };

	if (!flock (SERVER_FLCK, LOCK_EX)) {
	    my $err = $!;
	    close (SERVER_FLCK);
	    alarm (0);
	    die "$err\n";
	}
	alarm (0);
    };
    alarm (0);
    
    my $err = $@;

    if ($err) {
	debugmsg ('err', "can't aquire lock '$lockfile' - $err", undef, 1);
	exit (-1);
    }

    debugmsg('info', "got global lock", undef, 1);
}

sub get_lvm_mapping {

    my $devmapper;

    my $cmd = "$lvs --units m --separator ':' --noheadings -o vg_name,lv_name,lv_size";
    if (my $fd = IO::File->new ("$cmd 2>/dev/null|")) {
	while (my $line = <$fd>) {
	    if ($line =~ m|^\s*(\S+):(\S+):(\d+(\.\d+))M$|) {
		my $vg = $1;
		my $lv = $2;
		$devmapper->{"/dev/$vg/$lv"} = [$vg, $lv];
		$devmapper->{"/dev/mapper/$vg-$lv"} = [$vg, $lv];
	    }
	}
	close ($fd);
    }

    return $devmapper;
}

sub get_lvm_device {
    my ($dir, $mapping) = @_;

    my $fd = IO::File->new ("df -P -T '$dir' 2>/dev/null|");
    <$fd>; #skip first line
    my $out = <$fd>;
    close ($fd);

    return undef if !$out;
   
    my @res = split (/\s+/, $out);

    my $dev = $res[0];
    my $fstype = $res[1];
    my $mp = $res[6];

    my ($vg, $lv);

    ($vg, $lv) = @{$mapping->{$dev}} if defined $mapping->{$dev};

    return wantarray ? ($dev, $mp, $vg, $lv, $fstype) : $dev;
}

sub lvm_cleanup {
    my ($logfd, $snapdev) = @_;

    eval { run_command ($logfd, "umount /mnt/vzsnap"); };
    debugmsg ('info', $@, $logfd) if $@;

    eval { run_command ($logfd, "$lvremove -f $snapdev"); };
    debugmsg ('info', $@, $logfd) if $@;
}

sub archive_vm {
    my ($vmlist, $vpsid, $dir, $tarfile, $logfd) = @_;

    debugmsg ('info', "creating archive '$tarfile' ($dir)", $logfd);

    my $zflag = $opt_compress ? 'z' : '';

    my $srcconf = $vmlist->{$vpsid}->{conffile};
    my $vmtype = $vmlist->{$vpsid}->{type};

    my $bwl = $opt_bwlimit*1024; # bandwidth limit for cstream

    if ($vmtype eq 'openvz') { 
	mkpath "$dir/etc/vzdump/";
	run_command ($logfd, "$cpcmd $srcconf $dir/etc/vzdump/vps.conf");
	my $cfgdir = dirname ($srcconf);
	foreach my $s (@script_ext) {
	    my $fn = "$cfgdir/$vpsid.$s";
	    if (-f $fn) {
		run_command ($logfd, "$cpcmd $fn $dir/etc/vzdump/vps.$s");
	    }
	}
	
	if ($opt_stdexcludes) {
	    find_add_exclude ('-files', '/var/log/.+');
	    find_add_exclude ('-regex', '/tmp/.+');
	    find_add_exclude ('-regex', '/var/tmp/.+');
	    find_add_exclude ('-regex', '/var/run/.+pid');
	}

	# backup all types except sockets
	my $findargs = join (' ', @findexcl) . ' -print0';

	my $cmd = "(cd $dir; find . $findargs|tar c${zflag}pf - --totals --sparse --numeric-owner --no-recursion --ignore-failed-read --null -T -|cstream -t $bwl >$tarfile)";
	    
	run_command ($logfd, $cmd);

	rmtree "$dir/etc/vzdump";
    } else {
	run_command ($logfd, "$cpcmd $srcconf $dir/qemu-server.conf");
	my @filea = ('qemu-server.conf'); # always first file in tar
	foreach my $file (<$dir/*>) {
	    $file =~ s|^.*/([^/\s]+)$|$1|;
	    next if $file =~ m/^-/;
	    next if $file eq 'qemu-server.conf';
	    push @filea, $file; 
	}

	my $files = join (' ', @filea);
	my $cmd = "(tar cv${zflag}pf - -C '$dir' --totals --sparse --numeric-owner --ignore-failed-read $files|cstream -t $bwl >$tarfile)";
	run_command ($logfd, $cmd);
	unlink "$dir/qemu-server.conf";
    }
}

sub snapshot_vm {
    my ($vmlist, $vpsid, $dumpdir, $tmpdir, $logfd) = @_;

    my $vmtype = $vmlist->{$vpsid}->{type};
    my $dir = $vmlist->{$vpsid}->{dir};

    my $running = 0;
    my $status;
    if ($vmtype eq 'openvz') {
	$status = `$vzctl status $vpsid`;
    } else {
	$status = `qm status $vpsid`;
    }
    chomp $status;
    $running = 1 if $status =~ m/running/;

    debugmsg ('info', "status = $status", $logfd);

    my $snapdir = $dir;

    return ($snapdir, undef) if !$running;

    if (!$stopmode) {
	debugmsg ('warn', "online backup without stop/suspend/snapshot", $logfd);
	debugmsg ('warn', "this can lead to inconsistent data", $logfd);
	return ($snapdir, undef);
    }

    if ($stopmode eq 'snapshot') {
	
	my $lvmmap = get_lvm_mapping();
	my ($srcdev, $lvmpath, $lvmvg, $lvmlv, $fstype) = get_lvm_device ($dir, $lvmmap);

	my $targetdev = get_lvm_device ($dumpdir, $lvmmap);

	if (!$lvmvg) {
	    $stopmode = 'suspend';
	    debugmsg ('err', "unable to detect lvm volume group, " .
		      "using 'suspend' mode", $logfd);
	} elsif ($dir !~ m|/?$lvmpath/?|) {
	    $stopmode = 'suspend';
	    debugmsg ('err', "wrong lvm mount point '$lvmpath', " .
		      "using 'suspend' mode", $logfd);
	} elsif ($targetdev eq $srcdev) {
	    $stopmode = 'suspend';
	    debugmsg ('err', "unable to dump into snapshot " .
		      "(use option --dumpdir), using 'suspend' mode", $logfd); 
	} else {

	    my $snapdev = "/dev/$lvmvg/vzsnap";

	    mkpath "/mnt/vzsnap"; # create mount point for lvm snapshot
			
	    if (-b $snapdev) {
		debugmsg ('info', "trying to remove stale snapshot '$snapdev'", $logfd);
		lvm_cleanup ($logfd, $snapdev);
	    }

	    debugmsg ('info', "creating lvm snapshot of $srcdev ('$snapdev')", $logfd);
	    run_command ($logfd, "$lvcreate --size ${opt_snapsize}M --snapshot" .
			 " --name vzsnap /dev/$lvmvg/$lvmlv");

	    debugmsg ('info', "mounting lvm snapshot", $logfd);

	    my $mopts = '';
	    $mopts = "-o nouuid" if $fstype eq 'xfs';

	    eval { run_command ($logfd, "mount -t $fstype $mopts $snapdev /mnt/vzsnap"); };
	    my $err = $@;
	    if ($err) {
		eval { run_command ($logfd, "$lvremove -f $snapdev"); };
		die "mounting snapshot failed - $err";
	    }
	    
	    $snapdir =~ s|/?$lvmpath/?|/mnt/vzsnap/|;

	    return ($snapdir, $snapdev);
	}
    }
    
    rmtree $tmpdir;
    mkdir $tmpdir || die "unable to create temporary directory '$tmpdir'";

    my $rsyncopts = "--stats --numeric-ids --bwlimit=${opt_bwlimit}";

    my $synccmd = "$rsync $rsyncopts -aH --delete --no-whole-file --inplace $dir $tmpdir";
    debugmsg ('info', "starting first sync $dir to $tmpdir", $logfd);
    my $starttime = time();

    run_command ($logfd, $synccmd);

    my $delay = time () - $starttime;

    debugmsg ('info', "first sync finished ($delay seconds)", $logfd);

    my $stoptime = time();

    if ($stopmode eq 'stop') {
	debugmsg ('info', "stopping vps", $logfd);
	if ($vmtype eq 'openvz') {
	    run_command ($logfd, "$vzctl stop $vpsid");
	} else {
	    my $wait = $opt_stopwait * 60;
	    # send shutdown and wait
	    run_command ($logfd, "qm shutdown $vpsid && qm wait $vpsid $wait");
	}
    } elsif ($stopmode eq 'suspend') {
	debugmsg ('info', "suspend vps", $logfd);
	if ($vmtype eq 'openvz') {
	    run_command ($logfd, "$vzctl chkpnt $vpsid --suspend");
	} else {
	    run_command ($logfd, "qm suspend $vpsid");
	}
    }

    debugmsg ('info', "final sync $dir to $tmpdir", $logfd);
    
    $starttime = time();
    run_command ($logfd, $synccmd);

    $delay = time () - $starttime;
    debugmsg ('info', "final sync finished ($delay seconds)", $logfd);

    if ($stopmode eq 'stop') {
	debugmsg ('info', "restarting vps", $logfd);
	if ($vmtype eq 'openvz') {
	    run_command ($logfd, "$vzctl start $vpsid");
	} else {
	    run_command ($logfd, "qm start $vpsid");
	}
    } elsif ($stopmode eq 'suspend') {
	debugmsg ('info', "resume vps", $logfd);
	if ($vmtype eq 'openvz') {
	    run_command ($logfd, "$vzctl chkpnt $vpsid --resume");
	} else {
	    run_command ($logfd, "qm resume $vpsid");
	}
    }

    $delay = time () - $stoptime;

    debugmsg ('info', "vps is online again after $delay seconds", $logfd);
    
    $snapdir = "$tmpdir/$vpsid";

    return ($snapdir, undef);
}

sub vm_backup {
    my ($vmlist, $vpsid, $dumpdir, $tmpdir, $tarfile, $logfd) = @_;

    my $dir = $vmlist->{$vpsid}->{dir};
    die "directory '$dir' does not exist\n" if ! -d $dir;

    my ($snapdir, $snapdev);

    my $size = 0;
   
    my $tmptar = $tarfile;
    $tmptar =~ s/\.[^\.]+$/\.dat/;

    eval {
	($snapdir, $snapdev) = snapshot_vm ($vmlist, $vpsid, $dumpdir, $tmpdir, $logfd);

	unlink $tmptar;

	archive_vm ($vmlist, $vpsid, $snapdir, $tmptar, $logfd);

	$size = -s $tmptar;
	
	my $cs = format_size ($size); 
	debugmsg ('info', "file size $cs", $logfd);

	rename ($tmptar, $tarfile) ||
	    die "unable to rename '$tmptar' to '$tarfile'\n";
    };

    my $err = $@;

    # cleanup

    lvm_cleanup ($logfd, $snapdev) if $snapdev;
    rmtree $tmpdir;
    rmdir "/mnt/vzsnap" if $opt_snap;

    unlink $tmptar;

    die $err if $err; # propagate error

    return $size;
}

sub encode8bit {
    my ($str) = @_;

    $str =~ s/^(.{990})/$1\n/mg; # reduce line length

    return $str;
}

sub escape_html {
    my ($str) = @_;

    $str =~ s/&/&amp;/g;
    $str =~ s/</&lt;/g;
    $str =~ s/>/&gt;/g;

    return $str;
}

# send nicely formated multipart/alternative mail
sub send_mail {
    my ($mailto, $status, $cmdline, $totaltime) = @_;

    my $ecount = 0;
    foreach my $vpsid (keys %$status) {
	$ecount++ if  $status->{$vpsid}->{state} ne 'ok';
	chomp $status->{$vpsid}->{msg} if $status->{$vpsid}->{msg};
	$status->{$vpsid}->{backuptime} = 0 if !$status->{$vpsid}->{backuptime};
    }

    my $stat = $ecount ? 'backup failed' : 'backup successful';

    my $hostname = `hostname`;
    chomp $hostname;

    my $boundary = "----_=_NextPart_001_".int(time).$$;


    my $rcvrarg = '';
    foreach my $r (@$mailto) {
	$rcvrarg .= " '$r'";
    }

    open (MAIL,"|$sendmail -B 8BITMIME $rcvrarg") || 
	die "unable to open $sendmail - $!";

    my $rcvrtxt = join (', ', @$mailto);

    print MAIL "Content-Type: multipart/alternative;\n";
    print MAIL "\tboundary=\"$boundary\"\n";
    print MAIL "FROM: vzdump backup tool <root>\n";
    print MAIL "TO: $rcvrtxt\n";
    print MAIL "SUBJECT: vzdump backup status ($hostname) : $stat\n";
    print MAIL "\n";
    print MAIL "This is a multi-part message in MIME format.\n\n";
    print MAIL "--$boundary\n";

    print MAIL "Content-Type: text/plain;\n";
    print MAIL "\tcharset=\"UTF8\"\n";
    print MAIL "Content-Transfer-Encoding: 8bit\n";
    print MAIL "\n";

    # text part

    my $fill = '  '; # Avoid The Remove Extra Line Breaks Issue (MS Outlook)

    print MAIL sprintf ("${fill}%-10s %-6s %10s %10s  %s\n", qw(VMID STATUS TIME SIZE FILENAME));
    foreach my $vpsid (sort keys %$status) {
	if  ($status->{$vpsid}->{state} eq 'ok') {

	    print MAIL sprintf ("${fill}%-10s %-6s %10s %10s  %s\n", $vpsid, 
				$status->{$vpsid}->{state}, 
				format_time($status->{$vpsid}->{backuptime}),
				format_size ($status->{$vpsid}->{size}),
				$status->{$vpsid}->{tarfile});
	} else {
	    print MAIL sprintf ("${fill}%-10s %-6s %10s %8.2fMB  %s\n", $vpsid, 
				$status->{$vpsid}->{state}, 
				format_time($status->{$vpsid}->{backuptime}),
				0, '-');
	}
    }
    print MAIL "${fill}\n";
    print MAIL "${fill}Detailed backup logs:\n";
    print MAIL "${fill}\n";
    print MAIL "$fill$cmdline\n";
    print MAIL "${fill}\n";

    foreach my $vpsid (sort keys %$status) {
	my $log = $status->{$vpsid}->{tmplog};
	if (!$log) {
	    print MAIL "${fill}$vpsid: no log available\n\n";
	    next;
	}
	open (TMP, "$log");
	while (my $line = <TMP>) { print MAIL encode8bit ("${fill}$vpsid: $line"); }
	close (TMP);
	print MAIL "${fill}\n";
    }

    # end text part
    print MAIL "\n--$boundary\n";

    print MAIL "Content-Type: text/html;\n";
    print MAIL "\tcharset=\"UTF8\"\n";
    print MAIL "Content-Transfer-Encoding: 8bit\n";
    print MAIL "\n";

    # html part

    print MAIL "<html><body>\n";

    print MAIL "<table border=1 cellpadding=3>\n";

    print MAIL "<tr><td>VMID<td>NAME<td>STATUS<td>TIME<td>SIZE<td>FILENAME</tr>\n";

    my $ssize = 0;

    foreach my $vpsid (sort keys %$status) {
	my $name = $status->{$vpsid}->{hostname};
	$name =~ s/\..*$//; # remove domain part

	if  ($status->{$vpsid}->{state} eq 'ok') {

	    $ssize += $status->{$vpsid}->{size};

	    print MAIL sprintf ("<tr><td>%s<td>%s<td>OK<td>%s<td align=right>%s<td>%s</tr>\n", 
				$vpsid, $name,
				format_time($status->{$vpsid}->{backuptime}),
				format_size ($status->{$vpsid}->{size}),
				escape_html ($status->{$vpsid}->{tarfile}));
	} else {
	    print MAIL sprintf ("<tr><td>%s<td>%s<td><font color=red>FAILED<td>%s<td colspan=2>%s</tr>\n",
 
				$vpsid, $name, format_time($status->{$vpsid}->{backuptime}), 
				escape_html ($status->{$vpsid}->{msg}));
	}
    }

    print MAIL sprintf ("<tr><td align=left colspan=3>TOTAL<td>%s<td>%s<td></tr>",
 format_time ($totaltime), format_size ($ssize));

    print MAIL "</table><br><br>\n";
    print MAIL "Detailed backup logs:<br>\n";
    print MAIL "<br>\n";
    print MAIL "<pre>\n";
    print MAIL escape_html($cmdline) . "\n";
    print MAIL "\n";

    foreach my $vpsid (sort keys %$status) {
	my $log = $status->{$vpsid}->{tmplog};
	if (!$log) {
	    print MAIL "$vpsid: no log available\n\n";
	    next;
	}
	open (TMP, "$log");
	while (my $line = <TMP>) {
	    if ($line =~ m/^\S+\s\d+\s+\d+:\d+:\d+\s+(ERROR|WARN):/) {
		print MAIL encode8bit ("$vpsid: <font color=red>". 
				       escape_html ($line) . "</font>"); 
	    } else {
		print MAIL encode8bit ("$vpsid: " . escape_html ($line)); 
	    }
	}
	close (TMP);
	print MAIL "\n";
    }
    print MAIL "</pre>\n";

    print MAIL "</body></html>\n";

    # end html part
    print MAIL "\n--$boundary--\n";
}

sub restore_qemu {
    my ($opt_restore, $vpsid) = @_;

    debugmsg ('info', "restore qemu-server image '${opt_restore}' using ID $vpsid");

    my $conffile = "/etc/qemu-server/${vpsid}.conf";
    my $private = "/var/lib/vz/images/$vpsid";

    if (-d $private) {
	die "unable to restore VPS '${vpsid}' - directory '$private' already exists\n";
    }

    eval {
	mkpath $private || die "unable to create private dir '$private'";

	my $cmd = "zcat -f ${opt_restore}| tar xpf - --totals --sparse -C $private";

	debugmsg ('info', "extracting archive '${opt_restore}'");

	run_command (undef, $cmd);

	debugmsg ('info', "extracting configuration to '$conffile'");

	my $sfn = "$private/qemu-server.conf";

	run_command (undef, "$cpcmd '$sfn' '$conffile'");
	unlink $sfn;

	debugmsg ('info', "restore successful");

    };

    my $err = $@;

    if ($err) {
	rmtree $private;
	unlink $conffile;
	die $err;
    }
}

sub restore_openvz {
    my ($opt_restore, $vpsid) = @_;

    debugmsg ('info', "restore openvz image '${opt_restore}' using ID $vpsid");

    my $vzconf = read_glogal_vz_config ();
    my $cfgdir = "$vzdir/conf";
    my $conffile = "$cfgdir/${vpsid}.conf";
    my $private = "$vzconf->{privatedir}/${vpsid}";
    my $root = "$vzconf->{rootdir}/${vpsid}";

    if (-d $private) {
	die "unable to restore VPS '${vpsid}' - directory '$private' already exists\n";
    }
    if (-d $root) {
	die "unable to restore VPS '${vpsid}' - directory '$root' already exists\n";
    } 

    eval {
	mkpath $private || die "unable to create private dir '$private'";
	mkpath $root || die "unable to create private dir '$private'";

	my $cmd = "zcat -f ${opt_restore}| tar xpf - --totals --sparse -C $private";

	debugmsg ('info', "extracting archive '${opt_restore}'");

	run_command (undef, $cmd);

	debugmsg ('info', "extracting configuration to '$conffile'");

	my $qroot = $root;
	$qroot =~ s|/|\\\/|g;
	$qroot =~ s|/${vpsid}$|/\$VEID|;
	my $qprivate = $private;
	$qprivate =~ s|/|\\\/|g;
	$qprivate =~ s|/${vpsid}$|/\$VEID|;

	my $scmd = "sed -e 's/VE_ROOT=.*/VE_ROOT=\\\"$qroot\\\"/' -e 's/VE_PRIVATE=.*/VE_PRIVATE=\\\"$qprivate\\\"/'  <'$private/etc/vzdump/vps.conf' >'$conffile'";

	run_command (undef, $scmd);

	foreach my $s (@script_ext) {
	    my $tfn = "$cfgdir/${vpsid}.$s";
	    my $sfn = "$private/etc/vzdump/vps.$s";
	    if (-f $sfn) {
		run_command (undef, "$cpcmd '$sfn' '$tfn'");
	    }
	}

	rmtree "$private/etc/vzdump";

	debugmsg ('info', "restore successful");

    };

    my $err = $@;

    if ($err) {
	rmtree $private;
	rmtree $root;
	unlink $conffile;
	die $err;
    }
}


# parse parameters first - write errors to STDERR

if (!GetOptions ('all' => \$opt_all,
		 'exclude=s@' => \$opt_exclude,
		 'exclude-path=s@' => \$opt_exclude_path,
		 'stdexcludes' => \$opt_stdexcludes,
		 'compress' => \$opt_compress,
		 'restore=s' => \$opt_restore,
		 'mailto=s@' => \$opt_mailto,
		 'quiet' => \$opt_quiet,
		 'stop' =>\$opt_stop,
		 'suspend' =>\$opt_suspend,
		 'snapshot' =>\$opt_snap,
		 'size=i' => \$opt_snapsize,
		 'node=i' => \$opt_node,
		 'bwlimit=i' => \$opt_bwlimit,
		 'lockwait=i' => \$opt_lockwait,
		 'stopwait=i' => \$opt_stopwait,
		 'tmpdir=s' => \$opt_tmpdir,
		 'dumpdir=s' => \$opt_dumpdir)) {
    print_usage ();
    exit (-1);
}

$opt_dumpdir =~ s|/+$|| if ($opt_dumpdir);
$opt_tmpdir =~ s|/+$|| if ($opt_tmpdir);


if ($opt_node) {
    check_bin (\$pveca, "pveca not installed?");

    my $info = `$pveca -i`;
    chomp $info;
    die "unable to parse pveca info" if $info !~ m/^(\d+)\s+\S+\s+\S+\s+\S+$/;
    my $cid = $1;

    # silent exit if we run on wrong node
    exit (0) if $cid != $opt_node;
}

$opt_all = 1 if $opt_exclude;

if ($opt_all && ($#ARGV >= 0 || $opt_restore)) {
    print_usage ();
    exit (-1);
} 

if (!$opt_all && $#ARGV == -1) {
    print_usage ();
    exit (-1);
}

if ($opt_restore && $#ARGV != 0) {
    print_usage ();
    exit (-1);
}

if ($opt_restore && ! -f $opt_restore) {
    print_usage ("unable to access file '${opt_restore}'");
    exit (-1);
}

my @opt_vpsids;

if (!$opt_all) {
    @opt_vpsids = @ARGV;

    foreach my $vpsid (@opt_vpsids) {
	check_vpsid ($vpsid);
    }
}

if ($opt_exclude) {
    foreach my $vpsid (@$opt_exclude) { 
	check_vpsid ($vpsid); 
    }
}

if ($opt_exclude_path) {
    foreach my $path (@$opt_exclude_path) {
	find_add_exclude ('-regex', $path);
    }
}

check_bin (\$cpcmd, "unable to find 'cp' command");
check_bin (\$vzctl);
check_bin (\$qmctl);
check_bin (\$sendmail, "sendmail not installed?");
check_bin (\$rsync, "rsync not installed?");

if ($opt_snap) {
    check_bin (\$lvcreate, "lvm2 not installed?");
    check_bin (\$lvs, "lvm2 not installed?");
    check_bin (\$lvremove, "lvm2 not installed?");
}

# parameters are OK - no start real work and log everything

if ($opt_restore) {

    my $vpsid = $opt_vpsids[0];

    # try to detect type first
    open (TMP, "tar tf $opt_restore|") ||
	die "unable to open file '$opt_restore'\n";
    my $firstfile = <TMP>;
    chomp $firstfile;
    close TMP;

    my $vzconffile = "$vzdir/conf/${vpsid}.conf";
    my $qmconffile = "$qmdir/${vpsid}.conf";

    if (-f $vzconffile || -f $qmconffile) {
	die "unable to restore VPS '${vpsid}' - VM already exists\n";
    }

    if ($firstfile eq 'qemu-server.conf') {
	restore_qemu ($opt_restore, $vpsid);
    } else {
	restore_openvz ($opt_restore, $vpsid);
    }

    exit 0;
}

$SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
    die "interrupted by signal\n";
};

debugmsg ('info', "Starting new backup job - $cmdline", undef, 1);

my $def = read_vzdump_defaults();

my $maxwait = defined ($opt_lockwait) ? $opt_lockwait : $def->{lockwait};

getlock($maxwait); # only one process allowed

mkpath $logdir;

eval {

    my $starttime = time();

    my $vmlist = {};

    $opt_bwlimit = $def->{bwlimit} if !$opt_bwlimit;
    $opt_snapsize = $def->{size} if !$opt_snapsize;
    $opt_stopwait = $def->{stopwait} if !$opt_stopwait;
       
    $stopmode = $def->{mode} if ($def->{mode});
    $stopmode = 'stop' if $opt_stop;
    $stopmode = 'suspend' if $opt_suspend;
    $stopmode = 'snapshot' if $opt_snap;

    my $dumpdir;

    if ($vzctl) {
	my $vzconf = read_glogal_vz_config ();
	read_vz_list ($vzconf, $vmlist);
	$dumpdir = $vzconf->{dumpdir};
    }

    if ($qmctl) {
	read_qm_list ($vmlist);
    }

    $dumpdir = $def->{dumpdir} if defined ($def->{dumpdir});
    $dumpdir = $opt_dumpdir if defined ($opt_dumpdir);

    if (!$dumpdir) {
	die "no dumpdir specified - use option '--dumpdir'\n";
    } elsif (! -d $dumpdir) {
	die "dumpdir '$dumpdir' does not exist\n";
    }

    my $tmpdir = "/var/tmp";
    $tmpdir = $def->{tmpdir} if defined ($def->{tmpdir});
    $tmpdir = $opt_tmpdir if defined ($opt_tmpdir);

    $tmpdir .= "/vzdumptmp$$";

    @opt_vpsids = keys %$vmlist if $opt_all;

    my $status = {};

    my $abort = 0;

    foreach my $vpsid (sort @opt_vpsids) {

	next if grep { $_ eq  $vpsid } @$opt_exclude;

	my $res = { size => 0 };
	$res->{hostname} = $vmlist->{$vpsid}->{hostname};

	if ($abort) {
	    $res->{state} = 'err';
	    $res->{msg} = "interrupted by signal";
	    $status->{$vpsid} = $res;
	    next;
	}

	my $logfd;
	
	my $vmstarttime = time ();

	my $basename = "vzdump-${vpsid}";
	my $tarfile = $res->{tarfile} = "$dumpdir/$basename". ($opt_compress ? '.tgz' : '.tar');
	my $logfile = "$dumpdir/$basename.log";

	eval {
	    exists ($vmlist->{$vpsid}) ||
		die "unable to find VPS '$vpsid'\n";

	    my $tmplog = "$logdir/$vpsid.log";

	    $logfd = IO::File->new (">$tmplog") ||
		die "unable to create log file '$tmplog'";

	    $res->{tmplog} = $tmplog;

	    unlink $logfile;

	    my $vmtype = $vmlist->{$vpsid}->{type};

	    debugmsg ('info',  "Starting Backup of VM $vpsid ($vmtype)", $logfd, 1);

	    $res->{size} = vm_backup ($vmlist, $vpsid, $dumpdir, $tmpdir, $tarfile, $logfd);
	};

	my $err = $@;

	my $delay = $res->{backuptime} = time () - $vmstarttime;

	if ($err) {
	    $res->{state} = 'err';
	    $res->{msg} = $err;
	    debugmsg ('err', "Backup of VM $vpsid failed - $err", $logfd, 1);
	} else {
	    $res->{state} = 'ok';	    
	    debugmsg ('info', 
		      sprintf ("Finished Backup of VM $vpsid (%s)", 
			       format_time ($delay)), 
		      $logfd, 1);
	}

	close ($logfd) if $logfd;

	if ($res->{tmplog}) {
	    system ("$cpcmd $res->{tmplog} $logfile");
	}

	$status->{$vpsid} = $res;

	$abort = 1 if $err =~ m/interrupted by signal/;
    }

    my $totaltime = time() - $starttime;
 
    if ($opt_mailto) {
	eval {
	    send_mail ($opt_mailto, $status, $cmdline, $totaltime);
	};

	debugmsg ('err', $@) if $@;
    }
};

my $err = $@;

if ($err) {
    debugmsg ('err', $err, undef, 1);
    exit (-1);
}

exit (0);

__END__

=head1 NAME
                                          
vzdump - backup and restore utility for virtual machine

=head1 SYNOPSIS

vzdump OPTIONS [--all | <VMID>]

--exclude VPSID         exclude VPSID (assumes --all)

--exclude-path REGEX    exclude certain files/directories. You 
                        can use this option more than once to specify 
                        multiple exclude paths

--stdexcludes           exclude temorary files and logs

--compress              compress dump file (gzip)

--dumpdir DIR           store resulting files in DIR

--tmpdir DIR            store temporary files in DIR. --suspend and --stop
                        are using this directory to store a copy of the VM.

--mailto EMAIL          send notification mail to EMAIL. You can use 
                        this option more than once to specify multiple 
                        receivers

--stop                  stop/start VPS if running

--suspend               suspend/resume VPS when running

--snapshot              use LVM snapshot when running

--size MB               LVM snapshot size (default 1024)
    
--bwlimit KBPS          limit I/O bandwidth; KBytes per second

--lockwait MINUTES      maximal time to wait for the global
                        lock. vzdump uses a global lock file to make
                        sure that only one instance is running
                        (running sereral instance puts too much load
                        on a server). Default is 180 (3 hours).

--stopwait MINUTES      maximal time to wait until a VM is stopped.

--restore FILENAME      restore FILENAME

=head1 DESCRIPTION

vzdump is an utility to make consistent snapshots of running VMs
(openvz and qemu-server images). It basically creates a tar archive of
the VM private area, which also includes the VM configuration files.

There are several ways to provide consistency:

- stop the VM during backup (very long downtime)

- use rsync and suspend/resume (minimal downtime).

- use LVM2 (no downtime, but needs LVM2 and free space on the corresponding volume group to create the LVM snapshot)

=head1 CONFIGURATION

Global configuration is stored in /etc/vzdump.conf. 

 tmpdir: DIR
 dumpdir: DIR
 mode: snapshot|suspend|stop
 bwlimit: KBPS
 lockwait: MINUTES 
 stopwait: MINUTES 
 size: MB

=head1 FILES

vzdump skips the following files wit option --stdexcludes

 /var/log/.+
 /tmp/.+
 /var/tmp/.+
 /var/run/.+pid

You can manually specify exclude paths, for example:

> vzdump --exclude-path '/tmp/.+' --exclude-path '/var/tmp/.+' 777

(only excludes tmp directories)

Configuration files are also stored inside the backup archive (/etc/vzdump), and will be correctly restored with --restore

=head1 EXAMPLES

Simply dump VM 777 - no snapshot, just archive the VM private area and configuration files to the default dump directory (usually /vz/dump/).

> vzdump 777

Use rsync and suspend/resume to create an snapshot (minimal downtime).

> vzdump --suspend 777

Backup all VMs and send notification mails to root.

> vzdump --suspend --all --mailto root

Use LVM2 to create snapshots (no downtime).

> vzdump --dumpdir /mnt/backup --snapshot 777

Restore above backup to VM 600

> vzdump --restore /mnt/backup/vzdump-777.tar 600

Backup all VMSs excluding VM 101 and 102

> vzdump --suspend --exclude 101 --exclude 102

=head1 AUTHOR

Dietmar Maurer <dietmar@proxmox.com>

Many thanks to Proxmox Server Solutions (www.proxmox.com) for sponsoring 
this work.

=head1 COPYRIGHT AND DISCLAIMER

Copyright (C) 2007-2008 Proxmox Server Solutions GmbH

Copyright: vzdump is under GNU GPL, the GNU General Public License.

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; version 2 dated June, 1991.

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., 51 Franklin St, Fifth Floor, Boston,
MA 02110-1301, USA.

