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, $migrate_uri) = @_;
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';
2121 push @$cmd, '-incoming', $migrate_uri if $migrate_uri;
2123 push @$cmd, '-S' if $migrate_uri;
2126 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2127 next if !$conf->{"usb$i"};
2130 # include usb device config
2131 push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
2133 # enable absolute mouse coordinates (needed by vnc)
2134 my $tablet = defined($conf->{tablet
}) ?
$conf->{tablet
} : $defaults->{tablet
};
2137 push @$devices, '-device', 'usb-tablet,bus=ehci.0,port=6';
2139 push @$devices, '-usbdevice', 'tablet';
2144 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
2145 my $d = parse_hostpci
($conf->{"hostpci$i"});
2147 $pciaddr = print_pci_addr
("hostpci$i", $bridges);
2148 push @$devices, '-device', "pci-assign,host=$d->{pciid},id=hostpci$i$pciaddr";
2152 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2153 my $d = parse_usb_device
($conf->{"usb$i"});
2155 if ($d->{vendorid
} && $d->{productid
}) {
2156 push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2157 } elsif (defined($d->{hostbus
}) && defined($d->{hostport
})) {
2158 push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2163 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
2164 if (my $path = $conf->{"serial$i"}) {
2165 die "no such serial device\n" if ! -c
$path;
2166 push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2167 push @$devices, '-device', "isa-serial,chardev=serial$i";
2172 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
2173 if (my $path = $conf->{"parallel$i"}) {
2174 die "no such parallel device\n" if ! -c
$path;
2175 push @$devices, '-chardev', "parport,id=parallel$i,path=$path";
2176 push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2180 my $vmname = $conf->{name
} || "vm$vmid";
2182 push @$cmd, '-name', $vmname;
2185 $sockets = $conf->{smp
} if $conf->{smp
}; # old style - no longer iused
2186 $sockets = $conf->{sockets
} if $conf->{sockets
};
2188 my $cores = $conf->{cores
} || 1;
2190 push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2192 push @$cmd, '-cpu', $conf->{cpu
} if $conf->{cpu
};
2194 push @$cmd, '-nodefaults';
2196 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
2198 my $bootindex_hash = {};
2200 foreach my $o (split(//, $bootorder)) {
2201 $bootindex_hash->{$o} = $i*100;
2205 push @$cmd, '-boot', "menu=on";
2207 push @$cmd, '-no-acpi' if defined($conf->{acpi
}) && $conf->{acpi
} == 0;
2209 push @$cmd, '-no-reboot' if defined($conf->{reboot
}) && $conf->{reboot
} == 0;
2211 my $vga = $conf->{vga
};
2213 if ($conf->{ostype
} && ($conf->{ostype
} eq 'win7' || $conf->{ostype
} eq 'w2k8')) {
2220 push @$cmd, '-vga', $vga if $vga; # for kvm 77 and later
2223 my $tdf = defined($conf->{tdf
}) ?
$conf->{tdf
} : $defaults->{tdf
};
2224 # ignore - no longer supported by newer kvm
2225 # push @$cmd, '-tdf' if $tdf;
2227 my $nokvm = defined($conf->{kvm
}) && $conf->{kvm
} == 0 ?
1 : 0;
2229 if (my $ost = $conf->{ostype
}) {
2230 # other, wxp, w2k, w2k3, w2k8, wvista, win7, l24, l26
2232 if ($ost =~ m/^w/) { # windows
2233 push @$cmd, '-localtime' if !defined($conf->{localtime});
2235 # use rtc-td-hack when acpi is enabled
2236 if (!(defined($conf->{acpi
}) && $conf->{acpi
} == 0)) {
2237 push @$cmd, '-rtc-td-hack';
2241 if ($ost eq 'win7' || $ost eq 'w2k8' || $ost eq 'wvista') {
2242 push @$cmd, '-no-kvm-pit-reinjection';
2243 push @$cmd, '-no-hpet';
2253 push @$cmd, '-no-kvm';
2255 die "No accelerator found!\n" if !$cpuinfo->{hvm
};
2258 push @$cmd, '-localtime' if $conf->{localtime};
2260 push @$cmd, '-startdate', $conf->{startdate
} if $conf->{startdate
};
2262 push @$cmd, '-S' if $conf->{freeze
};
2264 # set keyboard layout
2265 my $kb = $conf->{keyboard
} || $defaults->{keyboard
};
2266 push @$cmd, '-k', $kb if $kb;
2269 #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2270 #push @$cmd, '-soundhw', 'es1370';
2271 #push @$cmd, '-soundhw', $soundhw if $soundhw;
2273 if($conf->{agent
}) {
2274 my $qgasocket = qga_socket
($vmid);
2275 my $pciaddr = print_pci_addr
("qga0", $bridges);
2276 push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
2277 push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
2278 push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
2281 $pciaddr = print_pci_addr
("balloon0", $bridges);
2282 push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr" if $conf->{balloon
};
2284 if ($conf->{watchdog
}) {
2285 my $wdopts = parse_watchdog
($conf->{watchdog
});
2286 $pciaddr = print_pci_addr
("watchdog", $bridges);
2287 my $watchdog = $wdopts->{model
} || 'i6300esb';
2288 push @$devices, '-device', "$watchdog$pciaddr";
2289 push @$devices, '-watchdog-action', $wdopts->{action
} if $wdopts->{action
};
2293 my $scsicontroller = {};
2294 my $ahcicontroller = {};
2295 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : $defaults->{scsihw
};
2297 foreach_drive
($conf, sub {
2298 my ($ds, $drive) = @_;
2300 if (PVE
::Storage
::parse_volume_id
($drive->{file
}, 1)) {
2301 push @$vollist, $drive->{file
};
2304 $use_virtio = 1 if $ds =~ m/^virtio/;
2306 if (drive_is_cdrom
($drive)) {
2307 if ($bootindex_hash->{d
}) {
2308 $drive->{bootindex
} = $bootindex_hash->{d
};
2309 $bootindex_hash->{d
} += 1;
2312 if ($bootindex_hash->{c
}) {
2313 $drive->{bootindex
} = $bootindex_hash->{c
} if $conf->{bootdisk
} && ($conf->{bootdisk
} eq $ds);
2314 $bootindex_hash->{c
} += 1;
2318 if ($drive->{interface
} eq 'scsi') {
2320 my $maxdev = ($scsihw ne 'lsi') ?
256 : 7;
2321 my $controller = int($drive->{index} / $maxdev);
2322 $pciaddr = print_pci_addr
("scsihw$controller", $bridges);
2323 push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
2324 $scsicontroller->{$controller}=1;
2327 if ($drive->{interface
} eq 'sata') {
2328 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
2329 $pciaddr = print_pci_addr
("ahci$controller", $bridges);
2330 push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
2331 $ahcicontroller->{$controller}=1;
2334 push @$devices, '-drive',print_drive_full
($storecfg, $vmid, $drive);
2335 push @$devices, '-device',print_drivedevice_full
($storecfg, $conf, $vmid, $drive, $bridges);
2338 push @$cmd, '-m', $conf->{memory
} || $defaults->{memory
};
2340 for (my $i = 0; $i < $MAX_NETS; $i++) {
2341 next if !$conf->{"net$i"};
2342 my $d = parse_net
($conf->{"net$i"});
2345 $use_virtio = 1 if $d->{model
} eq 'virtio';
2347 if ($bootindex_hash->{n
}) {
2348 $d->{bootindex
} = $bootindex_hash->{n
};
2349 $bootindex_hash->{n
} += 1;
2352 my $netdevfull = print_netdev_full
($vmid,$conf,$d,"net$i");
2353 push @$devices, '-netdev', $netdevfull;
2355 my $netdevicefull = print_netdevice_full
($vmid,$conf,$d,"net$i",$bridges);
2356 push @$devices, '-device', $netdevicefull;
2360 while (my ($k, $v) = each %$bridges) {
2361 $pciaddr = print_pci_addr
("pci.$k");
2362 unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
2366 # hack: virtio with fairsched is unreliable, so we do not use fairsched
2367 # when the VM uses virtio devices.
2368 if (!$use_virtio && $have_ovz) {
2370 my $cpuunits = defined($conf->{cpuunits
}) ?
2371 $conf->{cpuunits
} : $defaults->{cpuunits
};
2373 push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
2375 # fixme: cpulimit is currently ignored
2376 #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2380 if ($conf->{args
}) {
2381 my $aa = PVE
::Tools
::split_args
($conf->{args
});
2385 push @$cmd, @$devices;
2386 return wantarray ?
($cmd, $vollist) : $cmd;
2391 return "${var_run_tmpdir}/$vmid.vnc";
2396 return "${var_run_tmpdir}/$vmid.qmp";
2401 return "${var_run_tmpdir}/$vmid.qga";
2406 return "${var_run_tmpdir}/$vmid.pid";
2409 sub next_migrate_port
{
2411 for (my $p = 60000; $p < 60010; $p++) {
2413 my $sock = IO
::Socket
::INET-
>new(Listen
=> 5,
2414 LocalAddr
=> 'localhost',
2425 die "unable to find free migration port";
2428 sub vm_devices_list
{
2431 my $res = vm_mon_cmd
($vmid, 'query-pci');
2434 foreach my $pcibus (@$res) {
2435 foreach my $device (@{$pcibus->{devices
}}) {
2436 next if !$device->{'qdev_id'};
2437 $devices->{$device->{'qdev_id'}} = $device;
2445 my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2447 return 1 if !check_running
($vmid) || !$conf->{hotplug
};
2449 my $devices_list = vm_devices_list
($vmid);
2450 return 1 if defined($devices_list->{$deviceid});
2452 qemu_bridgeadd
($storecfg, $conf, $vmid, $deviceid); #add bridge if we need it for the device
2454 if ($deviceid =~ m/^(virtio)(\d+)$/) {
2455 return undef if !qemu_driveadd
($storecfg, $vmid, $device);
2456 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
2457 qemu_deviceadd
($vmid, $devicefull);
2458 if(!qemu_deviceaddverify
($vmid, $deviceid)) {
2459 qemu_drivedel
($vmid, $deviceid);
2464 if ($deviceid =~ m/^(scsihw)(\d+)$/) {
2465 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : "lsi";
2466 my $pciaddr = print_pci_addr
($deviceid);
2467 my $devicefull = "$scsihw,id=$deviceid$pciaddr";
2468 qemu_deviceadd
($vmid, $devicefull);
2469 return undef if(!qemu_deviceaddverify
($vmid, $deviceid));
2472 if ($deviceid =~ m/^(scsi)(\d+)$/) {
2473 return 1 if ($conf->{scsihw
} && $conf->{scsihw
} ne 'lsi'); #virtio-scsi not yet support hotplug
2474 return undef if !qemu_findorcreatescsihw
($storecfg,$conf, $vmid, $device);
2475 return undef if !qemu_driveadd
($storecfg, $vmid, $device);
2476 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
2477 if(!qemu_deviceadd
($vmid, $devicefull)) {
2478 qemu_drivedel
($vmid, $deviceid);
2483 if ($deviceid =~ m/^(net)(\d+)$/) {
2484 return undef if !qemu_netdevadd
($vmid, $conf, $device, $deviceid);
2485 my $netdevicefull = print_netdevice_full
($vmid, $conf, $device, $deviceid);
2486 qemu_deviceadd
($vmid, $netdevicefull);
2487 if(!qemu_deviceaddverify
($vmid, $deviceid)) {
2488 qemu_netdevdel
($vmid, $deviceid);
2493 if ($deviceid =~ m/^(pci\.)(\d+)$/) {
2495 my $pciaddr = print_pci_addr
($deviceid);
2496 my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
2497 qemu_deviceadd
($vmid, $devicefull);
2498 return undef if !qemu_deviceaddverify
($vmid, $deviceid);
2504 sub vm_deviceunplug
{
2505 my ($vmid, $conf, $deviceid) = @_;
2507 return 1 if !check_running
($vmid) || !$conf->{hotplug
};
2509 my $devices_list = vm_devices_list
($vmid);
2510 return 1 if !defined($devices_list->{$deviceid});
2512 die "can't unplug bootdisk" if $conf->{bootdisk
} && $conf->{bootdisk
} eq $deviceid;
2514 if ($deviceid =~ m/^(virtio)(\d+)$/) {
2515 return undef if !qemu_drivedel
($vmid, $deviceid);
2516 qemu_devicedel
($vmid, $deviceid);
2517 return undef if !qemu_devicedelverify
($vmid, $deviceid);
2520 if ($deviceid =~ m/^(lsi)(\d+)$/) {
2521 return undef if !qemu_devicedel
($vmid, $deviceid);
2524 if ($deviceid =~ m/^(scsi)(\d+)$/) {
2525 return undef if !qemu_devicedel
($vmid, $deviceid);
2526 return undef if !qemu_drivedel
($vmid, $deviceid);
2529 if ($deviceid =~ m/^(net)(\d+)$/) {
2530 return undef if !qemu_netdevdel
($vmid, $deviceid);
2531 qemu_devicedel
($vmid, $deviceid);
2532 return undef if !qemu_devicedelverify
($vmid, $deviceid);
2538 sub qemu_deviceadd
{
2539 my ($vmid, $devicefull) = @_;
2541 my $ret = vm_human_monitor_command
($vmid, "device_add $devicefull");
2543 # Otherwise, if the command succeeds, no output is sent. So any non-empty string shows an error
2544 return 1 if $ret eq "";
2545 syslog
("err", "error on hotplug device : $ret");
2550 sub qemu_devicedel
{
2551 my($vmid, $deviceid) = @_;
2553 my $ret = vm_human_monitor_command
($vmid, "device_del $deviceid");
2555 return 1 if $ret eq "";
2556 syslog
("err", "detaching device $deviceid failed : $ret");
2561 my($storecfg, $vmid, $device) = @_;
2563 my $drive = print_drive_full
($storecfg, $vmid, $device);
2564 my $ret = vm_human_monitor_command
($vmid, "drive_add auto $drive");
2565 # If the command succeeds qemu prints: "OK"
2566 if ($ret !~ m/OK/s) {
2567 syslog
("err", "adding drive failed: $ret");
2574 my($vmid, $deviceid) = @_;
2576 my $ret = vm_human_monitor_command
($vmid, "drive_del drive-$deviceid");
2578 if ($ret =~ m/Device \'.*?\' not found/s) {
2579 # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2581 elsif ($ret ne "") {
2582 syslog
("err", "deleting drive $deviceid failed : $ret");
2588 sub qemu_deviceaddverify
{
2589 my ($vmid,$deviceid) = @_;
2591 for (my $i = 0; $i <= 5; $i++) {
2592 my $devices_list = vm_devices_list
($vmid);
2593 return 1 if defined($devices_list->{$deviceid});
2596 syslog
("err", "error on hotplug device $deviceid");
2601 sub qemu_devicedelverify
{
2602 my ($vmid,$deviceid) = @_;
2604 #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2605 for (my $i = 0; $i <= 5; $i++) {
2606 my $devices_list = vm_devices_list
($vmid);
2607 return 1 if !defined($devices_list->{$deviceid});
2610 syslog
("err", "error on hot-unplugging device $deviceid");
2614 sub qemu_findorcreatescsihw
{
2615 my ($storecfg, $conf, $vmid, $device) = @_;
2617 my $maxdev = ($conf->{scsihw
} && $conf->{scsihw
} ne 'lsi') ?
256 : 7;
2618 my $controller = int($device->{index} / $maxdev);
2619 my $scsihwid="scsihw$controller";
2620 my $devices_list = vm_devices_list
($vmid);
2622 if(!defined($devices_list->{$scsihwid})) {
2623 return undef if !vm_deviceplug
($storecfg, $conf, $vmid, $scsihwid);
2628 sub qemu_bridgeadd
{
2629 my ($storecfg, $conf, $vmid, $device) = @_;
2632 my $bridgeid = undef;
2633 print_pci_addr
($device, $bridges);
2635 while (my ($k, $v) = each %$bridges) {
2638 return if $bridgeid < 1;
2639 my $bridge = "pci.$bridgeid";
2640 my $devices_list = vm_devices_list
($vmid);
2642 if(!defined($devices_list->{$bridge})) {
2643 return undef if !vm_deviceplug
($storecfg, $conf, $vmid, $bridge);
2648 sub qemu_netdevadd
{
2649 my ($vmid, $conf, $device, $deviceid) = @_;
2651 my $netdev = print_netdev_full
($vmid, $conf, $device, $deviceid);
2652 my $ret = vm_human_monitor_command
($vmid, "netdev_add $netdev");
2655 #if the command succeeds, no output is sent. So any non-empty string shows an error
2656 return 1 if $ret eq "";
2657 syslog
("err", "adding netdev failed: $ret");
2661 sub qemu_netdevdel
{
2662 my ($vmid, $deviceid) = @_;
2664 my $ret = vm_human_monitor_command
($vmid, "netdev_del $deviceid");
2666 #if the command succeeds, no output is sent. So any non-empty string shows an error
2667 return 1 if $ret eq "";
2668 syslog
("err", "deleting netdev failed: $ret");
2672 sub qemu_block_set_io_throttle
{
2673 my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
2675 return if !check_running
($vmid) ;
2678 $bps_rd = 0 if !$bps_rd;
2679 $bps_wr = 0 if !$bps_wr;
2680 $iops = 0 if !$iops;
2681 $iops_rd = 0 if !$iops_rd;
2682 $iops_wr = 0 if !$iops_wr;
2684 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));
2688 # old code, only used to shutdown old VM after update
2690 my ($fh, $timeout) = @_;
2692 my $sel = new IO
::Select
;
2699 while (scalar (@ready = $sel->can_read($timeout))) {
2701 if ($count = $fh->sysread($buf, 8192)) {
2702 if ($buf =~ /^(.*)\(qemu\) $/s) {
2709 if (!defined($count)) {
2716 die "monitor read timeout\n" if !scalar(@ready);
2721 # old code, only used to shutdown old VM after update
2722 sub vm_monitor_command
{
2723 my ($vmid, $cmdstr, $nocheck) = @_;
2728 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
2730 my $sname = "${var_run_tmpdir}/$vmid.mon";
2732 my $sock = IO
::Socket
::UNIX-
>new( Peer
=> $sname ) ||
2733 die "unable to connect to VM $vmid socket - $!\n";
2737 # hack: migrate sometime blocks the monitor (when migrate_downtime
2739 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2740 $timeout = 60*60; # 1 hour
2744 my $data = __read_avail
($sock, $timeout);
2746 if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
2747 die "got unexpected qemu monitor banner\n";
2750 my $sel = new IO
::Select
;
2753 if (!scalar(my @ready = $sel->can_write($timeout))) {
2754 die "monitor write error - timeout";
2757 my $fullcmd = "$cmdstr\r";
2759 # syslog('info', "VM $vmid monitor command: $cmdstr");
2762 if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
2763 die "monitor write error - $!";
2766 return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
2770 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2771 $timeout = 60*60; # 1 hour
2772 } elsif ($cmdstr =~ m/^(eject|change)/) {
2773 $timeout = 60; # note: cdrom mount command is slow
2775 if ($res = __read_avail
($sock, $timeout)) {
2777 my @lines = split("\r?\n", $res);
2779 shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
2781 $res = join("\n", @lines);
2789 syslog
("err", "VM $vmid monitor command failed - $err");
2796 sub qemu_block_resize
{
2797 my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
2799 my $running = PVE
::QemuServer
::check_running
($vmid);
2801 return if !PVE
::Storage
::volume_resize
($storecfg, $volid, $size, $running);
2803 return if !$running;
2805 vm_mon_cmd
($vmid, "block_resize", device
=> $deviceid, size
=> int($size));
2809 sub qemu_volume_snapshot
{
2810 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
2812 my $running = PVE
::QemuServer
::check_running
($vmid);
2814 return if !PVE
::Storage
::volume_snapshot
($storecfg, $volid, $snap, $running);
2816 return if !$running;
2818 vm_mon_cmd
($vmid, "snapshot-drive", device
=> $deviceid, name
=> $snap);
2822 sub qemu_volume_snapshot_delete
{
2823 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
2825 my $running = PVE
::QemuServer
::check_running
($vmid);
2827 return if !PVE
::Storage
::volume_snapshot_delete
($storecfg, $volid, $snap, $running);
2829 return if !$running;
2831 vm_mon_cmd
($vmid, "delete-drive-snapshot", device
=> $deviceid, name
=> $snap);
2834 sub qemu_snapshot_start
{
2835 my ($vmid, $snap) = @_;
2837 #need to implement statefile location
2838 my $statefile="/tmp/$vmid-$snap";
2840 vm_mon_cmd
($vmid, "snapshot-start", statefile
=> $statefile);
2844 sub qemu_snapshot_end
{
2847 vm_mon_cmd
($vmid, "snapshot-end");
2854 #need to impplement call to qemu-ga
2857 sub qga_unfreezefs
{
2860 #need to impplement call to qemu-ga
2864 my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom) = @_;
2866 lock_config
($vmid, sub {
2867 my $conf = load_config
($vmid, $migratedfrom);
2869 check_lock
($conf) if !$skiplock;
2871 die "VM $vmid already running\n" if check_running
($vmid, undef, $migratedfrom);
2874 my $migrate_port = 0;
2877 if ($statefile eq 'tcp') {
2878 $migrate_port = next_migrate_port
();
2879 $migrate_uri = "tcp:localhost:${migrate_port}";
2881 if (-f
$statefile) {
2882 $migrate_uri = "exec:cat $statefile";
2884 warn "state file '$statefile' does not exist - doing normal startup\n";
2889 my $defaults = load_defaults
();
2891 # set environment variable useful inside network script
2892 $ENV{PVE_MIGRATED_FROM
} = $migratedfrom if $migratedfrom;
2894 my ($cmd, $vollist) = config_to_command
($storecfg, $vmid, $conf, $defaults, $migrate_uri);
2896 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
2897 my $d = parse_hostpci
($conf->{"hostpci$i"});
2899 my $info = pci_device_info
("0000:$d->{pciid}");
2900 die "IOMMU not present\n" if !check_iommu_support
();
2901 die "no pci device info for device '$d->{pciid}'\n" if !$info;
2902 die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub
($info);
2903 die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset
($info);
2906 PVE
::Storage
::activate_volumes
($storecfg, $vollist);
2908 eval { run_command
($cmd, timeout
=> $migrate_uri ?
undef : 30); };
2910 die "start failed: $err" if $err;
2914 if ($statefile eq 'tcp') {
2915 print "migration listens on port $migrate_port\n";
2918 # fixme: send resume - is that necessary ?
2919 eval { vm_mon_cmd
($vmid, "cont"); };
2923 # always set migrate speed (overwrite kvm default of 32m)
2924 # we set a very hight default of 8192m which is basically unlimited
2925 my $migrate_speed = $defaults->{migrate_speed
} || 8192;
2926 $migrate_speed = $conf->{migrate_speed
} || $migrate_speed;
2927 $migrate_speed = $migrate_speed * 1048576;
2929 vm_mon_cmd
($vmid, "migrate_set_speed", value
=> $migrate_speed);
2932 my $migrate_downtime = $defaults->{migrate_downtime
};
2933 $migrate_downtime = $conf->{migrate_downtime
} if defined($conf->{migrate_downtime
});
2934 if (defined($migrate_downtime)) {
2935 eval { vm_mon_cmd
($vmid, "migrate_set_downtime", value
=> $migrate_downtime); };
2939 my $capabilities = {};
2940 $capabilities->{capability
} = "xbzrle";
2941 $capabilities->{state} = JSON
::true
;
2942 eval { PVE
::QemuServer
::vm_mon_cmd_nocheck
($vmid, "migrate-set-capabilities", capabilities
=> [$capabilities]); };
2945 vm_balloonset
($vmid, $conf->{balloon
}) if $conf->{balloon
};
2951 my ($vmid, $execute, %params) = @_;
2953 my $cmd = { execute
=> $execute, arguments
=> \
%params };
2954 vm_qmp_command
($vmid, $cmd);
2957 sub vm_mon_cmd_nocheck
{
2958 my ($vmid, $execute, %params) = @_;
2960 my $cmd = { execute
=> $execute, arguments
=> \
%params };
2961 vm_qmp_command
($vmid, $cmd, 1);
2964 sub vm_qmp_command
{
2965 my ($vmid, $cmd, $nocheck) = @_;
2970 if ($cmd->{arguments
} && $cmd->{arguments
}->{timeout
}) {
2971 $timeout = $cmd->{arguments
}->{timeout
};
2972 delete $cmd->{arguments
}->{timeout
};
2976 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
2977 my $sname = PVE
::QemuServer
::qmp_socket
($vmid);
2979 my $qmpclient = PVE
::QMPClient-
>new();
2981 $res = $qmpclient->cmd($vmid, $cmd, $timeout);
2982 } elsif (-e
"${var_run_tmpdir}/$vmid.mon") {
2983 die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
2984 if scalar(%{$cmd->{arguments
}});
2985 vm_monitor_command
($vmid, $cmd->{execute
}, $nocheck);
2987 die "unable to open monitor socket\n";
2991 syslog
("err", "VM $vmid qmp command failed - $err");
2998 sub vm_human_monitor_command
{
2999 my ($vmid, $cmdline) = @_;
3004 execute
=> 'human-monitor-command',
3005 arguments
=> { 'command-line' => $cmdline},
3008 return vm_qmp_command
($vmid, $cmd);
3011 sub vm_commandline
{
3012 my ($storecfg, $vmid) = @_;
3014 my $conf = load_config
($vmid);
3016 my $defaults = load_defaults
();
3018 my $cmd = config_to_command
($storecfg, $vmid, $conf, $defaults);
3020 return join(' ', @$cmd);
3024 my ($vmid, $skiplock) = @_;
3026 lock_config
($vmid, sub {
3028 my $conf = load_config
($vmid);
3030 check_lock
($conf) if !$skiplock;
3032 vm_mon_cmd
($vmid, "system_reset");
3036 sub get_vm_volumes
{
3040 foreach_drive
($conf, sub {
3041 my ($ds, $drive) = @_;
3043 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($drive->{file
}, 1);
3046 my $volid = $drive->{file
};
3047 return if !$volid || $volid =~ m
|^/|;
3049 push @$vollist, $volid;
3055 sub vm_stop_cleanup
{
3056 my ($storecfg, $vmid, $conf, $keepActive) = @_;
3059 fairsched_rmnod
($vmid); # try to destroy group
3062 my $vollist = get_vm_volumes
($conf);
3063 PVE
::Storage
::deactivate_volumes
($storecfg, $vollist);
3066 foreach my $ext (qw(mon qmp pid vnc qga)) {
3067 unlink "/var/run/qemu-server/${vmid}.$ext";
3070 warn $@ if $@; # avoid errors - just warn
3073 # Note: use $nockeck to skip tests if VM configuration file exists.
3074 # We need that when migration VMs to other nodes (files already moved)
3075 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3077 my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3079 $force = 1 if !defined($force) && !$shutdown;
3082 my $pid = check_running
($vmid, $nocheck, $migratedfrom);
3083 kill 15, $pid if $pid;
3084 my $conf = load_config
($vmid, $migratedfrom);
3085 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive);
3089 lock_config
($vmid, sub {
3091 my $pid = check_running
($vmid, $nocheck);
3096 $conf = load_config
($vmid);
3097 check_lock
($conf) if !$skiplock;
3098 if (!defined($timeout) && $shutdown && $conf->{startup
}) {
3099 my $opts = parse_startup
($conf->{startup
});
3100 $timeout = $opts->{down
} if $opts->{down
};
3104 $timeout = 60 if !defined($timeout);
3108 $nocheck ? vm_mon_cmd_nocheck
($vmid, "system_powerdown") : vm_mon_cmd
($vmid, "system_powerdown");
3111 $nocheck ? vm_mon_cmd_nocheck
($vmid, "quit") : vm_mon_cmd
($vmid, "quit");
3118 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
3123 if ($count >= $timeout) {
3125 warn "VM still running - terminating now with SIGTERM\n";
3128 die "VM quit/powerdown failed - got timeout\n";
3131 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
3136 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3139 die "VM quit/powerdown failed\n";
3147 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
3152 if ($count >= $timeout) {
3153 warn "VM still running - terminating now with SIGKILL\n";
3158 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
3163 my ($vmid, $skiplock) = @_;
3165 lock_config
($vmid, sub {
3167 my $conf = load_config
($vmid);
3169 check_lock
($conf) if !$skiplock;
3171 vm_mon_cmd
($vmid, "stop");
3176 my ($vmid, $skiplock) = @_;
3178 lock_config
($vmid, sub {
3180 my $conf = load_config
($vmid);
3182 check_lock
($conf) if !$skiplock;
3184 vm_mon_cmd
($vmid, "cont");
3189 my ($vmid, $skiplock, $key) = @_;
3191 lock_config
($vmid, sub {
3193 my $conf = load_config
($vmid);
3195 # there is no qmp command, so we use the human monitor command
3196 vm_human_monitor_command
($vmid, "sendkey $key");
3201 my ($storecfg, $vmid, $skiplock) = @_;
3203 lock_config
($vmid, sub {
3205 my $conf = load_config
($vmid);
3207 check_lock
($conf) if !$skiplock;
3209 if (!check_running
($vmid)) {
3210 fairsched_rmnod
($vmid); # try to destroy group
3211 destroy_vm
($storecfg, $vmid);
3213 die "VM $vmid is running - destroy failed\n";
3221 my ($filename, $buf) = @_;
3223 my $fh = IO
::File-
>new($filename, "w");
3224 return undef if !$fh;
3226 my $res = print $fh $buf;
3233 sub pci_device_info
{
3238 return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3239 my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3241 my $irq = file_read_firstline
("$pcisysfs/devices/$name/irq");
3242 return undef if !defined($irq) || $irq !~ m/^\d+$/;
3244 my $vendor = file_read_firstline
("$pcisysfs/devices/$name/vendor");
3245 return undef if !defined($vendor) || $vendor !~ s/^0x//;
3247 my $product = file_read_firstline
("$pcisysfs/devices/$name/device");
3248 return undef if !defined($product) || $product !~ s/^0x//;
3253 product
=> $product,
3259 has_fl_reset
=> -f
"$pcisysfs/devices/$name/reset" || 0,
3268 my $name = $dev->{name
};
3270 my $fn = "$pcisysfs/devices/$name/reset";
3272 return file_write
($fn, "1");
3275 sub pci_dev_bind_to_stub
{
3278 my $name = $dev->{name
};
3280 my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3281 return 1 if -d
$testdir;
3283 my $data = "$dev->{vendor} $dev->{product}";
3284 return undef if !file_write
("$pcisysfs/drivers/pci-stub/new_id", $data);
3286 my $fn = "$pcisysfs/devices/$name/driver/unbind";
3287 if (!file_write
($fn, $name)) {
3288 return undef if -f
$fn;
3291 $fn = "$pcisysfs/drivers/pci-stub/bind";
3292 if (! -d
$testdir) {
3293 return undef if !file_write
($fn, $name);
3299 sub print_pci_addr
{
3300 my ($id, $bridges) = @_;
3304 #addr1 : ide,parallel,serial (motherboard)
3305 #addr2 : first videocard
3306 balloon0
=> { bus
=> 0, addr
=> 3 },
3307 watchdog
=> { bus
=> 0, addr
=> 4 },
3308 scsihw0
=> { bus
=> 0, addr
=> 5 },
3309 scsihw1
=> { bus
=> 0, addr
=> 6 },
3310 ahci0
=> { bus
=> 0, addr
=> 7 },
3311 qga0
=> { bus
=> 0, addr
=> 8 },
3312 virtio0
=> { bus
=> 0, addr
=> 10 },
3313 virtio1
=> { bus
=> 0, addr
=> 11 },
3314 virtio2
=> { bus
=> 0, addr
=> 12 },
3315 virtio3
=> { bus
=> 0, addr
=> 13 },
3316 virtio4
=> { bus
=> 0, addr
=> 14 },
3317 virtio5
=> { bus
=> 0, addr
=> 15 },
3318 hostpci0
=> { bus
=> 0, addr
=> 16 },
3319 hostpci1
=> { bus
=> 0, addr
=> 17 },
3320 net0
=> { bus
=> 0, addr
=> 18 },
3321 net1
=> { bus
=> 0, addr
=> 19 },
3322 net2
=> { bus
=> 0, addr
=> 20 },
3323 net3
=> { bus
=> 0, addr
=> 21 },
3324 net4
=> { bus
=> 0, addr
=> 22 },
3325 net5
=> { bus
=> 0, addr
=> 23 },
3326 #addr29 : usb-host (pve-usb.cfg)
3327 'pci.1' => { bus
=> 0, addr
=> 30 },
3328 'pci.2' => { bus
=> 0, addr
=> 31 },
3329 'net6' => { bus
=> 1, addr
=> 1 },
3330 'net7' => { bus
=> 1, addr
=> 2 },
3331 'net8' => { bus
=> 1, addr
=> 3 },
3332 'net9' => { bus
=> 1, addr
=> 4 },
3333 'net10' => { bus
=> 1, addr
=> 5 },
3334 'net11' => { bus
=> 1, addr
=> 6 },
3335 'net12' => { bus
=> 1, addr
=> 7 },
3336 'net13' => { bus
=> 1, addr
=> 8 },
3337 'net14' => { bus
=> 1, addr
=> 9 },
3338 'net15' => { bus
=> 1, addr
=> 10 },
3339 'net16' => { bus
=> 1, addr
=> 11 },
3340 'net17' => { bus
=> 1, addr
=> 12 },
3341 'net18' => { bus
=> 1, addr
=> 13 },
3342 'net19' => { bus
=> 1, addr
=> 14 },
3343 'net20' => { bus
=> 1, addr
=> 15 },
3344 'net21' => { bus
=> 1, addr
=> 16 },
3345 'net22' => { bus
=> 1, addr
=> 17 },
3346 'net23' => { bus
=> 1, addr
=> 18 },
3347 'net24' => { bus
=> 1, addr
=> 19 },
3348 'net25' => { bus
=> 1, addr
=> 20 },
3349 'net26' => { bus
=> 1, addr
=> 21 },
3350 'net27' => { bus
=> 1, addr
=> 22 },
3351 'net28' => { bus
=> 1, addr
=> 23 },
3352 'net29' => { bus
=> 1, addr
=> 24 },
3353 'net30' => { bus
=> 1, addr
=> 25 },
3354 'net31' => { bus
=> 1, addr
=> 26 },
3355 'virtio6' => { bus
=> 2, addr
=> 1 },
3356 'virtio7' => { bus
=> 2, addr
=> 2 },
3357 'virtio8' => { bus
=> 2, addr
=> 3 },
3358 'virtio9' => { bus
=> 2, addr
=> 4 },
3359 'virtio10' => { bus
=> 2, addr
=> 5 },
3360 'virtio11' => { bus
=> 2, addr
=> 6 },
3361 'virtio12' => { bus
=> 2, addr
=> 7 },
3362 'virtio13' => { bus
=> 2, addr
=> 8 },
3363 'virtio14' => { bus
=> 2, addr
=> 9 },
3364 'virtio15' => { bus
=> 2, addr
=> 10 },
3367 if (defined($devices->{$id}->{bus
}) && defined($devices->{$id}->{addr
})) {
3368 my $addr = sprintf("0x%x", $devices->{$id}->{addr
});
3369 my $bus = $devices->{$id}->{bus
};
3370 $res = ",bus=pci.$bus,addr=$addr";
3371 $bridges->{$bus} = 1 if $bridges;
3378 my ($vmid, $value) = @_;
3380 vm_mon_cmd
($vmid, "balloon", value
=> $value);
3383 # vzdump restore implementaion
3385 sub archive_read_firstfile
{
3386 my $archive = shift;
3388 die "ERROR: file '$archive' does not exist\n" if ! -f
$archive;
3390 # try to detect archive type first
3391 my $pid = open (TMP
, "tar tf '$archive'|") ||
3392 die "unable to open file '$archive'\n";
3393 my $firstfile = <TMP
>;
3397 die "ERROR: archive contaions no data\n" if !$firstfile;
3403 sub restore_cleanup
{
3404 my $statfile = shift;
3406 print STDERR
"starting cleanup\n";
3408 if (my $fd = IO
::File-
>new($statfile, "r")) {
3409 while (defined(my $line = <$fd>)) {
3410 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3413 if ($volid =~ m
|^/|) {
3414 unlink $volid || die 'unlink failed\n';
3416 my $cfg = cfs_read_file
('storage.cfg');
3417 PVE
::Storage
::vdisk_free
($cfg, $volid);
3419 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
3421 print STDERR
"unable to cleanup '$volid' - $@" if $@;
3423 print STDERR
"unable to parse line in statfile - $line";
3430 sub restore_archive
{
3431 my ($archive, $vmid, $user, $opts) = @_;
3433 if ($archive ne '-') {
3434 my $firstfile = archive_read_firstfile
($archive);
3435 die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
3436 if $firstfile ne 'qemu-server.conf';
3439 my $tocmd = "/usr/lib/qemu-server/qmextract";
3441 $tocmd .= " --storage " . PVE
::Tools
::shellquote
($opts->{storage
}) if $opts->{storage
};
3442 $tocmd .= " --pool " . PVE
::Tools
::shellquote
($opts->{pool
}) if $opts->{pool
};
3443 $tocmd .= ' --prealloc' if $opts->{prealloc
};
3444 $tocmd .= ' --info' if $opts->{info
};
3446 # tar option "xf" does not autodetect compression when read from STDIN,
3447 # so we pipe to zcat
3448 my $cmd = "zcat -f|tar xf " . PVE
::Tools
::shellquote
($archive) . " " .
3449 PVE
::Tools
::shellquote
("--to-command=$tocmd");
3451 my $tmpdir = "/var/tmp/vzdumptmp$$";
3454 local $ENV{VZDUMP_TMPDIR
} = $tmpdir;
3455 local $ENV{VZDUMP_VMID
} = $vmid;
3456 local $ENV{VZDUMP_USER
} = $user;
3458 my $conffile = PVE
::QemuServer
::config_file
($vmid);
3459 my $tmpfn = "$conffile.$$.tmp";
3461 # disable interrupts (always do cleanups)
3462 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
3463 print STDERR
"got interrupt - ignored\n";
3468 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
3469 die "interrupted by signal\n";
3472 if ($archive eq '-') {
3473 print "extracting archive from STDIN\n";
3474 run_command
($cmd, input
=> "<&STDIN");
3476 print "extracting archive '$archive'\n";
3480 return if $opts->{info
};
3484 my $statfile = "$tmpdir/qmrestore.stat";
3485 if (my $fd = IO
::File-
>new($statfile, "r")) {
3486 while (defined (my $line = <$fd>)) {
3487 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3488 $map->{$1} = $2 if $1;
3490 print STDERR
"unable to parse line in statfile - $line\n";
3496 my $confsrc = "$tmpdir/qemu-server.conf";
3498 my $srcfd = new IO
::File
($confsrc, "r") ||
3499 die "unable to open file '$confsrc'\n";
3501 my $outfd = new IO
::File
($tmpfn, "w") ||
3502 die "unable to write config for VM $vmid\n";
3506 while (defined (my $line = <$srcfd>)) {
3507 next if $line =~ m/^\#vzdump\#/;
3508 next if $line =~ m/^lock:/;
3509 next if $line =~ m/^unused\d+:/;
3511 if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3512 # try to convert old 1.X settings
3513 my ($id, $ind, $ethcfg) = ($1, $2, $3);
3514 foreach my $devconfig (PVE
::Tools
::split_list
($ethcfg)) {
3515 my ($model, $macaddr) = split(/\=/, $devconfig);
3516 $macaddr = PVE
::Tools
::random_ether_addr
() if !$macaddr || $opts->{unique
};
3519 bridge
=> "vmbr$ind",
3520 macaddr
=> $macaddr,
3522 my $netstr = print_net
($net);
3523 print $outfd "net${netcount}: $netstr\n";
3526 } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && ($opts->{unique
})) {
3527 my ($id, $netstr) = ($1, $2);
3528 my $net = parse_net
($netstr);
3529 $net->{macaddr
} = PVE
::Tools
::random_ether_addr
() if $net->{macaddr
};
3530 $netstr = print_net
($net);
3531 print $outfd "$id: $netstr\n";
3532 } elsif ($line =~ m/^((ide|scsi|virtio)\d+):\s*(\S+)\s*$/) {
3535 if ($line =~ m/backup=no/) {
3536 print $outfd "#$line";
3537 } elsif ($virtdev && $map->{$virtdev}) {
3538 my $di = PVE
::QemuServer
::parse_drive
($virtdev, $value);
3539 $di->{file
} = $map->{$virtdev};
3540 $value = PVE
::QemuServer
::print_drive
($vmid, $di);
3541 print $outfd "$virtdev: $value\n";
3559 restore_cleanup
("$tmpdir/qmrestore.stat") if !$opts->{info
};
3566 rename $tmpfn, $conffile ||
3567 die "unable to commit configuration file '$conffile'\n";
3571 # Internal snapshots
3573 # NOTE: Snapshot create/delete involves several non-atomic
3574 # action, and can take a long time.
3575 # So we try to avoid locking the file and use 'lock' variable
3576 # inside the config file instead.
3578 my $snapshot_copy_config = sub {
3579 my ($source, $dest) = @_;
3581 foreach my $k (keys %$source) {
3582 next if $k eq 'snapshots';
3583 next if $k eq 'snapstate';
3584 next if $k eq 'snaptime';
3585 next if $k eq 'vmstate';
3586 next if $k eq 'lock';
3587 next if $k eq 'digest';
3588 next if $k eq 'description';
3589 next if $k =~ m/^unused\d+$/;
3591 $dest->{$k} = $source->{$k};
3595 my $snapshot_apply_config = sub {
3596 my ($conf, $snap) = @_;
3598 # copy snapshot list
3600 snapshots
=> $conf->{snapshots
},
3603 # keep description and list of unused disks
3604 foreach my $k (keys %$conf) {
3605 next if !($k =~ m/^unused\d+$/ || $k eq 'description');
3606 $newconf->{$k} = $conf->{$k};
3609 &$snapshot_copy_config($snap, $newconf);
3614 sub foreach_writable_storage
{
3615 my ($conf, $func) = @_;
3619 foreach my $ds (keys %$conf) {
3620 next if !valid_drivename
($ds);
3622 my $drive = parse_drive
($ds, $conf->{$ds});
3624 next if drive_is_cdrom
($drive);
3626 my $volid = $drive->{file
};
3628 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
3629 $sidhash->{$sid} = $sid if $sid;
3632 foreach my $sid (sort keys %$sidhash) {
3637 my $alloc_vmstate_volid = sub {
3638 my ($storecfg, $vmid, $conf, $snapname) = @_;
3640 # Note: we try to be smart when selecting a $target storage
3644 # search shared storage first
3645 foreach_writable_storage
($conf, sub {
3647 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
3648 return if !$scfg->{shared
};
3650 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage
3654 # now search local storage
3655 foreach_writable_storage
($conf, sub {
3657 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
3658 return if $scfg->{shared
};
3660 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage;
3664 $target = 'local' if !$target;
3666 my $driver_state_size = 32; # assume 32MB is enough to safe all driver state;
3667 my $size = $conf->{memory
} + $driver_state_size;
3669 my $name = "vm-$vmid-state-$snapname";
3670 my $scfg = PVE
::Storage
::storage_config
($storecfg, $target);
3671 $name .= ".raw" if $scfg->{path
}; # add filename extension for file base storage
3672 my $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $target, $vmid, 'raw', $name, $size*1024);
3677 my $snapshot_prepare = sub {
3678 my ($vmid, $snapname, $save_vmstate, $comment) = @_;
3682 my $updatefn = sub {
3684 my $conf = load_config
($vmid);
3688 $conf->{lock} = 'snapshot';
3690 die "snapshot name '$snapname' already used\n"
3691 if defined($conf->{snapshots
}->{$snapname});
3693 my $storecfg = PVE
::Storage
::config
();
3695 foreach_drive
($conf, sub {
3696 my ($ds, $drive) = @_;
3698 return if drive_is_cdrom
($drive);
3699 my $volid = $drive->{file
};
3701 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
3703 my $scfg = PVE
::Storage
::storage_config
($storecfg, $storeid);
3704 die "can't snapshot volume '$volid'\n"
3705 if !(($scfg->{path
} && $volname =~ m/\.qcow2$/) ||
3706 ($scfg->{type
} eq 'rbd') ||
3707 ($scfg->{type
} eq 'sheepdog'));
3708 } elsif ($volid =~ m
|^(/.+)$| && -e
$volid) {
3709 die "snapshot device '$volid' is not possible\n";
3711 die "can't snapshot volume '$volid'\n";
3716 $snap = $conf->{snapshots
}->{$snapname} = {};
3718 if ($save_vmstate && check_running
($vmid)) {
3719 $snap->{vmstate
} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
3722 &$snapshot_copy_config($conf, $snap);
3724 $snap->{snapstate
} = "prepare";
3725 $snap->{snaptime
} = time();
3726 $snap->{description
} = $comment if $comment;
3728 update_config_nolock
($vmid, $conf, 1);
3731 lock_config
($vmid, $updatefn);
3736 my $snapshot_commit = sub {
3737 my ($vmid, $snapname) = @_;
3739 my $updatefn = sub {
3741 my $conf = load_config
($vmid);
3743 die "missing snapshot lock\n"
3744 if !($conf->{lock} && $conf->{lock} eq 'snapshot');
3746 my $snap = $conf->{snapshots
}->{$snapname};
3748 die "snapshot '$snapname' does not exist\n" if !defined($snap);
3750 die "wrong snapshot state\n"
3751 if !($snap->{snapstate
} && $snap->{snapstate
} eq "prepare");
3753 delete $snap->{snapstate
};
3754 delete $conf->{lock};
3756 my $newconf = &$snapshot_apply_config($conf, $snap);
3758 $newconf->{parent
} = $snapname;
3760 update_config_nolock
($vmid, $newconf, 1);
3763 lock_config
($vmid, $updatefn);
3766 sub snapshot_rollback
{
3767 my ($vmid, $snapname) = @_;
3773 my $updatefn = sub {
3775 my $conf = load_config
($vmid);
3777 check_lock
($conf) if $prepare;
3779 die "unable to rollback vm $vmid: vm is running\n"
3780 if check_running
($vmid);
3783 $conf->{lock} = 'rollback';
3785 die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
3786 delete $conf->{lock};
3789 $snap = $conf->{snapshots
}->{$snapname};
3791 die "snapshot '$snapname' does not exist\n" if !defined($snap);
3793 die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
3794 if $snap->{snapstate
};
3797 # copy snapshot config to current config
3798 $conf = &$snapshot_apply_config($conf, $snap);
3799 $conf->{parent
} = $snapname;
3802 update_config_nolock
($vmid, $conf, 1);
3805 lock_config
($vmid, $updatefn);
3807 my $storecfg = PVE
::Storage
::config
();
3809 foreach_drive
($snap, sub {
3810 my ($ds, $drive) = @_;
3812 return if drive_is_cdrom
($drive);
3814 my $volid = $drive->{file
};
3815 my $device = "drive-$ds";
3817 PVE
::Storage
::volume_snapshot_rollback
($storecfg, $volid, $snapname);
3821 lock_config
($vmid, $updatefn);
3824 sub snapshot_create
{
3825 my ($vmid, $snapname, $save_vmstate, $freezefs, $comment) = @_;
3827 my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
3829 $freezefs = $save_vmstate = 0 if !$snap->{vmstate
}; # vm is not running
3833 my $running = check_running
($vmid);
3836 # create internal snapshots of all drives
3838 qemu_snapshot_start
($vmid, $snapname) if $running;
3840 qga_freezefs
($vmid) if $running && $freezefs;
3842 my $storecfg = PVE
::Storage
::config
();
3844 foreach_drive
($snap, sub {
3845 my ($ds, $drive) = @_;
3847 return if drive_is_cdrom
($drive);
3849 my $volid = $drive->{file
};
3850 my $device = "drive-$ds";
3852 qemu_volume_snapshot
($vmid, $device, $storecfg, $volid, $snapname);
3853 $drivehash->{$ds} = 1;
3858 eval { gqa_unfreezefs
($vmid) if $running && $freezefs; };
3861 eval { qemu_snapshot_end
($vmid) if $running; };
3865 warn "snapshot create failed: starting cleanup\n";
3866 eval { snapshot_delete
($vmid, $snapname, 0, $drivehash); };
3871 &$snapshot_commit($vmid, $snapname);
3874 # Note: $drivehash is only set when called from snapshot_create.
3875 sub snapshot_delete
{
3876 my ($vmid, $snapname, $force, $drivehash) = @_;
3883 my $unlink_parent = sub {
3884 my ($confref, $new_parent) = @_;
3886 if ($confref->{parent
} && $confref->{parent
} eq $snapname) {
3888 $confref->{parent
} = $new_parent;
3890 delete $confref->{parent
};
3895 my $updatefn = sub {
3896 my ($remove_drive) = @_;
3898 my $conf = load_config
($vmid);
3900 check_lock
($conf) if !$drivehash;
3902 $snap = $conf->{snapshots
}->{$snapname};
3904 die "snapshot '$snapname' does not exist\n" if !defined($snap);
3906 # remove parent refs
3907 &$unlink_parent($conf, $snap->{parent
});
3908 foreach my $sn (keys %{$conf->{snapshots
}}) {
3909 next if $sn eq $snapname;
3910 &$unlink_parent($conf->{snapshots
}->{$sn}, $snap->{parent
});
3913 if ($remove_drive) {
3914 if ($remove_drive eq 'vmstate') {
3915 delete $snap->{$remove_drive};
3917 my $drive = parse_drive
($remove_drive, $snap->{$remove_drive});
3918 my $volid = $drive->{file
};
3919 delete $snap->{$remove_drive};
3920 add_unused_volume
($conf, $volid);
3925 $snap->{snapstate
} = 'delete';
3927 delete $conf->{snapshots
}->{$snapname};
3928 delete $conf->{lock} if $drivehash;
3929 foreach my $volid (@$unused) {
3930 add_unused_volume
($conf, $volid);
3934 update_config_nolock
($vmid, $conf, 1);
3937 lock_config
($vmid, $updatefn);
3939 # now remove vmstate file
3941 my $storecfg = PVE
::Storage
::config
();
3943 if ($snap->{vmstate
}) {
3944 eval { PVE
::Storage
::vdisk_free
($storecfg, $snap->{vmstate
}); };
3946 die $err if !$force;
3949 # save changes (remove vmstate from snapshot)
3950 lock_config
($vmid, $updatefn, 'vmstate') if !$force;
3953 # now remove all internal snapshots
3954 foreach_drive
($snap, sub {
3955 my ($ds, $drive) = @_;
3957 return if drive_is_cdrom
($drive);
3959 my $volid = $drive->{file
};
3960 my $device = "drive-$ds";
3962 if (!$drivehash || $drivehash->{$ds}) {
3963 eval { qemu_volume_snapshot_delete
($vmid, $device, $storecfg, $volid, $snapname); };
3965 die $err if !$force;
3970 # save changes (remove drive fron snapshot)
3971 lock_config
($vmid, $updatefn, $ds) if !$force;
3972 push @$unused, $volid;
3975 # now cleanup config
3977 lock_config
($vmid, $updatefn);