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 Time
::HiRes
qw(gettimeofday);
32 my $cpuinfo = PVE
::ProcFSTools
::read_cpuinfo
();
34 # Note about locking: we use flock on the config file protect
35 # against concurent actions.
36 # Aditionaly, we have a 'lock' setting in the config file. This
37 # can be set to 'migrate', 'backup', 'snapshot' or 'rollback'. Most actions are not
38 # allowed when such lock is set. But you can ignore this kind of
39 # lock with the --skiplock flag.
41 cfs_register_file
('/qemu-server/',
45 PVE
::JSONSchema
::register_standard_option
('skiplock', {
46 description
=> "Ignore locks - only root is allowed to use this option.",
51 PVE
::JSONSchema
::register_standard_option
('pve-qm-stateuri', {
52 description
=> "Some command save/restore state from this location.",
58 PVE
::JSONSchema
::register_standard_option
('pve-snapshot-name', {
59 description
=> "The name of the snapshot.",
60 type
=> 'string', format
=> 'pve-configid',
64 #no warnings 'redefine';
66 unless(defined(&_VZSYSCALLS_H_
)) {
67 eval 'sub _VZSYSCALLS_H_ () {1;}' unless defined(&_VZSYSCALLS_H_
);
68 require 'sys/syscall.ph';
69 if(defined(&__x86_64__
)) {
70 eval 'sub __NR_fairsched_vcpus () {499;}' unless defined(&__NR_fairsched_vcpus
);
71 eval 'sub __NR_fairsched_mknod () {504;}' unless defined(&__NR_fairsched_mknod
);
72 eval 'sub __NR_fairsched_rmnod () {505;}' unless defined(&__NR_fairsched_rmnod
);
73 eval 'sub __NR_fairsched_chwt () {506;}' unless defined(&__NR_fairsched_chwt
);
74 eval 'sub __NR_fairsched_mvpr () {507;}' unless defined(&__NR_fairsched_mvpr
);
75 eval 'sub __NR_fairsched_rate () {508;}' unless defined(&__NR_fairsched_rate
);
76 eval 'sub __NR_setluid () {501;}' unless defined(&__NR_setluid
);
77 eval 'sub __NR_setublimit () {502;}' unless defined(&__NR_setublimit
);
79 elsif(defined( &__i386__
) ) {
80 eval 'sub __NR_fairsched_mknod () {500;}' unless defined(&__NR_fairsched_mknod
);
81 eval 'sub __NR_fairsched_rmnod () {501;}' unless defined(&__NR_fairsched_rmnod
);
82 eval 'sub __NR_fairsched_chwt () {502;}' unless defined(&__NR_fairsched_chwt
);
83 eval 'sub __NR_fairsched_mvpr () {503;}' unless defined(&__NR_fairsched_mvpr
);
84 eval 'sub __NR_fairsched_rate () {504;}' unless defined(&__NR_fairsched_rate
);
85 eval 'sub __NR_fairsched_vcpus () {505;}' unless defined(&__NR_fairsched_vcpus
);
86 eval 'sub __NR_setluid () {511;}' unless defined(&__NR_setluid
);
87 eval 'sub __NR_setublimit () {512;}' unless defined(&__NR_setublimit
);
89 die("no fairsched syscall for this arch");
91 require 'asm/ioctl.ph';
92 eval 'sub KVM_GET_API_VERSION () { &_IO(0xAE, 0x);}' unless defined(&KVM_GET_API_VERSION
);
96 my ($parent, $weight, $desired) = @_;
98 return syscall(&__NR_fairsched_mknod
, int($parent), int($weight), int($desired));
101 sub fairsched_rmnod
{
104 return syscall(&__NR_fairsched_rmnod
, int($id));
108 my ($pid, $newid) = @_;
110 return syscall(&__NR_fairsched_mvpr
, int($pid), int($newid));
113 sub fairsched_vcpus
{
114 my ($id, $vcpus) = @_;
116 return syscall(&__NR_fairsched_vcpus
, int($id), int($vcpus));
120 my ($id, $op, $rate) = @_;
122 return syscall(&__NR_fairsched_rate
, int($id), int($op), int($rate));
125 use constant FAIRSCHED_SET_RATE
=> 0;
126 use constant FAIRSCHED_DROP_RATE
=> 1;
127 use constant FAIRSCHED_GET_RATE
=> 2;
129 sub fairsched_cpulimit
{
130 my ($id, $limit) = @_;
132 my $cpulim1024 = int($limit * 1024 / 100);
133 my $op = $cpulim1024 ? FAIRSCHED_SET_RATE
: FAIRSCHED_DROP_RATE
;
135 return fairsched_rate
($id, $op, $cpulim1024);
138 my $nodename = PVE
::INotify
::nodename
();
140 mkdir "/etc/pve/nodes/$nodename";
141 my $confdir = "/etc/pve/nodes/$nodename/qemu-server";
144 my $var_run_tmpdir = "/var/run/qemu-server";
145 mkdir $var_run_tmpdir;
147 my $lock_dir = "/var/lock/qemu-server";
150 my $pcisysfs = "/sys/bus/pci";
156 description
=> "Specifies whether a VM will be started during system bootup.",
162 description
=> "Automatic restart after crash (currently ignored).",
168 description
=> "Activate hotplug for disk and network device",
174 description
=> "Allow reboot. If set to '0' the VM exit on reboot.",
180 description
=> "Lock/unlock the VM.",
181 enum
=> [qw(migrate backup snapshot rollback)],
186 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.",
193 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.",
201 description
=> "Amount of RAM for the VM in MB. This is the maximum available memory when you use the balloon device.",
208 description
=> "Amount of target RAM for the VM in MB.",
214 description
=> "Keybord layout for vnc server. Default is read from the datacenter configuration file.",
215 enum
=> PVE
::Tools
::kvmkeymaplist
(),
220 type
=> 'string', format
=> 'dns-name',
221 description
=> "Set a name for the VM. Only used on the configuration web interface.",
226 description
=> "scsi controller model",
227 enum
=> [qw(lsi virtio-scsi-pci megasas)],
233 description
=> "Description for the VM. Only used on the configuration web interface. This is saved as comment inside the configuration file.",
238 enum
=> [qw(other wxp w2k w2k3 w2k8 wvista win7 l24 l26)],
239 description
=> <<EODESC,
240 Used to enable special optimization/features for specific
243 other => unspecified OS
244 wxp => Microsoft Windows XP
245 w2k => Microsoft Windows 2000
246 w2k3 => Microsoft Windows 2003
247 w2k8 => Microsoft Windows 2008
248 wvista => Microsoft Windows Vista
249 win7 => Microsoft Windows 7
250 l24 => Linux 2.4 Kernel
251 l26 => Linux 2.6/3.X Kernel
253 other|l24|l26 ... no special behaviour
254 wxp|w2k|w2k3|w2k8|wvista|win7 ... use --localtime switch
260 description
=> "Boot on floppy (a), hard disk (c), CD-ROM (d), or network (n).",
261 pattern
=> '[acdn]{1,4}',
266 type
=> 'string', format
=> 'pve-qm-bootdisk',
267 description
=> "Enable booting from specified disk.",
268 pattern
=> '(ide|sata|scsi|virtio)\d+',
273 description
=> "The number of CPUs. Please use option -sockets instead.",
280 description
=> "The number of CPU sockets.",
287 description
=> "The number of cores per socket.",
294 description
=> "Enable/disable ACPI.",
300 description
=> "Enable/disable Qemu GuestAgent.",
306 description
=> "Enable/disable KVM hardware virtualization.",
312 description
=> "Enable/disable time drift fix. This is ignored for kvm versions newer that 1.0 (not needed anymore).",
318 description
=> "Set the real time clock to local time. This is enabled by default if ostype indicates a Microsoft OS.",
323 description
=> "Freeze CPU at startup (use 'c' monitor command to start execution).",
328 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 win7/w2k8, and 'cirrur' for other OS types",
329 enum
=> [qw(std cirrus vmware)],
333 type
=> 'string', format
=> 'pve-qm-watchdog',
334 typetext
=> '[[model=]i6300esb|ib700] [,[action=]reset|shutdown|poweroff|pause|debug|none]',
335 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)",
340 typetext
=> "(now | YYYY-MM-DD | YYYY-MM-DDTHH:MM:SS)",
341 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'.",
342 pattern
=> '(now|\d{4}-\d{1,2}-\d{1,2}(T\d{1,2}:\d{1,2}:\d{1,2})?)',
347 type
=> 'string', format
=> 'pve-qm-startup',
348 typetext
=> '[[order=]\d+] [,up=\d+] [,down=\d+] ',
349 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.",
354 description
=> <<EODESCR,
355 Note: this option is for experts only. It allows you to pass arbitrary arguments to kvm, for example:
357 args: -no-reboot -no-hpet
364 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.",
369 description
=> "Set maximum speed (in MB/s) for migrations. Value 0 is no limit.",
373 migrate_downtime
=> {
376 description
=> "Set maximum tolerated downtime (in seconds) for migrations.",
382 type
=> 'string', format
=> 'pve-qm-drive',
383 typetext
=> 'volume',
384 description
=> "This is an alias for option -ide2",
388 description
=> "Emulated CPU type.",
390 enum
=> [ qw(486 athlon pentium pentium2 pentium3 coreduo core2duo kvm32 kvm64 qemu32 qemu64 phenom cpu64-rhel6 cpu64-rhel5 Conroe Penryn Nehalem Westmere Opteron_G1 Opteron_G2 Opteron_G3 host) ],
393 parent
=> get_standard_option
('pve-snapshot-name', {
395 description
=> "Parent snapshot name. This is used internally, and should not be modified.",
399 description
=> "Timestamp for snapshots.",
405 type
=> 'string', format
=> 'pve-volume-id',
406 description
=> "Reference to a volume which stores the VM state. This is used internally for snapshots.",
410 # what about other qemu settings ?
412 #machine => 'string',
425 ##soundhw => 'string',
427 while (my ($k, $v) = each %$confdesc) {
428 PVE
::JSONSchema
::register_standard_option
("pve-qm-$k", $v);
431 my $MAX_IDE_DISKS = 4;
432 my $MAX_SCSI_DISKS = 14;
433 my $MAX_VIRTIO_DISKS = 16;
434 my $MAX_SATA_DISKS = 6;
435 my $MAX_USB_DEVICES = 5;
437 my $MAX_UNUSED_DISKS = 8;
438 my $MAX_HOSTPCI_DEVICES = 2;
439 my $MAX_SERIAL_PORTS = 4;
440 my $MAX_PARALLEL_PORTS = 3;
442 my $nic_model_list = ['rtl8139', 'ne2k_pci', 'e1000', 'pcnet', 'virtio',
443 'ne2k_isa', 'i82551', 'i82557b', 'i82559er'];
444 my $nic_model_list_txt = join(' ', sort @$nic_model_list);
449 type
=> 'string', format
=> 'pve-qm-net',
450 typetext
=> "MODEL=XX:XX:XX:XX:XX:XX [,bridge=<dev>][,rate=<mbps>][,tag=<vlanid>]",
451 description
=> <<EODESCR,
452 Specify network devices.
454 MODEL is one of: $nic_model_list_txt
456 XX:XX:XX:XX:XX:XX should be an unique MAC address. This is
457 automatically generated if not specified.
459 The bridge parameter can be used to automatically add the interface to a bridge device. The Proxmox VE standard bridge is called 'vmbr0'.
461 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'.
463 If you specify no bridge, we create a kvm 'user' (NATed) network device, which provides DHCP and DNS services. The following addresses are used:
469 The DHCP server assign addresses to the guest starting from 10.0.2.15.
473 PVE
::JSONSchema
::register_standard_option
("pve-qm-net", $netdesc);
475 for (my $i = 0; $i < $MAX_NETS; $i++) {
476 $confdesc->{"net$i"} = $netdesc;
483 type
=> 'string', format
=> 'pve-qm-drive',
484 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]',
485 description
=> "Use volume as IDE hard disk or CD-ROM (n is 0 to " .($MAX_IDE_DISKS -1) . ").",
487 PVE
::JSONSchema
::register_standard_option
("pve-qm-ide", $idedesc);
491 type
=> 'string', format
=> 'pve-qm-drive',
492 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]',
493 description
=> "Use volume as SCSI hard disk or CD-ROM (n is 0 to " . ($MAX_SCSI_DISKS - 1) . ").",
495 PVE
::JSONSchema
::register_standard_option
("pve-qm-scsi", $scsidesc);
499 type
=> 'string', format
=> 'pve-qm-drive',
500 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]',
501 description
=> "Use volume as SATA hard disk or CD-ROM (n is 0 to " . ($MAX_SATA_DISKS - 1). ").",
503 PVE
::JSONSchema
::register_standard_option
("pve-qm-sata", $satadesc);
507 type
=> 'string', format
=> 'pve-qm-drive',
508 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]',
509 description
=> "Use volume as VIRTIO hard disk (n is 0 to " . ($MAX_VIRTIO_DISKS - 1) . ").",
511 PVE
::JSONSchema
::register_standard_option
("pve-qm-virtio", $virtiodesc);
515 type
=> 'string', format
=> 'pve-qm-usb-device',
516 typetext
=> 'host=HOSTUSBDEVICE',
517 description
=> <<EODESCR,
518 Configure an USB device (n is 0 to 4). This can be used to
519 pass-through usb devices to the guest. HOSTUSBDEVICE syntax is:
521 'bus-port(.port)*' (decimal numbers) or
522 'vendor_id:product_id' (hexadeciaml numbers)
524 You can use the 'lsusb -t' command to list existing usb devices.
526 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
530 PVE
::JSONSchema
::register_standard_option
("pve-qm-usb", $usbdesc);
534 type
=> 'string', format
=> 'pve-qm-hostpci',
535 typetext
=> "HOSTPCIDEVICE",
536 description
=> <<EODESCR,
537 Map host pci devices. HOSTPCIDEVICE syntax is:
539 'bus:dev.func' (hexadecimal numbers)
541 You can us the 'lspci' command to list existing pci devices.
543 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
545 Experimental: user reported problems with this option.
548 PVE
::JSONSchema
::register_standard_option
("pve-qm-hostpci", $hostpcidesc);
553 pattern
=> '/dev/ttyS\d+',
554 description
=> <<EODESCR,
555 Map host serial devices (n is 0 to 3).
557 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
559 Experimental: user reported problems with this option.
566 pattern
=> '/dev/parport\d+',
567 description
=> <<EODESCR,
568 Map host parallel devices (n is 0 to 2).
570 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
572 Experimental: user reported problems with this option.
576 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
577 $confdesc->{"parallel$i"} = $paralleldesc;
580 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
581 $confdesc->{"serial$i"} = $serialdesc;
584 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
585 $confdesc->{"hostpci$i"} = $hostpcidesc;
588 for (my $i = 0; $i < $MAX_IDE_DISKS; $i++) {
589 $drivename_hash->{"ide$i"} = 1;
590 $confdesc->{"ide$i"} = $idedesc;
593 for (my $i = 0; $i < $MAX_SATA_DISKS; $i++) {
594 $drivename_hash->{"sata$i"} = 1;
595 $confdesc->{"sata$i"} = $satadesc;
598 for (my $i = 0; $i < $MAX_SCSI_DISKS; $i++) {
599 $drivename_hash->{"scsi$i"} = 1;
600 $confdesc->{"scsi$i"} = $scsidesc ;
603 for (my $i = 0; $i < $MAX_VIRTIO_DISKS; $i++) {
604 $drivename_hash->{"virtio$i"} = 1;
605 $confdesc->{"virtio$i"} = $virtiodesc;
608 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
609 $confdesc->{"usb$i"} = $usbdesc;
614 type
=> 'string', format
=> 'pve-volume-id',
615 description
=> "Reference to unused volumes.",
618 for (my $i = 0; $i < $MAX_UNUSED_DISKS; $i++) {
619 $confdesc->{"unused$i"} = $unuseddesc;
622 my $kvm_api_version = 0;
626 return $kvm_api_version if $kvm_api_version;
628 my $fh = IO
::File-
>new("</dev/kvm") ||
631 if (my $v = $fh->ioctl(KVM_GET_API_VERSION
(), 0)) {
632 $kvm_api_version = $v;
637 return $kvm_api_version;
640 my $kvm_user_version;
642 sub kvm_user_version
{
644 return $kvm_user_version if $kvm_user_version;
646 $kvm_user_version = 'unknown';
648 my $tmp = `kvm -help 2>/dev/null`;
650 if ($tmp =~ m/^QEMU( PC)? emulator version (\d+\.\d+(\.\d+)?) /) {
651 $kvm_user_version = $2;
654 return $kvm_user_version;
658 my $kernel_has_vhost_net = -c
'/dev/vhost-net';
661 # order is important - used to autoselect boot disk
662 return ((map { "ide$_" } (0 .. ($MAX_IDE_DISKS - 1))),
663 (map { "scsi$_" } (0 .. ($MAX_SCSI_DISKS - 1))),
664 (map { "virtio$_" } (0 .. ($MAX_VIRTIO_DISKS - 1))),
665 (map { "sata$_" } (0 .. ($MAX_SATA_DISKS - 1))));
668 sub valid_drivename
{
671 return defined($drivename_hash->{$dev});
676 return defined($confdesc->{$key});
680 return $nic_model_list;
683 sub os_list_description
{
688 w2k
=> 'Windows 2000',
689 w2k3
=>, 'Windows 2003',
690 w2k8
=> 'Windows 2008',
691 wvista
=> 'Windows Vista',
702 return $cdrom_path if $cdrom_path;
704 return $cdrom_path = "/dev/cdrom" if -l
"/dev/cdrom";
705 return $cdrom_path = "/dev/cdrom1" if -l
"/dev/cdrom1";
706 return $cdrom_path = "/dev/cdrom2" if -l
"/dev/cdrom2";
710 my ($storecfg, $vmid, $cdrom) = @_;
712 if ($cdrom eq 'cdrom') {
713 return get_cdrom_path
();
714 } elsif ($cdrom eq 'none') {
716 } elsif ($cdrom =~ m
|^/|) {
719 return PVE
::Storage
::path
($storecfg, $cdrom);
723 # try to convert old style file names to volume IDs
724 sub filename_to_volume_id
{
725 my ($vmid, $file, $media) = @_;
727 if (!($file eq 'none' || $file eq 'cdrom' ||
728 $file =~ m
|^/dev/.+| || $file =~ m/^([^:]+):(.+)$/)) {
730 return undef if $file =~ m
|/|;
732 if ($media && $media eq 'cdrom') {
733 $file = "local:iso/$file";
735 $file = "local:$vmid/$file";
742 sub verify_media_type
{
743 my ($opt, $vtype, $media) = @_;
748 if ($media eq 'disk') {
750 } elsif ($media eq 'cdrom') {
753 die "internal error";
756 return if ($vtype eq $etype);
758 raise_param_exc
({ $opt => "unexpected media type ($vtype != $etype)" });
761 sub cleanup_drive_path
{
762 my ($opt, $storecfg, $drive) = @_;
764 # try to convert filesystem paths to volume IDs
766 if (($drive->{file
} !~ m/^(cdrom|none)$/) &&
767 ($drive->{file
} !~ m
|^/dev/.+|) &&
768 ($drive->{file
} !~ m/^([^:]+):(.+)$/) &&
769 ($drive->{file
} !~ m/^\d+$/)) {
770 my ($vtype, $volid) = PVE
::Storage
::path_to_volume_id
($storecfg, $drive->{file
});
771 raise_param_exc
({ $opt => "unable to associate path '$drive->{file}' to any storage"}) if !$vtype;
772 $drive->{media
} = 'cdrom' if !$drive->{media
} && $vtype eq 'iso';
773 verify_media_type
($opt, $vtype, $drive->{media
});
774 $drive->{file
} = $volid;
777 $drive->{media
} = 'cdrom' if !$drive->{media
} && $drive->{file
} =~ m/^(cdrom|none)$/;
780 sub create_conf_nolock
{
781 my ($vmid, $settings) = @_;
783 my $filename = config_file
($vmid);
785 die "configuration file '$filename' already exists\n" if -f
$filename;
787 my $defaults = load_defaults
();
789 $settings->{name
} = "vm$vmid" if !$settings->{name
};
790 $settings->{memory
} = $defaults->{memory
} if !$settings->{memory
};
793 foreach my $opt (keys %$settings) {
794 next if !$confdesc->{$opt};
796 my $value = $settings->{$opt};
799 $data .= "$opt: $value\n";
802 PVE
::Tools
::file_set_contents
($filename, $data);
805 my $parse_size = sub {
808 return undef if $value !~ m/^(\d+(\.\d+)?)([KMG])?$/;
809 my ($size, $unit) = ($1, $3);
812 $size = $size * 1024;
813 } elsif ($unit eq 'M') {
814 $size = $size * 1024 * 1024;
815 } elsif ($unit eq 'G') {
816 $size = $size * 1024 * 1024 * 1024;
822 my $format_size = sub {
827 my $kb = int($size/1024);
828 return $size if $kb*1024 != $size;
830 my $mb = int($kb/1024);
831 return "${kb}K" if $mb*1024 != $kb;
833 my $gb = int($mb/1024);
834 return "${mb}M" if $gb*1024 != $mb;
839 # ideX = [volume=]volume-id[,media=d][,cyls=c,heads=h,secs=s[,trans=t]]
840 # [,snapshot=on|off][,cache=on|off][,format=f][,backup=yes|no]
841 # [,rerror=ignore|report|stop][,werror=enospc|ignore|report|stop]
842 # [,aio=native|threads]
845 my ($key, $data) = @_;
849 # $key may be undefined - used to verify JSON parameters
850 if (!defined($key)) {
851 $res->{interface
} = 'unknown'; # should not harm when used to verify parameters
853 } elsif ($key =~ m/^([^\d]+)(\d+)$/) {
854 $res->{interface
} = $1;
860 foreach my $p (split (/,/, $data)) {
861 next if $p =~ m/^\s*$/;
863 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)=(.+)$/) {
864 my ($k, $v) = ($1, $2);
866 $k = 'file' if $k eq 'volume';
868 return undef if defined $res->{$k};
870 if ($k eq 'bps' || $k eq 'bps_rd' || $k eq 'bps_wr') {
871 return undef if !$v || $v !~ m/^\d+/;
873 $v = sprintf("%.3f", $v / (1024*1024));
877 if (!$res->{file
} && $p !~ m/=/) {
885 return undef if !$res->{file
};
887 return undef if $res->{cache
} &&
888 $res->{cache
} !~ m/^(off|none|writethrough|writeback|unsafe|directsync)$/;
889 return undef if $res->{snapshot
} && $res->{snapshot
} !~ m/^(on|off)$/;
890 return undef if $res->{cyls
} && $res->{cyls
} !~ m/^\d+$/;
891 return undef if $res->{heads
} && $res->{heads
} !~ m/^\d+$/;
892 return undef if $res->{secs
} && $res->{secs
} !~ m/^\d+$/;
893 return undef if $res->{media
} && $res->{media
} !~ m/^(disk|cdrom)$/;
894 return undef if $res->{trans
} && $res->{trans
} !~ m/^(none|lba|auto)$/;
895 return undef if $res->{format
} && $res->{format
} !~ m/^(raw|cow|qcow|qcow2|vmdk|cloop)$/;
896 return undef if $res->{rerror
} && $res->{rerror
} !~ m/^(ignore|report|stop)$/;
897 return undef if $res->{werror
} && $res->{werror
} !~ m/^(enospc|ignore|report|stop)$/;
898 return undef if $res->{backup
} && $res->{backup
} !~ m/^(yes|no)$/;
899 return undef if $res->{aio
} && $res->{aio
} !~ m/^(native|threads)$/;
902 return undef if $res->{mbps_rd
} && $res->{mbps
};
903 return undef if $res->{mbps_wr
} && $res->{mbps
};
905 return undef if $res->{mbps
} && $res->{mbps
} !~ m/^\d+(\.\d+)?$/;
906 return undef if $res->{mbps_rd
} && $res->{mbps_rd
} !~ m/^\d+(\.\d+)?$/;
907 return undef if $res->{mbps_wr
} && $res->{mbps_wr
} !~ m/^\d+(\.\d+)?$/;
909 return undef if $res->{iops_rd
} && $res->{iops
};
910 return undef if $res->{iops_wr
} && $res->{iops
};
911 return undef if $res->{iops
} && $res->{iops
} !~ m/^\d+$/;
912 return undef if $res->{iops_rd
} && $res->{iops_rd
} !~ m/^\d+$/;
913 return undef if $res->{iops_wr
} && $res->{iops_wr
} !~ m/^\d+$/;
917 return undef if !defined($res->{size
} = &$parse_size($res->{size
}));
920 if ($res->{media
} && ($res->{media
} eq 'cdrom')) {
921 return undef if $res->{snapshot
} || $res->{trans
} || $res->{format
};
922 return undef if $res->{heads
} || $res->{secs
} || $res->{cyls
};
923 return undef if $res->{interface
} eq 'virtio';
926 # rerror does not work with scsi drives
927 if ($res->{rerror
}) {
928 return undef if $res->{interface
} eq 'scsi';
934 my @qemu_drive_options = qw(heads secs cyls trans media format cache snapshot rerror werror aio iops iops_rd iops_wr);
937 my ($vmid, $drive) = @_;
940 foreach my $o (@qemu_drive_options, 'mbps', 'mbps_rd', 'mbps_wr', 'backup') {
941 $opts .= ",$o=$drive->{$o}" if $drive->{$o};
944 if ($drive->{size
}) {
945 $opts .= ",size=" . &$format_size($drive->{size
});
948 return "$drive->{file}$opts";
952 my($fh, $noerr) = @_;
955 my $SG_GET_VERSION_NUM = 0x2282;
957 my $versionbuf = "\x00" x
8;
958 my $ret = ioctl($fh, $SG_GET_VERSION_NUM, $versionbuf);
960 die "scsi ioctl SG_GET_VERSION_NUM failoed - $!\n" if !$noerr;
963 my $version = unpack("I", $versionbuf);
964 if ($version < 30000) {
965 die "scsi generic interface too old\n" if !$noerr;
969 my $buf = "\x00" x
36;
970 my $sensebuf = "\x00" x
8;
971 my $cmd = pack("C x3 C x11", 0x12, 36);
973 # see /usr/include/scsi/sg.h
974 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";
976 my $packet = pack($sg_io_hdr_t, ord('S'), -3, length($cmd),
977 length($sensebuf), 0, length($buf), $buf,
978 $cmd, $sensebuf, 6000);
980 $ret = ioctl($fh, $SG_IO, $packet);
982 die "scsi ioctl SG_IO failed - $!\n" if !$noerr;
986 my @res = unpack($sg_io_hdr_t, $packet);
987 if ($res[17] || $res[18]) {
988 die "scsi ioctl SG_IO status error - $!\n" if !$noerr;
993 ($res->{device
}, $res->{removable
}, $res->{venodor
},
994 $res->{product
}, $res->{revision
}) = unpack("C C x6 A8 A16 A4", $buf);
1002 my $fh = IO
::File-
>new("+<$path") || return undef;
1003 my $res = scsi_inquiry
($fh, 1);
1009 sub print_drivedevice_full
{
1010 my ($storecfg, $conf, $vmid, $drive, $bridges) = @_;
1015 if ($drive->{interface
} eq 'virtio') {
1016 my $pciaddr = print_pci_addr
("$drive->{interface}$drive->{index}", $bridges);
1017 $device = "virtio-blk-pci,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}$pciaddr";
1018 } elsif ($drive->{interface
} eq 'scsi') {
1019 $maxdev = ($conf->{scsihw
} && $conf->{scsihw
} ne 'lsi') ?
256 : 7;
1020 my $controller = int($drive->{index} / $maxdev);
1021 my $unit = $drive->{index} % $maxdev;
1022 my $devicetype = 'hd';
1024 if (drive_is_cdrom
($drive)) {
1027 if ($drive->{file
} =~ m
|^/|) {
1028 $path = $drive->{file
};
1030 $path = PVE
::Storage
::path
($storecfg, $drive->{file
});
1033 if($path =~ m/^iscsi\:\/\
//){
1034 $devicetype = 'generic';
1037 $devicetype = 'block' if path_is_scsi
($path);
1041 if (!$conf->{scsihw
} || $conf->{scsihw
} eq 'lsi'){
1042 $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';
1044 $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}";
1047 } elsif ($drive->{interface
} eq 'ide'){
1049 my $controller = int($drive->{index} / $maxdev);
1050 my $unit = $drive->{index} % $maxdev;
1051 my $devicetype = ($drive->{media
} && $drive->{media
} eq 'cdrom') ?
"cd" : "hd";
1053 $device = "ide-$devicetype,bus=ide.$controller,unit=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1054 } elsif ($drive->{interface
} eq 'sata'){
1055 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
1056 my $unit = $drive->{index} % $MAX_SATA_DISKS;
1057 $device = "ide-drive,bus=ahci$controller.$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1058 } elsif ($drive->{interface
} eq 'usb') {
1060 # -device ide-drive,bus=ide.1,unit=0,drive=drive-ide0-1-0,id=ide0-1-0
1062 die "unsupported interface type";
1065 $device .= ",bootindex=$drive->{bootindex}" if $drive->{bootindex
};
1070 sub print_drive_full
{
1071 my ($storecfg, $vmid, $drive) = @_;
1074 foreach my $o (@qemu_drive_options) {
1075 next if $o eq 'bootindex';
1076 $opts .= ",$o=$drive->{$o}" if $drive->{$o};
1079 foreach my $o (qw(bps bps_rd bps_wr)) {
1080 my $v = $drive->{"m$o"};
1081 $opts .= ",$o=" . int($v*1024*1024) if $v;
1084 # use linux-aio by default (qemu default is threads)
1085 $opts .= ",aio=native" if !$drive->{aio
};
1088 my $volid = $drive->{file
};
1089 if (drive_is_cdrom
($drive)) {
1090 $path = get_iso_path
($storecfg, $vmid, $volid);
1092 if ($volid =~ m
|^/|) {
1095 $path = PVE
::Storage
::path
($storecfg, $volid);
1097 if (!$drive->{cache
} && ($path =~ m
|^/dev/| || $path =~ m
|\
.raw
$|)) {
1098 $opts .= ",cache=none";
1102 my $pathinfo = $path ?
"file=$path," : '';
1104 return "${pathinfo}if=none,id=drive-$drive->{interface}$drive->{index}$opts";
1107 sub print_netdevice_full
{
1108 my ($vmid, $conf, $net, $netid, $bridges) = @_;
1110 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
1112 my $device = $net->{model
};
1113 if ($net->{model
} eq 'virtio') {
1114 $device = 'virtio-net-pci';
1117 # qemu > 0.15 always try to boot from network - we disable that by
1118 # not loading the pxe rom file
1119 my $extra = ($bootorder !~ m/n/) ?
"romfile=," : '';
1120 my $pciaddr = print_pci_addr
("$netid", $bridges);
1121 my $tmpstr = "$device,${extra}mac=$net->{macaddr},netdev=$netid$pciaddr,id=$netid";
1122 $tmpstr .= ",bootindex=$net->{bootindex}" if $net->{bootindex
} ;
1126 sub print_netdev_full
{
1127 my ($vmid, $conf, $net, $netid) = @_;
1130 if ($netid =~ m/^net(\d+)$/) {
1134 die "got strange net id '$i'\n" if $i >= ${MAX_NETS
};
1136 my $ifname = "tap${vmid}i$i";
1138 # kvm uses TUNSETIFF ioctl, and that limits ifname length
1139 die "interface name '$ifname' is too long (max 15 character)\n"
1140 if length($ifname) >= 16;
1142 my $vhostparam = '';
1143 $vhostparam = ',vhost=on' if $kernel_has_vhost_net && $net->{model
} eq 'virtio';
1145 my $vmname = $conf->{name
} || "vm$vmid";
1147 if ($net->{bridge
}) {
1148 return "type=tap,id=$netid,ifname=${ifname},script=/var/lib/qemu-server/pve-bridge$vhostparam";
1150 return "type=user,id=$netid,hostname=$vmname";
1154 sub drive_is_cdrom
{
1157 return $drive && $drive->{media
} && ($drive->{media
} eq 'cdrom');
1164 return undef if !$value;
1168 if ($value =~ m/^[a-f0-9]{2}:[a-f0-9]{2}\.[a-f0-9]$/) {
1169 $res->{pciid
} = $value;
1177 # netX: e1000=XX:XX:XX:XX:XX:XX,bridge=vmbr0,rate=<mbps>
1183 foreach my $kvp (split(/,/, $data)) {
1185 if ($kvp =~ m/^(ne2k_pci|e1000|rtl8139|pcnet|virtio|ne2k_isa|i82551|i82557b|i82559er)(=([0-9a-f]{2}(:[0-9a-f]{2}){5}))?$/i) {
1187 my $mac = uc($3) || PVE
::Tools
::random_ether_addr
();
1188 $res->{model
} = $model;
1189 $res->{macaddr
} = $mac;
1190 } elsif ($kvp =~ m/^bridge=(\S+)$/) {
1191 $res->{bridge
} = $1;
1192 } elsif ($kvp =~ m/^rate=(\d+(\.\d+)?)$/) {
1194 } elsif ($kvp =~ m/^tag=(\d+)$/) {
1202 return undef if !$res->{model
};
1210 my $res = "$net->{model}";
1211 $res .= "=$net->{macaddr}" if $net->{macaddr
};
1212 $res .= ",bridge=$net->{bridge}" if $net->{bridge
};
1213 $res .= ",rate=$net->{rate}" if $net->{rate
};
1214 $res .= ",tag=$net->{tag}" if $net->{tag
};
1219 sub add_random_macs
{
1220 my ($settings) = @_;
1222 foreach my $opt (keys %$settings) {
1223 next if $opt !~ m/^net(\d+)$/;
1224 my $net = parse_net
($settings->{$opt});
1226 $settings->{$opt} = print_net
($net);
1230 sub add_unused_volume
{
1231 my ($config, $volid) = @_;
1234 for (my $ind = $MAX_UNUSED_DISKS - 1; $ind >= 0; $ind--) {
1235 my $test = "unused$ind";
1236 if (my $vid = $config->{$test}) {
1237 return if $vid eq $volid; # do not add duplicates
1243 die "To many unused volume - please delete them first.\n" if !$key;
1245 $config->{$key} = $volid;
1250 # fixme: remove all thos $noerr parameters?
1252 PVE
::JSONSchema
::register_format
('pve-qm-bootdisk', \
&verify_bootdisk
);
1253 sub verify_bootdisk
{
1254 my ($value, $noerr) = @_;
1256 return $value if valid_drivename
($value);
1258 return undef if $noerr;
1260 die "invalid boot disk '$value'\n";
1263 PVE
::JSONSchema
::register_format
('pve-qm-net', \
&verify_net
);
1265 my ($value, $noerr) = @_;
1267 return $value if parse_net
($value);
1269 return undef if $noerr;
1271 die "unable to parse network options\n";
1274 PVE
::JSONSchema
::register_format
('pve-qm-drive', \
&verify_drive
);
1276 my ($value, $noerr) = @_;
1278 return $value if parse_drive
(undef, $value);
1280 return undef if $noerr;
1282 die "unable to parse drive options\n";
1285 PVE
::JSONSchema
::register_format
('pve-qm-hostpci', \
&verify_hostpci
);
1286 sub verify_hostpci
{
1287 my ($value, $noerr) = @_;
1289 return $value if parse_hostpci
($value);
1291 return undef if $noerr;
1293 die "unable to parse pci id\n";
1296 PVE
::JSONSchema
::register_format
('pve-qm-watchdog', \
&verify_watchdog
);
1297 sub verify_watchdog
{
1298 my ($value, $noerr) = @_;
1300 return $value if parse_watchdog
($value);
1302 return undef if $noerr;
1304 die "unable to parse watchdog options\n";
1307 sub parse_watchdog
{
1310 return undef if !$value;
1314 foreach my $p (split(/,/, $value)) {
1315 next if $p =~ m/^\s*$/;
1317 if ($p =~ m/^(model=)?(i6300esb|ib700)$/) {
1319 } elsif ($p =~ m/^(action=)?(reset|shutdown|poweroff|pause|debug|none)$/) {
1320 $res->{action
} = $2;
1329 PVE
::JSONSchema
::register_format
('pve-qm-startup', \
&verify_startup
);
1330 sub verify_startup
{
1331 my ($value, $noerr) = @_;
1333 return $value if parse_startup
($value);
1335 return undef if $noerr;
1337 die "unable to parse startup options\n";
1343 return undef if !$value;
1347 foreach my $p (split(/,/, $value)) {
1348 next if $p =~ m/^\s*$/;
1350 if ($p =~ m/^(order=)?(\d+)$/) {
1352 } elsif ($p =~ m/^up=(\d+)$/) {
1354 } elsif ($p =~ m/^down=(\d+)$/) {
1364 sub parse_usb_device
{
1367 return undef if !$value;
1369 my @dl = split(/,/, $value);
1373 foreach my $v (@dl) {
1374 if ($v =~ m/^host=(0x)?([0-9A-Fa-f]{4}):(0x)?([0-9A-Fa-f]{4})$/) {
1376 $res->{vendorid
} = $2;
1377 $res->{productid
} = $4;
1378 } elsif ($v =~ m/^host=(\d+)\-(\d+(\.\d+)*)$/) {
1380 $res->{hostbus
} = $1;
1381 $res->{hostport
} = $2;
1386 return undef if !$found;
1391 PVE
::JSONSchema
::register_format
('pve-qm-usb-device', \
&verify_usb_device
);
1392 sub verify_usb_device
{
1393 my ($value, $noerr) = @_;
1395 return $value if parse_usb_device
($value);
1397 return undef if $noerr;
1399 die "unable to parse usb device\n";
1402 # add JSON properties for create and set function
1403 sub json_config_properties
{
1406 foreach my $opt (keys %$confdesc) {
1407 next if $opt eq 'parent' || $opt eq 'snaptime' || $opt eq 'vmstate';
1408 $prop->{$opt} = $confdesc->{$opt};
1415 my ($key, $value) = @_;
1417 die "unknown setting '$key'\n" if !$confdesc->{$key};
1419 my $type = $confdesc->{$key}->{type
};
1421 if (!defined($value)) {
1422 die "got undefined value\n";
1425 if ($value =~ m/[\n\r]/) {
1426 die "property contains a line feed\n";
1429 if ($type eq 'boolean') {
1430 return 1 if ($value eq '1') || ($value =~ m/^(on|yes|true)$/i);
1431 return 0 if ($value eq '0') || ($value =~ m/^(off|no|false)$/i);
1432 die "type check ('boolean') failed - got '$value'\n";
1433 } elsif ($type eq 'integer') {
1434 return int($1) if $value =~ m/^(\d+)$/;
1435 die "type check ('integer') failed - got '$value'\n";
1436 } elsif ($type eq 'string') {
1437 if (my $fmt = $confdesc->{$key}->{format
}) {
1438 if ($fmt eq 'pve-qm-drive') {
1439 # special case - we need to pass $key to parse_drive()
1440 my $drive = parse_drive
($key, $value);
1441 return $value if $drive;
1442 die "unable to parse drive options\n";
1444 PVE
::JSONSchema
::check_format
($fmt, $value);
1447 $value =~ s/^\"(.*)\"$/$1/;
1450 die "internal error"
1454 sub lock_config_full
{
1455 my ($vmid, $timeout, $code, @param) = @_;
1457 my $filename = config_file_lock
($vmid);
1459 my $res = lock_file
($filename, $timeout, $code, @param);
1467 my ($vmid, $code, @param) = @_;
1469 return lock_config_full
($vmid, 10, $code, @param);
1472 sub cfs_config_path
{
1473 my ($vmid, $node) = @_;
1475 $node = $nodename if !$node;
1476 return "nodes/$node/qemu-server/$vmid.conf";
1479 sub check_iommu_support
{
1480 #fixme : need to check IOMMU support
1481 #http://www.linux-kvm.org/page/How_to_assign_devices_with_VT-d_in_KVM
1489 my ($vmid, $node) = @_;
1491 my $cfspath = cfs_config_path
($vmid, $node);
1492 return "/etc/pve/$cfspath";
1495 sub config_file_lock
{
1498 return "$lock_dir/lock-$vmid.conf";
1504 my $conf = config_file
($vmid);
1505 utime undef, undef, $conf;
1509 my ($storecfg, $vmid, $keep_empty_config) = @_;
1511 my $conffile = config_file
($vmid);
1513 my $conf = load_config
($vmid);
1517 # only remove disks owned by this VM
1518 foreach_drive
($conf, sub {
1519 my ($ds, $drive) = @_;
1521 return if drive_is_cdrom
($drive);
1523 my $volid = $drive->{file
};
1524 return if !$volid || $volid =~ m
|^/|;
1526 my ($path, $owner) = PVE
::Storage
::path
($storecfg, $volid);
1527 return if !$path || !$owner || ($owner != $vmid);
1529 PVE
::Storage
::vdisk_free
($storecfg, $volid);
1532 if ($keep_empty_config) {
1533 PVE
::Tools
::file_set_contents
($conffile, "memory: 128\n");
1538 # also remove unused disk
1540 my $dl = PVE
::Storage
::vdisk_list
($storecfg, undef, $vmid);
1543 PVE
::Storage
::foreach_volid
($dl, sub {
1544 my ($volid, $sid, $volname, $d) = @_;
1545 PVE
::Storage
::vdisk_free
($storecfg, $volid);
1555 my ($vmid, $node) = @_;
1557 my $cfspath = cfs_config_path
($vmid, $node);
1559 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath);
1561 die "no such VM ('$vmid')\n" if !defined($conf);
1566 sub parse_vm_config
{
1567 my ($filename, $raw) = @_;
1569 return undef if !defined($raw);
1572 digest
=> Digest
::SHA
::sha1_hex
($raw),
1576 $filename =~ m
|/qemu-server/(\d
+)\
.conf
$|
1577 || die "got strange filename '$filename'";
1584 my @lines = split(/\n/, $raw);
1585 foreach my $line (@lines) {
1586 next if $line =~ m/^\s*$/;
1588 if ($line =~ m/^\[([a-z][a-z0-9_\-]+)\]\s*$/i) {
1590 $conf->{description
} = $descr if $descr;
1592 $conf = $res->{snapshots
}->{$snapname} = {};
1596 if ($line =~ m/^\#(.*)\s*$/) {
1597 $descr .= PVE
::Tools
::decode_text
($1) . "\n";
1601 if ($line =~ m/^(description):\s*(.*\S)\s*$/) {
1602 $descr .= PVE
::Tools
::decode_text
($2);
1603 } elsif ($line =~ m/snapstate:\s*(prepare|delete)\s*$/) {
1604 $conf->{snapstate
} = $1;
1605 } elsif ($line =~ m/^(args):\s*(.*\S)\s*$/) {
1608 $conf->{$key} = $value;
1609 } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/) {
1612 eval { $value = check_type
($key, $value); };
1614 warn "vm $vmid - unable to parse value of '$key' - $@";
1616 my $fmt = $confdesc->{$key}->{format
};
1617 if ($fmt && $fmt eq 'pve-qm-drive') {
1618 my $v = parse_drive
($key, $value);
1619 if (my $volid = filename_to_volume_id
($vmid, $v->{file
}, $v->{media
})) {
1620 $v->{file
} = $volid;
1621 $value = print_drive
($vmid, $v);
1623 warn "vm $vmid - unable to parse value of '$key'\n";
1628 if ($key eq 'cdrom') {
1629 $conf->{ide2
} = $value;
1631 $conf->{$key} = $value;
1637 $conf->{description
} = $descr if $descr;
1639 delete $res->{snapstate
}; # just to be sure
1644 sub write_vm_config
{
1645 my ($filename, $conf) = @_;
1647 delete $conf->{snapstate
}; # just to be sure
1649 if ($conf->{cdrom
}) {
1650 die "option ide2 conflicts with cdrom\n" if $conf->{ide2
};
1651 $conf->{ide2
} = $conf->{cdrom
};
1652 delete $conf->{cdrom
};
1655 # we do not use 'smp' any longer
1656 if ($conf->{sockets
}) {
1657 delete $conf->{smp
};
1658 } elsif ($conf->{smp
}) {
1659 $conf->{sockets
} = $conf->{smp
};
1660 delete $conf->{cores
};
1661 delete $conf->{smp
};
1664 my $used_volids = {};
1666 my $cleanup_config = sub {
1669 foreach my $key (keys %$cref) {
1670 next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots' ||
1671 $key eq 'snapstate';
1672 my $value = $cref->{$key};
1673 eval { $value = check_type
($key, $value); };
1674 die "unable to parse value of '$key' - $@" if $@;
1676 $cref->{$key} = $value;
1678 if (valid_drivename
($key)) {
1679 my $drive = PVE
::QemuServer
::parse_drive
($key, $value);
1680 $used_volids->{$drive->{file
}} = 1 if $drive && $drive->{file
};
1685 &$cleanup_config($conf);
1686 foreach my $snapname (keys %{$conf->{snapshots
}}) {
1687 &$cleanup_config($conf->{snapshots
}->{$snapname});
1690 # remove 'unusedX' settings if we re-add a volume
1691 foreach my $key (keys %$conf) {
1692 my $value = $conf->{$key};
1693 if ($key =~ m/^unused/ && $used_volids->{$value}) {
1694 delete $conf->{$key};
1698 my $generate_raw_config = sub {
1703 # add description as comment to top of file
1704 my $descr = $conf->{description
} || '';
1705 foreach my $cl (split(/\n/, $descr)) {
1706 $raw .= '#' . PVE
::Tools
::encode_text
($cl) . "\n";
1709 foreach my $key (sort keys %$conf) {
1710 next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots';
1711 $raw .= "$key: $conf->{$key}\n";
1716 my $raw = &$generate_raw_config($conf);
1717 foreach my $snapname (sort keys %{$conf->{snapshots
}}) {
1718 $raw .= "\n[$snapname]\n";
1719 $raw .= &$generate_raw_config($conf->{snapshots
}->{$snapname});
1725 sub update_config_nolock
{
1726 my ($vmid, $conf, $skiplock) = @_;
1728 check_lock
($conf) if !$skiplock;
1730 my $cfspath = cfs_config_path
($vmid);
1732 PVE
::Cluster
::cfs_write_file
($cfspath, $conf);
1736 my ($vmid, $conf, $skiplock) = @_;
1738 lock_config
($vmid, &update_config_nolock
, $conf, $skiplock);
1745 # we use static defaults from our JSON schema configuration
1746 foreach my $key (keys %$confdesc) {
1747 if (defined(my $default = $confdesc->{$key}->{default})) {
1748 $res->{$key} = $default;
1752 my $conf = PVE
::Cluster
::cfs_read_file
('datacenter.cfg');
1753 $res->{keyboard
} = $conf->{keyboard
} if $conf->{keyboard
};
1759 my $vmlist = PVE
::Cluster
::get_vmlist
();
1761 return $res if !$vmlist || !$vmlist->{ids
};
1762 my $ids = $vmlist->{ids
};
1764 foreach my $vmid (keys %$ids) {
1765 my $d = $ids->{$vmid};
1766 next if !$d->{node
} || $d->{node
} ne $nodename;
1767 next if !$d->{type
} || $d->{type
} ne 'qemu';
1768 $res->{$vmid}->{exists} = 1;
1773 # test if VM uses local resources (to prevent migration)
1774 sub check_local_resources
{
1775 my ($conf, $noerr) = @_;
1779 $loc_res = 1 if $conf->{hostusb
}; # old syntax
1780 $loc_res = 1 if $conf->{hostpci
}; # old syntax
1782 foreach my $k (keys %$conf) {
1783 $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/;
1786 die "VM uses local resources\n" if $loc_res && !$noerr;
1791 # check is used storages are available on all nodes (use by migrate)
1792 sub check_storage_availability
{
1793 my ($storecfg, $conf, $node) = @_;
1795 foreach_drive
($conf, sub {
1796 my ($ds, $drive) = @_;
1798 my $volid = $drive->{file
};
1801 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
1804 # check if storage is available on both nodes
1805 my $scfg = PVE
::Storage
::storage_check_node
($storecfg, $sid);
1806 PVE
::Storage
::storage_check_node
($storecfg, $sid, $node);
1813 die "VM is locked ($conf->{lock})\n" if $conf->{lock};
1817 my ($pidfile, $pid) = @_;
1819 my $fh = IO
::File-
>new("/proc/$pid/cmdline", "r");
1823 return undef if !$line;
1824 my @param = split(/\0/, $line);
1826 my $cmd = $param[0];
1827 return if !$cmd || ($cmd !~ m
|kvm
$|);
1829 for (my $i = 0; $i < scalar (@param); $i++) {
1832 if (($p eq '-pidfile') || ($p eq '--pidfile')) {
1833 my $p = $param[$i+1];
1834 return 1 if $p && ($p eq $pidfile);
1843 my ($vmid, $nocheck, $node) = @_;
1845 my $filename = config_file
($vmid, $node);
1847 die "unable to find configuration file for VM $vmid - no such machine\n"
1848 if !$nocheck && ! -f
$filename;
1850 my $pidfile = pidfile_name
($vmid);
1852 if (my $fd = IO
::File-
>new("<$pidfile")) {
1857 my $mtime = $st->mtime;
1858 if ($mtime > time()) {
1859 warn "file '$filename' modified in future\n";
1862 if ($line =~ m/^(\d+)$/) {
1864 if (check_cmdline
($pidfile, $pid)) {
1865 if (my $pinfo = PVE
::ProcFSTools
::check_process_running
($pid)) {
1877 my $vzlist = config_list
();
1879 my $fd = IO
::Dir-
>new($var_run_tmpdir) || return $vzlist;
1881 while (defined(my $de = $fd->read)) {
1882 next if $de !~ m/^(\d+)\.pid$/;
1884 next if !defined($vzlist->{$vmid});
1885 if (my $pid = check_running
($vmid)) {
1886 $vzlist->{$vmid}->{pid
} = $pid;
1894 my ($storecfg, $conf) = @_;
1896 my $bootdisk = $conf->{bootdisk
};
1897 return undef if !$bootdisk;
1898 return undef if !valid_drivename
($bootdisk);
1900 return undef if !$conf->{$bootdisk};
1902 my $drive = parse_drive
($bootdisk, $conf->{$bootdisk});
1903 return undef if !defined($drive);
1905 return undef if drive_is_cdrom
($drive);
1907 my $volid = $drive->{file
};
1908 return undef if !$volid;
1910 return $drive->{size
};
1913 my $last_proc_pid_stat;
1915 # get VM status information
1916 # This must be fast and should not block ($full == false)
1917 # We only query KVM using QMP if $full == true (this can be slow)
1919 my ($opt_vmid, $full) = @_;
1923 my $storecfg = PVE
::Storage
::config
();
1925 my $list = vzlist
();
1926 my ($uptime) = PVE
::ProcFSTools
::read_proc_uptime
(1);
1928 my $cpucount = $cpuinfo->{cpus
} || 1;
1930 foreach my $vmid (keys %$list) {
1931 next if $opt_vmid && ($vmid ne $opt_vmid);
1933 my $cfspath = cfs_config_path
($vmid);
1934 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath) || {};
1937 $d->{pid
} = $list->{$vmid}->{pid
};
1939 # fixme: better status?
1940 $d->{status
} = $list->{$vmid}->{pid
} ?
'running' : 'stopped';
1942 my $size = disksize
($storecfg, $conf);
1943 if (defined($size)) {
1944 $d->{disk
} = 0; # no info available
1945 $d->{maxdisk
} = $size;
1951 $d->{cpus
} = ($conf->{sockets
} || 1) * ($conf->{cores
} || 1);
1952 $d->{cpus
} = $cpucount if $d->{cpus
} > $cpucount;
1954 $d->{name
} = $conf->{name
} || "VM $vmid";
1955 $d->{maxmem
} = $conf->{memory
} ?
$conf->{memory
}*(1024*1024) : 0;
1965 $d->{diskwrite
} = 0;
1970 my $netdev = PVE
::ProcFSTools
::read_proc_net_dev
();
1971 foreach my $dev (keys %$netdev) {
1972 next if $dev !~ m/^tap([1-9]\d*)i/;
1974 my $d = $res->{$vmid};
1977 $d->{netout
} += $netdev->{$dev}->{receive
};
1978 $d->{netin
} += $netdev->{$dev}->{transmit
};
1981 my $ctime = gettimeofday
;
1983 foreach my $vmid (keys %$list) {
1985 my $d = $res->{$vmid};
1986 my $pid = $d->{pid
};
1989 my $pstat = PVE
::ProcFSTools
::read_proc_pid_stat
($pid);
1990 next if !$pstat; # not running
1992 my $used = $pstat->{utime} + $pstat->{stime
};
1994 $d->{uptime
} = int(($uptime - $pstat->{starttime
})/$cpuinfo->{user_hz
});
1996 if ($pstat->{vsize
}) {
1997 $d->{mem
} = int(($pstat->{rss
}/$pstat->{vsize
})*$d->{maxmem
});
2000 my $old = $last_proc_pid_stat->{$pid};
2002 $last_proc_pid_stat->{$pid} = {
2010 my $dtime = ($ctime - $old->{time}) * $cpucount * $cpuinfo->{user_hz
};
2012 if ($dtime > 1000) {
2013 my $dutime = $used - $old->{used
};
2015 $d->{cpu
} = (($dutime/$dtime)* $cpucount) / $d->{cpus
};
2016 $last_proc_pid_stat->{$pid} = {
2022 $d->{cpu
} = $old->{cpu
};
2026 return $res if !$full;
2028 my $qmpclient = PVE
::QMPClient-
>new();
2030 my $blockstatscb = sub {
2031 my ($vmid, $resp) = @_;
2032 my $data = $resp->{'return'} || [];
2033 my $totalrdbytes = 0;
2034 my $totalwrbytes = 0;
2035 for my $blockstat (@$data) {
2036 $totalrdbytes = $totalrdbytes + $blockstat->{stats
}->{rd_bytes
};
2037 $totalwrbytes = $totalwrbytes + $blockstat->{stats
}->{wr_bytes
};
2039 $res->{$vmid}->{diskread
} = $totalrdbytes;
2040 $res->{$vmid}->{diskwrite
} = $totalwrbytes;
2043 my $statuscb = sub {
2044 my ($vmid, $resp) = @_;
2045 $qmpclient->queue_cmd($vmid, $blockstatscb, 'query-blockstats');
2047 my $status = 'unknown';
2048 if (!defined($status = $resp->{'return'}->{status
})) {
2049 warn "unable to get VM status\n";
2053 $res->{$vmid}->{qmpstatus
} = $resp->{'return'}->{status
};
2056 foreach my $vmid (keys %$list) {
2057 next if $opt_vmid && ($vmid ne $opt_vmid);
2058 next if !$res->{$vmid}->{pid
}; # not running
2059 $qmpclient->queue_cmd($vmid, $statuscb, 'query-status');
2062 $qmpclient->queue_execute();
2064 foreach my $vmid (keys %$list) {
2065 next if $opt_vmid && ($vmid ne $opt_vmid);
2066 $res->{$vmid}->{qmpstatus
} = $res->{$vmid}->{status
} if !$res->{$vmid}->{qmpstatus
};
2073 my ($conf, $func) = @_;
2075 foreach my $ds (keys %$conf) {
2076 next if !valid_drivename
($ds);
2078 my $drive = parse_drive
($ds, $conf->{$ds});
2081 &$func($ds, $drive);
2086 my ($conf, $func) = @_;
2090 my $test_volid = sub {
2091 my ($volid, $is_cdrom) = @_;
2095 $volhash->{$volid} = $is_cdrom || 0;
2098 PVE
::QemuServer
::foreach_drive
($conf, sub {
2099 my ($ds, $drive) = @_;
2100 &$test_volid($drive->{file
}, drive_is_cdrom
($drive));
2103 foreach my $snapname (keys %{$conf->{snapshots
}}) {
2104 my $snap = $conf->{snapshots
}->{$snapname};
2105 &$test_volid($snap->{vmstate
}, 0);
2106 PVE
::QemuServer
::foreach_drive
($snap, sub {
2107 my ($ds, $drive) = @_;
2108 &$test_volid($drive->{file
}, drive_is_cdrom
($drive));
2112 foreach my $volid (keys %$volhash) {
2113 &$func($volid, $volhash->{$volid});
2117 sub config_to_command
{
2118 my ($storecfg, $vmid, $conf, $defaults) = @_;
2124 my $kvmver = kvm_user_version
();
2125 my $vernum = 0; # unknown
2126 if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
2127 $vernum = $1*1000000+$2*1000;
2128 } elsif ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
2129 $vernum = $1*1000000+$2*1000+$3;
2132 die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 15000;
2134 my $have_ovz = -f
'/proc/vz/vestat';
2136 push @$cmd, '/usr/bin/kvm';
2138 push @$cmd, '-id', $vmid;
2142 my $qmpsocket = qmp_socket
($vmid);
2143 push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
2144 push @$cmd, '-mon', "chardev=qmp,mode=control";
2146 my $socket = vnc_socket
($vmid);
2147 push @$cmd, '-vnc', "unix:$socket,x509,password";
2149 push @$cmd, '-pidfile' , pidfile_name
($vmid);
2151 push @$cmd, '-daemonize';
2154 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2155 next if !$conf->{"usb$i"};
2158 # include usb device config
2159 push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
2161 # enable absolute mouse coordinates (needed by vnc)
2162 my $tablet = defined($conf->{tablet
}) ?
$conf->{tablet
} : $defaults->{tablet
};
2165 push @$devices, '-device', 'usb-tablet,bus=ehci.0,port=6';
2167 push @$devices, '-usbdevice', 'tablet';
2172 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
2173 my $d = parse_hostpci
($conf->{"hostpci$i"});
2175 $pciaddr = print_pci_addr
("hostpci$i", $bridges);
2176 push @$devices, '-device', "pci-assign,host=$d->{pciid},id=hostpci$i$pciaddr";
2180 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2181 my $d = parse_usb_device
($conf->{"usb$i"});
2183 if ($d->{vendorid
} && $d->{productid
}) {
2184 push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2185 } elsif (defined($d->{hostbus
}) && defined($d->{hostport
})) {
2186 push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2191 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
2192 if (my $path = $conf->{"serial$i"}) {
2193 die "no such serial device\n" if ! -c
$path;
2194 push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2195 push @$devices, '-device', "isa-serial,chardev=serial$i";
2200 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
2201 if (my $path = $conf->{"parallel$i"}) {
2202 die "no such parallel device\n" if ! -c
$path;
2203 push @$devices, '-chardev', "parport,id=parallel$i,path=$path";
2204 push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2208 my $vmname = $conf->{name
} || "vm$vmid";
2210 push @$cmd, '-name', $vmname;
2213 $sockets = $conf->{smp
} if $conf->{smp
}; # old style - no longer iused
2214 $sockets = $conf->{sockets
} if $conf->{sockets
};
2216 my $cores = $conf->{cores
} || 1;
2218 push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2220 push @$cmd, '-cpu', $conf->{cpu
} if $conf->{cpu
};
2222 push @$cmd, '-nodefaults';
2224 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
2226 my $bootindex_hash = {};
2228 foreach my $o (split(//, $bootorder)) {
2229 $bootindex_hash->{$o} = $i*100;
2233 push @$cmd, '-boot', "menu=on";
2235 push @$cmd, '-no-acpi' if defined($conf->{acpi
}) && $conf->{acpi
} == 0;
2237 push @$cmd, '-no-reboot' if defined($conf->{reboot
}) && $conf->{reboot
} == 0;
2239 my $vga = $conf->{vga
};
2241 if ($conf->{ostype
} && ($conf->{ostype
} eq 'win7' || $conf->{ostype
} eq 'w2k8')) {
2248 push @$cmd, '-vga', $vga if $vga; # for kvm 77 and later
2251 my $tdf = defined($conf->{tdf
}) ?
$conf->{tdf
} : $defaults->{tdf
};
2252 # ignore - no longer supported by newer kvm
2253 # push @$cmd, '-tdf' if $tdf;
2255 my $nokvm = defined($conf->{kvm
}) && $conf->{kvm
} == 0 ?
1 : 0;
2257 if (my $ost = $conf->{ostype
}) {
2258 # other, wxp, w2k, w2k3, w2k8, wvista, win7, l24, l26
2260 if ($ost =~ m/^w/) { # windows
2261 push @$cmd, '-localtime' if !defined($conf->{localtime});
2263 # use rtc-td-hack when acpi is enabled
2264 if (!(defined($conf->{acpi
}) && $conf->{acpi
} == 0)) {
2265 push @$cmd, '-rtc-td-hack';
2269 if ($ost eq 'win7' || $ost eq 'w2k8' || $ost eq 'wvista') {
2270 push @$cmd, '-no-kvm-pit-reinjection';
2271 push @$cmd, '-no-hpet';
2281 push @$cmd, '-no-kvm';
2283 die "No accelerator found!\n" if !$cpuinfo->{hvm
};
2286 push @$cmd, '-localtime' if $conf->{localtime};
2288 push @$cmd, '-startdate', $conf->{startdate
} if $conf->{startdate
};
2290 push @$cmd, '-S' if $conf->{freeze
};
2292 # set keyboard layout
2293 my $kb = $conf->{keyboard
} || $defaults->{keyboard
};
2294 push @$cmd, '-k', $kb if $kb;
2297 #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2298 #push @$cmd, '-soundhw', 'es1370';
2299 #push @$cmd, '-soundhw', $soundhw if $soundhw;
2301 if($conf->{agent
}) {
2302 my $qgasocket = qga_socket
($vmid);
2303 my $pciaddr = print_pci_addr
("qga0", $bridges);
2304 push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
2305 push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
2306 push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
2309 $pciaddr = print_pci_addr
("balloon0", $bridges);
2310 push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr" if $conf->{balloon
};
2312 if ($conf->{watchdog
}) {
2313 my $wdopts = parse_watchdog
($conf->{watchdog
});
2314 $pciaddr = print_pci_addr
("watchdog", $bridges);
2315 my $watchdog = $wdopts->{model
} || 'i6300esb';
2316 push @$devices, '-device', "$watchdog$pciaddr";
2317 push @$devices, '-watchdog-action', $wdopts->{action
} if $wdopts->{action
};
2321 my $scsicontroller = {};
2322 my $ahcicontroller = {};
2323 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : $defaults->{scsihw
};
2325 foreach_drive
($conf, sub {
2326 my ($ds, $drive) = @_;
2328 if (PVE
::Storage
::parse_volume_id
($drive->{file
}, 1)) {
2329 push @$vollist, $drive->{file
};
2332 $use_virtio = 1 if $ds =~ m/^virtio/;
2334 if (drive_is_cdrom
($drive)) {
2335 if ($bootindex_hash->{d
}) {
2336 $drive->{bootindex
} = $bootindex_hash->{d
};
2337 $bootindex_hash->{d
} += 1;
2340 if ($bootindex_hash->{c
}) {
2341 $drive->{bootindex
} = $bootindex_hash->{c
} if $conf->{bootdisk
} && ($conf->{bootdisk
} eq $ds);
2342 $bootindex_hash->{c
} += 1;
2346 if ($drive->{interface
} eq 'scsi') {
2348 my $maxdev = ($scsihw ne 'lsi') ?
256 : 7;
2349 my $controller = int($drive->{index} / $maxdev);
2350 $pciaddr = print_pci_addr
("scsihw$controller", $bridges);
2351 push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
2352 $scsicontroller->{$controller}=1;
2355 if ($drive->{interface
} eq 'sata') {
2356 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
2357 $pciaddr = print_pci_addr
("ahci$controller", $bridges);
2358 push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
2359 $ahcicontroller->{$controller}=1;
2362 push @$devices, '-drive',print_drive_full
($storecfg, $vmid, $drive);
2363 push @$devices, '-device',print_drivedevice_full
($storecfg, $conf, $vmid, $drive, $bridges);
2366 push @$cmd, '-m', $conf->{memory
} || $defaults->{memory
};
2368 for (my $i = 0; $i < $MAX_NETS; $i++) {
2369 next if !$conf->{"net$i"};
2370 my $d = parse_net
($conf->{"net$i"});
2373 $use_virtio = 1 if $d->{model
} eq 'virtio';
2375 if ($bootindex_hash->{n
}) {
2376 $d->{bootindex
} = $bootindex_hash->{n
};
2377 $bootindex_hash->{n
} += 1;
2380 my $netdevfull = print_netdev_full
($vmid,$conf,$d,"net$i");
2381 push @$devices, '-netdev', $netdevfull;
2383 my $netdevicefull = print_netdevice_full
($vmid,$conf,$d,"net$i",$bridges);
2384 push @$devices, '-device', $netdevicefull;
2388 while (my ($k, $v) = each %$bridges) {
2389 $pciaddr = print_pci_addr
("pci.$k");
2390 unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
2394 # hack: virtio with fairsched is unreliable, so we do not use fairsched
2395 # when the VM uses virtio devices.
2396 if (!$use_virtio && $have_ovz) {
2398 my $cpuunits = defined($conf->{cpuunits
}) ?
2399 $conf->{cpuunits
} : $defaults->{cpuunits
};
2401 push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
2403 # fixme: cpulimit is currently ignored
2404 #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2408 if ($conf->{args
}) {
2409 my $aa = PVE
::Tools
::split_args
($conf->{args
});
2413 push @$cmd, @$devices;
2414 return wantarray ?
($cmd, $vollist) : $cmd;
2419 return "${var_run_tmpdir}/$vmid.vnc";
2424 return "${var_run_tmpdir}/$vmid.qmp";
2429 return "${var_run_tmpdir}/$vmid.qga";
2434 return "${var_run_tmpdir}/$vmid.pid";
2437 sub next_migrate_port
{
2439 for (my $p = 60000; $p < 60010; $p++) {
2441 my $sock = IO
::Socket
::INET-
>new(Listen
=> 5,
2442 LocalAddr
=> 'localhost',
2453 die "unable to find free migration port";
2456 sub vm_devices_list
{
2459 my $res = vm_mon_cmd
($vmid, 'query-pci');
2462 foreach my $pcibus (@$res) {
2463 foreach my $device (@{$pcibus->{devices
}}) {
2464 next if !$device->{'qdev_id'};
2465 $devices->{$device->{'qdev_id'}} = $device;
2473 my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2475 return 1 if !check_running
($vmid) || !$conf->{hotplug
};
2477 my $devices_list = vm_devices_list
($vmid);
2478 return 1 if defined($devices_list->{$deviceid});
2480 qemu_bridgeadd
($storecfg, $conf, $vmid, $deviceid); #add bridge if we need it for the device
2482 if ($deviceid =~ m/^(virtio)(\d+)$/) {
2483 return undef if !qemu_driveadd
($storecfg, $vmid, $device);
2484 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
2485 qemu_deviceadd
($vmid, $devicefull);
2486 if(!qemu_deviceaddverify
($vmid, $deviceid)) {
2487 qemu_drivedel
($vmid, $deviceid);
2492 if ($deviceid =~ m/^(scsihw)(\d+)$/) {
2493 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : "lsi";
2494 my $pciaddr = print_pci_addr
($deviceid);
2495 my $devicefull = "$scsihw,id=$deviceid$pciaddr";
2496 qemu_deviceadd
($vmid, $devicefull);
2497 return undef if(!qemu_deviceaddverify
($vmid, $deviceid));
2500 if ($deviceid =~ m/^(scsi)(\d+)$/) {
2501 return 1 if ($conf->{scsihw
} && $conf->{scsihw
} ne 'lsi'); #virtio-scsi not yet support hotplug
2502 return undef if !qemu_findorcreatescsihw
($storecfg,$conf, $vmid, $device);
2503 return undef if !qemu_driveadd
($storecfg, $vmid, $device);
2504 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
2505 if(!qemu_deviceadd
($vmid, $devicefull)) {
2506 qemu_drivedel
($vmid, $deviceid);
2511 if ($deviceid =~ m/^(net)(\d+)$/) {
2512 return undef if !qemu_netdevadd
($vmid, $conf, $device, $deviceid);
2513 my $netdevicefull = print_netdevice_full
($vmid, $conf, $device, $deviceid);
2514 qemu_deviceadd
($vmid, $netdevicefull);
2515 if(!qemu_deviceaddverify
($vmid, $deviceid)) {
2516 qemu_netdevdel
($vmid, $deviceid);
2521 if ($deviceid =~ m/^(pci\.)(\d+)$/) {
2523 my $pciaddr = print_pci_addr
($deviceid);
2524 my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
2525 qemu_deviceadd
($vmid, $devicefull);
2526 return undef if !qemu_deviceaddverify
($vmid, $deviceid);
2532 sub vm_deviceunplug
{
2533 my ($vmid, $conf, $deviceid) = @_;
2535 return 1 if !check_running
($vmid) || !$conf->{hotplug
};
2537 my $devices_list = vm_devices_list
($vmid);
2538 return 1 if !defined($devices_list->{$deviceid});
2540 die "can't unplug bootdisk" if $conf->{bootdisk
} && $conf->{bootdisk
} eq $deviceid;
2542 if ($deviceid =~ m/^(virtio)(\d+)$/) {
2543 return undef if !qemu_drivedel
($vmid, $deviceid);
2544 qemu_devicedel
($vmid, $deviceid);
2545 return undef if !qemu_devicedelverify
($vmid, $deviceid);
2548 if ($deviceid =~ m/^(lsi)(\d+)$/) {
2549 return undef if !qemu_devicedel
($vmid, $deviceid);
2552 if ($deviceid =~ m/^(scsi)(\d+)$/) {
2553 return undef if !qemu_devicedel
($vmid, $deviceid);
2554 return undef if !qemu_drivedel
($vmid, $deviceid);
2557 if ($deviceid =~ m/^(net)(\d+)$/) {
2558 return undef if !qemu_netdevdel
($vmid, $deviceid);
2559 qemu_devicedel
($vmid, $deviceid);
2560 return undef if !qemu_devicedelverify
($vmid, $deviceid);
2566 sub qemu_deviceadd
{
2567 my ($vmid, $devicefull) = @_;
2569 my $ret = vm_human_monitor_command
($vmid, "device_add $devicefull");
2571 # Otherwise, if the command succeeds, no output is sent. So any non-empty string shows an error
2572 return 1 if $ret eq "";
2573 syslog
("err", "error on hotplug device : $ret");
2578 sub qemu_devicedel
{
2579 my($vmid, $deviceid) = @_;
2581 my $ret = vm_human_monitor_command
($vmid, "device_del $deviceid");
2583 return 1 if $ret eq "";
2584 syslog
("err", "detaching device $deviceid failed : $ret");
2589 my($storecfg, $vmid, $device) = @_;
2591 my $drive = print_drive_full
($storecfg, $vmid, $device);
2592 my $ret = vm_human_monitor_command
($vmid, "drive_add auto $drive");
2593 # If the command succeeds qemu prints: "OK"
2594 if ($ret !~ m/OK/s) {
2595 syslog
("err", "adding drive failed: $ret");
2602 my($vmid, $deviceid) = @_;
2604 my $ret = vm_human_monitor_command
($vmid, "drive_del drive-$deviceid");
2606 if ($ret =~ m/Device \'.*?\' not found/s) {
2607 # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2609 elsif ($ret ne "") {
2610 syslog
("err", "deleting drive $deviceid failed : $ret");
2616 sub qemu_deviceaddverify
{
2617 my ($vmid,$deviceid) = @_;
2619 for (my $i = 0; $i <= 5; $i++) {
2620 my $devices_list = vm_devices_list
($vmid);
2621 return 1 if defined($devices_list->{$deviceid});
2624 syslog
("err", "error on hotplug device $deviceid");
2629 sub qemu_devicedelverify
{
2630 my ($vmid,$deviceid) = @_;
2632 #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2633 for (my $i = 0; $i <= 5; $i++) {
2634 my $devices_list = vm_devices_list
($vmid);
2635 return 1 if !defined($devices_list->{$deviceid});
2638 syslog
("err", "error on hot-unplugging device $deviceid");
2642 sub qemu_findorcreatescsihw
{
2643 my ($storecfg, $conf, $vmid, $device) = @_;
2645 my $maxdev = ($conf->{scsihw
} && $conf->{scsihw
} ne 'lsi') ?
256 : 7;
2646 my $controller = int($device->{index} / $maxdev);
2647 my $scsihwid="scsihw$controller";
2648 my $devices_list = vm_devices_list
($vmid);
2650 if(!defined($devices_list->{$scsihwid})) {
2651 return undef if !vm_deviceplug
($storecfg, $conf, $vmid, $scsihwid);
2656 sub qemu_bridgeadd
{
2657 my ($storecfg, $conf, $vmid, $device) = @_;
2660 my $bridgeid = undef;
2661 print_pci_addr
($device, $bridges);
2663 while (my ($k, $v) = each %$bridges) {
2666 return if $bridgeid < 1;
2667 my $bridge = "pci.$bridgeid";
2668 my $devices_list = vm_devices_list
($vmid);
2670 if(!defined($devices_list->{$bridge})) {
2671 return undef if !vm_deviceplug
($storecfg, $conf, $vmid, $bridge);
2676 sub qemu_netdevadd
{
2677 my ($vmid, $conf, $device, $deviceid) = @_;
2679 my $netdev = print_netdev_full
($vmid, $conf, $device, $deviceid);
2680 my $ret = vm_human_monitor_command
($vmid, "netdev_add $netdev");
2683 #if the command succeeds, no output is sent. So any non-empty string shows an error
2684 return 1 if $ret eq "";
2685 syslog
("err", "adding netdev failed: $ret");
2689 sub qemu_netdevdel
{
2690 my ($vmid, $deviceid) = @_;
2692 my $ret = vm_human_monitor_command
($vmid, "netdev_del $deviceid");
2694 #if the command succeeds, no output is sent. So any non-empty string shows an error
2695 return 1 if $ret eq "";
2696 syslog
("err", "deleting netdev failed: $ret");
2700 sub qemu_block_set_io_throttle
{
2701 my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
2703 return if !check_running
($vmid) ;
2706 $bps_rd = 0 if !$bps_rd;
2707 $bps_wr = 0 if !$bps_wr;
2708 $iops = 0 if !$iops;
2709 $iops_rd = 0 if !$iops_rd;
2710 $iops_wr = 0 if !$iops_wr;
2712 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));
2716 # old code, only used to shutdown old VM after update
2718 my ($fh, $timeout) = @_;
2720 my $sel = new IO
::Select
;
2727 while (scalar (@ready = $sel->can_read($timeout))) {
2729 if ($count = $fh->sysread($buf, 8192)) {
2730 if ($buf =~ /^(.*)\(qemu\) $/s) {
2737 if (!defined($count)) {
2744 die "monitor read timeout\n" if !scalar(@ready);
2749 # old code, only used to shutdown old VM after update
2750 sub vm_monitor_command
{
2751 my ($vmid, $cmdstr, $nocheck) = @_;
2756 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
2758 my $sname = "${var_run_tmpdir}/$vmid.mon";
2760 my $sock = IO
::Socket
::UNIX-
>new( Peer
=> $sname ) ||
2761 die "unable to connect to VM $vmid socket - $!\n";
2765 # hack: migrate sometime blocks the monitor (when migrate_downtime
2767 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2768 $timeout = 60*60; # 1 hour
2772 my $data = __read_avail
($sock, $timeout);
2774 if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
2775 die "got unexpected qemu monitor banner\n";
2778 my $sel = new IO
::Select
;
2781 if (!scalar(my @ready = $sel->can_write($timeout))) {
2782 die "monitor write error - timeout";
2785 my $fullcmd = "$cmdstr\r";
2787 # syslog('info', "VM $vmid monitor command: $cmdstr");
2790 if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
2791 die "monitor write error - $!";
2794 return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
2798 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2799 $timeout = 60*60; # 1 hour
2800 } elsif ($cmdstr =~ m/^(eject|change)/) {
2801 $timeout = 60; # note: cdrom mount command is slow
2803 if ($res = __read_avail
($sock, $timeout)) {
2805 my @lines = split("\r?\n", $res);
2807 shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
2809 $res = join("\n", @lines);
2817 syslog
("err", "VM $vmid monitor command failed - $err");
2824 sub qemu_block_resize
{
2825 my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
2827 my $running = PVE
::QemuServer
::check_running
($vmid);
2829 return if !PVE
::Storage
::volume_resize
($storecfg, $volid, $size, $running);
2831 return if !$running;
2833 vm_mon_cmd
($vmid, "block_resize", device
=> $deviceid, size
=> int($size));
2837 sub qemu_volume_snapshot
{
2838 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
2840 my $running = PVE
::QemuServer
::check_running
($vmid);
2842 return if !PVE
::Storage
::volume_snapshot
($storecfg, $volid, $snap, $running);
2844 return if !$running;
2846 vm_mon_cmd
($vmid, "snapshot-drive", device
=> $deviceid, name
=> $snap);
2850 sub qemu_volume_snapshot_delete
{
2851 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
2853 my $running = PVE
::QemuServer
::check_running
($vmid);
2855 return if !PVE
::Storage
::volume_snapshot_delete
($storecfg, $volid, $snap, $running);
2857 return if !$running;
2859 vm_mon_cmd
($vmid, "delete-drive-snapshot", device
=> $deviceid, name
=> $snap);
2865 #need to impplement call to qemu-ga
2868 sub qga_unfreezefs
{
2871 #need to impplement call to qemu-ga
2875 my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom) = @_;
2877 lock_config
($vmid, sub {
2878 my $conf = load_config
($vmid, $migratedfrom);
2880 check_lock
($conf) if !$skiplock;
2882 die "VM $vmid already running\n" if check_running
($vmid, undef, $migratedfrom);
2884 my $defaults = load_defaults
();
2886 # set environment variable useful inside network script
2887 $ENV{PVE_MIGRATED_FROM
} = $migratedfrom if $migratedfrom;
2889 my ($cmd, $vollist) = config_to_command
($storecfg, $vmid, $conf, $defaults);
2891 my $migrate_port = 0;
2894 if ($statefile eq 'tcp') {
2895 $migrate_port = next_migrate_port
();
2896 my $migrate_uri = "tcp:localhost:${migrate_port}";
2897 push @$cmd, '-incoming', $migrate_uri;
2900 push @$cmd, '-loadstate', $statefile;
2905 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
2906 my $d = parse_hostpci
($conf->{"hostpci$i"});
2908 my $info = pci_device_info
("0000:$d->{pciid}");
2909 die "IOMMU not present\n" if !check_iommu_support
();
2910 die "no pci device info for device '$d->{pciid}'\n" if !$info;
2911 die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub
($info);
2912 die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset
($info);
2915 PVE
::Storage
::activate_volumes
($storecfg, $vollist);
2917 eval { run_command
($cmd, timeout
=> $statefile ?
undef : 30); };
2919 die "start failed: $err" if $err;
2921 print "migration listens on port $migrate_port\n" if $migrate_port;
2923 if ($statefile && $statefile ne 'tcp') {
2924 eval { vm_mon_cmd
($vmid, "cont"); };
2928 # always set migrate speed (overwrite kvm default of 32m)
2929 # we set a very hight default of 8192m which is basically unlimited
2930 my $migrate_speed = $defaults->{migrate_speed
} || 8192;
2931 $migrate_speed = $conf->{migrate_speed
} || $migrate_speed;
2932 $migrate_speed = $migrate_speed * 1048576;
2934 vm_mon_cmd
($vmid, "migrate_set_speed", value
=> $migrate_speed);
2937 my $migrate_downtime = $defaults->{migrate_downtime
};
2938 $migrate_downtime = $conf->{migrate_downtime
} if defined($conf->{migrate_downtime
});
2939 if (defined($migrate_downtime)) {
2940 eval { vm_mon_cmd
($vmid, "migrate_set_downtime", value
=> $migrate_downtime); };
2944 my $capabilities = {};
2945 $capabilities->{capability
} = "xbzrle";
2946 $capabilities->{state} = JSON
::true
;
2947 eval { PVE
::QemuServer
::vm_mon_cmd_nocheck
($vmid, "migrate-set-capabilities", capabilities
=> [$capabilities]); };
2950 vm_balloonset
($vmid, $conf->{balloon
}) if $conf->{balloon
};
2956 my ($vmid, $execute, %params) = @_;
2958 my $cmd = { execute
=> $execute, arguments
=> \
%params };
2959 vm_qmp_command
($vmid, $cmd);
2962 sub vm_mon_cmd_nocheck
{
2963 my ($vmid, $execute, %params) = @_;
2965 my $cmd = { execute
=> $execute, arguments
=> \
%params };
2966 vm_qmp_command
($vmid, $cmd, 1);
2969 sub vm_qmp_command
{
2970 my ($vmid, $cmd, $nocheck) = @_;
2975 if ($cmd->{arguments
} && $cmd->{arguments
}->{timeout
}) {
2976 $timeout = $cmd->{arguments
}->{timeout
};
2977 delete $cmd->{arguments
}->{timeout
};
2981 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
2982 my $sname = PVE
::QemuServer
::qmp_socket
($vmid);
2984 my $qmpclient = PVE
::QMPClient-
>new();
2986 $res = $qmpclient->cmd($vmid, $cmd, $timeout);
2987 } elsif (-e
"${var_run_tmpdir}/$vmid.mon") {
2988 die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
2989 if scalar(%{$cmd->{arguments
}});
2990 vm_monitor_command
($vmid, $cmd->{execute
}, $nocheck);
2992 die "unable to open monitor socket\n";
2996 syslog
("err", "VM $vmid qmp command failed - $err");
3003 sub vm_human_monitor_command
{
3004 my ($vmid, $cmdline) = @_;
3009 execute
=> 'human-monitor-command',
3010 arguments
=> { 'command-line' => $cmdline},
3013 return vm_qmp_command
($vmid, $cmd);
3016 sub vm_commandline
{
3017 my ($storecfg, $vmid) = @_;
3019 my $conf = load_config
($vmid);
3021 my $defaults = load_defaults
();
3023 my $cmd = config_to_command
($storecfg, $vmid, $conf, $defaults);
3025 return join(' ', @$cmd);
3029 my ($vmid, $skiplock) = @_;
3031 lock_config
($vmid, sub {
3033 my $conf = load_config
($vmid);
3035 check_lock
($conf) if !$skiplock;
3037 vm_mon_cmd
($vmid, "system_reset");
3041 sub get_vm_volumes
{
3045 foreach_volid
($conf, sub {
3046 my ($volid, $is_cdrom) = @_;
3048 return if $volid =~ m
|^/|;
3050 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
3053 push @$vollist, $volid;
3059 sub vm_stop_cleanup
{
3060 my ($storecfg, $vmid, $conf, $keepActive) = @_;
3063 fairsched_rmnod
($vmid); # try to destroy group
3066 my $vollist = get_vm_volumes
($conf);
3067 PVE
::Storage
::deactivate_volumes
($storecfg, $vollist);
3070 foreach my $ext (qw(mon qmp pid vnc qga)) {
3071 unlink "/var/run/qemu-server/${vmid}.$ext";
3074 warn $@ if $@; # avoid errors - just warn
3077 # Note: use $nockeck to skip tests if VM configuration file exists.
3078 # We need that when migration VMs to other nodes (files already moved)
3079 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3081 my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3083 $force = 1 if !defined($force) && !$shutdown;
3086 my $pid = check_running
($vmid, $nocheck, $migratedfrom);
3087 kill 15, $pid if $pid;
3088 my $conf = load_config
($vmid, $migratedfrom);
3089 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive);
3093 lock_config
($vmid, sub {
3095 my $pid = check_running
($vmid, $nocheck);
3100 $conf = load_config
($vmid);
3101 check_lock
($conf) if !$skiplock;
3102 if (!defined($timeout) && $shutdown && $conf->{startup
}) {
3103 my $opts = parse_startup
($conf->{startup
});
3104 $timeout = $opts->{down
} if $opts->{down
};
3108 $timeout = 60 if !defined($timeout);
3112 $nocheck ? vm_mon_cmd_nocheck
($vmid, "system_powerdown") : vm_mon_cmd
($vmid, "system_powerdown");
3115 $nocheck ? vm_mon_cmd_nocheck
($vmid, "quit") : vm_mon_cmd
($vmid, "quit");
3122 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
3127 if ($count >= $timeout) {
3129 warn "VM still running - terminating now with SIGTERM\n";
3132 die "VM quit/powerdown failed - got timeout\n";
3135 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
3140 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3143 die "VM quit/powerdown failed\n";
3151 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
3156 if ($count >= $timeout) {
3157 warn "VM still running - terminating now with SIGKILL\n";
3162 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
3167 my ($vmid, $skiplock) = @_;
3169 lock_config
($vmid, sub {
3171 my $conf = load_config
($vmid);
3173 check_lock
($conf) if !$skiplock;
3175 vm_mon_cmd
($vmid, "stop");
3180 my ($vmid, $skiplock) = @_;
3182 lock_config
($vmid, sub {
3184 my $conf = load_config
($vmid);
3186 check_lock
($conf) if !$skiplock;
3188 vm_mon_cmd
($vmid, "cont");
3193 my ($vmid, $skiplock, $key) = @_;
3195 lock_config
($vmid, sub {
3197 my $conf = load_config
($vmid);
3199 # there is no qmp command, so we use the human monitor command
3200 vm_human_monitor_command
($vmid, "sendkey $key");
3205 my ($storecfg, $vmid, $skiplock) = @_;
3207 lock_config
($vmid, sub {
3209 my $conf = load_config
($vmid);
3211 check_lock
($conf) if !$skiplock;
3213 if (!check_running
($vmid)) {
3214 fairsched_rmnod
($vmid); # try to destroy group
3215 destroy_vm
($storecfg, $vmid);
3217 die "VM $vmid is running - destroy failed\n";
3225 my ($filename, $buf) = @_;
3227 my $fh = IO
::File-
>new($filename, "w");
3228 return undef if !$fh;
3230 my $res = print $fh $buf;
3237 sub pci_device_info
{
3242 return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3243 my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3245 my $irq = file_read_firstline
("$pcisysfs/devices/$name/irq");
3246 return undef if !defined($irq) || $irq !~ m/^\d+$/;
3248 my $vendor = file_read_firstline
("$pcisysfs/devices/$name/vendor");
3249 return undef if !defined($vendor) || $vendor !~ s/^0x//;
3251 my $product = file_read_firstline
("$pcisysfs/devices/$name/device");
3252 return undef if !defined($product) || $product !~ s/^0x//;
3257 product
=> $product,
3263 has_fl_reset
=> -f
"$pcisysfs/devices/$name/reset" || 0,
3272 my $name = $dev->{name
};
3274 my $fn = "$pcisysfs/devices/$name/reset";
3276 return file_write
($fn, "1");
3279 sub pci_dev_bind_to_stub
{
3282 my $name = $dev->{name
};
3284 my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3285 return 1 if -d
$testdir;
3287 my $data = "$dev->{vendor} $dev->{product}";
3288 return undef if !file_write
("$pcisysfs/drivers/pci-stub/new_id", $data);
3290 my $fn = "$pcisysfs/devices/$name/driver/unbind";
3291 if (!file_write
($fn, $name)) {
3292 return undef if -f
$fn;
3295 $fn = "$pcisysfs/drivers/pci-stub/bind";
3296 if (! -d
$testdir) {
3297 return undef if !file_write
($fn, $name);
3303 sub print_pci_addr
{
3304 my ($id, $bridges) = @_;
3308 #addr1 : ide,parallel,serial (motherboard)
3309 #addr2 : first videocard
3310 balloon0
=> { bus
=> 0, addr
=> 3 },
3311 watchdog
=> { bus
=> 0, addr
=> 4 },
3312 scsihw0
=> { bus
=> 0, addr
=> 5 },
3313 scsihw1
=> { bus
=> 0, addr
=> 6 },
3314 ahci0
=> { bus
=> 0, addr
=> 7 },
3315 qga0
=> { bus
=> 0, addr
=> 8 },
3316 virtio0
=> { bus
=> 0, addr
=> 10 },
3317 virtio1
=> { bus
=> 0, addr
=> 11 },
3318 virtio2
=> { bus
=> 0, addr
=> 12 },
3319 virtio3
=> { bus
=> 0, addr
=> 13 },
3320 virtio4
=> { bus
=> 0, addr
=> 14 },
3321 virtio5
=> { bus
=> 0, addr
=> 15 },
3322 hostpci0
=> { bus
=> 0, addr
=> 16 },
3323 hostpci1
=> { bus
=> 0, addr
=> 17 },
3324 net0
=> { bus
=> 0, addr
=> 18 },
3325 net1
=> { bus
=> 0, addr
=> 19 },
3326 net2
=> { bus
=> 0, addr
=> 20 },
3327 net3
=> { bus
=> 0, addr
=> 21 },
3328 net4
=> { bus
=> 0, addr
=> 22 },
3329 net5
=> { bus
=> 0, addr
=> 23 },
3330 #addr29 : usb-host (pve-usb.cfg)
3331 'pci.1' => { bus
=> 0, addr
=> 30 },
3332 'pci.2' => { bus
=> 0, addr
=> 31 },
3333 'net6' => { bus
=> 1, addr
=> 1 },
3334 'net7' => { bus
=> 1, addr
=> 2 },
3335 'net8' => { bus
=> 1, addr
=> 3 },
3336 'net9' => { bus
=> 1, addr
=> 4 },
3337 'net10' => { bus
=> 1, addr
=> 5 },
3338 'net11' => { bus
=> 1, addr
=> 6 },
3339 'net12' => { bus
=> 1, addr
=> 7 },
3340 'net13' => { bus
=> 1, addr
=> 8 },
3341 'net14' => { bus
=> 1, addr
=> 9 },
3342 'net15' => { bus
=> 1, addr
=> 10 },
3343 'net16' => { bus
=> 1, addr
=> 11 },
3344 'net17' => { bus
=> 1, addr
=> 12 },
3345 'net18' => { bus
=> 1, addr
=> 13 },
3346 'net19' => { bus
=> 1, addr
=> 14 },
3347 'net20' => { bus
=> 1, addr
=> 15 },
3348 'net21' => { bus
=> 1, addr
=> 16 },
3349 'net22' => { bus
=> 1, addr
=> 17 },
3350 'net23' => { bus
=> 1, addr
=> 18 },
3351 'net24' => { bus
=> 1, addr
=> 19 },
3352 'net25' => { bus
=> 1, addr
=> 20 },
3353 'net26' => { bus
=> 1, addr
=> 21 },
3354 'net27' => { bus
=> 1, addr
=> 22 },
3355 'net28' => { bus
=> 1, addr
=> 23 },
3356 'net29' => { bus
=> 1, addr
=> 24 },
3357 'net30' => { bus
=> 1, addr
=> 25 },
3358 'net31' => { bus
=> 1, addr
=> 26 },
3359 'virtio6' => { bus
=> 2, addr
=> 1 },
3360 'virtio7' => { bus
=> 2, addr
=> 2 },
3361 'virtio8' => { bus
=> 2, addr
=> 3 },
3362 'virtio9' => { bus
=> 2, addr
=> 4 },
3363 'virtio10' => { bus
=> 2, addr
=> 5 },
3364 'virtio11' => { bus
=> 2, addr
=> 6 },
3365 'virtio12' => { bus
=> 2, addr
=> 7 },
3366 'virtio13' => { bus
=> 2, addr
=> 8 },
3367 'virtio14' => { bus
=> 2, addr
=> 9 },
3368 'virtio15' => { bus
=> 2, addr
=> 10 },
3371 if (defined($devices->{$id}->{bus
}) && defined($devices->{$id}->{addr
})) {
3372 my $addr = sprintf("0x%x", $devices->{$id}->{addr
});
3373 my $bus = $devices->{$id}->{bus
};
3374 $res = ",bus=pci.$bus,addr=$addr";
3375 $bridges->{$bus} = 1 if $bridges;
3382 my ($vmid, $value) = @_;
3384 vm_mon_cmd
($vmid, "balloon", value
=> $value);
3387 # vzdump restore implementaion
3389 sub archive_read_firstfile
{
3390 my $archive = shift;
3392 die "ERROR: file '$archive' does not exist\n" if ! -f
$archive;
3394 # try to detect archive type first
3395 my $pid = open (TMP
, "tar tf '$archive'|") ||
3396 die "unable to open file '$archive'\n";
3397 my $firstfile = <TMP
>;
3401 die "ERROR: archive contaions no data\n" if !$firstfile;
3407 sub restore_cleanup
{
3408 my $statfile = shift;
3410 print STDERR
"starting cleanup\n";
3412 if (my $fd = IO
::File-
>new($statfile, "r")) {
3413 while (defined(my $line = <$fd>)) {
3414 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3417 if ($volid =~ m
|^/|) {
3418 unlink $volid || die 'unlink failed\n';
3420 my $cfg = cfs_read_file
('storage.cfg');
3421 PVE
::Storage
::vdisk_free
($cfg, $volid);
3423 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
3425 print STDERR
"unable to cleanup '$volid' - $@" if $@;
3427 print STDERR
"unable to parse line in statfile - $line";
3434 sub restore_archive
{
3435 my ($archive, $vmid, $user, $opts) = @_;
3437 if ($archive ne '-') {
3438 my $firstfile = archive_read_firstfile
($archive);
3439 die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
3440 if $firstfile ne 'qemu-server.conf';
3443 my $tocmd = "/usr/lib/qemu-server/qmextract";
3445 $tocmd .= " --storage " . PVE
::Tools
::shellquote
($opts->{storage
}) if $opts->{storage
};
3446 $tocmd .= " --pool " . PVE
::Tools
::shellquote
($opts->{pool
}) if $opts->{pool
};
3447 $tocmd .= ' --prealloc' if $opts->{prealloc
};
3448 $tocmd .= ' --info' if $opts->{info
};
3450 # tar option "xf" does not autodetect compression when read from STDIN,
3451 # so we pipe to zcat
3452 my $cmd = "zcat -f|tar xf " . PVE
::Tools
::shellquote
($archive) . " " .
3453 PVE
::Tools
::shellquote
("--to-command=$tocmd");
3455 my $tmpdir = "/var/tmp/vzdumptmp$$";
3458 local $ENV{VZDUMP_TMPDIR
} = $tmpdir;
3459 local $ENV{VZDUMP_VMID
} = $vmid;
3460 local $ENV{VZDUMP_USER
} = $user;
3462 my $conffile = PVE
::QemuServer
::config_file
($vmid);
3463 my $tmpfn = "$conffile.$$.tmp";
3465 # disable interrupts (always do cleanups)
3466 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
3467 print STDERR
"got interrupt - ignored\n";
3472 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
3473 die "interrupted by signal\n";
3476 if ($archive eq '-') {
3477 print "extracting archive from STDIN\n";
3478 run_command
($cmd, input
=> "<&STDIN");
3480 print "extracting archive '$archive'\n";
3484 return if $opts->{info
};
3488 my $statfile = "$tmpdir/qmrestore.stat";
3489 if (my $fd = IO
::File-
>new($statfile, "r")) {
3490 while (defined (my $line = <$fd>)) {
3491 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3492 $map->{$1} = $2 if $1;
3494 print STDERR
"unable to parse line in statfile - $line\n";
3500 my $confsrc = "$tmpdir/qemu-server.conf";
3502 my $srcfd = new IO
::File
($confsrc, "r") ||
3503 die "unable to open file '$confsrc'\n";
3505 my $outfd = new IO
::File
($tmpfn, "w") ||
3506 die "unable to write config for VM $vmid\n";
3510 while (defined (my $line = <$srcfd>)) {
3511 next if $line =~ m/^\#vzdump\#/;
3512 next if $line =~ m/^lock:/;
3513 next if $line =~ m/^unused\d+:/;
3515 if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3516 # try to convert old 1.X settings
3517 my ($id, $ind, $ethcfg) = ($1, $2, $3);
3518 foreach my $devconfig (PVE
::Tools
::split_list
($ethcfg)) {
3519 my ($model, $macaddr) = split(/\=/, $devconfig);
3520 $macaddr = PVE
::Tools
::random_ether_addr
() if !$macaddr || $opts->{unique
};
3523 bridge
=> "vmbr$ind",
3524 macaddr
=> $macaddr,
3526 my $netstr = print_net
($net);
3527 print $outfd "net${netcount}: $netstr\n";
3530 } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && ($opts->{unique
})) {
3531 my ($id, $netstr) = ($1, $2);
3532 my $net = parse_net
($netstr);
3533 $net->{macaddr
} = PVE
::Tools
::random_ether_addr
() if $net->{macaddr
};
3534 $netstr = print_net
($net);
3535 print $outfd "$id: $netstr\n";
3536 } elsif ($line =~ m/^((ide|scsi|virtio)\d+):\s*(\S+)\s*$/) {
3539 if ($line =~ m/backup=no/) {
3540 print $outfd "#$line";
3541 } elsif ($virtdev && $map->{$virtdev}) {
3542 my $di = PVE
::QemuServer
::parse_drive
($virtdev, $value);
3543 $di->{file
} = $map->{$virtdev};
3544 $value = PVE
::QemuServer
::print_drive
($vmid, $di);
3545 print $outfd "$virtdev: $value\n";
3563 restore_cleanup
("$tmpdir/qmrestore.stat") if !$opts->{info
};
3570 rename $tmpfn, $conffile ||
3571 die "unable to commit configuration file '$conffile'\n";
3575 # Internal snapshots
3577 # NOTE: Snapshot create/delete involves several non-atomic
3578 # action, and can take a long time.
3579 # So we try to avoid locking the file and use 'lock' variable
3580 # inside the config file instead.
3582 my $snapshot_copy_config = sub {
3583 my ($source, $dest) = @_;
3585 foreach my $k (keys %$source) {
3586 next if $k eq 'snapshots';
3587 next if $k eq 'snapstate';
3588 next if $k eq 'snaptime';
3589 next if $k eq 'vmstate';
3590 next if $k eq 'lock';
3591 next if $k eq 'digest';
3592 next if $k eq 'description';
3593 next if $k =~ m/^unused\d+$/;
3595 $dest->{$k} = $source->{$k};
3599 my $snapshot_apply_config = sub {
3600 my ($conf, $snap) = @_;
3602 # copy snapshot list
3604 snapshots
=> $conf->{snapshots
},
3607 # keep description and list of unused disks
3608 foreach my $k (keys %$conf) {
3609 next if !($k =~ m/^unused\d+$/ || $k eq 'description');
3610 $newconf->{$k} = $conf->{$k};
3613 &$snapshot_copy_config($snap, $newconf);
3618 sub foreach_writable_storage
{
3619 my ($conf, $func) = @_;
3623 foreach my $ds (keys %$conf) {
3624 next if !valid_drivename
($ds);
3626 my $drive = parse_drive
($ds, $conf->{$ds});
3628 next if drive_is_cdrom
($drive);
3630 my $volid = $drive->{file
};
3632 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
3633 $sidhash->{$sid} = $sid if $sid;
3636 foreach my $sid (sort keys %$sidhash) {
3641 my $alloc_vmstate_volid = sub {
3642 my ($storecfg, $vmid, $conf, $snapname) = @_;
3644 # Note: we try to be smart when selecting a $target storage
3648 # search shared storage first
3649 foreach_writable_storage
($conf, sub {
3651 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
3652 return if !$scfg->{shared
};
3654 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage
3658 # now search local storage
3659 foreach_writable_storage
($conf, sub {
3661 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
3662 return if $scfg->{shared
};
3664 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage;
3668 $target = 'local' if !$target;
3670 my $driver_state_size = 32; # assume 32MB is enough to safe all driver state;
3671 my $size = $conf->{memory
} + $driver_state_size;
3673 my $name = "vm-$vmid-state-$snapname";
3674 my $scfg = PVE
::Storage
::storage_config
($storecfg, $target);
3675 $name .= ".raw" if $scfg->{path
}; # add filename extension for file base storage
3676 my $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $target, $vmid, 'raw', $name, $size*1024);
3681 my $snapshot_prepare = sub {
3682 my ($vmid, $snapname, $save_vmstate, $comment) = @_;
3686 my $updatefn = sub {
3688 my $conf = load_config
($vmid);
3692 $conf->{lock} = 'snapshot';
3694 die "snapshot name '$snapname' already used\n"
3695 if defined($conf->{snapshots
}->{$snapname});
3697 my $storecfg = PVE
::Storage
::config
();
3699 foreach_drive
($conf, sub {
3700 my ($ds, $drive) = @_;
3702 return if drive_is_cdrom
($drive);
3703 my $volid = $drive->{file
};
3705 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
3707 my $scfg = PVE
::Storage
::storage_config
($storecfg, $storeid);
3708 die "can't snapshot volume '$volid'\n"
3709 if !(($scfg->{path
} && $volname =~ m/\.qcow2$/) ||
3710 ($scfg->{type
} eq 'nexenta') ||
3711 ($scfg->{type
} eq 'rbd') ||
3712 ($scfg->{type
} eq 'sheepdog'));
3713 } elsif ($volid =~ m
|^(/.+)$| && -e
$volid) {
3714 die "snapshot device '$volid' is not possible\n";
3716 die "can't snapshot volume '$volid'\n";
3721 $snap = $conf->{snapshots
}->{$snapname} = {};
3723 if ($save_vmstate && check_running
($vmid)) {
3724 $snap->{vmstate
} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
3727 &$snapshot_copy_config($conf, $snap);
3729 $snap->{snapstate
} = "prepare";
3730 $snap->{snaptime
} = time();
3731 $snap->{description
} = $comment if $comment;
3733 update_config_nolock
($vmid, $conf, 1);
3736 lock_config
($vmid, $updatefn);
3741 my $snapshot_commit = sub {
3742 my ($vmid, $snapname) = @_;
3744 my $updatefn = sub {
3746 my $conf = load_config
($vmid);
3748 die "missing snapshot lock\n"
3749 if !($conf->{lock} && $conf->{lock} eq 'snapshot');
3751 my $snap = $conf->{snapshots
}->{$snapname};
3753 die "snapshot '$snapname' does not exist\n" if !defined($snap);
3755 die "wrong snapshot state\n"
3756 if !($snap->{snapstate
} && $snap->{snapstate
} eq "prepare");
3758 delete $snap->{snapstate
};
3759 delete $conf->{lock};
3761 my $newconf = &$snapshot_apply_config($conf, $snap);
3763 $newconf->{parent
} = $snapname;
3765 update_config_nolock
($vmid, $newconf, 1);
3768 lock_config
($vmid, $updatefn);
3771 sub snapshot_rollback
{
3772 my ($vmid, $snapname) = @_;
3778 my $storecfg = PVE
::Storage
::config
();
3780 my $updatefn = sub {
3782 my $conf = load_config
($vmid);
3784 $snap = $conf->{snapshots
}->{$snapname};
3786 die "snapshot '$snapname' does not exist\n" if !defined($snap);
3788 die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
3789 if $snap->{snapstate
};
3793 vm_stop
($storecfg, $vmid, undef, undef, 5, undef, undef);
3796 die "unable to rollback vm $vmid: vm is running\n"
3797 if check_running
($vmid);
3800 $conf->{lock} = 'rollback';
3802 die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
3803 delete $conf->{lock};
3807 # copy snapshot config to current config
3808 $conf = &$snapshot_apply_config($conf, $snap);
3809 $conf->{parent
} = $snapname;
3812 update_config_nolock
($vmid, $conf, 1);
3814 if (!$prepare && $snap->{vmstate
}) {
3815 my $statefile = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
3816 # fixme: this only forws for files currently
3817 vm_start
($storecfg, $vmid, $statefile);
3822 lock_config
($vmid, $updatefn);
3824 foreach_drive
($snap, sub {
3825 my ($ds, $drive) = @_;
3827 return if drive_is_cdrom
($drive);
3829 my $volid = $drive->{file
};
3830 my $device = "drive-$ds";
3832 PVE
::Storage
::volume_snapshot_rollback
($storecfg, $volid, $snapname);
3836 lock_config
($vmid, $updatefn);
3839 my $savevm_wait = sub {
3843 my $stat = PVE
::QemuServer
::vm_mon_cmd_nocheck
($vmid, "query-savevm");
3844 if (!$stat->{status
}) {
3845 die "savevm not active\n";
3846 } elsif ($stat->{status
} eq 'active') {
3849 } elsif ($stat->{status
} eq 'completed') {
3852 die "query-savevm returned status '$stat->{status}'\n";
3857 sub snapshot_create
{
3858 my ($vmid, $snapname, $save_vmstate, $freezefs, $comment) = @_;
3860 my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
3862 $freezefs = $save_vmstate = 0 if !$snap->{vmstate
}; # vm is not running
3866 my $running = check_running
($vmid);
3869 # create internal snapshots of all drives
3871 my $storecfg = PVE
::Storage
::config
();
3874 if ($snap->{vmstate
}) {
3875 my $path = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
3876 vm_mon_cmd
($vmid, "savevm-start", statefile
=> $path);
3877 &$savevm_wait($vmid);
3879 vm_mon_cmd
($vmid, "savevm-start");
3883 qga_freezefs
($vmid) if $running && $freezefs;
3885 foreach_drive
($snap, sub {
3886 my ($ds, $drive) = @_;
3888 return if drive_is_cdrom
($drive);
3890 my $volid = $drive->{file
};
3891 my $device = "drive-$ds";
3893 qemu_volume_snapshot
($vmid, $device, $storecfg, $volid, $snapname);
3894 $drivehash->{$ds} = 1;
3899 eval { gqa_unfreezefs
($vmid) if $running && $freezefs; };
3902 eval { vm_mon_cmd
($vmid, "savevm-end") if $running; };
3906 warn "snapshot create failed: starting cleanup\n";
3907 eval { snapshot_delete
($vmid, $snapname, 0, $drivehash); };
3912 &$snapshot_commit($vmid, $snapname);
3915 # Note: $drivehash is only set when called from snapshot_create.
3916 sub snapshot_delete
{
3917 my ($vmid, $snapname, $force, $drivehash) = @_;
3924 my $unlink_parent = sub {
3925 my ($confref, $new_parent) = @_;
3927 if ($confref->{parent
} && $confref->{parent
} eq $snapname) {
3929 $confref->{parent
} = $new_parent;
3931 delete $confref->{parent
};
3936 my $updatefn = sub {
3937 my ($remove_drive) = @_;
3939 my $conf = load_config
($vmid);
3941 check_lock
($conf) if !$drivehash;
3943 $snap = $conf->{snapshots
}->{$snapname};
3945 die "snapshot '$snapname' does not exist\n" if !defined($snap);
3947 # remove parent refs
3948 &$unlink_parent($conf, $snap->{parent
});
3949 foreach my $sn (keys %{$conf->{snapshots
}}) {
3950 next if $sn eq $snapname;
3951 &$unlink_parent($conf->{snapshots
}->{$sn}, $snap->{parent
});
3954 if ($remove_drive) {
3955 if ($remove_drive eq 'vmstate') {
3956 delete $snap->{$remove_drive};
3958 my $drive = parse_drive
($remove_drive, $snap->{$remove_drive});
3959 my $volid = $drive->{file
};
3960 delete $snap->{$remove_drive};
3961 add_unused_volume
($conf, $volid);
3966 $snap->{snapstate
} = 'delete';
3968 delete $conf->{snapshots
}->{$snapname};
3969 delete $conf->{lock} if $drivehash;
3970 foreach my $volid (@$unused) {
3971 add_unused_volume
($conf, $volid);
3975 update_config_nolock
($vmid, $conf, 1);
3978 lock_config
($vmid, $updatefn);
3980 # now remove vmstate file
3982 my $storecfg = PVE
::Storage
::config
();
3984 if ($snap->{vmstate
}) {
3985 eval { PVE
::Storage
::vdisk_free
($storecfg, $snap->{vmstate
}); };
3987 die $err if !$force;
3990 # save changes (remove vmstate from snapshot)
3991 lock_config
($vmid, $updatefn, 'vmstate') if !$force;
3994 # now remove all internal snapshots
3995 foreach_drive
($snap, sub {
3996 my ($ds, $drive) = @_;
3998 return if drive_is_cdrom
($drive);
4000 my $volid = $drive->{file
};
4001 my $device = "drive-$ds";
4003 if (!$drivehash || $drivehash->{$ds}) {
4004 eval { qemu_volume_snapshot_delete
($vmid, $device, $storecfg, $volid, $snapname); };
4006 die $err if !$force;
4011 # save changes (remove drive fron snapshot)
4012 lock_config
($vmid, $updatefn, $ds) if !$force;
4013 push @$unused, $volid;
4016 # now cleanup config
4018 lock_config
($vmid, $updatefn);