1 package PVE
::QemuServer
;
22 use Storable
qw(dclone);
23 use PVE
::Exception
qw(raise raise_param_exc);
25 use PVE
::Tools
qw(run_command lock_file lock_file_full file_read_firstline dir_glob_foreach);
26 use PVE
::JSONSchema
qw(get_standard_option);
27 use PVE
::Cluster
qw(cfs_register_file cfs_read_file cfs_write_file cfs_lock_file);
31 use PVE
::RPCEnvironment
;
32 use Time
::HiRes
qw(gettimeofday);
34 my $cpuinfo = PVE
::ProcFSTools
::read_cpuinfo
();
36 # Note about locking: we use flock on the config file protect
37 # against concurent actions.
38 # Aditionaly, we have a 'lock' setting in the config file. This
39 # can be set to 'migrate', 'backup', 'snapshot' or 'rollback'. Most actions are not
40 # allowed when such lock is set. But you can ignore this kind of
41 # lock with the --skiplock flag.
43 cfs_register_file
('/qemu-server/',
47 PVE
::JSONSchema
::register_standard_option
('skiplock', {
48 description
=> "Ignore locks - only root is allowed to use this option.",
53 PVE
::JSONSchema
::register_standard_option
('pve-qm-stateuri', {
54 description
=> "Some command save/restore state from this location.",
60 PVE
::JSONSchema
::register_standard_option
('pve-snapshot-name', {
61 description
=> "The name of the snapshot.",
62 type
=> 'string', format
=> 'pve-configid',
66 #no warnings 'redefine';
68 unless(defined(&_VZSYSCALLS_H_
)) {
69 eval 'sub _VZSYSCALLS_H_ () {1;}' unless defined(&_VZSYSCALLS_H_
);
70 require 'sys/syscall.ph';
71 if(defined(&__x86_64__
)) {
72 eval 'sub __NR_fairsched_vcpus () {499;}' unless defined(&__NR_fairsched_vcpus
);
73 eval 'sub __NR_fairsched_mknod () {504;}' unless defined(&__NR_fairsched_mknod
);
74 eval 'sub __NR_fairsched_rmnod () {505;}' unless defined(&__NR_fairsched_rmnod
);
75 eval 'sub __NR_fairsched_chwt () {506;}' unless defined(&__NR_fairsched_chwt
);
76 eval 'sub __NR_fairsched_mvpr () {507;}' unless defined(&__NR_fairsched_mvpr
);
77 eval 'sub __NR_fairsched_rate () {508;}' unless defined(&__NR_fairsched_rate
);
78 eval 'sub __NR_setluid () {501;}' unless defined(&__NR_setluid
);
79 eval 'sub __NR_setublimit () {502;}' unless defined(&__NR_setublimit
);
81 elsif(defined( &__i386__
) ) {
82 eval 'sub __NR_fairsched_mknod () {500;}' unless defined(&__NR_fairsched_mknod
);
83 eval 'sub __NR_fairsched_rmnod () {501;}' unless defined(&__NR_fairsched_rmnod
);
84 eval 'sub __NR_fairsched_chwt () {502;}' unless defined(&__NR_fairsched_chwt
);
85 eval 'sub __NR_fairsched_mvpr () {503;}' unless defined(&__NR_fairsched_mvpr
);
86 eval 'sub __NR_fairsched_rate () {504;}' unless defined(&__NR_fairsched_rate
);
87 eval 'sub __NR_fairsched_vcpus () {505;}' unless defined(&__NR_fairsched_vcpus
);
88 eval 'sub __NR_setluid () {511;}' unless defined(&__NR_setluid
);
89 eval 'sub __NR_setublimit () {512;}' unless defined(&__NR_setublimit
);
91 die("no fairsched syscall for this arch");
93 require 'asm/ioctl.ph';
94 eval 'sub KVM_GET_API_VERSION () { &_IO(0xAE, 0x);}' unless defined(&KVM_GET_API_VERSION
);
98 my ($parent, $weight, $desired) = @_;
100 return syscall(&__NR_fairsched_mknod
, int($parent), int($weight), int($desired));
103 sub fairsched_rmnod
{
106 return syscall(&__NR_fairsched_rmnod
, int($id));
110 my ($pid, $newid) = @_;
112 return syscall(&__NR_fairsched_mvpr
, int($pid), int($newid));
115 sub fairsched_vcpus
{
116 my ($id, $vcpus) = @_;
118 return syscall(&__NR_fairsched_vcpus
, int($id), int($vcpus));
122 my ($id, $op, $rate) = @_;
124 return syscall(&__NR_fairsched_rate
, int($id), int($op), int($rate));
127 use constant FAIRSCHED_SET_RATE
=> 0;
128 use constant FAIRSCHED_DROP_RATE
=> 1;
129 use constant FAIRSCHED_GET_RATE
=> 2;
131 sub fairsched_cpulimit
{
132 my ($id, $limit) = @_;
134 my $cpulim1024 = int($limit * 1024 / 100);
135 my $op = $cpulim1024 ? FAIRSCHED_SET_RATE
: FAIRSCHED_DROP_RATE
;
137 return fairsched_rate
($id, $op, $cpulim1024);
140 my $nodename = PVE
::INotify
::nodename
();
142 mkdir "/etc/pve/nodes/$nodename";
143 my $confdir = "/etc/pve/nodes/$nodename/qemu-server";
146 my $var_run_tmpdir = "/var/run/qemu-server";
147 mkdir $var_run_tmpdir;
149 my $lock_dir = "/var/lock/qemu-server";
152 my $pcisysfs = "/sys/bus/pci";
158 description
=> "Specifies whether a VM will be started during system bootup.",
164 description
=> "Automatic restart after crash (currently ignored).",
169 type
=> 'string', format
=> 'pve-hotplug-features',
170 description
=> "Selectively enable hotplug features. This is a comma separated list of hotplug features: 'network', 'disk', 'cpu', 'memory' and 'usb'. Use '0' to disable hotplug completely. Value '1' is an alias for the default 'network,disk,usb'.",
171 default => 'network,disk,usb',
176 description
=> "Allow reboot. If set to '0' the VM exit on reboot.",
182 description
=> "Lock/unlock the VM.",
183 enum
=> [qw(migrate backup snapshot rollback)],
188 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.",
195 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.",
203 description
=> "Amount of RAM for the VM in MB. This is the maximum available memory when you use the balloon device.",
210 description
=> "Amount of target RAM for the VM in MB. Using zero disables the ballon driver.",
216 description
=> "Amount of memory shares for auto-ballooning. The larger the number is, the more memory this VM gets. Number is relative to weights of all other running VMs. Using zero disables auto-ballooning",
224 description
=> "Keybord layout for vnc server. Default is read from the datacenter configuration file.",
225 enum
=> PVE
::Tools
::kvmkeymaplist
(),
230 type
=> 'string', format
=> 'dns-name',
231 description
=> "Set a name for the VM. Only used on the configuration web interface.",
236 description
=> "scsi controller model",
237 enum
=> [qw(lsi lsi53c810 virtio-scsi-pci megasas pvscsi)],
243 description
=> "Description for the VM. Only used on the configuration web interface. This is saved as comment inside the configuration file.",
248 enum
=> [qw(other wxp w2k w2k3 w2k8 wvista win7 win8 l24 l26 solaris)],
249 description
=> <<EODESC,
250 Used to enable special optimization/features for specific
253 other => unspecified OS
254 wxp => Microsoft Windows XP
255 w2k => Microsoft Windows 2000
256 w2k3 => Microsoft Windows 2003
257 w2k8 => Microsoft Windows 2008
258 wvista => Microsoft Windows Vista
259 win7 => Microsoft Windows 7
260 win8 => Microsoft Windows 8/2012
261 l24 => Linux 2.4 Kernel
262 l26 => Linux 2.6/3.X Kernel
263 solaris => solaris/opensolaris/openindiania kernel
265 other|l24|l26|solaris ... no special behaviour
266 wxp|w2k|w2k3|w2k8|wvista|win7|win8 ... use --localtime switch
272 description
=> "Boot on floppy (a), hard disk (c), CD-ROM (d), or network (n).",
273 pattern
=> '[acdn]{1,4}',
278 type
=> 'string', format
=> 'pve-qm-bootdisk',
279 description
=> "Enable booting from specified disk.",
280 pattern
=> '(ide|sata|scsi|virtio)\d+',
285 description
=> "The number of CPUs. Please use option -sockets instead.",
292 description
=> "The number of CPU sockets.",
299 description
=> "The number of cores per socket.",
306 description
=> "Enable/disable Numa.",
312 description
=> "Number of hotplugged vcpus.",
319 description
=> "Enable/disable ACPI.",
325 description
=> "Enable/disable Qemu GuestAgent.",
331 description
=> "Enable/disable KVM hardware virtualization.",
337 description
=> "Enable/disable time drift fix.",
343 description
=> "Set the real time clock to local time. This is enabled by default if ostype indicates a Microsoft OS.",
348 description
=> "Freeze CPU at startup (use 'c' monitor command to start execution).",
353 description
=> "Select VGA type. If you want to use high resolution modes (>= 1280x1024x16) then you should use option 'std' or 'vmware'. Default is 'std' for win8/win7/w2k8, and 'cirrur' for other OS types. Option 'qxl' enables the SPICE display sever. You can also run without any graphic card using a serial devive as terminal.",
354 enum
=> [qw(std cirrus vmware qxl serial0 serial1 serial2 serial3 qxl2 qxl3 qxl4)],
358 type
=> 'string', format
=> 'pve-qm-watchdog',
359 typetext
=> '[[model=]i6300esb|ib700] [,[action=]reset|shutdown|poweroff|pause|debug|none]',
360 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)",
365 typetext
=> "(now | YYYY-MM-DD | YYYY-MM-DDTHH:MM:SS)",
366 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'.",
367 pattern
=> '(now|\d{4}-\d{1,2}-\d{1,2}(T\d{1,2}:\d{1,2}:\d{1,2})?)',
372 type
=> 'string', format
=> 'pve-qm-startup',
373 typetext
=> '[[order=]\d+] [,up=\d+] [,down=\d+] ',
374 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.",
379 description
=> "Enable/disable Template.",
385 description
=> <<EODESCR,
386 Note: this option is for experts only. It allows you to pass arbitrary arguments to kvm, for example:
388 args: -no-reboot -no-hpet
395 description
=> "Enable/disable the usb tablet device. This device is usually needed to allow absolute mouse positioning with VNC. 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. This is turned of by default if you use spice (vga=qxl).",
400 description
=> "Set maximum speed (in MB/s) for migrations. Value 0 is no limit.",
404 migrate_downtime
=> {
407 description
=> "Set maximum tolerated downtime (in seconds) for migrations.",
413 type
=> 'string', format
=> 'pve-qm-drive',
414 typetext
=> 'volume',
415 description
=> "This is an alias for option -ide2",
419 description
=> "Emulated CPU type.",
421 enum
=> [ qw(486 athlon pentium pentium2 pentium3 coreduo core2duo kvm32 kvm64 qemu32 qemu64 phenom Conroe Penryn Nehalem Westmere SandyBridge IvyBridge Haswell Broadwell Opteron_G1 Opteron_G2 Opteron_G3 Opteron_G4 Opteron_G5 host) ],
424 parent
=> get_standard_option
('pve-snapshot-name', {
426 description
=> "Parent snapshot name. This is used internally, and should not be modified.",
430 description
=> "Timestamp for snapshots.",
436 type
=> 'string', format
=> 'pve-volume-id',
437 description
=> "Reference to a volume which stores the VM state. This is used internally for snapshots.",
440 description
=> "Specific the Qemu machine type.",
442 pattern
=> '(pc|pc(-i440fx)?-\d+\.\d+|q35|pc-q35-\d+\.\d+)',
447 description
=> "Specify SMBIOS type 1 fields.",
448 type
=> 'string', format
=> 'pve-qm-smbios1',
449 typetext
=> "[manufacturer=str][,product=str][,version=str][,serial=str] [,uuid=uuid][,sku=str][,family=str]",
455 # what about other qemu settings ?
457 #machine => 'string',
470 ##soundhw => 'string',
472 while (my ($k, $v) = each %$confdesc) {
473 PVE
::JSONSchema
::register_standard_option
("pve-qm-$k", $v);
476 my $MAX_IDE_DISKS = 4;
477 my $MAX_SCSI_DISKS = 14;
478 my $MAX_VIRTIO_DISKS = 16;
479 my $MAX_SATA_DISKS = 6;
480 my $MAX_USB_DEVICES = 5;
482 my $MAX_UNUSED_DISKS = 8;
483 my $MAX_HOSTPCI_DEVICES = 4;
484 my $MAX_SERIAL_PORTS = 4;
485 my $MAX_PARALLEL_PORTS = 3;
487 my $MAX_MEM = 4194304;
488 my $STATICMEM = 1024;
492 type
=> 'string', format
=> 'pve-qm-numanode',
493 typetext
=> "cpus=<id[-id],memory=<mb>[[,hostnodes=<id[-id]>] [,policy=<preferred|bind|interleave>]]",
494 description
=> "numa topology",
496 PVE
::JSONSchema
::register_standard_option
("pve-qm-numanode", $numadesc);
498 for (my $i = 0; $i < $MAX_NUMA; $i++) {
499 $confdesc->{"numa$i"} = $numadesc;
502 my $nic_model_list = ['rtl8139', 'ne2k_pci', 'e1000', 'pcnet', 'virtio',
503 'ne2k_isa', 'i82551', 'i82557b', 'i82559er', 'vmxnet3',
504 'e1000-82540em', 'e1000-82544gc', 'e1000-82545em'];
505 my $nic_model_list_txt = join(' ', sort @$nic_model_list);
509 type
=> 'string', format
=> 'pve-qm-net',
510 typetext
=> "MODEL=XX:XX:XX:XX:XX:XX [,bridge=<dev>][,queues=<nbqueues>][,rate=<mbps>] [,tag=<vlanid>][,firewall=0|1],link_down=0|1]",
511 description
=> <<EODESCR,
512 Specify network devices.
514 MODEL is one of: $nic_model_list_txt
516 XX:XX:XX:XX:XX:XX should be an unique MAC address. This is
517 automatically generated if not specified.
519 The bridge parameter can be used to automatically add the interface to a bridge device. The Proxmox VE standard bridge is called 'vmbr0'.
521 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'.
523 If you specify no bridge, we create a kvm 'user' (NATed) network device, which provides DHCP and DNS services. The following addresses are used:
529 The DHCP server assign addresses to the guest starting from 10.0.2.15.
533 PVE
::JSONSchema
::register_standard_option
("pve-qm-net", $netdesc);
535 for (my $i = 0; $i < $MAX_NETS; $i++) {
536 $confdesc->{"net$i"} = $netdesc;
543 type
=> 'string', format
=> 'pve-qm-drive',
544 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] [,discard=ignore|on]',
545 description
=> "Use volume as IDE hard disk or CD-ROM (n is 0 to " .($MAX_IDE_DISKS -1) . ").",
547 PVE
::JSONSchema
::register_standard_option
("pve-qm-ide", $idedesc);
551 type
=> 'string', format
=> 'pve-qm-drive',
552 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] [,discard=ignore|on]',
553 description
=> "Use volume as SCSI hard disk or CD-ROM (n is 0 to " . ($MAX_SCSI_DISKS - 1) . ").",
555 PVE
::JSONSchema
::register_standard_option
("pve-qm-scsi", $scsidesc);
559 type
=> 'string', format
=> 'pve-qm-drive',
560 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] [,discard=ignore|on]',
561 description
=> "Use volume as SATA hard disk or CD-ROM (n is 0 to " . ($MAX_SATA_DISKS - 1). ").",
563 PVE
::JSONSchema
::register_standard_option
("pve-qm-sata", $satadesc);
567 type
=> 'string', format
=> 'pve-qm-drive',
568 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] [,discard=ignore|on] [,iothread=on]',
569 description
=> "Use volume as VIRTIO hard disk (n is 0 to " . ($MAX_VIRTIO_DISKS - 1) . ").",
571 PVE
::JSONSchema
::register_standard_option
("pve-qm-virtio", $virtiodesc);
575 type
=> 'string', format
=> 'pve-qm-usb-device',
576 typetext
=> 'host=HOSTUSBDEVICE|spice',
577 description
=> <<EODESCR,
578 Configure an USB device (n is 0 to 4). This can be used to
579 pass-through usb devices to the guest. HOSTUSBDEVICE syntax is:
581 'bus-port(.port)*' (decimal numbers) or
582 'vendor_id:product_id' (hexadeciaml numbers)
584 You can use the 'lsusb -t' command to list existing usb devices.
586 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
588 The value 'spice' can be used to add a usb redirection devices for spice.
592 PVE
::JSONSchema
::register_standard_option
("pve-qm-usb", $usbdesc);
596 type
=> 'string', format
=> 'pve-qm-hostpci',
597 typetext
=> "[host=]HOSTPCIDEVICE [,driver=kvm|vfio] [,rombar=on|off] [,pcie=0|1] [,x-vga=on|off]",
598 description
=> <<EODESCR,
599 Map host pci devices. HOSTPCIDEVICE syntax is:
601 'bus:dev.func' (hexadecimal numbers)
603 You can us the 'lspci' command to list existing pci devices.
605 The 'rombar' option determines whether or not the device's ROM will be visible in the guest's memory map (default is 'on').
607 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
609 Experimental: user reported problems with this option.
612 PVE
::JSONSchema
::register_standard_option
("pve-qm-hostpci", $hostpcidesc);
617 pattern
=> '(/dev/.+|socket)',
618 description
=> <<EODESCR,
619 Create a serial device inside the VM (n is 0 to 3), and pass through a host serial device (i.e. /dev/ttyS0), or create a unix socket on the host side (use 'qm terminal' to open a terminal connection).
621 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
623 Experimental: user reported problems with this option.
630 pattern
=> '/dev/parport\d+|/dev/usb/lp\d+',
631 description
=> <<EODESCR,
632 Map host parallel devices (n is 0 to 2).
634 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
636 Experimental: user reported problems with this option.
640 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
641 $confdesc->{"parallel$i"} = $paralleldesc;
644 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
645 $confdesc->{"serial$i"} = $serialdesc;
648 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
649 $confdesc->{"hostpci$i"} = $hostpcidesc;
652 for (my $i = 0; $i < $MAX_IDE_DISKS; $i++) {
653 $drivename_hash->{"ide$i"} = 1;
654 $confdesc->{"ide$i"} = $idedesc;
657 for (my $i = 0; $i < $MAX_SATA_DISKS; $i++) {
658 $drivename_hash->{"sata$i"} = 1;
659 $confdesc->{"sata$i"} = $satadesc;
662 for (my $i = 0; $i < $MAX_SCSI_DISKS; $i++) {
663 $drivename_hash->{"scsi$i"} = 1;
664 $confdesc->{"scsi$i"} = $scsidesc ;
667 for (my $i = 0; $i < $MAX_VIRTIO_DISKS; $i++) {
668 $drivename_hash->{"virtio$i"} = 1;
669 $confdesc->{"virtio$i"} = $virtiodesc;
672 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
673 $confdesc->{"usb$i"} = $usbdesc;
678 type
=> 'string', format
=> 'pve-volume-id',
679 description
=> "Reference to unused volumes.",
682 for (my $i = 0; $i < $MAX_UNUSED_DISKS; $i++) {
683 $confdesc->{"unused$i"} = $unuseddesc;
686 my $kvm_api_version = 0;
690 return $kvm_api_version if $kvm_api_version;
692 my $fh = IO
::File-
>new("</dev/kvm") ||
695 if (my $v = $fh->ioctl(KVM_GET_API_VERSION
(), 0)) {
696 $kvm_api_version = $v;
701 return $kvm_api_version;
704 my $kvm_user_version;
706 sub kvm_user_version
{
708 return $kvm_user_version if $kvm_user_version;
710 $kvm_user_version = 'unknown';
712 my $tmp = `kvm -help 2>/dev/null`;
714 if ($tmp =~ m/^QEMU( PC)? emulator version (\d+\.\d+(\.\d+)?)[,\s]/) {
715 $kvm_user_version = $2;
718 return $kvm_user_version;
722 my $kernel_has_vhost_net = -c
'/dev/vhost-net';
725 # order is important - used to autoselect boot disk
726 return ((map { "ide$_" } (0 .. ($MAX_IDE_DISKS - 1))),
727 (map { "scsi$_" } (0 .. ($MAX_SCSI_DISKS - 1))),
728 (map { "virtio$_" } (0 .. ($MAX_VIRTIO_DISKS - 1))),
729 (map { "sata$_" } (0 .. ($MAX_SATA_DISKS - 1))));
732 sub valid_drivename
{
735 return defined($drivename_hash->{$dev});
740 return defined($confdesc->{$key});
744 return $nic_model_list;
747 sub os_list_description
{
752 w2k
=> 'Windows 2000',
753 w2k3
=>, 'Windows 2003',
754 w2k8
=> 'Windows 2008',
755 wvista
=> 'Windows Vista',
757 win8
=> 'Windows 8/2012',
767 return $cdrom_path if $cdrom_path;
769 return $cdrom_path = "/dev/cdrom" if -l
"/dev/cdrom";
770 return $cdrom_path = "/dev/cdrom1" if -l
"/dev/cdrom1";
771 return $cdrom_path = "/dev/cdrom2" if -l
"/dev/cdrom2";
775 my ($storecfg, $vmid, $cdrom) = @_;
777 if ($cdrom eq 'cdrom') {
778 return get_cdrom_path
();
779 } elsif ($cdrom eq 'none') {
781 } elsif ($cdrom =~ m
|^/|) {
784 return PVE
::Storage
::path
($storecfg, $cdrom);
788 # try to convert old style file names to volume IDs
789 sub filename_to_volume_id
{
790 my ($vmid, $file, $media) = @_;
792 if (!($file eq 'none' || $file eq 'cdrom' ||
793 $file =~ m
|^/dev/.+| || $file =~ m/^([^:]+):(.+)$/)) {
795 return undef if $file =~ m
|/|;
797 if ($media && $media eq 'cdrom') {
798 $file = "local:iso/$file";
800 $file = "local:$vmid/$file";
807 sub verify_media_type
{
808 my ($opt, $vtype, $media) = @_;
813 if ($media eq 'disk') {
815 } elsif ($media eq 'cdrom') {
818 die "internal error";
821 return if ($vtype eq $etype);
823 raise_param_exc
({ $opt => "unexpected media type ($vtype != $etype)" });
826 sub cleanup_drive_path
{
827 my ($opt, $storecfg, $drive) = @_;
829 # try to convert filesystem paths to volume IDs
831 if (($drive->{file
} !~ m/^(cdrom|none)$/) &&
832 ($drive->{file
} !~ m
|^/dev/.+|) &&
833 ($drive->{file
} !~ m/^([^:]+):(.+)$/) &&
834 ($drive->{file
} !~ m/^\d+$/)) {
835 my ($vtype, $volid) = PVE
::Storage
::path_to_volume_id
($storecfg, $drive->{file
});
836 raise_param_exc
({ $opt => "unable to associate path '$drive->{file}' to any storage"}) if !$vtype;
837 $drive->{media
} = 'cdrom' if !$drive->{media
} && $vtype eq 'iso';
838 verify_media_type
($opt, $vtype, $drive->{media
});
839 $drive->{file
} = $volid;
842 $drive->{media
} = 'cdrom' if !$drive->{media
} && $drive->{file
} =~ m/^(cdrom|none)$/;
845 sub create_conf_nolock
{
846 my ($vmid, $settings) = @_;
848 my $filename = config_file
($vmid);
850 die "configuration file '$filename' already exists\n" if -f
$filename;
852 my $defaults = load_defaults
();
854 $settings->{name
} = "vm$vmid" if !$settings->{name
};
855 $settings->{memory
} = $defaults->{memory
} if !$settings->{memory
};
858 foreach my $opt (keys %$settings) {
859 next if !$confdesc->{$opt};
861 my $value = $settings->{$opt};
864 $data .= "$opt: $value\n";
867 PVE
::Tools
::file_set_contents
($filename, $data);
870 sub parse_hotplug_features
{
875 return $res if $data eq '0';
877 $data = $confdesc->{hotplug
}->{default} if $data eq '1';
879 foreach my $feature (PVE
::Tools
::split_list
($data)) {
880 if ($feature =~ m/^(network|disk|cpu|memory|usb)$/) {
883 warn "ignoring unknown hotplug feature '$feature'\n";
889 PVE
::JSONSchema
::register_format
('pve-hotplug-features', \
&pve_verify_hotplug_features
);
890 sub pve_verify_hotplug_features
{
891 my ($value, $noerr) = @_;
893 return $value if parse_hotplug_features
($value);
895 return undef if $noerr;
897 die "unable to parse hotplug option\n";
900 my $parse_size = sub {
903 return undef if $value !~ m/^(\d+(\.\d+)?)([KMG])?$/;
904 my ($size, $unit) = ($1, $3);
907 $size = $size * 1024;
908 } elsif ($unit eq 'M') {
909 $size = $size * 1024 * 1024;
910 } elsif ($unit eq 'G') {
911 $size = $size * 1024 * 1024 * 1024;
917 my $format_size = sub {
922 my $kb = int($size/1024);
923 return $size if $kb*1024 != $size;
925 my $mb = int($kb/1024);
926 return "${kb}K" if $mb*1024 != $kb;
928 my $gb = int($mb/1024);
929 return "${mb}M" if $gb*1024 != $mb;
934 # ideX = [volume=]volume-id[,media=d][,cyls=c,heads=h,secs=s[,trans=t]]
935 # [,snapshot=on|off][,cache=on|off][,format=f][,backup=yes|no]
936 # [,rerror=ignore|report|stop][,werror=enospc|ignore|report|stop]
937 # [,aio=native|threads][,discard=ignore|on][,iothread=on]
940 my ($key, $data) = @_;
944 # $key may be undefined - used to verify JSON parameters
945 if (!defined($key)) {
946 $res->{interface
} = 'unknown'; # should not harm when used to verify parameters
948 } elsif ($key =~ m/^([^\d]+)(\d+)$/) {
949 $res->{interface
} = $1;
955 foreach my $p (split (/,/, $data)) {
956 next if $p =~ m/^\s*$/;
958 if ($p =~ m/^(file|volume|cyls|heads|secs|trans|media|snapshot|cache|format|rerror|werror|backup|aio|bps|mbps|mbps_max|bps_rd|mbps_rd|mbps_rd_max|bps_wr|mbps_wr|mbps_wr_max|iops|iops_max|iops_rd|iops_rd_max|iops_wr|iops_wr_max|size|discard|iothread)=(.+)$/) {
959 my ($k, $v) = ($1, $2);
961 $k = 'file' if $k eq 'volume';
963 return undef if defined $res->{$k};
965 if ($k eq 'bps' || $k eq 'bps_rd' || $k eq 'bps_wr') {
966 return undef if !$v || $v !~ m/^\d+/;
968 $v = sprintf("%.3f", $v / (1024*1024));
972 if (!$res->{file
} && $p !~ m/=/) {
980 return undef if !$res->{file
};
982 if($res->{file
} =~ m/\.(raw|cow|qcow|qcow2|vmdk|cloop)$/){
986 return undef if $res->{cache
} &&
987 $res->{cache
} !~ m/^(off|none|writethrough|writeback|unsafe|directsync)$/;
988 return undef if $res->{snapshot
} && $res->{snapshot
} !~ m/^(on|off)$/;
989 return undef if $res->{cyls
} && $res->{cyls
} !~ m/^\d+$/;
990 return undef if $res->{heads
} && $res->{heads
} !~ m/^\d+$/;
991 return undef if $res->{secs
} && $res->{secs
} !~ m/^\d+$/;
992 return undef if $res->{media
} && $res->{media
} !~ m/^(disk|cdrom)$/;
993 return undef if $res->{trans
} && $res->{trans
} !~ m/^(none|lba|auto)$/;
994 return undef if $res->{format
} && $res->{format
} !~ m/^(raw|cow|qcow|qcow2|vmdk|cloop)$/;
995 return undef if $res->{rerror
} && $res->{rerror
} !~ m/^(ignore|report|stop)$/;
996 return undef if $res->{werror
} && $res->{werror
} !~ m/^(enospc|ignore|report|stop)$/;
997 return undef if $res->{backup
} && $res->{backup
} !~ m/^(yes|no)$/;
998 return undef if $res->{aio
} && $res->{aio
} !~ m/^(native|threads)$/;
999 return undef if $res->{discard
} && $res->{discard
} !~ m/^(ignore|on)$/;
1000 return undef if $res->{iothread
} && $res->{iothread
} !~ m/^(on)$/;
1002 return undef if $res->{mbps_rd
} && $res->{mbps
};
1003 return undef if $res->{mbps_wr
} && $res->{mbps
};
1005 return undef if $res->{mbps
} && $res->{mbps
} !~ m/^\d+(\.\d+)?$/;
1006 return undef if $res->{mbps_max
} && $res->{mbps_max
} !~ m/^\d+(\.\d+)?$/;
1007 return undef if $res->{mbps_rd
} && $res->{mbps_rd
} !~ m/^\d+(\.\d+)?$/;
1008 return undef if $res->{mbps_rd_max
} && $res->{mbps_rd_max
} !~ m/^\d+(\.\d+)?$/;
1009 return undef if $res->{mbps_wr
} && $res->{mbps_wr
} !~ m/^\d+(\.\d+)?$/;
1010 return undef if $res->{mbps_wr_max
} && $res->{mbps_wr_max
} !~ m/^\d+(\.\d+)?$/;
1012 return undef if $res->{iops_rd
} && $res->{iops
};
1013 return undef if $res->{iops_wr
} && $res->{iops
};
1016 return undef if $res->{iops
} && $res->{iops
} !~ m/^\d+$/;
1017 return undef if $res->{iops_max
} && $res->{iops_max
} !~ m/^\d+$/;
1018 return undef if $res->{iops_rd
} && $res->{iops_rd
} !~ m/^\d+$/;
1019 return undef if $res->{iops_rd_max
} && $res->{iops_rd_max
} !~ m/^\d+$/;
1020 return undef if $res->{iops_wr
} && $res->{iops_wr
} !~ m/^\d+$/;
1021 return undef if $res->{iops_wr_max
} && $res->{iops_wr_max
} !~ m/^\d+$/;
1025 return undef if !defined($res->{size
} = &$parse_size($res->{size
}));
1028 if ($res->{media
} && ($res->{media
} eq 'cdrom')) {
1029 return undef if $res->{snapshot
} || $res->{trans
} || $res->{format
};
1030 return undef if $res->{heads
} || $res->{secs
} || $res->{cyls
};
1031 return undef if $res->{interface
} eq 'virtio';
1034 # rerror does not work with scsi drives
1035 if ($res->{rerror
}) {
1036 return undef if $res->{interface
} eq 'scsi';
1042 my @qemu_drive_options = qw(heads secs cyls trans media format cache snapshot rerror werror aio discard iops iops_rd iops_wr iops_max iops_rd_max iops_wr_max);
1045 my ($vmid, $drive) = @_;
1048 foreach my $o (@qemu_drive_options, 'mbps', 'mbps_rd', 'mbps_wr', 'mbps_max', 'mbps_rd_max', 'mbps_wr_max', 'backup', 'iothread') {
1049 $opts .= ",$o=$drive->{$o}" if $drive->{$o};
1052 if ($drive->{size
}) {
1053 $opts .= ",size=" . &$format_size($drive->{size
});
1056 return "$drive->{file}$opts";
1060 my($fh, $noerr) = @_;
1063 my $SG_GET_VERSION_NUM = 0x2282;
1065 my $versionbuf = "\x00" x
8;
1066 my $ret = ioctl($fh, $SG_GET_VERSION_NUM, $versionbuf);
1068 die "scsi ioctl SG_GET_VERSION_NUM failoed - $!\n" if !$noerr;
1071 my $version = unpack("I", $versionbuf);
1072 if ($version < 30000) {
1073 die "scsi generic interface too old\n" if !$noerr;
1077 my $buf = "\x00" x
36;
1078 my $sensebuf = "\x00" x
8;
1079 my $cmd = pack("C x3 C x1", 0x12, 36);
1081 # see /usr/include/scsi/sg.h
1082 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";
1084 my $packet = pack($sg_io_hdr_t, ord('S'), -3, length($cmd),
1085 length($sensebuf), 0, length($buf), $buf,
1086 $cmd, $sensebuf, 6000);
1088 $ret = ioctl($fh, $SG_IO, $packet);
1090 die "scsi ioctl SG_IO failed - $!\n" if !$noerr;
1094 my @res = unpack($sg_io_hdr_t, $packet);
1095 if ($res[17] || $res[18]) {
1096 die "scsi ioctl SG_IO status error - $!\n" if !$noerr;
1101 (my $byte0, my $byte1, $res->{vendor
},
1102 $res->{product
}, $res->{revision
}) = unpack("C C x6 A8 A16 A4", $buf);
1104 $res->{removable
} = $byte1 & 128 ?
1 : 0;
1105 $res->{type
} = $byte0 & 31;
1113 my $fh = IO
::File-
>new("+<$path") || return undef;
1114 my $res = scsi_inquiry
($fh, 1);
1120 sub machine_type_is_q35
{
1123 return $conf->{machine
} && ($conf->{machine
} =~ m/q35/) ?
1 : 0;
1126 sub print_tabletdevice_full
{
1129 my $q35 = machine_type_is_q35
($conf);
1131 # we use uhci for old VMs because tablet driver was buggy in older qemu
1132 my $usbbus = $q35 ?
"ehci" : "uhci";
1134 return "usb-tablet,id=tablet,bus=$usbbus.0,port=1";
1137 sub print_drivedevice_full
{
1138 my ($storecfg, $conf, $vmid, $drive, $bridges) = @_;
1143 if ($drive->{interface
} eq 'virtio') {
1144 my $pciaddr = print_pci_addr
("$drive->{interface}$drive->{index}", $bridges);
1145 $device = "virtio-blk-pci,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}$pciaddr";
1146 $device .= ",iothread=iothread-$drive->{interface}$drive->{index}" if $drive->{iothread
};
1147 } elsif ($drive->{interface
} eq 'scsi') {
1148 $maxdev = ($conf->{scsihw
} && ($conf->{scsihw
} !~ m/^lsi/)) ?
256 : 7;
1149 my $controller = int($drive->{index} / $maxdev);
1150 my $unit = $drive->{index} % $maxdev;
1151 my $devicetype = 'hd';
1153 if (drive_is_cdrom
($drive)) {
1156 if ($drive->{file
} =~ m
|^/|) {
1157 $path = $drive->{file
};
1159 $path = PVE
::Storage
::path
($storecfg, $drive->{file
});
1162 if($path =~ m/^iscsi\:\/\
//){
1163 $devicetype = 'generic';
1165 if (my $info = path_is_scsi
($path)) {
1166 if ($info->{type
} == 0) {
1167 $devicetype = 'block';
1168 } elsif ($info->{type
} == 1) { # tape
1169 $devicetype = 'generic';
1175 if (!$conf->{scsihw
} || ($conf->{scsihw
} =~ m/^lsi/)){
1176 $device = "scsi-$devicetype,bus=scsihw$controller.0,scsi-id=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1178 $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}";
1181 } elsif ($drive->{interface
} eq 'ide'){
1183 my $controller = int($drive->{index} / $maxdev);
1184 my $unit = $drive->{index} % $maxdev;
1185 my $devicetype = ($drive->{media
} && $drive->{media
} eq 'cdrom') ?
"cd" : "hd";
1187 $device = "ide-$devicetype,bus=ide.$controller,unit=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1188 } elsif ($drive->{interface
} eq 'sata'){
1189 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
1190 my $unit = $drive->{index} % $MAX_SATA_DISKS;
1191 $device = "ide-drive,bus=ahci$controller.$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1192 } elsif ($drive->{interface
} eq 'usb') {
1194 # -device ide-drive,bus=ide.1,unit=0,drive=drive-ide0-1-0,id=ide0-1-0
1196 die "unsupported interface type";
1199 $device .= ",bootindex=$drive->{bootindex}" if $drive->{bootindex
};
1204 sub get_initiator_name
{
1207 my $fh = IO
::File-
>new('/etc/iscsi/initiatorname.iscsi') || return undef;
1208 while (defined(my $line = <$fh>)) {
1209 next if $line !~ m/^\s*InitiatorName\s*=\s*([\.\-:\w]+)/;
1218 sub print_drive_full
{
1219 my ($storecfg, $vmid, $drive) = @_;
1222 foreach my $o (@qemu_drive_options) {
1223 next if $o eq 'bootindex';
1224 $opts .= ",$o=$drive->{$o}" if $drive->{$o};
1227 foreach my $o (qw(bps bps_rd bps_wr)) {
1228 my $v = $drive->{"m$o"};
1229 $opts .= ",$o=" . int($v*1024*1024) if $v;
1232 # use linux-aio by default (qemu default is threads)
1233 $opts .= ",aio=native" if !$drive->{aio
};
1236 my $volid = $drive->{file
};
1237 if (drive_is_cdrom
($drive)) {
1238 $path = get_iso_path
($storecfg, $vmid, $volid);
1240 if ($volid =~ m
|^/|) {
1243 $path = PVE
::Storage
::path
($storecfg, $volid);
1247 $opts .= ",cache=none" if !$drive->{cache
} && !drive_is_cdrom
($drive);
1249 my $detectzeroes = $drive->{discard
} ?
"unmap" : "on";
1250 $opts .= ",detect-zeroes=$detectzeroes" if !drive_is_cdrom
($drive);
1252 my $pathinfo = $path ?
"file=$path," : '';
1254 return "${pathinfo}if=none,id=drive-$drive->{interface}$drive->{index}$opts";
1257 sub print_netdevice_full
{
1258 my ($vmid, $conf, $net, $netid, $bridges) = @_;
1260 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
1262 my $device = $net->{model
};
1263 if ($net->{model
} eq 'virtio') {
1264 $device = 'virtio-net-pci';
1267 my $pciaddr = print_pci_addr
("$netid", $bridges);
1268 my $tmpstr = "$device,mac=$net->{macaddr},netdev=$netid$pciaddr,id=$netid";
1269 if ($net->{queues
} && $net->{queues
} > 1 && $net->{model
} eq 'virtio'){
1270 #Consider we have N queues, the number of vectors needed is 2*N + 2 (plus one config interrupt and control vq)
1271 my $vectors = $net->{queues
} * 2 + 2;
1272 $tmpstr .= ",vectors=$vectors,mq=on";
1274 $tmpstr .= ",bootindex=$net->{bootindex}" if $net->{bootindex
} ;
1278 sub print_netdev_full
{
1279 my ($vmid, $conf, $net, $netid) = @_;
1282 if ($netid =~ m/^net(\d+)$/) {
1286 die "got strange net id '$i'\n" if $i >= ${MAX_NETS
};
1288 my $ifname = "tap${vmid}i$i";
1290 # kvm uses TUNSETIFF ioctl, and that limits ifname length
1291 die "interface name '$ifname' is too long (max 15 character)\n"
1292 if length($ifname) >= 16;
1294 my $vhostparam = '';
1295 $vhostparam = ',vhost=on' if $kernel_has_vhost_net && $net->{model
} eq 'virtio';
1297 my $vmname = $conf->{name
} || "vm$vmid";
1301 if ($net->{bridge
}) {
1302 $netdev = "type=tap,id=$netid,ifname=${ifname},script=/var/lib/qemu-server/pve-bridge,downscript=/var/lib/qemu-server/pve-bridgedown$vhostparam";
1304 $netdev = "type=user,id=$netid,hostname=$vmname";
1307 $netdev .= ",queues=$net->{queues}" if ($net->{queues
} && $net->{model
} eq 'virtio');
1312 sub drive_is_cdrom
{
1315 return $drive && $drive->{media
} && ($drive->{media
} eq 'cdrom');
1324 foreach my $kvp (split(/,/, $data)) {
1326 if ($kvp =~ m/^memory=(\S+)$/) {
1327 $res->{memory
} = $1;
1328 } elsif ($kvp =~ m/^policy=(preferred|bind|interleave)$/) {
1329 $res->{policy
} = $1;
1330 } elsif ($kvp =~ m/^cpus=(\d+)(-(\d+))?$/) {
1331 $res->{cpus
}->{start
} = $1;
1332 $res->{cpus
}->{end
} = $3;
1333 } elsif ($kvp =~ m/^hostnodes=(\d+)(-(\d+))?$/) {
1334 $res->{hostnodes
}->{start
} = $1;
1335 $res->{hostnodes
}->{end
} = $3;
1347 return undef if !$value;
1350 my @list = split(/,/, $value);
1354 foreach my $kv (@list) {
1356 if ($kv =~ m/^(host=)?([a-f0-9]{2}:[a-f0-9]{2})(\.([a-f0-9]))?$/) {
1359 push @{$res->{pciid
}}, { id
=> $2 , function
=> $4};
1362 my $pcidevices = lspci
($2);
1363 $res->{pciid
} = $pcidevices->{$2};
1365 } elsif ($kv =~ m/^driver=(kvm|vfio)$/) {
1366 $res->{driver
} = $1;
1367 } elsif ($kv =~ m/^rombar=(on|off)$/) {
1368 $res->{rombar
} = $1;
1369 } elsif ($kv =~ m/^x-vga=(on|off)$/) {
1370 $res->{'x-vga'} = $1;
1371 } elsif ($kv =~ m/^pcie=(\d+)$/) {
1372 $res->{pcie
} = 1 if $1 == 1;
1374 warn "unknown hostpci setting '$kv'\n";
1378 return undef if !$found;
1383 # netX: e1000=XX:XX:XX:XX:XX:XX,bridge=vmbr0,rate=<mbps>
1389 foreach my $kvp (split(/,/, $data)) {
1391 if ($kvp =~ m/^(ne2k_pci|e1000|e1000-82540em|e1000-82544gc|e1000-82545em|rtl8139|pcnet|virtio|ne2k_isa|i82551|i82557b|i82559er|vmxnet3)(=([0-9a-f]{2}(:[0-9a-f]{2}){5}))?$/i) {
1393 my $mac = defined($3) ?
uc($3) : PVE
::Tools
::random_ether_addr
();
1394 $res->{model
} = $model;
1395 $res->{macaddr
} = $mac;
1396 } elsif ($kvp =~ m/^bridge=(\S+)$/) {
1397 $res->{bridge
} = $1;
1398 } elsif ($kvp =~ m/^queues=(\d+)$/) {
1399 $res->{queues
} = $1;
1400 } elsif ($kvp =~ m/^rate=(\d+(\.\d+)?)$/) {
1402 } elsif ($kvp =~ m/^tag=(\d+)$/) {
1404 } elsif ($kvp =~ m/^firewall=([01])$/) {
1405 $res->{firewall
} = $1;
1406 } elsif ($kvp =~ m/^link_down=([01])$/) {
1407 $res->{link_down
} = $1;
1414 return undef if !$res->{model
};
1422 my $res = "$net->{model}";
1423 $res .= "=$net->{macaddr}" if $net->{macaddr
};
1424 $res .= ",bridge=$net->{bridge}" if $net->{bridge
};
1425 $res .= ",rate=$net->{rate}" if $net->{rate
};
1426 $res .= ",tag=$net->{tag}" if $net->{tag
};
1427 $res .= ",firewall=1" if $net->{firewall
};
1428 $res .= ",link_down=1" if $net->{link_down
};
1429 $res .= ",queues=$net->{queues}" if $net->{queues
};
1434 sub add_random_macs
{
1435 my ($settings) = @_;
1437 foreach my $opt (keys %$settings) {
1438 next if $opt !~ m/^net(\d+)$/;
1439 my $net = parse_net
($settings->{$opt});
1441 $settings->{$opt} = print_net
($net);
1445 sub add_unused_volume
{
1446 my ($config, $volid) = @_;
1449 for (my $ind = $MAX_UNUSED_DISKS - 1; $ind >= 0; $ind--) {
1450 my $test = "unused$ind";
1451 if (my $vid = $config->{$test}) {
1452 return if $vid eq $volid; # do not add duplicates
1458 die "To many unused volume - please delete them first.\n" if !$key;
1460 $config->{$key} = $volid;
1465 sub vm_is_volid_owner
{
1466 my ($storecfg, $vmid, $volid) = @_;
1468 if ($volid !~ m
|^/|) {
1470 eval { ($path, $owner) = PVE
::Storage
::path
($storecfg, $volid); };
1471 if ($owner && ($owner == $vmid)) {
1479 sub vmconfig_delete_pending_option
{
1480 my ($conf, $key) = @_;
1482 delete $conf->{pending
}->{$key};
1483 my $pending_delete_hash = { $key => 1 };
1484 foreach my $opt (PVE
::Tools
::split_list
($conf->{pending
}->{delete})) {
1485 $pending_delete_hash->{$opt} = 1;
1487 $conf->{pending
}->{delete} = join(',', keys %$pending_delete_hash);
1490 sub vmconfig_undelete_pending_option
{
1491 my ($conf, $key) = @_;
1493 my $pending_delete_hash = {};
1494 foreach my $opt (PVE
::Tools
::split_list
($conf->{pending
}->{delete})) {
1495 $pending_delete_hash->{$opt} = 1;
1497 delete $pending_delete_hash->{$key};
1499 my @keylist = keys %$pending_delete_hash;
1500 if (scalar(@keylist)) {
1501 $conf->{pending
}->{delete} = join(',', @keylist);
1503 delete $conf->{pending
}->{delete};
1507 sub vmconfig_register_unused_drive
{
1508 my ($storecfg, $vmid, $conf, $drive) = @_;
1510 if (!drive_is_cdrom
($drive)) {
1511 my $volid = $drive->{file
};
1512 if (vm_is_volid_owner
($storecfg, $vmid, $volid)) {
1513 add_unused_volume
($conf, $volid, $vmid);
1518 sub vmconfig_cleanup_pending
{
1521 # remove pending changes when nothing changed
1523 foreach my $opt (keys %{$conf->{pending
}}) {
1524 if (defined($conf->{$opt}) && ($conf->{pending
}->{$opt} eq $conf->{$opt})) {
1526 delete $conf->{pending
}->{$opt};
1530 # remove delete if option is not set
1531 my $pending_delete_hash = {};
1532 foreach my $opt (PVE
::Tools
::split_list
($conf->{pending
}->{delete})) {
1533 if (defined($conf->{$opt})) {
1534 $pending_delete_hash->{$opt} = 1;
1540 my @keylist = keys %$pending_delete_hash;
1541 if (scalar(@keylist)) {
1542 $conf->{pending
}->{delete} = join(',', @keylist);
1544 delete $conf->{pending
}->{delete};
1550 my $valid_smbios1_options = {
1551 manufacturer
=> '\S+',
1555 uuid
=> '[a-fA-F0-9]{8}(?:-[a-fA-F0-9]{4}){3}-[a-fA-F0-9]{12}',
1560 # smbios: [manufacturer=str][,product=str][,version=str][,serial=str][,uuid=uuid][,sku=str][,family=str]
1566 foreach my $kvp (split(/,/, $data)) {
1567 return undef if $kvp !~ m/^(\S+)=(.+)$/;
1568 my ($k, $v) = split(/=/, $kvp);
1569 return undef if !defined($k) || !defined($v);
1570 return undef if !$valid_smbios1_options->{$k};
1571 return undef if $v !~ m/^$valid_smbios1_options->{$k}$/;
1582 foreach my $k (keys %$smbios1) {
1583 next if !defined($smbios1->{$k});
1584 next if !$valid_smbios1_options->{$k};
1585 $data .= ',' if $data;
1586 $data .= "$k=$smbios1->{$k}";
1591 PVE
::JSONSchema
::register_format
('pve-qm-smbios1', \
&verify_smbios1
);
1592 sub verify_smbios1
{
1593 my ($value, $noerr) = @_;
1595 return $value if parse_smbios1
($value);
1597 return undef if $noerr;
1599 die "unable to parse smbios (type 1) options\n";
1602 PVE
::JSONSchema
::register_format
('pve-qm-bootdisk', \
&verify_bootdisk
);
1603 sub verify_bootdisk
{
1604 my ($value, $noerr) = @_;
1606 return $value if valid_drivename
($value);
1608 return undef if $noerr;
1610 die "invalid boot disk '$value'\n";
1613 PVE
::JSONSchema
::register_format
('pve-qm-numanode', \
&verify_numa
);
1615 my ($value, $noerr) = @_;
1617 return $value if parse_numa
($value);
1619 return undef if $noerr;
1621 die "unable to parse numa options\n";
1624 PVE
::JSONSchema
::register_format
('pve-qm-net', \
&verify_net
);
1626 my ($value, $noerr) = @_;
1628 return $value if parse_net
($value);
1630 return undef if $noerr;
1632 die "unable to parse network options\n";
1635 PVE
::JSONSchema
::register_format
('pve-qm-drive', \
&verify_drive
);
1637 my ($value, $noerr) = @_;
1639 return $value if parse_drive
(undef, $value);
1641 return undef if $noerr;
1643 die "unable to parse drive options\n";
1646 PVE
::JSONSchema
::register_format
('pve-qm-hostpci', \
&verify_hostpci
);
1647 sub verify_hostpci
{
1648 my ($value, $noerr) = @_;
1650 return $value if parse_hostpci
($value);
1652 return undef if $noerr;
1654 die "unable to parse pci id\n";
1657 PVE
::JSONSchema
::register_format
('pve-qm-watchdog', \
&verify_watchdog
);
1658 sub verify_watchdog
{
1659 my ($value, $noerr) = @_;
1661 return $value if parse_watchdog
($value);
1663 return undef if $noerr;
1665 die "unable to parse watchdog options\n";
1668 sub parse_watchdog
{
1671 return undef if !$value;
1675 foreach my $p (split(/,/, $value)) {
1676 next if $p =~ m/^\s*$/;
1678 if ($p =~ m/^(model=)?(i6300esb|ib700)$/) {
1680 } elsif ($p =~ m/^(action=)?(reset|shutdown|poweroff|pause|debug|none)$/) {
1681 $res->{action
} = $2;
1690 PVE
::JSONSchema
::register_format
('pve-qm-startup', \
&verify_startup
);
1691 sub verify_startup
{
1692 my ($value, $noerr) = @_;
1694 return $value if parse_startup
($value);
1696 return undef if $noerr;
1698 die "unable to parse startup options\n";
1704 return undef if !$value;
1708 foreach my $p (split(/,/, $value)) {
1709 next if $p =~ m/^\s*$/;
1711 if ($p =~ m/^(order=)?(\d+)$/) {
1713 } elsif ($p =~ m/^up=(\d+)$/) {
1715 } elsif ($p =~ m/^down=(\d+)$/) {
1725 sub parse_usb_device
{
1728 return undef if !$value;
1730 my @dl = split(/,/, $value);
1734 foreach my $v (@dl) {
1735 if ($v =~ m/^host=(0x)?([0-9A-Fa-f]{4}):(0x)?([0-9A-Fa-f]{4})$/) {
1737 $res->{vendorid
} = $2;
1738 $res->{productid
} = $4;
1739 } elsif ($v =~ m/^host=(\d+)\-(\d+(\.\d+)*)$/) {
1741 $res->{hostbus
} = $1;
1742 $res->{hostport
} = $2;
1743 } elsif ($v =~ m/^spice$/) {
1750 return undef if !$found;
1755 PVE
::JSONSchema
::register_format
('pve-qm-usb-device', \
&verify_usb_device
);
1756 sub verify_usb_device
{
1757 my ($value, $noerr) = @_;
1759 return $value if parse_usb_device
($value);
1761 return undef if $noerr;
1763 die "unable to parse usb device\n";
1766 # add JSON properties for create and set function
1767 sub json_config_properties
{
1770 foreach my $opt (keys %$confdesc) {
1771 next if $opt eq 'parent' || $opt eq 'snaptime' || $opt eq 'vmstate';
1772 $prop->{$opt} = $confdesc->{$opt};
1779 my ($key, $value) = @_;
1781 die "unknown setting '$key'\n" if !$confdesc->{$key};
1783 my $type = $confdesc->{$key}->{type
};
1785 if (!defined($value)) {
1786 die "got undefined value\n";
1789 if ($value =~ m/[\n\r]/) {
1790 die "property contains a line feed\n";
1793 if ($type eq 'boolean') {
1794 return 1 if ($value eq '1') || ($value =~ m/^(on|yes|true)$/i);
1795 return 0 if ($value eq '0') || ($value =~ m/^(off|no|false)$/i);
1796 die "type check ('boolean') failed - got '$value'\n";
1797 } elsif ($type eq 'integer') {
1798 return int($1) if $value =~ m/^(\d+)$/;
1799 die "type check ('integer') failed - got '$value'\n";
1800 } elsif ($type eq 'number') {
1801 return $value if $value =~ m/^(\d+)(\.\d+)?$/;
1802 die "type check ('number') failed - got '$value'\n";
1803 } elsif ($type eq 'string') {
1804 if (my $fmt = $confdesc->{$key}->{format
}) {
1805 if ($fmt eq 'pve-qm-drive') {
1806 # special case - we need to pass $key to parse_drive()
1807 my $drive = parse_drive
($key, $value);
1808 return $value if $drive;
1809 die "unable to parse drive options\n";
1811 PVE
::JSONSchema
::check_format
($fmt, $value);
1814 $value =~ s/^\"(.*)\"$/$1/;
1817 die "internal error"
1821 sub lock_config_full
{
1822 my ($vmid, $timeout, $code, @param) = @_;
1824 my $filename = config_file_lock
($vmid);
1826 my $res = lock_file
($filename, $timeout, $code, @param);
1833 sub lock_config_mode
{
1834 my ($vmid, $timeout, $shared, $code, @param) = @_;
1836 my $filename = config_file_lock
($vmid);
1838 my $res = lock_file_full
($filename, $timeout, $shared, $code, @param);
1846 my ($vmid, $code, @param) = @_;
1848 return lock_config_full
($vmid, 10, $code, @param);
1851 sub cfs_config_path
{
1852 my ($vmid, $node) = @_;
1854 $node = $nodename if !$node;
1855 return "nodes/$node/qemu-server/$vmid.conf";
1858 sub check_iommu_support
{
1859 #fixme : need to check IOMMU support
1860 #http://www.linux-kvm.org/page/How_to_assign_devices_with_VT-d_in_KVM
1868 my ($vmid, $node) = @_;
1870 my $cfspath = cfs_config_path
($vmid, $node);
1871 return "/etc/pve/$cfspath";
1874 sub config_file_lock
{
1877 return "$lock_dir/lock-$vmid.conf";
1883 my $conf = config_file
($vmid);
1884 utime undef, undef, $conf;
1888 my ($storecfg, $vmid, $keep_empty_config) = @_;
1890 my $conffile = config_file
($vmid);
1892 my $conf = load_config
($vmid);
1896 # only remove disks owned by this VM
1897 foreach_drive
($conf, sub {
1898 my ($ds, $drive) = @_;
1900 return if drive_is_cdrom
($drive);
1902 my $volid = $drive->{file
};
1904 return if !$volid || $volid =~ m
|^/|;
1906 my ($path, $owner) = PVE
::Storage
::path
($storecfg, $volid);
1907 return if !$path || !$owner || ($owner != $vmid);
1909 PVE
::Storage
::vdisk_free
($storecfg, $volid);
1912 if ($keep_empty_config) {
1913 PVE
::Tools
::file_set_contents
($conffile, "memory: 128\n");
1918 # also remove unused disk
1920 my $dl = PVE
::Storage
::vdisk_list
($storecfg, undef, $vmid);
1923 PVE
::Storage
::foreach_volid
($dl, sub {
1924 my ($volid, $sid, $volname, $d) = @_;
1925 PVE
::Storage
::vdisk_free
($storecfg, $volid);
1935 my ($vmid, $node) = @_;
1937 my $cfspath = cfs_config_path
($vmid, $node);
1939 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath);
1941 die "no such VM ('$vmid')\n" if !defined($conf);
1946 sub parse_vm_config
{
1947 my ($filename, $raw) = @_;
1949 return undef if !defined($raw);
1952 digest
=> Digest
::SHA
::sha1_hex
($raw),
1957 $filename =~ m
|/qemu-server/(\d
+)\
.conf
$|
1958 || die "got strange filename '$filename'";
1966 my @lines = split(/\n/, $raw);
1967 foreach my $line (@lines) {
1968 next if $line =~ m/^\s*$/;
1970 if ($line =~ m/^\[PENDING\]\s*$/i) {
1971 $section = 'pending';
1972 $conf->{description
} = $descr if $descr;
1974 $conf = $res->{$section} = {};
1977 } elsif ($line =~ m/^\[([a-z][a-z0-9_\-]+)\]\s*$/i) {
1979 $conf->{description
} = $descr if $descr;
1981 $conf = $res->{snapshots
}->{$section} = {};
1985 if ($line =~ m/^\#(.*)\s*$/) {
1986 $descr .= PVE
::Tools
::decode_text
($1) . "\n";
1990 if ($line =~ m/^(description):\s*(.*\S)\s*$/) {
1991 $descr .= PVE
::Tools
::decode_text
($2);
1992 } elsif ($line =~ m/snapstate:\s*(prepare|delete)\s*$/) {
1993 $conf->{snapstate
} = $1;
1994 } elsif ($line =~ m/^(args):\s*(.*\S)\s*$/) {
1997 $conf->{$key} = $value;
1998 } elsif ($line =~ m/^delete:\s*(.*\S)\s*$/) {
2000 if ($section eq 'pending') {
2001 $conf->{delete} = $value; # we parse this later
2003 warn "vm $vmid - propertry 'delete' is only allowed in [PENDING]\n";
2005 } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/) {
2008 eval { $value = check_type
($key, $value); };
2010 warn "vm $vmid - unable to parse value of '$key' - $@";
2012 my $fmt = $confdesc->{$key}->{format
};
2013 if ($fmt && $fmt eq 'pve-qm-drive') {
2014 my $v = parse_drive
($key, $value);
2015 if (my $volid = filename_to_volume_id
($vmid, $v->{file
}, $v->{media
})) {
2016 $v->{file
} = $volid;
2017 $value = print_drive
($vmid, $v);
2019 warn "vm $vmid - unable to parse value of '$key'\n";
2024 if ($key eq 'cdrom') {
2025 $conf->{ide2
} = $value;
2027 $conf->{$key} = $value;
2033 $conf->{description
} = $descr if $descr;
2035 delete $res->{snapstate
}; # just to be sure
2040 sub write_vm_config
{
2041 my ($filename, $conf) = @_;
2043 delete $conf->{snapstate
}; # just to be sure
2045 if ($conf->{cdrom
}) {
2046 die "option ide2 conflicts with cdrom\n" if $conf->{ide2
};
2047 $conf->{ide2
} = $conf->{cdrom
};
2048 delete $conf->{cdrom
};
2051 # we do not use 'smp' any longer
2052 if ($conf->{sockets
}) {
2053 delete $conf->{smp
};
2054 } elsif ($conf->{smp
}) {
2055 $conf->{sockets
} = $conf->{smp
};
2056 delete $conf->{cores
};
2057 delete $conf->{smp
};
2060 my $used_volids = {};
2062 my $cleanup_config = sub {
2063 my ($cref, $pending, $snapname) = @_;
2065 foreach my $key (keys %$cref) {
2066 next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots' ||
2067 $key eq 'snapstate' || $key eq 'pending';
2068 my $value = $cref->{$key};
2069 if ($key eq 'delete') {
2070 die "propertry 'delete' is only allowed in [PENDING]\n"
2072 # fixme: check syntax?
2075 eval { $value = check_type
($key, $value); };
2076 die "unable to parse value of '$key' - $@" if $@;
2078 $cref->{$key} = $value;
2080 if (!$snapname && valid_drivename
($key)) {
2081 my $drive = parse_drive
($key, $value);
2082 $used_volids->{$drive->{file
}} = 1 if $drive && $drive->{file
};
2087 &$cleanup_config($conf);
2089 &$cleanup_config($conf->{pending
}, 1);
2091 foreach my $snapname (keys %{$conf->{snapshots
}}) {
2092 die "internal error" if $snapname eq 'pending';
2093 &$cleanup_config($conf->{snapshots
}->{$snapname}, undef, $snapname);
2096 # remove 'unusedX' settings if we re-add a volume
2097 foreach my $key (keys %$conf) {
2098 my $value = $conf->{$key};
2099 if ($key =~ m/^unused/ && $used_volids->{$value}) {
2100 delete $conf->{$key};
2104 my $generate_raw_config = sub {
2109 # add description as comment to top of file
2110 my $descr = $conf->{description
} || '';
2111 foreach my $cl (split(/\n/, $descr)) {
2112 $raw .= '#' . PVE
::Tools
::encode_text
($cl) . "\n";
2115 foreach my $key (sort keys %$conf) {
2116 next if $key eq 'digest' || $key eq 'description' || $key eq 'pending' || $key eq 'snapshots';
2117 $raw .= "$key: $conf->{$key}\n";
2122 my $raw = &$generate_raw_config($conf);
2124 if (scalar(keys %{$conf->{pending
}})){
2125 $raw .= "\n[PENDING]\n";
2126 $raw .= &$generate_raw_config($conf->{pending
});
2129 foreach my $snapname (sort keys %{$conf->{snapshots
}}) {
2130 $raw .= "\n[$snapname]\n";
2131 $raw .= &$generate_raw_config($conf->{snapshots
}->{$snapname});
2137 sub update_config_nolock
{
2138 my ($vmid, $conf, $skiplock) = @_;
2140 check_lock
($conf) if !$skiplock;
2142 my $cfspath = cfs_config_path
($vmid);
2144 PVE
::Cluster
::cfs_write_file
($cfspath, $conf);
2148 my ($vmid, $conf, $skiplock) = @_;
2150 lock_config
($vmid, &update_config_nolock
, $conf, $skiplock);
2157 # we use static defaults from our JSON schema configuration
2158 foreach my $key (keys %$confdesc) {
2159 if (defined(my $default = $confdesc->{$key}->{default})) {
2160 $res->{$key} = $default;
2164 my $conf = PVE
::Cluster
::cfs_read_file
('datacenter.cfg');
2165 $res->{keyboard
} = $conf->{keyboard
} if $conf->{keyboard
};
2171 my $vmlist = PVE
::Cluster
::get_vmlist
();
2173 return $res if !$vmlist || !$vmlist->{ids
};
2174 my $ids = $vmlist->{ids
};
2176 foreach my $vmid (keys %$ids) {
2177 my $d = $ids->{$vmid};
2178 next if !$d->{node
} || $d->{node
} ne $nodename;
2179 next if !$d->{type
} || $d->{type
} ne 'qemu';
2180 $res->{$vmid}->{exists} = 1;
2185 # test if VM uses local resources (to prevent migration)
2186 sub check_local_resources
{
2187 my ($conf, $noerr) = @_;
2191 $loc_res = 1 if $conf->{hostusb
}; # old syntax
2192 $loc_res = 1 if $conf->{hostpci
}; # old syntax
2194 foreach my $k (keys %$conf) {
2195 next if $k =~ m/^usb/ && ($conf->{$k} eq 'spice');
2196 $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/;
2199 die "VM uses local resources\n" if $loc_res && !$noerr;
2204 # check if used storages are available on all nodes (use by migrate)
2205 sub check_storage_availability
{
2206 my ($storecfg, $conf, $node) = @_;
2208 foreach_drive
($conf, sub {
2209 my ($ds, $drive) = @_;
2211 my $volid = $drive->{file
};
2214 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
2217 # check if storage is available on both nodes
2218 my $scfg = PVE
::Storage
::storage_check_node
($storecfg, $sid);
2219 PVE
::Storage
::storage_check_node
($storecfg, $sid, $node);
2223 # list nodes where all VM images are available (used by has_feature API)
2225 my ($conf, $storecfg) = @_;
2227 my $nodelist = PVE
::Cluster
::get_nodelist
();
2228 my $nodehash = { map { $_ => 1 } @$nodelist };
2229 my $nodename = PVE
::INotify
::nodename
();
2231 foreach_drive
($conf, sub {
2232 my ($ds, $drive) = @_;
2234 my $volid = $drive->{file
};
2237 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
2239 my $scfg = PVE
::Storage
::storage_config
($storecfg, $storeid);
2240 if ($scfg->{disable
}) {
2242 } elsif (my $avail = $scfg->{nodes
}) {
2243 foreach my $node (keys %$nodehash) {
2244 delete $nodehash->{$node} if !$avail->{$node};
2246 } elsif (!$scfg->{shared
}) {
2247 foreach my $node (keys %$nodehash) {
2248 delete $nodehash->{$node} if $node ne $nodename
2260 die "VM is locked ($conf->{lock})\n" if $conf->{lock};
2264 my ($pidfile, $pid) = @_;
2266 my $fh = IO
::File-
>new("/proc/$pid/cmdline", "r");
2270 return undef if !$line;
2271 my @param = split(/\0/, $line);
2273 my $cmd = $param[0];
2274 return if !$cmd || ($cmd !~ m
|kvm
$| && $cmd !~ m
|qemu-system-x86_64
$|);
2276 for (my $i = 0; $i < scalar (@param); $i++) {
2279 if (($p eq '-pidfile') || ($p eq '--pidfile')) {
2280 my $p = $param[$i+1];
2281 return 1 if $p && ($p eq $pidfile);
2290 my ($vmid, $nocheck, $node) = @_;
2292 my $filename = config_file
($vmid, $node);
2294 die "unable to find configuration file for VM $vmid - no such machine\n"
2295 if !$nocheck && ! -f
$filename;
2297 my $pidfile = pidfile_name
($vmid);
2299 if (my $fd = IO
::File-
>new("<$pidfile")) {
2304 my $mtime = $st->mtime;
2305 if ($mtime > time()) {
2306 warn "file '$filename' modified in future\n";
2309 if ($line =~ m/^(\d+)$/) {
2311 if (check_cmdline
($pidfile, $pid)) {
2312 if (my $pinfo = PVE
::ProcFSTools
::check_process_running
($pid)) {
2324 my $vzlist = config_list
();
2326 my $fd = IO
::Dir-
>new($var_run_tmpdir) || return $vzlist;
2328 while (defined(my $de = $fd->read)) {
2329 next if $de !~ m/^(\d+)\.pid$/;
2331 next if !defined($vzlist->{$vmid});
2332 if (my $pid = check_running
($vmid)) {
2333 $vzlist->{$vmid}->{pid
} = $pid;
2341 my ($storecfg, $conf) = @_;
2343 my $bootdisk = $conf->{bootdisk
};
2344 return undef if !$bootdisk;
2345 return undef if !valid_drivename
($bootdisk);
2347 return undef if !$conf->{$bootdisk};
2349 my $drive = parse_drive
($bootdisk, $conf->{$bootdisk});
2350 return undef if !defined($drive);
2352 return undef if drive_is_cdrom
($drive);
2354 my $volid = $drive->{file
};
2355 return undef if !$volid;
2357 return $drive->{size
};
2360 my $last_proc_pid_stat;
2362 # get VM status information
2363 # This must be fast and should not block ($full == false)
2364 # We only query KVM using QMP if $full == true (this can be slow)
2366 my ($opt_vmid, $full) = @_;
2370 my $storecfg = PVE
::Storage
::config
();
2372 my $list = vzlist
();
2373 my ($uptime) = PVE
::ProcFSTools
::read_proc_uptime
(1);
2375 my $cpucount = $cpuinfo->{cpus
} || 1;
2377 foreach my $vmid (keys %$list) {
2378 next if $opt_vmid && ($vmid ne $opt_vmid);
2380 my $cfspath = cfs_config_path
($vmid);
2381 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath) || {};
2384 $d->{pid
} = $list->{$vmid}->{pid
};
2386 # fixme: better status?
2387 $d->{status
} = $list->{$vmid}->{pid
} ?
'running' : 'stopped';
2389 my $size = disksize
($storecfg, $conf);
2390 if (defined($size)) {
2391 $d->{disk
} = 0; # no info available
2392 $d->{maxdisk
} = $size;
2398 $d->{cpus
} = ($conf->{sockets
} || 1) * ($conf->{cores
} || 1);
2399 $d->{cpus
} = $cpucount if $d->{cpus
} > $cpucount;
2400 $d->{cpus
} = $conf->{vcpus
} if $conf->{vcpus
};
2402 $d->{name
} = $conf->{name
} || "VM $vmid";
2403 $d->{maxmem
} = $conf->{memory
} ?
$conf->{memory
}*(1024*1024) : 0;
2405 if ($conf->{balloon
}) {
2406 $d->{balloon_min
} = $conf->{balloon
}*(1024*1024);
2407 $d->{shares
} = defined($conf->{shares
}) ?
$conf->{shares
} : 1000;
2418 $d->{diskwrite
} = 0;
2420 $d->{template
} = is_template
($conf);
2425 my $netdev = PVE
::ProcFSTools
::read_proc_net_dev
();
2426 foreach my $dev (keys %$netdev) {
2427 next if $dev !~ m/^tap([1-9]\d*)i/;
2429 my $d = $res->{$vmid};
2432 $d->{netout
} += $netdev->{$dev}->{receive
};
2433 $d->{netin
} += $netdev->{$dev}->{transmit
};
2436 my $ctime = gettimeofday
;
2438 foreach my $vmid (keys %$list) {
2440 my $d = $res->{$vmid};
2441 my $pid = $d->{pid
};
2444 my $pstat = PVE
::ProcFSTools
::read_proc_pid_stat
($pid);
2445 next if !$pstat; # not running
2447 my $used = $pstat->{utime} + $pstat->{stime
};
2449 $d->{uptime
} = int(($uptime - $pstat->{starttime
})/$cpuinfo->{user_hz
});
2451 if ($pstat->{vsize
}) {
2452 $d->{mem
} = int(($pstat->{rss
}/$pstat->{vsize
})*$d->{maxmem
});
2455 my $old = $last_proc_pid_stat->{$pid};
2457 $last_proc_pid_stat->{$pid} = {
2465 my $dtime = ($ctime - $old->{time}) * $cpucount * $cpuinfo->{user_hz
};
2467 if ($dtime > 1000) {
2468 my $dutime = $used - $old->{used
};
2470 $d->{cpu
} = (($dutime/$dtime)* $cpucount) / $d->{cpus
};
2471 $last_proc_pid_stat->{$pid} = {
2477 $d->{cpu
} = $old->{cpu
};
2481 return $res if !$full;
2483 my $qmpclient = PVE
::QMPClient-
>new();
2485 my $ballooncb = sub {
2486 my ($vmid, $resp) = @_;
2488 my $info = $resp->{'return'};
2489 return if !$info->{max_mem
};
2491 my $d = $res->{$vmid};
2493 # use memory assigned to VM
2494 $d->{maxmem
} = $info->{max_mem
};
2495 $d->{balloon
} = $info->{actual
};
2497 if (defined($info->{total_mem
}) && defined($info->{free_mem
})) {
2498 $d->{mem
} = $info->{total_mem
} - $info->{free_mem
};
2499 $d->{freemem
} = $info->{free_mem
};
2504 my $blockstatscb = sub {
2505 my ($vmid, $resp) = @_;
2506 my $data = $resp->{'return'} || [];
2507 my $totalrdbytes = 0;
2508 my $totalwrbytes = 0;
2509 for my $blockstat (@$data) {
2510 $totalrdbytes = $totalrdbytes + $blockstat->{stats
}->{rd_bytes
};
2511 $totalwrbytes = $totalwrbytes + $blockstat->{stats
}->{wr_bytes
};
2513 $res->{$vmid}->{diskread
} = $totalrdbytes;
2514 $res->{$vmid}->{diskwrite
} = $totalwrbytes;
2517 my $statuscb = sub {
2518 my ($vmid, $resp) = @_;
2520 $qmpclient->queue_cmd($vmid, $blockstatscb, 'query-blockstats');
2521 # this fails if ballon driver is not loaded, so this must be
2522 # the last commnand (following command are aborted if this fails).
2523 $qmpclient->queue_cmd($vmid, $ballooncb, 'query-balloon');
2525 my $status = 'unknown';
2526 if (!defined($status = $resp->{'return'}->{status
})) {
2527 warn "unable to get VM status\n";
2531 $res->{$vmid}->{qmpstatus
} = $resp->{'return'}->{status
};
2534 foreach my $vmid (keys %$list) {
2535 next if $opt_vmid && ($vmid ne $opt_vmid);
2536 next if !$res->{$vmid}->{pid
}; # not running
2537 $qmpclient->queue_cmd($vmid, $statuscb, 'query-status');
2540 $qmpclient->queue_execute(undef, 1);
2542 foreach my $vmid (keys %$list) {
2543 next if $opt_vmid && ($vmid ne $opt_vmid);
2544 $res->{$vmid}->{qmpstatus
} = $res->{$vmid}->{status
} if !$res->{$vmid}->{qmpstatus
};
2551 my ($conf, $vmid, $memory, $sockets, $func) = @_;
2554 my $current_size = 1024;
2555 my $dimm_size = 512;
2556 return if $current_size == $memory;
2558 for (my $j = 0; $j < 8; $j++) {
2559 for (my $i = 0; $i < 32; $i++) {
2560 my $name = "dimm${dimm_id}";
2562 my $numanode = $i % $sockets;
2563 $current_size += $dimm_size;
2564 &$func($conf, $vmid, $name, $dimm_size, $numanode, $current_size, $memory);
2565 return $current_size if $current_size >= $memory;
2572 my ($conf, $func) = @_;
2574 foreach my $ds (keys %$conf) {
2575 next if !valid_drivename
($ds);
2577 my $drive = parse_drive
($ds, $conf->{$ds});
2580 &$func($ds, $drive);
2585 my ($conf, $func) = @_;
2589 my $test_volid = sub {
2590 my ($volid, $is_cdrom) = @_;
2594 $volhash->{$volid} = $is_cdrom || 0;
2597 foreach_drive
($conf, sub {
2598 my ($ds, $drive) = @_;
2599 &$test_volid($drive->{file
}, drive_is_cdrom
($drive));
2602 foreach my $snapname (keys %{$conf->{snapshots
}}) {
2603 my $snap = $conf->{snapshots
}->{$snapname};
2604 &$test_volid($snap->{vmstate
}, 0);
2605 foreach_drive
($snap, sub {
2606 my ($ds, $drive) = @_;
2607 &$test_volid($drive->{file
}, drive_is_cdrom
($drive));
2611 foreach my $volid (keys %$volhash) {
2612 &$func($volid, $volhash->{$volid});
2616 sub vga_conf_has_spice
{
2619 return 0 if !$vga || $vga !~ m/^qxl([234])?$/;
2624 sub config_to_command
{
2625 my ($storecfg, $vmid, $conf, $defaults, $forcemachine) = @_;
2628 my $globalFlags = [];
2629 my $machineFlags = [];
2635 my $kvmver = kvm_user_version
();
2636 my $vernum = 0; # unknown
2637 if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
2638 $vernum = $1*1000000+$2*1000;
2639 } elsif ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
2640 $vernum = $1*1000000+$2*1000+$3;
2643 die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 15000;
2645 my $have_ovz = -f
'/proc/vz/vestat';
2647 my $q35 = machine_type_is_q35
($conf);
2648 my $hotplug_features = parse_hotplug_features
(defined($conf->{hotplug
}) ?
$conf->{hotplug
} : '1');
2649 my $machine_type = $forcemachine || $conf->{machine
};
2651 push @$cmd, '/usr/bin/kvm';
2653 push @$cmd, '-id', $vmid;
2657 my $qmpsocket = qmp_socket
($vmid);
2658 push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
2659 push @$cmd, '-mon', "chardev=qmp,mode=control";
2661 my $socket = vnc_socket
($vmid);
2662 push @$cmd, '-vnc', "unix:$socket,x509,password";
2664 push @$cmd, '-pidfile' , pidfile_name
($vmid);
2666 push @$cmd, '-daemonize';
2668 if ($conf->{smbios1
}) {
2669 push @$cmd, '-smbios', "type=1,$conf->{smbios1}";
2673 # the q35 chipset support native usb2, so we enable usb controller
2674 # by default for this machine type
2675 push @$devices, '-readconfig', '/usr/share/qemu-server/pve-q35.cfg';
2677 $pciaddr = print_pci_addr
("piix3", $bridges);
2678 push @$devices, '-device', "piix3-usb-uhci,id=uhci$pciaddr.0x2";
2681 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2682 next if !$conf->{"usb$i"};
2685 # include usb device config
2686 push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
2689 my $vga = $conf->{vga
};
2691 my $qxlnum = vga_conf_has_spice
($vga);
2692 $vga = 'qxl' if $qxlnum;
2695 if ($conf->{ostype
} && ($conf->{ostype
} eq 'win8' ||
2696 $conf->{ostype
} eq 'win7' ||
2697 $conf->{ostype
} eq 'w2k8')) {
2704 # enable absolute mouse coordinates (needed by vnc)
2706 if (defined($conf->{tablet
})) {
2707 $tablet = $conf->{tablet
};
2709 $tablet = $defaults->{tablet
};
2710 $tablet = 0 if $qxlnum; # disable for spice because it is not needed
2711 $tablet = 0 if $vga =~ m/^serial\d+$/; # disable if we use serial terminal (no vga card)
2714 push @$devices, '-device', print_tabletdevice_full
($conf) if $tablet;
2717 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
2718 my $d = parse_hostpci
($conf->{"hostpci$i"});
2721 my $pcie = $d->{pcie
};
2723 die "q35 machine model is not enabled" if !$q35;
2724 $pciaddr = print_pcie_addr
("hostpci$i");
2726 $pciaddr = print_pci_addr
("hostpci$i", $bridges);
2729 my $rombar = $d->{rombar
} && $d->{rombar
} eq 'off' ?
",rombar=0" : "";
2730 my $driver = $d->{driver
} && $d->{driver
} eq 'vfio' ?
"vfio-pci" : "pci-assign";
2731 my $xvga = $d->{'x-vga'} && $d->{'x-vga'} eq 'on' ?
",x-vga=on" : "";
2732 if ($xvga && $xvga ne '') {
2733 push @$cpuFlags, 'kvm=off';
2736 $driver = "vfio-pci" if $xvga ne '';
2737 my $pcidevices = $d->{pciid
};
2738 my $multifunction = 1 if @$pcidevices > 1;
2741 foreach my $pcidevice (@$pcidevices) {
2743 my $id = "hostpci$i";
2744 $id .= ".$j" if $multifunction;
2745 my $addr = $pciaddr;
2746 $addr .= ".$j" if $multifunction;
2747 my $devicestr = "$driver,host=$pcidevice->{id}.$pcidevice->{function},id=$id$addr";
2750 $devicestr .= "$rombar$xvga";
2751 $devicestr .= ",multifunction=on" if $multifunction;
2754 push @$devices, '-device', $devicestr;
2760 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2761 my $d = parse_usb_device
($conf->{"usb$i"});
2763 if ($d->{vendorid
} && $d->{productid
}) {
2764 push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2765 } elsif (defined($d->{hostbus
}) && defined($d->{hostport
})) {
2766 push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2767 } elsif ($d->{spice
}) {
2768 # usb redir support for spice
2769 push @$devices, '-chardev', "spicevmc,id=usbredirchardev$i,name=usbredir";
2770 push @$devices, '-device', "usb-redir,chardev=usbredirchardev$i,id=usbredirdev$i,bus=ehci.0";
2775 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
2776 if (my $path = $conf->{"serial$i"}) {
2777 if ($path eq 'socket') {
2778 my $socket = "/var/run/qemu-server/${vmid}.serial$i";
2779 push @$devices, '-chardev', "socket,id=serial$i,path=$socket,server,nowait";
2780 push @$devices, '-device', "isa-serial,chardev=serial$i";
2782 die "no such serial device\n" if ! -c
$path;
2783 push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2784 push @$devices, '-device', "isa-serial,chardev=serial$i";
2790 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
2791 if (my $path = $conf->{"parallel$i"}) {
2792 die "no such parallel device\n" if ! -c
$path;
2793 my $devtype = $path =~ m!^/dev/usb/lp! ?
'tty' : 'parport';
2794 push @$devices, '-chardev', "$devtype,id=parallel$i,path=$path";
2795 push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2799 my $vmname = $conf->{name
} || "vm$vmid";
2801 push @$cmd, '-name', $vmname;
2804 $sockets = $conf->{smp
} if $conf->{smp
}; # old style - no longer iused
2805 $sockets = $conf->{sockets
} if $conf->{sockets
};
2807 my $cores = $conf->{cores
} || 1;
2809 my $maxcpus = $sockets * $cores;
2811 my $vcpus = $conf->{vcpus
} ?
$conf->{vcpus
} : $maxcpus;
2813 my $allowed_vcpus = $cpuinfo->{cpus
};
2815 die "MAX $maxcpus vcpus allowed per VM on this node\n"
2816 if ($allowed_vcpus < $maxcpus);
2818 push @$cmd, '-smp', "$vcpus,sockets=$sockets,cores=$cores,maxcpus=$maxcpus";
2820 push @$cmd, '-nodefaults';
2822 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
2824 my $bootindex_hash = {};
2826 foreach my $o (split(//, $bootorder)) {
2827 $bootindex_hash->{$o} = $i*100;
2831 push @$cmd, '-boot', "menu=on,strict=on,reboot-timeout=1000";
2833 push @$cmd, '-no-acpi' if defined($conf->{acpi
}) && $conf->{acpi
} == 0;
2835 push @$cmd, '-no-reboot' if defined($conf->{reboot
}) && $conf->{reboot
} == 0;
2837 push @$cmd, '-vga', $vga if $vga && $vga !~ m/^serial\d+$/; # for kvm 77 and later
2840 my $tdf = defined($conf->{tdf
}) ?
$conf->{tdf
} : $defaults->{tdf
};
2842 my $nokvm = defined($conf->{kvm
}) && $conf->{kvm
} == 0 ?
1 : 0;
2843 my $useLocaltime = $conf->{localtime};
2845 if (my $ost = $conf->{ostype
}) {
2846 # other, wxp, w2k, w2k3, w2k8, wvista, win7, win8, l24, l26, solaris
2848 if ($ost =~ m/^w/) { # windows
2849 $useLocaltime = 1 if !defined($conf->{localtime});
2851 # use time drift fix when acpi is enabled
2852 if (!(defined($conf->{acpi
}) && $conf->{acpi
} == 0)) {
2853 $tdf = 1 if !defined($conf->{tdf
});
2857 if ($ost eq 'win7' || $ost eq 'win8' || $ost eq 'w2k8' ||
2859 push @$globalFlags, 'kvm-pit.lost_tick_policy=discard';
2860 push @$cmd, '-no-hpet';
2861 if (qemu_machine_feature_enabled
($machine_type, $kvmver, 2, 3)) {
2862 push @$cpuFlags , 'hv_spinlocks=0x1fff' if !$nokvm;
2863 push @$cpuFlags , 'hv_vapic' if !$nokvm;
2864 push @$cpuFlags , 'hv_time' if !$nokvm;
2867 push @$cpuFlags , 'hv_spinlocks=0xffff' if !$nokvm;
2871 if ($ost eq 'win7' || $ost eq 'win8') {
2872 push @$cpuFlags , 'hv_relaxed' if !$nokvm;
2876 push @$rtcFlags, 'driftfix=slew' if $tdf;
2879 push @$machineFlags, 'accel=tcg';
2881 die "No accelerator found!\n" if !$cpuinfo->{hvm
};
2884 if ($machine_type) {
2885 push @$machineFlags, "type=${machine_type}";
2888 if ($conf->{startdate
}) {
2889 push @$rtcFlags, "base=$conf->{startdate}";
2890 } elsif ($useLocaltime) {
2891 push @$rtcFlags, 'base=localtime';
2894 my $cpu = $nokvm ?
"qemu64" : "kvm64";
2895 $cpu = $conf->{cpu
} if $conf->{cpu
};
2897 push @$cpuFlags , '+lahf_lm' if $cpu eq 'kvm64';
2899 push @$cpuFlags , '+x2apic' if !$nokvm && $conf->{ostype
} ne 'solaris';
2901 push @$cpuFlags , '-x2apic' if $conf->{ostype
} eq 'solaris';
2903 push @$cpuFlags, '+sep' if $cpu eq 'kvm64' || $cpu eq 'kvm32';
2905 if (qemu_machine_feature_enabled
($machine_type, $kvmver, 2, 3)) {
2907 push @$cpuFlags , '+kvm_pv_unhalt' if !$nokvm;
2908 push @$cpuFlags , '+kvm_pv_eoi' if !$nokvm;
2911 $cpu .= "," . join(',', @$cpuFlags) if scalar(@$cpuFlags);
2913 push @$cmd, '-cpu', "$cpu,enforce";
2915 my $memory = $conf->{memory
} || $defaults->{memory
};
2916 my $static_memory = 0;
2917 my $dimm_memory = 0;
2919 if ($hotplug_features->{memory
}) {
2920 die "Numa need to be enabled for memory hotplug\n" if !$conf->{numa
};
2921 die "Total memory is bigger than ${MAX_MEM}MB\n" if $memory > $MAX_MEM;
2922 $static_memory = $STATICMEM;
2923 die "minimum memory must be ${static_memory}MB\n" if($memory < $static_memory);
2924 $dimm_memory = $memory - $static_memory;
2925 push @$cmd, '-m', "size=${static_memory},slots=255,maxmem=${MAX_MEM}M";
2929 $static_memory = $memory;
2930 push @$cmd, '-m', $static_memory;
2933 if ($conf->{numa
}) {
2935 my $numa_totalmemory = undef;
2936 for (my $i = 0; $i < $MAX_NUMA; $i++) {
2937 next if !$conf->{"numa$i"};
2938 my $numa = parse_numa
($conf->{"numa$i"});
2941 die "missing numa node$i memory value\n" if !$numa->{memory
};
2942 my $numa_memory = $numa->{memory
};
2943 $numa_totalmemory += $numa_memory;
2944 my $numa_object = "memory-backend-ram,id=ram-node$i,size=${numa_memory}M";
2947 my $cpus_start = $numa->{cpus
}->{start
};
2948 die "missing numa node$i cpus\n" if !defined($cpus_start);
2949 my $cpus_end = $numa->{cpus
}->{end
} if defined($numa->{cpus
}->{end
});
2950 my $cpus = $cpus_start;
2951 if (defined($cpus_end)) {
2952 $cpus .= "-$cpus_end";
2953 die "numa node$i : cpu range $cpus is incorrect\n" if $cpus_end <= $cpus_start;
2957 my $hostnodes_start = $numa->{hostnodes
}->{start
};
2958 if (defined($hostnodes_start)) {
2959 my $hostnodes_end = $numa->{hostnodes
}->{end
} if defined($numa->{hostnodes
}->{end
});
2960 my $hostnodes = $hostnodes_start;
2961 if (defined($hostnodes_end)) {
2962 $hostnodes .= "-$hostnodes_end";
2963 die "host node $hostnodes range is incorrect\n" if $hostnodes_end <= $hostnodes_start;
2966 my $hostnodes_end_range = defined($hostnodes_end) ?
$hostnodes_end : $hostnodes_start;
2967 for (my $i = $hostnodes_start; $i <= $hostnodes_end_range; $i++ ) {
2968 die "host numa node$i don't exist\n" if ! -d
"/sys/devices/system/node/node$i/";
2972 my $policy = $numa->{policy
};
2973 die "you need to define a policy for hostnode $hostnodes\n" if !$policy;
2974 $numa_object .= ",host-nodes=$hostnodes,policy=$policy";
2977 push @$cmd, '-object', $numa_object;
2978 push @$cmd, '-numa', "node,nodeid=$i,cpus=$cpus,memdev=ram-node$i";
2981 die "total memory for NUMA nodes must be equal to vm static memory\n"
2982 if $numa_totalmemory && $numa_totalmemory != $static_memory;
2984 #if no custom tology, we split memory and cores across numa nodes
2985 if(!$numa_totalmemory) {
2987 my $numa_memory = ($static_memory / $sockets) . "M";
2989 for (my $i = 0; $i < $sockets; $i++) {
2991 my $cpustart = ($cores * $i);
2992 my $cpuend = ($cpustart + $cores - 1) if $cores && $cores > 1;
2993 my $cpus = $cpustart;
2994 $cpus .= "-$cpuend" if $cpuend;
2996 push @$cmd, '-object', "memory-backend-ram,size=$numa_memory,id=ram-node$i";
2997 push @$cmd, '-numa', "node,nodeid=$i,cpus=$cpus,memdev=ram-node$i";
3002 if ($hotplug_features->{memory
}) {
3003 foreach_dimm
($conf, $vmid, $memory, $sockets, sub {
3004 my ($conf, $vmid, $name, $dimm_size, $numanode, $current_size, $memory) = @_;
3005 push @$cmd, "-object" , "memory-backend-ram,id=mem-$name,size=${dimm_size}M";
3006 push @$cmd, "-device", "pc-dimm,id=$name,memdev=mem-$name,node=$numanode";
3008 #if dimm_memory is not aligned to dimm map
3009 if($current_size > $memory) {
3010 $conf->{memory
} = $current_size;
3011 update_config_nolock
($vmid, $conf, 1);
3016 push @$cmd, '-S' if $conf->{freeze
};
3018 # set keyboard layout
3019 my $kb = $conf->{keyboard
} || $defaults->{keyboard
};
3020 push @$cmd, '-k', $kb if $kb;
3023 #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
3024 #push @$cmd, '-soundhw', 'es1370';
3025 #push @$cmd, '-soundhw', $soundhw if $soundhw;
3027 if($conf->{agent
}) {
3028 my $qgasocket = qmp_socket
($vmid, 1);
3029 my $pciaddr = print_pci_addr
("qga0", $bridges);
3030 push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
3031 push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
3032 push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
3039 if ($conf->{ostype
} && $conf->{ostype
} =~ m/^w/){
3040 for(my $i = 1; $i < $qxlnum; $i++){
3041 my $pciaddr = print_pci_addr
("vga$i", $bridges);
3042 push @$cmd, '-device', "qxl,id=vga$i,ram_size=67108864,vram_size=33554432$pciaddr";
3045 # assume other OS works like Linux
3046 push @$cmd, '-global', 'qxl-vga.ram_size=134217728';
3047 push @$cmd, '-global', 'qxl-vga.vram_size=67108864';
3051 my $pciaddr = print_pci_addr
("spice", $bridges);
3053 $spice_port = PVE
::Tools
::next_spice_port
();
3055 push @$devices, '-spice', "tls-port=${spice_port},addr=127.0.0.1,tls-ciphers=DES-CBC3-SHA,seamless-migration=on";
3057 push @$devices, '-device', "virtio-serial,id=spice$pciaddr";
3058 push @$devices, '-chardev', "spicevmc,id=vdagent,name=vdagent";
3059 push @$devices, '-device', "virtserialport,chardev=vdagent,name=com.redhat.spice.0";
3062 # enable balloon by default, unless explicitly disabled
3063 if (!defined($conf->{balloon
}) || $conf->{balloon
}) {
3064 $pciaddr = print_pci_addr
("balloon0", $bridges);
3065 push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr";
3068 if ($conf->{watchdog
}) {
3069 my $wdopts = parse_watchdog
($conf->{watchdog
});
3070 $pciaddr = print_pci_addr
("watchdog", $bridges);
3071 my $watchdog = $wdopts->{model
} || 'i6300esb';
3072 push @$devices, '-device', "$watchdog$pciaddr";
3073 push @$devices, '-watchdog-action', $wdopts->{action
} if $wdopts->{action
};
3077 my $scsicontroller = {};
3078 my $ahcicontroller = {};
3079 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : $defaults->{scsihw
};
3081 # Add iscsi initiator name if available
3082 if (my $initiator = get_initiator_name
()) {
3083 push @$devices, '-iscsi', "initiator-name=$initiator";
3086 foreach_drive
($conf, sub {
3087 my ($ds, $drive) = @_;
3089 if (PVE
::Storage
::parse_volume_id
($drive->{file
}, 1)) {
3090 push @$vollist, $drive->{file
};
3093 $use_virtio = 1 if $ds =~ m/^virtio/;
3095 if (drive_is_cdrom
($drive)) {
3096 if ($bootindex_hash->{d
}) {
3097 $drive->{bootindex
} = $bootindex_hash->{d
};
3098 $bootindex_hash->{d
} += 1;
3101 if ($bootindex_hash->{c
}) {
3102 $drive->{bootindex
} = $bootindex_hash->{c
} if $conf->{bootdisk
} && ($conf->{bootdisk
} eq $ds);
3103 $bootindex_hash->{c
} += 1;
3107 if($drive->{interface
} eq 'virtio'){
3108 push @$cmd, '-object', "iothread,id=iothread-$ds" if $drive->{iothread
};
3111 if ($drive->{interface
} eq 'scsi') {
3113 my $maxdev = ($scsihw !~ m/^lsi/) ?
256 : 7;
3114 my $controller = int($drive->{index} / $maxdev);
3115 $pciaddr = print_pci_addr
("scsihw$controller", $bridges);
3116 push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
3117 $scsicontroller->{$controller}=1;
3120 if ($drive->{interface
} eq 'sata') {
3121 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
3122 $pciaddr = print_pci_addr
("ahci$controller", $bridges);
3123 push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
3124 $ahcicontroller->{$controller}=1;
3127 my $drive_cmd = print_drive_full
($storecfg, $vmid, $drive);
3128 push @$devices, '-drive',$drive_cmd;
3129 push @$devices, '-device', print_drivedevice_full
($storecfg, $conf, $vmid, $drive, $bridges);
3132 for (my $i = 0; $i < $MAX_NETS; $i++) {
3133 next if !$conf->{"net$i"};
3134 my $d = parse_net
($conf->{"net$i"});
3137 $use_virtio = 1 if $d->{model
} eq 'virtio';
3139 if ($bootindex_hash->{n
}) {
3140 $d->{bootindex
} = $bootindex_hash->{n
};
3141 $bootindex_hash->{n
} += 1;
3144 my $netdevfull = print_netdev_full
($vmid,$conf,$d,"net$i");
3145 push @$devices, '-netdev', $netdevfull;
3147 my $netdevicefull = print_netdevice_full
($vmid,$conf,$d,"net$i",$bridges);
3148 push @$devices, '-device', $netdevicefull;
3153 if (qemu_machine_feature_enabled
($machine_type, $kvmver, 2, 3)) {
3158 while (my ($k, $v) = each %$bridges) {
3159 $pciaddr = print_pci_addr
("pci.$k");
3160 unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
3164 # hack: virtio with fairsched is unreliable, so we do not use fairsched
3165 # when the VM uses virtio devices.
3166 if (!$use_virtio && $have_ovz) {
3168 my $cpuunits = defined($conf->{cpuunits
}) ?
3169 $conf->{cpuunits
} : $defaults->{cpuunits
};
3171 push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
3173 # fixme: cpulimit is currently ignored
3174 #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
3178 if ($conf->{args
}) {
3179 my $aa = PVE
::Tools
::split_args
($conf->{args
});
3183 push @$cmd, @$devices;
3184 push @$cmd, '-rtc', join(',', @$rtcFlags)
3185 if scalar(@$rtcFlags);
3186 push @$cmd, '-machine', join(',', @$machineFlags)
3187 if scalar(@$machineFlags);
3188 push @$cmd, '-global', join(',', @$globalFlags)
3189 if scalar(@$globalFlags);
3191 return wantarray ?
($cmd, $vollist, $spice_port) : $cmd;
3196 return "${var_run_tmpdir}/$vmid.vnc";
3202 my $res = vm_mon_cmd
($vmid, 'query-spice');
3204 return $res->{'tls-port'} || $res->{'port'} || die "no spice port\n";
3208 my ($vmid, $qga) = @_;
3209 my $sockettype = $qga ?
'qga' : 'qmp';
3210 return "${var_run_tmpdir}/$vmid.$sockettype";
3215 return "${var_run_tmpdir}/$vmid.pid";
3218 sub vm_devices_list
{
3221 my $res = vm_mon_cmd
($vmid, 'query-pci');
3223 foreach my $pcibus (@$res) {
3224 foreach my $device (@{$pcibus->{devices
}}) {
3225 next if !$device->{'qdev_id'};
3226 if ($device->{'pci_bridge'}) {
3227 $devices->{$device->{'qdev_id'}} = 1;
3228 foreach my $bridge_device (@{$device->{'pci_bridge'}->{devices
}}) {
3229 next if !$bridge_device->{'qdev_id'};
3230 $devices->{$bridge_device->{'qdev_id'}} = 1;
3231 $devices->{$device->{'qdev_id'}}++;
3234 $devices->{$device->{'qdev_id'}} = 1;
3239 my $resblock = vm_mon_cmd
($vmid, 'query-block');
3240 foreach my $block (@$resblock) {
3241 if($block->{device
} =~ m/^drive-(\S+)/){
3246 my $resmice = vm_mon_cmd
($vmid, 'query-mice');
3247 foreach my $mice (@$resmice) {
3248 if ($mice->{name
} eq 'QEMU HID Tablet') {
3249 $devices->{tablet
} = 1;
3258 my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
3260 my $q35 = machine_type_is_q35
($conf);
3262 my $devices_list = vm_devices_list
($vmid);
3263 return 1 if defined($devices_list->{$deviceid});
3265 qemu_add_pci_bridge
($storecfg, $conf, $vmid, $deviceid); # add PCI bridge if we need it for the device
3267 if ($deviceid eq 'tablet') {
3269 qemu_deviceadd
($vmid, print_tabletdevice_full
($conf));
3271 } elsif ($deviceid =~ m/^(virtio)(\d+)$/) {
3273 qemu_iothread_add
($vmid, $deviceid, $device);
3275 qemu_driveadd
($storecfg, $vmid, $device);
3276 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
3278 qemu_deviceadd
($vmid, $devicefull);
3279 eval { qemu_deviceaddverify
($vmid, $deviceid); };
3281 eval { qemu_drivedel
($vmid, $deviceid); };
3286 } elsif ($deviceid =~ m/^(scsihw)(\d+)$/) {
3288 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : "lsi";
3289 my $pciaddr = print_pci_addr
($deviceid);
3290 my $devicefull = "$scsihw,id=$deviceid$pciaddr";
3292 qemu_deviceadd
($vmid, $devicefull);
3293 qemu_deviceaddverify
($vmid, $deviceid);
3295 } elsif ($deviceid =~ m/^(scsi)(\d+)$/) {
3297 qemu_findorcreatescsihw
($storecfg,$conf, $vmid, $device);
3298 qemu_driveadd
($storecfg, $vmid, $device);
3300 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
3301 eval { qemu_deviceadd
($vmid, $devicefull); };
3303 eval { qemu_drivedel
($vmid, $deviceid); };
3308 } elsif ($deviceid =~ m/^(net)(\d+)$/) {
3310 return undef if !qemu_netdevadd
($vmid, $conf, $device, $deviceid);
3311 my $netdevicefull = print_netdevice_full
($vmid, $conf, $device, $deviceid);
3312 qemu_deviceadd
($vmid, $netdevicefull);
3313 eval { qemu_deviceaddverify
($vmid, $deviceid); };
3315 eval { qemu_netdevdel
($vmid, $deviceid); };
3320 } elsif (!$q35 && $deviceid =~ m/^(pci\.)(\d+)$/) {
3323 my $pciaddr = print_pci_addr
($deviceid);
3324 my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
3326 qemu_deviceadd
($vmid, $devicefull);
3327 qemu_deviceaddverify
($vmid, $deviceid);
3330 die "can't hotplug device '$deviceid'\n";
3336 # fixme: this should raise exceptions on error!
3337 sub vm_deviceunplug
{
3338 my ($vmid, $conf, $deviceid) = @_;
3340 my $devices_list = vm_devices_list
($vmid);
3341 return 1 if !defined($devices_list->{$deviceid});
3343 die "can't unplug bootdisk" if $conf->{bootdisk
} && $conf->{bootdisk
} eq $deviceid;
3345 if ($deviceid eq 'tablet') {
3347 qemu_devicedel
($vmid, $deviceid);
3349 } elsif ($deviceid =~ m/^(virtio)(\d+)$/) {
3351 qemu_devicedel
($vmid, $deviceid);
3352 qemu_devicedelverify
($vmid, $deviceid);
3353 qemu_drivedel
($vmid, $deviceid);
3354 qemu_iothread_del
($conf, $vmid, $deviceid);
3356 } elsif ($deviceid =~ m/^(scsihw)(\d+)$/) {
3358 qemu_devicedel
($vmid, $deviceid);
3359 qemu_devicedelverify
($vmid, $deviceid);
3361 } elsif ($deviceid =~ m/^(scsi)(\d+)$/) {
3363 qemu_devicedel
($vmid, $deviceid);
3364 qemu_drivedel
($vmid, $deviceid);
3365 qemu_deletescsihw
($conf, $vmid, $deviceid);
3367 } elsif ($deviceid =~ m/^(net)(\d+)$/) {
3369 qemu_devicedel
($vmid, $deviceid);
3370 qemu_devicedelverify
($vmid, $deviceid);
3371 qemu_netdevdel
($vmid, $deviceid);
3374 die "can't unplug device '$deviceid'\n";
3380 sub qemu_deviceadd
{
3381 my ($vmid, $devicefull) = @_;
3383 $devicefull = "driver=".$devicefull;
3384 my %options = split(/[=,]/, $devicefull);
3386 vm_mon_cmd
($vmid, "device_add" , %options);
3389 sub qemu_devicedel
{
3390 my ($vmid, $deviceid) = @_;
3392 my $ret = vm_mon_cmd
($vmid, "device_del", id
=> $deviceid);
3395 sub qemu_iothread_add
{
3396 my($vmid, $deviceid, $device) = @_;
3398 if ($device->{iothread
}) {
3399 my $iothreads = vm_iothreads_list
($vmid);
3400 qemu_objectadd
($vmid, "iothread-$deviceid", "iothread") if !$iothreads->{"iothread-$deviceid"};
3404 sub qemu_iothread_del
{
3405 my($conf, $vmid, $deviceid) = @_;
3407 my $device = parse_drive
($deviceid, $conf->{$deviceid});
3408 if ($device->{iothread
}) {
3409 my $iothreads = vm_iothreads_list
($vmid);
3410 qemu_objectdel
($vmid, "iothread-$deviceid") if $iothreads->{"iothread-$deviceid"};
3414 sub qemu_objectadd
{
3415 my($vmid, $objectid, $qomtype) = @_;
3417 vm_mon_cmd
($vmid, "object-add", id
=> $objectid, "qom-type" => $qomtype);
3422 sub qemu_objectdel
{
3423 my($vmid, $objectid) = @_;
3425 vm_mon_cmd
($vmid, "object-del", id
=> $objectid);
3431 my ($storecfg, $vmid, $device) = @_;
3433 my $drive = print_drive_full
($storecfg, $vmid, $device);
3434 $drive =~ s/\\/\\\\/g;
3435 my $ret = vm_human_monitor_command
($vmid, "drive_add auto \"$drive\"");
3437 # If the command succeeds qemu prints: "OK
"
3438 return 1 if $ret =~ m/OK/s;
3440 die "adding drive failed
: $ret\n";
3444 my($vmid, $deviceid) = @_;
3446 my $ret = vm_human_monitor_command($vmid, "drive_del drive-
$deviceid");
3449 return 1 if $ret eq "";
3451 # NB: device not found errors mean the drive was auto-deleted and we ignore the error
3452 return 1 if $ret =~ m/Device \'.*?\' not found/s;
3454 die "deleting drive
$deviceid failed
: $ret\n";
3457 sub qemu_deviceaddverify {
3458 my ($vmid, $deviceid) = @_;
3460 for (my $i = 0; $i <= 5; $i++) {
3461 my $devices_list = vm_devices_list($vmid);
3462 return 1 if defined($devices_list->{$deviceid});
3466 die "error on hotplug device
'$deviceid'\n";
3470 sub qemu_devicedelverify {
3471 my ($vmid, $deviceid) = @_;
3473 # need to verify that the device is correctly removed as device_del
3474 # is async and empty return is not reliable
3476 for (my $i = 0; $i <= 5; $i++) {
3477 my $devices_list = vm_devices_list($vmid);
3478 return 1 if !defined($devices_list->{$deviceid});
3482 die "error on hot-unplugging device
'$deviceid'\n";
3485 sub qemu_findorcreatescsihw {
3486 my ($storecfg, $conf, $vmid, $device) = @_;
3488 my $maxdev = ($conf->{scsihw} && ($conf->{scsihw} !~ m/^lsi/)) ? 256 : 7;
3489 my $controller = int($device->{index} / $maxdev);
3490 my $scsihwid="scsihw
$controller";
3491 my $devices_list = vm_devices_list($vmid);
3493 if(!defined($devices_list->{$scsihwid})) {
3494 vm_deviceplug($storecfg, $conf, $vmid, $scsihwid);
3500 sub qemu_deletescsihw {
3501 my ($conf, $vmid, $opt) = @_;
3503 my $device = parse_drive($opt, $conf->{$opt});
3505 my $maxdev = ($conf->{scsihw} && ($conf->{scsihw} !~ m/^lsi/)) ? 256 : 7;
3506 my $controller = int($device->{index} / $maxdev);
3508 my $devices_list = vm_devices_list($vmid);
3509 foreach my $opt (keys %{$devices_list}) {
3510 if (PVE::QemuServer::valid_drivename($opt)) {
3511 my $drive = PVE::QemuServer::parse_drive($opt, $conf->{$opt});
3512 if($drive->{interface} eq 'scsi' && $drive->{index} < (($maxdev-1)*($controller+1))) {
3518 my $scsihwid="scsihw
$controller";
3520 vm_deviceunplug($vmid, $conf, $scsihwid);
3525 sub qemu_add_pci_bridge {
3526 my ($storecfg, $conf, $vmid, $device) = @_;
3532 print_pci_addr($device, $bridges);
3534 while (my ($k, $v) = each %$bridges) {
3537 return 1 if !defined($bridgeid) || $bridgeid < 1;
3539 my $bridge = "pci
.$bridgeid";
3540 my $devices_list = vm_devices_list($vmid);
3542 if (!defined($devices_list->{$bridge})) {
3543 vm_deviceplug($storecfg, $conf, $vmid, $bridge);
3549 sub qemu_set_link_status {
3550 my ($vmid, $device, $up) = @_;
3552 vm_mon_cmd($vmid, "set_link
", name => $device,
3553 up => $up ? JSON::true : JSON::false);
3556 sub qemu_netdevadd {
3557 my ($vmid, $conf, $device, $deviceid) = @_;
3559 my $netdev = print_netdev_full($vmid, $conf, $device, $deviceid);
3560 my %options = split(/[=,]/, $netdev);
3562 vm_mon_cmd($vmid, "netdev_add
", %options);
3566 sub qemu_netdevdel {
3567 my ($vmid, $deviceid) = @_;
3569 vm_mon_cmd($vmid, "netdev_del
", id => $deviceid);
3572 sub qemu_cpu_hotplug {
3573 my ($vmid, $conf, $vcpus) = @_;
3576 $sockets = $conf->{smp} if $conf->{smp}; # old style - no longer iused
3577 $sockets = $conf->{sockets} if $conf->{sockets};
3578 my $cores = $conf->{cores} || 1;
3579 my $maxcpus = $sockets * $cores;
3581 $vcpus = $maxcpus if !$vcpus;
3583 die "you can
't add more vcpus than maxcpus\n"
3584 if $vcpus > $maxcpus;
3586 my $currentvcpus = $conf->{vcpus} || $maxcpus;
3587 die "online cpu unplug is not yet possible\n"
3588 if $vcpus < $currentvcpus;
3590 my $currentrunningvcpus = vm_mon_cmd($vmid, "query-cpus");
3591 die "vcpus in running vm is different than configuration\n"
3592 if scalar(@{$currentrunningvcpus}) != $currentvcpus;
3594 for (my $i = $currentvcpus; $i < $vcpus; $i++) {
3595 vm_mon_cmd($vmid, "cpu-add", id => int($i));
3599 sub qemu_memory_hotplug {
3600 my ($vmid, $conf, $defaults, $opt, $value) = @_;
3602 return $value if !check_running($vmid);
3604 my $memory = $conf->{memory} || $defaults->{memory};
3605 $value = $defaults->{memory} if !$value;
3606 return $value if $value == $memory;
3608 my $static_memory = $STATICMEM;
3609 my $dimm_memory = $memory - $static_memory;
3611 die "memory can't be lower than
$static_memory MB
" if $value < $static_memory;
3612 die "memory unplug
is not yet available
" if $value < $memory;
3613 die "you cannot add more memory than
$MAX_MEM MB
!\n" if $memory > $MAX_MEM;
3617 $sockets = $conf->{sockets} if $conf->{sockets};
3619 foreach_dimm($conf, $vmid, $value, $sockets, sub {
3620 my ($conf, $vmid, $name, $dimm_size, $numanode, $current_size, $memory) = @_;
3622 return if $current_size <= $conf->{memory};
3624 eval { vm_mon_cmd($vmid, "object-add
", 'qom-type' => "memory-backend-ram
", id => "mem-
$name", props => { size => int($dimm_size*1024*1024) } ) };
3626 eval { qemu_objectdel($vmid, "mem-
$name"); };
3630 eval { vm_mon_cmd($vmid, "device_add
", driver => "pc-dimm
", id => "$name", memdev => "mem-
$name", node => $numanode) };
3632 eval { qemu_objectdel($vmid, "mem-
$name"); };
3635 #update conf after each succesful module hotplug
3636 $conf->{memory} = $current_size;
3637 update_config_nolock($vmid, $conf, 1);
3641 sub qemu_block_set_io_throttle {
3642 my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
3644 return if !check_running($vmid) ;
3646 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));
3650 # old code, only used to shutdown old VM after update
3652 my ($fh, $timeout) = @_;
3654 my $sel = new IO::Select;
3661 while (scalar (@ready = $sel->can_read($timeout))) {
3663 if ($count = $fh->sysread($buf, 8192)) {
3664 if ($buf =~ /^(.*)\(qemu\) $/s) {
3671 if (!defined($count)) {
3678 die "monitor
read timeout
\n" if !scalar(@ready);
3683 # old code, only used to shutdown old VM after update
3684 sub vm_monitor_command {
3685 my ($vmid, $cmdstr, $nocheck) = @_;
3690 die "VM
$vmid not running
\n" if !check_running($vmid, $nocheck);
3692 my $sname = "${var_run_tmpdir
}/$vmid.mon
";
3694 my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
3695 die "unable to
connect to VM
$vmid socket - $!\n";
3699 # hack: migrate sometime blocks the monitor (when migrate_downtime
3701 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3702 $timeout = 60*60; # 1 hour
3706 my $data = __read_avail($sock, $timeout);
3708 if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
3709 die "got unexpected qemu monitor banner
\n";
3712 my $sel = new IO::Select;
3715 if (!scalar(my @ready = $sel->can_write($timeout))) {
3716 die "monitor
write error
- timeout
";
3719 my $fullcmd = "$cmdstr\r";
3721 # syslog('info', "VM
$vmid monitor command
: $cmdstr");
3724 if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
3725 die "monitor
write error
- $!";
3728 return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
3732 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3733 $timeout = 60*60; # 1 hour
3734 } elsif ($cmdstr =~ m/^(eject|change)/) {
3735 $timeout = 60; # note: cdrom mount command is slow
3737 if ($res = __read_avail($sock, $timeout)) {
3739 my @lines = split("\r?
\n", $res);
3741 shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
3743 $res = join("\n", @lines);
3751 syslog("err
", "VM
$vmid monitor command failed
- $err");
3758 sub qemu_block_resize {
3759 my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
3761 my $running = check_running($vmid);
3763 return if !PVE::Storage::volume_resize($storecfg, $volid, $size, $running);
3765 return if !$running;
3767 vm_mon_cmd($vmid, "block_resize
", device => $deviceid, size => int($size));
3771 sub qemu_volume_snapshot {
3772 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3774 my $running = check_running($vmid);
3776 return if !PVE::Storage::volume_snapshot($storecfg, $volid, $snap, $running);
3778 return if !$running;
3780 vm_mon_cmd($vmid, "snapshot-drive
", device => $deviceid, name => $snap);
3784 sub qemu_volume_snapshot_delete {
3785 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3787 my $running = check_running($vmid);
3789 return if !PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snap, $running);
3791 return if !$running;
3793 vm_mon_cmd($vmid, "delete-drive-snapshot
", device => $deviceid, name => $snap);
3796 sub set_migration_caps {
3802 "auto-converge
" => 1,
3804 "x-rdma-pin-all
" => 0,
3808 my $supported_capabilities = vm_mon_cmd_nocheck($vmid, "query-migrate-capabilities
");
3810 for my $supported_capability (@$supported_capabilities) {
3812 capability => $supported_capability->{capability},
3813 state => $enabled_cap->{$supported_capability->{capability}} ? JSON::true : JSON::false,
3817 vm_mon_cmd_nocheck($vmid, "migrate-set-capabilities
", capabilities => $cap_ref);
3820 my $fast_plug_option = {
3828 # hotplug changes in [PENDING]
3829 # $selection hash can be used to only apply specified options, for
3830 # example: { cores => 1 } (only apply changed 'cores')
3831 # $errors ref is used to return error messages
3832 sub vmconfig_hotplug_pending {
3833 my ($vmid, $conf, $storecfg, $selection, $errors) = @_;
3835 my $defaults = load_defaults();
3837 # commit values which do not have any impact on running VM first
3838 # Note: those option cannot raise errors, we we do not care about
3839 # $selection and always apply them.
3841 my $add_error = sub {
3842 my ($opt, $msg) = @_;
3843 $errors->{$opt} = "hotplug problem
- $msg";
3847 foreach my $opt (keys %{$conf->{pending}}) { # add/change
3848 if ($fast_plug_option->{$opt}) {
3849 $conf->{$opt} = $conf->{pending}->{$opt};
3850 delete $conf->{pending}->{$opt};
3856 update_config_nolock($vmid, $conf, 1);
3857 $conf = load_config($vmid); # update/reload
3860 my $hotplug_features = parse_hotplug_features(defined($conf->{hotplug}) ? $conf->{hotplug} : '1');
3862 my @delete = PVE::Tools::split_list($conf->{pending}->{delete});
3863 foreach my $opt (@delete) {
3864 next if $selection && !$selection->{$opt};
3866 if ($opt eq 'hotplug') {
3867 die "skip
\n" if ($conf->{hotplug} =~ /memory/);
3868 } elsif ($opt eq 'tablet') {
3869 die "skip
\n" if !$hotplug_features->{usb};
3870 if ($defaults->{tablet}) {
3871 vm_deviceplug($storecfg, $conf, $vmid, $opt);
3873 vm_deviceunplug($vmid, $conf, $opt);
3875 } elsif ($opt eq 'vcpus') {
3876 die "skip
\n" if !$hotplug_features->{cpu};
3877 qemu_cpu_hotplug($vmid, $conf, undef);
3878 } elsif ($opt eq 'balloon') {
3879 # enable balloon device is not hotpluggable
3880 die "skip
\n" if !defined($conf->{balloon}) || $conf->{balloon};
3881 } elsif ($fast_plug_option->{$opt}) {
3883 } elsif ($opt =~ m/^net(\d+)$/) {
3884 die "skip
\n" if !$hotplug_features->{network};
3885 vm_deviceunplug($vmid, $conf, $opt);
3886 } elsif (valid_drivename($opt)) {
3887 die "skip
\n" if !$hotplug_features->{disk} || $opt =~ m/(ide|sata)(\d+)/;
3888 vm_deviceunplug($vmid, $conf, $opt);
3889 vmconfig_register_unused_drive($storecfg, $vmid, $conf, parse_drive($opt, $conf->{$opt}));
3890 } elsif ($opt =~ m/^memory$/) {
3891 die "skip
\n" if !$hotplug_features->{memory};
3892 qemu_memory_hotplug($vmid, $conf, $defaults, $opt);
3898 &$add_error($opt, $err) if $err ne "skip
\n";
3900 # save new config if hotplug was successful
3901 delete $conf->{$opt};
3902 vmconfig_undelete_pending_option($conf, $opt);
3903 update_config_nolock($vmid, $conf, 1);
3904 $conf = load_config($vmid); # update/reload
3908 foreach my $opt (keys %{$conf->{pending}}) {
3909 next if $selection && !$selection->{$opt};
3910 my $value = $conf->{pending}->{$opt};
3912 if ($opt eq 'hotplug') {
3913 die "skip
\n" if ($value =~ /memory/) || ($value !~ /memory/ && $conf->{hotplug} =~ /memory/);
3914 } elsif ($opt eq 'tablet') {
3915 die "skip
\n" if !$hotplug_features->{usb};
3917 vm_deviceplug($storecfg, $conf, $vmid, $opt);
3918 } elsif ($value == 0) {
3919 vm_deviceunplug($vmid, $conf, $opt);
3921 } elsif ($opt eq 'vcpus') {
3922 die "skip
\n" if !$hotplug_features->{cpu};
3923 qemu_cpu_hotplug($vmid, $conf, $value);
3924 } elsif ($opt eq 'balloon') {
3925 # enable/disable balloning device is not hotpluggable
3926 my $old_balloon_enabled = !!(!defined($conf->{balloon}) || $conf->{balloon});
3927 my $new_balloon_enabled = !!(!defined($conf->{pending}->{balloon}) || $conf->{pending}->{balloon});
3928 die "skip
\n" if $old_balloon_enabled != $new_balloon_enabled;
3930 # allow manual ballooning if shares is set to zero
3931 if ((defined($conf->{shares}) && ($conf->{shares} == 0))) {
3932 my $balloon = $conf->{pending}->{balloon} || $conf->{memory} || $defaults->{memory};
3933 vm_mon_cmd($vmid, "balloon
", value => $balloon*1024*1024);
3935 } elsif ($opt =~ m/^net(\d+)$/) {
3936 # some changes can be done without hotplug
3937 vmconfig_update_net($storecfg, $conf, $hotplug_features->{network},
3938 $vmid, $opt, $value);
3939 } elsif (valid_drivename($opt)) {
3940 # some changes can be done without hotplug
3941 vmconfig_update_disk($storecfg, $conf, $hotplug_features->{disk},
3942 $vmid, $opt, $value, 1);
3943 } elsif ($opt =~ m/^memory$/) { #dimms
3944 die "skip
\n" if !$hotplug_features->{memory};
3945 $value = qemu_memory_hotplug($vmid, $conf, $defaults, $opt, $value);
3947 die "skip
\n"; # skip non-hot-pluggable options
3951 &$add_error($opt, $err) if $err ne "skip
\n";
3953 # save new config if hotplug was successful
3954 $conf->{$opt} = $value;
3955 delete $conf->{pending}->{$opt};
3956 update_config_nolock($vmid, $conf, 1);
3957 $conf = load_config($vmid); # update/reload
3962 sub vmconfig_apply_pending {
3963 my ($vmid, $conf, $storecfg) = @_;
3967 my @delete = PVE::Tools::split_list($conf->{pending}->{delete});
3968 foreach my $opt (@delete) { # delete
3969 die "internal error
" if $opt =~ m/^unused/;
3970 $conf = load_config($vmid); # update/reload
3971 if (!defined($conf->{$opt})) {
3972 vmconfig_undelete_pending_option($conf, $opt);
3973 update_config_nolock($vmid, $conf, 1);
3974 } elsif (valid_drivename($opt)) {
3975 vmconfig_register_unused_drive($storecfg, $vmid, $conf, parse_drive($opt, $conf->{$opt}));
3976 vmconfig_undelete_pending_option($conf, $opt);
3977 delete $conf->{$opt};
3978 update_config_nolock($vmid, $conf, 1);
3980 vmconfig_undelete_pending_option($conf, $opt);
3981 delete $conf->{$opt};
3982 update_config_nolock($vmid, $conf, 1);
3986 $conf = load_config($vmid); # update/reload
3988 foreach my $opt (keys %{$conf->{pending}}) { # add/change
3989 $conf = load_config($vmid); # update/reload
3991 if (defined($conf->{$opt}) && ($conf->{$opt} eq $conf->{pending}->{$opt})) {
3992 # skip if nothing changed
3993 } elsif (valid_drivename($opt)) {
3994 vmconfig_register_unused_drive($storecfg, $vmid, $conf, parse_drive($opt, $conf->{$opt}))
3995 if defined($conf->{$opt});
3996 $conf->{$opt} = $conf->{pending}->{$opt};
3998 $conf->{$opt} = $conf->{pending}->{$opt};
4001 delete $conf->{pending}->{$opt};
4002 update_config_nolock($vmid, $conf, 1);
4006 my $safe_num_ne = sub {
4009 return 0 if !defined($a) && !defined($b);
4010 return 1 if !defined($a);
4011 return 1 if !defined($b);
4016 my $safe_string_ne = sub {
4019 return 0 if !defined($a) && !defined($b);
4020 return 1 if !defined($a);
4021 return 1 if !defined($b);
4026 sub vmconfig_update_net {
4027 my ($storecfg, $conf, $hotplug, $vmid, $opt, $value) = @_;
4029 my $newnet = parse_net($value);
4031 if ($conf->{$opt}) {
4032 my $oldnet = parse_net($conf->{$opt});
4034 if (&$safe_string_ne($oldnet->{model}, $newnet->{model}) ||
4035 &$safe_string_ne($oldnet->{macaddr}, $newnet->{macaddr}) ||
4036 &$safe_num_ne($oldnet->{queues}, $newnet->{queues}) ||
4037 !($newnet->{bridge} && $oldnet->{bridge})) { # bridge/nat mode change
4039 # for non online change, we try to hot-unplug
4040 die "skip
\n" if !$hotplug;
4041 vm_deviceunplug($vmid, $conf, $opt);
4044 die "internal error
" if $opt !~ m/net(\d+)/;
4045 my $iface = "tap
${vmid
}i
$1";
4047 if (&$safe_num_ne($oldnet->{rate}, $newnet->{rate})) {
4048 PVE::Network::tap_rate_limit($iface, $newnet->{rate});
4051 if (&$safe_string_ne($oldnet->{bridge}, $newnet->{bridge}) ||
4052 &$safe_num_ne($oldnet->{tag}, $newnet->{tag}) ||
4053 &$safe_num_ne($oldnet->{firewall}, $newnet->{firewall})) {
4054 PVE::Network::tap_unplug($iface);
4055 PVE::Network::tap_plug($iface, $newnet->{bridge}, $newnet->{tag}, $newnet->{firewall});
4058 if (&$safe_string_ne($oldnet->{link_down}, $newnet->{link_down})) {
4059 qemu_set_link_status($vmid, $opt, !$newnet->{link_down});
4067 vm_deviceplug($storecfg, $conf, $vmid, $opt, $newnet);
4073 sub vmconfig_update_disk {
4074 my ($storecfg, $conf, $hotplug, $vmid, $opt, $value, $force) = @_;
4076 # fixme: do we need force?
4078 my $drive = parse_drive($opt, $value);
4080 if ($conf->{$opt}) {
4082 if (my $old_drive = parse_drive($opt, $conf->{$opt})) {
4084 my $media = $drive->{media} || 'disk';
4085 my $oldmedia = $old_drive->{media} || 'disk';
4086 die "unable to change media type
\n" if $media ne $oldmedia;
4088 if (!drive_is_cdrom($old_drive)) {
4090 if ($drive->{file} ne $old_drive->{file}) {
4092 die "skip
\n" if !$hotplug;
4094 # unplug and register as unused
4095 vm_deviceunplug($vmid, $conf, $opt);
4096 vmconfig_register_unused_drive($storecfg, $vmid, $conf, $old_drive)
4099 # update existing disk
4101 # skip non hotpluggable value
4102 if (&$safe_num_ne($drive->{discard}, $old_drive->{discard}) ||
4103 &$safe_string_ne($drive->{iothread}, $old_drive->{iothread}) ||
4104 &$safe_string_ne($drive->{cache}, $old_drive->{cache})) {
4109 if (&$safe_num_ne($drive->{mbps}, $old_drive->{mbps}) ||
4110 &$safe_num_ne($drive->{mbps_rd}, $old_drive->{mbps_rd}) ||
4111 &$safe_num_ne($drive->{mbps_wr}, $old_drive->{mbps_wr}) ||
4112 &$safe_num_ne($drive->{iops}, $old_drive->{iops}) ||
4113 &$safe_num_ne($drive->{iops_rd}, $old_drive->{iops_rd}) ||
4114 &$safe_num_ne($drive->{iops_wr}, $old_drive->{iops_wr}) ||
4115 &$safe_num_ne($drive->{mbps_max}, $old_drive->{mbps_max}) ||
4116 &$safe_num_ne($drive->{mbps_rd_max}, $old_drive->{mbps_rd_max}) ||
4117 &$safe_num_ne($drive->{mbps_wr_max}, $old_drive->{mbps_wr_max}) ||
4118 &$safe_num_ne($drive->{iops_max}, $old_drive->{iops_max}) ||
4119 &$safe_num_ne($drive->{iops_rd_max}, $old_drive->{iops_rd_max}) ||
4120 &$safe_num_ne($drive->{iops_wr_max}, $old_drive->{iops_wr_max})) {
4122 qemu_block_set_io_throttle($vmid,"drive-
$opt",
4123 ($drive->{mbps} || 0)*1024*1024,
4124 ($drive->{mbps_rd} || 0)*1024*1024,
4125 ($drive->{mbps_wr} || 0)*1024*1024,
4126 $drive->{iops} || 0,
4127 $drive->{iops_rd} || 0,
4128 $drive->{iops_wr} || 0,
4129 ($drive->{mbps_max} || 0)*1024*1024,
4130 ($drive->{mbps_rd_max} || 0)*1024*1024,
4131 ($drive->{mbps_wr_max} || 0)*1024*1024,
4132 $drive->{iops_max} || 0,
4133 $drive->{iops_rd_max} || 0,
4134 $drive->{iops_wr_max} || 0);
4143 if ($drive->{file} eq 'none') {
4144 vm_mon_cmd($vmid, "eject
",force => JSON::true,device => "drive-
$opt");
4146 my $path = get_iso_path($storecfg, $vmid, $drive->{file});
4147 vm_mon_cmd($vmid, "eject
", force => JSON::true,device => "drive-
$opt"); # force eject if locked
4148 vm_mon_cmd($vmid, "change
", device => "drive-
$opt",target => "$path") if $path;
4156 die "skip
\n" if !$hotplug || $opt =~ m/(ide|sata)(\d+)/;
4158 vm_deviceplug($storecfg, $conf, $vmid, $opt, $drive);
4162 my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused, $forcemachine, $spice_ticket) = @_;
4164 lock_config($vmid, sub {
4165 my $conf = load_config($vmid, $migratedfrom);
4167 die "you can
't start a vm if it's a template
\n" if is_template($conf);
4169 check_lock($conf) if !$skiplock;
4171 die "VM
$vmid already running
\n" if check_running($vmid, undef, $migratedfrom);
4173 if (!$statefile && scalar(keys %{$conf->{pending}})) {
4174 vmconfig_apply_pending($vmid, $conf, $storecfg);
4175 $conf = load_config($vmid); # update/reload
4178 my $defaults = load_defaults();
4180 # set environment variable useful inside network script
4181 $ENV{PVE_MIGRATED_FROM} = $migratedfrom if $migratedfrom;
4183 my ($cmd, $vollist, $spice_port) = config_to_command($storecfg, $vmid, $conf, $defaults, $forcemachine);
4185 my $migrate_port = 0;
4188 if ($statefile eq 'tcp') {
4189 my $localip = "localhost
";
4190 my $datacenterconf = PVE::Cluster::cfs_read_file('datacenter.cfg');
4191 if ($datacenterconf->{migration_unsecure}) {
4192 my $nodename = PVE::INotify::nodename();
4193 $localip = PVE::Cluster::remote_node_ip($nodename, 1);
4195 $migrate_port = PVE::Tools::next_migrate_port();
4196 $migrate_uri = "tcp
:${localip
}:${migrate_port
}";
4197 push @$cmd, '-incoming', $migrate_uri;
4200 push @$cmd, '-loadstate', $statefile;
4207 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
4208 my $d = parse_hostpci($conf->{"hostpci
$i"});
4210 my $pcidevices = $d->{pciid};
4211 foreach my $pcidevice (@$pcidevices) {
4212 my $pciid = $pcidevice->{id}.".".$pcidevice->{function};
4214 my $info = pci_device_info("0000:$pciid");
4215 die "IOMMU
not present
\n" if !check_iommu_support();
4216 die "no pci device info
for device
'$pciid'\n" if !$info;
4218 if ($d->{driver} && $d->{driver} eq "vfio
") {
4219 die "can
't unbind/bind pci group to vfio '$pciid'\n" if !pci_dev_group_bind_to_vfio($pciid);
4221 die "can't unbind
/bind to stub pci device
'$pciid'\n" if !pci_dev_bind_to_stub($info);
4224 die "can
't reset pci device '$pciid'\n" if $info->{has_fl_reset} and !pci_dev_reset($info);
4228 PVE::Storage::activate_volumes($storecfg, $vollist);
4230 eval { run_command($cmd, timeout => $statefile ? undef : 30,
4233 die "start failed: $err" if $err;
4235 print "migration listens on $migrate_uri\n" if $migrate_uri;
4237 if ($statefile && $statefile ne 'tcp
') {
4238 eval { vm_mon_cmd_nocheck($vmid, "cont"); };
4242 if ($migratedfrom) {
4245 set_migration_caps($vmid);
4250 print "spice listens on port $spice_port\n";
4251 if ($spice_ticket) {
4252 vm_mon_cmd_nocheck($vmid, "set_password", protocol => 'spice
', password => $spice_ticket);
4253 vm_mon_cmd_nocheck($vmid, "expire_password", protocol => 'spice
', time => "+30");
4259 if (!$statefile && (!defined($conf->{balloon}) || $conf->{balloon})) {
4260 vm_mon_cmd_nocheck($vmid, "balloon", value => $conf->{balloon}*1024*1024)
4261 if $conf->{balloon};
4264 foreach my $opt (keys %$conf) {
4265 next if $opt !~ m/^net\d+$/;
4266 my $nicconf = parse_net($conf->{$opt});
4267 qemu_set_link_status($vmid, $opt, 0) if $nicconf->{link_down};
4271 vm_mon_cmd_nocheck($vmid, 'qom-set
',
4272 path => "machine/peripheral/balloon0",
4273 property => "guest-stats-polling-interval",
4274 value => 2) if (!defined($conf->{balloon}) || $conf->{balloon});
4280 my ($vmid, $execute, %params) = @_;
4282 my $cmd = { execute => $execute, arguments => \%params };
4283 vm_qmp_command($vmid, $cmd);
4286 sub vm_mon_cmd_nocheck {
4287 my ($vmid, $execute, %params) = @_;
4289 my $cmd = { execute => $execute, arguments => \%params };
4290 vm_qmp_command($vmid, $cmd, 1);
4293 sub vm_qmp_command {
4294 my ($vmid, $cmd, $nocheck) = @_;
4299 if ($cmd->{arguments} && $cmd->{arguments}->{timeout}) {
4300 $timeout = $cmd->{arguments}->{timeout};
4301 delete $cmd->{arguments}->{timeout};
4305 die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
4306 my $sname = qmp_socket($vmid);
4307 if (-e $sname) { # test if VM is reasonambe new and supports qmp/qga
4308 my $qmpclient = PVE::QMPClient->new();
4310 $res = $qmpclient->cmd($vmid, $cmd, $timeout);
4311 } elsif (-e "${var_run_tmpdir}/$vmid.mon") {
4312 die "can't execute complex command on old monitor
- stop
/start your vm to fix the problem
\n"
4313 if scalar(%{$cmd->{arguments}});
4314 vm_monitor_command($vmid, $cmd->{execute}, $nocheck);
4316 die "unable to
open monitor
socket\n";
4320 syslog("err
", "VM
$vmid qmp command failed
- $err");
4327 sub vm_human_monitor_command {
4328 my ($vmid, $cmdline) = @_;
4333 execute => 'human-monitor-command',
4334 arguments => { 'command-line' => $cmdline},
4337 return vm_qmp_command($vmid, $cmd);
4340 sub vm_commandline {
4341 my ($storecfg, $vmid) = @_;
4343 my $conf = load_config($vmid);
4345 my $defaults = load_defaults();
4347 my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
4349 return join(' ', @$cmd);
4353 my ($vmid, $skiplock) = @_;
4355 lock_config($vmid, sub {
4357 my $conf = load_config($vmid);
4359 check_lock($conf) if !$skiplock;
4361 vm_mon_cmd($vmid, "system_reset
");
4365 sub get_vm_volumes {
4369 foreach_volid($conf, sub {
4370 my ($volid, $is_cdrom) = @_;
4372 return if $volid =~ m|^/|;
4374 my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
4377 push @$vollist, $volid;
4383 sub vm_stop_cleanup {
4384 my ($storecfg, $vmid, $conf, $keepActive, $apply_pending_changes) = @_;
4387 fairsched_rmnod($vmid); # try to destroy group
4390 my $vollist = get_vm_volumes($conf);
4391 PVE::Storage::deactivate_volumes($storecfg, $vollist);
4394 foreach my $ext (qw(mon qmp pid vnc qga)) {
4395 unlink "/var/run/qemu-server/${vmid}.$ext";
4398 vmconfig_apply_pending
($vmid, $conf, $storecfg) if $apply_pending_changes;
4400 warn $@ if $@; # avoid errors - just warn
4403 # Note: use $nockeck to skip tests if VM configuration file exists.
4404 # We need that when migration VMs to other nodes (files already moved)
4405 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
4407 my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
4409 $force = 1 if !defined($force) && !$shutdown;
4412 my $pid = check_running
($vmid, $nocheck, $migratedfrom);
4413 kill 15, $pid if $pid;
4414 my $conf = load_config
($vmid, $migratedfrom);
4415 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive, 0);
4419 lock_config
($vmid, sub {
4421 my $pid = check_running
($vmid, $nocheck);
4426 $conf = load_config
($vmid);
4427 check_lock
($conf) if !$skiplock;
4428 if (!defined($timeout) && $shutdown && $conf->{startup
}) {
4429 my $opts = parse_startup
($conf->{startup
});
4430 $timeout = $opts->{down
} if $opts->{down
};
4434 $timeout = 60 if !defined($timeout);
4438 if (defined($conf) && $conf->{agent
}) {
4439 vm_qmp_command
($vmid, { execute
=> "guest-shutdown" }, $nocheck);
4441 vm_qmp_command
($vmid, { execute
=> "system_powerdown" }, $nocheck);
4444 vm_qmp_command
($vmid, { execute
=> "quit" }, $nocheck);
4451 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
4456 if ($count >= $timeout) {
4458 warn "VM still running - terminating now with SIGTERM\n";
4461 die "VM quit/powerdown failed - got timeout\n";
4464 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive, 1) if $conf;
4469 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
4472 die "VM quit/powerdown failed\n";
4480 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
4485 if ($count >= $timeout) {
4486 warn "VM still running - terminating now with SIGKILL\n";
4491 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive, 1) if $conf;
4496 my ($vmid, $skiplock) = @_;
4498 lock_config
($vmid, sub {
4500 my $conf = load_config
($vmid);
4502 check_lock
($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
4504 vm_mon_cmd
($vmid, "stop");
4509 my ($vmid, $skiplock) = @_;
4511 lock_config
($vmid, sub {
4513 my $conf = load_config
($vmid);
4515 check_lock
($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
4517 vm_mon_cmd
($vmid, "cont");
4522 my ($vmid, $skiplock, $key) = @_;
4524 lock_config
($vmid, sub {
4526 my $conf = load_config
($vmid);
4528 # there is no qmp command, so we use the human monitor command
4529 vm_human_monitor_command
($vmid, "sendkey $key");
4534 my ($storecfg, $vmid, $skiplock) = @_;
4536 lock_config
($vmid, sub {
4538 my $conf = load_config
($vmid);
4540 check_lock
($conf) if !$skiplock;
4542 if (!check_running
($vmid)) {
4543 fairsched_rmnod
($vmid); # try to destroy group
4544 destroy_vm
($storecfg, $vmid);
4546 die "VM $vmid is running - destroy failed\n";
4554 my ($filename, $buf) = @_;
4556 my $fh = IO
::File-
>new($filename, "w");
4557 return undef if !$fh;
4559 my $res = print $fh $buf;
4566 sub pci_device_info
{
4571 return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
4572 my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
4574 my $irq = file_read_firstline
("$pcisysfs/devices/$name/irq");
4575 return undef if !defined($irq) || $irq !~ m/^\d+$/;
4577 my $vendor = file_read_firstline
("$pcisysfs/devices/$name/vendor");
4578 return undef if !defined($vendor) || $vendor !~ s/^0x//;
4580 my $product = file_read_firstline
("$pcisysfs/devices/$name/device");
4581 return undef if !defined($product) || $product !~ s/^0x//;
4586 product
=> $product,
4592 has_fl_reset
=> -f
"$pcisysfs/devices/$name/reset" || 0,
4601 my $name = $dev->{name
};
4603 my $fn = "$pcisysfs/devices/$name/reset";
4605 return file_write
($fn, "1");
4608 sub pci_dev_bind_to_stub
{
4611 my $name = $dev->{name
};
4613 my $testdir = "$pcisysfs/drivers/pci-stub/$name";
4614 return 1 if -d
$testdir;
4616 my $data = "$dev->{vendor} $dev->{product}";
4617 return undef if !file_write
("$pcisysfs/drivers/pci-stub/new_id", $data);
4619 my $fn = "$pcisysfs/devices/$name/driver/unbind";
4620 if (!file_write
($fn, $name)) {
4621 return undef if -f
$fn;
4624 $fn = "$pcisysfs/drivers/pci-stub/bind";
4625 if (! -d
$testdir) {
4626 return undef if !file_write
($fn, $name);
4632 sub pci_dev_bind_to_vfio
{
4635 my $name = $dev->{name
};
4637 my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4639 if (!-d
$vfio_basedir) {
4640 system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4642 die "Cannot find vfio-pci module!\n" if !-d
$vfio_basedir;
4644 my $testdir = "$vfio_basedir/$name";
4645 return 1 if -d
$testdir;
4647 my $data = "$dev->{vendor} $dev->{product}";
4648 return undef if !file_write
("$vfio_basedir/new_id", $data);
4650 my $fn = "$pcisysfs/devices/$name/driver/unbind";
4651 if (!file_write
($fn, $name)) {
4652 return undef if -f
$fn;
4655 $fn = "$vfio_basedir/bind";
4656 if (! -d
$testdir) {
4657 return undef if !file_write
($fn, $name);
4663 sub pci_dev_group_bind_to_vfio
{
4666 my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4668 if (!-d
$vfio_basedir) {
4669 system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4671 die "Cannot find vfio-pci module!\n" if !-d
$vfio_basedir;
4673 # get IOMMU group devices
4674 opendir(my $D, "$pcisysfs/devices/0000:$pciid/iommu_group/devices/") || die "Cannot open iommu_group: $!\n";
4675 my @devs = grep /^0000:/, readdir($D);
4678 foreach my $pciid (@devs) {
4679 $pciid =~ m/^([:\.\da-f]+)$/ or die "PCI ID $pciid not valid!\n";
4681 # pci bridges, switches or root ports are not supported
4682 # they have a pci_bus subdirectory so skip them
4683 next if (-e
"$pcisysfs/devices/$pciid/pci_bus");
4685 my $info = pci_device_info
($1);
4686 pci_dev_bind_to_vfio
($info) || die "Cannot bind $pciid to vfio\n";
4692 sub print_pci_addr
{
4693 my ($id, $bridges) = @_;
4697 piix3
=> { bus
=> 0, addr
=> 1 },
4698 #addr2 : first videocard
4699 balloon0
=> { bus
=> 0, addr
=> 3 },
4700 watchdog
=> { bus
=> 0, addr
=> 4 },
4701 scsihw0
=> { bus
=> 0, addr
=> 5 },
4702 scsihw1
=> { bus
=> 0, addr
=> 6 },
4703 ahci0
=> { bus
=> 0, addr
=> 7 },
4704 qga0
=> { bus
=> 0, addr
=> 8 },
4705 spice
=> { bus
=> 0, addr
=> 9 },
4706 virtio0
=> { bus
=> 0, addr
=> 10 },
4707 virtio1
=> { bus
=> 0, addr
=> 11 },
4708 virtio2
=> { bus
=> 0, addr
=> 12 },
4709 virtio3
=> { bus
=> 0, addr
=> 13 },
4710 virtio4
=> { bus
=> 0, addr
=> 14 },
4711 virtio5
=> { bus
=> 0, addr
=> 15 },
4712 hostpci0
=> { bus
=> 0, addr
=> 16 },
4713 hostpci1
=> { bus
=> 0, addr
=> 17 },
4714 net0
=> { bus
=> 0, addr
=> 18 },
4715 net1
=> { bus
=> 0, addr
=> 19 },
4716 net2
=> { bus
=> 0, addr
=> 20 },
4717 net3
=> { bus
=> 0, addr
=> 21 },
4718 net4
=> { bus
=> 0, addr
=> 22 },
4719 net5
=> { bus
=> 0, addr
=> 23 },
4720 vga1
=> { bus
=> 0, addr
=> 24 },
4721 vga2
=> { bus
=> 0, addr
=> 25 },
4722 vga3
=> { bus
=> 0, addr
=> 26 },
4723 hostpci2
=> { bus
=> 0, addr
=> 27 },
4724 hostpci3
=> { bus
=> 0, addr
=> 28 },
4725 #addr29 : usb-host (pve-usb.cfg)
4726 'pci.1' => { bus
=> 0, addr
=> 30 },
4727 'pci.2' => { bus
=> 0, addr
=> 31 },
4728 'net6' => { bus
=> 1, addr
=> 1 },
4729 'net7' => { bus
=> 1, addr
=> 2 },
4730 'net8' => { bus
=> 1, addr
=> 3 },
4731 'net9' => { bus
=> 1, addr
=> 4 },
4732 'net10' => { bus
=> 1, addr
=> 5 },
4733 'net11' => { bus
=> 1, addr
=> 6 },
4734 'net12' => { bus
=> 1, addr
=> 7 },
4735 'net13' => { bus
=> 1, addr
=> 8 },
4736 'net14' => { bus
=> 1, addr
=> 9 },
4737 'net15' => { bus
=> 1, addr
=> 10 },
4738 'net16' => { bus
=> 1, addr
=> 11 },
4739 'net17' => { bus
=> 1, addr
=> 12 },
4740 'net18' => { bus
=> 1, addr
=> 13 },
4741 'net19' => { bus
=> 1, addr
=> 14 },
4742 'net20' => { bus
=> 1, addr
=> 15 },
4743 'net21' => { bus
=> 1, addr
=> 16 },
4744 'net22' => { bus
=> 1, addr
=> 17 },
4745 'net23' => { bus
=> 1, addr
=> 18 },
4746 'net24' => { bus
=> 1, addr
=> 19 },
4747 'net25' => { bus
=> 1, addr
=> 20 },
4748 'net26' => { bus
=> 1, addr
=> 21 },
4749 'net27' => { bus
=> 1, addr
=> 22 },
4750 'net28' => { bus
=> 1, addr
=> 23 },
4751 'net29' => { bus
=> 1, addr
=> 24 },
4752 'net30' => { bus
=> 1, addr
=> 25 },
4753 'net31' => { bus
=> 1, addr
=> 26 },
4754 'virtio6' => { bus
=> 2, addr
=> 1 },
4755 'virtio7' => { bus
=> 2, addr
=> 2 },
4756 'virtio8' => { bus
=> 2, addr
=> 3 },
4757 'virtio9' => { bus
=> 2, addr
=> 4 },
4758 'virtio10' => { bus
=> 2, addr
=> 5 },
4759 'virtio11' => { bus
=> 2, addr
=> 6 },
4760 'virtio12' => { bus
=> 2, addr
=> 7 },
4761 'virtio13' => { bus
=> 2, addr
=> 8 },
4762 'virtio14' => { bus
=> 2, addr
=> 9 },
4763 'virtio15' => { bus
=> 2, addr
=> 10 },
4766 if (defined($devices->{$id}->{bus
}) && defined($devices->{$id}->{addr
})) {
4767 my $addr = sprintf("0x%x", $devices->{$id}->{addr
});
4768 my $bus = $devices->{$id}->{bus
};
4769 $res = ",bus=pci.$bus,addr=$addr";
4770 $bridges->{$bus} = 1 if $bridges;
4776 sub print_pcie_addr
{
4781 hostpci0
=> { bus
=> "ich9-pcie-port-1", addr
=> 0 },
4782 hostpci1
=> { bus
=> "ich9-pcie-port-2", addr
=> 0 },
4783 hostpci2
=> { bus
=> "ich9-pcie-port-3", addr
=> 0 },
4784 hostpci3
=> { bus
=> "ich9-pcie-port-4", addr
=> 0 },
4787 if (defined($devices->{$id}->{bus
}) && defined($devices->{$id}->{addr
})) {
4788 my $addr = sprintf("0x%x", $devices->{$id}->{addr
});
4789 my $bus = $devices->{$id}->{bus
};
4790 $res = ",bus=$bus,addr=$addr";
4796 # vzdump restore implementaion
4798 sub tar_archive_read_firstfile
{
4799 my $archive = shift;
4801 die "ERROR: file '$archive' does not exist\n" if ! -f
$archive;
4803 # try to detect archive type first
4804 my $pid = open (TMP
, "tar tf '$archive'|") ||
4805 die "unable to open file '$archive'\n";
4806 my $firstfile = <TMP
>;
4810 die "ERROR: archive contaions no data\n" if !$firstfile;
4816 sub tar_restore_cleanup
{
4817 my ($storecfg, $statfile) = @_;
4819 print STDERR
"starting cleanup\n";
4821 if (my $fd = IO
::File-
>new($statfile, "r")) {
4822 while (defined(my $line = <$fd>)) {
4823 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4826 if ($volid =~ m
|^/|) {
4827 unlink $volid || die 'unlink failed\n';
4829 PVE
::Storage
::vdisk_free
($storecfg, $volid);
4831 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
4833 print STDERR
"unable to cleanup '$volid' - $@" if $@;
4835 print STDERR
"unable to parse line in statfile - $line";
4842 sub restore_archive
{
4843 my ($archive, $vmid, $user, $opts) = @_;
4845 my $format = $opts->{format
};
4848 if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
4849 $format = 'tar' if !$format;
4851 } elsif ($archive =~ m/\.tar$/) {
4852 $format = 'tar' if !$format;
4853 } elsif ($archive =~ m/.tar.lzo$/) {
4854 $format = 'tar' if !$format;
4856 } elsif ($archive =~ m/\.vma$/) {
4857 $format = 'vma' if !$format;
4858 } elsif ($archive =~ m/\.vma\.gz$/) {
4859 $format = 'vma' if !$format;
4861 } elsif ($archive =~ m/\.vma\.lzo$/) {
4862 $format = 'vma' if !$format;
4865 $format = 'vma' if !$format; # default
4868 # try to detect archive format
4869 if ($format eq 'tar') {
4870 return restore_tar_archive
($archive, $vmid, $user, $opts);
4872 return restore_vma_archive
($archive, $vmid, $user, $opts, $comp);
4876 sub restore_update_config_line
{
4877 my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
4879 return if $line =~ m/^\#qmdump\#/;
4880 return if $line =~ m/^\#vzdump\#/;
4881 return if $line =~ m/^lock:/;
4882 return if $line =~ m/^unused\d+:/;
4883 return if $line =~ m/^parent:/;
4884 return if $line =~ m/^template:/; # restored VM is never a template
4886 if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
4887 # try to convert old 1.X settings
4888 my ($id, $ind, $ethcfg) = ($1, $2, $3);
4889 foreach my $devconfig (PVE
::Tools
::split_list
($ethcfg)) {
4890 my ($model, $macaddr) = split(/\=/, $devconfig);
4891 $macaddr = PVE
::Tools
::random_ether_addr
() if !$macaddr || $unique;
4894 bridge
=> "vmbr$ind",
4895 macaddr
=> $macaddr,
4897 my $netstr = print_net
($net);
4899 print $outfd "net$cookie->{netcount}: $netstr\n";
4900 $cookie->{netcount
}++;
4902 } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
4903 my ($id, $netstr) = ($1, $2);
4904 my $net = parse_net
($netstr);
4905 $net->{macaddr
} = PVE
::Tools
::random_ether_addr
() if $net->{macaddr
};
4906 $netstr = print_net
($net);
4907 print $outfd "$id: $netstr\n";
4908 } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
4911 if ($line =~ m/backup=no/) {
4912 print $outfd "#$line";
4913 } elsif ($virtdev && $map->{$virtdev}) {
4914 my $di = parse_drive
($virtdev, $value);
4915 delete $di->{format
}; # format can change on restore
4916 $di->{file
} = $map->{$virtdev};
4917 $value = print_drive
($vmid, $di);
4918 print $outfd "$virtdev: $value\n";
4928 my ($cfg, $vmid) = @_;
4930 my $info = PVE
::Storage
::vdisk_list
($cfg, undef, $vmid);
4932 my $volid_hash = {};
4933 foreach my $storeid (keys %$info) {
4934 foreach my $item (@{$info->{$storeid}}) {
4935 next if !($item->{volid
} && $item->{size
});
4936 $item->{path
} = PVE
::Storage
::path
($cfg, $item->{volid
});
4937 $volid_hash->{$item->{volid
}} = $item;
4944 sub get_used_paths
{
4945 my ($vmid, $storecfg, $conf, $scan_snapshots, $skip_drive) = @_;
4949 my $scan_config = sub {
4950 my ($cref, $snapname) = @_;
4952 foreach my $key (keys %$cref) {
4953 my $value = $cref->{$key};
4954 if (valid_drivename
($key)) {
4955 next if $skip_drive && $key eq $skip_drive;
4956 my $drive = parse_drive
($key, $value);
4957 next if !$drive || !$drive->{file
} || drive_is_cdrom
($drive);
4958 if ($drive->{file
} =~ m!^/!) {
4959 $used_path->{$drive->{file
}}++; # = 1;
4961 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($drive->{file
}, 1);
4963 my $scfg = PVE
::Storage
::storage_config
($storecfg, $storeid, 1);
4965 my $path = PVE
::Storage
::path
($storecfg, $drive->{file
}, $snapname);
4966 $used_path->{$path}++; # = 1;
4972 &$scan_config($conf);
4976 if ($scan_snapshots) {
4977 foreach my $snapname (keys %{$conf->{snapshots
}}) {
4978 &$scan_config($conf->{snapshots
}->{$snapname}, $snapname);
4985 sub update_disksize
{
4986 my ($vmid, $conf, $volid_hash) = @_;
4992 # Note: it is allowed to define multiple storages with same path (alias), so
4993 # we need to check both 'volid' and real 'path' (two different volid can point
4994 # to the same path).
4999 foreach my $opt (keys %$conf) {
5000 if (valid_drivename
($opt)) {
5001 my $drive = parse_drive
($opt, $conf->{$opt});
5002 my $volid = $drive->{file
};
5005 $used->{$volid} = 1;
5006 if ($volid_hash->{$volid} &&
5007 (my $path = $volid_hash->{$volid}->{path
})) {
5008 $usedpath->{$path} = 1;
5011 next if drive_is_cdrom
($drive);
5012 next if !$volid_hash->{$volid};
5014 $drive->{size
} = $volid_hash->{$volid}->{size
};
5015 my $new = print_drive
($vmid, $drive);
5016 if ($new ne $conf->{$opt}) {
5018 $conf->{$opt} = $new;
5023 # remove 'unusedX' entry if volume is used
5024 foreach my $opt (keys %$conf) {
5025 next if $opt !~ m/^unused\d+$/;
5026 my $volid = $conf->{$opt};
5027 my $path = $volid_hash->{$volid}->{path
} if $volid_hash->{$volid};
5028 if ($used->{$volid} || ($path && $usedpath->{$path})) {
5030 delete $conf->{$opt};
5034 foreach my $volid (sort keys %$volid_hash) {
5035 next if $volid =~ m/vm-$vmid-state-/;
5036 next if $used->{$volid};
5037 my $path = $volid_hash->{$volid}->{path
};
5038 next if !$path; # just to be sure
5039 next if $usedpath->{$path};
5041 add_unused_volume
($conf, $volid);
5042 $usedpath->{$path} = 1; # avoid to add more than once (aliases)
5049 my ($vmid, $nolock) = @_;
5051 my $cfg = PVE
::Cluster
::cfs_read_file
("storage.cfg");
5053 my $volid_hash = scan_volids
($cfg, $vmid);
5055 my $updatefn = sub {
5058 my $conf = load_config
($vmid);
5063 foreach my $volid (keys %$volid_hash) {
5064 my $info = $volid_hash->{$volid};
5065 $vm_volids->{$volid} = $info if $info->{vmid
} && $info->{vmid
} == $vmid;
5068 my $changes = update_disksize
($vmid, $conf, $vm_volids);
5070 update_config_nolock
($vmid, $conf, 1) if $changes;
5073 if (defined($vmid)) {
5077 lock_config
($vmid, $updatefn, $vmid);
5080 my $vmlist = config_list
();
5081 foreach my $vmid (keys %$vmlist) {
5085 lock_config
($vmid, $updatefn, $vmid);
5091 sub restore_vma_archive
{
5092 my ($archive, $vmid, $user, $opts, $comp) = @_;
5094 my $input = $archive eq '-' ?
"<&STDIN" : undef;
5095 my $readfrom = $archive;
5100 my $qarchive = PVE
::Tools
::shellquote
($archive);
5101 if ($comp eq 'gzip') {
5102 $uncomp = "zcat $qarchive|";
5103 } elsif ($comp eq 'lzop') {
5104 $uncomp = "lzop -d -c $qarchive|";
5106 die "unknown compression method '$comp'\n";
5111 my $tmpdir = "/var/tmp/vzdumptmp$$";
5114 # disable interrupts (always do cleanups)
5115 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
5116 warn "got interrupt - ignored\n";
5119 my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
5120 POSIX
::mkfifo
($mapfifo, 0600);
5123 my $openfifo = sub {
5124 open($fifofh, '>', $mapfifo) || die $!;
5127 my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
5134 my $rpcenv = PVE
::RPCEnvironment
::get
();
5136 my $conffile = config_file
($vmid);
5137 my $tmpfn = "$conffile.$$.tmp";
5139 # Note: $oldconf is undef if VM does not exists
5140 my $oldconf = PVE
::Cluster
::cfs_read_file
(cfs_config_path
($vmid));
5142 my $print_devmap = sub {
5143 my $virtdev_hash = {};
5145 my $cfgfn = "$tmpdir/qemu-server.conf";
5147 # we can read the config - that is already extracted
5148 my $fh = IO
::File-
>new($cfgfn, "r") ||
5149 "unable to read qemu-server.conf - $!\n";
5151 while (defined(my $line = <$fh>)) {
5152 if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
5153 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
5154 die "archive does not contain data for drive '$virtdev'\n"
5155 if !$devinfo->{$devname};
5156 if (defined($opts->{storage
})) {
5157 $storeid = $opts->{storage
} || 'local';
5158 } elsif (!$storeid) {
5161 $format = 'raw' if !$format;
5162 $devinfo->{$devname}->{devname
} = $devname;
5163 $devinfo->{$devname}->{virtdev
} = $virtdev;
5164 $devinfo->{$devname}->{format
} = $format;
5165 $devinfo->{$devname}->{storeid
} = $storeid;
5167 # check permission on storage
5168 my $pool = $opts->{pool
}; # todo: do we need that?
5169 if ($user ne 'root@pam') {
5170 $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
5173 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
5177 foreach my $devname (keys %$devinfo) {
5178 die "found no device mapping information for device '$devname'\n"
5179 if !$devinfo->{$devname}->{virtdev
};
5182 my $cfg = cfs_read_file
('storage.cfg');
5184 # create empty/temp config
5186 PVE
::Tools
::file_set_contents
($conffile, "memory: 128\n");
5187 foreach_drive
($oldconf, sub {
5188 my ($ds, $drive) = @_;
5190 return if drive_is_cdrom
($drive);
5192 my $volid = $drive->{file
};
5194 return if !$volid || $volid =~ m
|^/|;
5196 my ($path, $owner) = PVE
::Storage
::path
($cfg, $volid);
5197 return if !$path || !$owner || ($owner != $vmid);
5199 # Note: only delete disk we want to restore
5200 # other volumes will become unused
5201 if ($virtdev_hash->{$ds}) {
5202 PVE
::Storage
::vdisk_free
($cfg, $volid);
5208 foreach my $virtdev (sort keys %$virtdev_hash) {
5209 my $d = $virtdev_hash->{$virtdev};
5210 my $alloc_size = int(($d->{size
} + 1024 - 1)/1024);
5211 my $scfg = PVE
::Storage
::storage_config
($cfg, $d->{storeid
});
5213 # test if requested format is supported
5214 my ($defFormat, $validFormats) = PVE
::Storage
::storage_default_format
($cfg, $d->{storeid
});
5215 my $supported = grep { $_ eq $d->{format
} } @$validFormats;
5216 $d->{format
} = $defFormat if !$supported;
5218 my $volid = PVE
::Storage
::vdisk_alloc
($cfg, $d->{storeid
}, $vmid,
5219 $d->{format
}, undef, $alloc_size);
5220 print STDERR
"new volume ID is '$volid'\n";
5221 $d->{volid
} = $volid;
5222 my $path = PVE
::Storage
::path
($cfg, $volid);
5224 my $write_zeros = 1;
5225 # fixme: what other storages types initialize volumes with zero?
5226 if ($scfg->{type
} eq 'dir' || $scfg->{type
} eq 'nfs' || $scfg->{type
} eq 'glusterfs' ||
5227 $scfg->{type
} eq 'sheepdog' || $scfg->{type
} eq 'rbd') {
5231 print $fifofh "${write_zeros}:$d->{devname}=$path\n";
5233 print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
5234 $map->{$virtdev} = $volid;
5237 $fh->seek(0, 0) || die "seek failed - $!\n";
5239 my $outfd = new IO
::File
($tmpfn, "w") ||
5240 die "unable to write config for VM $vmid\n";
5242 my $cookie = { netcount
=> 0 };
5243 while (defined(my $line = <$fh>)) {
5244 restore_update_config_line
($outfd, $cookie, $vmid, $map, $line, $opts->{unique
});
5253 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
5254 die "interrupted by signal\n";
5256 local $SIG{ALRM
} = sub { die "got timeout\n"; };
5258 $oldtimeout = alarm($timeout);
5265 if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
5266 my ($dev_id, $size, $devname) = ($1, $2, $3);
5267 $devinfo->{$devname} = { size
=> $size, dev_id
=> $dev_id };
5268 } elsif ($line =~ m/^CTIME: /) {
5269 # we correctly received the vma config, so we can disable
5270 # the timeout now for disk allocation (set to 10 minutes, so
5271 # that we always timeout if something goes wrong)
5274 print $fifofh "done\n";
5275 my $tmp = $oldtimeout || 0;
5276 $oldtimeout = undef;
5282 print "restore vma archive: $cmd\n";
5283 run_command
($cmd, input
=> $input, outfunc
=> $parser, afterfork
=> $openfifo);
5287 alarm($oldtimeout) if $oldtimeout;
5295 my $cfg = cfs_read_file
('storage.cfg');
5296 foreach my $devname (keys %$devinfo) {
5297 my $volid = $devinfo->{$devname}->{volid
};
5300 if ($volid =~ m
|^/|) {
5301 unlink $volid || die 'unlink failed\n';
5303 PVE
::Storage
::vdisk_free
($cfg, $volid);
5305 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
5307 print STDERR
"unable to cleanup '$volid' - $@" if $@;
5314 rename($tmpfn, $conffile) ||
5315 die "unable to commit configuration file '$conffile'\n";
5317 PVE
::Cluster
::cfs_update
(); # make sure we read new file
5319 eval { rescan
($vmid, 1); };
5323 sub restore_tar_archive
{
5324 my ($archive, $vmid, $user, $opts) = @_;
5326 if ($archive ne '-') {
5327 my $firstfile = tar_archive_read_firstfile
($archive);
5328 die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
5329 if $firstfile ne 'qemu-server.conf';
5332 my $storecfg = cfs_read_file
('storage.cfg');
5334 # destroy existing data - keep empty config
5335 my $vmcfgfn = config_file
($vmid);
5336 destroy_vm
($storecfg, $vmid, 1) if -f
$vmcfgfn;
5338 my $tocmd = "/usr/lib/qemu-server/qmextract";
5340 $tocmd .= " --storage " . PVE
::Tools
::shellquote
($opts->{storage
}) if $opts->{storage
};
5341 $tocmd .= " --pool " . PVE
::Tools
::shellquote
($opts->{pool
}) if $opts->{pool
};
5342 $tocmd .= ' --prealloc' if $opts->{prealloc
};
5343 $tocmd .= ' --info' if $opts->{info
};
5345 # tar option "xf" does not autodetect compression when read from STDIN,
5346 # so we pipe to zcat
5347 my $cmd = "zcat -f|tar xf " . PVE
::Tools
::shellquote
($archive) . " " .
5348 PVE
::Tools
::shellquote
("--to-command=$tocmd");
5350 my $tmpdir = "/var/tmp/vzdumptmp$$";
5353 local $ENV{VZDUMP_TMPDIR
} = $tmpdir;
5354 local $ENV{VZDUMP_VMID
} = $vmid;
5355 local $ENV{VZDUMP_USER
} = $user;
5357 my $conffile = config_file
($vmid);
5358 my $tmpfn = "$conffile.$$.tmp";
5360 # disable interrupts (always do cleanups)
5361 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
5362 print STDERR
"got interrupt - ignored\n";
5367 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
5368 die "interrupted by signal\n";
5371 if ($archive eq '-') {
5372 print "extracting archive from STDIN\n";
5373 run_command
($cmd, input
=> "<&STDIN");
5375 print "extracting archive '$archive'\n";
5379 return if $opts->{info
};
5383 my $statfile = "$tmpdir/qmrestore.stat";
5384 if (my $fd = IO
::File-
>new($statfile, "r")) {
5385 while (defined (my $line = <$fd>)) {
5386 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
5387 $map->{$1} = $2 if $1;
5389 print STDERR
"unable to parse line in statfile - $line\n";
5395 my $confsrc = "$tmpdir/qemu-server.conf";
5397 my $srcfd = new IO
::File
($confsrc, "r") ||
5398 die "unable to open file '$confsrc'\n";
5400 my $outfd = new IO
::File
($tmpfn, "w") ||
5401 die "unable to write config for VM $vmid\n";
5403 my $cookie = { netcount
=> 0 };
5404 while (defined (my $line = <$srcfd>)) {
5405 restore_update_config_line
($outfd, $cookie, $vmid, $map, $line, $opts->{unique
});
5417 tar_restore_cleanup
($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info
};
5424 rename $tmpfn, $conffile ||
5425 die "unable to commit configuration file '$conffile'\n";
5427 PVE
::Cluster
::cfs_update
(); # make sure we read new file
5429 eval { rescan
($vmid, 1); };
5434 # Internal snapshots
5436 # NOTE: Snapshot create/delete involves several non-atomic
5437 # action, and can take a long time.
5438 # So we try to avoid locking the file and use 'lock' variable
5439 # inside the config file instead.
5441 my $snapshot_copy_config = sub {
5442 my ($source, $dest) = @_;
5444 foreach my $k (keys %$source) {
5445 next if $k eq 'snapshots';
5446 next if $k eq 'snapstate';
5447 next if $k eq 'snaptime';
5448 next if $k eq 'vmstate';
5449 next if $k eq 'lock';
5450 next if $k eq 'digest';
5451 next if $k eq 'description';
5452 next if $k =~ m/^unused\d+$/;
5454 $dest->{$k} = $source->{$k};
5458 my $snapshot_apply_config = sub {
5459 my ($conf, $snap) = @_;
5461 # copy snapshot list
5463 snapshots
=> $conf->{snapshots
},
5466 # keep description and list of unused disks
5467 foreach my $k (keys %$conf) {
5468 next if !($k =~ m/^unused\d+$/ || $k eq 'description');
5469 $newconf->{$k} = $conf->{$k};
5472 &$snapshot_copy_config($snap, $newconf);
5477 sub foreach_writable_storage
{
5478 my ($conf, $func) = @_;
5482 foreach my $ds (keys %$conf) {
5483 next if !valid_drivename
($ds);
5485 my $drive = parse_drive
($ds, $conf->{$ds});
5487 next if drive_is_cdrom
($drive);
5489 my $volid = $drive->{file
};
5491 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
5492 $sidhash->{$sid} = $sid if $sid;
5495 foreach my $sid (sort keys %$sidhash) {
5500 my $alloc_vmstate_volid = sub {
5501 my ($storecfg, $vmid, $conf, $snapname) = @_;
5503 # Note: we try to be smart when selecting a $target storage
5507 # search shared storage first
5508 foreach_writable_storage
($conf, sub {
5510 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
5511 return if !$scfg->{shared
};
5513 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage
5517 # now search local storage
5518 foreach_writable_storage
($conf, sub {
5520 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
5521 return if $scfg->{shared
};
5523 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage;
5527 $target = 'local' if !$target;
5529 my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
5530 # we abort live save after $conf->{memory}, so we need at max twice that space
5531 my $size = $conf->{memory
}*2 + $driver_state_size;
5533 my $name = "vm-$vmid-state-$snapname";
5534 my $scfg = PVE
::Storage
::storage_config
($storecfg, $target);
5535 $name .= ".raw" if $scfg->{path
}; # add filename extension for file base storage
5536 my $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $target, $vmid, 'raw', $name, $size*1024);
5541 my $snapshot_prepare = sub {
5542 my ($vmid, $snapname, $save_vmstate, $comment) = @_;
5546 my $updatefn = sub {
5548 my $conf = load_config
($vmid);
5550 die "you can't take a snapshot if it's a template\n"
5551 if is_template
($conf);
5555 $conf->{lock} = 'snapshot';
5557 die "snapshot name '$snapname' already used\n"
5558 if defined($conf->{snapshots
}->{$snapname});
5560 my $storecfg = PVE
::Storage
::config
();
5561 die "snapshot feature is not available" if !has_feature
('snapshot', $conf, $storecfg);
5563 $snap = $conf->{snapshots
}->{$snapname} = {};
5565 if ($save_vmstate && check_running
($vmid)) {
5566 $snap->{vmstate
} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
5569 &$snapshot_copy_config($conf, $snap);
5571 $snap->{snapstate
} = "prepare";
5572 $snap->{snaptime
} = time();
5573 $snap->{description
} = $comment if $comment;
5575 # always overwrite machine if we save vmstate. This makes sure we
5576 # can restore it later using correct machine type
5577 $snap->{machine
} = get_current_qemu_machine
($vmid) if $snap->{vmstate
};
5579 update_config_nolock
($vmid, $conf, 1);
5582 lock_config
($vmid, $updatefn);
5587 my $snapshot_commit = sub {
5588 my ($vmid, $snapname) = @_;
5590 my $updatefn = sub {
5592 my $conf = load_config
($vmid);
5594 die "missing snapshot lock\n"
5595 if !($conf->{lock} && $conf->{lock} eq 'snapshot');
5597 my $has_machine_config = defined($conf->{machine
});
5599 my $snap = $conf->{snapshots
}->{$snapname};
5601 die "snapshot '$snapname' does not exist\n" if !defined($snap);
5603 die "wrong snapshot state\n"
5604 if !($snap->{snapstate
} && $snap->{snapstate
} eq "prepare");
5606 delete $snap->{snapstate
};
5607 delete $conf->{lock};
5609 my $newconf = &$snapshot_apply_config($conf, $snap);
5611 delete $newconf->{machine
} if !$has_machine_config;
5613 $newconf->{parent
} = $snapname;
5615 update_config_nolock
($vmid, $newconf, 1);
5618 lock_config
($vmid, $updatefn);
5621 sub snapshot_rollback
{
5622 my ($vmid, $snapname) = @_;
5626 my $storecfg = PVE
::Storage
::config
();
5628 my $conf = load_config
($vmid);
5630 my $get_snapshot_config = sub {
5632 die "you can't rollback if vm is a template\n" if is_template
($conf);
5634 my $res = $conf->{snapshots
}->{$snapname};
5636 die "snapshot '$snapname' does not exist\n" if !defined($res);
5641 my $snap = &$get_snapshot_config();
5643 foreach_drive
($snap, sub {
5644 my ($ds, $drive) = @_;
5646 return if drive_is_cdrom
($drive);
5648 my $volid = $drive->{file
};
5650 PVE
::Storage
::volume_rollback_is_possible
($storecfg, $volid, $snapname);
5653 my $updatefn = sub {
5655 $conf = load_config
($vmid);
5657 $snap = &$get_snapshot_config();
5659 die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
5660 if $snap->{snapstate
};
5664 vm_stop
($storecfg, $vmid, undef, undef, 5, undef, undef);
5667 die "unable to rollback vm $vmid: vm is running\n"
5668 if check_running
($vmid);
5671 $conf->{lock} = 'rollback';
5673 die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
5674 delete $conf->{lock};
5680 my $has_machine_config = defined($conf->{machine
});
5682 # copy snapshot config to current config
5683 $conf = &$snapshot_apply_config($conf, $snap);
5684 $conf->{parent
} = $snapname;
5686 # Note: old code did not store 'machine', so we try to be smart
5687 # and guess the snapshot was generated with kvm 1.4 (pc-i440fx-1.4).
5688 $forcemachine = $conf->{machine
} || 'pc-i440fx-1.4';
5689 # we remove the 'machine' configuration if not explicitly specified
5690 # in the original config.
5691 delete $conf->{machine
} if $snap->{vmstate
} && !$has_machine_config;
5694 update_config_nolock
($vmid, $conf, 1);
5696 if (!$prepare && $snap->{vmstate
}) {
5697 my $statefile = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
5698 vm_start
($storecfg, $vmid, $statefile, undef, undef, undef, $forcemachine);
5702 lock_config
($vmid, $updatefn);
5704 foreach_drive
($snap, sub {
5705 my ($ds, $drive) = @_;
5707 return if drive_is_cdrom
($drive);
5709 my $volid = $drive->{file
};
5710 my $device = "drive-$ds";
5712 PVE
::Storage
::volume_snapshot_rollback
($storecfg, $volid, $snapname);
5716 lock_config
($vmid, $updatefn);
5719 my $savevm_wait = sub {
5723 my $stat = vm_mon_cmd_nocheck
($vmid, "query-savevm");
5724 if (!$stat->{status
}) {
5725 die "savevm not active\n";
5726 } elsif ($stat->{status
} eq 'active') {
5729 } elsif ($stat->{status
} eq 'completed') {
5732 die "query-savevm returned status '$stat->{status}'\n";
5737 sub snapshot_create
{
5738 my ($vmid, $snapname, $save_vmstate, $comment) = @_;
5740 my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
5742 $save_vmstate = 0 if !$snap->{vmstate
}; # vm is not running
5744 my $config = load_config
($vmid);
5746 my $running = check_running
($vmid);
5748 my $freezefs = $running && $config->{agent
};
5749 $freezefs = 0 if $snap->{vmstate
}; # not needed if we save RAM
5754 eval { vm_mon_cmd
($vmid, "guest-fsfreeze-freeze"); };
5755 warn "guest-fsfreeze-freeze problems - $@" if $@;
5759 # create internal snapshots of all drives
5761 my $storecfg = PVE
::Storage
::config
();
5764 if ($snap->{vmstate
}) {
5765 my $path = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
5766 vm_mon_cmd
($vmid, "savevm-start", statefile
=> $path);
5767 &$savevm_wait($vmid);
5769 vm_mon_cmd
($vmid, "savevm-start");
5773 foreach_drive
($snap, sub {
5774 my ($ds, $drive) = @_;
5776 return if drive_is_cdrom
($drive);
5778 my $volid = $drive->{file
};
5779 my $device = "drive-$ds";
5781 qemu_volume_snapshot
($vmid, $device, $storecfg, $volid, $snapname);
5782 $drivehash->{$ds} = 1;
5788 eval { vm_mon_cmd
($vmid, "savevm-end") };
5792 eval { vm_mon_cmd
($vmid, "guest-fsfreeze-thaw"); };
5793 warn "guest-fsfreeze-thaw problems - $@" if $@;
5796 # savevm-end is async, we need to wait
5798 my $stat = vm_mon_cmd_nocheck
($vmid, "query-savevm");
5799 if (!$stat->{bytes
}) {
5802 print "savevm not yet finished\n";
5810 warn "snapshot create failed: starting cleanup\n";
5811 eval { snapshot_delete
($vmid, $snapname, 0, $drivehash); };
5816 &$snapshot_commit($vmid, $snapname);
5819 # Note: $drivehash is only set when called from snapshot_create.
5820 sub snapshot_delete
{
5821 my ($vmid, $snapname, $force, $drivehash) = @_;
5828 my $unlink_parent = sub {
5829 my ($confref, $new_parent) = @_;
5831 if ($confref->{parent
} && $confref->{parent
} eq $snapname) {
5833 $confref->{parent
} = $new_parent;
5835 delete $confref->{parent
};
5840 my $updatefn = sub {
5841 my ($remove_drive) = @_;
5843 my $conf = load_config
($vmid);
5847 die "you can't delete a snapshot if vm is a template\n"
5848 if is_template
($conf);
5851 $snap = $conf->{snapshots
}->{$snapname};
5853 die "snapshot '$snapname' does not exist\n" if !defined($snap);
5855 # remove parent refs
5857 &$unlink_parent($conf, $snap->{parent
});
5858 foreach my $sn (keys %{$conf->{snapshots
}}) {
5859 next if $sn eq $snapname;
5860 &$unlink_parent($conf->{snapshots
}->{$sn}, $snap->{parent
});
5864 if ($remove_drive) {
5865 if ($remove_drive eq 'vmstate') {
5866 delete $snap->{$remove_drive};
5868 my $drive = parse_drive
($remove_drive, $snap->{$remove_drive});
5869 my $volid = $drive->{file
};
5870 delete $snap->{$remove_drive};
5871 add_unused_volume
($conf, $volid);
5876 $snap->{snapstate
} = 'delete';
5878 delete $conf->{snapshots
}->{$snapname};
5879 delete $conf->{lock} if $drivehash;
5880 foreach my $volid (@$unused) {
5881 add_unused_volume
($conf, $volid);
5885 update_config_nolock
($vmid, $conf, 1);
5888 lock_config
($vmid, $updatefn);
5890 # now remove vmstate file
5892 my $storecfg = PVE
::Storage
::config
();
5894 if ($snap->{vmstate
}) {
5895 eval { PVE
::Storage
::vdisk_free
($storecfg, $snap->{vmstate
}); };
5897 die $err if !$force;
5900 # save changes (remove vmstate from snapshot)
5901 lock_config
($vmid, $updatefn, 'vmstate') if !$force;
5904 # now remove all internal snapshots
5905 foreach_drive
($snap, sub {
5906 my ($ds, $drive) = @_;
5908 return if drive_is_cdrom
($drive);
5910 my $volid = $drive->{file
};
5911 my $device = "drive-$ds";
5913 if (!$drivehash || $drivehash->{$ds}) {
5914 eval { qemu_volume_snapshot_delete
($vmid, $device, $storecfg, $volid, $snapname); };
5916 die $err if !$force;
5921 # save changes (remove drive fron snapshot)
5922 lock_config
($vmid, $updatefn, $ds) if !$force;
5923 push @$unused, $volid;
5926 # now cleanup config
5928 lock_config
($vmid, $updatefn);
5932 my ($feature, $conf, $storecfg, $snapname, $running) = @_;
5935 foreach_drive
($conf, sub {
5936 my ($ds, $drive) = @_;
5938 return if drive_is_cdrom
($drive);
5939 my $volid = $drive->{file
};
5940 $err = 1 if !PVE
::Storage
::volume_has_feature
($storecfg, $feature, $volid, $snapname, $running);
5943 return $err ?
0 : 1;
5946 sub template_create
{
5947 my ($vmid, $conf, $disk) = @_;
5949 my $storecfg = PVE
::Storage
::config
();
5951 foreach_drive
($conf, sub {
5952 my ($ds, $drive) = @_;
5954 return if drive_is_cdrom
($drive);
5955 return if $disk && $ds ne $disk;
5957 my $volid = $drive->{file
};
5958 return if !PVE
::Storage
::volume_has_feature
($storecfg, 'template', $volid);
5960 my $voliddst = PVE
::Storage
::vdisk_create_base
($storecfg, $volid);
5961 $drive->{file
} = $voliddst;
5962 $conf->{$ds} = print_drive
($vmid, $drive);
5963 update_config_nolock
($vmid, $conf, 1);
5970 return 1 if defined $conf->{template
} && $conf->{template
} == 1;
5973 sub qemu_img_convert
{
5974 my ($src_volid, $dst_volid, $size, $snapname) = @_;
5976 my $storecfg = PVE
::Storage
::config
();
5977 my ($src_storeid, $src_volname) = PVE
::Storage
::parse_volume_id
($src_volid, 1);
5978 my ($dst_storeid, $dst_volname) = PVE
::Storage
::parse_volume_id
($dst_volid, 1);
5980 if ($src_storeid && $dst_storeid) {
5981 my $src_scfg = PVE
::Storage
::storage_config
($storecfg, $src_storeid);
5982 my $dst_scfg = PVE
::Storage
::storage_config
($storecfg, $dst_storeid);
5984 my $src_format = qemu_img_format
($src_scfg, $src_volname);
5985 my $dst_format = qemu_img_format
($dst_scfg, $dst_volname);
5987 my $src_path = PVE
::Storage
::path
($storecfg, $src_volid, $snapname);
5988 my $dst_path = PVE
::Storage
::path
($storecfg, $dst_volid);
5991 push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-n';
5992 push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
5993 push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
5997 if($line =~ m/\((\S+)\/100\
%\)/){
5999 my $transferred = int($size * $percent / 100);
6000 my $remaining = $size - $transferred;
6002 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
6007 eval { run_command
($cmd, timeout
=> undef, outfunc
=> $parser); };
6009 die "copy failed: $err" if $err;
6013 sub qemu_img_format
{
6014 my ($scfg, $volname) = @_;
6016 if ($scfg->{path
} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/) {
6018 } elsif ($scfg->{type
} eq 'iscsi') {
6019 return "host_device";
6025 sub qemu_drive_mirror
{
6026 my ($vmid, $drive, $dst_volid, $vmiddst) = @_;
6033 my $storecfg = PVE
::Storage
::config
();
6034 my ($dst_storeid, $dst_volname) = PVE
::Storage
::parse_volume_id
($dst_volid);
6036 my $dst_scfg = PVE
::Storage
::storage_config
($storecfg, $dst_storeid);
6039 if ($dst_volname =~ m/\.(raw|qcow2)$/){
6043 my $dst_path = PVE
::Storage
::path
($storecfg, $dst_volid);
6045 my $opts = { timeout
=> 10, device
=> "drive-$drive", mode
=> "existing", sync
=> "full", target
=> $dst_path };
6046 $opts->{format
} = $format if $format;
6048 #fixme : sometime drive-mirror timeout, but works fine after.
6049 # (I have see the problem with big volume > 200GB), so we need to eval
6050 eval { vm_mon_cmd
($vmid, "drive-mirror", %$opts); };
6051 # ignore errors here
6055 my $stats = vm_mon_cmd
($vmid, "query-block-jobs");
6056 my $stat = @$stats[0];
6057 die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
6058 die "error job is not mirroring" if $stat->{type
} ne "mirror";
6060 my $busy = $stat->{busy
};
6062 if (my $total = $stat->{len
}) {
6063 my $transferred = $stat->{offset
} || 0;
6064 my $remaining = $total - $transferred;
6065 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
6067 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent % busy: $busy\n";
6070 if ($stat->{len
} == $stat->{offset
}) {
6071 if ($busy eq 'false') {
6073 last if $vmiddst != $vmid;
6075 # try to switch the disk if source and destination are on the same guest
6076 eval { vm_mon_cmd
($vmid, "block-job-complete", device
=> "drive-$drive") };
6078 die $@ if $@ !~ m/cannot be completed/;
6081 if ($count > $maxwait) {
6082 # if too much writes to disk occurs at the end of migration
6083 #the disk needs to be freezed to be able to complete the migration
6084 vm_suspend
($vmid,1);
6089 $old_len = $stat->{offset
};
6093 vm_resume
($vmid, 1) if $frozen;
6098 my $cancel_job = sub {
6099 vm_mon_cmd
($vmid, "block-job-cancel", device
=> "drive-$drive");
6101 my $stats = vm_mon_cmd
($vmid, "query-block-jobs");
6102 my $stat = @$stats[0];
6109 eval { &$cancel_job(); };
6110 die "mirroring error: $err";
6113 if ($vmiddst != $vmid) {
6114 # if we clone a disk for a new target vm, we don't switch the disk
6115 &$cancel_job(); # so we call block-job-cancel
6120 my ($storecfg, $vmid, $running, $drivename, $drive, $snapname,
6121 $newvmid, $storage, $format, $full, $newvollist) = @_;
6126 print "create linked clone of drive $drivename ($drive->{file})\n";
6127 $newvolid = PVE
::Storage
::vdisk_clone
($storecfg, $drive->{file
}, $newvmid, $snapname);
6128 push @$newvollist, $newvolid;
6130 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($drive->{file
});
6131 $storeid = $storage if $storage;
6133 my ($defFormat, $validFormats) = PVE
::Storage
::storage_default_format
($storecfg, $storeid);
6135 $format = $drive->{format
} || $defFormat;
6138 # test if requested format is supported - else use default
6139 my $supported = grep { $_ eq $format } @$validFormats;
6140 $format = $defFormat if !$supported;
6142 my ($size) = PVE
::Storage
::volume_size_info
($storecfg, $drive->{file
}, 3);
6144 print "create full clone of drive $drivename ($drive->{file})\n";
6145 $newvolid = PVE
::Storage
::vdisk_alloc
($storecfg, $storeid, $newvmid, $format, undef, ($size/1024));
6146 push @$newvollist, $newvolid;
6148 if (!$running || $snapname) {
6149 qemu_img_convert
($drive->{file
}, $newvolid, $size, $snapname);
6151 qemu_drive_mirror
($vmid, $drivename, $newvolid, $newvmid);
6155 my ($size) = PVE
::Storage
::volume_size_info
($storecfg, $newvolid, 3);
6158 $disk->{format
} = undef;
6159 $disk->{file
} = $newvolid;
6160 $disk->{size
} = $size;
6165 # this only works if VM is running
6166 sub get_current_qemu_machine
{
6169 my $cmd = { execute
=> 'query-machines', arguments
=> {} };
6170 my $res = vm_qmp_command
($vmid, $cmd);
6172 my ($current, $default);
6173 foreach my $e (@$res) {
6174 $default = $e->{name
} if $e->{'is-default'};
6175 $current = $e->{name
} if $e->{'is-current'};
6178 # fallback to the default machine if current is not supported by qemu
6179 return $current || $default || 'pc';
6182 sub qemu_machine_feature_enabled
{
6183 my ($machine, $kvmver, $version_major, $version_minor) = @_;
6188 if ($machine && $machine =~ m/^(pc(-i440fx|-q35)?-(\d+)\.(\d+))/) {
6190 $current_major = $3;
6191 $current_minor = $4;
6193 } elsif ($kvmver =~ m/^(\d+)\.(\d+)/) {
6195 $current_major = $1;
6196 $current_minor = $2;
6199 return 1 if $current_major >= $version_major && $current_minor >= $version_minor;
6208 dir_glob_foreach
("$pcisysfs/devices", '[a-f0-9]{4}:([a-f0-9]{2}:[a-f0-9]{2})\.([0-9])', sub {
6209 my (undef, $id, $function) = @_;
6210 my $res = { id
=> $id, function
=> $function};
6211 push @{$devices->{$id}}, $res;
6217 sub vm_iothreads_list
{
6220 my $res = vm_mon_cmd
($vmid, 'query-iothreads');
6223 foreach my $iothread (@$res) {
6224 $iothreads->{ $iothread->{id
} } = $iothread->{"thread-id"};