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
=> $migrate_port ?
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') eval {
2892 vm_mon_cmd
($vmid, "cont");
2895 # always set migrate speed (overwrite kvm default of 32m)
2896 # we set a very hight default of 8192m which is basically unlimited
2897 my $migrate_speed = $defaults->{migrate_speed
} || 8192;
2898 $migrate_speed = $conf->{migrate_speed
} || $migrate_speed;
2899 $migrate_speed = $migrate_speed * 1048576;
2901 vm_mon_cmd
($vmid, "migrate_set_speed", value
=> $migrate_speed);
2904 my $migrate_downtime = $defaults->{migrate_downtime
};
2905 $migrate_downtime = $conf->{migrate_downtime
} if defined($conf->{migrate_downtime
});
2906 if (defined($migrate_downtime)) {
2907 eval { vm_mon_cmd
($vmid, "migrate_set_downtime", value
=> $migrate_downtime); };
2911 my $capabilities = {};
2912 $capabilities->{capability
} = "xbzrle";
2913 $capabilities->{state} = JSON
::true
;
2914 eval { PVE
::QemuServer
::vm_mon_cmd_nocheck
($vmid, "migrate-set-capabilities", capabilities
=> [$capabilities]); };
2917 vm_balloonset
($vmid, $conf->{balloon
}) if $conf->{balloon
};
2923 my ($vmid, $execute, %params) = @_;
2925 my $cmd = { execute
=> $execute, arguments
=> \
%params };
2926 vm_qmp_command
($vmid, $cmd);
2929 sub vm_mon_cmd_nocheck
{
2930 my ($vmid, $execute, %params) = @_;
2932 my $cmd = { execute
=> $execute, arguments
=> \
%params };
2933 vm_qmp_command
($vmid, $cmd, 1);
2936 sub vm_qmp_command
{
2937 my ($vmid, $cmd, $nocheck) = @_;
2942 if ($cmd->{arguments
} && $cmd->{arguments
}->{timeout
}) {
2943 $timeout = $cmd->{arguments
}->{timeout
};
2944 delete $cmd->{arguments
}->{timeout
};
2948 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
2949 my $sname = PVE
::QemuServer
::qmp_socket
($vmid);
2951 my $qmpclient = PVE
::QMPClient-
>new();
2953 $res = $qmpclient->cmd($vmid, $cmd, $timeout);
2954 } elsif (-e
"${var_run_tmpdir}/$vmid.mon") {
2955 die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
2956 if scalar(%{$cmd->{arguments
}});
2957 vm_monitor_command
($vmid, $cmd->{execute
}, $nocheck);
2959 die "unable to open monitor socket\n";
2963 syslog
("err", "VM $vmid qmp command failed - $err");
2970 sub vm_human_monitor_command
{
2971 my ($vmid, $cmdline) = @_;
2976 execute
=> 'human-monitor-command',
2977 arguments
=> { 'command-line' => $cmdline},
2980 return vm_qmp_command
($vmid, $cmd);
2983 sub vm_commandline
{
2984 my ($storecfg, $vmid) = @_;
2986 my $conf = load_config
($vmid);
2988 my $defaults = load_defaults
();
2990 my $cmd = config_to_command
($storecfg, $vmid, $conf, $defaults);
2992 return join(' ', @$cmd);
2996 my ($vmid, $skiplock) = @_;
2998 lock_config
($vmid, sub {
3000 my $conf = load_config
($vmid);
3002 check_lock
($conf) if !$skiplock;
3004 vm_mon_cmd
($vmid, "system_reset");
3008 sub get_vm_volumes
{
3012 foreach_drive
($conf, sub {
3013 my ($ds, $drive) = @_;
3015 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($drive->{file
}, 1);
3018 my $volid = $drive->{file
};
3019 return if !$volid || $volid =~ m
|^/|;
3021 push @$vollist, $volid;
3027 sub vm_stop_cleanup
{
3028 my ($storecfg, $vmid, $conf, $keepActive) = @_;
3031 fairsched_rmnod
($vmid); # try to destroy group
3034 my $vollist = get_vm_volumes
($conf);
3035 PVE
::Storage
::deactivate_volumes
($storecfg, $vollist);
3038 foreach my $ext (qw(mon qmp pid vnc qga)) {
3039 unlink "/var/run/qemu-server/${vmid}.$ext";
3042 warn $@ if $@; # avoid errors - just warn
3045 # Note: use $nockeck to skip tests if VM configuration file exists.
3046 # We need that when migration VMs to other nodes (files already moved)
3047 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3049 my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3051 $force = 1 if !defined($force) && !$shutdown;
3054 my $pid = check_running
($vmid, $nocheck, $migratedfrom);
3055 kill 15, $pid if $pid;
3056 my $conf = load_config
($vmid, $migratedfrom);
3057 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive);
3061 lock_config
($vmid, sub {
3063 my $pid = check_running
($vmid, $nocheck);
3068 $conf = load_config
($vmid);
3069 check_lock
($conf) if !$skiplock;
3070 if (!defined($timeout) && $shutdown && $conf->{startup
}) {
3071 my $opts = parse_startup
($conf->{startup
});
3072 $timeout = $opts->{down
} if $opts->{down
};
3076 $timeout = 60 if !defined($timeout);
3080 $nocheck ? vm_mon_cmd_nocheck
($vmid, "system_powerdown") : vm_mon_cmd
($vmid, "system_powerdown");
3083 $nocheck ? vm_mon_cmd_nocheck
($vmid, "quit") : vm_mon_cmd
($vmid, "quit");
3090 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
3095 if ($count >= $timeout) {
3097 warn "VM still running - terminating now with SIGTERM\n";
3100 die "VM quit/powerdown failed - got timeout\n";
3103 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
3108 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3111 die "VM quit/powerdown failed\n";
3119 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
3124 if ($count >= $timeout) {
3125 warn "VM still running - terminating now with SIGKILL\n";
3130 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
3135 my ($vmid, $skiplock) = @_;
3137 lock_config
($vmid, sub {
3139 my $conf = load_config
($vmid);
3141 check_lock
($conf) if !$skiplock;
3143 vm_mon_cmd
($vmid, "stop");
3148 my ($vmid, $skiplock) = @_;
3150 lock_config
($vmid, sub {
3152 my $conf = load_config
($vmid);
3154 check_lock
($conf) if !$skiplock;
3156 vm_mon_cmd
($vmid, "cont");
3161 my ($vmid, $skiplock, $key) = @_;
3163 lock_config
($vmid, sub {
3165 my $conf = load_config
($vmid);
3167 # there is no qmp command, so we use the human monitor command
3168 vm_human_monitor_command
($vmid, "sendkey $key");
3173 my ($storecfg, $vmid, $skiplock) = @_;
3175 lock_config
($vmid, sub {
3177 my $conf = load_config
($vmid);
3179 check_lock
($conf) if !$skiplock;
3181 if (!check_running
($vmid)) {
3182 fairsched_rmnod
($vmid); # try to destroy group
3183 destroy_vm
($storecfg, $vmid);
3185 die "VM $vmid is running - destroy failed\n";
3193 my ($filename, $buf) = @_;
3195 my $fh = IO
::File-
>new($filename, "w");
3196 return undef if !$fh;
3198 my $res = print $fh $buf;
3205 sub pci_device_info
{
3210 return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3211 my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3213 my $irq = file_read_firstline
("$pcisysfs/devices/$name/irq");
3214 return undef if !defined($irq) || $irq !~ m/^\d+$/;
3216 my $vendor = file_read_firstline
("$pcisysfs/devices/$name/vendor");
3217 return undef if !defined($vendor) || $vendor !~ s/^0x//;
3219 my $product = file_read_firstline
("$pcisysfs/devices/$name/device");
3220 return undef if !defined($product) || $product !~ s/^0x//;
3225 product
=> $product,
3231 has_fl_reset
=> -f
"$pcisysfs/devices/$name/reset" || 0,
3240 my $name = $dev->{name
};
3242 my $fn = "$pcisysfs/devices/$name/reset";
3244 return file_write
($fn, "1");
3247 sub pci_dev_bind_to_stub
{
3250 my $name = $dev->{name
};
3252 my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3253 return 1 if -d
$testdir;
3255 my $data = "$dev->{vendor} $dev->{product}";
3256 return undef if !file_write
("$pcisysfs/drivers/pci-stub/new_id", $data);
3258 my $fn = "$pcisysfs/devices/$name/driver/unbind";
3259 if (!file_write
($fn, $name)) {
3260 return undef if -f
$fn;
3263 $fn = "$pcisysfs/drivers/pci-stub/bind";
3264 if (! -d
$testdir) {
3265 return undef if !file_write
($fn, $name);
3271 sub print_pci_addr
{
3272 my ($id, $bridges) = @_;
3276 #addr1 : ide,parallel,serial (motherboard)
3277 #addr2 : first videocard
3278 balloon0
=> { bus
=> 0, addr
=> 3 },
3279 watchdog
=> { bus
=> 0, addr
=> 4 },
3280 scsihw0
=> { bus
=> 0, addr
=> 5 },
3281 scsihw1
=> { bus
=> 0, addr
=> 6 },
3282 ahci0
=> { bus
=> 0, addr
=> 7 },
3283 qga0
=> { bus
=> 0, addr
=> 8 },
3284 virtio0
=> { bus
=> 0, addr
=> 10 },
3285 virtio1
=> { bus
=> 0, addr
=> 11 },
3286 virtio2
=> { bus
=> 0, addr
=> 12 },
3287 virtio3
=> { bus
=> 0, addr
=> 13 },
3288 virtio4
=> { bus
=> 0, addr
=> 14 },
3289 virtio5
=> { bus
=> 0, addr
=> 15 },
3290 hostpci0
=> { bus
=> 0, addr
=> 16 },
3291 hostpci1
=> { bus
=> 0, addr
=> 17 },
3292 net0
=> { bus
=> 0, addr
=> 18 },
3293 net1
=> { bus
=> 0, addr
=> 19 },
3294 net2
=> { bus
=> 0, addr
=> 20 },
3295 net3
=> { bus
=> 0, addr
=> 21 },
3296 net4
=> { bus
=> 0, addr
=> 22 },
3297 net5
=> { bus
=> 0, addr
=> 23 },
3298 #addr29 : usb-host (pve-usb.cfg)
3299 'pci.1' => { bus
=> 0, addr
=> 30 },
3300 'pci.2' => { bus
=> 0, addr
=> 31 },
3301 'net6' => { bus
=> 1, addr
=> 1 },
3302 'net7' => { bus
=> 1, addr
=> 2 },
3303 'net8' => { bus
=> 1, addr
=> 3 },
3304 'net9' => { bus
=> 1, addr
=> 4 },
3305 'net10' => { bus
=> 1, addr
=> 5 },
3306 'net11' => { bus
=> 1, addr
=> 6 },
3307 'net12' => { bus
=> 1, addr
=> 7 },
3308 'net13' => { bus
=> 1, addr
=> 8 },
3309 'net14' => { bus
=> 1, addr
=> 9 },
3310 'net15' => { bus
=> 1, addr
=> 10 },
3311 'net16' => { bus
=> 1, addr
=> 11 },
3312 'net17' => { bus
=> 1, addr
=> 12 },
3313 'net18' => { bus
=> 1, addr
=> 13 },
3314 'net19' => { bus
=> 1, addr
=> 14 },
3315 'net20' => { bus
=> 1, addr
=> 15 },
3316 'net21' => { bus
=> 1, addr
=> 16 },
3317 'net22' => { bus
=> 1, addr
=> 17 },
3318 'net23' => { bus
=> 1, addr
=> 18 },
3319 'net24' => { bus
=> 1, addr
=> 19 },
3320 'net25' => { bus
=> 1, addr
=> 20 },
3321 'net26' => { bus
=> 1, addr
=> 21 },
3322 'net27' => { bus
=> 1, addr
=> 22 },
3323 'net28' => { bus
=> 1, addr
=> 23 },
3324 'net29' => { bus
=> 1, addr
=> 24 },
3325 'net30' => { bus
=> 1, addr
=> 25 },
3326 'net31' => { bus
=> 1, addr
=> 26 },
3327 'virtio6' => { bus
=> 2, addr
=> 1 },
3328 'virtio7' => { bus
=> 2, addr
=> 2 },
3329 'virtio8' => { bus
=> 2, addr
=> 3 },
3330 'virtio9' => { bus
=> 2, addr
=> 4 },
3331 'virtio10' => { bus
=> 2, addr
=> 5 },
3332 'virtio11' => { bus
=> 2, addr
=> 6 },
3333 'virtio12' => { bus
=> 2, addr
=> 7 },
3334 'virtio13' => { bus
=> 2, addr
=> 8 },
3335 'virtio14' => { bus
=> 2, addr
=> 9 },
3336 'virtio15' => { bus
=> 2, addr
=> 10 },
3339 if (defined($devices->{$id}->{bus
}) && defined($devices->{$id}->{addr
})) {
3340 my $addr = sprintf("0x%x", $devices->{$id}->{addr
});
3341 my $bus = $devices->{$id}->{bus
};
3342 $res = ",bus=pci.$bus,addr=$addr";
3343 $bridges->{$bus} = 1 if $bridges;
3350 my ($vmid, $value) = @_;
3352 vm_mon_cmd
($vmid, "balloon", value
=> $value);
3355 # vzdump restore implementaion
3357 sub archive_read_firstfile
{
3358 my $archive = shift;
3360 die "ERROR: file '$archive' does not exist\n" if ! -f
$archive;
3362 # try to detect archive type first
3363 my $pid = open (TMP
, "tar tf '$archive'|") ||
3364 die "unable to open file '$archive'\n";
3365 my $firstfile = <TMP
>;
3369 die "ERROR: archive contaions no data\n" if !$firstfile;
3375 sub restore_cleanup
{
3376 my $statfile = shift;
3378 print STDERR
"starting cleanup\n";
3380 if (my $fd = IO
::File-
>new($statfile, "r")) {
3381 while (defined(my $line = <$fd>)) {
3382 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3385 if ($volid =~ m
|^/|) {
3386 unlink $volid || die 'unlink failed\n';
3388 my $cfg = cfs_read_file
('storage.cfg');
3389 PVE
::Storage
::vdisk_free
($cfg, $volid);
3391 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
3393 print STDERR
"unable to cleanup '$volid' - $@" if $@;
3395 print STDERR
"unable to parse line in statfile - $line";
3402 sub restore_archive
{
3403 my ($archive, $vmid, $user, $opts) = @_;
3405 if ($archive ne '-') {
3406 my $firstfile = archive_read_firstfile
($archive);
3407 die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
3408 if $firstfile ne 'qemu-server.conf';
3411 my $tocmd = "/usr/lib/qemu-server/qmextract";
3413 $tocmd .= " --storage " . PVE
::Tools
::shellquote
($opts->{storage
}) if $opts->{storage
};
3414 $tocmd .= " --pool " . PVE
::Tools
::shellquote
($opts->{pool
}) if $opts->{pool
};
3415 $tocmd .= ' --prealloc' if $opts->{prealloc
};
3416 $tocmd .= ' --info' if $opts->{info
};
3418 # tar option "xf" does not autodetect compression when read from STDIN,
3419 # so we pipe to zcat
3420 my $cmd = "zcat -f|tar xf " . PVE
::Tools
::shellquote
($archive) . " " .
3421 PVE
::Tools
::shellquote
("--to-command=$tocmd");
3423 my $tmpdir = "/var/tmp/vzdumptmp$$";
3426 local $ENV{VZDUMP_TMPDIR
} = $tmpdir;
3427 local $ENV{VZDUMP_VMID
} = $vmid;
3428 local $ENV{VZDUMP_USER
} = $user;
3430 my $conffile = PVE
::QemuServer
::config_file
($vmid);
3431 my $tmpfn = "$conffile.$$.tmp";
3433 # disable interrupts (always do cleanups)
3434 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
3435 print STDERR
"got interrupt - ignored\n";
3440 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
3441 die "interrupted by signal\n";
3444 if ($archive eq '-') {
3445 print "extracting archive from STDIN\n";
3446 run_command
($cmd, input
=> "<&STDIN");
3448 print "extracting archive '$archive'\n";
3452 return if $opts->{info
};
3456 my $statfile = "$tmpdir/qmrestore.stat";
3457 if (my $fd = IO
::File-
>new($statfile, "r")) {
3458 while (defined (my $line = <$fd>)) {
3459 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3460 $map->{$1} = $2 if $1;
3462 print STDERR
"unable to parse line in statfile - $line\n";
3468 my $confsrc = "$tmpdir/qemu-server.conf";
3470 my $srcfd = new IO
::File
($confsrc, "r") ||
3471 die "unable to open file '$confsrc'\n";
3473 my $outfd = new IO
::File
($tmpfn, "w") ||
3474 die "unable to write config for VM $vmid\n";
3478 while (defined (my $line = <$srcfd>)) {
3479 next if $line =~ m/^\#vzdump\#/;
3480 next if $line =~ m/^lock:/;
3481 next if $line =~ m/^unused\d+:/;
3483 if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3484 # try to convert old 1.X settings
3485 my ($id, $ind, $ethcfg) = ($1, $2, $3);
3486 foreach my $devconfig (PVE
::Tools
::split_list
($ethcfg)) {
3487 my ($model, $macaddr) = split(/\=/, $devconfig);
3488 $macaddr = PVE
::Tools
::random_ether_addr
() if !$macaddr || $opts->{unique
};
3491 bridge
=> "vmbr$ind",
3492 macaddr
=> $macaddr,
3494 my $netstr = print_net
($net);
3495 print $outfd "net${netcount}: $netstr\n";
3498 } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && ($opts->{unique
})) {
3499 my ($id, $netstr) = ($1, $2);
3500 my $net = parse_net
($netstr);
3501 $net->{macaddr
} = PVE
::Tools
::random_ether_addr
() if $net->{macaddr
};
3502 $netstr = print_net
($net);
3503 print $outfd "$id: $netstr\n";
3504 } elsif ($line =~ m/^((ide|scsi|virtio)\d+):\s*(\S+)\s*$/) {
3507 if ($line =~ m/backup=no/) {
3508 print $outfd "#$line";
3509 } elsif ($virtdev && $map->{$virtdev}) {
3510 my $di = PVE
::QemuServer
::parse_drive
($virtdev, $value);
3511 $di->{file
} = $map->{$virtdev};
3512 $value = PVE
::QemuServer
::print_drive
($vmid, $di);
3513 print $outfd "$virtdev: $value\n";
3531 restore_cleanup
("$tmpdir/qmrestore.stat") if !$opts->{info
};
3538 rename $tmpfn, $conffile ||
3539 die "unable to commit configuration file '$conffile'\n";
3543 # Internal snapshots
3545 # NOTE: Snapshot create/delete involves several non-atomic
3546 # action, and can take a long time.
3547 # So we try to avoid locking the file and use 'lock' variable
3548 # inside the config file instead.
3550 my $snapshot_copy_config = sub {
3551 my ($source, $dest) = @_;
3553 foreach my $k (keys %$source) {
3554 next if $k eq 'snapshots';
3555 next if $k eq 'snapstate';
3556 next if $k eq 'snaptime';
3557 next if $k eq 'vmstate';
3558 next if $k eq 'lock';
3559 next if $k eq 'digest';
3560 next if $k eq 'description';
3561 next if $k =~ m/^unused\d+$/;
3563 $dest->{$k} = $source->{$k};
3567 my $snapshot_apply_config = sub {
3568 my ($conf, $snap) = @_;
3570 # copy snapshot list
3572 snapshots
=> $conf->{snapshots
},
3575 # keep description and list of unused disks
3576 foreach my $k (keys %$conf) {
3577 next if !($k =~ m/^unused\d+$/ || $k eq 'description');
3578 $newconf->{$k} = $conf->{$k};
3581 &$snapshot_copy_config($snap, $newconf);
3586 sub foreach_writable_storage
{
3587 my ($conf, $func) = @_;
3591 foreach my $ds (keys %$conf) {
3592 next if !valid_drivename
($ds);
3594 my $drive = parse_drive
($ds, $conf->{$ds});
3596 next if drive_is_cdrom
($drive);
3598 my $volid = $drive->{file
};
3600 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
3601 $sidhash->{$sid} = $sid if $sid;
3604 foreach my $sid (sort keys %$sidhash) {
3609 my $alloc_vmstate_volid = sub {
3610 my ($storecfg, $vmid, $conf, $snapname) = @_;
3612 # Note: we try to be smart when selecting a $target storage
3616 # search shared storage first
3617 foreach_writable_storage
($conf, sub {
3619 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
3620 return if !$scfg->{shared
};
3622 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage
3626 # now search local storage
3627 foreach_writable_storage
($conf, sub {
3629 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
3630 return if $scfg->{shared
};
3632 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage;
3636 $target = 'local' if !$target;
3638 my $driver_state_size = 32; # assume 32MB is enough to safe all driver state;
3639 my $size = $conf->{memory
} + $driver_state_size;
3641 my $name = "vm-$vmid-state-$snapname";
3642 my $scfg = PVE
::Storage
::storage_config
($storecfg, $target);
3643 $name .= ".raw" if $scfg->{path
}; # add filename extension for file base storage
3644 my $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $target, $vmid, 'raw', $name, $size*1024);
3649 my $snapshot_prepare = sub {
3650 my ($vmid, $snapname, $save_vmstate, $comment) = @_;
3654 my $updatefn = sub {
3656 my $conf = load_config
($vmid);
3660 $conf->{lock} = 'snapshot';
3662 die "snapshot name '$snapname' already used\n"
3663 if defined($conf->{snapshots
}->{$snapname});
3665 my $storecfg = PVE
::Storage
::config
();
3667 foreach_drive
($conf, sub {
3668 my ($ds, $drive) = @_;
3670 return if drive_is_cdrom
($drive);
3671 my $volid = $drive->{file
};
3673 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
3675 my $scfg = PVE
::Storage
::storage_config
($storecfg, $storeid);
3676 die "can't snapshot volume '$volid'\n"
3677 if !(($scfg->{path
} && $volname =~ m/\.qcow2$/) ||
3678 ($scfg->{type
} eq 'nexenta') ||
3679 ($scfg->{type
} eq 'rbd') ||
3680 ($scfg->{type
} eq 'sheepdog'));
3681 } elsif ($volid =~ m
|^(/.+)$| && -e
$volid) {
3682 die "snapshot device '$volid' is not possible\n";
3684 die "can't snapshot volume '$volid'\n";
3689 $snap = $conf->{snapshots
}->{$snapname} = {};
3691 if ($save_vmstate && check_running
($vmid)) {
3692 $snap->{vmstate
} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
3695 &$snapshot_copy_config($conf, $snap);
3697 $snap->{snapstate
} = "prepare";
3698 $snap->{snaptime
} = time();
3699 $snap->{description
} = $comment if $comment;
3701 update_config_nolock
($vmid, $conf, 1);
3704 lock_config
($vmid, $updatefn);
3709 my $snapshot_commit = sub {
3710 my ($vmid, $snapname) = @_;
3712 my $updatefn = sub {
3714 my $conf = load_config
($vmid);
3716 die "missing snapshot lock\n"
3717 if !($conf->{lock} && $conf->{lock} eq 'snapshot');
3719 my $snap = $conf->{snapshots
}->{$snapname};
3721 die "snapshot '$snapname' does not exist\n" if !defined($snap);
3723 die "wrong snapshot state\n"
3724 if !($snap->{snapstate
} && $snap->{snapstate
} eq "prepare");
3726 delete $snap->{snapstate
};
3727 delete $conf->{lock};
3729 my $newconf = &$snapshot_apply_config($conf, $snap);
3731 $newconf->{parent
} = $snapname;
3733 update_config_nolock
($vmid, $newconf, 1);
3736 lock_config
($vmid, $updatefn);
3739 sub snapshot_rollback
{
3740 my ($vmid, $snapname) = @_;
3746 my $storecfg = PVE
::Storage
::config
();
3748 my $updatefn = sub {
3750 my $conf = load_config
($vmid);
3752 $snap = $conf->{snapshots
}->{$snapname};
3754 die "snapshot '$snapname' does not exist\n" if !defined($snap);
3756 die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
3757 if $snap->{snapstate
};
3761 vm_stop
($storecfg, $vmid, undef, undef, 5, undef, undef);
3764 die "unable to rollback vm $vmid: vm is running\n"
3765 if check_running
($vmid);
3768 $conf->{lock} = 'rollback';
3770 die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
3771 delete $conf->{lock};
3775 # copy snapshot config to current config
3776 $conf = &$snapshot_apply_config($conf, $snap);
3777 $conf->{parent
} = $snapname;
3780 update_config_nolock
($vmid, $conf, 1);
3782 if (!$prepare && $snap->{vmstate
}) {
3783 my $statefile = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
3784 # fixme: this only forws for files currently
3785 vm_start
($storecfg, $vmid, $statefile);
3790 lock_config
($vmid, $updatefn);
3792 foreach_drive
($snap, sub {
3793 my ($ds, $drive) = @_;
3795 return if drive_is_cdrom
($drive);
3797 my $volid = $drive->{file
};
3798 my $device = "drive-$ds";
3800 PVE
::Storage
::volume_snapshot_rollback
($storecfg, $volid, $snapname);
3804 lock_config
($vmid, $updatefn);
3807 sub snapshot_create
{
3808 my ($vmid, $snapname, $save_vmstate, $freezefs, $comment) = @_;
3810 my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
3812 $freezefs = $save_vmstate = 0 if !$snap->{vmstate
}; # vm is not running
3816 my $running = check_running
($vmid);
3819 # create internal snapshots of all drives
3821 my $storecfg = PVE
::Storage
::config
();
3824 if ($snap->{vmstate
}) {
3825 my $path = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
3826 vm_mon_cmd
($vmid, "snapshot-start", statefile
=> $path);
3828 vm_mon_cmd
($vmid, "snapshot-start");
3832 qga_freezefs
($vmid) if $running && $freezefs;
3834 foreach_drive
($snap, sub {
3835 my ($ds, $drive) = @_;
3837 return if drive_is_cdrom
($drive);
3839 my $volid = $drive->{file
};
3840 my $device = "drive-$ds";
3842 qemu_volume_snapshot
($vmid, $device, $storecfg, $volid, $snapname);
3843 $drivehash->{$ds} = 1;
3848 eval { gqa_unfreezefs
($vmid) if $running && $freezefs; };
3851 eval { vm_mon_cmd
($vmid, "snapshot-end") if $running; };
3855 warn "snapshot create failed: starting cleanup\n";
3856 eval { snapshot_delete
($vmid, $snapname, 0, $drivehash); };
3861 &$snapshot_commit($vmid, $snapname);
3864 # Note: $drivehash is only set when called from snapshot_create.
3865 sub snapshot_delete
{
3866 my ($vmid, $snapname, $force, $drivehash) = @_;
3873 my $unlink_parent = sub {
3874 my ($confref, $new_parent) = @_;
3876 if ($confref->{parent
} && $confref->{parent
} eq $snapname) {
3878 $confref->{parent
} = $new_parent;
3880 delete $confref->{parent
};
3885 my $updatefn = sub {
3886 my ($remove_drive) = @_;
3888 my $conf = load_config
($vmid);
3890 check_lock
($conf) if !$drivehash;
3892 $snap = $conf->{snapshots
}->{$snapname};
3894 die "snapshot '$snapname' does not exist\n" if !defined($snap);
3896 # remove parent refs
3897 &$unlink_parent($conf, $snap->{parent
});
3898 foreach my $sn (keys %{$conf->{snapshots
}}) {
3899 next if $sn eq $snapname;
3900 &$unlink_parent($conf->{snapshots
}->{$sn}, $snap->{parent
});
3903 if ($remove_drive) {
3904 if ($remove_drive eq 'vmstate') {
3905 delete $snap->{$remove_drive};
3907 my $drive = parse_drive
($remove_drive, $snap->{$remove_drive});
3908 my $volid = $drive->{file
};
3909 delete $snap->{$remove_drive};
3910 add_unused_volume
($conf, $volid);
3915 $snap->{snapstate
} = 'delete';
3917 delete $conf->{snapshots
}->{$snapname};
3918 delete $conf->{lock} if $drivehash;
3919 foreach my $volid (@$unused) {
3920 add_unused_volume
($conf, $volid);
3924 update_config_nolock
($vmid, $conf, 1);
3927 lock_config
($vmid, $updatefn);
3929 # now remove vmstate file
3931 my $storecfg = PVE
::Storage
::config
();
3933 if ($snap->{vmstate
}) {
3934 eval { PVE
::Storage
::vdisk_free
($storecfg, $snap->{vmstate
}); };
3936 die $err if !$force;
3939 # save changes (remove vmstate from snapshot)
3940 lock_config
($vmid, $updatefn, 'vmstate') if !$force;
3943 # now remove all internal snapshots
3944 foreach_drive
($snap, sub {
3945 my ($ds, $drive) = @_;
3947 return if drive_is_cdrom
($drive);
3949 my $volid = $drive->{file
};
3950 my $device = "drive-$ds";
3952 if (!$drivehash || $drivehash->{$ds}) {
3953 eval { qemu_volume_snapshot_delete
($vmid, $device, $storecfg, $volid, $snapname); };
3955 die $err if !$force;
3960 # save changes (remove drive fron snapshot)
3961 lock_config
($vmid, $updatefn, $ds) if !$force;
3962 push @$unused, $volid;
3965 # now cleanup config
3967 lock_config
($vmid, $updatefn);