1 package PVE
::QemuServer
;
21 use Storable
qw(dclone);
22 use PVE
::Exception
qw(raise raise_param_exc);
24 use PVE
::Tools
qw(run_command lock_file file_read_firstline);
25 use PVE
::JSONSchema
qw(get_standard_option);
26 use PVE
::Cluster
qw(cfs_register_file cfs_read_file cfs_write_file cfs_lock_file);
30 use PVE
::RPCEnvironment
;
31 use Time
::HiRes
qw(gettimeofday);
33 my $cpuinfo = PVE
::ProcFSTools
::read_cpuinfo
();
35 # Note about locking: we use flock on the config file protect
36 # against concurent actions.
37 # Aditionaly, we have a 'lock' setting in the config file. This
38 # can be set to 'migrate', 'backup', 'snapshot' or 'rollback'. Most actions are not
39 # allowed when such lock is set. But you can ignore this kind of
40 # lock with the --skiplock flag.
42 cfs_register_file
('/qemu-server/',
46 PVE
::JSONSchema
::register_standard_option
('skiplock', {
47 description
=> "Ignore locks - only root is allowed to use this option.",
52 PVE
::JSONSchema
::register_standard_option
('pve-qm-stateuri', {
53 description
=> "Some command save/restore state from this location.",
59 PVE
::JSONSchema
::register_standard_option
('pve-snapshot-name', {
60 description
=> "The name of the snapshot.",
61 type
=> 'string', format
=> 'pve-configid',
65 #no warnings 'redefine';
67 unless(defined(&_VZSYSCALLS_H_
)) {
68 eval 'sub _VZSYSCALLS_H_ () {1;}' unless defined(&_VZSYSCALLS_H_
);
69 require 'sys/syscall.ph';
70 if(defined(&__x86_64__
)) {
71 eval 'sub __NR_fairsched_vcpus () {499;}' unless defined(&__NR_fairsched_vcpus
);
72 eval 'sub __NR_fairsched_mknod () {504;}' unless defined(&__NR_fairsched_mknod
);
73 eval 'sub __NR_fairsched_rmnod () {505;}' unless defined(&__NR_fairsched_rmnod
);
74 eval 'sub __NR_fairsched_chwt () {506;}' unless defined(&__NR_fairsched_chwt
);
75 eval 'sub __NR_fairsched_mvpr () {507;}' unless defined(&__NR_fairsched_mvpr
);
76 eval 'sub __NR_fairsched_rate () {508;}' unless defined(&__NR_fairsched_rate
);
77 eval 'sub __NR_setluid () {501;}' unless defined(&__NR_setluid
);
78 eval 'sub __NR_setublimit () {502;}' unless defined(&__NR_setublimit
);
80 elsif(defined( &__i386__
) ) {
81 eval 'sub __NR_fairsched_mknod () {500;}' unless defined(&__NR_fairsched_mknod
);
82 eval 'sub __NR_fairsched_rmnod () {501;}' unless defined(&__NR_fairsched_rmnod
);
83 eval 'sub __NR_fairsched_chwt () {502;}' unless defined(&__NR_fairsched_chwt
);
84 eval 'sub __NR_fairsched_mvpr () {503;}' unless defined(&__NR_fairsched_mvpr
);
85 eval 'sub __NR_fairsched_rate () {504;}' unless defined(&__NR_fairsched_rate
);
86 eval 'sub __NR_fairsched_vcpus () {505;}' unless defined(&__NR_fairsched_vcpus
);
87 eval 'sub __NR_setluid () {511;}' unless defined(&__NR_setluid
);
88 eval 'sub __NR_setublimit () {512;}' unless defined(&__NR_setublimit
);
90 die("no fairsched syscall for this arch");
92 require 'asm/ioctl.ph';
93 eval 'sub KVM_GET_API_VERSION () { &_IO(0xAE, 0x);}' unless defined(&KVM_GET_API_VERSION
);
97 my ($parent, $weight, $desired) = @_;
99 return syscall(&__NR_fairsched_mknod
, int($parent), int($weight), int($desired));
102 sub fairsched_rmnod
{
105 return syscall(&__NR_fairsched_rmnod
, int($id));
109 my ($pid, $newid) = @_;
111 return syscall(&__NR_fairsched_mvpr
, int($pid), int($newid));
114 sub fairsched_vcpus
{
115 my ($id, $vcpus) = @_;
117 return syscall(&__NR_fairsched_vcpus
, int($id), int($vcpus));
121 my ($id, $op, $rate) = @_;
123 return syscall(&__NR_fairsched_rate
, int($id), int($op), int($rate));
126 use constant FAIRSCHED_SET_RATE
=> 0;
127 use constant FAIRSCHED_DROP_RATE
=> 1;
128 use constant FAIRSCHED_GET_RATE
=> 2;
130 sub fairsched_cpulimit
{
131 my ($id, $limit) = @_;
133 my $cpulim1024 = int($limit * 1024 / 100);
134 my $op = $cpulim1024 ? FAIRSCHED_SET_RATE
: FAIRSCHED_DROP_RATE
;
136 return fairsched_rate
($id, $op, $cpulim1024);
139 my $nodename = PVE
::INotify
::nodename
();
141 mkdir "/etc/pve/nodes/$nodename";
142 my $confdir = "/etc/pve/nodes/$nodename/qemu-server";
145 my $var_run_tmpdir = "/var/run/qemu-server";
146 mkdir $var_run_tmpdir;
148 my $lock_dir = "/var/lock/qemu-server";
151 my $pcisysfs = "/sys/bus/pci";
157 description
=> "Specifies whether a VM will be started during system bootup.",
163 description
=> "Automatic restart after crash (currently ignored).",
169 description
=> "Activate hotplug for disk and network device",
175 description
=> "Allow reboot. If set to '0' the VM exit on reboot.",
181 description
=> "Lock/unlock the VM.",
182 enum
=> [qw(migrate backup snapshot rollback)],
187 description
=> "Limit of CPU usage in per cent. Note if the computer has 2 CPUs, it has total of 200% CPU time. Value '0' indicates no CPU limit.\n\nNOTE: This option is currently ignored.",
194 description
=> "CPU weight for a VM. Argument is used in the kernel fair scheduler. The larger the number is, the more CPU time this VM gets. Number is relative to weights of all the other running VMs.\n\nNOTE: You can disable fair-scheduler configuration by setting this to 0.",
202 description
=> "Amount of RAM for the VM in MB. This is the maximum available memory when you use the balloon device.",
209 description
=> "Amount of target RAM for the VM in MB. Using zero disables the ballon driver.",
215 description
=> "Amount of memory shares for auto-ballooning. The larger the number is, the more memory this VM gets. Number is relative to weights of all other running VMs. Using zero disables auto-ballooning",
223 description
=> "Keybord layout for vnc server. Default is read from the datacenter configuration file.",
224 enum
=> PVE
::Tools
::kvmkeymaplist
(),
229 type
=> 'string', format
=> 'dns-name',
230 description
=> "Set a name for the VM. Only used on the configuration web interface.",
235 description
=> "scsi controller model",
236 enum
=> [qw(lsi virtio-scsi-pci megasas)],
242 description
=> "Description for the VM. Only used on the configuration web interface. This is saved as comment inside the configuration file.",
247 enum
=> [qw(other wxp w2k w2k3 w2k8 wvista win7 win8 l24 l26)],
248 description
=> <<EODESC,
249 Used to enable special optimization/features for specific
252 other => unspecified OS
253 wxp => Microsoft Windows XP
254 w2k => Microsoft Windows 2000
255 w2k3 => Microsoft Windows 2003
256 w2k8 => Microsoft Windows 2008
257 wvista => Microsoft Windows Vista
258 win7 => Microsoft Windows 7
259 win8 => Microsoft Windows 8/2012
260 l24 => Linux 2.4 Kernel
261 l26 => Linux 2.6/3.X Kernel
263 other|l24|l26 ... no special behaviour
264 wxp|w2k|w2k3|w2k8|wvista|win7|win8 ... use --localtime switch
270 description
=> "Boot on floppy (a), hard disk (c), CD-ROM (d), or network (n).",
271 pattern
=> '[acdn]{1,4}',
276 type
=> 'string', format
=> 'pve-qm-bootdisk',
277 description
=> "Enable booting from specified disk.",
278 pattern
=> '(ide|sata|scsi|virtio)\d+',
283 description
=> "The number of CPUs. Please use option -sockets instead.",
290 description
=> "The number of CPU sockets.",
297 description
=> "The number of cores per socket.",
304 description
=> "Enable/disable ACPI.",
310 description
=> "Enable/disable Qemu GuestAgent.",
316 description
=> "Enable/disable KVM hardware virtualization.",
322 description
=> "Enable/disable time drift fix.",
328 description
=> "Set the real time clock to local time. This is enabled by default if ostype indicates a Microsoft OS.",
333 description
=> "Freeze CPU at startup (use 'c' monitor command to start execution).",
338 description
=> "Select VGA type. If you want to use high resolution modes (>= 1280x1024x16) then you should use option 'std' or 'vmware'. Default is 'std' for win8/win7/w2k8, and 'cirrur' for other OS types",
339 enum
=> [qw(std cirrus vmware)],
343 type
=> 'string', format
=> 'pve-qm-watchdog',
344 typetext
=> '[[model=]i6300esb|ib700] [,[action=]reset|shutdown|poweroff|pause|debug|none]',
345 description
=> "Create a virtual hardware watchdog device. Once enabled (by a guest action), the watchdog must be periodically polled by an agent inside the guest or else the guest will be restarted (or execute the action specified)",
350 typetext
=> "(now | YYYY-MM-DD | YYYY-MM-DDTHH:MM:SS)",
351 description
=> "Set the initial date of the real time clock. Valid format for date are: 'now' or '2006-06-17T16:01:21' or '2006-06-17'.",
352 pattern
=> '(now|\d{4}-\d{1,2}-\d{1,2}(T\d{1,2}:\d{1,2}:\d{1,2})?)',
357 type
=> 'string', format
=> 'pve-qm-startup',
358 typetext
=> '[[order=]\d+] [,up=\d+] [,down=\d+] ',
359 description
=> "Startup and shutdown behavior. Order is a non-negative number defining the general startup order. Shutdown in done with reverse ordering. Additionally you can set the 'up' or 'down' delay in seconds, which specifies a delay to wait before the next VM is started or stopped.",
364 description
=> <<EODESCR,
365 Note: this option is for experts only. It allows you to pass arbitrary arguments to kvm, for example:
367 args: -no-reboot -no-hpet
374 description
=> "Enable/disable the usb tablet device. This device is usually needed to allow absolute mouse positioning. Else the mouse runs out of sync with normal vnc clients. If you're running lots of console-only guests on one host, you may consider disabling this to save some context switches.",
379 description
=> "Set maximum speed (in MB/s) for migrations. Value 0 is no limit.",
383 migrate_downtime
=> {
386 description
=> "Set maximum tolerated downtime (in seconds) for migrations.",
392 type
=> 'string', format
=> 'pve-qm-drive',
393 typetext
=> 'volume',
394 description
=> "This is an alias for option -ide2",
398 description
=> "Emulated CPU type.",
400 enum
=> [ qw(486 athlon pentium pentium2 pentium3 coreduo core2duo kvm32 kvm64 qemu32 qemu64 phenom Conroe Penryn Nehalem Westmere SandyBridge Haswell Opteron_G1 Opteron_G2 Opteron_G3 Opteron_G4 Opteron_G5 host) ],
403 parent
=> get_standard_option
('pve-snapshot-name', {
405 description
=> "Parent snapshot name. This is used internally, and should not be modified.",
409 description
=> "Timestamp for snapshots.",
415 type
=> 'string', format
=> 'pve-volume-id',
416 description
=> "Reference to a volume which stores the VM state. This is used internally for snapshots.",
420 # what about other qemu settings ?
422 #machine => 'string',
435 ##soundhw => 'string',
437 while (my ($k, $v) = each %$confdesc) {
438 PVE
::JSONSchema
::register_standard_option
("pve-qm-$k", $v);
441 my $MAX_IDE_DISKS = 4;
442 my $MAX_SCSI_DISKS = 14;
443 my $MAX_VIRTIO_DISKS = 16;
444 my $MAX_SATA_DISKS = 6;
445 my $MAX_USB_DEVICES = 5;
447 my $MAX_UNUSED_DISKS = 8;
448 my $MAX_HOSTPCI_DEVICES = 2;
449 my $MAX_SERIAL_PORTS = 4;
450 my $MAX_PARALLEL_PORTS = 3;
452 my $nic_model_list = ['rtl8139', 'ne2k_pci', 'e1000', 'pcnet', 'virtio',
453 'ne2k_isa', 'i82551', 'i82557b', 'i82559er'];
454 my $nic_model_list_txt = join(' ', sort @$nic_model_list);
458 type
=> 'string', format
=> 'pve-qm-net',
459 typetext
=> "MODEL=XX:XX:XX:XX:XX:XX [,bridge=<dev>][,rate=<mbps>][,tag=<vlanid>]",
460 description
=> <<EODESCR,
461 Specify network devices.
463 MODEL is one of: $nic_model_list_txt
465 XX:XX:XX:XX:XX:XX should be an unique MAC address. This is
466 automatically generated if not specified.
468 The bridge parameter can be used to automatically add the interface to a bridge device. The Proxmox VE standard bridge is called 'vmbr0'.
470 Option 'rate' is used to limit traffic bandwidth from and to this interface. It is specified as floating point number, unit is 'Megabytes per second'.
472 If you specify no bridge, we create a kvm 'user' (NATed) network device, which provides DHCP and DNS services. The following addresses are used:
478 The DHCP server assign addresses to the guest starting from 10.0.2.15.
482 PVE
::JSONSchema
::register_standard_option
("pve-qm-net", $netdesc);
484 for (my $i = 0; $i < $MAX_NETS; $i++) {
485 $confdesc->{"net$i"} = $netdesc;
492 type
=> 'string', format
=> 'pve-qm-drive',
493 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]',
494 description
=> "Use volume as IDE hard disk or CD-ROM (n is 0 to " .($MAX_IDE_DISKS -1) . ").",
496 PVE
::JSONSchema
::register_standard_option
("pve-qm-ide", $idedesc);
500 type
=> 'string', format
=> 'pve-qm-drive',
501 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]',
502 description
=> "Use volume as SCSI hard disk or CD-ROM (n is 0 to " . ($MAX_SCSI_DISKS - 1) . ").",
504 PVE
::JSONSchema
::register_standard_option
("pve-qm-scsi", $scsidesc);
508 type
=> 'string', format
=> 'pve-qm-drive',
509 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]',
510 description
=> "Use volume as SATA hard disk or CD-ROM (n is 0 to " . ($MAX_SATA_DISKS - 1). ").",
512 PVE
::JSONSchema
::register_standard_option
("pve-qm-sata", $satadesc);
516 type
=> 'string', format
=> 'pve-qm-drive',
517 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]',
518 description
=> "Use volume as VIRTIO hard disk (n is 0 to " . ($MAX_VIRTIO_DISKS - 1) . ").",
520 PVE
::JSONSchema
::register_standard_option
("pve-qm-virtio", $virtiodesc);
524 type
=> 'string', format
=> 'pve-qm-usb-device',
525 typetext
=> 'host=HOSTUSBDEVICE',
526 description
=> <<EODESCR,
527 Configure an USB device (n is 0 to 4). This can be used to
528 pass-through usb devices to the guest. HOSTUSBDEVICE syntax is:
530 'bus-port(.port)*' (decimal numbers) or
531 'vendor_id:product_id' (hexadeciaml numbers)
533 You can use the 'lsusb -t' command to list existing usb devices.
535 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
539 PVE
::JSONSchema
::register_standard_option
("pve-qm-usb", $usbdesc);
543 type
=> 'string', format
=> 'pve-qm-hostpci',
544 typetext
=> "HOSTPCIDEVICE",
545 description
=> <<EODESCR,
546 Map host pci devices. HOSTPCIDEVICE syntax is:
548 'bus:dev.func' (hexadecimal numbers)
550 You can us the 'lspci' command to list existing pci devices.
552 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
554 Experimental: user reported problems with this option.
557 PVE
::JSONSchema
::register_standard_option
("pve-qm-hostpci", $hostpcidesc);
562 pattern
=> '/dev/ttyS\d+',
563 description
=> <<EODESCR,
564 Map host serial devices (n is 0 to 3).
566 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
568 Experimental: user reported problems with this option.
575 pattern
=> '/dev/parport\d+',
576 description
=> <<EODESCR,
577 Map host parallel devices (n is 0 to 2).
579 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
581 Experimental: user reported problems with this option.
585 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
586 $confdesc->{"parallel$i"} = $paralleldesc;
589 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
590 $confdesc->{"serial$i"} = $serialdesc;
593 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
594 $confdesc->{"hostpci$i"} = $hostpcidesc;
597 for (my $i = 0; $i < $MAX_IDE_DISKS; $i++) {
598 $drivename_hash->{"ide$i"} = 1;
599 $confdesc->{"ide$i"} = $idedesc;
602 for (my $i = 0; $i < $MAX_SATA_DISKS; $i++) {
603 $drivename_hash->{"sata$i"} = 1;
604 $confdesc->{"sata$i"} = $satadesc;
607 for (my $i = 0; $i < $MAX_SCSI_DISKS; $i++) {
608 $drivename_hash->{"scsi$i"} = 1;
609 $confdesc->{"scsi$i"} = $scsidesc ;
612 for (my $i = 0; $i < $MAX_VIRTIO_DISKS; $i++) {
613 $drivename_hash->{"virtio$i"} = 1;
614 $confdesc->{"virtio$i"} = $virtiodesc;
617 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
618 $confdesc->{"usb$i"} = $usbdesc;
623 type
=> 'string', format
=> 'pve-volume-id',
624 description
=> "Reference to unused volumes.",
627 for (my $i = 0; $i < $MAX_UNUSED_DISKS; $i++) {
628 $confdesc->{"unused$i"} = $unuseddesc;
631 my $kvm_api_version = 0;
635 return $kvm_api_version if $kvm_api_version;
637 my $fh = IO
::File-
>new("</dev/kvm") ||
640 if (my $v = $fh->ioctl(KVM_GET_API_VERSION
(), 0)) {
641 $kvm_api_version = $v;
646 return $kvm_api_version;
649 my $kvm_user_version;
651 sub kvm_user_version
{
653 return $kvm_user_version if $kvm_user_version;
655 $kvm_user_version = 'unknown';
657 my $tmp = `kvm -help 2>/dev/null`;
659 if ($tmp =~ m/^QEMU( PC)? emulator version (\d+\.\d+(\.\d+)?)[,\s]/) {
660 $kvm_user_version = $2;
663 return $kvm_user_version;
667 my $kernel_has_vhost_net = -c
'/dev/vhost-net';
670 # order is important - used to autoselect boot disk
671 return ((map { "ide$_" } (0 .. ($MAX_IDE_DISKS - 1))),
672 (map { "scsi$_" } (0 .. ($MAX_SCSI_DISKS - 1))),
673 (map { "virtio$_" } (0 .. ($MAX_VIRTIO_DISKS - 1))),
674 (map { "sata$_" } (0 .. ($MAX_SATA_DISKS - 1))));
677 sub valid_drivename
{
680 return defined($drivename_hash->{$dev});
685 return defined($confdesc->{$key});
689 return $nic_model_list;
692 sub os_list_description
{
697 w2k
=> 'Windows 2000',
698 w2k3
=>, 'Windows 2003',
699 w2k8
=> 'Windows 2008',
700 wvista
=> 'Windows Vista',
702 win8
=> 'Windows 8/2012',
712 return $cdrom_path if $cdrom_path;
714 return $cdrom_path = "/dev/cdrom" if -l
"/dev/cdrom";
715 return $cdrom_path = "/dev/cdrom1" if -l
"/dev/cdrom1";
716 return $cdrom_path = "/dev/cdrom2" if -l
"/dev/cdrom2";
720 my ($storecfg, $vmid, $cdrom) = @_;
722 if ($cdrom eq 'cdrom') {
723 return get_cdrom_path
();
724 } elsif ($cdrom eq 'none') {
726 } elsif ($cdrom =~ m
|^/|) {
729 return PVE
::Storage
::path
($storecfg, $cdrom);
733 # try to convert old style file names to volume IDs
734 sub filename_to_volume_id
{
735 my ($vmid, $file, $media) = @_;
737 if (!($file eq 'none' || $file eq 'cdrom' ||
738 $file =~ m
|^/dev/.+| || $file =~ m/^([^:]+):(.+)$/)) {
740 return undef if $file =~ m
|/|;
742 if ($media && $media eq 'cdrom') {
743 $file = "local:iso/$file";
745 $file = "local:$vmid/$file";
752 sub verify_media_type
{
753 my ($opt, $vtype, $media) = @_;
758 if ($media eq 'disk') {
760 } elsif ($media eq 'cdrom') {
763 die "internal error";
766 return if ($vtype eq $etype);
768 raise_param_exc
({ $opt => "unexpected media type ($vtype != $etype)" });
771 sub cleanup_drive_path
{
772 my ($opt, $storecfg, $drive) = @_;
774 # try to convert filesystem paths to volume IDs
776 if (($drive->{file
} !~ m/^(cdrom|none)$/) &&
777 ($drive->{file
} !~ m
|^/dev/.+|) &&
778 ($drive->{file
} !~ m/^([^:]+):(.+)$/) &&
779 ($drive->{file
} !~ m/^\d+$/)) {
780 my ($vtype, $volid) = PVE
::Storage
::path_to_volume_id
($storecfg, $drive->{file
});
781 raise_param_exc
({ $opt => "unable to associate path '$drive->{file}' to any storage"}) if !$vtype;
782 $drive->{media
} = 'cdrom' if !$drive->{media
} && $vtype eq 'iso';
783 verify_media_type
($opt, $vtype, $drive->{media
});
784 $drive->{file
} = $volid;
787 $drive->{media
} = 'cdrom' if !$drive->{media
} && $drive->{file
} =~ m/^(cdrom|none)$/;
790 sub create_conf_nolock
{
791 my ($vmid, $settings) = @_;
793 my $filename = config_file
($vmid);
795 die "configuration file '$filename' already exists\n" if -f
$filename;
797 my $defaults = load_defaults
();
799 $settings->{name
} = "vm$vmid" if !$settings->{name
};
800 $settings->{memory
} = $defaults->{memory
} if !$settings->{memory
};
803 foreach my $opt (keys %$settings) {
804 next if !$confdesc->{$opt};
806 my $value = $settings->{$opt};
809 $data .= "$opt: $value\n";
812 PVE
::Tools
::file_set_contents
($filename, $data);
815 my $parse_size = sub {
818 return undef if $value !~ m/^(\d+(\.\d+)?)([KMG])?$/;
819 my ($size, $unit) = ($1, $3);
822 $size = $size * 1024;
823 } elsif ($unit eq 'M') {
824 $size = $size * 1024 * 1024;
825 } elsif ($unit eq 'G') {
826 $size = $size * 1024 * 1024 * 1024;
832 my $format_size = sub {
837 my $kb = int($size/1024);
838 return $size if $kb*1024 != $size;
840 my $mb = int($kb/1024);
841 return "${kb}K" if $mb*1024 != $kb;
843 my $gb = int($mb/1024);
844 return "${mb}M" if $gb*1024 != $mb;
849 # ideX = [volume=]volume-id[,media=d][,cyls=c,heads=h,secs=s[,trans=t]]
850 # [,snapshot=on|off][,cache=on|off][,format=f][,backup=yes|no]
851 # [,rerror=ignore|report|stop][,werror=enospc|ignore|report|stop]
852 # [,aio=native|threads]
855 my ($key, $data) = @_;
859 # $key may be undefined - used to verify JSON parameters
860 if (!defined($key)) {
861 $res->{interface
} = 'unknown'; # should not harm when used to verify parameters
863 } elsif ($key =~ m/^([^\d]+)(\d+)$/) {
864 $res->{interface
} = $1;
870 foreach my $p (split (/,/, $data)) {
871 next if $p =~ m/^\s*$/;
873 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)=(.+)$/) {
874 my ($k, $v) = ($1, $2);
876 $k = 'file' if $k eq 'volume';
878 return undef if defined $res->{$k};
880 if ($k eq 'bps' || $k eq 'bps_rd' || $k eq 'bps_wr') {
881 return undef if !$v || $v !~ m/^\d+/;
883 $v = sprintf("%.3f", $v / (1024*1024));
887 if (!$res->{file
} && $p !~ m/=/) {
895 return undef if !$res->{file
};
897 return undef if $res->{cache
} &&
898 $res->{cache
} !~ m/^(off|none|writethrough|writeback|unsafe|directsync)$/;
899 return undef if $res->{snapshot
} && $res->{snapshot
} !~ m/^(on|off)$/;
900 return undef if $res->{cyls
} && $res->{cyls
} !~ m/^\d+$/;
901 return undef if $res->{heads
} && $res->{heads
} !~ m/^\d+$/;
902 return undef if $res->{secs
} && $res->{secs
} !~ m/^\d+$/;
903 return undef if $res->{media
} && $res->{media
} !~ m/^(disk|cdrom)$/;
904 return undef if $res->{trans
} && $res->{trans
} !~ m/^(none|lba|auto)$/;
905 return undef if $res->{format
} && $res->{format
} !~ m/^(raw|cow|qcow|qcow2|vmdk|cloop)$/;
906 return undef if $res->{rerror
} && $res->{rerror
} !~ m/^(ignore|report|stop)$/;
907 return undef if $res->{werror
} && $res->{werror
} !~ m/^(enospc|ignore|report|stop)$/;
908 return undef if $res->{backup
} && $res->{backup
} !~ m/^(yes|no)$/;
909 return undef if $res->{aio
} && $res->{aio
} !~ m/^(native|threads)$/;
912 return undef if $res->{mbps_rd
} && $res->{mbps
};
913 return undef if $res->{mbps_wr
} && $res->{mbps
};
915 return undef if $res->{mbps
} && $res->{mbps
} !~ m/^\d+(\.\d+)?$/;
916 return undef if $res->{mbps_rd
} && $res->{mbps_rd
} !~ m/^\d+(\.\d+)?$/;
917 return undef if $res->{mbps_wr
} && $res->{mbps_wr
} !~ m/^\d+(\.\d+)?$/;
919 return undef if $res->{iops_rd
} && $res->{iops
};
920 return undef if $res->{iops_wr
} && $res->{iops
};
921 return undef if $res->{iops
} && $res->{iops
} !~ m/^\d+$/;
922 return undef if $res->{iops_rd
} && $res->{iops_rd
} !~ m/^\d+$/;
923 return undef if $res->{iops_wr
} && $res->{iops_wr
} !~ m/^\d+$/;
927 return undef if !defined($res->{size
} = &$parse_size($res->{size
}));
930 if ($res->{media
} && ($res->{media
} eq 'cdrom')) {
931 return undef if $res->{snapshot
} || $res->{trans
} || $res->{format
};
932 return undef if $res->{heads
} || $res->{secs
} || $res->{cyls
};
933 return undef if $res->{interface
} eq 'virtio';
936 # rerror does not work with scsi drives
937 if ($res->{rerror
}) {
938 return undef if $res->{interface
} eq 'scsi';
944 my @qemu_drive_options = qw(heads secs cyls trans media format cache snapshot rerror werror aio iops iops_rd iops_wr);
947 my ($vmid, $drive) = @_;
950 foreach my $o (@qemu_drive_options, 'mbps', 'mbps_rd', 'mbps_wr', 'backup') {
951 $opts .= ",$o=$drive->{$o}" if $drive->{$o};
954 if ($drive->{size
}) {
955 $opts .= ",size=" . &$format_size($drive->{size
});
958 return "$drive->{file}$opts";
962 my($fh, $noerr) = @_;
965 my $SG_GET_VERSION_NUM = 0x2282;
967 my $versionbuf = "\x00" x
8;
968 my $ret = ioctl($fh, $SG_GET_VERSION_NUM, $versionbuf);
970 die "scsi ioctl SG_GET_VERSION_NUM failoed - $!\n" if !$noerr;
973 my $version = unpack("I", $versionbuf);
974 if ($version < 30000) {
975 die "scsi generic interface too old\n" if !$noerr;
979 my $buf = "\x00" x
36;
980 my $sensebuf = "\x00" x
8;
981 my $cmd = pack("C x3 C x11", 0x12, 36);
983 # see /usr/include/scsi/sg.h
984 my $sg_io_hdr_t = "i i C C s I P P P I I i P C C C C S S i I I";
986 my $packet = pack($sg_io_hdr_t, ord('S'), -3, length($cmd),
987 length($sensebuf), 0, length($buf), $buf,
988 $cmd, $sensebuf, 6000);
990 $ret = ioctl($fh, $SG_IO, $packet);
992 die "scsi ioctl SG_IO failed - $!\n" if !$noerr;
996 my @res = unpack($sg_io_hdr_t, $packet);
997 if ($res[17] || $res[18]) {
998 die "scsi ioctl SG_IO status error - $!\n" if !$noerr;
1003 ($res->{device
}, $res->{removable
}, $res->{venodor
},
1004 $res->{product
}, $res->{revision
}) = unpack("C C x6 A8 A16 A4", $buf);
1012 my $fh = IO
::File-
>new("+<$path") || return undef;
1013 my $res = scsi_inquiry
($fh, 1);
1019 sub print_drivedevice_full
{
1020 my ($storecfg, $conf, $vmid, $drive, $bridges) = @_;
1025 if ($drive->{interface
} eq 'virtio') {
1026 my $pciaddr = print_pci_addr
("$drive->{interface}$drive->{index}", $bridges);
1027 $device = "virtio-blk-pci,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}$pciaddr";
1028 } elsif ($drive->{interface
} eq 'scsi') {
1029 $maxdev = ($conf->{scsihw
} && $conf->{scsihw
} ne 'lsi') ?
256 : 7;
1030 my $controller = int($drive->{index} / $maxdev);
1031 my $unit = $drive->{index} % $maxdev;
1032 my $devicetype = 'hd';
1034 if (drive_is_cdrom
($drive)) {
1037 if ($drive->{file
} =~ m
|^/|) {
1038 $path = $drive->{file
};
1040 $path = PVE
::Storage
::path
($storecfg, $drive->{file
});
1043 if($path =~ m/^iscsi\:\/\
//){
1044 $devicetype = 'generic';
1047 $devicetype = 'block' if path_is_scsi
($path);
1051 if (!$conf->{scsihw
} || $conf->{scsihw
} eq 'lsi'){
1052 $device = "scsi-$devicetype,bus=scsihw$controller.0,scsi-id=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}" if !$conf->{scsihw
} || $conf->{scsihw
} eq 'lsi';
1054 $device = "scsi-$devicetype,bus=scsihw$controller.0,channel=0,scsi-id=0,lun=$drive->{index},drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1057 } elsif ($drive->{interface
} eq 'ide'){
1059 my $controller = int($drive->{index} / $maxdev);
1060 my $unit = $drive->{index} % $maxdev;
1061 my $devicetype = ($drive->{media
} && $drive->{media
} eq 'cdrom') ?
"cd" : "hd";
1063 $device = "ide-$devicetype,bus=ide.$controller,unit=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1064 } elsif ($drive->{interface
} eq 'sata'){
1065 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
1066 my $unit = $drive->{index} % $MAX_SATA_DISKS;
1067 $device = "ide-drive,bus=ahci$controller.$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1068 } elsif ($drive->{interface
} eq 'usb') {
1070 # -device ide-drive,bus=ide.1,unit=0,drive=drive-ide0-1-0,id=ide0-1-0
1072 die "unsupported interface type";
1075 $device .= ",bootindex=$drive->{bootindex}" if $drive->{bootindex
};
1080 sub print_drive_full
{
1081 my ($storecfg, $vmid, $drive) = @_;
1084 foreach my $o (@qemu_drive_options) {
1085 next if $o eq 'bootindex';
1086 $opts .= ",$o=$drive->{$o}" if $drive->{$o};
1089 foreach my $o (qw(bps bps_rd bps_wr)) {
1090 my $v = $drive->{"m$o"};
1091 $opts .= ",$o=" . int($v*1024*1024) if $v;
1094 # use linux-aio by default (qemu default is threads)
1095 $opts .= ",aio=native" if !$drive->{aio
};
1098 my $volid = $drive->{file
};
1099 if (drive_is_cdrom
($drive)) {
1100 $path = get_iso_path
($storecfg, $vmid, $volid);
1102 if ($volid =~ m
|^/|) {
1105 $path = PVE
::Storage
::path
($storecfg, $volid);
1109 my $pathinfo = $path ?
"file=$path," : '';
1111 return "${pathinfo}if=none,id=drive-$drive->{interface}$drive->{index}$opts";
1114 sub print_netdevice_full
{
1115 my ($vmid, $conf, $net, $netid, $bridges) = @_;
1117 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
1119 my $device = $net->{model
};
1120 if ($net->{model
} eq 'virtio') {
1121 $device = 'virtio-net-pci';
1124 # qemu > 0.15 always try to boot from network - we disable that by
1125 # not loading the pxe rom file
1126 my $extra = ($bootorder !~ m/n/) ?
"romfile=," : '';
1127 my $pciaddr = print_pci_addr
("$netid", $bridges);
1128 my $tmpstr = "$device,${extra}mac=$net->{macaddr},netdev=$netid$pciaddr,id=$netid";
1129 $tmpstr .= ",bootindex=$net->{bootindex}" if $net->{bootindex
} ;
1133 sub print_netdev_full
{
1134 my ($vmid, $conf, $net, $netid) = @_;
1137 if ($netid =~ m/^net(\d+)$/) {
1141 die "got strange net id '$i'\n" if $i >= ${MAX_NETS
};
1143 my $ifname = "tap${vmid}i$i";
1145 # kvm uses TUNSETIFF ioctl, and that limits ifname length
1146 die "interface name '$ifname' is too long (max 15 character)\n"
1147 if length($ifname) >= 16;
1149 my $vhostparam = '';
1150 $vhostparam = ',vhost=on' if $kernel_has_vhost_net && $net->{model
} eq 'virtio';
1152 my $vmname = $conf->{name
} || "vm$vmid";
1154 if ($net->{bridge
}) {
1155 return "type=tap,id=$netid,ifname=${ifname},script=/var/lib/qemu-server/pve-bridge$vhostparam";
1157 return "type=user,id=$netid,hostname=$vmname";
1161 sub drive_is_cdrom
{
1164 return $drive && $drive->{media
} && ($drive->{media
} eq 'cdrom');
1171 return undef if !$value;
1175 if ($value =~ m/^[a-f0-9]{2}:[a-f0-9]{2}\.[a-f0-9]$/) {
1176 $res->{pciid
} = $value;
1184 # netX: e1000=XX:XX:XX:XX:XX:XX,bridge=vmbr0,rate=<mbps>
1190 foreach my $kvp (split(/,/, $data)) {
1192 if ($kvp =~ m/^(ne2k_pci|e1000|rtl8139|pcnet|virtio|ne2k_isa|i82551|i82557b|i82559er)(=([0-9a-f]{2}(:[0-9a-f]{2}){5}))?$/i) {
1194 my $mac = uc($3) || PVE
::Tools
::random_ether_addr
();
1195 $res->{model
} = $model;
1196 $res->{macaddr
} = $mac;
1197 } elsif ($kvp =~ m/^bridge=(\S+)$/) {
1198 $res->{bridge
} = $1;
1199 } elsif ($kvp =~ m/^rate=(\d+(\.\d+)?)$/) {
1201 } elsif ($kvp =~ m/^tag=(\d+)$/) {
1209 return undef if !$res->{model
};
1217 my $res = "$net->{model}";
1218 $res .= "=$net->{macaddr}" if $net->{macaddr
};
1219 $res .= ",bridge=$net->{bridge}" if $net->{bridge
};
1220 $res .= ",rate=$net->{rate}" if $net->{rate
};
1221 $res .= ",tag=$net->{tag}" if $net->{tag
};
1226 sub add_random_macs
{
1227 my ($settings) = @_;
1229 foreach my $opt (keys %$settings) {
1230 next if $opt !~ m/^net(\d+)$/;
1231 my $net = parse_net
($settings->{$opt});
1233 $settings->{$opt} = print_net
($net);
1237 sub add_unused_volume
{
1238 my ($config, $volid) = @_;
1241 for (my $ind = $MAX_UNUSED_DISKS - 1; $ind >= 0; $ind--) {
1242 my $test = "unused$ind";
1243 if (my $vid = $config->{$test}) {
1244 return if $vid eq $volid; # do not add duplicates
1250 die "To many unused volume - please delete them first.\n" if !$key;
1252 $config->{$key} = $volid;
1257 PVE
::JSONSchema
::register_format
('pve-qm-bootdisk', \
&verify_bootdisk
);
1258 sub verify_bootdisk
{
1259 my ($value, $noerr) = @_;
1261 return $value if valid_drivename
($value);
1263 return undef if $noerr;
1265 die "invalid boot disk '$value'\n";
1268 PVE
::JSONSchema
::register_format
('pve-qm-net', \
&verify_net
);
1270 my ($value, $noerr) = @_;
1272 return $value if parse_net
($value);
1274 return undef if $noerr;
1276 die "unable to parse network options\n";
1279 PVE
::JSONSchema
::register_format
('pve-qm-drive', \
&verify_drive
);
1281 my ($value, $noerr) = @_;
1283 return $value if parse_drive
(undef, $value);
1285 return undef if $noerr;
1287 die "unable to parse drive options\n";
1290 PVE
::JSONSchema
::register_format
('pve-qm-hostpci', \
&verify_hostpci
);
1291 sub verify_hostpci
{
1292 my ($value, $noerr) = @_;
1294 return $value if parse_hostpci
($value);
1296 return undef if $noerr;
1298 die "unable to parse pci id\n";
1301 PVE
::JSONSchema
::register_format
('pve-qm-watchdog', \
&verify_watchdog
);
1302 sub verify_watchdog
{
1303 my ($value, $noerr) = @_;
1305 return $value if parse_watchdog
($value);
1307 return undef if $noerr;
1309 die "unable to parse watchdog options\n";
1312 sub parse_watchdog
{
1315 return undef if !$value;
1319 foreach my $p (split(/,/, $value)) {
1320 next if $p =~ m/^\s*$/;
1322 if ($p =~ m/^(model=)?(i6300esb|ib700)$/) {
1324 } elsif ($p =~ m/^(action=)?(reset|shutdown|poweroff|pause|debug|none)$/) {
1325 $res->{action
} = $2;
1334 PVE
::JSONSchema
::register_format
('pve-qm-startup', \
&verify_startup
);
1335 sub verify_startup
{
1336 my ($value, $noerr) = @_;
1338 return $value if parse_startup
($value);
1340 return undef if $noerr;
1342 die "unable to parse startup options\n";
1348 return undef if !$value;
1352 foreach my $p (split(/,/, $value)) {
1353 next if $p =~ m/^\s*$/;
1355 if ($p =~ m/^(order=)?(\d+)$/) {
1357 } elsif ($p =~ m/^up=(\d+)$/) {
1359 } elsif ($p =~ m/^down=(\d+)$/) {
1369 sub parse_usb_device
{
1372 return undef if !$value;
1374 my @dl = split(/,/, $value);
1378 foreach my $v (@dl) {
1379 if ($v =~ m/^host=(0x)?([0-9A-Fa-f]{4}):(0x)?([0-9A-Fa-f]{4})$/) {
1381 $res->{vendorid
} = $2;
1382 $res->{productid
} = $4;
1383 } elsif ($v =~ m/^host=(\d+)\-(\d+(\.\d+)*)$/) {
1385 $res->{hostbus
} = $1;
1386 $res->{hostport
} = $2;
1391 return undef if !$found;
1396 PVE
::JSONSchema
::register_format
('pve-qm-usb-device', \
&verify_usb_device
);
1397 sub verify_usb_device
{
1398 my ($value, $noerr) = @_;
1400 return $value if parse_usb_device
($value);
1402 return undef if $noerr;
1404 die "unable to parse usb device\n";
1407 # add JSON properties for create and set function
1408 sub json_config_properties
{
1411 foreach my $opt (keys %$confdesc) {
1412 next if $opt eq 'parent' || $opt eq 'snaptime' || $opt eq 'vmstate';
1413 $prop->{$opt} = $confdesc->{$opt};
1420 my ($key, $value) = @_;
1422 die "unknown setting '$key'\n" if !$confdesc->{$key};
1424 my $type = $confdesc->{$key}->{type
};
1426 if (!defined($value)) {
1427 die "got undefined value\n";
1430 if ($value =~ m/[\n\r]/) {
1431 die "property contains a line feed\n";
1434 if ($type eq 'boolean') {
1435 return 1 if ($value eq '1') || ($value =~ m/^(on|yes|true)$/i);
1436 return 0 if ($value eq '0') || ($value =~ m/^(off|no|false)$/i);
1437 die "type check ('boolean') failed - got '$value'\n";
1438 } elsif ($type eq 'integer') {
1439 return int($1) if $value =~ m/^(\d+)$/;
1440 die "type check ('integer') failed - got '$value'\n";
1441 } elsif ($type eq 'number') {
1442 return $value if $value =~ m/^(\d+)(\.\d+)?$/;
1443 die "type check ('number') failed - got '$value'\n";
1444 } elsif ($type eq 'string') {
1445 if (my $fmt = $confdesc->{$key}->{format
}) {
1446 if ($fmt eq 'pve-qm-drive') {
1447 # special case - we need to pass $key to parse_drive()
1448 my $drive = parse_drive
($key, $value);
1449 return $value if $drive;
1450 die "unable to parse drive options\n";
1452 PVE
::JSONSchema
::check_format
($fmt, $value);
1455 $value =~ s/^\"(.*)\"$/$1/;
1458 die "internal error"
1462 sub lock_config_full
{
1463 my ($vmid, $timeout, $code, @param) = @_;
1465 my $filename = config_file_lock
($vmid);
1467 my $res = lock_file
($filename, $timeout, $code, @param);
1475 my ($vmid, $code, @param) = @_;
1477 return lock_config_full
($vmid, 10, $code, @param);
1480 sub cfs_config_path
{
1481 my ($vmid, $node) = @_;
1483 $node = $nodename if !$node;
1484 return "nodes/$node/qemu-server/$vmid.conf";
1487 sub check_iommu_support
{
1488 #fixme : need to check IOMMU support
1489 #http://www.linux-kvm.org/page/How_to_assign_devices_with_VT-d_in_KVM
1497 my ($vmid, $node) = @_;
1499 my $cfspath = cfs_config_path
($vmid, $node);
1500 return "/etc/pve/$cfspath";
1503 sub config_file_lock
{
1506 return "$lock_dir/lock-$vmid.conf";
1512 my $conf = config_file
($vmid);
1513 utime undef, undef, $conf;
1517 my ($storecfg, $vmid, $keep_empty_config) = @_;
1519 my $conffile = config_file
($vmid);
1521 my $conf = load_config
($vmid);
1525 # only remove disks owned by this VM
1526 foreach_drive
($conf, sub {
1527 my ($ds, $drive) = @_;
1529 return if drive_is_cdrom
($drive);
1531 my $volid = $drive->{file
};
1533 return if !$volid || $volid =~ m
|^/|;
1535 my ($path, $owner) = PVE
::Storage
::path
($storecfg, $volid);
1536 return if !$path || !$owner || ($owner != $vmid);
1538 PVE
::Storage
::vdisk_free
($storecfg, $volid);
1541 if ($keep_empty_config) {
1542 PVE
::Tools
::file_set_contents
($conffile, "memory: 128\n");
1547 # also remove unused disk
1549 my $dl = PVE
::Storage
::vdisk_list
($storecfg, undef, $vmid);
1552 PVE
::Storage
::foreach_volid
($dl, sub {
1553 my ($volid, $sid, $volname, $d) = @_;
1554 PVE
::Storage
::vdisk_free
($storecfg, $volid);
1564 my ($vmid, $node) = @_;
1566 my $cfspath = cfs_config_path
($vmid, $node);
1568 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath);
1570 die "no such VM ('$vmid')\n" if !defined($conf);
1575 sub parse_vm_config
{
1576 my ($filename, $raw) = @_;
1578 return undef if !defined($raw);
1581 digest
=> Digest
::SHA
::sha1_hex
($raw),
1585 $filename =~ m
|/qemu-server/(\d
+)\
.conf
$|
1586 || die "got strange filename '$filename'";
1593 my @lines = split(/\n/, $raw);
1594 foreach my $line (@lines) {
1595 next if $line =~ m/^\s*$/;
1597 if ($line =~ m/^\[([a-z][a-z0-9_\-]+)\]\s*$/i) {
1599 $conf->{description
} = $descr if $descr;
1601 $conf = $res->{snapshots
}->{$snapname} = {};
1605 if ($line =~ m/^\#(.*)\s*$/) {
1606 $descr .= PVE
::Tools
::decode_text
($1) . "\n";
1610 if ($line =~ m/^(description):\s*(.*\S)\s*$/) {
1611 $descr .= PVE
::Tools
::decode_text
($2);
1612 } elsif ($line =~ m/snapstate:\s*(prepare|delete)\s*$/) {
1613 $conf->{snapstate
} = $1;
1614 } elsif ($line =~ m/^(args):\s*(.*\S)\s*$/) {
1617 $conf->{$key} = $value;
1618 } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/) {
1621 eval { $value = check_type
($key, $value); };
1623 warn "vm $vmid - unable to parse value of '$key' - $@";
1625 my $fmt = $confdesc->{$key}->{format
};
1626 if ($fmt && $fmt eq 'pve-qm-drive') {
1627 my $v = parse_drive
($key, $value);
1628 if (my $volid = filename_to_volume_id
($vmid, $v->{file
}, $v->{media
})) {
1629 $v->{file
} = $volid;
1630 $value = print_drive
($vmid, $v);
1632 warn "vm $vmid - unable to parse value of '$key'\n";
1637 if ($key eq 'cdrom') {
1638 $conf->{ide2
} = $value;
1640 $conf->{$key} = $value;
1646 $conf->{description
} = $descr if $descr;
1648 delete $res->{snapstate
}; # just to be sure
1653 sub write_vm_config
{
1654 my ($filename, $conf) = @_;
1656 delete $conf->{snapstate
}; # just to be sure
1658 if ($conf->{cdrom
}) {
1659 die "option ide2 conflicts with cdrom\n" if $conf->{ide2
};
1660 $conf->{ide2
} = $conf->{cdrom
};
1661 delete $conf->{cdrom
};
1664 # we do not use 'smp' any longer
1665 if ($conf->{sockets
}) {
1666 delete $conf->{smp
};
1667 } elsif ($conf->{smp
}) {
1668 $conf->{sockets
} = $conf->{smp
};
1669 delete $conf->{cores
};
1670 delete $conf->{smp
};
1673 my $used_volids = {};
1675 my $cleanup_config = sub {
1678 foreach my $key (keys %$cref) {
1679 next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots' ||
1680 $key eq 'snapstate';
1681 my $value = $cref->{$key};
1682 eval { $value = check_type
($key, $value); };
1683 die "unable to parse value of '$key' - $@" if $@;
1685 $cref->{$key} = $value;
1687 if (valid_drivename
($key)) {
1688 my $drive = parse_drive
($key, $value);
1689 $used_volids->{$drive->{file
}} = 1 if $drive && $drive->{file
};
1694 &$cleanup_config($conf);
1695 foreach my $snapname (keys %{$conf->{snapshots
}}) {
1696 &$cleanup_config($conf->{snapshots
}->{$snapname});
1699 # remove 'unusedX' settings if we re-add a volume
1700 foreach my $key (keys %$conf) {
1701 my $value = $conf->{$key};
1702 if ($key =~ m/^unused/ && $used_volids->{$value}) {
1703 delete $conf->{$key};
1707 my $generate_raw_config = sub {
1712 # add description as comment to top of file
1713 my $descr = $conf->{description
} || '';
1714 foreach my $cl (split(/\n/, $descr)) {
1715 $raw .= '#' . PVE
::Tools
::encode_text
($cl) . "\n";
1718 foreach my $key (sort keys %$conf) {
1719 next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots';
1720 $raw .= "$key: $conf->{$key}\n";
1725 my $raw = &$generate_raw_config($conf);
1726 foreach my $snapname (sort keys %{$conf->{snapshots
}}) {
1727 $raw .= "\n[$snapname]\n";
1728 $raw .= &$generate_raw_config($conf->{snapshots
}->{$snapname});
1734 sub update_config_nolock
{
1735 my ($vmid, $conf, $skiplock) = @_;
1737 check_lock
($conf) if !$skiplock;
1739 my $cfspath = cfs_config_path
($vmid);
1741 PVE
::Cluster
::cfs_write_file
($cfspath, $conf);
1745 my ($vmid, $conf, $skiplock) = @_;
1747 lock_config
($vmid, &update_config_nolock
, $conf, $skiplock);
1754 # we use static defaults from our JSON schema configuration
1755 foreach my $key (keys %$confdesc) {
1756 if (defined(my $default = $confdesc->{$key}->{default})) {
1757 $res->{$key} = $default;
1761 my $conf = PVE
::Cluster
::cfs_read_file
('datacenter.cfg');
1762 $res->{keyboard
} = $conf->{keyboard
} if $conf->{keyboard
};
1768 my $vmlist = PVE
::Cluster
::get_vmlist
();
1770 return $res if !$vmlist || !$vmlist->{ids
};
1771 my $ids = $vmlist->{ids
};
1773 foreach my $vmid (keys %$ids) {
1774 my $d = $ids->{$vmid};
1775 next if !$d->{node
} || $d->{node
} ne $nodename;
1776 next if !$d->{type
} || $d->{type
} ne 'qemu';
1777 $res->{$vmid}->{exists} = 1;
1782 # test if VM uses local resources (to prevent migration)
1783 sub check_local_resources
{
1784 my ($conf, $noerr) = @_;
1788 $loc_res = 1 if $conf->{hostusb
}; # old syntax
1789 $loc_res = 1 if $conf->{hostpci
}; # old syntax
1791 foreach my $k (keys %$conf) {
1792 $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/;
1795 die "VM uses local resources\n" if $loc_res && !$noerr;
1800 # check is used storages are available on all nodes (use by migrate)
1801 sub check_storage_availability
{
1802 my ($storecfg, $conf, $node) = @_;
1804 foreach_drive
($conf, sub {
1805 my ($ds, $drive) = @_;
1807 my $volid = $drive->{file
};
1810 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
1813 # check if storage is available on both nodes
1814 my $scfg = PVE
::Storage
::storage_check_node
($storecfg, $sid);
1815 PVE
::Storage
::storage_check_node
($storecfg, $sid, $node);
1822 die "VM is locked ($conf->{lock})\n" if $conf->{lock};
1826 my ($pidfile, $pid) = @_;
1828 my $fh = IO
::File-
>new("/proc/$pid/cmdline", "r");
1832 return undef if !$line;
1833 my @param = split(/\0/, $line);
1835 my $cmd = $param[0];
1836 return if !$cmd || ($cmd !~ m
|kvm
$| && $cmd !~ m
|qemu-system-x86_64
$|);
1838 for (my $i = 0; $i < scalar (@param); $i++) {
1841 if (($p eq '-pidfile') || ($p eq '--pidfile')) {
1842 my $p = $param[$i+1];
1843 return 1 if $p && ($p eq $pidfile);
1852 my ($vmid, $nocheck, $node) = @_;
1854 my $filename = config_file
($vmid, $node);
1856 die "unable to find configuration file for VM $vmid - no such machine\n"
1857 if !$nocheck && ! -f
$filename;
1859 my $pidfile = pidfile_name
($vmid);
1861 if (my $fd = IO
::File-
>new("<$pidfile")) {
1866 my $mtime = $st->mtime;
1867 if ($mtime > time()) {
1868 warn "file '$filename' modified in future\n";
1871 if ($line =~ m/^(\d+)$/) {
1873 if (check_cmdline
($pidfile, $pid)) {
1874 if (my $pinfo = PVE
::ProcFSTools
::check_process_running
($pid)) {
1886 my $vzlist = config_list
();
1888 my $fd = IO
::Dir-
>new($var_run_tmpdir) || return $vzlist;
1890 while (defined(my $de = $fd->read)) {
1891 next if $de !~ m/^(\d+)\.pid$/;
1893 next if !defined($vzlist->{$vmid});
1894 if (my $pid = check_running
($vmid)) {
1895 $vzlist->{$vmid}->{pid
} = $pid;
1903 my ($storecfg, $conf) = @_;
1905 my $bootdisk = $conf->{bootdisk
};
1906 return undef if !$bootdisk;
1907 return undef if !valid_drivename
($bootdisk);
1909 return undef if !$conf->{$bootdisk};
1911 my $drive = parse_drive
($bootdisk, $conf->{$bootdisk});
1912 return undef if !defined($drive);
1914 return undef if drive_is_cdrom
($drive);
1916 my $volid = $drive->{file
};
1917 return undef if !$volid;
1919 return $drive->{size
};
1922 my $last_proc_pid_stat;
1924 # get VM status information
1925 # This must be fast and should not block ($full == false)
1926 # We only query KVM using QMP if $full == true (this can be slow)
1928 my ($opt_vmid, $full) = @_;
1932 my $storecfg = PVE
::Storage
::config
();
1934 my $list = vzlist
();
1935 my ($uptime) = PVE
::ProcFSTools
::read_proc_uptime
(1);
1937 my $cpucount = $cpuinfo->{cpus
} || 1;
1939 foreach my $vmid (keys %$list) {
1940 next if $opt_vmid && ($vmid ne $opt_vmid);
1942 my $cfspath = cfs_config_path
($vmid);
1943 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath) || {};
1946 $d->{pid
} = $list->{$vmid}->{pid
};
1948 # fixme: better status?
1949 $d->{status
} = $list->{$vmid}->{pid
} ?
'running' : 'stopped';
1951 my $size = disksize
($storecfg, $conf);
1952 if (defined($size)) {
1953 $d->{disk
} = 0; # no info available
1954 $d->{maxdisk
} = $size;
1960 $d->{cpus
} = ($conf->{sockets
} || 1) * ($conf->{cores
} || 1);
1961 $d->{cpus
} = $cpucount if $d->{cpus
} > $cpucount;
1963 $d->{name
} = $conf->{name
} || "VM $vmid";
1964 $d->{maxmem
} = $conf->{memory
} ?
$conf->{memory
}*(1024*1024) : 0;
1966 if ($conf->{balloon
}) {
1967 $d->{balloon_min
} = $conf->{balloon
}*(1024*1024);
1968 $d->{shares
} = defined($conf->{shares
}) ?
$conf->{shares
} : 1000;
1979 $d->{diskwrite
} = 0;
1981 $d->{template
} = is_template
($conf);
1986 my $netdev = PVE
::ProcFSTools
::read_proc_net_dev
();
1987 foreach my $dev (keys %$netdev) {
1988 next if $dev !~ m/^tap([1-9]\d*)i/;
1990 my $d = $res->{$vmid};
1993 $d->{netout
} += $netdev->{$dev}->{receive
};
1994 $d->{netin
} += $netdev->{$dev}->{transmit
};
1997 my $ctime = gettimeofday
;
1999 foreach my $vmid (keys %$list) {
2001 my $d = $res->{$vmid};
2002 my $pid = $d->{pid
};
2005 my $pstat = PVE
::ProcFSTools
::read_proc_pid_stat
($pid);
2006 next if !$pstat; # not running
2008 my $used = $pstat->{utime} + $pstat->{stime
};
2010 $d->{uptime
} = int(($uptime - $pstat->{starttime
})/$cpuinfo->{user_hz
});
2012 if ($pstat->{vsize
}) {
2013 $d->{mem
} = int(($pstat->{rss
}/$pstat->{vsize
})*$d->{maxmem
});
2016 my $old = $last_proc_pid_stat->{$pid};
2018 $last_proc_pid_stat->{$pid} = {
2026 my $dtime = ($ctime - $old->{time}) * $cpucount * $cpuinfo->{user_hz
};
2028 if ($dtime > 1000) {
2029 my $dutime = $used - $old->{used
};
2031 $d->{cpu
} = (($dutime/$dtime)* $cpucount) / $d->{cpus
};
2032 $last_proc_pid_stat->{$pid} = {
2038 $d->{cpu
} = $old->{cpu
};
2042 return $res if !$full;
2044 my $qmpclient = PVE
::QMPClient-
>new();
2046 my $ballooncb = sub {
2047 my ($vmid, $resp) = @_;
2049 my $info = $resp->{'return'};
2050 return if !$info->{max_mem
};
2052 my $d = $res->{$vmid};
2054 # use memory assigned to VM
2055 $d->{maxmem
} = $info->{max_mem
};
2056 $d->{balloon
} = $info->{actual
};
2058 if (defined($info->{total_mem
}) && defined($info->{free_mem
})) {
2059 $d->{mem
} = $info->{total_mem
} - $info->{free_mem
};
2060 $d->{freemem
} = $info->{free_mem
};
2065 my $blockstatscb = sub {
2066 my ($vmid, $resp) = @_;
2067 my $data = $resp->{'return'} || [];
2068 my $totalrdbytes = 0;
2069 my $totalwrbytes = 0;
2070 for my $blockstat (@$data) {
2071 $totalrdbytes = $totalrdbytes + $blockstat->{stats
}->{rd_bytes
};
2072 $totalwrbytes = $totalwrbytes + $blockstat->{stats
}->{wr_bytes
};
2074 $res->{$vmid}->{diskread
} = $totalrdbytes;
2075 $res->{$vmid}->{diskwrite
} = $totalwrbytes;
2078 my $statuscb = sub {
2079 my ($vmid, $resp) = @_;
2081 $qmpclient->queue_cmd($vmid, $blockstatscb, 'query-blockstats');
2082 # this fails if ballon driver is not loaded, so this must be
2083 # the last commnand (following command are aborted if this fails).
2084 $qmpclient->queue_cmd($vmid, $ballooncb, 'query-balloon');
2086 my $status = 'unknown';
2087 if (!defined($status = $resp->{'return'}->{status
})) {
2088 warn "unable to get VM status\n";
2092 $res->{$vmid}->{qmpstatus
} = $resp->{'return'}->{status
};
2095 foreach my $vmid (keys %$list) {
2096 next if $opt_vmid && ($vmid ne $opt_vmid);
2097 next if !$res->{$vmid}->{pid
}; # not running
2098 $qmpclient->queue_cmd($vmid, $statuscb, 'query-status');
2101 $qmpclient->queue_execute();
2103 foreach my $vmid (keys %$list) {
2104 next if $opt_vmid && ($vmid ne $opt_vmid);
2105 $res->{$vmid}->{qmpstatus
} = $res->{$vmid}->{status
} if !$res->{$vmid}->{qmpstatus
};
2112 my ($conf, $func) = @_;
2114 foreach my $ds (keys %$conf) {
2115 next if !valid_drivename
($ds);
2117 my $drive = parse_drive
($ds, $conf->{$ds});
2120 &$func($ds, $drive);
2125 my ($conf, $func) = @_;
2129 my $test_volid = sub {
2130 my ($volid, $is_cdrom) = @_;
2134 $volhash->{$volid} = $is_cdrom || 0;
2137 foreach_drive
($conf, sub {
2138 my ($ds, $drive) = @_;
2139 &$test_volid($drive->{file
}, drive_is_cdrom
($drive));
2142 foreach my $snapname (keys %{$conf->{snapshots
}}) {
2143 my $snap = $conf->{snapshots
}->{$snapname};
2144 &$test_volid($snap->{vmstate
}, 0);
2145 foreach_drive
($snap, sub {
2146 my ($ds, $drive) = @_;
2147 &$test_volid($drive->{file
}, drive_is_cdrom
($drive));
2151 foreach my $volid (keys %$volhash) {
2152 &$func($volid, $volhash->{$volid});
2156 sub config_to_command
{
2157 my ($storecfg, $vmid, $conf, $defaults) = @_;
2160 my $globalFlags = [];
2161 my $machineFlags = [];
2166 my $kvmver = kvm_user_version
();
2167 my $vernum = 0; # unknown
2168 if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
2169 $vernum = $1*1000000+$2*1000;
2170 } elsif ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
2171 $vernum = $1*1000000+$2*1000+$3;
2174 die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 15000;
2176 my $have_ovz = -f
'/proc/vz/vestat';
2178 push @$cmd, '/usr/bin/kvm';
2180 push @$cmd, '-id', $vmid;
2184 my $qmpsocket = qmp_socket
($vmid);
2185 push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
2186 push @$cmd, '-mon', "chardev=qmp,mode=control";
2188 my $socket = vnc_socket
($vmid);
2189 push @$cmd, '-vnc', "unix:$socket,x509,password";
2191 push @$cmd, '-pidfile' , pidfile_name
($vmid);
2193 push @$cmd, '-daemonize';
2195 push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg';
2197 # enable absolute mouse coordinates (needed by vnc)
2198 my $tablet = defined($conf->{tablet
}) ?
$conf->{tablet
} : $defaults->{tablet
};
2199 push @$devices, '-device', 'usb-tablet,id=tablet,bus=ehci.0,port=6' if $tablet;
2202 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
2203 my $d = parse_hostpci
($conf->{"hostpci$i"});
2205 $pciaddr = print_pci_addr
("hostpci$i", $bridges);
2206 push @$devices, '-device', "pci-assign,host=$d->{pciid},id=hostpci$i$pciaddr";
2210 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2211 my $d = parse_usb_device
($conf->{"usb$i"});
2213 if ($d->{vendorid
} && $d->{productid
}) {
2214 push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2215 } elsif (defined($d->{hostbus
}) && defined($d->{hostport
})) {
2216 push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2221 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
2222 if (my $path = $conf->{"serial$i"}) {
2223 die "no such serial device\n" if ! -c
$path;
2224 push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2225 push @$devices, '-device', "isa-serial,chardev=serial$i";
2230 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
2231 if (my $path = $conf->{"parallel$i"}) {
2232 die "no such parallel device\n" if ! -c
$path;
2233 push @$devices, '-chardev', "parport,id=parallel$i,path=$path";
2234 push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2238 my $vmname = $conf->{name
} || "vm$vmid";
2240 push @$cmd, '-name', $vmname;
2243 $sockets = $conf->{smp
} if $conf->{smp
}; # old style - no longer iused
2244 $sockets = $conf->{sockets
} if $conf->{sockets
};
2246 my $cores = $conf->{cores
} || 1;
2248 push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2250 push @$cmd, '-cpu', $conf->{cpu
} if $conf->{cpu
};
2252 push @$cmd, '-nodefaults';
2254 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
2256 my $bootindex_hash = {};
2258 foreach my $o (split(//, $bootorder)) {
2259 $bootindex_hash->{$o} = $i*100;
2263 push @$cmd, '-boot', "menu=on";
2265 push @$cmd, '-no-acpi' if defined($conf->{acpi
}) && $conf->{acpi
} == 0;
2267 push @$cmd, '-no-reboot' if defined($conf->{reboot
}) && $conf->{reboot
} == 0;
2269 my $vga = $conf->{vga
};
2271 if ($conf->{ostype
} && ($conf->{ostype
} eq 'win8' || $conf->{ostype
} eq 'win7' || $conf->{ostype
} eq 'w2k8')) {
2278 push @$cmd, '-vga', $vga if $vga; # for kvm 77 and later
2281 my $tdf = defined($conf->{tdf
}) ?
$conf->{tdf
} : $defaults->{tdf
};
2283 my $nokvm = defined($conf->{kvm
}) && $conf->{kvm
} == 0 ?
1 : 0;
2284 my $useLocaltime = $conf->{localtime};
2286 if (my $ost = $conf->{ostype
}) {
2287 # other, wxp, w2k, w2k3, w2k8, wvista, win7, win8, l24, l26
2289 if ($ost =~ m/^w/) { # windows
2290 $useLocaltime = 1 if !defined($conf->{localtime});
2292 # use time drift fix when acpi is enabled
2293 if (!(defined($conf->{acpi
}) && $conf->{acpi
} == 0)) {
2294 $tdf = 1 if !defined($conf->{tdf
});
2298 if ($ost eq 'win7' || $ost eq 'win8' || $ost eq 'w2k8' ||
2300 push @$globalFlags, 'kvm-pit.lost_tick_policy=discard';
2301 push @$cmd, '-no-hpet';
2305 push @$rtcFlags, 'driftfix=slew' if $tdf;
2308 push @$machineFlags, 'accel=tcg';
2310 die "No accelerator found!\n" if !$cpuinfo->{hvm
};
2313 if ($conf->{startdate
}) {
2314 push @$rtcFlags, "base=$conf->{startdate}";
2315 } elsif ($useLocaltime) {
2316 push @$rtcFlags, 'base=localtime';
2319 push @$cmd, '-S' if $conf->{freeze
};
2321 # set keyboard layout
2322 my $kb = $conf->{keyboard
} || $defaults->{keyboard
};
2323 push @$cmd, '-k', $kb if $kb;
2326 #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2327 #push @$cmd, '-soundhw', 'es1370';
2328 #push @$cmd, '-soundhw', $soundhw if $soundhw;
2330 if($conf->{agent
}) {
2331 my $qgasocket = qga_socket
($vmid);
2332 my $pciaddr = print_pci_addr
("qga0", $bridges);
2333 push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
2334 push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
2335 push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
2338 # enable balloon by default, unless explicitly disabled
2339 if (!defined($conf->{balloon
}) || $conf->{balloon
}) {
2340 $pciaddr = print_pci_addr
("balloon0", $bridges);
2341 push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr";
2344 if ($conf->{watchdog
}) {
2345 my $wdopts = parse_watchdog
($conf->{watchdog
});
2346 $pciaddr = print_pci_addr
("watchdog", $bridges);
2347 my $watchdog = $wdopts->{model
} || 'i6300esb';
2348 push @$devices, '-device', "$watchdog$pciaddr";
2349 push @$devices, '-watchdog-action', $wdopts->{action
} if $wdopts->{action
};
2353 my $scsicontroller = {};
2354 my $ahcicontroller = {};
2355 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : $defaults->{scsihw
};
2357 foreach_drive
($conf, sub {
2358 my ($ds, $drive) = @_;
2360 if (PVE
::Storage
::parse_volume_id
($drive->{file
}, 1)) {
2361 push @$vollist, $drive->{file
};
2364 $use_virtio = 1 if $ds =~ m/^virtio/;
2366 if (drive_is_cdrom
($drive)) {
2367 if ($bootindex_hash->{d
}) {
2368 $drive->{bootindex
} = $bootindex_hash->{d
};
2369 $bootindex_hash->{d
} += 1;
2372 if ($bootindex_hash->{c
}) {
2373 $drive->{bootindex
} = $bootindex_hash->{c
} if $conf->{bootdisk
} && ($conf->{bootdisk
} eq $ds);
2374 $bootindex_hash->{c
} += 1;
2378 if ($drive->{interface
} eq 'scsi') {
2380 my $maxdev = ($scsihw ne 'lsi') ?
256 : 7;
2381 my $controller = int($drive->{index} / $maxdev);
2382 $pciaddr = print_pci_addr
("scsihw$controller", $bridges);
2383 push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
2384 $scsicontroller->{$controller}=1;
2387 if ($drive->{interface
} eq 'sata') {
2388 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
2389 $pciaddr = print_pci_addr
("ahci$controller", $bridges);
2390 push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
2391 $ahcicontroller->{$controller}=1;
2394 push @$devices, '-drive',print_drive_full
($storecfg, $vmid, $drive);
2395 push @$devices, '-device',print_drivedevice_full
($storecfg, $conf, $vmid, $drive, $bridges);
2398 push @$cmd, '-m', $conf->{memory
} || $defaults->{memory
};
2400 for (my $i = 0; $i < $MAX_NETS; $i++) {
2401 next if !$conf->{"net$i"};
2402 my $d = parse_net
($conf->{"net$i"});
2405 $use_virtio = 1 if $d->{model
} eq 'virtio';
2407 if ($bootindex_hash->{n
}) {
2408 $d->{bootindex
} = $bootindex_hash->{n
};
2409 $bootindex_hash->{n
} += 1;
2412 my $netdevfull = print_netdev_full
($vmid,$conf,$d,"net$i");
2413 push @$devices, '-netdev', $netdevfull;
2415 my $netdevicefull = print_netdevice_full
($vmid,$conf,$d,"net$i",$bridges);
2416 push @$devices, '-device', $netdevicefull;
2420 while (my ($k, $v) = each %$bridges) {
2421 $pciaddr = print_pci_addr
("pci.$k");
2422 unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
2426 # hack: virtio with fairsched is unreliable, so we do not use fairsched
2427 # when the VM uses virtio devices.
2428 if (!$use_virtio && $have_ovz) {
2430 my $cpuunits = defined($conf->{cpuunits
}) ?
2431 $conf->{cpuunits
} : $defaults->{cpuunits
};
2433 push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
2435 # fixme: cpulimit is currently ignored
2436 #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2440 if ($conf->{args
}) {
2441 my $aa = PVE
::Tools
::split_args
($conf->{args
});
2445 push @$cmd, @$devices;
2446 push @$cmd, '-rtc', join(',', @$rtcFlags)
2447 if scalar(@$rtcFlags);
2448 push @$cmd, '-machine', join(',', @$machineFlags)
2449 if scalar(@$machineFlags);
2450 push @$cmd, '-global', join(',', @$globalFlags)
2451 if scalar(@$globalFlags);
2453 return wantarray ?
($cmd, $vollist) : $cmd;
2458 return "${var_run_tmpdir}/$vmid.vnc";
2463 return "${var_run_tmpdir}/$vmid.qmp";
2468 return "${var_run_tmpdir}/$vmid.qga";
2473 return "${var_run_tmpdir}/$vmid.pid";
2476 sub next_migrate_port
{
2478 for (my $p = 60000; $p < 60010; $p++) {
2480 my $sock = IO
::Socket
::INET-
>new(Listen
=> 5,
2481 LocalAddr
=> 'localhost',
2492 die "unable to find free migration port";
2495 sub vm_devices_list
{
2498 my $res = vm_mon_cmd
($vmid, 'query-pci');
2501 foreach my $pcibus (@$res) {
2502 foreach my $device (@{$pcibus->{devices
}}) {
2503 next if !$device->{'qdev_id'};
2504 $devices->{$device->{'qdev_id'}} = $device;
2512 my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2514 return 1 if !check_running
($vmid);
2516 if ($deviceid eq 'tablet') {
2517 my $devicefull = "usb-tablet,id=tablet,bus=ehci.0,port=6";
2518 qemu_deviceadd
($vmid, $devicefull);
2522 return 1 if !$conf->{hotplug
};
2524 my $devices_list = vm_devices_list
($vmid);
2525 return 1 if defined($devices_list->{$deviceid});
2527 qemu_bridgeadd
($storecfg, $conf, $vmid, $deviceid); #add bridge if we need it for the device
2529 if ($deviceid =~ m/^(virtio)(\d+)$/) {
2530 return undef if !qemu_driveadd
($storecfg, $vmid, $device);
2531 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
2532 qemu_deviceadd
($vmid, $devicefull);
2533 if(!qemu_deviceaddverify
($vmid, $deviceid)) {
2534 qemu_drivedel
($vmid, $deviceid);
2539 if ($deviceid =~ m/^(scsihw)(\d+)$/) {
2540 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : "lsi";
2541 my $pciaddr = print_pci_addr
($deviceid);
2542 my $devicefull = "$scsihw,id=$deviceid$pciaddr";
2543 qemu_deviceadd
($vmid, $devicefull);
2544 return undef if(!qemu_deviceaddverify
($vmid, $deviceid));
2547 if ($deviceid =~ m/^(scsi)(\d+)$/) {
2548 return 1 if ($conf->{scsihw
} && $conf->{scsihw
} ne 'lsi'); #virtio-scsi not yet support hotplug
2549 return undef if !qemu_findorcreatescsihw
($storecfg,$conf, $vmid, $device);
2550 return undef if !qemu_driveadd
($storecfg, $vmid, $device);
2551 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
2552 if(!qemu_deviceadd
($vmid, $devicefull)) {
2553 qemu_drivedel
($vmid, $deviceid);
2558 if ($deviceid =~ m/^(net)(\d+)$/) {
2559 return undef if !qemu_netdevadd
($vmid, $conf, $device, $deviceid);
2560 my $netdevicefull = print_netdevice_full
($vmid, $conf, $device, $deviceid);
2561 qemu_deviceadd
($vmid, $netdevicefull);
2562 if(!qemu_deviceaddverify
($vmid, $deviceid)) {
2563 qemu_netdevdel
($vmid, $deviceid);
2568 if ($deviceid =~ m/^(pci\.)(\d+)$/) {
2570 my $pciaddr = print_pci_addr
($deviceid);
2571 my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
2572 qemu_deviceadd
($vmid, $devicefull);
2573 return undef if !qemu_deviceaddverify
($vmid, $deviceid);
2579 sub vm_deviceunplug
{
2580 my ($vmid, $conf, $deviceid) = @_;
2582 return 1 if !check_running
($vmid);
2584 if ($deviceid eq 'tablet') {
2585 qemu_devicedel
($vmid, $deviceid);
2589 return 1 if!$conf->{hotplug
};
2591 my $devices_list = vm_devices_list
($vmid);
2592 return 1 if !defined($devices_list->{$deviceid});
2594 die "can't unplug bootdisk" if $conf->{bootdisk
} && $conf->{bootdisk
} eq $deviceid;
2596 if ($deviceid =~ m/^(virtio)(\d+)$/) {
2597 return undef if !qemu_drivedel
($vmid, $deviceid);
2598 qemu_devicedel
($vmid, $deviceid);
2599 return undef if !qemu_devicedelverify
($vmid, $deviceid);
2602 if ($deviceid =~ m/^(lsi)(\d+)$/) {
2603 return undef if !qemu_devicedel
($vmid, $deviceid);
2606 if ($deviceid =~ m/^(scsi)(\d+)$/) {
2607 return undef if !qemu_devicedel
($vmid, $deviceid);
2608 return undef if !qemu_drivedel
($vmid, $deviceid);
2611 if ($deviceid =~ m/^(net)(\d+)$/) {
2612 return undef if !qemu_netdevdel
($vmid, $deviceid);
2613 qemu_devicedel
($vmid, $deviceid);
2614 return undef if !qemu_devicedelverify
($vmid, $deviceid);
2620 sub qemu_deviceadd
{
2621 my ($vmid, $devicefull) = @_;
2623 my $ret = vm_human_monitor_command
($vmid, "device_add $devicefull");
2625 # Otherwise, if the command succeeds, no output is sent. So any non-empty string shows an error
2626 return 1 if $ret eq "";
2627 syslog
("err", "error on hotplug device : $ret");
2632 sub qemu_devicedel
{
2633 my($vmid, $deviceid) = @_;
2634 my $ret = vm_mon_cmd
($vmid, "device_del", id
=> $deviceid);
2639 my($storecfg, $vmid, $device) = @_;
2641 my $drive = print_drive_full
($storecfg, $vmid, $device);
2642 my $ret = vm_human_monitor_command
($vmid, "drive_add auto $drive");
2643 # If the command succeeds qemu prints: "OK"
2644 if ($ret !~ m/OK/s) {
2645 syslog
("err", "adding drive failed: $ret");
2652 my($vmid, $deviceid) = @_;
2654 my $ret = vm_human_monitor_command
($vmid, "drive_del drive-$deviceid");
2656 if ($ret =~ m/Device \'.*?\' not found/s) {
2657 # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2659 elsif ($ret ne "") {
2660 syslog
("err", "deleting drive $deviceid failed : $ret");
2666 sub qemu_deviceaddverify
{
2667 my ($vmid,$deviceid) = @_;
2669 for (my $i = 0; $i <= 5; $i++) {
2670 my $devices_list = vm_devices_list
($vmid);
2671 return 1 if defined($devices_list->{$deviceid});
2674 syslog
("err", "error on hotplug device $deviceid");
2679 sub qemu_devicedelverify
{
2680 my ($vmid,$deviceid) = @_;
2682 #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2683 for (my $i = 0; $i <= 5; $i++) {
2684 my $devices_list = vm_devices_list
($vmid);
2685 return 1 if !defined($devices_list->{$deviceid});
2688 syslog
("err", "error on hot-unplugging device $deviceid");
2692 sub qemu_findorcreatescsihw
{
2693 my ($storecfg, $conf, $vmid, $device) = @_;
2695 my $maxdev = ($conf->{scsihw
} && $conf->{scsihw
} ne 'lsi') ?
256 : 7;
2696 my $controller = int($device->{index} / $maxdev);
2697 my $scsihwid="scsihw$controller";
2698 my $devices_list = vm_devices_list
($vmid);
2700 if(!defined($devices_list->{$scsihwid})) {
2701 return undef if !vm_deviceplug
($storecfg, $conf, $vmid, $scsihwid);
2706 sub qemu_bridgeadd
{
2707 my ($storecfg, $conf, $vmid, $device) = @_;
2710 my $bridgeid = undef;
2711 print_pci_addr
($device, $bridges);
2713 while (my ($k, $v) = each %$bridges) {
2716 return if $bridgeid < 1;
2717 my $bridge = "pci.$bridgeid";
2718 my $devices_list = vm_devices_list
($vmid);
2720 if(!defined($devices_list->{$bridge})) {
2721 return undef if !vm_deviceplug
($storecfg, $conf, $vmid, $bridge);
2726 sub qemu_netdevadd
{
2727 my ($vmid, $conf, $device, $deviceid) = @_;
2729 my $netdev = print_netdev_full
($vmid, $conf, $device, $deviceid);
2730 my $ret = vm_human_monitor_command
($vmid, "netdev_add $netdev");
2733 #if the command succeeds, no output is sent. So any non-empty string shows an error
2734 return 1 if $ret eq "";
2735 syslog
("err", "adding netdev failed: $ret");
2739 sub qemu_netdevdel
{
2740 my ($vmid, $deviceid) = @_;
2742 my $ret = vm_human_monitor_command
($vmid, "netdev_del $deviceid");
2744 #if the command succeeds, no output is sent. So any non-empty string shows an error
2745 return 1 if $ret eq "";
2746 syslog
("err", "deleting netdev failed: $ret");
2750 sub qemu_block_set_io_throttle
{
2751 my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
2753 return if !check_running
($vmid) ;
2756 $bps_rd = 0 if !$bps_rd;
2757 $bps_wr = 0 if !$bps_wr;
2758 $iops = 0 if !$iops;
2759 $iops_rd = 0 if !$iops_rd;
2760 $iops_wr = 0 if !$iops_wr;
2762 vm_mon_cmd
($vmid, "block_set_io_throttle", device
=> $deviceid, bps
=> int($bps), bps_rd
=> int($bps_rd), bps_wr
=> int($bps_wr), iops
=> int($iops), iops_rd
=> int($iops_rd), iops_wr
=> int($iops_wr));
2766 # old code, only used to shutdown old VM after update
2768 my ($fh, $timeout) = @_;
2770 my $sel = new IO
::Select
;
2777 while (scalar (@ready = $sel->can_read($timeout))) {
2779 if ($count = $fh->sysread($buf, 8192)) {
2780 if ($buf =~ /^(.*)\(qemu\) $/s) {
2787 if (!defined($count)) {
2794 die "monitor read timeout\n" if !scalar(@ready);
2799 # old code, only used to shutdown old VM after update
2800 sub vm_monitor_command
{
2801 my ($vmid, $cmdstr, $nocheck) = @_;
2806 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
2808 my $sname = "${var_run_tmpdir}/$vmid.mon";
2810 my $sock = IO
::Socket
::UNIX-
>new( Peer
=> $sname ) ||
2811 die "unable to connect to VM $vmid socket - $!\n";
2815 # hack: migrate sometime blocks the monitor (when migrate_downtime
2817 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2818 $timeout = 60*60; # 1 hour
2822 my $data = __read_avail
($sock, $timeout);
2824 if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
2825 die "got unexpected qemu monitor banner\n";
2828 my $sel = new IO
::Select
;
2831 if (!scalar(my @ready = $sel->can_write($timeout))) {
2832 die "monitor write error - timeout";
2835 my $fullcmd = "$cmdstr\r";
2837 # syslog('info', "VM $vmid monitor command: $cmdstr");
2840 if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
2841 die "monitor write error - $!";
2844 return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
2848 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2849 $timeout = 60*60; # 1 hour
2850 } elsif ($cmdstr =~ m/^(eject|change)/) {
2851 $timeout = 60; # note: cdrom mount command is slow
2853 if ($res = __read_avail
($sock, $timeout)) {
2855 my @lines = split("\r?\n", $res);
2857 shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
2859 $res = join("\n", @lines);
2867 syslog
("err", "VM $vmid monitor command failed - $err");
2874 sub qemu_block_resize
{
2875 my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
2877 my $running = check_running
($vmid);
2879 return if !PVE
::Storage
::volume_resize
($storecfg, $volid, $size, $running);
2881 return if !$running;
2883 vm_mon_cmd
($vmid, "block_resize", device
=> $deviceid, size
=> int($size));
2887 sub qemu_volume_snapshot
{
2888 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
2890 my $running = check_running
($vmid);
2892 return if !PVE
::Storage
::volume_snapshot
($storecfg, $volid, $snap, $running);
2894 return if !$running;
2896 vm_mon_cmd
($vmid, "snapshot-drive", device
=> $deviceid, name
=> $snap);
2900 sub qemu_volume_snapshot_delete
{
2901 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
2903 my $running = check_running
($vmid);
2905 return if !PVE
::Storage
::volume_snapshot_delete
($storecfg, $volid, $snap, $running);
2907 return if !$running;
2909 vm_mon_cmd
($vmid, "delete-drive-snapshot", device
=> $deviceid, name
=> $snap);
2915 #need to impplement call to qemu-ga
2918 sub qga_unfreezefs
{
2921 #need to impplement call to qemu-ga
2925 my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused) = @_;
2927 lock_config
($vmid, sub {
2928 my $conf = load_config
($vmid, $migratedfrom);
2930 die "you can't start a vm if it's a template\n" if is_template
($conf);
2932 check_lock
($conf) if !$skiplock;
2934 die "VM $vmid already running\n" if check_running
($vmid, undef, $migratedfrom);
2936 my $defaults = load_defaults
();
2938 # set environment variable useful inside network script
2939 $ENV{PVE_MIGRATED_FROM
} = $migratedfrom if $migratedfrom;
2941 my ($cmd, $vollist) = config_to_command
($storecfg, $vmid, $conf, $defaults);
2943 my $migrate_port = 0;
2946 if ($statefile eq 'tcp') {
2947 $migrate_port = next_migrate_port
();
2948 my $migrate_uri = "tcp:localhost:${migrate_port}";
2949 push @$cmd, '-incoming', $migrate_uri;
2952 push @$cmd, '-loadstate', $statefile;
2959 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
2960 my $d = parse_hostpci
($conf->{"hostpci$i"});
2962 my $info = pci_device_info
("0000:$d->{pciid}");
2963 die "IOMMU not present\n" if !check_iommu_support
();
2964 die "no pci device info for device '$d->{pciid}'\n" if !$info;
2965 die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub
($info);
2966 die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset
($info);
2969 PVE
::Storage
::activate_volumes
($storecfg, $vollist);
2971 eval { run_command
($cmd, timeout
=> $statefile ?
undef : 30,
2974 die "start failed: $err" if $err;
2976 print "migration listens on port $migrate_port\n" if $migrate_port;
2978 if ($statefile && $statefile ne 'tcp') {
2979 eval { vm_mon_cmd_nocheck
($vmid, "cont"); };
2984 my $capabilities = {};
2985 $capabilities->{capability
} = "xbzrle";
2986 $capabilities->{state} = JSON
::true
;
2987 eval { vm_mon_cmd_nocheck
($vmid, "migrate-set-capabilities", capabilities
=> [$capabilities]); };
2991 if (!defined($conf->{balloon
}) || $conf->{balloon
}) {
2992 vm_mon_cmd_nocheck
($vmid, "balloon", value
=> $conf->{balloon
}*1024*1024)
2993 if $conf->{balloon
};
2994 vm_mon_cmd_nocheck
($vmid, 'qom-set',
2995 path
=> "machine/peripheral/balloon0",
2996 property
=> "guest-stats-polling-interval",
3004 my ($vmid, $execute, %params) = @_;
3006 my $cmd = { execute
=> $execute, arguments
=> \
%params };
3007 vm_qmp_command
($vmid, $cmd);
3010 sub vm_mon_cmd_nocheck
{
3011 my ($vmid, $execute, %params) = @_;
3013 my $cmd = { execute
=> $execute, arguments
=> \
%params };
3014 vm_qmp_command
($vmid, $cmd, 1);
3017 sub vm_qmp_command
{
3018 my ($vmid, $cmd, $nocheck) = @_;
3023 if ($cmd->{arguments
} && $cmd->{arguments
}->{timeout
}) {
3024 $timeout = $cmd->{arguments
}->{timeout
};
3025 delete $cmd->{arguments
}->{timeout
};
3029 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
3030 my $sname = qmp_socket
($vmid);
3032 my $qmpclient = PVE
::QMPClient-
>new();
3034 $res = $qmpclient->cmd($vmid, $cmd, $timeout);
3035 } elsif (-e
"${var_run_tmpdir}/$vmid.mon") {
3036 die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
3037 if scalar(%{$cmd->{arguments
}});
3038 vm_monitor_command
($vmid, $cmd->{execute
}, $nocheck);
3040 die "unable to open monitor socket\n";
3044 syslog
("err", "VM $vmid qmp command failed - $err");
3051 sub vm_human_monitor_command
{
3052 my ($vmid, $cmdline) = @_;
3057 execute
=> 'human-monitor-command',
3058 arguments
=> { 'command-line' => $cmdline},
3061 return vm_qmp_command
($vmid, $cmd);
3064 sub vm_commandline
{
3065 my ($storecfg, $vmid) = @_;
3067 my $conf = load_config
($vmid);
3069 my $defaults = load_defaults
();
3071 my $cmd = config_to_command
($storecfg, $vmid, $conf, $defaults);
3073 return join(' ', @$cmd);
3077 my ($vmid, $skiplock) = @_;
3079 lock_config
($vmid, sub {
3081 my $conf = load_config
($vmid);
3083 check_lock
($conf) if !$skiplock;
3085 vm_mon_cmd
($vmid, "system_reset");
3089 sub get_vm_volumes
{
3093 foreach_volid
($conf, sub {
3094 my ($volid, $is_cdrom) = @_;
3096 return if $volid =~ m
|^/|;
3098 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
3101 push @$vollist, $volid;
3107 sub vm_stop_cleanup
{
3108 my ($storecfg, $vmid, $conf, $keepActive) = @_;
3111 fairsched_rmnod
($vmid); # try to destroy group
3114 my $vollist = get_vm_volumes
($conf);
3115 PVE
::Storage
::deactivate_volumes
($storecfg, $vollist);
3118 foreach my $ext (qw(mon qmp pid vnc qga)) {
3119 unlink "/var/run/qemu-server/${vmid}.$ext";
3122 warn $@ if $@; # avoid errors - just warn
3125 # Note: use $nockeck to skip tests if VM configuration file exists.
3126 # We need that when migration VMs to other nodes (files already moved)
3127 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3129 my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3131 $force = 1 if !defined($force) && !$shutdown;
3134 my $pid = check_running
($vmid, $nocheck, $migratedfrom);
3135 kill 15, $pid if $pid;
3136 my $conf = load_config
($vmid, $migratedfrom);
3137 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive);
3141 lock_config
($vmid, sub {
3143 my $pid = check_running
($vmid, $nocheck);
3148 $conf = load_config
($vmid);
3149 check_lock
($conf) if !$skiplock;
3150 if (!defined($timeout) && $shutdown && $conf->{startup
}) {
3151 my $opts = parse_startup
($conf->{startup
});
3152 $timeout = $opts->{down
} if $opts->{down
};
3156 $timeout = 60 if !defined($timeout);
3160 $nocheck ? vm_mon_cmd_nocheck
($vmid, "system_powerdown") : vm_mon_cmd
($vmid, "system_powerdown");
3163 $nocheck ? vm_mon_cmd_nocheck
($vmid, "quit") : vm_mon_cmd
($vmid, "quit");
3170 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
3175 if ($count >= $timeout) {
3177 warn "VM still running - terminating now with SIGTERM\n";
3180 die "VM quit/powerdown failed - got timeout\n";
3183 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
3188 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3191 die "VM quit/powerdown failed\n";
3199 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
3204 if ($count >= $timeout) {
3205 warn "VM still running - terminating now with SIGKILL\n";
3210 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
3215 my ($vmid, $skiplock) = @_;
3217 lock_config
($vmid, sub {
3219 my $conf = load_config
($vmid);
3221 check_lock
($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3223 vm_mon_cmd
($vmid, "stop");
3228 my ($vmid, $skiplock) = @_;
3230 lock_config
($vmid, sub {
3232 my $conf = load_config
($vmid);
3234 check_lock
($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3236 vm_mon_cmd
($vmid, "cont");
3241 my ($vmid, $skiplock, $key) = @_;
3243 lock_config
($vmid, sub {
3245 my $conf = load_config
($vmid);
3247 # there is no qmp command, so we use the human monitor command
3248 vm_human_monitor_command
($vmid, "sendkey $key");
3253 my ($storecfg, $vmid, $skiplock) = @_;
3255 lock_config
($vmid, sub {
3257 my $conf = load_config
($vmid);
3259 check_lock
($conf) if !$skiplock;
3261 if (!check_running
($vmid)) {
3262 fairsched_rmnod
($vmid); # try to destroy group
3263 destroy_vm
($storecfg, $vmid);
3265 die "VM $vmid is running - destroy failed\n";
3273 my ($filename, $buf) = @_;
3275 my $fh = IO
::File-
>new($filename, "w");
3276 return undef if !$fh;
3278 my $res = print $fh $buf;
3285 sub pci_device_info
{
3290 return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3291 my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3293 my $irq = file_read_firstline
("$pcisysfs/devices/$name/irq");
3294 return undef if !defined($irq) || $irq !~ m/^\d+$/;
3296 my $vendor = file_read_firstline
("$pcisysfs/devices/$name/vendor");
3297 return undef if !defined($vendor) || $vendor !~ s/^0x//;
3299 my $product = file_read_firstline
("$pcisysfs/devices/$name/device");
3300 return undef if !defined($product) || $product !~ s/^0x//;
3305 product
=> $product,
3311 has_fl_reset
=> -f
"$pcisysfs/devices/$name/reset" || 0,
3320 my $name = $dev->{name
};
3322 my $fn = "$pcisysfs/devices/$name/reset";
3324 return file_write
($fn, "1");
3327 sub pci_dev_bind_to_stub
{
3330 my $name = $dev->{name
};
3332 my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3333 return 1 if -d
$testdir;
3335 my $data = "$dev->{vendor} $dev->{product}";
3336 return undef if !file_write
("$pcisysfs/drivers/pci-stub/new_id", $data);
3338 my $fn = "$pcisysfs/devices/$name/driver/unbind";
3339 if (!file_write
($fn, $name)) {
3340 return undef if -f
$fn;
3343 $fn = "$pcisysfs/drivers/pci-stub/bind";
3344 if (! -d
$testdir) {
3345 return undef if !file_write
($fn, $name);
3351 sub print_pci_addr
{
3352 my ($id, $bridges) = @_;
3356 #addr1 : ide,parallel,serial (motherboard)
3357 #addr2 : first videocard
3358 balloon0
=> { bus
=> 0, addr
=> 3 },
3359 watchdog
=> { bus
=> 0, addr
=> 4 },
3360 scsihw0
=> { bus
=> 0, addr
=> 5 },
3361 scsihw1
=> { bus
=> 0, addr
=> 6 },
3362 ahci0
=> { bus
=> 0, addr
=> 7 },
3363 qga0
=> { bus
=> 0, addr
=> 8 },
3364 virtio0
=> { bus
=> 0, addr
=> 10 },
3365 virtio1
=> { bus
=> 0, addr
=> 11 },
3366 virtio2
=> { bus
=> 0, addr
=> 12 },
3367 virtio3
=> { bus
=> 0, addr
=> 13 },
3368 virtio4
=> { bus
=> 0, addr
=> 14 },
3369 virtio5
=> { bus
=> 0, addr
=> 15 },
3370 hostpci0
=> { bus
=> 0, addr
=> 16 },
3371 hostpci1
=> { bus
=> 0, addr
=> 17 },
3372 net0
=> { bus
=> 0, addr
=> 18 },
3373 net1
=> { bus
=> 0, addr
=> 19 },
3374 net2
=> { bus
=> 0, addr
=> 20 },
3375 net3
=> { bus
=> 0, addr
=> 21 },
3376 net4
=> { bus
=> 0, addr
=> 22 },
3377 net5
=> { bus
=> 0, addr
=> 23 },
3378 #addr29 : usb-host (pve-usb.cfg)
3379 'pci.1' => { bus
=> 0, addr
=> 30 },
3380 'pci.2' => { bus
=> 0, addr
=> 31 },
3381 'net6' => { bus
=> 1, addr
=> 1 },
3382 'net7' => { bus
=> 1, addr
=> 2 },
3383 'net8' => { bus
=> 1, addr
=> 3 },
3384 'net9' => { bus
=> 1, addr
=> 4 },
3385 'net10' => { bus
=> 1, addr
=> 5 },
3386 'net11' => { bus
=> 1, addr
=> 6 },
3387 'net12' => { bus
=> 1, addr
=> 7 },
3388 'net13' => { bus
=> 1, addr
=> 8 },
3389 'net14' => { bus
=> 1, addr
=> 9 },
3390 'net15' => { bus
=> 1, addr
=> 10 },
3391 'net16' => { bus
=> 1, addr
=> 11 },
3392 'net17' => { bus
=> 1, addr
=> 12 },
3393 'net18' => { bus
=> 1, addr
=> 13 },
3394 'net19' => { bus
=> 1, addr
=> 14 },
3395 'net20' => { bus
=> 1, addr
=> 15 },
3396 'net21' => { bus
=> 1, addr
=> 16 },
3397 'net22' => { bus
=> 1, addr
=> 17 },
3398 'net23' => { bus
=> 1, addr
=> 18 },
3399 'net24' => { bus
=> 1, addr
=> 19 },
3400 'net25' => { bus
=> 1, addr
=> 20 },
3401 'net26' => { bus
=> 1, addr
=> 21 },
3402 'net27' => { bus
=> 1, addr
=> 22 },
3403 'net28' => { bus
=> 1, addr
=> 23 },
3404 'net29' => { bus
=> 1, addr
=> 24 },
3405 'net30' => { bus
=> 1, addr
=> 25 },
3406 'net31' => { bus
=> 1, addr
=> 26 },
3407 'virtio6' => { bus
=> 2, addr
=> 1 },
3408 'virtio7' => { bus
=> 2, addr
=> 2 },
3409 'virtio8' => { bus
=> 2, addr
=> 3 },
3410 'virtio9' => { bus
=> 2, addr
=> 4 },
3411 'virtio10' => { bus
=> 2, addr
=> 5 },
3412 'virtio11' => { bus
=> 2, addr
=> 6 },
3413 'virtio12' => { bus
=> 2, addr
=> 7 },
3414 'virtio13' => { bus
=> 2, addr
=> 8 },
3415 'virtio14' => { bus
=> 2, addr
=> 9 },
3416 'virtio15' => { bus
=> 2, addr
=> 10 },
3419 if (defined($devices->{$id}->{bus
}) && defined($devices->{$id}->{addr
})) {
3420 my $addr = sprintf("0x%x", $devices->{$id}->{addr
});
3421 my $bus = $devices->{$id}->{bus
};
3422 $res = ",bus=pci.$bus,addr=$addr";
3423 $bridges->{$bus} = 1 if $bridges;
3429 # vzdump restore implementaion
3431 sub tar_archive_read_firstfile
{
3432 my $archive = shift;
3434 die "ERROR: file '$archive' does not exist\n" if ! -f
$archive;
3436 # try to detect archive type first
3437 my $pid = open (TMP
, "tar tf '$archive'|") ||
3438 die "unable to open file '$archive'\n";
3439 my $firstfile = <TMP
>;
3443 die "ERROR: archive contaions no data\n" if !$firstfile;
3449 sub tar_restore_cleanup
{
3450 my ($storecfg, $statfile) = @_;
3452 print STDERR
"starting cleanup\n";
3454 if (my $fd = IO
::File-
>new($statfile, "r")) {
3455 while (defined(my $line = <$fd>)) {
3456 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3459 if ($volid =~ m
|^/|) {
3460 unlink $volid || die 'unlink failed\n';
3462 PVE
::Storage
::vdisk_free
($storecfg, $volid);
3464 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
3466 print STDERR
"unable to cleanup '$volid' - $@" if $@;
3468 print STDERR
"unable to parse line in statfile - $line";
3475 sub restore_archive
{
3476 my ($archive, $vmid, $user, $opts) = @_;
3478 my $format = $opts->{format
};
3481 if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
3482 $format = 'tar' if !$format;
3484 } elsif ($archive =~ m/\.tar$/) {
3485 $format = 'tar' if !$format;
3486 } elsif ($archive =~ m/.tar.lzo$/) {
3487 $format = 'tar' if !$format;
3489 } elsif ($archive =~ m/\.vma$/) {
3490 $format = 'vma' if !$format;
3491 } elsif ($archive =~ m/\.vma\.gz$/) {
3492 $format = 'vma' if !$format;
3494 } elsif ($archive =~ m/\.vma\.lzo$/) {
3495 $format = 'vma' if !$format;
3498 $format = 'vma' if !$format; # default
3501 # try to detect archive format
3502 if ($format eq 'tar') {
3503 return restore_tar_archive
($archive, $vmid, $user, $opts);
3505 return restore_vma_archive
($archive, $vmid, $user, $opts, $comp);
3509 sub restore_update_config_line
{
3510 my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
3512 return if $line =~ m/^\#qmdump\#/;
3513 return if $line =~ m/^\#vzdump\#/;
3514 return if $line =~ m/^lock:/;
3515 return if $line =~ m/^unused\d+:/;
3516 return if $line =~ m/^parent:/;
3518 if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3519 # try to convert old 1.X settings
3520 my ($id, $ind, $ethcfg) = ($1, $2, $3);
3521 foreach my $devconfig (PVE
::Tools
::split_list
($ethcfg)) {
3522 my ($model, $macaddr) = split(/\=/, $devconfig);
3523 $macaddr = PVE
::Tools
::random_ether_addr
() if !$macaddr || $unique;
3526 bridge
=> "vmbr$ind",
3527 macaddr
=> $macaddr,
3529 my $netstr = print_net
($net);
3531 print $outfd "net$cookie->{netcount}: $netstr\n";
3532 $cookie->{netcount
}++;
3534 } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
3535 my ($id, $netstr) = ($1, $2);
3536 my $net = parse_net
($netstr);
3537 $net->{macaddr
} = PVE
::Tools
::random_ether_addr
() if $net->{macaddr
};
3538 $netstr = print_net
($net);
3539 print $outfd "$id: $netstr\n";
3540 } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
3543 if ($line =~ m/backup=no/) {
3544 print $outfd "#$line";
3545 } elsif ($virtdev && $map->{$virtdev}) {
3546 my $di = parse_drive
($virtdev, $value);
3547 $di->{file
} = $map->{$virtdev};
3548 $value = print_drive
($vmid, $di);
3549 print $outfd "$virtdev: $value\n";
3559 my ($cfg, $vmid) = @_;
3561 my $info = PVE
::Storage
::vdisk_list
($cfg, undef, $vmid);
3563 my $volid_hash = {};
3564 foreach my $storeid (keys %$info) {
3565 foreach my $item (@{$info->{$storeid}}) {
3566 next if !($item->{volid
} && $item->{size
});
3567 $volid_hash->{$item->{volid
}} = $item;
3574 sub update_disksize
{
3575 my ($vmid, $conf, $volid_hash) = @_;
3582 foreach my $opt (keys %$conf) {
3583 if (valid_drivename
($opt)) {
3584 my $drive = parse_drive
($opt, $conf->{$opt});
3585 my $volid = $drive->{file
};
3588 $used->{$volid} = 1;
3590 next if drive_is_cdrom
($drive);
3591 next if !$volid_hash->{$volid};
3593 $drive->{size
} = $volid_hash->{$volid}->{size
};
3595 $conf->{$opt} = print_drive
($vmid, $drive);
3599 foreach my $volid (sort keys %$volid_hash) {
3600 next if $volid =~ m/vm-$vmid-state-/;
3601 next if $used->{$volid};
3603 add_unused_volume
($conf, $volid);
3610 my ($vmid, $nolock) = @_;
3612 my $cfg = PVE
::Cluster
::cfs_read_file
("storage.cfg");
3614 my $volid_hash = scan_volids
($cfg, $vmid);
3616 my $updatefn = sub {
3619 my $conf = load_config
($vmid);
3623 my $changes = update_disksize
($vmid, $conf, $volid_hash);
3625 update_config_nolock
($vmid, $conf, 1) if $changes;
3628 if (defined($vmid)) {
3632 lock_config
($vmid, $updatefn, $vmid);
3635 my $vmlist = config_list
();
3636 foreach my $vmid (keys %$vmlist) {
3640 lock_config
($vmid, $updatefn, $vmid);
3646 sub restore_vma_archive
{
3647 my ($archive, $vmid, $user, $opts, $comp) = @_;
3649 my $input = $archive eq '-' ?
"<&STDIN" : undef;
3650 my $readfrom = $archive;
3655 my $qarchive = PVE
::Tools
::shellquote
($archive);
3656 if ($comp eq 'gzip') {
3657 $uncomp = "zcat $qarchive|";
3658 } elsif ($comp eq 'lzop') {
3659 $uncomp = "lzop -d -c $qarchive|";
3661 die "unknown compression method '$comp'\n";
3666 my $tmpdir = "/var/tmp/vzdumptmp$$";
3669 # disable interrupts (always do cleanups)
3670 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
3671 warn "got interrupt - ignored\n";
3674 my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
3675 POSIX
::mkfifo
($mapfifo, 0600);
3678 my $openfifo = sub {
3679 open($fifofh, '>', $mapfifo) || die $!;
3682 my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
3689 my $rpcenv = PVE
::RPCEnvironment
::get
();
3691 my $conffile = config_file
($vmid);
3692 my $tmpfn = "$conffile.$$.tmp";
3694 # Note: $oldconf is undef if VM does not exists
3695 my $oldconf = PVE
::Cluster
::cfs_read_file
(cfs_config_path
($vmid));
3697 my $print_devmap = sub {
3698 my $virtdev_hash = {};
3700 my $cfgfn = "$tmpdir/qemu-server.conf";
3702 # we can read the config - that is already extracted
3703 my $fh = IO
::File-
>new($cfgfn, "r") ||
3704 "unable to read qemu-server.conf - $!\n";
3706 while (defined(my $line = <$fh>)) {
3707 if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
3708 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
3709 die "archive does not contain data for drive '$virtdev'\n"
3710 if !$devinfo->{$devname};
3711 if (defined($opts->{storage
})) {
3712 $storeid = $opts->{storage
} || 'local';
3713 } elsif (!$storeid) {
3716 $format = 'raw' if !$format;
3717 $devinfo->{$devname}->{devname
} = $devname;
3718 $devinfo->{$devname}->{virtdev
} = $virtdev;
3719 $devinfo->{$devname}->{format
} = $format;
3720 $devinfo->{$devname}->{storeid
} = $storeid;
3722 # check permission on storage
3723 my $pool = $opts->{pool
}; # todo: do we need that?
3724 if ($user ne 'root@pam') {
3725 $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
3728 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
3732 foreach my $devname (keys %$devinfo) {
3733 die "found no device mapping information for device '$devname'\n"
3734 if !$devinfo->{$devname}->{virtdev
};
3737 my $cfg = cfs_read_file
('storage.cfg');
3739 # create empty/temp config
3741 PVE
::Tools
::file_set_contents
($conffile, "memory: 128\n");
3742 foreach_drive
($oldconf, sub {
3743 my ($ds, $drive) = @_;
3745 return if drive_is_cdrom
($drive);
3747 my $volid = $drive->{file
};
3749 return if !$volid || $volid =~ m
|^/|;
3751 my ($path, $owner) = PVE
::Storage
::path
($cfg, $volid);
3752 return if !$path || !$owner || ($owner != $vmid);
3754 # Note: only delete disk we want to restore
3755 # other volumes will become unused
3756 if ($virtdev_hash->{$ds}) {
3757 PVE
::Storage
::vdisk_free
($cfg, $volid);
3763 foreach my $virtdev (sort keys %$virtdev_hash) {
3764 my $d = $virtdev_hash->{$virtdev};
3765 my $alloc_size = int(($d->{size
} + 1024 - 1)/1024);
3766 my $scfg = PVE
::Storage
::storage_config
($cfg, $d->{storeid
});
3767 my $volid = PVE
::Storage
::vdisk_alloc
($cfg, $d->{storeid
}, $vmid,
3768 $d->{format
}, undef, $alloc_size);
3769 print STDERR
"new volume ID is '$volid'\n";
3770 $d->{volid
} = $volid;
3771 my $path = PVE
::Storage
::path
($cfg, $volid);
3773 my $write_zeros = 1;
3774 # fixme: what other storages types initialize volumes with zero?
3775 if ($scfg->{type
} eq 'dir' || $scfg->{type
} eq 'nfs') {
3779 print $fifofh "${write_zeros}:$d->{devname}=$path\n";
3781 print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
3782 $map->{$virtdev} = $volid;
3785 $fh->seek(0, 0) || die "seek failed - $!\n";
3787 my $outfd = new IO
::File
($tmpfn, "w") ||
3788 die "unable to write config for VM $vmid\n";
3790 my $cookie = { netcount
=> 0 };
3791 while (defined(my $line = <$fh>)) {
3792 restore_update_config_line
($outfd, $cookie, $vmid, $map, $line, $opts->{unique
});
3801 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
3802 die "interrupted by signal\n";
3804 local $SIG{ALRM
} = sub { die "got timeout\n"; };
3806 $oldtimeout = alarm($timeout);
3813 if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
3814 my ($dev_id, $size, $devname) = ($1, $2, $3);
3815 $devinfo->{$devname} = { size
=> $size, dev_id
=> $dev_id };
3816 } elsif ($line =~ m/^CTIME: /) {
3818 print $fifofh "done\n";
3819 my $tmp = $oldtimeout || 0;
3820 $oldtimeout = undef;
3826 print "restore vma archive: $cmd\n";
3827 run_command
($cmd, input
=> $input, outfunc
=> $parser, afterfork
=> $openfifo);
3831 alarm($oldtimeout) if $oldtimeout;
3839 my $cfg = cfs_read_file
('storage.cfg');
3840 foreach my $devname (keys %$devinfo) {
3841 my $volid = $devinfo->{$devname}->{volid
};
3844 if ($volid =~ m
|^/|) {
3845 unlink $volid || die 'unlink failed\n';
3847 PVE
::Storage
::vdisk_free
($cfg, $volid);
3849 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
3851 print STDERR
"unable to cleanup '$volid' - $@" if $@;
3858 rename($tmpfn, $conffile) ||
3859 die "unable to commit configuration file '$conffile'\n";
3861 PVE
::Cluster
::cfs_update
(); # make sure we read new file
3863 eval { rescan
($vmid, 1); };
3867 sub restore_tar_archive
{
3868 my ($archive, $vmid, $user, $opts) = @_;
3870 if ($archive ne '-') {
3871 my $firstfile = tar_archive_read_firstfile
($archive);
3872 die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
3873 if $firstfile ne 'qemu-server.conf';
3876 my $storecfg = cfs_read_file
('storage.cfg');
3878 # destroy existing data - keep empty config
3879 my $vmcfgfn = PVE
::QemuServer
::config_file
($vmid);
3880 destroy_vm
($storecfg, $vmid, 1) if -f
$vmcfgfn;
3882 my $tocmd = "/usr/lib/qemu-server/qmextract";
3884 $tocmd .= " --storage " . PVE
::Tools
::shellquote
($opts->{storage
}) if $opts->{storage
};
3885 $tocmd .= " --pool " . PVE
::Tools
::shellquote
($opts->{pool
}) if $opts->{pool
};
3886 $tocmd .= ' --prealloc' if $opts->{prealloc
};
3887 $tocmd .= ' --info' if $opts->{info
};
3889 # tar option "xf" does not autodetect compression when read from STDIN,
3890 # so we pipe to zcat
3891 my $cmd = "zcat -f|tar xf " . PVE
::Tools
::shellquote
($archive) . " " .
3892 PVE
::Tools
::shellquote
("--to-command=$tocmd");
3894 my $tmpdir = "/var/tmp/vzdumptmp$$";
3897 local $ENV{VZDUMP_TMPDIR
} = $tmpdir;
3898 local $ENV{VZDUMP_VMID
} = $vmid;
3899 local $ENV{VZDUMP_USER
} = $user;
3901 my $conffile = config_file
($vmid);
3902 my $tmpfn = "$conffile.$$.tmp";
3904 # disable interrupts (always do cleanups)
3905 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
3906 print STDERR
"got interrupt - ignored\n";
3911 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
3912 die "interrupted by signal\n";
3915 if ($archive eq '-') {
3916 print "extracting archive from STDIN\n";
3917 run_command
($cmd, input
=> "<&STDIN");
3919 print "extracting archive '$archive'\n";
3923 return if $opts->{info
};
3927 my $statfile = "$tmpdir/qmrestore.stat";
3928 if (my $fd = IO
::File-
>new($statfile, "r")) {
3929 while (defined (my $line = <$fd>)) {
3930 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3931 $map->{$1} = $2 if $1;
3933 print STDERR
"unable to parse line in statfile - $line\n";
3939 my $confsrc = "$tmpdir/qemu-server.conf";
3941 my $srcfd = new IO
::File
($confsrc, "r") ||
3942 die "unable to open file '$confsrc'\n";
3944 my $outfd = new IO
::File
($tmpfn, "w") ||
3945 die "unable to write config for VM $vmid\n";
3947 my $cookie = { netcount
=> 0 };
3948 while (defined (my $line = <$srcfd>)) {
3949 restore_update_config_line
($outfd, $cookie, $vmid, $map, $line, $opts->{unique
});
3961 tar_restore_cleanup
($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info
};
3968 rename $tmpfn, $conffile ||
3969 die "unable to commit configuration file '$conffile'\n";
3971 PVE
::Cluster
::cfs_update
(); # make sure we read new file
3973 eval { rescan
($vmid, 1); };
3978 # Internal snapshots
3980 # NOTE: Snapshot create/delete involves several non-atomic
3981 # action, and can take a long time.
3982 # So we try to avoid locking the file and use 'lock' variable
3983 # inside the config file instead.
3985 my $snapshot_copy_config = sub {
3986 my ($source, $dest) = @_;
3988 foreach my $k (keys %$source) {
3989 next if $k eq 'snapshots';
3990 next if $k eq 'snapstate';
3991 next if $k eq 'snaptime';
3992 next if $k eq 'vmstate';
3993 next if $k eq 'lock';
3994 next if $k eq 'digest';
3995 next if $k eq 'description';
3996 next if $k =~ m/^unused\d+$/;
3998 $dest->{$k} = $source->{$k};
4002 my $snapshot_apply_config = sub {
4003 my ($conf, $snap) = @_;
4005 # copy snapshot list
4007 snapshots
=> $conf->{snapshots
},
4010 # keep description and list of unused disks
4011 foreach my $k (keys %$conf) {
4012 next if !($k =~ m/^unused\d+$/ || $k eq 'description');
4013 $newconf->{$k} = $conf->{$k};
4016 &$snapshot_copy_config($snap, $newconf);
4021 sub foreach_writable_storage
{
4022 my ($conf, $func) = @_;
4026 foreach my $ds (keys %$conf) {
4027 next if !valid_drivename
($ds);
4029 my $drive = parse_drive
($ds, $conf->{$ds});
4031 next if drive_is_cdrom
($drive);
4033 my $volid = $drive->{file
};
4035 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
4036 $sidhash->{$sid} = $sid if $sid;
4039 foreach my $sid (sort keys %$sidhash) {
4044 my $alloc_vmstate_volid = sub {
4045 my ($storecfg, $vmid, $conf, $snapname) = @_;
4047 # Note: we try to be smart when selecting a $target storage
4051 # search shared storage first
4052 foreach_writable_storage
($conf, sub {
4054 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
4055 return if !$scfg->{shared
};
4057 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage
4061 # now search local storage
4062 foreach_writable_storage
($conf, sub {
4064 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
4065 return if $scfg->{shared
};
4067 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage;
4071 $target = 'local' if !$target;
4073 my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
4074 # we abort live save after $conf->{memory}, so we need at max twice that space
4075 my $size = $conf->{memory
}*2 + $driver_state_size;
4077 my $name = "vm-$vmid-state-$snapname";
4078 my $scfg = PVE
::Storage
::storage_config
($storecfg, $target);
4079 $name .= ".raw" if $scfg->{path
}; # add filename extension for file base storage
4080 my $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $target, $vmid, 'raw', $name, $size*1024);
4085 my $snapshot_prepare = sub {
4086 my ($vmid, $snapname, $save_vmstate, $comment) = @_;
4090 my $updatefn = sub {
4092 my $conf = load_config
($vmid);
4094 die "you can't take a snapshot if it's a template\n"
4095 if is_template
($conf);
4099 $conf->{lock} = 'snapshot';
4101 die "snapshot name '$snapname' already used\n"
4102 if defined($conf->{snapshots
}->{$snapname});
4104 my $storecfg = PVE
::Storage
::config
();
4105 die "snapshot feature is not available" if !has_feature
('snapshot', $conf, $storecfg);
4107 $snap = $conf->{snapshots
}->{$snapname} = {};
4109 if ($save_vmstate && check_running
($vmid)) {
4110 $snap->{vmstate
} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
4113 &$snapshot_copy_config($conf, $snap);
4115 $snap->{snapstate
} = "prepare";
4116 $snap->{snaptime
} = time();
4117 $snap->{description
} = $comment if $comment;
4119 update_config_nolock
($vmid, $conf, 1);
4122 lock_config
($vmid, $updatefn);
4127 my $snapshot_commit = sub {
4128 my ($vmid, $snapname) = @_;
4130 my $updatefn = sub {
4132 my $conf = load_config
($vmid);
4134 die "missing snapshot lock\n"
4135 if !($conf->{lock} && $conf->{lock} eq 'snapshot');
4137 my $snap = $conf->{snapshots
}->{$snapname};
4139 die "snapshot '$snapname' does not exist\n" if !defined($snap);
4141 die "wrong snapshot state\n"
4142 if !($snap->{snapstate
} && $snap->{snapstate
} eq "prepare");
4144 delete $snap->{snapstate
};
4145 delete $conf->{lock};
4147 my $newconf = &$snapshot_apply_config($conf, $snap);
4149 $newconf->{parent
} = $snapname;
4151 update_config_nolock
($vmid, $newconf, 1);
4154 lock_config
($vmid, $updatefn);
4157 sub snapshot_rollback
{
4158 my ($vmid, $snapname) = @_;
4164 my $storecfg = PVE
::Storage
::config
();
4166 my $updatefn = sub {
4168 my $conf = load_config
($vmid);
4170 die "you can't rollback if vm is a template\n" if is_template
($conf);
4172 $snap = $conf->{snapshots
}->{$snapname};
4174 die "snapshot '$snapname' does not exist\n" if !defined($snap);
4176 die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
4177 if $snap->{snapstate
};
4181 vm_stop
($storecfg, $vmid, undef, undef, 5, undef, undef);
4184 die "unable to rollback vm $vmid: vm is running\n"
4185 if check_running
($vmid);
4188 $conf->{lock} = 'rollback';
4190 die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
4191 delete $conf->{lock};
4195 # copy snapshot config to current config
4196 $conf = &$snapshot_apply_config($conf, $snap);
4197 $conf->{parent
} = $snapname;
4200 update_config_nolock
($vmid, $conf, 1);
4202 if (!$prepare && $snap->{vmstate
}) {
4203 my $statefile = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
4204 vm_start
($storecfg, $vmid, $statefile);
4208 lock_config
($vmid, $updatefn);
4210 foreach_drive
($snap, sub {
4211 my ($ds, $drive) = @_;
4213 return if drive_is_cdrom
($drive);
4215 my $volid = $drive->{file
};
4216 my $device = "drive-$ds";
4218 PVE
::Storage
::volume_snapshot_rollback
($storecfg, $volid, $snapname);
4222 lock_config
($vmid, $updatefn);
4225 my $savevm_wait = sub {
4229 my $stat = vm_mon_cmd_nocheck
($vmid, "query-savevm");
4230 if (!$stat->{status
}) {
4231 die "savevm not active\n";
4232 } elsif ($stat->{status
} eq 'active') {
4235 } elsif ($stat->{status
} eq 'completed') {
4238 die "query-savevm returned status '$stat->{status}'\n";
4243 sub snapshot_create
{
4244 my ($vmid, $snapname, $save_vmstate, $freezefs, $comment) = @_;
4246 my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
4248 $freezefs = $save_vmstate = 0 if !$snap->{vmstate
}; # vm is not running
4252 my $running = check_running
($vmid);
4255 # create internal snapshots of all drives
4257 my $storecfg = PVE
::Storage
::config
();
4260 if ($snap->{vmstate
}) {
4261 my $path = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
4262 vm_mon_cmd
($vmid, "savevm-start", statefile
=> $path);
4263 &$savevm_wait($vmid);
4265 vm_mon_cmd
($vmid, "savevm-start");
4269 qga_freezefs
($vmid) if $running && $freezefs;
4271 foreach_drive
($snap, sub {
4272 my ($ds, $drive) = @_;
4274 return if drive_is_cdrom
($drive);
4276 my $volid = $drive->{file
};
4277 my $device = "drive-$ds";
4279 qemu_volume_snapshot
($vmid, $device, $storecfg, $volid, $snapname);
4280 $drivehash->{$ds} = 1;
4285 eval { gqa_unfreezefs
($vmid) if $running && $freezefs; };
4288 eval { vm_mon_cmd
($vmid, "savevm-end") if $running; };
4292 warn "snapshot create failed: starting cleanup\n";
4293 eval { snapshot_delete
($vmid, $snapname, 0, $drivehash); };
4298 &$snapshot_commit($vmid, $snapname);
4301 # Note: $drivehash is only set when called from snapshot_create.
4302 sub snapshot_delete
{
4303 my ($vmid, $snapname, $force, $drivehash) = @_;
4310 my $unlink_parent = sub {
4311 my ($confref, $new_parent) = @_;
4313 if ($confref->{parent
} && $confref->{parent
} eq $snapname) {
4315 $confref->{parent
} = $new_parent;
4317 delete $confref->{parent
};
4322 my $updatefn = sub {
4323 my ($remove_drive) = @_;
4325 my $conf = load_config
($vmid);
4329 die "you can't delete a snapshot if vm is a template\n"
4330 if is_template
($conf);
4333 $snap = $conf->{snapshots
}->{$snapname};
4335 die "snapshot '$snapname' does not exist\n" if !defined($snap);
4337 # remove parent refs
4338 &$unlink_parent($conf, $snap->{parent
});
4339 foreach my $sn (keys %{$conf->{snapshots
}}) {
4340 next if $sn eq $snapname;
4341 &$unlink_parent($conf->{snapshots
}->{$sn}, $snap->{parent
});
4344 if ($remove_drive) {
4345 if ($remove_drive eq 'vmstate') {
4346 delete $snap->{$remove_drive};
4348 my $drive = parse_drive
($remove_drive, $snap->{$remove_drive});
4349 my $volid = $drive->{file
};
4350 delete $snap->{$remove_drive};
4351 add_unused_volume
($conf, $volid);
4356 $snap->{snapstate
} = 'delete';
4358 delete $conf->{snapshots
}->{$snapname};
4359 delete $conf->{lock} if $drivehash;
4360 foreach my $volid (@$unused) {
4361 add_unused_volume
($conf, $volid);
4365 update_config_nolock
($vmid, $conf, 1);
4368 lock_config
($vmid, $updatefn);
4370 # now remove vmstate file
4372 my $storecfg = PVE
::Storage
::config
();
4374 if ($snap->{vmstate
}) {
4375 eval { PVE
::Storage
::vdisk_free
($storecfg, $snap->{vmstate
}); };
4377 die $err if !$force;
4380 # save changes (remove vmstate from snapshot)
4381 lock_config
($vmid, $updatefn, 'vmstate') if !$force;
4384 # now remove all internal snapshots
4385 foreach_drive
($snap, sub {
4386 my ($ds, $drive) = @_;
4388 return if drive_is_cdrom
($drive);
4390 my $volid = $drive->{file
};
4391 my $device = "drive-$ds";
4393 if (!$drivehash || $drivehash->{$ds}) {
4394 eval { qemu_volume_snapshot_delete
($vmid, $device, $storecfg, $volid, $snapname); };
4396 die $err if !$force;
4401 # save changes (remove drive fron snapshot)
4402 lock_config
($vmid, $updatefn, $ds) if !$force;
4403 push @$unused, $volid;
4406 # now cleanup config
4408 lock_config
($vmid, $updatefn);
4412 my ($feature, $conf, $storecfg, $snapname, $running) = @_;
4415 foreach_drive
($conf, sub {
4416 my ($ds, $drive) = @_;
4418 return if drive_is_cdrom
($drive);
4419 my $volid = $drive->{file
};
4420 $err = 1 if !PVE
::Storage
::volume_has_feature
($storecfg, $feature, $volid, $snapname, $running);
4426 sub template_create
{
4427 my ($vmid, $conf, $disk) = @_;
4429 my $running = check_running
($vmid);
4430 die "you can't convert a vm to template if vm is running vm\n" if $running;
4432 my $storecfg = PVE
::Storage
::config
();
4435 foreach_drive
($conf, sub {
4436 my ($ds, $drive) = @_;
4438 return if drive_is_cdrom
($drive);
4439 return if $disk && $ds ne $disk;
4441 my $volid = $drive->{file
};
4442 die "volume '$volid' does not support template/clone\n"
4443 if !PVE
::Storage
::volume_has_feature
($storecfg, 'template', $volid);
4446 foreach_drive
($conf, sub {
4447 my ($ds, $drive) = @_;
4449 return if drive_is_cdrom
($drive);
4450 return if $disk && $ds ne $disk;
4452 my $volid = $drive->{file
};
4453 my $voliddst = PVE
::Storage
::vdisk_create_base
($storecfg, $volid);
4454 $drive->{file
} = $voliddst;
4455 $conf->{$ds} = PVE
::QemuServer
::print_drive
($vmid, $drive);
4456 PVE
::QemuServer
::update_config_nolock
($vmid, $conf, 1);
4459 if($conf->{snapshots
}){
4460 delete $conf->{parent
};
4461 delete $conf->{snapshots
};
4462 PVE
::QemuServer
::update_config_nolock
($vmid, $conf, 1);
4463 #fixme : do we need to delete disks snapshots ?
4470 my $baseimagecount = 0;
4471 my $totalvolumecount = 0;
4472 my $storecfg = PVE
::Storage
::config
();
4474 foreach_drive
($conf, sub {
4475 my ($ds, $drive) = @_;
4476 return if drive_is_cdrom
($drive);
4477 $totalvolumecount++;
4478 my $volid = $drive->{file
};
4479 if (PVE
::Storage
::volume_is_base
($storecfg, $volid)){
4485 return 0 if $baseimagecount == 0;
4486 return 1 if $baseimagecount == $totalvolumecount; #full template
4487 return 2 if $baseimagecount < $totalvolumecount; #semi-template