2011-08-23 07:47:04 +02:00
package PVE::VZDump::QemuServer ;
use strict ;
use warnings ;
use File::Path ;
use File::Basename ;
2011-10-14 11:05:06 +02:00
use PVE::INotify ;
2011-08-23 07:47:04 +02:00
use PVE::VZDump ;
2011-10-17 13:49:48 +02:00
use PVE::Cluster qw( cfs_read_file ) ;
use PVE::Tools ;
2011-08-23 07:47:04 +02:00
use PVE::Storage ;
use PVE::QemuServer ;
use IO::File ;
use base qw ( PVE::VZDump:: Plugin ) ;
sub new {
my ( $ class , $ vzdump ) = @ _ ;
2011-10-14 11:05:06 +02:00
PVE::VZDump:: check_bin ( 'qm' ) ;
2011-08-23 07:47:04 +02:00
my $ self = bless { vzdump = > $ vzdump } ;
$ self - > { vmlist } = PVE::QemuServer:: vzlist ( ) ;
$ self - > { storecfg } = PVE::Storage:: config ( ) ;
return $ self ;
} ;
sub type {
return 'qemu' ;
}
sub vmlist {
my ( $ self ) = @ _ ;
return [ keys % { $ self - > { vmlist } } ] ;
}
sub prepare {
my ( $ self , $ task , $ vmid , $ mode ) = @ _ ;
$ task - > { disks } = [] ;
2011-10-14 11:05:06 +02:00
my $ conf = $ self - > { vmlist } - > { $ vmid } = PVE::QemuServer:: load_config ( $ vmid ) ;
2011-08-23 07:47:04 +02:00
$ task - > { hostname } = $ conf - > { name } ;
my $ lvmmap = PVE::VZDump:: get_lvm_mapping ( ) ;
2011-10-14 11:05:06 +02:00
my $ hostname = PVE::INotify:: nodename ( ) ;
2011-08-23 07:47:04 +02:00
my $ ind = { } ;
my $ mountinfo = { } ;
my $ mountind = 0 ;
my $ snapshot_count = 0 ;
PVE::QemuServer:: foreach_drive ( $ conf , sub {
my ( $ ds , $ drive ) = @ _ ;
return if PVE::QemuServer:: drive_is_cdrom ( $ drive ) ;
if ( defined ( $ drive - > { backup } ) && $ drive - > { backup } eq "no" ) {
$ self - > loginfo ( "exclude disk '$ds' (backup=no)" ) ;
return ;
}
my $ volid = $ drive - > { file } ;
my $ path ;
my ( $ storeid , $ volname ) = PVE::Storage:: parse_volume_id ( $ volid , 1 ) ;
if ( $ storeid ) {
PVE::Storage:: activate_storage ( $ self - > { storecfg } , $ storeid ) ;
$ path = PVE::Storage:: path ( $ self - > { storecfg } , $ volid ) ;
} else {
$ path = $ volid ;
}
return if ! $ path ;
die "no such volume '$volid'\n" if ! - e $ path ;
my $ diskinfo = { path = > $ path , volid = > $ volid , storeid = > $ storeid ,
snappath = > $ path , virtdev = > $ ds } ;
if ( - b $ path ) {
$ diskinfo - > { type } = 'block' ;
$ diskinfo - > { filename } = "vm-disk-$ds.raw" ;
if ( $ mode eq 'snapshot' ) {
my ( $ lvmvg , $ lvmlv ) = @ { $ lvmmap - > { $ path } } if defined ( $ lvmmap - > { $ path } ) ;
die ( "mode failure - unable to detect lvm volume group\n" ) if ! $ lvmvg ;
$ ind - > { $ lvmvg } = 0 if ! defined $ ind - > { $ lvmvg } ;
$ diskinfo - > { snapname } = "vzsnap-$hostname-$ind->{$lvmvg}" ;
$ diskinfo - > { snapdev } = "/dev/$lvmvg/$diskinfo->{snapname}" ;
$ diskinfo - > { lvmvg } = $ lvmvg ;
$ diskinfo - > { lvmlv } = $ lvmlv ;
$ diskinfo - > { snappath } = $ diskinfo - > { snapdev } ;
$ ind - > { $ lvmvg } + + ;
$ snapshot_count + + ;
}
} else {
$ diskinfo - > { type } = 'file' ;
my ( undef , $ dir , $ ext ) = fileparse ( $ path , qr/\.[^.]*/ ) ;
$ diskinfo - > { filename } = "vm-disk-$ds$ext" ;
if ( $ mode eq 'snapshot' ) {
my ( $ srcdev , $ lvmpath , $ lvmvg , $ lvmlv , $ fstype ) =
PVE::VZDump:: get_lvm_device ( $ dir , $ lvmmap ) ;
my $ targetdev = PVE::VZDump:: get_lvm_device ( $ task - > { dumpdir } , $ lvmmap ) ;
die ( "mode failure - unable to detect lvm volume group\n" ) if ! $ lvmvg ;
die ( "mode failure - wrong lvm mount point '$lvmpath'\n" ) if $ dir !~ m | /?$lvmpath/ ? | ;
die ( "mode failure - unable to dump into snapshot (use option --dumpdir)\n" )
if $ targetdev eq $ srcdev ;
$ ind - > { $ lvmvg } = 0 if ! defined $ ind - > { $ lvmvg } ;
my $ info = $ mountinfo - > { $ lvmpath } ;
if ( ! $ info ) {
my $ snapname = "vzsnap-$hostname-$ind->{$lvmvg}" ;
my $ snapdev = "/dev/$lvmvg/$snapname" ;
$ mountinfo - > { $ lvmpath } = $ info = {
snapdev = > $ snapdev ,
snapname = > $ snapname ,
mountpoint = > "/mnt/vzsnap$mountind" ,
} ;
$ ind - > { $ lvmvg } + + ;
$ mountind + + ;
$ snapshot_count + + ;
}
$ diskinfo - > { snapdev } = $ info - > { snapdev } ;
$ diskinfo - > { snapname } = $ info - > { snapname } ;
$ diskinfo - > { mountpoint } = $ info - > { mountpoint } ;
$ diskinfo - > { lvmvg } = $ lvmvg ;
$ diskinfo - > { lvmlv } = $ lvmlv ;
$ diskinfo - > { fstype } = $ fstype ;
$ diskinfo - > { lvmpath } = $ lvmpath ;
$ diskinfo - > { snappath } = $ path ;
$ diskinfo - > { snappath } =~ s | /?$lvmpath/ ? | $ diskinfo - > { mountpoint } / | ;
}
}
push @ { $ task - > { disks } } , $ diskinfo ;
} ) ;
$ task - > { snapshot_count } = $ snapshot_count ;
}
sub vm_status {
my ( $ self , $ vmid ) = @ _ ;
2011-10-14 11:05:06 +02:00
my $ running = PVE::QemuServer:: check_running ( $ vmid ) ? 1 : 0 ;
return wantarray ? ( $ running , $ running ? 'running' : 'stopped' ) : $ running ;
2011-08-23 07:47:04 +02:00
}
sub lock_vm {
my ( $ self , $ vmid ) = @ _ ;
$ self - > cmd ( "qm set $vmid --lock backup" ) ;
}
sub unlock_vm {
my ( $ self , $ vmid ) = @ _ ;
2011-10-14 11:05:06 +02:00
$ self - > cmd ( "qm unlock $vmid" ) ;
2011-08-23 07:47:04 +02:00
}
sub stop_vm {
my ( $ self , $ task , $ vmid ) = @ _ ;
my $ opts = $ self - > { vzdump } - > { opts } ;
my $ wait = $ opts - > { stopwait } * 60 ;
# send shutdown and wait
2012-01-17 11:56:56 +01:00
$ self - > cmd ( "qm shutdown $vmid --skiplock --keepActive --timeout $wait" ) ;
2011-08-23 07:47:04 +02:00
}
sub start_vm {
my ( $ self , $ task , $ vmid ) = @ _ ;
2011-10-14 11:05:06 +02:00
$ self - > cmd ( "qm start $vmid --skiplock" ) ;
2011-08-23 07:47:04 +02:00
}
sub suspend_vm {
my ( $ self , $ task , $ vmid ) = @ _ ;
2011-10-14 11:05:06 +02:00
$ self - > cmd ( "qm suspend $vmid --skiplock" ) ;
2011-08-23 07:47:04 +02:00
}
sub resume_vm {
my ( $ self , $ task , $ vmid ) = @ _ ;
2011-10-14 11:05:06 +02:00
$ self - > cmd ( "qm resume $vmid --skiplock" ) ;
2011-08-23 07:47:04 +02:00
}
sub snapshot_alloc {
2011-11-29 06:19:42 +01:00
my ( $ self , $ storeid , $ name , $ size , $ srcdev ) = @ _ ;
2011-08-23 07:47:04 +02:00
my $ cmd = "lvcreate --size ${size}M --snapshot --name '$name' '$srcdev'" ;
if ( $ storeid ) {
my $ scfg = PVE::Storage:: storage_config ( $ self - > { storecfg } , $ storeid ) ;
# lock shared storage
return PVE::Storage:: cluster_lock_storage ( $ storeid , $ scfg - > { shared } , undef , sub {
$ self - > cmd ( $ cmd ) ;
} ) ;
} else {
$ self - > cmd ( $ cmd ) ;
}
}
sub snapshot_free {
2011-11-29 06:19:42 +01:00
my ( $ self , $ storeid , $ name , $ snapdev , $ noerr ) = @ _ ;
my $ cmd = [ 'lvremove' , '-f' , $ snapdev ] ;
# loop, because we often get 'LV in use: not deactivating'
# we use run_command() because we do not want to log errors here
my $ wait = 1 ;
while ( - b $ snapdev ) {
eval {
if ( $ storeid ) {
my $ scfg = PVE::Storage:: storage_config ( $ self - > { storecfg } , $ storeid ) ;
# lock shared storage
return PVE::Storage:: cluster_lock_storage ( $ storeid , $ scfg - > { shared } , undef , sub {
PVE::Tools:: run_command ( $ cmd , outfunc = > sub { } , errfunc = > { } ) ;
} ) ;
} else {
PVE::Tools:: run_command ( $ cmd , outfunc = > sub { } , errfunc = > { } ) ;
}
} ;
my $ err = $@ ;
last if ! $ err ;
if ( $ wait >= 64 ) {
$ self - > logerr ( $ err ) ;
die $@ if ! $ noerr ;
last ;
2011-08-23 07:47:04 +02:00
}
2011-11-29 06:19:42 +01:00
$ self - > loginfo ( "lvremove failed - trying again in $wait seconds" ) if $ wait >= 8 ;
sleep ( $ wait ) ;
$ wait = $ wait * 2 ;
}
2011-08-23 07:47:04 +02:00
}
sub snapshot {
my ( $ self , $ task , $ vmid ) = @ _ ;
my $ opts = $ self - > { vzdump } - > { opts } ;
my $ mounts = { } ;
foreach my $ di ( @ { $ task - > { disks } } ) {
if ( $ di - > { type } eq 'block' ) {
if ( - b $ di - > { snapdev } ) {
$ self - > loginfo ( "trying to remove stale snapshot '$di->{snapdev}'" ) ;
2011-11-29 06:19:42 +01:00
$ self - > snapshot_free ( $ di - > { storeid } , $ di - > { snapname } , $ di - > { snapdev } , 1 ) ;
2011-08-23 07:47:04 +02:00
}
$ di - > { cleanup_lvm } = 1 ;
2011-11-29 06:19:42 +01:00
$ self - > snapshot_alloc ( $ di - > { storeid } , $ di - > { snapname } , $ opts - > { size } ,
2011-08-23 07:47:04 +02:00
"/dev/$di->{lvmvg}/$di->{lvmlv}" ) ;
} elsif ( $ di - > { type } eq 'file' ) {
next if defined ( $ mounts - > { $ di - > { mountpoint } } ) ; # already mounted
if ( - b $ di - > { snapdev } ) {
$ self - > loginfo ( "trying to remove stale snapshot '$di->{snapdev}'" ) ;
$ self - > cmd_noerr ( "umount $di->{mountpoint}" ) ;
2011-11-29 06:19:42 +01:00
$ self - > snapshot_free ( $ di - > { storeid } , $ di - > { snapname } , $ di - > { snapdev } , 1 ) ;
2011-08-23 07:47:04 +02:00
}
mkpath $ di - > { mountpoint } ; # create mount point for lvm snapshot
$ di - > { cleanup_lvm } = 1 ;
2011-11-29 06:19:42 +01:00
$ self - > snapshot_alloc ( $ di - > { storeid } , $ di - > { snapname } , $ opts - > { size } ,
2011-08-23 07:47:04 +02:00
"/dev/$di->{lvmvg}/$di->{lvmlv}" ) ;
my $ mopts = $ di - > { fstype } eq 'xfs' ? "-o nouuid" : '' ;
$ di - > { snapshot_mount } = 1 ;
$ self - > cmd ( "mount -t $di->{fstype} $mopts $di->{snapdev} $di->{mountpoint}" ) ;
$ mounts - > { $ di - > { mountpoint } } = 1 ;
} else {
die "implement me" ;
}
}
}
sub get_size {
my $ path = shift ;
if ( - f $ path ) {
return - s $ path ;
} elsif ( - b $ path ) {
my $ fh = IO::File - > new ( $ path , "r" ) ;
die "unable to open '$path' to detect device size\n" if ! $ fh ;
my $ size = sysseek $ fh , 0 , 2 ;
$ fh - > close ( ) ;
die "unable to detect device size for '$path'\n" if ! $ size ;
return $ size ;
}
}
sub assemble {
my ( $ self , $ task , $ vmid ) = @ _ ;
my $ conffile = PVE::QemuServer:: config_file ( $ vmid ) ;
my $ outfile = "$task->{tmpdir}/qemu-server.conf" ;
my $ outfd ;
my $ conffd ;
eval {
$ outfd = IO::File - > new ( ">$outfile" ) ||
die "unable to open '$outfile'" ;
$ conffd = IO::File - > new ( $ conffile , 'r' ) ||
die "unable open '$conffile'" ;
while ( defined ( my $ line = <$conffd> ) ) {
next if $ line =~ m/^\#vzdump\#/ ; # just to be sure
print $ outfd $ line ;
}
foreach my $ di ( @ { $ task - > { disks } } ) {
if ( $ di - > { type } eq 'block' || $ di - > { type } eq 'file' ) {
my $ size = get_size ( $ di - > { snappath } ) ;
my $ storeid = $ di - > { storeid } || '' ;
print $ outfd "#vzdump#map:$di->{virtdev}:$di->{filename}:$size:$storeid:\n" ;
} else {
die "internal error" ;
}
}
} ;
my $ err = $@ ;
close ( $ outfd ) if $ outfd ;
close ( $ conffd ) if $ conffd ;
die $ err if $ err ;
}
sub archive {
my ( $ self , $ task , $ vmid , $ filename ) = @ _ ;
my $ conffile = "$task->{tmpdir}/qemu-server.conf" ;
my $ opts = $ self - > { vzdump } - > { opts } ;
my $ starttime = time ( ) ;
my $ fh ;
my @ filea = ( $ conffile , 'qemu-server.conf' ) ; # always first file in tar
foreach my $ di ( @ { $ task - > { disks } } ) {
if ( $ di - > { type } eq 'block' || $ di - > { type } eq 'file' ) {
push @ filea , $ di - > { snappath } , $ di - > { filename } ;
} else {
die "implement me" ;
}
}
my $ files = join ( ' ' , map { "'$_'" } @ filea ) ;
2011-10-19 11:27:42 +02:00
my $ cmd = "/usr/lib/qemu-server/vmtar $files" ;
my $ bwl = $ opts - > { bwlimit } * 1024 ; # bandwidth limit for cstream
$ cmd . = "|cstream -t $bwl" if $ opts - > { bwlimit } ;
$ cmd . = "|gzip" if $ opts - > { compress } ;
if ( $ opts - > { stdout } ) {
$ self - > cmd ( $ cmd , output = > ">&=" . fileno ( $ opts - > { stdout } ) ) ;
} else {
$ self - > cmd ( "$cmd >$filename" ) ;
}
2011-08-23 07:47:04 +02:00
}
sub cleanup {
my ( $ self , $ task , $ vmid ) = @ _ ;
foreach my $ di ( @ { $ task - > { disks } } ) {
if ( $ di - > { snapshot_mount } ) {
$ self - > cmd_noerr ( "umount $di->{mountpoint}" ) ;
}
if ( $ di - > { cleanup_lvm } ) {
if ( - b $ di - > { snapdev } ) {
if ( $ di - > { type } eq 'block' ) {
2011-11-29 06:19:42 +01:00
$ self - > snapshot_free ( $ di - > { storeid } , $ di - > { snapname } , $ di - > { snapdev } , 1 ) ;
2011-08-23 07:47:04 +02:00
} elsif ( $ di - > { type } eq 'file' ) {
2011-11-29 06:19:42 +01:00
$ self - > snapshot_free ( $ di - > { storeid } , $ di - > { snapname } , $ di - > { snapdev } , 1 ) ;
2011-08-23 07:47:04 +02:00
}
}
}
}
}
1 ;