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);
2085 sub config_to_command
{
2086 my ($storecfg, $vmid, $conf, $defaults) = @_;
2092 my $kvmver = kvm_user_version
();
2093 my $vernum = 0; # unknown
2094 if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
2095 $vernum = $1*1000000+$2*1000;
2096 } elsif ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
2097 $vernum = $1*1000000+$2*1000+$3;
2100 die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 15000;
2102 my $have_ovz = -f
'/proc/vz/vestat';
2104 push @$cmd, '/usr/bin/kvm';
2106 push @$cmd, '-id', $vmid;
2110 my $qmpsocket = qmp_socket
($vmid);
2111 push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
2112 push @$cmd, '-mon', "chardev=qmp,mode=control";
2114 my $socket = vnc_socket
($vmid);
2115 push @$cmd, '-vnc', "unix:$socket,x509,password";
2117 push @$cmd, '-pidfile' , pidfile_name
($vmid);
2119 push @$cmd, '-daemonize';
2122 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2123 next if !$conf->{"usb$i"};
2126 # include usb device config
2127 push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
2129 # enable absolute mouse coordinates (needed by vnc)
2130 my $tablet = defined($conf->{tablet
}) ?
$conf->{tablet
} : $defaults->{tablet
};
2133 push @$devices, '-device', 'usb-tablet,bus=ehci.0,port=6';
2135 push @$devices, '-usbdevice', 'tablet';
2140 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
2141 my $d = parse_hostpci
($conf->{"hostpci$i"});
2143 $pciaddr = print_pci_addr
("hostpci$i", $bridges);
2144 push @$devices, '-device', "pci-assign,host=$d->{pciid},id=hostpci$i$pciaddr";
2148 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2149 my $d = parse_usb_device
($conf->{"usb$i"});
2151 if ($d->{vendorid
} && $d->{productid
}) {
2152 push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2153 } elsif (defined($d->{hostbus
}) && defined($d->{hostport
})) {
2154 push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2159 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
2160 if (my $path = $conf->{"serial$i"}) {
2161 die "no such serial device\n" if ! -c
$path;
2162 push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2163 push @$devices, '-device', "isa-serial,chardev=serial$i";
2168 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
2169 if (my $path = $conf->{"parallel$i"}) {
2170 die "no such parallel device\n" if ! -c
$path;
2171 push @$devices, '-chardev', "parport,id=parallel$i,path=$path";
2172 push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2176 my $vmname = $conf->{name
} || "vm$vmid";
2178 push @$cmd, '-name', $vmname;
2181 $sockets = $conf->{smp
} if $conf->{smp
}; # old style - no longer iused
2182 $sockets = $conf->{sockets
} if $conf->{sockets
};
2184 my $cores = $conf->{cores
} || 1;
2186 push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2188 push @$cmd, '-cpu', $conf->{cpu
} if $conf->{cpu
};
2190 push @$cmd, '-nodefaults';
2192 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
2194 my $bootindex_hash = {};
2196 foreach my $o (split(//, $bootorder)) {
2197 $bootindex_hash->{$o} = $i*100;
2201 push @$cmd, '-boot', "menu=on";
2203 push @$cmd, '-no-acpi' if defined($conf->{acpi
}) && $conf->{acpi
} == 0;
2205 push @$cmd, '-no-reboot' if defined($conf->{reboot
}) && $conf->{reboot
} == 0;
2207 my $vga = $conf->{vga
};
2209 if ($conf->{ostype
} && ($conf->{ostype
} eq 'win7' || $conf->{ostype
} eq 'w2k8')) {
2216 push @$cmd, '-vga', $vga if $vga; # for kvm 77 and later
2219 my $tdf = defined($conf->{tdf
}) ?
$conf->{tdf
} : $defaults->{tdf
};
2220 # ignore - no longer supported by newer kvm
2221 # push @$cmd, '-tdf' if $tdf;
2223 my $nokvm = defined($conf->{kvm
}) && $conf->{kvm
} == 0 ?
1 : 0;
2225 if (my $ost = $conf->{ostype
}) {
2226 # other, wxp, w2k, w2k3, w2k8, wvista, win7, l24, l26
2228 if ($ost =~ m/^w/) { # windows
2229 push @$cmd, '-localtime' if !defined($conf->{localtime});
2231 # use rtc-td-hack when acpi is enabled
2232 if (!(defined($conf->{acpi
}) && $conf->{acpi
} == 0)) {
2233 push @$cmd, '-rtc-td-hack';
2237 if ($ost eq 'win7' || $ost eq 'w2k8' || $ost eq 'wvista') {
2238 push @$cmd, '-no-kvm-pit-reinjection';
2239 push @$cmd, '-no-hpet';
2249 push @$cmd, '-no-kvm';
2251 die "No accelerator found!\n" if !$cpuinfo->{hvm
};
2254 push @$cmd, '-localtime' if $conf->{localtime};
2256 push @$cmd, '-startdate', $conf->{startdate
} if $conf->{startdate
};
2258 push @$cmd, '-S' if $conf->{freeze
};
2260 # set keyboard layout
2261 my $kb = $conf->{keyboard
} || $defaults->{keyboard
};
2262 push @$cmd, '-k', $kb if $kb;
2265 #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2266 #push @$cmd, '-soundhw', 'es1370';
2267 #push @$cmd, '-soundhw', $soundhw if $soundhw;
2269 if($conf->{agent
}) {
2270 my $qgasocket = qga_socket
($vmid);
2271 my $pciaddr = print_pci_addr
("qga0", $bridges);
2272 push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
2273 push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
2274 push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
2277 $pciaddr = print_pci_addr
("balloon0", $bridges);
2278 push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr" if $conf->{balloon
};
2280 if ($conf->{watchdog
}) {
2281 my $wdopts = parse_watchdog
($conf->{watchdog
});
2282 $pciaddr = print_pci_addr
("watchdog", $bridges);
2283 my $watchdog = $wdopts->{model
} || 'i6300esb';
2284 push @$devices, '-device', "$watchdog$pciaddr";
2285 push @$devices, '-watchdog-action', $wdopts->{action
} if $wdopts->{action
};
2289 my $scsicontroller = {};
2290 my $ahcicontroller = {};
2291 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : $defaults->{scsihw
};
2293 foreach_drive
($conf, sub {
2294 my ($ds, $drive) = @_;
2296 if (PVE
::Storage
::parse_volume_id
($drive->{file
}, 1)) {
2297 push @$vollist, $drive->{file
};
2300 $use_virtio = 1 if $ds =~ m/^virtio/;
2302 if (drive_is_cdrom
($drive)) {
2303 if ($bootindex_hash->{d
}) {
2304 $drive->{bootindex
} = $bootindex_hash->{d
};
2305 $bootindex_hash->{d
} += 1;
2308 if ($bootindex_hash->{c
}) {
2309 $drive->{bootindex
} = $bootindex_hash->{c
} if $conf->{bootdisk
} && ($conf->{bootdisk
} eq $ds);
2310 $bootindex_hash->{c
} += 1;
2314 if ($drive->{interface
} eq 'scsi') {
2316 my $maxdev = ($scsihw ne 'lsi') ?
256 : 7;
2317 my $controller = int($drive->{index} / $maxdev);
2318 $pciaddr = print_pci_addr
("scsihw$controller", $bridges);
2319 push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
2320 $scsicontroller->{$controller}=1;
2323 if ($drive->{interface
} eq 'sata') {
2324 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
2325 $pciaddr = print_pci_addr
("ahci$controller", $bridges);
2326 push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
2327 $ahcicontroller->{$controller}=1;
2330 push @$devices, '-drive',print_drive_full
($storecfg, $vmid, $drive);
2331 push @$devices, '-device',print_drivedevice_full
($storecfg, $conf, $vmid, $drive, $bridges);
2334 push @$cmd, '-m', $conf->{memory
} || $defaults->{memory
};
2336 for (my $i = 0; $i < $MAX_NETS; $i++) {
2337 next if !$conf->{"net$i"};
2338 my $d = parse_net
($conf->{"net$i"});
2341 $use_virtio = 1 if $d->{model
} eq 'virtio';
2343 if ($bootindex_hash->{n
}) {
2344 $d->{bootindex
} = $bootindex_hash->{n
};
2345 $bootindex_hash->{n
} += 1;
2348 my $netdevfull = print_netdev_full
($vmid,$conf,$d,"net$i");
2349 push @$devices, '-netdev', $netdevfull;
2351 my $netdevicefull = print_netdevice_full
($vmid,$conf,$d,"net$i",$bridges);
2352 push @$devices, '-device', $netdevicefull;
2356 while (my ($k, $v) = each %$bridges) {
2357 $pciaddr = print_pci_addr
("pci.$k");
2358 unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
2362 # hack: virtio with fairsched is unreliable, so we do not use fairsched
2363 # when the VM uses virtio devices.
2364 if (!$use_virtio && $have_ovz) {
2366 my $cpuunits = defined($conf->{cpuunits
}) ?
2367 $conf->{cpuunits
} : $defaults->{cpuunits
};
2369 push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
2371 # fixme: cpulimit is currently ignored
2372 #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2376 if ($conf->{args
}) {
2377 my $aa = PVE
::Tools
::split_args
($conf->{args
});
2381 push @$cmd, @$devices;
2382 return wantarray ?
($cmd, $vollist) : $cmd;
2387 return "${var_run_tmpdir}/$vmid.vnc";
2392 return "${var_run_tmpdir}/$vmid.qmp";
2397 return "${var_run_tmpdir}/$vmid.qga";
2402 return "${var_run_tmpdir}/$vmid.pid";
2405 sub next_migrate_port
{
2407 for (my $p = 60000; $p < 60010; $p++) {
2409 my $sock = IO
::Socket
::INET-
>new(Listen
=> 5,
2410 LocalAddr
=> 'localhost',
2421 die "unable to find free migration port";
2424 sub vm_devices_list
{
2427 my $res = vm_mon_cmd
($vmid, 'query-pci');
2430 foreach my $pcibus (@$res) {
2431 foreach my $device (@{$pcibus->{devices
}}) {
2432 next if !$device->{'qdev_id'};
2433 $devices->{$device->{'qdev_id'}} = $device;
2441 my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2443 return 1 if !check_running
($vmid) || !$conf->{hotplug
};
2445 my $devices_list = vm_devices_list
($vmid);
2446 return 1 if defined($devices_list->{$deviceid});
2448 qemu_bridgeadd
($storecfg, $conf, $vmid, $deviceid); #add bridge if we need it for the device
2450 if ($deviceid =~ m/^(virtio)(\d+)$/) {
2451 return undef if !qemu_driveadd
($storecfg, $vmid, $device);
2452 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
2453 qemu_deviceadd
($vmid, $devicefull);
2454 if(!qemu_deviceaddverify
($vmid, $deviceid)) {
2455 qemu_drivedel
($vmid, $deviceid);
2460 if ($deviceid =~ m/^(scsihw)(\d+)$/) {
2461 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : "lsi";
2462 my $pciaddr = print_pci_addr
($deviceid);
2463 my $devicefull = "$scsihw,id=$deviceid$pciaddr";
2464 qemu_deviceadd
($vmid, $devicefull);
2465 return undef if(!qemu_deviceaddverify
($vmid, $deviceid));
2468 if ($deviceid =~ m/^(scsi)(\d+)$/) {
2469 return 1 if ($conf->{scsihw
} && $conf->{scsihw
} ne 'lsi'); #virtio-scsi not yet support hotplug
2470 return undef if !qemu_findorcreatescsihw
($storecfg,$conf, $vmid, $device);
2471 return undef if !qemu_driveadd
($storecfg, $vmid, $device);
2472 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
2473 if(!qemu_deviceadd
($vmid, $devicefull)) {
2474 qemu_drivedel
($vmid, $deviceid);
2479 if ($deviceid =~ m/^(net)(\d+)$/) {
2480 return undef if !qemu_netdevadd
($vmid, $conf, $device, $deviceid);
2481 my $netdevicefull = print_netdevice_full
($vmid, $conf, $device, $deviceid);
2482 qemu_deviceadd
($vmid, $netdevicefull);
2483 if(!qemu_deviceaddverify
($vmid, $deviceid)) {
2484 qemu_netdevdel
($vmid, $deviceid);
2489 if ($deviceid =~ m/^(pci\.)(\d+)$/) {
2491 my $pciaddr = print_pci_addr
($deviceid);
2492 my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
2493 qemu_deviceadd
($vmid, $devicefull);
2494 return undef if !qemu_deviceaddverify
($vmid, $deviceid);
2500 sub vm_deviceunplug
{
2501 my ($vmid, $conf, $deviceid) = @_;
2503 return 1 if !check_running
($vmid) || !$conf->{hotplug
};
2505 my $devices_list = vm_devices_list
($vmid);
2506 return 1 if !defined($devices_list->{$deviceid});
2508 die "can't unplug bootdisk" if $conf->{bootdisk
} && $conf->{bootdisk
} eq $deviceid;
2510 if ($deviceid =~ m/^(virtio)(\d+)$/) {
2511 return undef if !qemu_drivedel
($vmid, $deviceid);
2512 qemu_devicedel
($vmid, $deviceid);
2513 return undef if !qemu_devicedelverify
($vmid, $deviceid);
2516 if ($deviceid =~ m/^(lsi)(\d+)$/) {
2517 return undef if !qemu_devicedel
($vmid, $deviceid);
2520 if ($deviceid =~ m/^(scsi)(\d+)$/) {
2521 return undef if !qemu_devicedel
($vmid, $deviceid);
2522 return undef if !qemu_drivedel
($vmid, $deviceid);
2525 if ($deviceid =~ m/^(net)(\d+)$/) {
2526 return undef if !qemu_netdevdel
($vmid, $deviceid);
2527 qemu_devicedel
($vmid, $deviceid);
2528 return undef if !qemu_devicedelverify
($vmid, $deviceid);
2534 sub qemu_deviceadd
{
2535 my ($vmid, $devicefull) = @_;
2537 my $ret = vm_human_monitor_command
($vmid, "device_add $devicefull");
2539 # Otherwise, if the command succeeds, no output is sent. So any non-empty string shows an error
2540 return 1 if $ret eq "";
2541 syslog
("err", "error on hotplug device : $ret");
2546 sub qemu_devicedel
{
2547 my($vmid, $deviceid) = @_;
2549 my $ret = vm_human_monitor_command
($vmid, "device_del $deviceid");
2551 return 1 if $ret eq "";
2552 syslog
("err", "detaching device $deviceid failed : $ret");
2557 my($storecfg, $vmid, $device) = @_;
2559 my $drive = print_drive_full
($storecfg, $vmid, $device);
2560 my $ret = vm_human_monitor_command
($vmid, "drive_add auto $drive");
2561 # If the command succeeds qemu prints: "OK"
2562 if ($ret !~ m/OK/s) {
2563 syslog
("err", "adding drive failed: $ret");
2570 my($vmid, $deviceid) = @_;
2572 my $ret = vm_human_monitor_command
($vmid, "drive_del drive-$deviceid");
2574 if ($ret =~ m/Device \'.*?\' not found/s) {
2575 # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2577 elsif ($ret ne "") {
2578 syslog
("err", "deleting drive $deviceid failed : $ret");
2584 sub qemu_deviceaddverify
{
2585 my ($vmid,$deviceid) = @_;
2587 for (my $i = 0; $i <= 5; $i++) {
2588 my $devices_list = vm_devices_list
($vmid);
2589 return 1 if defined($devices_list->{$deviceid});
2592 syslog
("err", "error on hotplug device $deviceid");
2597 sub qemu_devicedelverify
{
2598 my ($vmid,$deviceid) = @_;
2600 #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2601 for (my $i = 0; $i <= 5; $i++) {
2602 my $devices_list = vm_devices_list
($vmid);
2603 return 1 if !defined($devices_list->{$deviceid});
2606 syslog
("err", "error on hot-unplugging device $deviceid");
2610 sub qemu_findorcreatescsihw
{
2611 my ($storecfg, $conf, $vmid, $device) = @_;
2613 my $maxdev = ($conf->{scsihw
} && $conf->{scsihw
} ne 'lsi') ?
256 : 7;
2614 my $controller = int($device->{index} / $maxdev);
2615 my $scsihwid="scsihw$controller";
2616 my $devices_list = vm_devices_list
($vmid);
2618 if(!defined($devices_list->{$scsihwid})) {
2619 return undef if !vm_deviceplug
($storecfg, $conf, $vmid, $scsihwid);
2624 sub qemu_bridgeadd
{
2625 my ($storecfg, $conf, $vmid, $device) = @_;
2628 my $bridgeid = undef;
2629 print_pci_addr
($device, $bridges);
2631 while (my ($k, $v) = each %$bridges) {
2634 return if $bridgeid < 1;
2635 my $bridge = "pci.$bridgeid";
2636 my $devices_list = vm_devices_list
($vmid);
2638 if(!defined($devices_list->{$bridge})) {
2639 return undef if !vm_deviceplug
($storecfg, $conf, $vmid, $bridge);
2644 sub qemu_netdevadd
{
2645 my ($vmid, $conf, $device, $deviceid) = @_;
2647 my $netdev = print_netdev_full
($vmid, $conf, $device, $deviceid);
2648 my $ret = vm_human_monitor_command
($vmid, "netdev_add $netdev");
2651 #if the command succeeds, no output is sent. So any non-empty string shows an error
2652 return 1 if $ret eq "";
2653 syslog
("err", "adding netdev failed: $ret");
2657 sub qemu_netdevdel
{
2658 my ($vmid, $deviceid) = @_;
2660 my $ret = vm_human_monitor_command
($vmid, "netdev_del $deviceid");
2662 #if the command succeeds, no output is sent. So any non-empty string shows an error
2663 return 1 if $ret eq "";
2664 syslog
("err", "deleting netdev failed: $ret");
2668 sub qemu_block_set_io_throttle
{
2669 my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
2671 return if !check_running
($vmid) ;
2674 $bps_rd = 0 if !$bps_rd;
2675 $bps_wr = 0 if !$bps_wr;
2676 $iops = 0 if !$iops;
2677 $iops_rd = 0 if !$iops_rd;
2678 $iops_wr = 0 if !$iops_wr;
2680 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));
2684 # old code, only used to shutdown old VM after update
2686 my ($fh, $timeout) = @_;
2688 my $sel = new IO
::Select
;
2695 while (scalar (@ready = $sel->can_read($timeout))) {
2697 if ($count = $fh->sysread($buf, 8192)) {
2698 if ($buf =~ /^(.*)\(qemu\) $/s) {
2705 if (!defined($count)) {
2712 die "monitor read timeout\n" if !scalar(@ready);
2717 # old code, only used to shutdown old VM after update
2718 sub vm_monitor_command
{
2719 my ($vmid, $cmdstr, $nocheck) = @_;
2724 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
2726 my $sname = "${var_run_tmpdir}/$vmid.mon";
2728 my $sock = IO
::Socket
::UNIX-
>new( Peer
=> $sname ) ||
2729 die "unable to connect to VM $vmid socket - $!\n";
2733 # hack: migrate sometime blocks the monitor (when migrate_downtime
2735 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2736 $timeout = 60*60; # 1 hour
2740 my $data = __read_avail
($sock, $timeout);
2742 if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
2743 die "got unexpected qemu monitor banner\n";
2746 my $sel = new IO
::Select
;
2749 if (!scalar(my @ready = $sel->can_write($timeout))) {
2750 die "monitor write error - timeout";
2753 my $fullcmd = "$cmdstr\r";
2755 # syslog('info', "VM $vmid monitor command: $cmdstr");
2758 if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
2759 die "monitor write error - $!";
2762 return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
2766 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2767 $timeout = 60*60; # 1 hour
2768 } elsif ($cmdstr =~ m/^(eject|change)/) {
2769 $timeout = 60; # note: cdrom mount command is slow
2771 if ($res = __read_avail
($sock, $timeout)) {
2773 my @lines = split("\r?\n", $res);
2775 shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
2777 $res = join("\n", @lines);
2785 syslog
("err", "VM $vmid monitor command failed - $err");
2792 sub qemu_block_resize
{
2793 my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
2795 my $running = PVE
::QemuServer
::check_running
($vmid);
2797 return if !PVE
::Storage
::volume_resize
($storecfg, $volid, $size, $running);
2799 return if !$running;
2801 vm_mon_cmd
($vmid, "block_resize", device
=> $deviceid, size
=> int($size));
2805 sub qemu_volume_snapshot
{
2806 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
2808 my $running = PVE
::QemuServer
::check_running
($vmid);
2810 return if !PVE
::Storage
::volume_snapshot
($storecfg, $volid, $snap, $running);
2812 return if !$running;
2814 vm_mon_cmd
($vmid, "snapshot-drive", device
=> $deviceid, name
=> $snap);
2818 sub qemu_volume_snapshot_delete
{
2819 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
2821 my $running = PVE
::QemuServer
::check_running
($vmid);
2823 return if !PVE
::Storage
::volume_snapshot_delete
($storecfg, $volid, $snap, $running);
2825 return if !$running;
2827 vm_mon_cmd
($vmid, "delete-drive-snapshot", device
=> $deviceid, name
=> $snap);
2833 #need to impplement call to qemu-ga
2836 sub qga_unfreezefs
{
2839 #need to impplement call to qemu-ga
2843 my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom) = @_;
2845 lock_config
($vmid, sub {
2846 my $conf = load_config
($vmid, $migratedfrom);
2848 check_lock
($conf) if !$skiplock;
2850 die "VM $vmid already running\n" if check_running
($vmid, undef, $migratedfrom);
2852 my $defaults = load_defaults
();
2854 # set environment variable useful inside network script
2855 $ENV{PVE_MIGRATED_FROM
} = $migratedfrom if $migratedfrom;
2857 my ($cmd, $vollist) = config_to_command
($storecfg, $vmid, $conf, $defaults);
2859 my $migrate_port = 0;
2862 if ($statefile eq 'tcp') {
2863 $migrate_port = next_migrate_port
();
2864 my $migrate_uri = "tcp:localhost:${migrate_port}";
2865 push @$cmd, '-incoming', $migrate_uri;
2868 push @$cmd, '-loadstate', $statefile;
2873 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
2874 my $d = parse_hostpci
($conf->{"hostpci$i"});
2876 my $info = pci_device_info
("0000:$d->{pciid}");
2877 die "IOMMU not present\n" if !check_iommu_support
();
2878 die "no pci device info for device '$d->{pciid}'\n" if !$info;
2879 die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub
($info);
2880 die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset
($info);
2883 PVE
::Storage
::activate_volumes
($storecfg, $vollist);
2885 eval { run_command
($cmd, timeout
=> $statefile ?
undef : 30); };
2887 die "start failed: $err" if $err;
2889 print "migration listens on port $migrate_port\n" if $migrate_port;
2891 if ($statefile && $statefile ne 'tcp') {
2892 eval { vm_mon_cmd
($vmid, "cont"); };
2896 # always set migrate speed (overwrite kvm default of 32m)
2897 # we set a very hight default of 8192m which is basically unlimited
2898 my $migrate_speed = $defaults->{migrate_speed
} || 8192;
2899 $migrate_speed = $conf->{migrate_speed
} || $migrate_speed;
2900 $migrate_speed = $migrate_speed * 1048576;
2902 vm_mon_cmd
($vmid, "migrate_set_speed", value
=> $migrate_speed);
2905 my $migrate_downtime = $defaults->{migrate_downtime
};
2906 $migrate_downtime = $conf->{migrate_downtime
} if defined($conf->{migrate_downtime
});
2907 if (defined($migrate_downtime)) {
2908 eval { vm_mon_cmd
($vmid, "migrate_set_downtime", value
=> $migrate_downtime); };
2912 my $capabilities = {};
2913 $capabilities->{capability
} = "xbzrle";
2914 $capabilities->{state} = JSON
::true
;
2915 eval { PVE
::QemuServer
::vm_mon_cmd_nocheck
($vmid, "migrate-set-capabilities", capabilities
=> [$capabilities]); };
2918 vm_balloonset
($vmid, $conf->{balloon
}) if $conf->{balloon
};
2924 my ($vmid, $execute, %params) = @_;
2926 my $cmd = { execute
=> $execute, arguments
=> \
%params };
2927 vm_qmp_command
($vmid, $cmd);
2930 sub vm_mon_cmd_nocheck
{
2931 my ($vmid, $execute, %params) = @_;
2933 my $cmd = { execute
=> $execute, arguments
=> \
%params };
2934 vm_qmp_command
($vmid, $cmd, 1);
2937 sub vm_qmp_command
{
2938 my ($vmid, $cmd, $nocheck) = @_;
2943 if ($cmd->{arguments
} && $cmd->{arguments
}->{timeout
}) {
2944 $timeout = $cmd->{arguments
}->{timeout
};
2945 delete $cmd->{arguments
}->{timeout
};
2949 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
2950 my $sname = PVE
::QemuServer
::qmp_socket
($vmid);
2952 my $qmpclient = PVE
::QMPClient-
>new();
2954 $res = $qmpclient->cmd($vmid, $cmd, $timeout);
2955 } elsif (-e
"${var_run_tmpdir}/$vmid.mon") {
2956 die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
2957 if scalar(%{$cmd->{arguments
}});
2958 vm_monitor_command
($vmid, $cmd->{execute
}, $nocheck);
2960 die "unable to open monitor socket\n";
2964 syslog
("err", "VM $vmid qmp command failed - $err");
2971 sub vm_human_monitor_command
{
2972 my ($vmid, $cmdline) = @_;
2977 execute
=> 'human-monitor-command',
2978 arguments
=> { 'command-line' => $cmdline},
2981 return vm_qmp_command
($vmid, $cmd);
2984 sub vm_commandline
{
2985 my ($storecfg, $vmid) = @_;
2987 my $conf = load_config
($vmid);
2989 my $defaults = load_defaults
();
2991 my $cmd = config_to_command
($storecfg, $vmid, $conf, $defaults);
2993 return join(' ', @$cmd);
2997 my ($vmid, $skiplock) = @_;
2999 lock_config
($vmid, sub {
3001 my $conf = load_config
($vmid);
3003 check_lock
($conf) if !$skiplock;
3005 vm_mon_cmd
($vmid, "system_reset");
3009 sub get_vm_volumes
{
3013 foreach_drive
($conf, sub {
3014 my ($ds, $drive) = @_;
3016 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($drive->{file
}, 1);
3019 my $volid = $drive->{file
};
3020 return if !$volid || $volid =~ m
|^/|;
3022 push @$vollist, $volid;
3028 sub vm_stop_cleanup
{
3029 my ($storecfg, $vmid, $conf, $keepActive) = @_;
3032 fairsched_rmnod
($vmid); # try to destroy group
3035 my $vollist = get_vm_volumes
($conf);
3036 PVE
::Storage
::deactivate_volumes
($storecfg, $vollist);
3039 foreach my $ext (qw(mon qmp pid vnc qga)) {
3040 unlink "/var/run/qemu-server/${vmid}.$ext";
3043 warn $@ if $@; # avoid errors - just warn
3046 # Note: use $nockeck to skip tests if VM configuration file exists.
3047 # We need that when migration VMs to other nodes (files already moved)
3048 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3050 my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3052 $force = 1 if !defined($force) && !$shutdown;
3055 my $pid = check_running
($vmid, $nocheck, $migratedfrom);
3056 kill 15, $pid if $pid;
3057 my $conf = load_config
($vmid, $migratedfrom);
3058 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive);
3062 lock_config
($vmid, sub {
3064 my $pid = check_running
($vmid, $nocheck);
3069 $conf = load_config
($vmid);
3070 check_lock
($conf) if !$skiplock;
3071 if (!defined($timeout) && $shutdown && $conf->{startup
}) {
3072 my $opts = parse_startup
($conf->{startup
});
3073 $timeout = $opts->{down
} if $opts->{down
};
3077 $timeout = 60 if !defined($timeout);
3081 $nocheck ? vm_mon_cmd_nocheck
($vmid, "system_powerdown") : vm_mon_cmd
($vmid, "system_powerdown");
3084 $nocheck ? vm_mon_cmd_nocheck
($vmid, "quit") : vm_mon_cmd
($vmid, "quit");
3091 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
3096 if ($count >= $timeout) {
3098 warn "VM still running - terminating now with SIGTERM\n";
3101 die "VM quit/powerdown failed - got timeout\n";
3104 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
3109 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3112 die "VM quit/powerdown failed\n";
3120 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
3125 if ($count >= $timeout) {
3126 warn "VM still running - terminating now with SIGKILL\n";
3131 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
3136 my ($vmid, $skiplock) = @_;
3138 lock_config
($vmid, sub {
3140 my $conf = load_config
($vmid);
3142 check_lock
($conf) if !$skiplock;
3144 vm_mon_cmd
($vmid, "stop");
3149 my ($vmid, $skiplock) = @_;
3151 lock_config
($vmid, sub {
3153 my $conf = load_config
($vmid);
3155 check_lock
($conf) if !$skiplock;
3157 vm_mon_cmd
($vmid, "cont");
3162 my ($vmid, $skiplock, $key) = @_;
3164 lock_config
($vmid, sub {
3166 my $conf = load_config
($vmid);
3168 # there is no qmp command, so we use the human monitor command
3169 vm_human_monitor_command
($vmid, "sendkey $key");
3174 my ($storecfg, $vmid, $skiplock) = @_;
3176 lock_config
($vmid, sub {
3178 my $conf = load_config
($vmid);
3180 check_lock
($conf) if !$skiplock;
3182 if (!check_running
($vmid)) {
3183 fairsched_rmnod
($vmid); # try to destroy group
3184 destroy_vm
($storecfg, $vmid);
3186 die "VM $vmid is running - destroy failed\n";
3194 my ($filename, $buf) = @_;
3196 my $fh = IO
::File-
>new($filename, "w");
3197 return undef if !$fh;
3199 my $res = print $fh $buf;
3206 sub pci_device_info
{
3211 return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3212 my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3214 my $irq = file_read_firstline
("$pcisysfs/devices/$name/irq");
3215 return undef if !defined($irq) || $irq !~ m/^\d+$/;
3217 my $vendor = file_read_firstline
("$pcisysfs/devices/$name/vendor");
3218 return undef if !defined($vendor) || $vendor !~ s/^0x//;
3220 my $product = file_read_firstline
("$pcisysfs/devices/$name/device");
3221 return undef if !defined($product) || $product !~ s/^0x//;
3226 product
=> $product,
3232 has_fl_reset
=> -f
"$pcisysfs/devices/$name/reset" || 0,
3241 my $name = $dev->{name
};
3243 my $fn = "$pcisysfs/devices/$name/reset";
3245 return file_write
($fn, "1");
3248 sub pci_dev_bind_to_stub
{
3251 my $name = $dev->{name
};
3253 my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3254 return 1 if -d
$testdir;
3256 my $data = "$dev->{vendor} $dev->{product}";
3257 return undef if !file_write
("$pcisysfs/drivers/pci-stub/new_id", $data);
3259 my $fn = "$pcisysfs/devices/$name/driver/unbind";
3260 if (!file_write
($fn, $name)) {
3261 return undef if -f
$fn;
3264 $fn = "$pcisysfs/drivers/pci-stub/bind";
3265 if (! -d
$testdir) {
3266 return undef if !file_write
($fn, $name);
3272 sub print_pci_addr
{
3273 my ($id, $bridges) = @_;
3277 #addr1 : ide,parallel,serial (motherboard)
3278 #addr2 : first videocard
3279 balloon0
=> { bus
=> 0, addr
=> 3 },
3280 watchdog
=> { bus
=> 0, addr
=> 4 },
3281 scsihw0
=> { bus
=> 0, addr
=> 5 },
3282 scsihw1
=> { bus
=> 0, addr
=> 6 },
3283 ahci0
=> { bus
=> 0, addr
=> 7 },
3284 qga0
=> { bus
=> 0, addr
=> 8 },
3285 virtio0
=> { bus
=> 0, addr
=> 10 },
3286 virtio1
=> { bus
=> 0, addr
=> 11 },
3287 virtio2
=> { bus
=> 0, addr
=> 12 },
3288 virtio3
=> { bus
=> 0, addr
=> 13 },
3289 virtio4
=> { bus
=> 0, addr
=> 14 },
3290 virtio5
=> { bus
=> 0, addr
=> 15 },
3291 hostpci0
=> { bus
=> 0, addr
=> 16 },
3292 hostpci1
=> { bus
=> 0, addr
=> 17 },
3293 net0
=> { bus
=> 0, addr
=> 18 },
3294 net1
=> { bus
=> 0, addr
=> 19 },
3295 net2
=> { bus
=> 0, addr
=> 20 },
3296 net3
=> { bus
=> 0, addr
=> 21 },
3297 net4
=> { bus
=> 0, addr
=> 22 },
3298 net5
=> { bus
=> 0, addr
=> 23 },
3299 #addr29 : usb-host (pve-usb.cfg)
3300 'pci.1' => { bus
=> 0, addr
=> 30 },
3301 'pci.2' => { bus
=> 0, addr
=> 31 },
3302 'net6' => { bus
=> 1, addr
=> 1 },
3303 'net7' => { bus
=> 1, addr
=> 2 },
3304 'net8' => { bus
=> 1, addr
=> 3 },
3305 'net9' => { bus
=> 1, addr
=> 4 },
3306 'net10' => { bus
=> 1, addr
=> 5 },
3307 'net11' => { bus
=> 1, addr
=> 6 },
3308 'net12' => { bus
=> 1, addr
=> 7 },
3309 'net13' => { bus
=> 1, addr
=> 8 },
3310 'net14' => { bus
=> 1, addr
=> 9 },
3311 'net15' => { bus
=> 1, addr
=> 10 },
3312 'net16' => { bus
=> 1, addr
=> 11 },
3313 'net17' => { bus
=> 1, addr
=> 12 },
3314 'net18' => { bus
=> 1, addr
=> 13 },
3315 'net19' => { bus
=> 1, addr
=> 14 },
3316 'net20' => { bus
=> 1, addr
=> 15 },
3317 'net21' => { bus
=> 1, addr
=> 16 },
3318 'net22' => { bus
=> 1, addr
=> 17 },
3319 'net23' => { bus
=> 1, addr
=> 18 },
3320 'net24' => { bus
=> 1, addr
=> 19 },
3321 'net25' => { bus
=> 1, addr
=> 20 },
3322 'net26' => { bus
=> 1, addr
=> 21 },
3323 'net27' => { bus
=> 1, addr
=> 22 },
3324 'net28' => { bus
=> 1, addr
=> 23 },
3325 'net29' => { bus
=> 1, addr
=> 24 },
3326 'net30' => { bus
=> 1, addr
=> 25 },
3327 'net31' => { bus
=> 1, addr
=> 26 },
3328 'virtio6' => { bus
=> 2, addr
=> 1 },
3329 'virtio7' => { bus
=> 2, addr
=> 2 },
3330 'virtio8' => { bus
=> 2, addr
=> 3 },
3331 'virtio9' => { bus
=> 2, addr
=> 4 },
3332 'virtio10' => { bus
=> 2, addr
=> 5 },
3333 'virtio11' => { bus
=> 2, addr
=> 6 },
3334 'virtio12' => { bus
=> 2, addr
=> 7 },
3335 'virtio13' => { bus
=> 2, addr
=> 8 },
3336 'virtio14' => { bus
=> 2, addr
=> 9 },
3337 'virtio15' => { bus
=> 2, addr
=> 10 },
3340 if (defined($devices->{$id}->{bus
}) && defined($devices->{$id}->{addr
})) {
3341 my $addr = sprintf("0x%x", $devices->{$id}->{addr
});
3342 my $bus = $devices->{$id}->{bus
};
3343 $res = ",bus=pci.$bus,addr=$addr";
3344 $bridges->{$bus} = 1 if $bridges;
3351 my ($vmid, $value) = @_;
3353 vm_mon_cmd
($vmid, "balloon", value
=> $value);
3356 # vzdump restore implementaion
3358 sub archive_read_firstfile
{
3359 my $archive = shift;
3361 die "ERROR: file '$archive' does not exist\n" if ! -f
$archive;
3363 # try to detect archive type first
3364 my $pid = open (TMP
, "tar tf '$archive'|") ||
3365 die "unable to open file '$archive'\n";
3366 my $firstfile = <TMP
>;
3370 die "ERROR: archive contaions no data\n" if !$firstfile;
3376 sub restore_cleanup
{
3377 my $statfile = shift;
3379 print STDERR
"starting cleanup\n";
3381 if (my $fd = IO
::File-
>new($statfile, "r")) {
3382 while (defined(my $line = <$fd>)) {
3383 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3386 if ($volid =~ m
|^/|) {
3387 unlink $volid || die 'unlink failed\n';
3389 my $cfg = cfs_read_file
('storage.cfg');
3390 PVE
::Storage
::vdisk_free
($cfg, $volid);
3392 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
3394 print STDERR
"unable to cleanup '$volid' - $@" if $@;
3396 print STDERR
"unable to parse line in statfile - $line";
3403 sub restore_archive
{
3404 my ($archive, $vmid, $user, $opts) = @_;
3406 if ($archive ne '-') {
3407 my $firstfile = archive_read_firstfile
($archive);
3408 die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
3409 if $firstfile ne 'qemu-server.conf';
3412 my $tocmd = "/usr/lib/qemu-server/qmextract";
3414 $tocmd .= " --storage " . PVE
::Tools
::shellquote
($opts->{storage
}) if $opts->{storage
};
3415 $tocmd .= " --pool " . PVE
::Tools
::shellquote
($opts->{pool
}) if $opts->{pool
};
3416 $tocmd .= ' --prealloc' if $opts->{prealloc
};
3417 $tocmd .= ' --info' if $opts->{info
};
3419 # tar option "xf" does not autodetect compression when read from STDIN,
3420 # so we pipe to zcat
3421 my $cmd = "zcat -f|tar xf " . PVE
::Tools
::shellquote
($archive) . " " .
3422 PVE
::Tools
::shellquote
("--to-command=$tocmd");
3424 my $tmpdir = "/var/tmp/vzdumptmp$$";
3427 local $ENV{VZDUMP_TMPDIR
} = $tmpdir;
3428 local $ENV{VZDUMP_VMID
} = $vmid;
3429 local $ENV{VZDUMP_USER
} = $user;
3431 my $conffile = PVE
::QemuServer
::config_file
($vmid);
3432 my $tmpfn = "$conffile.$$.tmp";
3434 # disable interrupts (always do cleanups)
3435 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
3436 print STDERR
"got interrupt - ignored\n";
3441 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
3442 die "interrupted by signal\n";
3445 if ($archive eq '-') {
3446 print "extracting archive from STDIN\n";
3447 run_command
($cmd, input
=> "<&STDIN");
3449 print "extracting archive '$archive'\n";
3453 return if $opts->{info
};
3457 my $statfile = "$tmpdir/qmrestore.stat";
3458 if (my $fd = IO
::File-
>new($statfile, "r")) {
3459 while (defined (my $line = <$fd>)) {
3460 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3461 $map->{$1} = $2 if $1;
3463 print STDERR
"unable to parse line in statfile - $line\n";
3469 my $confsrc = "$tmpdir/qemu-server.conf";
3471 my $srcfd = new IO
::File
($confsrc, "r") ||
3472 die "unable to open file '$confsrc'\n";
3474 my $outfd = new IO
::File
($tmpfn, "w") ||
3475 die "unable to write config for VM $vmid\n";
3479 while (defined (my $line = <$srcfd>)) {
3480 next if $line =~ m/^\#vzdump\#/;
3481 next if $line =~ m/^lock:/;
3482 next if $line =~ m/^unused\d+:/;
3484 if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3485 # try to convert old 1.X settings
3486 my ($id, $ind, $ethcfg) = ($1, $2, $3);
3487 foreach my $devconfig (PVE
::Tools
::split_list
($ethcfg)) {
3488 my ($model, $macaddr) = split(/\=/, $devconfig);
3489 $macaddr = PVE
::Tools
::random_ether_addr
() if !$macaddr || $opts->{unique
};
3492 bridge
=> "vmbr$ind",
3493 macaddr
=> $macaddr,
3495 my $netstr = print_net
($net);
3496 print $outfd "net${netcount}: $netstr\n";
3499 } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && ($opts->{unique
})) {
3500 my ($id, $netstr) = ($1, $2);
3501 my $net = parse_net
($netstr);
3502 $net->{macaddr
} = PVE
::Tools
::random_ether_addr
() if $net->{macaddr
};
3503 $netstr = print_net
($net);
3504 print $outfd "$id: $netstr\n";
3505 } elsif ($line =~ m/^((ide|scsi|virtio)\d+):\s*(\S+)\s*$/) {
3508 if ($line =~ m/backup=no/) {
3509 print $outfd "#$line";
3510 } elsif ($virtdev && $map->{$virtdev}) {
3511 my $di = PVE
::QemuServer
::parse_drive
($virtdev, $value);
3512 $di->{file
} = $map->{$virtdev};
3513 $value = PVE
::QemuServer
::print_drive
($vmid, $di);
3514 print $outfd "$virtdev: $value\n";
3532 restore_cleanup
("$tmpdir/qmrestore.stat") if !$opts->{info
};
3539 rename $tmpfn, $conffile ||
3540 die "unable to commit configuration file '$conffile'\n";
3544 # Internal snapshots
3546 # NOTE: Snapshot create/delete involves several non-atomic
3547 # action, and can take a long time.
3548 # So we try to avoid locking the file and use 'lock' variable
3549 # inside the config file instead.
3551 my $snapshot_copy_config = sub {
3552 my ($source, $dest) = @_;
3554 foreach my $k (keys %$source) {
3555 next if $k eq 'snapshots';
3556 next if $k eq 'snapstate';
3557 next if $k eq 'snaptime';
3558 next if $k eq 'vmstate';
3559 next if $k eq 'lock';
3560 next if $k eq 'digest';
3561 next if $k eq 'description';
3562 next if $k =~ m/^unused\d+$/;
3564 $dest->{$k} = $source->{$k};
3568 my $snapshot_apply_config = sub {
3569 my ($conf, $snap) = @_;
3571 # copy snapshot list
3573 snapshots
=> $conf->{snapshots
},
3576 # keep description and list of unused disks
3577 foreach my $k (keys %$conf) {
3578 next if !($k =~ m/^unused\d+$/ || $k eq 'description');
3579 $newconf->{$k} = $conf->{$k};
3582 &$snapshot_copy_config($snap, $newconf);
3587 sub foreach_writable_storage
{
3588 my ($conf, $func) = @_;
3592 foreach my $ds (keys %$conf) {
3593 next if !valid_drivename
($ds);
3595 my $drive = parse_drive
($ds, $conf->{$ds});
3597 next if drive_is_cdrom
($drive);
3599 my $volid = $drive->{file
};
3601 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
3602 $sidhash->{$sid} = $sid if $sid;
3605 foreach my $sid (sort keys %$sidhash) {
3610 my $alloc_vmstate_volid = sub {
3611 my ($storecfg, $vmid, $conf, $snapname) = @_;
3613 # Note: we try to be smart when selecting a $target storage
3617 # search shared storage first
3618 foreach_writable_storage
($conf, sub {
3620 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
3621 return if !$scfg->{shared
};
3623 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage
3627 # now search local storage
3628 foreach_writable_storage
($conf, sub {
3630 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
3631 return if $scfg->{shared
};
3633 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage;
3637 $target = 'local' if !$target;
3639 my $driver_state_size = 32; # assume 32MB is enough to safe all driver state;
3640 my $size = $conf->{memory
} + $driver_state_size;
3642 my $name = "vm-$vmid-state-$snapname";
3643 my $scfg = PVE
::Storage
::storage_config
($storecfg, $target);
3644 $name .= ".raw" if $scfg->{path
}; # add filename extension for file base storage
3645 my $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $target, $vmid, 'raw', $name, $size*1024);
3650 my $snapshot_prepare = sub {
3651 my ($vmid, $snapname, $save_vmstate, $comment) = @_;
3655 my $updatefn = sub {
3657 my $conf = load_config
($vmid);
3661 $conf->{lock} = 'snapshot';
3663 die "snapshot name '$snapname' already used\n"
3664 if defined($conf->{snapshots
}->{$snapname});
3666 my $storecfg = PVE
::Storage
::config
();
3668 foreach_drive
($conf, sub {
3669 my ($ds, $drive) = @_;
3671 return if drive_is_cdrom
($drive);
3672 my $volid = $drive->{file
};
3674 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
3676 my $scfg = PVE
::Storage
::storage_config
($storecfg, $storeid);
3677 die "can't snapshot volume '$volid'\n"
3678 if !(($scfg->{path
} && $volname =~ m/\.qcow2$/) ||
3679 ($scfg->{type
} eq 'nexenta') ||
3680 ($scfg->{type
} eq 'rbd') ||
3681 ($scfg->{type
} eq 'sheepdog'));
3682 } elsif ($volid =~ m
|^(/.+)$| && -e
$volid) {
3683 die "snapshot device '$volid' is not possible\n";
3685 die "can't snapshot volume '$volid'\n";
3690 $snap = $conf->{snapshots
}->{$snapname} = {};
3692 if ($save_vmstate && check_running
($vmid)) {
3693 $snap->{vmstate
} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
3696 &$snapshot_copy_config($conf, $snap);
3698 $snap->{snapstate
} = "prepare";
3699 $snap->{snaptime
} = time();
3700 $snap->{description
} = $comment if $comment;
3702 update_config_nolock
($vmid, $conf, 1);
3705 lock_config
($vmid, $updatefn);
3710 my $snapshot_commit = sub {
3711 my ($vmid, $snapname) = @_;
3713 my $updatefn = sub {
3715 my $conf = load_config
($vmid);
3717 die "missing snapshot lock\n"
3718 if !($conf->{lock} && $conf->{lock} eq 'snapshot');
3720 my $snap = $conf->{snapshots
}->{$snapname};
3722 die "snapshot '$snapname' does not exist\n" if !defined($snap);
3724 die "wrong snapshot state\n"
3725 if !($snap->{snapstate
} && $snap->{snapstate
} eq "prepare");
3727 delete $snap->{snapstate
};
3728 delete $conf->{lock};
3730 my $newconf = &$snapshot_apply_config($conf, $snap);
3732 $newconf->{parent
} = $snapname;
3734 update_config_nolock
($vmid, $newconf, 1);
3737 lock_config
($vmid, $updatefn);
3740 sub snapshot_rollback
{
3741 my ($vmid, $snapname) = @_;
3747 my $storecfg = PVE
::Storage
::config
();
3749 my $updatefn = sub {
3751 my $conf = load_config
($vmid);
3753 $snap = $conf->{snapshots
}->{$snapname};
3755 die "snapshot '$snapname' does not exist\n" if !defined($snap);
3757 die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
3758 if $snap->{snapstate
};
3762 vm_stop
($storecfg, $vmid, undef, undef, 5, undef, undef);
3765 die "unable to rollback vm $vmid: vm is running\n"
3766 if check_running
($vmid);
3769 $conf->{lock} = 'rollback';
3771 die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
3772 delete $conf->{lock};
3776 # copy snapshot config to current config
3777 $conf = &$snapshot_apply_config($conf, $snap);
3778 $conf->{parent
} = $snapname;
3781 update_config_nolock
($vmid, $conf, 1);
3783 if (!$prepare && $snap->{vmstate
}) {
3784 my $statefile = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
3785 # fixme: this only forws for files currently
3786 vm_start
($storecfg, $vmid, $statefile);
3791 lock_config
($vmid, $updatefn);
3793 foreach_drive
($snap, sub {
3794 my ($ds, $drive) = @_;
3796 return if drive_is_cdrom
($drive);
3798 my $volid = $drive->{file
};
3799 my $device = "drive-$ds";
3801 PVE
::Storage
::volume_snapshot_rollback
($storecfg, $volid, $snapname);
3805 lock_config
($vmid, $updatefn);
3808 my $savevm_wait = sub {
3812 my $stat = PVE
::QemuServer
::vm_mon_cmd_nocheck
($vmid, "query-savevm");
3813 if (!$stat->{status
}) {
3814 die "savevm not active\n";
3815 } elsif ($stat->{status
} eq 'active') {
3818 } elsif ($stat->{status
} eq 'completed') {
3821 die "query-savevm returned status '$stat->{status}'\n";
3826 sub snapshot_create
{
3827 my ($vmid, $snapname, $save_vmstate, $freezefs, $comment) = @_;
3829 my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
3831 $freezefs = $save_vmstate = 0 if !$snap->{vmstate
}; # vm is not running
3835 my $running = check_running
($vmid);
3838 # create internal snapshots of all drives
3840 my $storecfg = PVE
::Storage
::config
();
3843 if ($snap->{vmstate
}) {
3844 my $path = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
3845 vm_mon_cmd
($vmid, "savevm-start", statefile
=> $path);
3846 &$savevm_wait($vmid);
3848 vm_mon_cmd
($vmid, "savevm-start");
3852 qga_freezefs
($vmid) if $running && $freezefs;
3854 foreach_drive
($snap, sub {
3855 my ($ds, $drive) = @_;
3857 return if drive_is_cdrom
($drive);
3859 my $volid = $drive->{file
};
3860 my $device = "drive-$ds";
3862 qemu_volume_snapshot
($vmid, $device, $storecfg, $volid, $snapname);
3863 $drivehash->{$ds} = 1;
3868 eval { gqa_unfreezefs
($vmid) if $running && $freezefs; };
3871 eval { vm_mon_cmd
($vmid, "savevm-end") if $running; };
3875 warn "snapshot create failed: starting cleanup\n";
3876 eval { snapshot_delete
($vmid, $snapname, 0, $drivehash); };
3881 &$snapshot_commit($vmid, $snapname);
3884 # Note: $drivehash is only set when called from snapshot_create.
3885 sub snapshot_delete
{
3886 my ($vmid, $snapname, $force, $drivehash) = @_;
3893 my $unlink_parent = sub {
3894 my ($confref, $new_parent) = @_;
3896 if ($confref->{parent
} && $confref->{parent
} eq $snapname) {
3898 $confref->{parent
} = $new_parent;
3900 delete $confref->{parent
};
3905 my $updatefn = sub {
3906 my ($remove_drive) = @_;
3908 my $conf = load_config
($vmid);
3910 check_lock
($conf) if !$drivehash;
3912 $snap = $conf->{snapshots
}->{$snapname};
3914 die "snapshot '$snapname' does not exist\n" if !defined($snap);
3916 # remove parent refs
3917 &$unlink_parent($conf, $snap->{parent
});
3918 foreach my $sn (keys %{$conf->{snapshots
}}) {
3919 next if $sn eq $snapname;
3920 &$unlink_parent($conf->{snapshots
}->{$sn}, $snap->{parent
});
3923 if ($remove_drive) {
3924 if ($remove_drive eq 'vmstate') {
3925 delete $snap->{$remove_drive};
3927 my $drive = parse_drive
($remove_drive, $snap->{$remove_drive});
3928 my $volid = $drive->{file
};
3929 delete $snap->{$remove_drive};
3930 add_unused_volume
($conf, $volid);
3935 $snap->{snapstate
} = 'delete';
3937 delete $conf->{snapshots
}->{$snapname};
3938 delete $conf->{lock} if $drivehash;
3939 foreach my $volid (@$unused) {
3940 add_unused_volume
($conf, $volid);
3944 update_config_nolock
($vmid, $conf, 1);
3947 lock_config
($vmid, $updatefn);
3949 # now remove vmstate file
3951 my $storecfg = PVE
::Storage
::config
();
3953 if ($snap->{vmstate
}) {
3954 eval { PVE
::Storage
::vdisk_free
($storecfg, $snap->{vmstate
}); };
3956 die $err if !$force;
3959 # save changes (remove vmstate from snapshot)
3960 lock_config
($vmid, $updatefn, 'vmstate') if !$force;
3963 # now remove all internal snapshots
3964 foreach_drive
($snap, sub {
3965 my ($ds, $drive) = @_;
3967 return if drive_is_cdrom
($drive);
3969 my $volid = $drive->{file
};
3970 my $device = "drive-$ds";
3972 if (!$drivehash || $drivehash->{$ds}) {
3973 eval { qemu_volume_snapshot_delete
($vmid, $device, $storecfg, $volid, $snapname); };
3975 die $err if !$force;
3980 # save changes (remove drive fron snapshot)
3981 lock_config
($vmid, $updatefn, $ds) if !$force;
3982 push @$unused, $volid;
3985 # now cleanup config
3987 lock_config
($vmid, $updatefn);