use PVE::Exception qw(raise raise_param_exc);
use PVE::Storage;
use PVE::Tools qw(run_command lock_file file_read_firstline);
+use PVE::JSONSchema qw(get_standard_option);
use PVE::Cluster qw(cfs_register_file cfs_read_file cfs_write_file cfs_lock_file);
use PVE::INotify;
use PVE::ProcFSTools;
# Note about locking: we use flock on the config file protect
# against concurent actions.
# Aditionaly, we have a 'lock' setting in the config file. This
-# can be set to 'migrate' or 'backup'. Most actions are not
+# can be set to 'migrate', 'backup', 'snapshot' or 'rollback'. Most actions are not
# allowed when such lock is set. But you can ignore this kind of
# lock with the --skiplock flag.
optional => 1,
});
+PVE::JSONSchema::register_standard_option('pve-snapshot-name', {
+ description => "The name of the snapshot.",
+ type => 'string', format => 'pve-configid',
+ maxLength => 40,
+});
+
#no warnings 'redefine';
unless(defined(&_VZSYSCALLS_H_)) {
optional => 1,
type => 'string',
description => "Lock/unlock the VM.",
- enum => [qw(migrate backup)],
+ enum => [qw(migrate backup snapshot rollback)],
},
cpulimit => {
optional => 1,
optional => 1,
type => 'string',
description => "scsi controller model",
- enum => [qw(lsi virtio-scsi-pci)],
+ enum => [qw(lsi virtio-scsi-pci megasas)],
default => 'lsi',
},
description => {
optional => 1,
type => 'string', format => 'pve-qm-bootdisk',
description => "Enable booting from specified disk.",
- pattern => '(ide|scsi|virtio)\d+',
+ pattern => '(ide|sata|scsi|virtio)\d+',
},
smp => {
optional => 1,
description => "Enable/disable ACPI.",
default => 1,
},
+ agent => {
+ optional => 1,
+ type => 'boolean',
+ description => "Enable/disable Qemu GuestAgent.",
+ default => 0,
+ },
kvm => {
optional => 1,
type => 'boolean',
enum => [ qw(486 athlon pentium pentium2 pentium3 coreduo core2duo kvm32 kvm64 qemu32 qemu64 phenom cpu64-rhel6 cpu64-rhel5 Conroe Penryn Nehalem Westmere Opteron_G1 Opteron_G2 Opteron_G3 host) ],
default => 'qemu64',
},
+ parent => get_standard_option('pve-snapshot-name', {
+ optional => 1,
+ description => "Parent snapshot name. This is used internally, and should not be modified.",
+ }),
+ snaptime => {
+ optional => 1,
+ description => "Timestamp for snapshots.",
+ type => 'integer',
+ minimum => 0,
+ },
+ vmstate => {
+ optional => 1,
+ type => 'string', format => 'pve-volume-id',
+ description => "Reference to a volume which stores the VM state. This is used internally for snapshots.",
+ },
};
# what about other qemu settings ?
my $MAX_IDE_DISKS = 4;
my $MAX_SCSI_DISKS = 14;
-my $MAX_VIRTIO_DISKS = 6;
+my $MAX_VIRTIO_DISKS = 16;
my $MAX_SATA_DISKS = 6;
my $MAX_USB_DEVICES = 5;
-my $MAX_NETS = 6;
+my $MAX_NETS = 32;
my $MAX_UNUSED_DISKS = 8;
my $MAX_HOSTPCI_DEVICES = 2;
my $MAX_SERIAL_PORTS = 4;
optional => 1,
type => 'string', format => 'pve-qm-drive',
typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe|directsync] [,format=f] [,backup=yes|no] [,rerror=ignore|report|stop] [,werror=enospc|ignore|report|stop] [,aio=native|threads]',
- description => "Use volume as IDE hard disk or CD-ROM (n is 0 to 3).",
+ description => "Use volume as IDE hard disk or CD-ROM (n is 0 to " .($MAX_IDE_DISKS -1) . ").",
};
PVE::JSONSchema::register_standard_option("pve-qm-ide", $idedesc);
optional => 1,
type => 'string', format => 'pve-qm-drive',
typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe|directsync] [,format=f] [,backup=yes|no] [,rerror=ignore|report|stop] [,werror=enospc|ignore|report|stop] [,aio=native|threads]',
- description => "Use volume as SCSI hard disk or CD-ROM (n is 0 to 13).",
+ description => "Use volume as SCSI hard disk or CD-ROM (n is 0 to " . ($MAX_SCSI_DISKS - 1) . ").",
};
PVE::JSONSchema::register_standard_option("pve-qm-scsi", $scsidesc);
optional => 1,
type => 'string', format => 'pve-qm-drive',
typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe|directsync] [,format=f] [,backup=yes|no] [,rerror=ignore|report|stop] [,werror=enospc|ignore|report|stop] [,aio=native|threads]',
- description => "Use volume as SATA hard disk or CD-ROM (n is 0 to 5).",
+ description => "Use volume as SATA hard disk or CD-ROM (n is 0 to " . ($MAX_SATA_DISKS - 1). ").",
};
PVE::JSONSchema::register_standard_option("pve-qm-sata", $satadesc);
optional => 1,
type => 'string', format => 'pve-qm-drive',
typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe|directsync] [,format=f] [,backup=yes|no] [,rerror=ignore|report|stop] [,werror=enospc|ignore|report|stop] [,aio=native|threads]',
- description => "Use volume as VIRTIO hard disk (n is 0 to 5).",
+ description => "Use volume as VIRTIO hard disk (n is 0 to " . ($MAX_VIRTIO_DISKS - 1) . ").",
};
PVE::JSONSchema::register_standard_option("pve-qm-virtio", $virtiodesc);
};
}
-sub disk_devive_info {
- my $dev = shift;
-
- die "unknown disk device format '$dev'" if $dev !~ m/^(ide|scsi|virtio)(\d+)$/;
-
- my $bus = $1;
- my $index = $2;
- my $maxdev = 1024;
-
- if ($bus eq 'ide') {
- $maxdev = 2;
- } elsif ($bus eq 'scsi') {
- $maxdev = 7;
- }
-
- my $controller = int($index / $maxdev);
- my $unit = $index % $maxdev;
-
-
- return { bus => $bus, desc => uc($bus) . " $controller:$unit",
- controller => $controller, unit => $unit, index => $index };
-
-}
-
-sub qemu_drive_name {
- my ($dev, $media) = @_;
-
- my $info = disk_devive_info($dev);
- my $mediastr = '';
-
- if (($info->{bus} eq 'ide') || ($info->{bus} eq 'scsi')) {
- $mediastr = ($media eq 'cdrom') ? "-cd" : "-hd";
- return sprintf("%s%i%s%i", $info->{bus}, $info->{controller},
- $mediastr, $info->{unit});
- } else {
- return sprintf("%s%i", $info->{bus}, $info->{index});
- }
-}
-
my $cdrom_path;
sub get_cdrom_path {
PVE::Tools::file_set_contents($filename, $data);
}
+my $parse_size = sub {
+ my ($value) = @_;
+
+ return undef if $value !~ m/^(\d+(\.\d+)?)([KMG])?$/;
+ my ($size, $unit) = ($1, $3);
+ if ($unit) {
+ if ($unit eq 'K') {
+ $size = $size * 1024;
+ } elsif ($unit eq 'M') {
+ $size = $size * 1024 * 1024;
+ } elsif ($unit eq 'G') {
+ $size = $size * 1024 * 1024 * 1024;
+ }
+ }
+ return int($size);
+};
+
+my $format_size = sub {
+ my ($size) = @_;
+
+ $size = int($size);
+
+ my $kb = int($size/1024);
+ return $size if $kb*1024 != $size;
+
+ my $mb = int($kb/1024);
+ return "${kb}K" if $mb*1024 != $kb;
+
+ my $gb = int($mb/1024);
+ return "${mb}M" if $gb*1024 != $mb;
+
+ return "${gb}G";
+};
+
# ideX = [volume=]volume-id[,media=d][,cyls=c,heads=h,secs=s[,trans=t]]
# [,snapshot=on|off][,cache=on|off][,format=f][,backup=yes|no]
# [,rerror=ignore|report|stop][,werror=enospc|ignore|report|stop]
foreach my $p (split (/,/, $data)) {
next if $p =~ m/^\s*$/;
- if ($p =~ m/^(file|volume|cyls|heads|secs|trans|media|snapshot|cache|format|rerror|werror|backup|aio|bps|bps_rd|bps_wr|iops|iops_rd|iops_wr)=(.+)$/) {
+ if ($p =~ m/^(file|volume|cyls|heads|secs|trans|media|snapshot|cache|format|rerror|werror|backup|aio|bps|mbps|bps_rd|mbps_rd|bps_wr|mbps_wr|iops|iops_rd|iops_wr|size)=(.+)$/) {
my ($k, $v) = ($1, $2);
$k = 'file' if $k eq 'volume';
return undef if defined $res->{$k};
+ if ($k eq 'bps' || $k eq 'bps_rd' || $k eq 'bps_wr') {
+ return undef if !$v || $v !~ m/^\d+/;
+ $k = "m$k";
+ $v = sprintf("%.3f", $v / (1024*1024));
+ }
$res->{$k} = $v;
} else {
if (!$res->{file} && $p !~ m/=/) {
return undef if $res->{backup} && $res->{backup} !~ m/^(yes|no)$/;
return undef if $res->{aio} && $res->{aio} !~ m/^(native|threads)$/;
- return undef if $res->{bps_rd} && $res->{bps};
- return undef if $res->{bps_wr} && $res->{bps};
+
+ return undef if $res->{mbps_rd} && $res->{mbps};
+ return undef if $res->{mbps_wr} && $res->{mbps};
+
+ return undef if $res->{mbps} && $res->{mbps} !~ m/^\d+(\.\d+)?$/;
+ return undef if $res->{mbps_rd} && $res->{mbps_rd} !~ m/^\d+(\.\d+)?$/;
+ return undef if $res->{mbps_wr} && $res->{mbps_wr} !~ m/^\d+(\.\d+)?$/;
+
return undef if $res->{iops_rd} && $res->{iops};
return undef if $res->{iops_wr} && $res->{iops};
-
- return undef if $res->{bps} && $res->{bps} !~ m/^\d+$/;
- return undef if $res->{bps_rd} && $res->{bps_rd} !~ m/^\d+$/;
- return undef if $res->{bps_wr} && $res->{bps_wr} !~ m/^\d+$/;
return undef if $res->{iops} && $res->{iops} !~ m/^\d+$/;
return undef if $res->{iops_rd} && $res->{iops_rd} !~ m/^\d+$/;
return undef if $res->{iops_wr} && $res->{iops_wr} !~ m/^\d+$/;
+ if ($res->{size}) {
+ return undef if !defined($res->{size} = &$parse_size($res->{size}));
+ }
+
if ($res->{media} && ($res->{media} eq 'cdrom')) {
return undef if $res->{snapshot} || $res->{trans} || $res->{format};
return undef if $res->{heads} || $res->{secs} || $res->{cyls};
return $res;
}
-my @qemu_drive_options = qw(heads secs cyls trans media format cache snapshot rerror werror aio bps bps_rd bps_wr iops iops_rd iops_wr);
+my @qemu_drive_options = qw(heads secs cyls trans media format cache snapshot rerror werror aio iops iops_rd iops_wr);
sub print_drive {
my ($vmid, $drive) = @_;
my $opts = '';
- foreach my $o (@qemu_drive_options, 'backup') {
+ foreach my $o (@qemu_drive_options, 'mbps', 'mbps_rd', 'mbps_wr', 'backup') {
$opts .= ",$o=$drive->{$o}" if $drive->{$o};
}
+ if ($drive->{size}) {
+ $opts .= ",size=" . &$format_size($drive->{size});
+ }
+
return "$drive->{file}$opts";
}
}
sub print_drivedevice_full {
- my ($storecfg, $conf, $vmid, $drive) = @_;
+ my ($storecfg, $conf, $vmid, $drive, $bridges) = @_;
my $device = '';
my $maxdev = 0;
if ($drive->{interface} eq 'virtio') {
- my $pciaddr = print_pci_addr("$drive->{interface}$drive->{index}");
+ my $pciaddr = print_pci_addr("$drive->{interface}$drive->{index}", $bridges);
$device = "virtio-blk-pci,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}$pciaddr";
} elsif ($drive->{interface} eq 'scsi') {
$maxdev = ($conf->{scsihw} && $conf->{scsihw} ne 'lsi') ? 256 : 7;
} else {
$path = PVE::Storage::path($storecfg, $drive->{file});
}
- $devicetype = 'block' if path_is_scsi($path);
+
+ if($path =~ m/^iscsi\:\/\//){
+ $devicetype = 'generic';
+ }
+ else {
+ $devicetype = 'block' if path_is_scsi($path);
+ }
}
if (!$conf->{scsihw} || $conf->{scsihw} eq 'lsi'){
$opts .= ",$o=$drive->{$o}" if $drive->{$o};
}
+ foreach my $o (qw(bps bps_rd bps_wr)) {
+ my $v = $drive->{"m$o"};
+ $opts .= ",$o=" . int($v*1024*1024) if $v;
+ }
+
# use linux-aio by default (qemu default is threads)
$opts .= ",aio=native" if !$drive->{aio};
}
sub print_netdevice_full {
- my ($vmid, $conf, $net, $netid) = @_;
+ my ($vmid, $conf, $net, $netid, $bridges) = @_;
my $bootorder = $conf->{boot} || $confdesc->{boot}->{default};
# qemu > 0.15 always try to boot from network - we disable that by
# not loading the pxe rom file
my $extra = ($bootorder !~ m/n/) ? "romfile=," : '';
- my $pciaddr = print_pci_addr("$netid");
+ my $pciaddr = print_pci_addr("$netid", $bridges);
my $tmpstr = "$device,${extra}mac=$net->{macaddr},netdev=$netid$pciaddr,id=$netid";
$tmpstr .= ",bootindex=$net->{bootindex}" if $net->{bootindex} ;
return $tmpstr;
my $prop = shift;
foreach my $opt (keys %$confdesc) {
+ next if $opt eq 'parent' || $opt eq 'snaptime' || $opt eq 'vmstate';
$prop->{$opt} = $confdesc->{$opt};
}
warn $@ if $@;
}
-# fixme: remove?
-sub load_diskinfo_old {
- my ($storecfg, $vmid, $conf) = @_;
-
- my $info = {};
- my $res = {};
- my $vollist;
-
- foreach_drive($conf, sub {
- my ($ds, $di) = @_;
-
- $res->{$ds} = $di;
-
- return if drive_is_cdrom($di);
-
- if ($di->{file} =~ m|^/dev/.+|) {
- $info->{$di->{file}}->{size} = PVE::Storage::file_size_info($di->{file});
- } else {
- push @$vollist, $di->{file};
- }
- });
-
- eval {
- my $dl = PVE::Storage::vdisk_list($storecfg, undef, $vmid, $vollist);
-
- PVE::Storage::foreach_volid($dl, sub {
- my ($volid, $sid, $volname, $d) = @_;
- $info->{$volid} = $d;
- });
- };
- warn $@ if $@;
-
- foreach my $ds (keys %$res) {
- my $di = $res->{$ds};
-
- $res->{$ds}->{disksize} = $info->{$di->{file}} ?
- $info->{$di->{file}}->{size} / (1024*1024) : 0;
- }
-
- return $res;
-}
-
sub load_config {
- my ($vmid) = @_;
+ my ($vmid, $node) = @_;
- my $cfspath = cfs_config_path($vmid);
+ my $cfspath = cfs_config_path($vmid, $node);
my $conf = PVE::Cluster::cfs_read_file($cfspath);
my $res = {
digest => Digest::SHA::sha1_hex($raw),
+ snapshots => {},
};
$filename =~ m|/qemu-server/(\d+)\.conf$|
my $vmid = $1;
+ my $conf = $res;
my $descr = '';
- while ($raw && $raw =~ s/^(.*?)(\n|$)//) {
- my $line = $1;
-
+ my @lines = split(/\n/, $raw);
+ foreach my $line (@lines) {
next if $line =~ m/^\s*$/;
+
+ if ($line =~ m/^\[([a-z][a-z0-9_\-]+)\]\s*$/i) {
+ my $snapname = $1;
+ $conf->{description} = $descr if $descr;
+ $descr = '';
+ $conf = $res->{snapshots}->{$snapname} = {};
+ next;
+ }
if ($line =~ m/^\#(.*)\s*$/) {
$descr .= PVE::Tools::decode_text($1) . "\n";
if ($line =~ m/^(description):\s*(.*\S)\s*$/) {
$descr .= PVE::Tools::decode_text($2);
+ } elsif ($line =~ m/snapstate:\s*(prepare|delete)\s*$/) {
+ $conf->{snapstate} = $1;
} elsif ($line =~ m/^(args):\s*(.*\S)\s*$/) {
my $key = $1;
my $value = $2;
- $res->{$key} = $value;
+ $conf->{$key} = $value;
} elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/) {
my $key = $1;
my $value = $2;
}
if ($key eq 'cdrom') {
- $res->{ide2} = $value;
+ $conf->{ide2} = $value;
} else {
- $res->{$key} = $value;
+ $conf->{$key} = $value;
}
}
}
}
- $res->{description} = $descr if $descr;
+ $conf->{description} = $descr if $descr;
- # convert old smp to sockets
- if ($res->{smp} && !$res->{sockets}) {
- $res->{sockets} = $res->{smp};
- }
- delete $res->{smp};
+ delete $res->{snapstate}; # just to be sure
return $res;
}
sub write_vm_config {
my ($filename, $conf) = @_;
+ delete $conf->{snapstate}; # just to be sure
+
if ($conf->{cdrom}) {
die "option ide2 conflicts with cdrom\n" if $conf->{ide2};
$conf->{ide2} = $conf->{cdrom};
delete $conf->{smp};
}
- my $new_volids = {};
- foreach my $key (keys %$conf) {
- next if $key eq 'digest' || $key eq 'description';
- my $value = $conf->{$key};
- eval { $value = check_type($key, $value); };
- die "unable to parse value of '$key' - $@" if $@;
+ my $used_volids = {};
+
+ my $cleanup_config = sub {
+ my ($cref) = @_;
+
+ foreach my $key (keys %$cref) {
+ next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots' ||
+ $key eq 'snapstate';
+ my $value = $cref->{$key};
+ eval { $value = check_type($key, $value); };
+ die "unable to parse value of '$key' - $@" if $@;
- $conf->{$key} = $value;
+ $cref->{$key} = $value;
- if (valid_drivename($key)) {
- my $drive = PVE::QemuServer::parse_drive($key, $value);
- $new_volids->{$drive->{file}} = 1 if $drive && $drive->{file};
+ if (valid_drivename($key)) {
+ my $drive = PVE::QemuServer::parse_drive($key, $value);
+ $used_volids->{$drive->{file}} = 1 if $drive && $drive->{file};
+ }
}
+ };
+
+ &$cleanup_config($conf);
+ foreach my $snapname (keys %{$conf->{snapshots}}) {
+ &$cleanup_config($conf->{snapshots}->{$snapname});
}
# remove 'unusedX' settings if we re-add a volume
foreach my $key (keys %$conf) {
my $value = $conf->{$key};
- if ($key =~ m/^unused/ && $new_volids->{$value}) {
+ if ($key =~ m/^unused/ && $used_volids->{$value}) {
delete $conf->{$key};
}
}
+
+ my $generate_raw_config = sub {
+ my ($conf) = @_;
- # gererate RAW data
- my $raw = '';
+ my $raw = '';
- # add description as comment to top of file
- my $descr = $conf->{description} || '';
- foreach my $cl (split(/\n/, $descr)) {
- $raw .= '#' . PVE::Tools::encode_text($cl) . "\n";
- }
+ # add description as comment to top of file
+ my $descr = $conf->{description} || '';
+ foreach my $cl (split(/\n/, $descr)) {
+ $raw .= '#' . PVE::Tools::encode_text($cl) . "\n";
+ }
- foreach my $key (sort keys %$conf) {
- next if $key eq 'digest' || $key eq 'description';
- $raw .= "$key: $conf->{$key}\n";
+ foreach my $key (sort keys %$conf) {
+ next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots';
+ $raw .= "$key: $conf->{$key}\n";
+ }
+ return $raw;
+ };
+
+ my $raw = &$generate_raw_config($conf);
+ foreach my $snapname (sort keys %{$conf->{snapshots}}) {
+ $raw .= "\n[$snapname]\n";
+ $raw .= &$generate_raw_config($conf->{snapshots}->{$snapname});
}
return $raw;
}
sub check_running {
- my ($vmid, $nocheck) = @_;
+ my ($vmid, $nocheck, $node) = @_;
- my $filename = config_file($vmid);
+ my $filename = config_file($vmid, $node);
die "unable to find configuration file for VM $vmid - no such machine\n"
if !$nocheck && ! -f $filename;
return $vzlist;
}
-my $storage_timeout_hash = {};
-
sub disksize {
my ($storecfg, $conf) = @_;
my $volid = $drive->{file};
return undef if !$volid;
- my $path;
- my $storeid;
- my $timeoutid;
-
- if ($volid =~ m|^/|) {
- $path = $timeoutid = $volid;
- } else {
- eval {
- $storeid = $timeoutid = PVE::Storage::parse_volume_id($volid);
- };
- if (my $err = $@) {
- warn $err;
- return undef;
- }
- }
-
- my $last_timeout = $storage_timeout_hash->{$timeoutid};
- if ($last_timeout) {
- if ((time() - $last_timeout) < 30) {
- # skip storage with errors
- return undef ;
- }
- delete $storage_timeout_hash->{$timeoutid};
- }
-
- my ($size, $format, $used);
-
- ($size, $format, $used) = PVE::Storage::volume_size_info($storecfg, $volid, 1);
-
- if (!defined($format)) {
- # got timeout
- $storage_timeout_hash->{$timeoutid} = time();
- return undef;
- }
-
- return wantarray ? ($size, $used) : $size;
+ return $drive->{size};
}
my $last_proc_pid_stat;
# fixme: better status?
$d->{status} = $list->{$vmid}->{pid} ? 'running' : 'stopped';
- my ($size, $used) = disksize($storecfg, $conf);
- if (defined($size) && defined($used)) {
- $d->{disk} = $used;
+ my $size = disksize($storecfg, $conf);
+ if (defined($size)) {
+ $d->{disk} = 0; # no info available
$d->{maxdisk} = $size;
} else {
$d->{disk} = 0;
}
}
- return $res if !$full;
+ return $res if !$full;
my $qmpclient = PVE::QMPClient->new();
my ($storecfg, $vmid, $conf, $defaults, $migrate_uri) = @_;
my $cmd = [];
+ my $devices = [];
my $pciaddr = '';
+ my $bridges = {};
my $kvmver = kvm_user_version();
my $vernum = 0; # unknown
if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
push @$cmd, '-incoming', $migrate_uri if $migrate_uri;
+ push @$cmd, '-S' if $migrate_uri;
+
my $use_usb2 = 0;
for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
next if !$conf->{"usb$i"};
$use_usb2 = 1;
}
# include usb device config
- push @$cmd, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
+ push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
# enable absolute mouse coordinates (needed by vnc)
my $tablet = defined($conf->{tablet}) ? $conf->{tablet} : $defaults->{tablet};
if ($tablet) {
if ($use_usb2) {
- push @$cmd, '-device', 'usb-tablet,bus=ehci.0,port=6';
+ push @$devices, '-device', 'usb-tablet,bus=ehci.0,port=6';
} else {
- push @$cmd, '-usbdevice', 'tablet';
+ push @$devices, '-usbdevice', 'tablet';
}
}
for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
my $d = parse_hostpci($conf->{"hostpci$i"});
next if !$d;
- $pciaddr = print_pci_addr("hostpci$i");
- push @$cmd, '-device', "pci-assign,host=$d->{pciid},id=hostpci$i$pciaddr";
+ $pciaddr = print_pci_addr("hostpci$i", $bridges);
+ push @$devices, '-device', "pci-assign,host=$d->{pciid},id=hostpci$i$pciaddr";
}
# usb devices
my $d = parse_usb_device($conf->{"usb$i"});
next if !$d;
if ($d->{vendorid} && $d->{productid}) {
- push @$cmd, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
+ push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
} elsif (defined($d->{hostbus}) && defined($d->{hostport})) {
- push @$cmd, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
+ push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
}
}
for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
if (my $path = $conf->{"serial$i"}) {
die "no such serial device\n" if ! -c $path;
- push @$cmd, '-chardev', "tty,id=serial$i,path=$path";
- push @$cmd, '-device', "isa-serial,chardev=serial$i";
+ push @$devices, '-chardev', "tty,id=serial$i,path=$path";
+ push @$devices, '-device', "isa-serial,chardev=serial$i";
}
}
for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
if (my $path = $conf->{"parallel$i"}) {
die "no such parallel device\n" if ! -c $path;
- push @$cmd, '-chardev', "parport,id=parallel$i,path=$path";
- push @$cmd, '-device', "isa-parallel,chardev=parallel$i";
+ push @$devices, '-chardev', "parport,id=parallel$i,path=$path";
+ push @$devices, '-device', "isa-parallel,chardev=parallel$i";
}
}
#my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
#push @$cmd, '-soundhw', 'es1370';
#push @$cmd, '-soundhw', $soundhw if $soundhw;
- $pciaddr = print_pci_addr("balloon0");
- push @$cmd, '-device', "virtio-balloon-pci,id=balloon0$pciaddr" if $conf->{balloon};
+
+ if($conf->{agent}) {
+ my $qgasocket = qga_socket($vmid);
+ my $pciaddr = print_pci_addr("qga0", $bridges);
+ push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
+ push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
+ push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
+ }
+
+ $pciaddr = print_pci_addr("balloon0", $bridges);
+ push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr" if $conf->{balloon};
if ($conf->{watchdog}) {
my $wdopts = parse_watchdog($conf->{watchdog});
- $pciaddr = print_pci_addr("watchdog");
+ $pciaddr = print_pci_addr("watchdog", $bridges);
my $watchdog = $wdopts->{model} || 'i6300esb';
- push @$cmd, '-device', "$watchdog$pciaddr";
- push @$cmd, '-watchdog-action', $wdopts->{action} if $wdopts->{action};
+ push @$devices, '-device', "$watchdog$pciaddr";
+ push @$devices, '-watchdog-action', $wdopts->{action} if $wdopts->{action};
}
my $vollist = [];
my $maxdev = ($scsihw ne 'lsi') ? 256 : 7;
my $controller = int($drive->{index} / $maxdev);
- $pciaddr = print_pci_addr("scsihw$controller");
- push @$cmd, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
+ $pciaddr = print_pci_addr("scsihw$controller", $bridges);
+ push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
$scsicontroller->{$controller}=1;
}
if ($drive->{interface} eq 'sata') {
my $controller = int($drive->{index} / $MAX_SATA_DISKS);
- $pciaddr = print_pci_addr("ahci$controller");
- push @$cmd, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
+ $pciaddr = print_pci_addr("ahci$controller", $bridges);
+ push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
$ahcicontroller->{$controller}=1;
}
- push @$cmd, '-drive',print_drive_full($storecfg, $vmid, $drive);
- push @$cmd, '-device',print_drivedevice_full($storecfg, $conf, $vmid, $drive);
+ push @$devices, '-drive',print_drive_full($storecfg, $vmid, $drive);
+ push @$devices, '-device',print_drivedevice_full($storecfg, $conf, $vmid, $drive, $bridges);
});
push @$cmd, '-m', $conf->{memory} || $defaults->{memory};
}
my $netdevfull = print_netdev_full($vmid,$conf,$d,"net$i");
- push @$cmd, '-netdev', $netdevfull;
+ push @$devices, '-netdev', $netdevfull;
- my $netdevicefull = print_netdevice_full($vmid,$conf,$d,"net$i");
- push @$cmd, '-device', $netdevicefull;
+ my $netdevicefull = print_netdevice_full($vmid,$conf,$d,"net$i",$bridges);
+ push @$devices, '-device', $netdevicefull;
+ }
+
+ #bridges
+ while (my ($k, $v) = each %$bridges) {
+ $pciaddr = print_pci_addr("pci.$k");
+ unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
}
push @$cmd, @$aa;
}
+ push @$cmd, @$devices;
return wantarray ? ($cmd, $vollist) : $cmd;
}
return "${var_run_tmpdir}/$vmid.qmp";
}
+sub qga_socket {
+ my ($vmid) = @_;
+ return "${var_run_tmpdir}/$vmid.qga";
+}
+
sub pidfile_name {
my ($vmid) = @_;
return "${var_run_tmpdir}/$vmid.pid";
my $devices_list = vm_devices_list($vmid);
return 1 if defined($devices_list->{$deviceid});
+ qemu_bridgeadd($storecfg, $conf, $vmid, $deviceid); #add bridge if we need it for the device
+
if ($deviceid =~ m/^(virtio)(\d+)$/) {
return undef if !qemu_driveadd($storecfg, $vmid, $device);
my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
}
}
+ if ($deviceid =~ m/^(pci\.)(\d+)$/) {
+ my $bridgeid = $2;
+ my $pciaddr = print_pci_addr($deviceid);
+ my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
+ qemu_deviceadd($vmid, $devicefull);
+ return undef if !qemu_deviceaddverify($vmid, $deviceid);
+ }
+
return 1;
}
return 1;
}
+sub qemu_bridgeadd {
+ my ($storecfg, $conf, $vmid, $device) = @_;
+
+ my $bridges = {};
+ my $bridgeid = undef;
+ print_pci_addr($device, $bridges);
+
+ while (my ($k, $v) = each %$bridges) {
+ $bridgeid = $k;
+ }
+ return if $bridgeid < 1;
+ my $bridge = "pci.$bridgeid";
+ my $devices_list = vm_devices_list($vmid);
+
+ if(!defined($devices_list->{$bridge})) {
+ return undef if !vm_deviceplug($storecfg, $conf, $vmid, $bridge);
+ }
+ return 1;
+}
+
sub qemu_netdevadd {
my ($vmid, $conf, $device, $deviceid) = @_;
}
+# old code, only used to shutdown old VM after update
+sub __read_avail {
+ my ($fh, $timeout) = @_;
+
+ my $sel = new IO::Select;
+ $sel->add($fh);
+
+ my $res = '';
+ my $buf;
+
+ my @ready;
+ while (scalar (@ready = $sel->can_read($timeout))) {
+ my $count;
+ if ($count = $fh->sysread($buf, 8192)) {
+ if ($buf =~ /^(.*)\(qemu\) $/s) {
+ $res .= $1;
+ last;
+ } else {
+ $res .= $buf;
+ }
+ } else {
+ if (!defined($count)) {
+ die "$!\n";
+ }
+ last;
+ }
+ }
+
+ die "monitor read timeout\n" if !scalar(@ready);
+
+ return $res;
+}
+
+# old code, only used to shutdown old VM after update
+sub vm_monitor_command {
+ my ($vmid, $cmdstr, $nocheck) = @_;
+
+ my $res;
+
+ eval {
+ die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
+
+ my $sname = "${var_run_tmpdir}/$vmid.mon";
+
+ my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
+ die "unable to connect to VM $vmid socket - $!\n";
+
+ my $timeout = 3;
+
+ # hack: migrate sometime blocks the monitor (when migrate_downtime
+ # is set)
+ if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
+ $timeout = 60*60; # 1 hour
+ }
+
+ # read banner;
+ my $data = __read_avail($sock, $timeout);
+
+ if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
+ die "got unexpected qemu monitor banner\n";
+ }
+
+ my $sel = new IO::Select;
+ $sel->add($sock);
+
+ if (!scalar(my @ready = $sel->can_write($timeout))) {
+ die "monitor write error - timeout";
+ }
+
+ my $fullcmd = "$cmdstr\r";
+
+ # syslog('info', "VM $vmid monitor command: $cmdstr");
+
+ my $b;
+ if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
+ die "monitor write error - $!";
+ }
+
+ return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
+
+ $timeout = 20;
+
+ if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
+ $timeout = 60*60; # 1 hour
+ } elsif ($cmdstr =~ m/^(eject|change)/) {
+ $timeout = 60; # note: cdrom mount command is slow
+ }
+ if ($res = __read_avail($sock, $timeout)) {
+
+ my @lines = split("\r?\n", $res);
+
+ shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
+
+ $res = join("\n", @lines);
+ $res .= "\n";
+ }
+ };
+
+ my $err = $@;
+
+ if ($err) {
+ syslog("err", "VM $vmid monitor command failed - $err");
+ die $err;
+ }
+
+ return $res;
+}
+
+sub qemu_block_resize {
+ my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
+
+ my $running = PVE::QemuServer::check_running($vmid);
+
+ return if !PVE::Storage::volume_resize($storecfg, $volid, $size, $running);
+
+ return if !$running;
+
+ vm_mon_cmd($vmid, "block_resize", device => $deviceid, size => int($size));
+
+}
+
+sub qemu_volume_snapshot {
+ my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
+
+ my $running = PVE::QemuServer::check_running($vmid);
+
+ return if !PVE::Storage::volume_snapshot($storecfg, $volid, $snap, $running);
+
+ return if !$running;
+
+ vm_mon_cmd($vmid, "snapshot-drive", device => $deviceid, name => $snap);
+
+}
+
+sub qemu_volume_snapshot_delete {
+ my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
+
+ my $running = PVE::QemuServer::check_running($vmid);
+
+ return if !PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snap, $running);
+
+ return if !$running;
+
+ vm_mon_cmd($vmid, "delete-drive-snapshot", device => $deviceid, name => $snap);
+}
+
+sub qga_freezefs {
+ my ($vmid) = @_;
+
+ #need to impplement call to qemu-ga
+}
+
+sub qga_unfreezefs {
+ my ($vmid) = @_;
+
+ #need to impplement call to qemu-ga
+}
+
sub vm_start {
- my ($storecfg, $vmid, $statefile, $skiplock) = @_;
+ my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom) = @_;
lock_config($vmid, sub {
- my $conf = load_config($vmid);
+ my $conf = load_config($vmid, $migratedfrom);
check_lock($conf) if !$skiplock;
- die "VM $vmid already running\n" if check_running($vmid);
+ die "VM $vmid already running\n" if check_running($vmid, undef, $migratedfrom);
my $migrate_uri;
my $migrate_port = 0;
my $defaults = load_defaults();
+ # set environment variable useful inside network script
+ $ENV{PVE_MIGRATED_FROM} = $migratedfrom if $migratedfrom;
+
my ($cmd, $vollist) = config_to_command($storecfg, $vmid, $conf, $defaults, $migrate_uri);
# host pci devices
for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
if ($statefile eq 'tcp') {
print "migration listens on port $migrate_port\n";
} else {
- unlink $statefile;
- # fixme: send resume - is that necessary ?
- eval { vm_mon_cmd($vmid, "cont"); };
+ if ($migratedfrom) {
+ unlink $statefile;
+ # fixme: send resume - is that necessary ?
+ eval { vm_mon_cmd($vmid, "cont"); };
+ }
}
}
eval { vm_mon_cmd($vmid, "migrate_set_downtime", value => $migrate_downtime); };
}
+ if($migratedfrom) {
+ my $capabilities = {};
+ $capabilities->{capability} = "xbzrle";
+ $capabilities->{state} = JSON::true;
+ eval { PVE::QemuServer::vm_mon_cmd_nocheck($vmid, "migrate-set-capabilities", capabilities => [$capabilities]); };
+ }
+
vm_balloonset($vmid, $conf->{balloon}) if $conf->{balloon};
});
my $res;
+ my $timeout;
+ if ($cmd->{arguments} && $cmd->{arguments}->{timeout}) {
+ $timeout = $cmd->{arguments}->{timeout};
+ delete $cmd->{arguments}->{timeout};
+ }
+
eval {
die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
-
- my $qmpclient = PVE::QMPClient->new();
-
- $res = $qmpclient->cmd($vmid, $cmd);
-
+ my $sname = PVE::QemuServer::qmp_socket($vmid);
+ if (-e $sname) {
+ my $qmpclient = PVE::QMPClient->new();
+
+ $res = $qmpclient->cmd($vmid, $cmd, $timeout);
+ } elsif (-e "${var_run_tmpdir}/$vmid.mon") {
+ die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
+ if scalar(%{$cmd->{arguments}});
+ vm_monitor_command($vmid, $cmd->{execute}, $nocheck);
+ } else {
+ die "unable to open monitor socket\n";
+ }
};
if (my $err = $@) {
syslog("err", "VM $vmid qmp command failed - $err");
my $res;
- my $cmd = {
+ my $cmd = {
execute => 'human-monitor-command',
arguments => { 'command-line' => $cmdline},
};
PVE::Storage::deactivate_volumes($storecfg, $vollist);
}
- foreach my $ext (qw(mon pid vnc)) {
+ foreach my $ext (qw(mon qmp pid vnc qga)) {
unlink "/var/run/qemu-server/${vmid}.$ext";
}
};
# We need that when migration VMs to other nodes (files already moved)
# Note: we set $keepActive in vzdump stop mode - volumes need to stay active
sub vm_stop {
- my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive) = @_;
-
- $timeout = 60 if !defined($timeout);
+ my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
$force = 1 if !defined($force) && !$shutdown;
+ if ($migratedfrom){
+ my $pid = check_running($vmid, $nocheck, $migratedfrom);
+ kill 15, $pid if $pid;
+ my $conf = load_config($vmid, $migratedfrom);
+ vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive);
+ return;
+ }
+
lock_config($vmid, sub {
my $pid = check_running($vmid, $nocheck);
if (!$nocheck) {
$conf = load_config($vmid);
check_lock($conf) if !$skiplock;
+ if (!defined($timeout) && $shutdown && $conf->{startup}) {
+ my $opts = parse_startup($conf->{startup});
+ $timeout = $opts->{down} if $opts->{down};
+ }
}
+ $timeout = 60 if !defined($timeout);
+
eval {
if ($shutdown) {
$nocheck ? vm_mon_cmd_nocheck($vmid, "system_powerdown") : vm_mon_cmd($vmid, "system_powerdown");
lock_config($vmid, sub {
my $conf = load_config($vmid);
-
+
# there is no qmp command, so we use the human monitor command
vm_human_monitor_command($vmid, "sendkey $key");
});
}
sub print_pci_addr {
- my ($id) = @_;
+ my ($id, $bridges) = @_;
my $res = '';
my $devices = {
scsihw0 => { bus => 0, addr => 5 },
scsihw1 => { bus => 0, addr => 6 },
ahci0 => { bus => 0, addr => 7 },
+ qga0 => { bus => 0, addr => 8 },
virtio0 => { bus => 0, addr => 10 },
virtio1 => { bus => 0, addr => 11 },
virtio2 => { bus => 0, addr => 12 },
net4 => { bus => 0, addr => 22 },
net5 => { bus => 0, addr => 23 },
#addr29 : usb-host (pve-usb.cfg)
+ 'pci.1' => { bus => 0, addr => 30 },
+ 'pci.2' => { bus => 0, addr => 31 },
+ 'net6' => { bus => 1, addr => 1 },
+ 'net7' => { bus => 1, addr => 2 },
+ 'net8' => { bus => 1, addr => 3 },
+ 'net9' => { bus => 1, addr => 4 },
+ 'net10' => { bus => 1, addr => 5 },
+ 'net11' => { bus => 1, addr => 6 },
+ 'net12' => { bus => 1, addr => 7 },
+ 'net13' => { bus => 1, addr => 8 },
+ 'net14' => { bus => 1, addr => 9 },
+ 'net15' => { bus => 1, addr => 10 },
+ 'net16' => { bus => 1, addr => 11 },
+ 'net17' => { bus => 1, addr => 12 },
+ 'net18' => { bus => 1, addr => 13 },
+ 'net19' => { bus => 1, addr => 14 },
+ 'net20' => { bus => 1, addr => 15 },
+ 'net21' => { bus => 1, addr => 16 },
+ 'net22' => { bus => 1, addr => 17 },
+ 'net23' => { bus => 1, addr => 18 },
+ 'net24' => { bus => 1, addr => 19 },
+ 'net25' => { bus => 1, addr => 20 },
+ 'net26' => { bus => 1, addr => 21 },
+ 'net27' => { bus => 1, addr => 22 },
+ 'net28' => { bus => 1, addr => 23 },
+ 'net29' => { bus => 1, addr => 24 },
+ 'net30' => { bus => 1, addr => 25 },
+ 'net31' => { bus => 1, addr => 26 },
+ 'virtio6' => { bus => 2, addr => 1 },
+ 'virtio7' => { bus => 2, addr => 2 },
+ 'virtio8' => { bus => 2, addr => 3 },
+ 'virtio9' => { bus => 2, addr => 4 },
+ 'virtio10' => { bus => 2, addr => 5 },
+ 'virtio11' => { bus => 2, addr => 6 },
+ 'virtio12' => { bus => 2, addr => 7 },
+ 'virtio13' => { bus => 2, addr => 8 },
+ 'virtio14' => { bus => 2, addr => 9 },
+ 'virtio15' => { bus => 2, addr => 10 },
};
if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
my $addr = sprintf("0x%x", $devices->{$id}->{addr});
- $res = ",bus=pci.$devices->{$id}->{bus},addr=$addr";
+ my $bus = $devices->{$id}->{bus};
+ $res = ",bus=pci.$bus,addr=$addr";
+ $bridges->{$bus} = 1 if $bridges;
}
return $res;
die "unable to commit configuration file '$conffile'\n";
};
+
+# Internal snapshots
+
+# NOTE: Snapshot create/delete involves several non-atomic
+# action, and can take a long time.
+# So we try to avoid locking the file and use 'lock' variable
+# inside the config file instead.
+
+my $snapshot_copy_config = sub {
+ my ($source, $dest) = @_;
+
+ foreach my $k (keys %$source) {
+ next if $k eq 'snapshots';
+ next if $k eq 'snapstate';
+ next if $k eq 'snaptime';
+ next if $k eq 'vmstate';
+ next if $k eq 'lock';
+ next if $k eq 'digest';
+ next if $k eq 'description';
+ next if $k =~ m/^unused\d+$/;
+
+ $dest->{$k} = $source->{$k};
+ }
+};
+
+my $snapshot_apply_config = sub {
+ my ($conf, $snap) = @_;
+
+ # copy snapshot list
+ my $newconf = {
+ snapshots => $conf->{snapshots},
+ };
+
+ # keep description and list of unused disks
+ foreach my $k (keys %$conf) {
+ next if !($k =~ m/^unused\d+$/ || $k eq 'description');
+ $newconf->{$k} = $conf->{$k};
+ }
+
+ &$snapshot_copy_config($snap, $newconf);
+
+ return $newconf;
+};
+
+sub foreach_writable_storage {
+ my ($conf, $func) = @_;
+
+ my $sidhash = {};
+
+ foreach my $ds (keys %$conf) {
+ next if !valid_drivename($ds);
+
+ my $drive = parse_drive($ds, $conf->{$ds});
+ next if !$drive;
+ next if drive_is_cdrom($drive);
+
+ my $volid = $drive->{file};
+
+ my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
+ $sidhash->{$sid} = $sid if $sid;
+ }
+
+ foreach my $sid (sort keys %$sidhash) {
+ &$func($sid);
+ }
+}
+
+my $alloc_vmstate_volid = sub {
+ my ($storecfg, $vmid, $conf, $snapname) = @_;
+
+ # Note: we try to be smart when selecting a $target storage
+
+ my $target;
+
+ # search shared storage first
+ foreach_writable_storage($conf, sub {
+ my ($sid) = @_;
+ my $scfg = PVE::Storage::storage_config($storecfg, $sid);
+ return if !$scfg->{shared};
+
+ $target = $sid if !$target || $scfg->{path}; # prefer file based storage
+ });
+
+ if (!$target) {
+ # now search local storage
+ foreach_writable_storage($conf, sub {
+ my ($sid) = @_;
+ my $scfg = PVE::Storage::storage_config($storecfg, $sid);
+ return if $scfg->{shared};
+
+ $target = $sid if !$target || $scfg->{path}; # prefer file based storage;
+ });
+ }
+
+ $target = 'local' if !$target;
+
+ my $driver_state_size = 32; # assume 32MB is enough to safe all driver state;
+ my $size = $conf->{memory} + $driver_state_size;
+
+ my $name = "vm-$vmid-state-$snapname";
+ my $scfg = PVE::Storage::storage_config($storecfg, $target);
+ $name .= ".raw" if $scfg->{path}; # add filename extension for file base storage
+ my $volid = PVE::Storage::vdisk_alloc($storecfg, $target, $vmid, 'raw', $name, $size*1024);
+
+ return $volid;
+};
+
+my $snapshot_prepare = sub {
+ my ($vmid, $snapname, $save_vmstate, $comment) = @_;
+
+ my $snap;
+
+ my $updatefn = sub {
+
+ my $conf = load_config($vmid);
+
+ check_lock($conf);
+
+ $conf->{lock} = 'snapshot';
+
+ die "snapshot name '$snapname' already used\n"
+ if defined($conf->{snapshots}->{$snapname});
+
+ my $storecfg = PVE::Storage::config();
+
+ foreach_drive($conf, sub {
+ my ($ds, $drive) = @_;
+
+ return if drive_is_cdrom($drive);
+ my $volid = $drive->{file};
+
+ my ($storeid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
+ if ($storeid) {
+ my $scfg = PVE::Storage::storage_config($storecfg, $storeid);
+ die "can't snapshot volume '$volid'\n"
+ if !(($scfg->{path} && $volname =~ m/\.qcow2$/) ||
+ ($scfg->{type} eq 'rbd') ||
+ ($scfg->{type} eq 'sheepdog'));
+ } elsif ($volid =~ m|^(/.+)$| && -e $volid) {
+ die "snapshot device '$volid' is not possible\n";
+ } else {
+ die "can't snapshot volume '$volid'\n";
+ }
+ });
+
+
+ $snap = $conf->{snapshots}->{$snapname} = {};
+
+ if ($save_vmstate && check_running($vmid)) {
+ $snap->{vmstate} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
+ }
+
+ &$snapshot_copy_config($conf, $snap);
+
+ $snap->{snapstate} = "prepare";
+ $snap->{snaptime} = time();
+ $snap->{description} = $comment if $comment;
+
+ update_config_nolock($vmid, $conf, 1);
+ };
+
+ lock_config($vmid, $updatefn);
+
+ return $snap;
+};
+
+my $snapshot_commit = sub {
+ my ($vmid, $snapname) = @_;
+
+ my $updatefn = sub {
+
+ my $conf = load_config($vmid);
+
+ die "missing snapshot lock\n"
+ if !($conf->{lock} && $conf->{lock} eq 'snapshot');
+
+ my $snap = $conf->{snapshots}->{$snapname};
+
+ die "snapshot '$snapname' does not exist\n" if !defined($snap);
+
+ die "wrong snapshot state\n"
+ if !($snap->{snapstate} && $snap->{snapstate} eq "prepare");
+
+ delete $snap->{snapstate};
+ delete $conf->{lock};
+
+ my $newconf = &$snapshot_apply_config($conf, $snap);
+
+ $newconf->{parent} = $snapname;
+
+ update_config_nolock($vmid, $newconf, 1);
+ };
+
+ lock_config($vmid, $updatefn);
+};
+
+sub snapshot_rollback {
+ my ($vmid, $snapname) = @_;
+
+ my $snap;
+
+ my $prepare = 1;
+
+ my $storecfg = PVE::Storage::config();
+
+ my $updatefn = sub {
+
+ my $conf = load_config($vmid);
+
+ if ($prepare) {
+ check_lock($conf);
+ vm_stop($storecfg, $vmid, undef, undef, 5, undef, undef);
+ }
+
+ die "unable to rollback vm $vmid: vm is running\n"
+ if check_running($vmid);
+
+ if ($prepare) {
+ $conf->{lock} = 'rollback';
+ } else {
+ die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
+ delete $conf->{lock};
+ }
+
+ $snap = $conf->{snapshots}->{$snapname};
+
+ die "snapshot '$snapname' does not exist\n" if !defined($snap);
+
+ die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
+ if $snap->{snapstate};
+
+ if (!$prepare) {
+ # copy snapshot config to current config
+ $conf = &$snapshot_apply_config($conf, $snap);
+ $conf->{parent} = $snapname;
+ }
+
+ update_config_nolock($vmid, $conf, 1);
+
+ if (!$prepare && $snap->{vmstate}) {
+ my $statefile = PVE::Storage::path($storecfg, $snap->{vmstate});
+ # fixme: this only forws for files currently
+ vm_start($storecfg, $vmid, $statefile);
+ }
+
+ };
+
+ lock_config($vmid, $updatefn);
+
+ foreach_drive($snap, sub {
+ my ($ds, $drive) = @_;
+
+ return if drive_is_cdrom($drive);
+
+ my $volid = $drive->{file};
+ my $device = "drive-$ds";
+
+ PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
+ });
+
+ $prepare = 0;
+ lock_config($vmid, $updatefn);
+}
+
+sub snapshot_create {
+ my ($vmid, $snapname, $save_vmstate, $freezefs, $comment) = @_;
+
+ my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
+
+ $freezefs = $save_vmstate = 0 if !$snap->{vmstate}; # vm is not running
+
+ my $drivehash = {};
+
+ my $running = check_running($vmid);
+
+ eval {
+ # create internal snapshots of all drives
+
+ my $storecfg = PVE::Storage::config();
+
+ if ($running) {
+ if ($snap->{vmstate}) {
+ my $path = PVE::Storage::path($storecfg, $snap->{vmstate});
+ vm_mon_cmd($vmid, "snapshot-start", statefile => $path);
+ } else {
+ vm_mon_cmd($vmid, "snapshot-start");
+ }
+ };
+
+ qga_freezefs($vmid) if $running && $freezefs;
+
+ foreach_drive($snap, sub {
+ my ($ds, $drive) = @_;
+
+ return if drive_is_cdrom($drive);
+
+ my $volid = $drive->{file};
+ my $device = "drive-$ds";
+
+ qemu_volume_snapshot($vmid, $device, $storecfg, $volid, $snapname);
+ $drivehash->{$ds} = 1;
+ });
+ };
+ my $err = $@;
+
+ eval { gqa_unfreezefs($vmid) if $running && $freezefs; };
+ warn $@ if $@;
+
+ eval { vm_mon_cmd($vmid, "snapshot-end") if $running; };
+ warn $@ if $@;
+
+ if ($err) {
+ warn "snapshot create failed: starting cleanup\n";
+ eval { snapshot_delete($vmid, $snapname, 0, $drivehash); };
+ warn $@ if $@;
+ die $err;
+ }
+
+ &$snapshot_commit($vmid, $snapname);
+}
+
+# Note: $drivehash is only set when called from snapshot_create.
+sub snapshot_delete {
+ my ($vmid, $snapname, $force, $drivehash) = @_;
+
+ my $prepare = 1;
+
+ my $snap;
+ my $unused = [];
+
+ my $unlink_parent = sub {
+ my ($confref, $new_parent) = @_;
+
+ if ($confref->{parent} && $confref->{parent} eq $snapname) {
+ if ($new_parent) {
+ $confref->{parent} = $new_parent;
+ } else {
+ delete $confref->{parent};
+ }
+ }
+ };
+
+ my $updatefn = sub {
+ my ($remove_drive) = @_;
+
+ my $conf = load_config($vmid);
+
+ check_lock($conf) if !$drivehash;
+
+ $snap = $conf->{snapshots}->{$snapname};
+
+ die "snapshot '$snapname' does not exist\n" if !defined($snap);
+
+ # remove parent refs
+ &$unlink_parent($conf, $snap->{parent});
+ foreach my $sn (keys %{$conf->{snapshots}}) {
+ next if $sn eq $snapname;
+ &$unlink_parent($conf->{snapshots}->{$sn}, $snap->{parent});
+ }
+
+ if ($remove_drive) {
+ if ($remove_drive eq 'vmstate') {
+ delete $snap->{$remove_drive};
+ } else {
+ my $drive = parse_drive($remove_drive, $snap->{$remove_drive});
+ my $volid = $drive->{file};
+ delete $snap->{$remove_drive};
+ add_unused_volume($conf, $volid);
+ }
+ }
+
+ if ($prepare) {
+ $snap->{snapstate} = 'delete';
+ } else {
+ delete $conf->{snapshots}->{$snapname};
+ delete $conf->{lock} if $drivehash;
+ foreach my $volid (@$unused) {
+ add_unused_volume($conf, $volid);
+ }
+ }
+
+ update_config_nolock($vmid, $conf, 1);
+ };
+
+ lock_config($vmid, $updatefn);
+
+ # now remove vmstate file
+
+ my $storecfg = PVE::Storage::config();
+
+ if ($snap->{vmstate}) {
+ eval { PVE::Storage::vdisk_free($storecfg, $snap->{vmstate}); };
+ if (my $err = $@) {
+ die $err if !$force;
+ warn $err;
+ }
+ # save changes (remove vmstate from snapshot)
+ lock_config($vmid, $updatefn, 'vmstate') if !$force;
+ };
+
+ # now remove all internal snapshots
+ foreach_drive($snap, sub {
+ my ($ds, $drive) = @_;
+
+ return if drive_is_cdrom($drive);
+
+ my $volid = $drive->{file};
+ my $device = "drive-$ds";
+
+ if (!$drivehash || $drivehash->{$ds}) {
+ eval { qemu_volume_snapshot_delete($vmid, $device, $storecfg, $volid, $snapname); };
+ if (my $err = $@) {
+ die $err if !$force;
+ warn $err;
+ }
+ }
+
+ # save changes (remove drive fron snapshot)
+ lock_config($vmid, $updatefn, $ds) if !$force;
+ push @$unused, $volid;
+ });
+
+ # now cleanup config
+ $prepare = 0;
+ lock_config($vmid, $updatefn);
+}
+
1;