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
=> "Enable iothread dataplane.",
164 description
=> "Specifies whether a VM will be started during system bootup.",
170 description
=> "Automatic restart after crash (currently ignored).",
176 description
=> "Allow hotplug for disk and network device",
182 description
=> "Allow reboot. If set to '0' the VM exit on reboot.",
188 description
=> "Lock/unlock the VM.",
189 enum
=> [qw(migrate backup snapshot rollback)],
194 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.",
201 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.",
209 description
=> "Amount of RAM for the VM in MB. This is the maximum available memory when you use the balloon device.",
216 description
=> "Amount of target RAM for the VM in MB. Using zero disables the ballon driver.",
222 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",
230 description
=> "Keybord layout for vnc server. Default is read from the datacenter configuration file.",
231 enum
=> PVE
::Tools
::kvmkeymaplist
(),
236 type
=> 'string', format
=> 'dns-name',
237 description
=> "Set a name for the VM. Only used on the configuration web interface.",
242 description
=> "scsi controller model",
243 enum
=> [qw(lsi lsi53c810 virtio-scsi-pci megasas pvscsi)],
249 description
=> "Description for the VM. Only used on the configuration web interface. This is saved as comment inside the configuration file.",
254 enum
=> [qw(other wxp w2k w2k3 w2k8 wvista win7 win8 l24 l26 solaris)],
255 description
=> <<EODESC,
256 Used to enable special optimization/features for specific
259 other => unspecified OS
260 wxp => Microsoft Windows XP
261 w2k => Microsoft Windows 2000
262 w2k3 => Microsoft Windows 2003
263 w2k8 => Microsoft Windows 2008
264 wvista => Microsoft Windows Vista
265 win7 => Microsoft Windows 7
266 win8 => Microsoft Windows 8/2012
267 l24 => Linux 2.4 Kernel
268 l26 => Linux 2.6/3.X Kernel
269 solaris => solaris/opensolaris/openindiania kernel
271 other|l24|l26|solaris ... no special behaviour
272 wxp|w2k|w2k3|w2k8|wvista|win7|win8 ... use --localtime switch
278 description
=> "Boot on floppy (a), hard disk (c), CD-ROM (d), or network (n).",
279 pattern
=> '[acdn]{1,4}',
284 type
=> 'string', format
=> 'pve-qm-bootdisk',
285 description
=> "Enable booting from specified disk.",
286 pattern
=> '(ide|sata|scsi|virtio)\d+',
291 description
=> "The number of CPUs. Please use option -sockets instead.",
298 description
=> "The number of CPU sockets.",
305 description
=> "The number of cores per socket.",
312 description
=> "Enable/disable Numa.",
318 description
=> "Maximum cpus for hotplug.",
325 description
=> "Enable/disable ACPI.",
331 description
=> "Enable/disable Qemu GuestAgent.",
337 description
=> "Enable/disable KVM hardware virtualization.",
343 description
=> "Enable/disable time drift fix.",
349 description
=> "Set the real time clock to local time. This is enabled by default if ostype indicates a Microsoft OS.",
354 description
=> "Freeze CPU at startup (use 'c' monitor command to start execution).",
359 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.",
360 enum
=> [qw(std cirrus vmware qxl serial0 serial1 serial2 serial3 qxl2 qxl3 qxl4)],
364 type
=> 'string', format
=> 'pve-qm-watchdog',
365 typetext
=> '[[model=]i6300esb|ib700] [,[action=]reset|shutdown|poweroff|pause|debug|none]',
366 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)",
371 typetext
=> "(now | YYYY-MM-DD | YYYY-MM-DDTHH:MM:SS)",
372 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'.",
373 pattern
=> '(now|\d{4}-\d{1,2}-\d{1,2}(T\d{1,2}:\d{1,2}:\d{1,2})?)',
378 type
=> 'string', format
=> 'pve-qm-startup',
379 typetext
=> '[[order=]\d+] [,up=\d+] [,down=\d+] ',
380 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.",
385 description
=> "Enable/disable Template.",
391 description
=> <<EODESCR,
392 Note: this option is for experts only. It allows you to pass arbitrary arguments to kvm, for example:
394 args: -no-reboot -no-hpet
401 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).",
406 description
=> "Set maximum speed (in MB/s) for migrations. Value 0 is no limit.",
410 migrate_downtime
=> {
413 description
=> "Set maximum tolerated downtime (in seconds) for migrations.",
419 type
=> 'string', format
=> 'pve-qm-drive',
420 typetext
=> 'volume',
421 description
=> "This is an alias for option -ide2",
425 description
=> "Emulated CPU type.",
427 enum
=> [ qw(486 athlon pentium pentium2 pentium3 coreduo core2duo kvm32 kvm64 qemu32 qemu64 phenom Conroe Penryn Nehalem Westmere SandyBridge Haswell Broadwell Opteron_G1 Opteron_G2 Opteron_G3 Opteron_G4 Opteron_G5 host) ],
430 parent
=> get_standard_option
('pve-snapshot-name', {
432 description
=> "Parent snapshot name. This is used internally, and should not be modified.",
436 description
=> "Timestamp for snapshots.",
442 type
=> 'string', format
=> 'pve-volume-id',
443 description
=> "Reference to a volume which stores the VM state. This is used internally for snapshots.",
446 description
=> "Specific the Qemu machine type.",
448 pattern
=> '(pc|pc(-i440fx)?-\d+\.\d+|q35|pc-q35-\d+\.\d+)',
453 description
=> "Specify SMBIOS type 1 fields.",
454 type
=> 'string', format
=> 'pve-qm-smbios1',
455 typetext
=> "[manufacturer=str][,product=str][,version=str][,serial=str] [,uuid=uuid][,sku=str][,family=str]",
461 # what about other qemu settings ?
463 #machine => 'string',
476 ##soundhw => 'string',
478 while (my ($k, $v) = each %$confdesc) {
479 PVE
::JSONSchema
::register_standard_option
("pve-qm-$k", $v);
482 my $MAX_IDE_DISKS = 4;
483 my $MAX_SCSI_DISKS = 14;
484 my $MAX_VIRTIO_DISKS = 16;
485 my $MAX_SATA_DISKS = 6;
486 my $MAX_USB_DEVICES = 5;
488 my $MAX_UNUSED_DISKS = 8;
489 my $MAX_HOSTPCI_DEVICES = 4;
490 my $MAX_SERIAL_PORTS = 4;
491 my $MAX_PARALLEL_PORTS = 3;
496 type
=> 'string', format
=> 'pve-qm-numanode',
497 typetext
=> "cpus=<id[-id],memory=<mb>[[,hostnodes=<id[-id]>][,policy=<preferred|bind|interleave>]]",
498 description
=> "numa topology",
500 PVE
::JSONSchema
::register_standard_option
("pve-qm-numanode", $numadesc);
502 for (my $i = 0; $i < $MAX_NUMA; $i++) {
503 $confdesc->{"numa$i"} = $numadesc;
506 my $nic_model_list = ['rtl8139', 'ne2k_pci', 'e1000', 'pcnet', 'virtio',
507 'ne2k_isa', 'i82551', 'i82557b', 'i82559er', 'vmxnet3'];
508 my $nic_model_list_txt = join(' ', sort @$nic_model_list);
512 type
=> 'string', format
=> 'pve-qm-net',
513 typetext
=> "MODEL=XX:XX:XX:XX:XX:XX [,bridge=<dev>][,queues=<nbqueues>][,rate=<mbps>][,tag=<vlanid>][,firewall=0|1]",
514 description
=> <<EODESCR,
515 Specify network devices.
517 MODEL is one of: $nic_model_list_txt
519 XX:XX:XX:XX:XX:XX should be an unique MAC address. This is
520 automatically generated if not specified.
522 The bridge parameter can be used to automatically add the interface to a bridge device. The Proxmox VE standard bridge is called 'vmbr0'.
524 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'.
526 If you specify no bridge, we create a kvm 'user' (NATed) network device, which provides DHCP and DNS services. The following addresses are used:
532 The DHCP server assign addresses to the guest starting from 10.0.2.15.
536 PVE
::JSONSchema
::register_standard_option
("pve-qm-net", $netdesc);
538 for (my $i = 0; $i < $MAX_NETS; $i++) {
539 $confdesc->{"net$i"} = $netdesc;
546 type
=> 'string', format
=> 'pve-qm-drive',
547 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]',
548 description
=> "Use volume as IDE hard disk or CD-ROM (n is 0 to " .($MAX_IDE_DISKS -1) . ").",
550 PVE
::JSONSchema
::register_standard_option
("pve-qm-ide", $idedesc);
554 type
=> 'string', format
=> 'pve-qm-drive',
555 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]',
556 description
=> "Use volume as SCSI hard disk or CD-ROM (n is 0 to " . ($MAX_SCSI_DISKS - 1) . ").",
558 PVE
::JSONSchema
::register_standard_option
("pve-qm-scsi", $scsidesc);
562 type
=> 'string', format
=> 'pve-qm-drive',
563 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]',
564 description
=> "Use volume as SATA hard disk or CD-ROM (n is 0 to " . ($MAX_SATA_DISKS - 1). ").",
566 PVE
::JSONSchema
::register_standard_option
("pve-qm-sata", $satadesc);
570 type
=> 'string', format
=> 'pve-qm-drive',
571 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]',
572 description
=> "Use volume as VIRTIO hard disk (n is 0 to " . ($MAX_VIRTIO_DISKS - 1) . ").",
574 PVE
::JSONSchema
::register_standard_option
("pve-qm-virtio", $virtiodesc);
578 type
=> 'string', format
=> 'pve-qm-usb-device',
579 typetext
=> 'host=HOSTUSBDEVICE|spice',
580 description
=> <<EODESCR,
581 Configure an USB device (n is 0 to 4). This can be used to
582 pass-through usb devices to the guest. HOSTUSBDEVICE syntax is:
584 'bus-port(.port)*' (decimal numbers) or
585 'vendor_id:product_id' (hexadeciaml numbers)
587 You can use the 'lsusb -t' command to list existing usb devices.
589 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
591 The value 'spice' can be used to add a usb redirection devices for spice.
595 PVE
::JSONSchema
::register_standard_option
("pve-qm-usb", $usbdesc);
599 type
=> 'string', format
=> 'pve-qm-hostpci',
600 typetext
=> "[host=]HOSTPCIDEVICE [,driver=kvm|vfio] [,rombar=on|off] [,pcie=0|1] [,x-vga=on|off]",
601 description
=> <<EODESCR,
602 Map host pci devices. HOSTPCIDEVICE syntax is:
604 'bus:dev.func' (hexadecimal numbers)
606 You can us the 'lspci' command to list existing pci devices.
608 The 'rombar' option determines whether or not the device's ROM will be visible in the guest's memory map (default is 'on').
610 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
612 Experimental: user reported problems with this option.
615 PVE
::JSONSchema
::register_standard_option
("pve-qm-hostpci", $hostpcidesc);
620 pattern
=> '(/dev/.+|socket)',
621 description
=> <<EODESCR,
622 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).
624 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
626 Experimental: user reported problems with this option.
633 pattern
=> '/dev/parport\d+|/dev/usb/lp\d+',
634 description
=> <<EODESCR,
635 Map host parallel devices (n is 0 to 2).
637 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
639 Experimental: user reported problems with this option.
643 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
644 $confdesc->{"parallel$i"} = $paralleldesc;
647 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
648 $confdesc->{"serial$i"} = $serialdesc;
651 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
652 $confdesc->{"hostpci$i"} = $hostpcidesc;
655 for (my $i = 0; $i < $MAX_IDE_DISKS; $i++) {
656 $drivename_hash->{"ide$i"} = 1;
657 $confdesc->{"ide$i"} = $idedesc;
660 for (my $i = 0; $i < $MAX_SATA_DISKS; $i++) {
661 $drivename_hash->{"sata$i"} = 1;
662 $confdesc->{"sata$i"} = $satadesc;
665 for (my $i = 0; $i < $MAX_SCSI_DISKS; $i++) {
666 $drivename_hash->{"scsi$i"} = 1;
667 $confdesc->{"scsi$i"} = $scsidesc ;
670 for (my $i = 0; $i < $MAX_VIRTIO_DISKS; $i++) {
671 $drivename_hash->{"virtio$i"} = 1;
672 $confdesc->{"virtio$i"} = $virtiodesc;
675 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
676 $confdesc->{"usb$i"} = $usbdesc;
681 type
=> 'string', format
=> 'pve-volume-id',
682 description
=> "Reference to unused volumes.",
685 for (my $i = 0; $i < $MAX_UNUSED_DISKS; $i++) {
686 $confdesc->{"unused$i"} = $unuseddesc;
689 my $kvm_api_version = 0;
693 return $kvm_api_version if $kvm_api_version;
695 my $fh = IO
::File-
>new("</dev/kvm") ||
698 if (my $v = $fh->ioctl(KVM_GET_API_VERSION
(), 0)) {
699 $kvm_api_version = $v;
704 return $kvm_api_version;
707 my $kvm_user_version;
709 sub kvm_user_version
{
711 return $kvm_user_version if $kvm_user_version;
713 $kvm_user_version = 'unknown';
715 my $tmp = `kvm -help 2>/dev/null`;
717 if ($tmp =~ m/^QEMU( PC)? emulator version (\d+\.\d+(\.\d+)?)[,\s]/) {
718 $kvm_user_version = $2;
721 return $kvm_user_version;
725 my $kernel_has_vhost_net = -c
'/dev/vhost-net';
728 # order is important - used to autoselect boot disk
729 return ((map { "ide$_" } (0 .. ($MAX_IDE_DISKS - 1))),
730 (map { "scsi$_" } (0 .. ($MAX_SCSI_DISKS - 1))),
731 (map { "virtio$_" } (0 .. ($MAX_VIRTIO_DISKS - 1))),
732 (map { "sata$_" } (0 .. ($MAX_SATA_DISKS - 1))));
735 sub valid_drivename
{
738 return defined($drivename_hash->{$dev});
743 return defined($confdesc->{$key});
747 return $nic_model_list;
750 sub os_list_description
{
755 w2k
=> 'Windows 2000',
756 w2k3
=>, 'Windows 2003',
757 w2k8
=> 'Windows 2008',
758 wvista
=> 'Windows Vista',
760 win8
=> 'Windows 8/2012',
770 return $cdrom_path if $cdrom_path;
772 return $cdrom_path = "/dev/cdrom" if -l
"/dev/cdrom";
773 return $cdrom_path = "/dev/cdrom1" if -l
"/dev/cdrom1";
774 return $cdrom_path = "/dev/cdrom2" if -l
"/dev/cdrom2";
778 my ($storecfg, $vmid, $cdrom) = @_;
780 if ($cdrom eq 'cdrom') {
781 return get_cdrom_path
();
782 } elsif ($cdrom eq 'none') {
784 } elsif ($cdrom =~ m
|^/|) {
787 return PVE
::Storage
::path
($storecfg, $cdrom);
791 # try to convert old style file names to volume IDs
792 sub filename_to_volume_id
{
793 my ($vmid, $file, $media) = @_;
795 if (!($file eq 'none' || $file eq 'cdrom' ||
796 $file =~ m
|^/dev/.+| || $file =~ m/^([^:]+):(.+)$/)) {
798 return undef if $file =~ m
|/|;
800 if ($media && $media eq 'cdrom') {
801 $file = "local:iso/$file";
803 $file = "local:$vmid/$file";
810 sub verify_media_type
{
811 my ($opt, $vtype, $media) = @_;
816 if ($media eq 'disk') {
818 } elsif ($media eq 'cdrom') {
821 die "internal error";
824 return if ($vtype eq $etype);
826 raise_param_exc
({ $opt => "unexpected media type ($vtype != $etype)" });
829 sub cleanup_drive_path
{
830 my ($opt, $storecfg, $drive) = @_;
832 # try to convert filesystem paths to volume IDs
834 if (($drive->{file
} !~ m/^(cdrom|none)$/) &&
835 ($drive->{file
} !~ m
|^/dev/.+|) &&
836 ($drive->{file
} !~ m/^([^:]+):(.+)$/) &&
837 ($drive->{file
} !~ m/^\d+$/)) {
838 my ($vtype, $volid) = PVE
::Storage
::path_to_volume_id
($storecfg, $drive->{file
});
839 raise_param_exc
({ $opt => "unable to associate path '$drive->{file}' to any storage"}) if !$vtype;
840 $drive->{media
} = 'cdrom' if !$drive->{media
} && $vtype eq 'iso';
841 verify_media_type
($opt, $vtype, $drive->{media
});
842 $drive->{file
} = $volid;
845 $drive->{media
} = 'cdrom' if !$drive->{media
} && $drive->{file
} =~ m/^(cdrom|none)$/;
848 sub create_conf_nolock
{
849 my ($vmid, $settings) = @_;
851 my $filename = config_file
($vmid);
853 die "configuration file '$filename' already exists\n" if -f
$filename;
855 my $defaults = load_defaults
();
857 $settings->{name
} = "vm$vmid" if !$settings->{name
};
858 $settings->{memory
} = $defaults->{memory
} if !$settings->{memory
};
861 foreach my $opt (keys %$settings) {
862 next if !$confdesc->{$opt};
864 my $value = $settings->{$opt};
867 $data .= "$opt: $value\n";
870 PVE
::Tools
::file_set_contents
($filename, $data);
873 my $parse_size = sub {
876 return undef if $value !~ m/^(\d+(\.\d+)?)([KMG])?$/;
877 my ($size, $unit) = ($1, $3);
880 $size = $size * 1024;
881 } elsif ($unit eq 'M') {
882 $size = $size * 1024 * 1024;
883 } elsif ($unit eq 'G') {
884 $size = $size * 1024 * 1024 * 1024;
890 my $format_size = sub {
895 my $kb = int($size/1024);
896 return $size if $kb*1024 != $size;
898 my $mb = int($kb/1024);
899 return "${kb}K" if $mb*1024 != $kb;
901 my $gb = int($mb/1024);
902 return "${mb}M" if $gb*1024 != $mb;
907 # ideX = [volume=]volume-id[,media=d][,cyls=c,heads=h,secs=s[,trans=t]]
908 # [,snapshot=on|off][,cache=on|off][,format=f][,backup=yes|no]
909 # [,rerror=ignore|report|stop][,werror=enospc|ignore|report|stop]
910 # [,aio=native|threads][,discard=ignore|on]
913 my ($key, $data) = @_;
917 # $key may be undefined - used to verify JSON parameters
918 if (!defined($key)) {
919 $res->{interface
} = 'unknown'; # should not harm when used to verify parameters
921 } elsif ($key =~ m/^([^\d]+)(\d+)$/) {
922 $res->{interface
} = $1;
928 foreach my $p (split (/,/, $data)) {
929 next if $p =~ m/^\s*$/;
931 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)=(.+)$/) {
932 my ($k, $v) = ($1, $2);
934 $k = 'file' if $k eq 'volume';
936 return undef if defined $res->{$k};
938 if ($k eq 'bps' || $k eq 'bps_rd' || $k eq 'bps_wr') {
939 return undef if !$v || $v !~ m/^\d+/;
941 $v = sprintf("%.3f", $v / (1024*1024));
945 if (!$res->{file
} && $p !~ m/=/) {
953 return undef if !$res->{file
};
955 if($res->{file
} =~ m/\.(raw|cow|qcow|qcow2|vmdk|cloop)$/){
959 return undef if $res->{cache
} &&
960 $res->{cache
} !~ m/^(off|none|writethrough|writeback|unsafe|directsync)$/;
961 return undef if $res->{snapshot
} && $res->{snapshot
} !~ m/^(on|off)$/;
962 return undef if $res->{cyls
} && $res->{cyls
} !~ m/^\d+$/;
963 return undef if $res->{heads
} && $res->{heads
} !~ m/^\d+$/;
964 return undef if $res->{secs
} && $res->{secs
} !~ m/^\d+$/;
965 return undef if $res->{media
} && $res->{media
} !~ m/^(disk|cdrom)$/;
966 return undef if $res->{trans
} && $res->{trans
} !~ m/^(none|lba|auto)$/;
967 return undef if $res->{format
} && $res->{format
} !~ m/^(raw|cow|qcow|qcow2|vmdk|cloop)$/;
968 return undef if $res->{rerror
} && $res->{rerror
} !~ m/^(ignore|report|stop)$/;
969 return undef if $res->{werror
} && $res->{werror
} !~ m/^(enospc|ignore|report|stop)$/;
970 return undef if $res->{backup
} && $res->{backup
} !~ m/^(yes|no)$/;
971 return undef if $res->{aio
} && $res->{aio
} !~ m/^(native|threads)$/;
972 return undef if $res->{discard
} && $res->{discard
} !~ m/^(ignore|on)$/;
974 return undef if $res->{mbps_rd
} && $res->{mbps
};
975 return undef if $res->{mbps_wr
} && $res->{mbps
};
977 return undef if $res->{mbps
} && $res->{mbps
} !~ m/^\d+(\.\d+)?$/;
978 return undef if $res->{mbps_max
} && $res->{mbps_max
} !~ m/^\d+(\.\d+)?$/;
979 return undef if $res->{mbps_rd
} && $res->{mbps_rd
} !~ m/^\d+(\.\d+)?$/;
980 return undef if $res->{mbps_rd_max
} && $res->{mbps_rd_max
} !~ m/^\d+(\.\d+)?$/;
981 return undef if $res->{mbps_wr
} && $res->{mbps_wr
} !~ m/^\d+(\.\d+)?$/;
982 return undef if $res->{mbps_wr_max
} && $res->{mbps_wr_max
} !~ m/^\d+(\.\d+)?$/;
984 return undef if $res->{iops_rd
} && $res->{iops
};
985 return undef if $res->{iops_wr
} && $res->{iops
};
988 return undef if $res->{iops
} && $res->{iops
} !~ m/^\d+$/;
989 return undef if $res->{iops_max
} && $res->{iops_max
} !~ m/^\d+$/;
990 return undef if $res->{iops_rd
} && $res->{iops_rd
} !~ m/^\d+$/;
991 return undef if $res->{iops_rd_max
} && $res->{iops_rd_max
} !~ m/^\d+$/;
992 return undef if $res->{iops_wr
} && $res->{iops_wr
} !~ m/^\d+$/;
993 return undef if $res->{iops_wr_max
} && $res->{iops_wr_max
} !~ m/^\d+$/;
997 return undef if !defined($res->{size
} = &$parse_size($res->{size
}));
1000 if ($res->{media
} && ($res->{media
} eq 'cdrom')) {
1001 return undef if $res->{snapshot
} || $res->{trans
} || $res->{format
};
1002 return undef if $res->{heads
} || $res->{secs
} || $res->{cyls
};
1003 return undef if $res->{interface
} eq 'virtio';
1006 # rerror does not work with scsi drives
1007 if ($res->{rerror
}) {
1008 return undef if $res->{interface
} eq 'scsi';
1014 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);
1017 my ($vmid, $drive) = @_;
1020 foreach my $o (@qemu_drive_options, 'mbps', 'mbps_rd', 'mbps_wr', 'mbps_max', 'mbps_rd_max', 'mbps_wr_max', 'backup') {
1021 $opts .= ",$o=$drive->{$o}" if $drive->{$o};
1024 if ($drive->{size
}) {
1025 $opts .= ",size=" . &$format_size($drive->{size
});
1028 return "$drive->{file}$opts";
1032 my($fh, $noerr) = @_;
1035 my $SG_GET_VERSION_NUM = 0x2282;
1037 my $versionbuf = "\x00" x
8;
1038 my $ret = ioctl($fh, $SG_GET_VERSION_NUM, $versionbuf);
1040 die "scsi ioctl SG_GET_VERSION_NUM failoed - $!\n" if !$noerr;
1043 my $version = unpack("I", $versionbuf);
1044 if ($version < 30000) {
1045 die "scsi generic interface too old\n" if !$noerr;
1049 my $buf = "\x00" x
36;
1050 my $sensebuf = "\x00" x
8;
1051 my $cmd = pack("C x3 C x1", 0x12, 36);
1053 # see /usr/include/scsi/sg.h
1054 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";
1056 my $packet = pack($sg_io_hdr_t, ord('S'), -3, length($cmd),
1057 length($sensebuf), 0, length($buf), $buf,
1058 $cmd, $sensebuf, 6000);
1060 $ret = ioctl($fh, $SG_IO, $packet);
1062 die "scsi ioctl SG_IO failed - $!\n" if !$noerr;
1066 my @res = unpack($sg_io_hdr_t, $packet);
1067 if ($res[17] || $res[18]) {
1068 die "scsi ioctl SG_IO status error - $!\n" if !$noerr;
1073 (my $byte0, my $byte1, $res->{vendor
},
1074 $res->{product
}, $res->{revision
}) = unpack("C C x6 A8 A16 A4", $buf);
1076 $res->{removable
} = $byte1 & 128 ?
1 : 0;
1077 $res->{type
} = $byte0 & 31;
1085 my $fh = IO
::File-
>new("+<$path") || return undef;
1086 my $res = scsi_inquiry
($fh, 1);
1092 sub machine_type_is_q35
{
1095 return $conf->{machine
} && ($conf->{machine
} =~ m/q35/) ?
1 : 0;
1098 sub print_tabletdevice_full
{
1101 my $q35 = machine_type_is_q35
($conf);
1103 # we use uhci for old VMs because tablet driver was buggy in older qemu
1104 my $usbbus = $q35 ?
"ehci" : "uhci";
1106 return "usb-tablet,id=tablet,bus=$usbbus.0,port=1";
1109 sub print_drivedevice_full
{
1110 my ($storecfg, $conf, $vmid, $drive, $bridges) = @_;
1115 if ($drive->{interface
} eq 'virtio') {
1116 my $pciaddr = print_pci_addr
("$drive->{interface}$drive->{index}", $bridges);
1117 $device = "virtio-blk-pci,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}$pciaddr";
1118 $device .= ",iothread=iothread0" if $conf->{iothread
};
1119 } elsif ($drive->{interface
} eq 'scsi') {
1120 $maxdev = ($conf->{scsihw
} && ($conf->{scsihw
} !~ m/^lsi/)) ?
256 : 7;
1121 my $controller = int($drive->{index} / $maxdev);
1122 my $unit = $drive->{index} % $maxdev;
1123 my $devicetype = 'hd';
1125 if (drive_is_cdrom
($drive)) {
1128 if ($drive->{file
} =~ m
|^/|) {
1129 $path = $drive->{file
};
1131 $path = PVE
::Storage
::path
($storecfg, $drive->{file
});
1134 if($path =~ m/^iscsi\:\/\
//){
1135 $devicetype = 'generic';
1137 if (my $info = path_is_scsi
($path)) {
1138 if ($info->{type
} == 0) {
1139 $devicetype = 'block';
1140 } elsif ($info->{type
} == 1) { # tape
1141 $devicetype = 'generic';
1147 if (!$conf->{scsihw
} || ($conf->{scsihw
} =~ m/^lsi/)){
1148 $device = "scsi-$devicetype,bus=scsihw$controller.0,scsi-id=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1150 $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}";
1153 } elsif ($drive->{interface
} eq 'ide'){
1155 my $controller = int($drive->{index} / $maxdev);
1156 my $unit = $drive->{index} % $maxdev;
1157 my $devicetype = ($drive->{media
} && $drive->{media
} eq 'cdrom') ?
"cd" : "hd";
1159 $device = "ide-$devicetype,bus=ide.$controller,unit=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1160 } elsif ($drive->{interface
} eq 'sata'){
1161 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
1162 my $unit = $drive->{index} % $MAX_SATA_DISKS;
1163 $device = "ide-drive,bus=ahci$controller.$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1164 } elsif ($drive->{interface
} eq 'usb') {
1166 # -device ide-drive,bus=ide.1,unit=0,drive=drive-ide0-1-0,id=ide0-1-0
1168 die "unsupported interface type";
1171 $device .= ",bootindex=$drive->{bootindex}" if $drive->{bootindex
};
1176 sub get_initiator_name
{
1179 my $fh = IO
::File-
>new('/etc/iscsi/initiatorname.iscsi') || return undef;
1180 while (defined(my $line = <$fh>)) {
1181 next if $line !~ m/^\s*InitiatorName\s*=\s*([\.\-:\w]+)/;
1190 sub print_drive_full
{
1191 my ($storecfg, $vmid, $drive) = @_;
1194 foreach my $o (@qemu_drive_options) {
1195 next if $o eq 'bootindex';
1196 $opts .= ",$o=$drive->{$o}" if $drive->{$o};
1199 foreach my $o (qw(bps bps_rd bps_wr)) {
1200 my $v = $drive->{"m$o"};
1201 $opts .= ",$o=" . int($v*1024*1024) if $v;
1204 # use linux-aio by default (qemu default is threads)
1205 $opts .= ",aio=native" if !$drive->{aio
};
1208 my $volid = $drive->{file
};
1209 if (drive_is_cdrom
($drive)) {
1210 $path = get_iso_path
($storecfg, $vmid, $volid);
1212 if ($volid =~ m
|^/|) {
1215 $path = PVE
::Storage
::path
($storecfg, $volid);
1219 $opts .= ",cache=none" if !$drive->{cache
} && !drive_is_cdrom
($drive);
1221 my $detectzeroes = $drive->{discard
} ?
"unmap" : "on";
1222 $opts .= ",detect-zeroes=$detectzeroes" if !drive_is_cdrom
($drive);
1224 my $pathinfo = $path ?
"file=$path," : '';
1226 return "${pathinfo}if=none,id=drive-$drive->{interface}$drive->{index}$opts";
1229 sub print_netdevice_full
{
1230 my ($vmid, $conf, $net, $netid, $bridges) = @_;
1232 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
1234 my $device = $net->{model
};
1235 if ($net->{model
} eq 'virtio') {
1236 $device = 'virtio-net-pci';
1239 my $pciaddr = print_pci_addr
("$netid", $bridges);
1240 my $tmpstr = "$device,mac=$net->{macaddr},netdev=$netid$pciaddr,id=$netid";
1241 if ($net->{queues
} && $net->{queues
} > 1 && $net->{model
} eq 'virtio'){
1242 #Consider we have N queues, the number of vectors needed is 2*N + 2 (plus one config interrupt and control vq)
1243 my $vectors = $net->{queues
} * 2 + 2;
1244 $tmpstr .= ",vectors=$vectors,mq=on";
1246 $tmpstr .= ",bootindex=$net->{bootindex}" if $net->{bootindex
} ;
1250 sub print_netdev_full
{
1251 my ($vmid, $conf, $net, $netid) = @_;
1254 if ($netid =~ m/^net(\d+)$/) {
1258 die "got strange net id '$i'\n" if $i >= ${MAX_NETS
};
1260 my $ifname = "tap${vmid}i$i";
1262 # kvm uses TUNSETIFF ioctl, and that limits ifname length
1263 die "interface name '$ifname' is too long (max 15 character)\n"
1264 if length($ifname) >= 16;
1266 my $vhostparam = '';
1267 $vhostparam = ',vhost=on' if $kernel_has_vhost_net && $net->{model
} eq 'virtio';
1269 my $vmname = $conf->{name
} || "vm$vmid";
1273 if ($net->{bridge
}) {
1274 $netdev = "type=tap,id=$netid,ifname=${ifname},script=/var/lib/qemu-server/pve-bridge,downscript=/var/lib/qemu-server/pve-bridgedown$vhostparam";
1276 $netdev = "type=user,id=$netid,hostname=$vmname";
1279 $netdev .= ",queues=$net->{queues}" if ($net->{queues
} && $net->{model
} eq 'virtio');
1284 sub drive_is_cdrom
{
1287 return $drive && $drive->{media
} && ($drive->{media
} eq 'cdrom');
1296 foreach my $kvp (split(/,/, $data)) {
1298 if ($kvp =~ m/^memory=(\S+)$/) {
1299 $res->{memory
} = $1;
1300 } elsif ($kvp =~ m/^policy=(preferred|bind|interleave)$/) {
1301 $res->{policy
} = $1;
1302 } elsif ($kvp =~ m/^cpus=(\d+)(-(\d+))?$/) {
1303 $res->{cpus
}->{start
} = $1;
1304 $res->{cpus
}->{end
} = $3;
1305 } elsif ($kvp =~ m/^hostnodes=(\d+)(-(\d+))?$/) {
1306 $res->{hostnodes
}->{start
} = $1;
1307 $res->{hostnodes
}->{end
} = $3;
1319 return undef if !$value;
1322 my @list = split(/,/, $value);
1326 foreach my $kv (@list) {
1328 if ($kv =~ m/^(host=)?([a-f0-9]{2}:[a-f0-9]{2})(\.([a-f0-9]))?$/) {
1331 push @{$res->{pciid
}}, { id
=> $2 , function
=> $4};
1334 my $pcidevices = lspci
($2);
1335 $res->{pciid
} = $pcidevices->{$2};
1337 } elsif ($kv =~ m/^driver=(kvm|vfio)$/) {
1338 $res->{driver
} = $1;
1339 } elsif ($kv =~ m/^rombar=(on|off)$/) {
1340 $res->{rombar
} = $1;
1341 } elsif ($kv =~ m/^x-vga=(on|off)$/) {
1342 $res->{'x-vga'} = $1;
1343 } elsif ($kv =~ m/^pcie=(\d+)$/) {
1344 $res->{pcie
} = 1 if $1 == 1;
1346 warn "unknown hostpci setting '$kv'\n";
1350 return undef if !$found;
1355 # netX: e1000=XX:XX:XX:XX:XX:XX,bridge=vmbr0,rate=<mbps>
1361 foreach my $kvp (split(/,/, $data)) {
1363 if ($kvp =~ m/^(ne2k_pci|e1000|rtl8139|pcnet|virtio|ne2k_isa|i82551|i82557b|i82559er|vmxnet3)(=([0-9a-f]{2}(:[0-9a-f]{2}){5}))?$/i) {
1365 my $mac = defined($3) ?
uc($3) : PVE
::Tools
::random_ether_addr
();
1366 $res->{model
} = $model;
1367 $res->{macaddr
} = $mac;
1368 } elsif ($kvp =~ m/^bridge=(\S+)$/) {
1369 $res->{bridge
} = $1;
1370 } elsif ($kvp =~ m/^queues=(\d+)$/) {
1371 $res->{queues
} = $1;
1372 } elsif ($kvp =~ m/^rate=(\d+(\.\d+)?)$/) {
1374 } elsif ($kvp =~ m/^tag=(\d+)$/) {
1376 } elsif ($kvp =~ m/^firewall=(\d+)$/) {
1377 $res->{firewall
} = $1;
1384 return undef if !$res->{model
};
1392 my $res = "$net->{model}";
1393 $res .= "=$net->{macaddr}" if $net->{macaddr
};
1394 $res .= ",bridge=$net->{bridge}" if $net->{bridge
};
1395 $res .= ",rate=$net->{rate}" if $net->{rate
};
1396 $res .= ",tag=$net->{tag}" if $net->{tag
};
1397 $res .= ",firewall=$net->{firewall}" if $net->{firewall
};
1402 sub add_random_macs
{
1403 my ($settings) = @_;
1405 foreach my $opt (keys %$settings) {
1406 next if $opt !~ m/^net(\d+)$/;
1407 my $net = parse_net
($settings->{$opt});
1409 $settings->{$opt} = print_net
($net);
1413 sub add_unused_volume
{
1414 my ($config, $volid) = @_;
1417 for (my $ind = $MAX_UNUSED_DISKS - 1; $ind >= 0; $ind--) {
1418 my $test = "unused$ind";
1419 if (my $vid = $config->{$test}) {
1420 return if $vid eq $volid; # do not add duplicates
1426 die "To many unused volume - please delete them first.\n" if !$key;
1428 $config->{$key} = $volid;
1433 sub vm_is_volid_owner
{
1434 my ($storecfg, $vmid, $volid) = @_;
1436 if ($volid !~ m
|^/|) {
1438 eval { ($path, $owner) = PVE
::Storage
::path
($storecfg, $volid); };
1439 if ($owner && ($owner == $vmid)) {
1447 sub vmconfig_delete_pending_option
{
1448 my ($conf, $key) = @_;
1450 delete $conf->{pending
}->{$key};
1451 my $pending_delete_hash = { $key => 1 };
1452 foreach my $opt (PVE
::Tools
::split_list
($conf->{pending
}->{delete})) {
1453 $pending_delete_hash->{$opt} = 1;
1455 $conf->{pending
}->{delete} = join(',', keys %$pending_delete_hash);
1458 sub vmconfig_undelete_pending_option
{
1459 my ($conf, $key) = @_;
1461 my $pending_delete_hash = {};
1462 foreach my $opt (PVE
::Tools
::split_list
($conf->{pending
}->{delete})) {
1463 $pending_delete_hash->{$opt} = 1;
1465 delete $pending_delete_hash->{$key};
1467 my @keylist = keys %$pending_delete_hash;
1468 if (scalar(@keylist)) {
1469 $conf->{pending
}->{delete} = join(',', @keylist);
1471 delete $conf->{pending
}->{delete};
1475 sub vmconfig_register_unused_drive
{
1476 my ($storecfg, $vmid, $conf, $drive) = @_;
1478 if (!drive_is_cdrom
($drive)) {
1479 my $volid = $drive->{file
};
1480 if (vm_is_volid_owner
($storecfg, $vmid, $volid)) {
1481 add_unused_volume
($conf, $volid, $vmid);
1486 sub vmconfig_cleanup_pending
{
1489 # remove pending changes when nothing changed
1491 foreach my $opt (keys %{$conf->{pending
}}) {
1492 if (defined($conf->{$opt}) && ($conf->{pending
}->{$opt} eq $conf->{$opt})) {
1494 delete $conf->{pending
}->{$opt};
1498 # remove delete if option is not set
1499 my $pending_delete_hash = {};
1500 foreach my $opt (PVE
::Tools
::split_list
($conf->{pending
}->{delete})) {
1501 if (defined($conf->{$opt})) {
1502 $pending_delete_hash->{$opt} = 1;
1508 my @keylist = keys %$pending_delete_hash;
1509 if (scalar(@keylist)) {
1510 $conf->{pending
}->{delete} = join(',', @keylist);
1512 delete $conf->{pending
}->{delete};
1518 my $valid_smbios1_options = {
1519 manufacturer
=> '\S+',
1523 uuid
=> '[a-fA-F0-9]{8}(?:-[a-fA-F0-9]{4}){3}-[a-fA-F0-9]{12}',
1528 # smbios: [manufacturer=str][,product=str][,version=str][,serial=str][,uuid=uuid][,sku=str][,family=str]
1534 foreach my $kvp (split(/,/, $data)) {
1535 return undef if $kvp !~ m/^(\S+)=(.+)$/;
1536 my ($k, $v) = split(/=/, $kvp);
1537 return undef if !defined($k) || !defined($v);
1538 return undef if !$valid_smbios1_options->{$k};
1539 return undef if $v !~ m/^$valid_smbios1_options->{$k}$/;
1550 foreach my $k (keys %$smbios1) {
1551 next if !defined($smbios1->{$k});
1552 next if !$valid_smbios1_options->{$k};
1553 $data .= ',' if $data;
1554 $data .= "$k=$smbios1->{$k}";
1559 PVE
::JSONSchema
::register_format
('pve-qm-smbios1', \
&verify_smbios1
);
1560 sub verify_smbios1
{
1561 my ($value, $noerr) = @_;
1563 return $value if parse_smbios1
($value);
1565 return undef if $noerr;
1567 die "unable to parse smbios (type 1) options\n";
1570 PVE
::JSONSchema
::register_format
('pve-qm-bootdisk', \
&verify_bootdisk
);
1571 sub verify_bootdisk
{
1572 my ($value, $noerr) = @_;
1574 return $value if valid_drivename
($value);
1576 return undef if $noerr;
1578 die "invalid boot disk '$value'\n";
1581 PVE
::JSONSchema
::register_format
('pve-qm-numanode', \
&verify_numa
);
1583 my ($value, $noerr) = @_;
1585 return $value if parse_numa
($value);
1587 return undef if $noerr;
1589 die "unable to parse numa options\n";
1592 PVE
::JSONSchema
::register_format
('pve-qm-net', \
&verify_net
);
1594 my ($value, $noerr) = @_;
1596 return $value if parse_net
($value);
1598 return undef if $noerr;
1600 die "unable to parse network options\n";
1603 PVE
::JSONSchema
::register_format
('pve-qm-drive', \
&verify_drive
);
1605 my ($value, $noerr) = @_;
1607 return $value if parse_drive
(undef, $value);
1609 return undef if $noerr;
1611 die "unable to parse drive options\n";
1614 PVE
::JSONSchema
::register_format
('pve-qm-hostpci', \
&verify_hostpci
);
1615 sub verify_hostpci
{
1616 my ($value, $noerr) = @_;
1618 return $value if parse_hostpci
($value);
1620 return undef if $noerr;
1622 die "unable to parse pci id\n";
1625 PVE
::JSONSchema
::register_format
('pve-qm-watchdog', \
&verify_watchdog
);
1626 sub verify_watchdog
{
1627 my ($value, $noerr) = @_;
1629 return $value if parse_watchdog
($value);
1631 return undef if $noerr;
1633 die "unable to parse watchdog options\n";
1636 sub parse_watchdog
{
1639 return undef if !$value;
1643 foreach my $p (split(/,/, $value)) {
1644 next if $p =~ m/^\s*$/;
1646 if ($p =~ m/^(model=)?(i6300esb|ib700)$/) {
1648 } elsif ($p =~ m/^(action=)?(reset|shutdown|poweroff|pause|debug|none)$/) {
1649 $res->{action
} = $2;
1658 PVE
::JSONSchema
::register_format
('pve-qm-startup', \
&verify_startup
);
1659 sub verify_startup
{
1660 my ($value, $noerr) = @_;
1662 return $value if parse_startup
($value);
1664 return undef if $noerr;
1666 die "unable to parse startup options\n";
1672 return undef if !$value;
1676 foreach my $p (split(/,/, $value)) {
1677 next if $p =~ m/^\s*$/;
1679 if ($p =~ m/^(order=)?(\d+)$/) {
1681 } elsif ($p =~ m/^up=(\d+)$/) {
1683 } elsif ($p =~ m/^down=(\d+)$/) {
1693 sub parse_usb_device
{
1696 return undef if !$value;
1698 my @dl = split(/,/, $value);
1702 foreach my $v (@dl) {
1703 if ($v =~ m/^host=(0x)?([0-9A-Fa-f]{4}):(0x)?([0-9A-Fa-f]{4})$/) {
1705 $res->{vendorid
} = $2;
1706 $res->{productid
} = $4;
1707 } elsif ($v =~ m/^host=(\d+)\-(\d+(\.\d+)*)$/) {
1709 $res->{hostbus
} = $1;
1710 $res->{hostport
} = $2;
1711 } elsif ($v =~ m/^spice$/) {
1718 return undef if !$found;
1723 PVE
::JSONSchema
::register_format
('pve-qm-usb-device', \
&verify_usb_device
);
1724 sub verify_usb_device
{
1725 my ($value, $noerr) = @_;
1727 return $value if parse_usb_device
($value);
1729 return undef if $noerr;
1731 die "unable to parse usb device\n";
1734 # add JSON properties for create and set function
1735 sub json_config_properties
{
1738 foreach my $opt (keys %$confdesc) {
1739 next if $opt eq 'parent' || $opt eq 'snaptime' || $opt eq 'vmstate';
1740 $prop->{$opt} = $confdesc->{$opt};
1747 my ($key, $value) = @_;
1749 die "unknown setting '$key'\n" if !$confdesc->{$key};
1751 my $type = $confdesc->{$key}->{type
};
1753 if (!defined($value)) {
1754 die "got undefined value\n";
1757 if ($value =~ m/[\n\r]/) {
1758 die "property contains a line feed\n";
1761 if ($type eq 'boolean') {
1762 return 1 if ($value eq '1') || ($value =~ m/^(on|yes|true)$/i);
1763 return 0 if ($value eq '0') || ($value =~ m/^(off|no|false)$/i);
1764 die "type check ('boolean') failed - got '$value'\n";
1765 } elsif ($type eq 'integer') {
1766 return int($1) if $value =~ m/^(\d+)$/;
1767 die "type check ('integer') failed - got '$value'\n";
1768 } elsif ($type eq 'number') {
1769 return $value if $value =~ m/^(\d+)(\.\d+)?$/;
1770 die "type check ('number') failed - got '$value'\n";
1771 } elsif ($type eq 'string') {
1772 if (my $fmt = $confdesc->{$key}->{format
}) {
1773 if ($fmt eq 'pve-qm-drive') {
1774 # special case - we need to pass $key to parse_drive()
1775 my $drive = parse_drive
($key, $value);
1776 return $value if $drive;
1777 die "unable to parse drive options\n";
1779 PVE
::JSONSchema
::check_format
($fmt, $value);
1782 $value =~ s/^\"(.*)\"$/$1/;
1785 die "internal error"
1789 sub lock_config_full
{
1790 my ($vmid, $timeout, $code, @param) = @_;
1792 my $filename = config_file_lock
($vmid);
1794 my $res = lock_file
($filename, $timeout, $code, @param);
1801 sub lock_config_mode
{
1802 my ($vmid, $timeout, $shared, $code, @param) = @_;
1804 my $filename = config_file_lock
($vmid);
1806 my $res = lock_file_full
($filename, $timeout, $shared, $code, @param);
1814 my ($vmid, $code, @param) = @_;
1816 return lock_config_full
($vmid, 10, $code, @param);
1819 sub cfs_config_path
{
1820 my ($vmid, $node) = @_;
1822 $node = $nodename if !$node;
1823 return "nodes/$node/qemu-server/$vmid.conf";
1826 sub check_iommu_support
{
1827 #fixme : need to check IOMMU support
1828 #http://www.linux-kvm.org/page/How_to_assign_devices_with_VT-d_in_KVM
1836 my ($vmid, $node) = @_;
1838 my $cfspath = cfs_config_path
($vmid, $node);
1839 return "/etc/pve/$cfspath";
1842 sub config_file_lock
{
1845 return "$lock_dir/lock-$vmid.conf";
1851 my $conf = config_file
($vmid);
1852 utime undef, undef, $conf;
1856 my ($storecfg, $vmid, $keep_empty_config) = @_;
1858 my $conffile = config_file
($vmid);
1860 my $conf = load_config
($vmid);
1864 # only remove disks owned by this VM
1865 foreach_drive
($conf, sub {
1866 my ($ds, $drive) = @_;
1868 return if drive_is_cdrom
($drive);
1870 my $volid = $drive->{file
};
1872 return if !$volid || $volid =~ m
|^/|;
1874 my ($path, $owner) = PVE
::Storage
::path
($storecfg, $volid);
1875 return if !$path || !$owner || ($owner != $vmid);
1877 PVE
::Storage
::vdisk_free
($storecfg, $volid);
1880 if ($keep_empty_config) {
1881 PVE
::Tools
::file_set_contents
($conffile, "memory: 128\n");
1886 # also remove unused disk
1888 my $dl = PVE
::Storage
::vdisk_list
($storecfg, undef, $vmid);
1891 PVE
::Storage
::foreach_volid
($dl, sub {
1892 my ($volid, $sid, $volname, $d) = @_;
1893 PVE
::Storage
::vdisk_free
($storecfg, $volid);
1903 my ($vmid, $node) = @_;
1905 my $cfspath = cfs_config_path
($vmid, $node);
1907 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath);
1909 die "no such VM ('$vmid')\n" if !defined($conf);
1914 sub parse_vm_config
{
1915 my ($filename, $raw) = @_;
1917 return undef if !defined($raw);
1920 digest
=> Digest
::SHA
::sha1_hex
($raw),
1925 $filename =~ m
|/qemu-server/(\d
+)\
.conf
$|
1926 || die "got strange filename '$filename'";
1934 my @lines = split(/\n/, $raw);
1935 foreach my $line (@lines) {
1936 next if $line =~ m/^\s*$/;
1938 if ($line =~ m/^\[PENDING\]\s*$/i) {
1939 $section = 'pending';
1940 $conf->{description
} = $descr if $descr;
1942 $conf = $res->{$section} = {};
1945 } elsif ($line =~ m/^\[([a-z][a-z0-9_\-]+)\]\s*$/i) {
1947 $conf->{description
} = $descr if $descr;
1949 $conf = $res->{snapshots
}->{$section} = {};
1953 if ($line =~ m/^\#(.*)\s*$/) {
1954 $descr .= PVE
::Tools
::decode_text
($1) . "\n";
1958 if ($line =~ m/^(description):\s*(.*\S)\s*$/) {
1959 $descr .= PVE
::Tools
::decode_text
($2);
1960 } elsif ($line =~ m/snapstate:\s*(prepare|delete)\s*$/) {
1961 $conf->{snapstate
} = $1;
1962 } elsif ($line =~ m/^(args):\s*(.*\S)\s*$/) {
1965 $conf->{$key} = $value;
1966 } elsif ($line =~ m/^delete:\s*(.*\S)\s*$/) {
1968 if ($section eq 'pending') {
1969 $conf->{delete} = $value; # we parse this later
1971 warn "vm $vmid - propertry 'delete' is only allowed in [PENDING]\n";
1973 } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/) {
1976 eval { $value = check_type
($key, $value); };
1978 warn "vm $vmid - unable to parse value of '$key' - $@";
1980 my $fmt = $confdesc->{$key}->{format
};
1981 if ($fmt && $fmt eq 'pve-qm-drive') {
1982 my $v = parse_drive
($key, $value);
1983 if (my $volid = filename_to_volume_id
($vmid, $v->{file
}, $v->{media
})) {
1984 $v->{file
} = $volid;
1985 $value = print_drive
($vmid, $v);
1987 warn "vm $vmid - unable to parse value of '$key'\n";
1992 if ($key eq 'cdrom') {
1993 $conf->{ide2
} = $value;
1995 $conf->{$key} = $value;
2001 $conf->{description
} = $descr if $descr;
2003 delete $res->{snapstate
}; # just to be sure
2008 sub write_vm_config
{
2009 my ($filename, $conf) = @_;
2011 delete $conf->{snapstate
}; # just to be sure
2013 if ($conf->{cdrom
}) {
2014 die "option ide2 conflicts with cdrom\n" if $conf->{ide2
};
2015 $conf->{ide2
} = $conf->{cdrom
};
2016 delete $conf->{cdrom
};
2019 # we do not use 'smp' any longer
2020 if ($conf->{sockets
}) {
2021 delete $conf->{smp
};
2022 } elsif ($conf->{smp
}) {
2023 $conf->{sockets
} = $conf->{smp
};
2024 delete $conf->{cores
};
2025 delete $conf->{smp
};
2028 if ($conf->{maxcpus
} && $conf->{sockets
}) {
2029 delete $conf->{sockets
};
2032 my $used_volids = {};
2034 my $cleanup_config = sub {
2035 my ($cref, $pending, $snapname) = @_;
2037 foreach my $key (keys %$cref) {
2038 next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots' ||
2039 $key eq 'snapstate' || $key eq 'pending';
2040 my $value = $cref->{$key};
2041 if ($key eq 'delete') {
2042 die "propertry 'delete' is only allowed in [PENDING]\n"
2044 # fixme: check syntax?
2047 eval { $value = check_type
($key, $value); };
2048 die "unable to parse value of '$key' - $@" if $@;
2050 $cref->{$key} = $value;
2052 if (!$snapname && valid_drivename
($key)) {
2053 my $drive = parse_drive
($key, $value);
2054 $used_volids->{$drive->{file
}} = 1 if $drive && $drive->{file
};
2059 &$cleanup_config($conf);
2061 &$cleanup_config($conf->{pending
}, 1);
2063 foreach my $snapname (keys %{$conf->{snapshots
}}) {
2064 die "internal error" if $snapname eq 'pending';
2065 &$cleanup_config($conf->{snapshots
}->{$snapname}, undef, $snapname);
2068 # remove 'unusedX' settings if we re-add a volume
2069 foreach my $key (keys %$conf) {
2070 my $value = $conf->{$key};
2071 if ($key =~ m/^unused/ && $used_volids->{$value}) {
2072 delete $conf->{$key};
2076 my $generate_raw_config = sub {
2081 # add description as comment to top of file
2082 my $descr = $conf->{description
} || '';
2083 foreach my $cl (split(/\n/, $descr)) {
2084 $raw .= '#' . PVE
::Tools
::encode_text
($cl) . "\n";
2087 foreach my $key (sort keys %$conf) {
2088 next if $key eq 'digest' || $key eq 'description' || $key eq 'pending' || $key eq 'snapshots';
2089 $raw .= "$key: $conf->{$key}\n";
2094 my $raw = &$generate_raw_config($conf);
2096 if (scalar(keys %{$conf->{pending
}})){
2097 $raw .= "\n[PENDING]\n";
2098 $raw .= &$generate_raw_config($conf->{pending
});
2101 foreach my $snapname (sort keys %{$conf->{snapshots
}}) {
2102 $raw .= "\n[$snapname]\n";
2103 $raw .= &$generate_raw_config($conf->{snapshots
}->{$snapname});
2109 sub update_config_nolock
{
2110 my ($vmid, $conf, $skiplock) = @_;
2112 check_lock
($conf) if !$skiplock;
2114 my $cfspath = cfs_config_path
($vmid);
2116 PVE
::Cluster
::cfs_write_file
($cfspath, $conf);
2120 my ($vmid, $conf, $skiplock) = @_;
2122 lock_config
($vmid, &update_config_nolock
, $conf, $skiplock);
2129 # we use static defaults from our JSON schema configuration
2130 foreach my $key (keys %$confdesc) {
2131 if (defined(my $default = $confdesc->{$key}->{default})) {
2132 $res->{$key} = $default;
2136 my $conf = PVE
::Cluster
::cfs_read_file
('datacenter.cfg');
2137 $res->{keyboard
} = $conf->{keyboard
} if $conf->{keyboard
};
2143 my $vmlist = PVE
::Cluster
::get_vmlist
();
2145 return $res if !$vmlist || !$vmlist->{ids
};
2146 my $ids = $vmlist->{ids
};
2148 foreach my $vmid (keys %$ids) {
2149 my $d = $ids->{$vmid};
2150 next if !$d->{node
} || $d->{node
} ne $nodename;
2151 next if !$d->{type
} || $d->{type
} ne 'qemu';
2152 $res->{$vmid}->{exists} = 1;
2157 # test if VM uses local resources (to prevent migration)
2158 sub check_local_resources
{
2159 my ($conf, $noerr) = @_;
2163 $loc_res = 1 if $conf->{hostusb
}; # old syntax
2164 $loc_res = 1 if $conf->{hostpci
}; # old syntax
2166 foreach my $k (keys %$conf) {
2167 next if $k =~ m/^usb/ && ($conf->{$k} eq 'spice');
2168 $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/;
2171 die "VM uses local resources\n" if $loc_res && !$noerr;
2176 # check if used storages are available on all nodes (use by migrate)
2177 sub check_storage_availability
{
2178 my ($storecfg, $conf, $node) = @_;
2180 foreach_drive
($conf, sub {
2181 my ($ds, $drive) = @_;
2183 my $volid = $drive->{file
};
2186 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
2189 # check if storage is available on both nodes
2190 my $scfg = PVE
::Storage
::storage_check_node
($storecfg, $sid);
2191 PVE
::Storage
::storage_check_node
($storecfg, $sid, $node);
2195 # list nodes where all VM images are available (used by has_feature API)
2197 my ($conf, $storecfg) = @_;
2199 my $nodelist = PVE
::Cluster
::get_nodelist
();
2200 my $nodehash = { map { $_ => 1 } @$nodelist };
2201 my $nodename = PVE
::INotify
::nodename
();
2203 foreach_drive
($conf, sub {
2204 my ($ds, $drive) = @_;
2206 my $volid = $drive->{file
};
2209 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
2211 my $scfg = PVE
::Storage
::storage_config
($storecfg, $storeid);
2212 if ($scfg->{disable
}) {
2214 } elsif (my $avail = $scfg->{nodes
}) {
2215 foreach my $node (keys %$nodehash) {
2216 delete $nodehash->{$node} if !$avail->{$node};
2218 } elsif (!$scfg->{shared
}) {
2219 foreach my $node (keys %$nodehash) {
2220 delete $nodehash->{$node} if $node ne $nodename
2232 die "VM is locked ($conf->{lock})\n" if $conf->{lock};
2236 my ($pidfile, $pid) = @_;
2238 my $fh = IO
::File-
>new("/proc/$pid/cmdline", "r");
2242 return undef if !$line;
2243 my @param = split(/\0/, $line);
2245 my $cmd = $param[0];
2246 return if !$cmd || ($cmd !~ m
|kvm
$| && $cmd !~ m
|qemu-system-x86_64
$|);
2248 for (my $i = 0; $i < scalar (@param); $i++) {
2251 if (($p eq '-pidfile') || ($p eq '--pidfile')) {
2252 my $p = $param[$i+1];
2253 return 1 if $p && ($p eq $pidfile);
2262 my ($vmid, $nocheck, $node) = @_;
2264 my $filename = config_file
($vmid, $node);
2266 die "unable to find configuration file for VM $vmid - no such machine\n"
2267 if !$nocheck && ! -f
$filename;
2269 my $pidfile = pidfile_name
($vmid);
2271 if (my $fd = IO
::File-
>new("<$pidfile")) {
2276 my $mtime = $st->mtime;
2277 if ($mtime > time()) {
2278 warn "file '$filename' modified in future\n";
2281 if ($line =~ m/^(\d+)$/) {
2283 if (check_cmdline
($pidfile, $pid)) {
2284 if (my $pinfo = PVE
::ProcFSTools
::check_process_running
($pid)) {
2296 my $vzlist = config_list
();
2298 my $fd = IO
::Dir-
>new($var_run_tmpdir) || return $vzlist;
2300 while (defined(my $de = $fd->read)) {
2301 next if $de !~ m/^(\d+)\.pid$/;
2303 next if !defined($vzlist->{$vmid});
2304 if (my $pid = check_running
($vmid)) {
2305 $vzlist->{$vmid}->{pid
} = $pid;
2313 my ($storecfg, $conf) = @_;
2315 my $bootdisk = $conf->{bootdisk
};
2316 return undef if !$bootdisk;
2317 return undef if !valid_drivename
($bootdisk);
2319 return undef if !$conf->{$bootdisk};
2321 my $drive = parse_drive
($bootdisk, $conf->{$bootdisk});
2322 return undef if !defined($drive);
2324 return undef if drive_is_cdrom
($drive);
2326 my $volid = $drive->{file
};
2327 return undef if !$volid;
2329 return $drive->{size
};
2332 my $last_proc_pid_stat;
2334 # get VM status information
2335 # This must be fast and should not block ($full == false)
2336 # We only query KVM using QMP if $full == true (this can be slow)
2338 my ($opt_vmid, $full) = @_;
2342 my $storecfg = PVE
::Storage
::config
();
2344 my $list = vzlist
();
2345 my ($uptime) = PVE
::ProcFSTools
::read_proc_uptime
(1);
2347 my $cpucount = $cpuinfo->{cpus
} || 1;
2349 foreach my $vmid (keys %$list) {
2350 next if $opt_vmid && ($vmid ne $opt_vmid);
2352 my $cfspath = cfs_config_path
($vmid);
2353 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath) || {};
2356 $d->{pid
} = $list->{$vmid}->{pid
};
2358 # fixme: better status?
2359 $d->{status
} = $list->{$vmid}->{pid
} ?
'running' : 'stopped';
2361 my $size = disksize
($storecfg, $conf);
2362 if (defined($size)) {
2363 $d->{disk
} = 0; # no info available
2364 $d->{maxdisk
} = $size;
2370 $d->{cpus
} = ($conf->{sockets
} || 1) * ($conf->{cores
} || 1);
2371 $d->{cpus
} = $cpucount if $d->{cpus
} > $cpucount;
2373 $d->{name
} = $conf->{name
} || "VM $vmid";
2374 $d->{maxmem
} = $conf->{memory
} ?
$conf->{memory
}*(1024*1024) : 0;
2376 if ($conf->{balloon
}) {
2377 $d->{balloon_min
} = $conf->{balloon
}*(1024*1024);
2378 $d->{shares
} = defined($conf->{shares
}) ?
$conf->{shares
} : 1000;
2389 $d->{diskwrite
} = 0;
2391 $d->{template
} = is_template
($conf);
2396 my $netdev = PVE
::ProcFSTools
::read_proc_net_dev
();
2397 foreach my $dev (keys %$netdev) {
2398 next if $dev !~ m/^tap([1-9]\d*)i/;
2400 my $d = $res->{$vmid};
2403 $d->{netout
} += $netdev->{$dev}->{receive
};
2404 $d->{netin
} += $netdev->{$dev}->{transmit
};
2407 my $ctime = gettimeofday
;
2409 foreach my $vmid (keys %$list) {
2411 my $d = $res->{$vmid};
2412 my $pid = $d->{pid
};
2415 my $pstat = PVE
::ProcFSTools
::read_proc_pid_stat
($pid);
2416 next if !$pstat; # not running
2418 my $used = $pstat->{utime} + $pstat->{stime
};
2420 $d->{uptime
} = int(($uptime - $pstat->{starttime
})/$cpuinfo->{user_hz
});
2422 if ($pstat->{vsize
}) {
2423 $d->{mem
} = int(($pstat->{rss
}/$pstat->{vsize
})*$d->{maxmem
});
2426 my $old = $last_proc_pid_stat->{$pid};
2428 $last_proc_pid_stat->{$pid} = {
2436 my $dtime = ($ctime - $old->{time}) * $cpucount * $cpuinfo->{user_hz
};
2438 if ($dtime > 1000) {
2439 my $dutime = $used - $old->{used
};
2441 $d->{cpu
} = (($dutime/$dtime)* $cpucount) / $d->{cpus
};
2442 $last_proc_pid_stat->{$pid} = {
2448 $d->{cpu
} = $old->{cpu
};
2452 return $res if !$full;
2454 my $qmpclient = PVE
::QMPClient-
>new();
2456 my $ballooncb = sub {
2457 my ($vmid, $resp) = @_;
2459 my $info = $resp->{'return'};
2460 return if !$info->{max_mem
};
2462 my $d = $res->{$vmid};
2464 # use memory assigned to VM
2465 $d->{maxmem
} = $info->{max_mem
};
2466 $d->{balloon
} = $info->{actual
};
2468 if (defined($info->{total_mem
}) && defined($info->{free_mem
})) {
2469 $d->{mem
} = $info->{total_mem
} - $info->{free_mem
};
2470 $d->{freemem
} = $info->{free_mem
};
2475 my $blockstatscb = sub {
2476 my ($vmid, $resp) = @_;
2477 my $data = $resp->{'return'} || [];
2478 my $totalrdbytes = 0;
2479 my $totalwrbytes = 0;
2480 for my $blockstat (@$data) {
2481 $totalrdbytes = $totalrdbytes + $blockstat->{stats
}->{rd_bytes
};
2482 $totalwrbytes = $totalwrbytes + $blockstat->{stats
}->{wr_bytes
};
2484 $res->{$vmid}->{diskread
} = $totalrdbytes;
2485 $res->{$vmid}->{diskwrite
} = $totalwrbytes;
2488 my $statuscb = sub {
2489 my ($vmid, $resp) = @_;
2491 $qmpclient->queue_cmd($vmid, $blockstatscb, 'query-blockstats');
2492 # this fails if ballon driver is not loaded, so this must be
2493 # the last commnand (following command are aborted if this fails).
2494 $qmpclient->queue_cmd($vmid, $ballooncb, 'query-balloon');
2496 my $status = 'unknown';
2497 if (!defined($status = $resp->{'return'}->{status
})) {
2498 warn "unable to get VM status\n";
2502 $res->{$vmid}->{qmpstatus
} = $resp->{'return'}->{status
};
2505 foreach my $vmid (keys %$list) {
2506 next if $opt_vmid && ($vmid ne $opt_vmid);
2507 next if !$res->{$vmid}->{pid
}; # not running
2508 $qmpclient->queue_cmd($vmid, $statuscb, 'query-status');
2511 $qmpclient->queue_execute(undef, 1);
2513 foreach my $vmid (keys %$list) {
2514 next if $opt_vmid && ($vmid ne $opt_vmid);
2515 $res->{$vmid}->{qmpstatus
} = $res->{$vmid}->{status
} if !$res->{$vmid}->{qmpstatus
};
2522 my ($conf, $func) = @_;
2524 foreach my $ds (keys %$conf) {
2525 next if !valid_drivename
($ds);
2527 my $drive = parse_drive
($ds, $conf->{$ds});
2530 &$func($ds, $drive);
2535 my ($conf, $func) = @_;
2539 my $test_volid = sub {
2540 my ($volid, $is_cdrom) = @_;
2544 $volhash->{$volid} = $is_cdrom || 0;
2547 foreach_drive
($conf, sub {
2548 my ($ds, $drive) = @_;
2549 &$test_volid($drive->{file
}, drive_is_cdrom
($drive));
2552 foreach my $snapname (keys %{$conf->{snapshots
}}) {
2553 my $snap = $conf->{snapshots
}->{$snapname};
2554 &$test_volid($snap->{vmstate
}, 0);
2555 foreach_drive
($snap, sub {
2556 my ($ds, $drive) = @_;
2557 &$test_volid($drive->{file
}, drive_is_cdrom
($drive));
2561 foreach my $volid (keys %$volhash) {
2562 &$func($volid, $volhash->{$volid});
2566 sub vga_conf_has_spice
{
2569 return 0 if !$vga || $vga !~ m/^qxl([234])?$/;
2574 sub config_to_command
{
2575 my ($storecfg, $vmid, $conf, $defaults, $forcemachine) = @_;
2578 my $globalFlags = [];
2579 my $machineFlags = [];
2585 my $kvmver = kvm_user_version
();
2586 my $vernum = 0; # unknown
2587 if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
2588 $vernum = $1*1000000+$2*1000;
2589 } elsif ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
2590 $vernum = $1*1000000+$2*1000+$3;
2593 die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 15000;
2595 my $have_ovz = -f
'/proc/vz/vestat';
2597 my $q35 = machine_type_is_q35
($conf);
2599 push @$cmd, '/usr/bin/kvm';
2601 push @$cmd, '-id', $vmid;
2605 my $qmpsocket = qmp_socket
($vmid);
2606 push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
2607 push @$cmd, '-mon', "chardev=qmp,mode=control";
2609 my $socket = vnc_socket
($vmid);
2610 push @$cmd, '-vnc', "unix:$socket,x509,password";
2612 push @$cmd, '-pidfile' , pidfile_name
($vmid);
2614 push @$cmd, '-daemonize';
2616 if ($conf->{smbios1
}) {
2617 push @$cmd, '-smbios', "type=1,$conf->{smbios1}";
2620 push @$cmd, '-object', "iothread,id=iothread0" if $conf->{iothread
};
2623 # the q35 chipset support native usb2, so we enable usb controller
2624 # by default for this machine type
2625 push @$devices, '-readconfig', '/usr/share/qemu-server/pve-q35.cfg';
2627 $pciaddr = print_pci_addr
("piix3", $bridges);
2628 push @$devices, '-device', "piix3-usb-uhci,id=uhci$pciaddr.0x2";
2631 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2632 next if !$conf->{"usb$i"};
2635 # include usb device config
2636 push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
2639 my $vga = $conf->{vga
};
2641 my $qxlnum = vga_conf_has_spice
($vga);
2642 $vga = 'qxl' if $qxlnum;
2645 if ($conf->{ostype
} && ($conf->{ostype
} eq 'win8' ||
2646 $conf->{ostype
} eq 'win7' ||
2647 $conf->{ostype
} eq 'w2k8')) {
2654 # enable absolute mouse coordinates (needed by vnc)
2656 if (defined($conf->{tablet
})) {
2657 $tablet = $conf->{tablet
};
2659 $tablet = $defaults->{tablet
};
2660 $tablet = 0 if $qxlnum; # disable for spice because it is not needed
2661 $tablet = 0 if $vga =~ m/^serial\d+$/; # disable if we use serial terminal (no vga card)
2664 push @$devices, '-device', print_tabletdevice_full
($conf) if $tablet;
2667 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
2668 my $d = parse_hostpci
($conf->{"hostpci$i"});
2671 my $pcie = $d->{pcie
};
2673 die "q35 machine model is not enabled" if !$q35;
2674 $pciaddr = print_pcie_addr
("hostpci$i");
2676 $pciaddr = print_pci_addr
("hostpci$i", $bridges);
2679 my $rombar = $d->{rombar
} && $d->{rombar
} eq 'off' ?
",rombar=0" : "";
2680 my $driver = $d->{driver
} && $d->{driver
} eq 'vfio' ?
"vfio-pci" : "pci-assign";
2681 my $xvga = $d->{'x-vga'} && $d->{'x-vga'} eq 'on' ?
",x-vga=on" : "";
2682 if ($xvga && $xvga ne '') {
2683 push @$cpuFlags, 'kvm=off';
2686 $driver = "vfio-pci" if $xvga ne '';
2687 my $pcidevices = $d->{pciid
};
2688 my $multifunction = 1 if @$pcidevices > 1;
2691 foreach my $pcidevice (@$pcidevices) {
2693 my $id = "hostpci$i";
2694 $id .= ".$j" if $multifunction;
2695 my $addr = $pciaddr;
2696 $addr .= ".$j" if $multifunction;
2697 my $devicestr = "$driver,host=$pcidevice->{id}.$pcidevice->{function},id=$id$addr";
2700 $devicestr .= "$rombar$xvga";
2701 $devicestr .= ",multifunction=on" if $multifunction;
2704 push @$devices, '-device', $devicestr;
2710 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2711 my $d = parse_usb_device
($conf->{"usb$i"});
2713 if ($d->{vendorid
} && $d->{productid
}) {
2714 push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2715 } elsif (defined($d->{hostbus
}) && defined($d->{hostport
})) {
2716 push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2717 } elsif ($d->{spice
}) {
2718 # usb redir support for spice
2719 push @$devices, '-chardev', "spicevmc,id=usbredirchardev$i,name=usbredir";
2720 push @$devices, '-device', "usb-redir,chardev=usbredirchardev$i,id=usbredirdev$i,bus=ehci.0";
2725 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
2726 if (my $path = $conf->{"serial$i"}) {
2727 if ($path eq 'socket') {
2728 my $socket = "/var/run/qemu-server/${vmid}.serial$i";
2729 push @$devices, '-chardev', "socket,id=serial$i,path=$socket,server,nowait";
2730 push @$devices, '-device', "isa-serial,chardev=serial$i";
2732 die "no such serial device\n" if ! -c
$path;
2733 push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2734 push @$devices, '-device', "isa-serial,chardev=serial$i";
2740 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
2741 if (my $path = $conf->{"parallel$i"}) {
2742 die "no such parallel device\n" if ! -c
$path;
2743 my $devtype = $path =~ m!^/dev/usb/lp! ?
'tty' : 'parport';
2744 push @$devices, '-chardev', "$devtype,id=parallel$i,path=$path";
2745 push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2749 my $vmname = $conf->{name
} || "vm$vmid";
2751 push @$cmd, '-name', $vmname;
2754 $sockets = $conf->{smp
} if $conf->{smp
}; # old style - no longer iused
2755 $sockets = $conf->{sockets
} if $conf->{sockets
};
2757 my $cores = $conf->{cores
} || 1;
2758 my $maxcpus = $conf->{maxcpus
} if $conf->{maxcpus
};
2760 my $total_cores = $sockets * $cores;
2761 my $allowed_cores = $cpuinfo->{cpus
};
2763 die "MAX $allowed_cores cores allowed per VM on this node\n"
2764 if ($allowed_cores < $total_cores);
2767 push @$cmd, '-smp', "cpus=$cores,maxcpus=$maxcpus";
2769 push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2772 push @$cmd, '-nodefaults';
2774 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
2776 my $bootindex_hash = {};
2778 foreach my $o (split(//, $bootorder)) {
2779 $bootindex_hash->{$o} = $i*100;
2783 push @$cmd, '-boot', "menu=on";
2785 push @$cmd, '-no-acpi' if defined($conf->{acpi
}) && $conf->{acpi
} == 0;
2787 push @$cmd, '-no-reboot' if defined($conf->{reboot
}) && $conf->{reboot
} == 0;
2789 push @$cmd, '-vga', $vga if $vga && $vga !~ m/^serial\d+$/; # for kvm 77 and later
2792 my $tdf = defined($conf->{tdf
}) ?
$conf->{tdf
} : $defaults->{tdf
};
2794 my $nokvm = defined($conf->{kvm
}) && $conf->{kvm
} == 0 ?
1 : 0;
2795 my $useLocaltime = $conf->{localtime};
2797 if (my $ost = $conf->{ostype
}) {
2798 # other, wxp, w2k, w2k3, w2k8, wvista, win7, win8, l24, l26, solaris
2800 if ($ost =~ m/^w/) { # windows
2801 $useLocaltime = 1 if !defined($conf->{localtime});
2803 # use time drift fix when acpi is enabled
2804 if (!(defined($conf->{acpi
}) && $conf->{acpi
} == 0)) {
2805 $tdf = 1 if !defined($conf->{tdf
});
2809 if ($ost eq 'win7' || $ost eq 'win8' || $ost eq 'w2k8' ||
2811 push @$globalFlags, 'kvm-pit.lost_tick_policy=discard';
2812 push @$cmd, '-no-hpet';
2813 #push @$cpuFlags , 'hv_vapic" if !$nokvm; #fixme, my win2008R2 hang at boot with this
2814 push @$cpuFlags , 'hv_spinlocks=0xffff' if !$nokvm;
2817 if ($ost eq 'win7' || $ost eq 'win8') {
2818 push @$cpuFlags , 'hv_relaxed' if !$nokvm;
2822 push @$rtcFlags, 'driftfix=slew' if $tdf;
2825 push @$machineFlags, 'accel=tcg';
2827 die "No accelerator found!\n" if !$cpuinfo->{hvm
};
2830 my $machine_type = $forcemachine || $conf->{machine
};
2831 if ($machine_type) {
2832 push @$machineFlags, "type=${machine_type}";
2835 if ($conf->{startdate
}) {
2836 push @$rtcFlags, "base=$conf->{startdate}";
2837 } elsif ($useLocaltime) {
2838 push @$rtcFlags, 'base=localtime';
2841 my $cpu = $nokvm ?
"qemu64" : "kvm64";
2842 $cpu = $conf->{cpu
} if $conf->{cpu
};
2844 push @$cpuFlags , '+lahf_lm' if $cpu eq 'kvm64';
2846 push @$cpuFlags , '+x2apic' if !$nokvm && $conf->{ostype
} ne 'solaris';
2848 push @$cpuFlags , '-x2apic' if $conf->{ostype
} eq 'solaris';
2850 push @$cpuFlags, '+sep' if $cpu eq 'kvm64' || $cpu eq 'kvm32';
2852 $cpu .= "," . join(',', @$cpuFlags) if scalar(@$cpuFlags);
2854 # Note: enforce needs kernel 3.10, so we do not use it for now
2855 # push @$cmd, '-cpu', "$cpu,enforce";
2856 push @$cmd, '-cpu', $cpu;
2858 my $memory = $conf->{memory
} || $defaults->{memory
};
2859 push @$cmd, '-m', $memory;
2861 if ($conf->{numa
}) {
2863 my $numa_totalmemory = undef;
2864 for (my $i = 0; $i < $MAX_NUMA; $i++) {
2865 next if !$conf->{"numa$i"};
2866 my $numa = parse_numa
($conf->{"numa$i"});
2869 die "missing numa node$i memory value\n" if !$numa->{memory
};
2870 my $numa_memory = $numa->{memory
};
2871 $numa_totalmemory += $numa_memory;
2872 my $numa_object = "memory-backend-ram,id=ram-node$i,size=$numa_memory"."M";
2875 my $cpus_start = $numa->{cpus
}->{start
};
2876 die "missing numa node$i cpus\n" if !defined($cpus_start);
2877 my $cpus_end = $numa->{cpus
}->{end
} if defined($numa->{cpus
}->{end
});
2878 my $cpus = $cpus_start;
2879 if (defined($cpus_end)) {
2880 $cpus .= "-$cpus_end";
2881 die "numa node$i : cpu range $cpus is incorrect\n" if $cpus_end <= $cpus_start;
2885 my $hostnodes_start = $numa->{hostnodes
}->{start
};
2886 if (defined($hostnodes_start)) {
2887 my $hostnodes_end = $numa->{hostnodes
}->{end
} if defined($numa->{hostnodes
}->{end
});
2888 my $hostnodes = $hostnodes_start;
2889 if (defined($hostnodes_end)) {
2890 $hostnodes .= "-$hostnodes_end";
2891 die "host node $hostnodes range is incorrect\n" if $hostnodes_end <= $hostnodes_start;
2894 my $hostnodes_end_range = defined($hostnodes_end) ?
$hostnodes_end : $hostnodes_start;
2895 for (my $i = $hostnodes_start; $i <= $hostnodes_end_range; $i++ ) {
2896 die "host numa node$i don't exist\n" if ! -d
"/sys/devices/system/node/node$i/";
2900 my $policy = $numa->{policy
};
2901 die "you need to define a policy for hostnode $hostnodes\n" if !$policy;
2902 $numa_object .= ",host-nodes=$hostnodes,policy=$policy";
2905 push @$cmd, '-object', $numa_object;
2906 push @$cmd, '-numa', "node,nodeid=$i,cpus=$cpus,memdev=ram-node$i";
2909 die "total memory for NUMA nodes must be equal to vm memory\n"
2910 if $numa_totalmemory && $numa_totalmemory != $memory;
2912 #if no custom tology, we split memory and cores across numa nodes
2913 if(!$numa_totalmemory) {
2915 my $numa_memory = ($memory / $sockets) . "M";
2917 for (my $i = 0; $i < $sockets; $i++) {
2919 my $cpustart = ($cores * $i);
2920 my $cpuend = ($cpustart + $cores - 1) if $cores && $cores > 1;
2921 my $cpus = $cpustart;
2922 $cpus .= "-$cpuend" if $cpuend;
2924 push @$cmd, '-object', "memory-backend-ram,size=$numa_memory,id=ram-node$i";
2925 push @$cmd, '-numa', "node,nodeid=$i,cpus=$cpus,memdev=ram-node$i";
2930 push @$cmd, '-S' if $conf->{freeze
};
2932 # set keyboard layout
2933 my $kb = $conf->{keyboard
} || $defaults->{keyboard
};
2934 push @$cmd, '-k', $kb if $kb;
2937 #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2938 #push @$cmd, '-soundhw', 'es1370';
2939 #push @$cmd, '-soundhw', $soundhw if $soundhw;
2941 if($conf->{agent
}) {
2942 my $qgasocket = qmp_socket
($vmid, 1);
2943 my $pciaddr = print_pci_addr
("qga0", $bridges);
2944 push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
2945 push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
2946 push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
2953 if ($conf->{ostype
} && $conf->{ostype
} =~ m/^w/){
2954 for(my $i = 1; $i < $qxlnum; $i++){
2955 my $pciaddr = print_pci_addr
("vga$i", $bridges);
2956 push @$cmd, '-device', "qxl,id=vga$i,ram_size=67108864,vram_size=33554432$pciaddr";
2959 # assume other OS works like Linux
2960 push @$cmd, '-global', 'qxl-vga.ram_size=134217728';
2961 push @$cmd, '-global', 'qxl-vga.vram_size=67108864';
2965 my $pciaddr = print_pci_addr
("spice", $bridges);
2967 $spice_port = PVE
::Tools
::next_spice_port
();
2969 push @$devices, '-spice', "tls-port=${spice_port},addr=127.0.0.1,tls-ciphers=DES-CBC3-SHA,seamless-migration=on";
2971 push @$devices, '-device', "virtio-serial,id=spice$pciaddr";
2972 push @$devices, '-chardev', "spicevmc,id=vdagent,name=vdagent";
2973 push @$devices, '-device', "virtserialport,chardev=vdagent,name=com.redhat.spice.0";
2976 # enable balloon by default, unless explicitly disabled
2977 if (!defined($conf->{balloon
}) || $conf->{balloon
}) {
2978 $pciaddr = print_pci_addr
("balloon0", $bridges);
2979 push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr";
2982 if ($conf->{watchdog
}) {
2983 my $wdopts = parse_watchdog
($conf->{watchdog
});
2984 $pciaddr = print_pci_addr
("watchdog", $bridges);
2985 my $watchdog = $wdopts->{model
} || 'i6300esb';
2986 push @$devices, '-device', "$watchdog$pciaddr";
2987 push @$devices, '-watchdog-action', $wdopts->{action
} if $wdopts->{action
};
2991 my $scsicontroller = {};
2992 my $ahcicontroller = {};
2993 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : $defaults->{scsihw
};
2995 # Add iscsi initiator name if available
2996 if (my $initiator = get_initiator_name
()) {
2997 push @$devices, '-iscsi', "initiator-name=$initiator";
3000 foreach_drive
($conf, sub {
3001 my ($ds, $drive) = @_;
3003 if (PVE
::Storage
::parse_volume_id
($drive->{file
}, 1)) {
3004 push @$vollist, $drive->{file
};
3007 $use_virtio = 1 if $ds =~ m/^virtio/;
3009 if (drive_is_cdrom
($drive)) {
3010 if ($bootindex_hash->{d
}) {
3011 $drive->{bootindex
} = $bootindex_hash->{d
};
3012 $bootindex_hash->{d
} += 1;
3015 if ($bootindex_hash->{c
}) {
3016 $drive->{bootindex
} = $bootindex_hash->{c
} if $conf->{bootdisk
} && ($conf->{bootdisk
} eq $ds);
3017 $bootindex_hash->{c
} += 1;
3021 if ($drive->{interface
} eq 'scsi') {
3023 my $maxdev = ($scsihw !~ m/^lsi/) ?
256 : 7;
3024 my $controller = int($drive->{index} / $maxdev);
3025 $pciaddr = print_pci_addr
("scsihw$controller", $bridges);
3026 push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
3027 $scsicontroller->{$controller}=1;
3030 if ($drive->{interface
} eq 'sata') {
3031 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
3032 $pciaddr = print_pci_addr
("ahci$controller", $bridges);
3033 push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
3034 $ahcicontroller->{$controller}=1;
3037 my $drive_cmd = print_drive_full
($storecfg, $vmid, $drive);
3038 push @$devices, '-drive',$drive_cmd;
3039 push @$devices, '-device', print_drivedevice_full
($storecfg, $conf, $vmid, $drive, $bridges);
3042 for (my $i = 0; $i < $MAX_NETS; $i++) {
3043 next if !$conf->{"net$i"};
3044 my $d = parse_net
($conf->{"net$i"});
3047 $use_virtio = 1 if $d->{model
} eq 'virtio';
3049 if ($bootindex_hash->{n
}) {
3050 $d->{bootindex
} = $bootindex_hash->{n
};
3051 $bootindex_hash->{n
} += 1;
3054 my $netdevfull = print_netdev_full
($vmid,$conf,$d,"net$i");
3055 push @$devices, '-netdev', $netdevfull;
3057 my $netdevicefull = print_netdevice_full
($vmid,$conf,$d,"net$i",$bridges);
3058 push @$devices, '-device', $netdevicefull;
3063 while (my ($k, $v) = each %$bridges) {
3064 $pciaddr = print_pci_addr
("pci.$k");
3065 unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
3069 # hack: virtio with fairsched is unreliable, so we do not use fairsched
3070 # when the VM uses virtio devices.
3071 if (!$use_virtio && $have_ovz) {
3073 my $cpuunits = defined($conf->{cpuunits
}) ?
3074 $conf->{cpuunits
} : $defaults->{cpuunits
};
3076 push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
3078 # fixme: cpulimit is currently ignored
3079 #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
3083 if ($conf->{args
}) {
3084 my $aa = PVE
::Tools
::split_args
($conf->{args
});
3088 push @$cmd, @$devices;
3089 push @$cmd, '-rtc', join(',', @$rtcFlags)
3090 if scalar(@$rtcFlags);
3091 push @$cmd, '-machine', join(',', @$machineFlags)
3092 if scalar(@$machineFlags);
3093 push @$cmd, '-global', join(',', @$globalFlags)
3094 if scalar(@$globalFlags);
3096 return wantarray ?
($cmd, $vollist, $spice_port) : $cmd;
3101 return "${var_run_tmpdir}/$vmid.vnc";
3107 my $res = vm_mon_cmd
($vmid, 'query-spice');
3109 return $res->{'tls-port'} || $res->{'port'} || die "no spice port\n";
3113 my ($vmid, $qga) = @_;
3114 my $sockettype = $qga ?
'qga' : 'qmp';
3115 return "${var_run_tmpdir}/$vmid.$sockettype";
3120 return "${var_run_tmpdir}/$vmid.pid";
3123 sub vm_devices_list
{
3126 my $res = vm_mon_cmd
($vmid, 'query-pci');
3128 foreach my $pcibus (@$res) {
3129 foreach my $device (@{$pcibus->{devices
}}) {
3130 next if !$device->{'qdev_id'};
3131 $devices->{$device->{'qdev_id'}} = 1;
3135 my $resblock = vm_mon_cmd
($vmid, 'query-block');
3136 foreach my $block (@$resblock) {
3137 if($block->{device
} =~ m/^drive-(\S+)/){
3142 my $resmice = vm_mon_cmd
($vmid, 'query-mice');
3143 foreach my $mice (@$resmice) {
3144 if ($mice->{name
} eq 'QEMU HID Tablet') {
3145 $devices->{tablet
} = 1;
3154 my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
3156 die "internal error" if !$conf->{hotplug
};
3158 my $q35 = machine_type_is_q35
($conf);
3160 my $devices_list = vm_devices_list
($vmid);
3161 return 1 if defined($devices_list->{$deviceid});
3163 qemu_add_pci_bridge
($storecfg, $conf, $vmid, $deviceid); # add PCI bridge if we need it for the device
3165 if ($deviceid eq 'tablet') {
3167 qemu_deviceadd
($vmid, print_tabletdevice_full
($conf));
3169 } elsif ($deviceid =~ m/^(virtio)(\d+)$/) {
3171 qemu_driveadd
($storecfg, $vmid, $device);
3172 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
3174 qemu_deviceadd
($vmid, $devicefull);
3175 eval { qemu_deviceaddverify
($vmid, $deviceid); };
3177 eval { qemu_drivedel
($vmid, $deviceid); };
3182 } elsif ($deviceid =~ m/^(scsihw)(\d+)$/) {
3184 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : "lsi";
3185 my $pciaddr = print_pci_addr
($deviceid);
3186 my $devicefull = "$scsihw,id=$deviceid$pciaddr";
3188 qemu_deviceadd
($vmid, $devicefull);
3189 qemu_deviceaddverify
($vmid, $deviceid);
3191 } elsif ($deviceid =~ m/^(scsi)(\d+)$/) {
3193 qemu_findorcreatescsihw
($storecfg,$conf, $vmid, $device);
3194 qemu_driveadd
($storecfg, $vmid, $device);
3196 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
3197 eval { qemu_deviceadd
($vmid, $devicefull); };
3199 eval { qemu_drivedel
($vmid, $deviceid); };
3204 } elsif ($deviceid =~ m/^(net)(\d+)$/) {
3206 return undef if !qemu_netdevadd
($vmid, $conf, $device, $deviceid);
3207 my $netdevicefull = print_netdevice_full
($vmid, $conf, $device, $deviceid);
3208 qemu_deviceadd
($vmid, $netdevicefull);
3209 eval { qemu_deviceaddverify
($vmid, $deviceid); };
3211 eval { qemu_netdevdel
($vmid, $deviceid); };
3216 } elsif (!$q35 && $deviceid =~ m/^(pci\.)(\d+)$/) {
3219 my $pciaddr = print_pci_addr
($deviceid);
3220 my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
3222 qemu_deviceadd
($vmid, $devicefull);
3223 qemu_deviceaddverify
($vmid, $deviceid);
3226 die "can't hotplug device '$deviceid'\n";
3232 # fixme: this should raise exceptions on error!
3233 sub vm_deviceunplug
{
3234 my ($vmid, $conf, $deviceid) = @_;
3236 die "internal error" if !$conf->{hotplug
};
3238 my $devices_list = vm_devices_list
($vmid);
3239 return 1 if !defined($devices_list->{$deviceid});
3241 die "can't unplug bootdisk" if $conf->{bootdisk
} && $conf->{bootdisk
} eq $deviceid;
3243 if ($deviceid eq 'tablet') {
3245 qemu_devicedel
($vmid, $deviceid);
3247 } elsif ($deviceid =~ m/^(virtio)(\d+)$/) {
3249 qemu_devicedel
($vmid, $deviceid);
3250 qemu_devicedelverify
($vmid, $deviceid);
3251 qemu_drivedel
($vmid, $deviceid);
3253 } elsif ($deviceid =~ m/^(lsi)(\d+)$/) {
3255 qemu_devicedel
($vmid, $deviceid);
3257 } elsif ($deviceid =~ m/^(scsi)(\d+)$/) {
3259 qemu_devicedel
($vmid, $deviceid);
3260 qemu_drivedel
($vmid, $deviceid);
3262 } elsif ($deviceid =~ m/^(net)(\d+)$/) {
3264 qemu_devicedel
($vmid, $deviceid);
3265 qemu_devicedelverify
($vmid, $deviceid);
3266 qemu_netdevdel
($vmid, $deviceid);
3269 die "can't unplug device '$deviceid'\n";
3275 sub qemu_deviceadd
{
3276 my ($vmid, $devicefull) = @_;
3278 $devicefull = "driver=".$devicefull;
3279 my %options = split(/[=,]/, $devicefull);
3281 vm_mon_cmd
($vmid, "device_add" , %options);
3284 sub qemu_devicedel
{
3285 my ($vmid, $deviceid) = @_;
3287 my $ret = vm_mon_cmd
($vmid, "device_del", id
=> $deviceid);
3291 my ($storecfg, $vmid, $device) = @_;
3293 my $drive = print_drive_full
($storecfg, $vmid, $device);
3294 my $ret = vm_human_monitor_command
($vmid, "drive_add auto $drive");
3296 # If the command succeeds qemu prints: "OK"
3297 return 1 if $ret =~ m/OK/s;
3299 die "adding drive failed: $ret\n";
3303 my($vmid, $deviceid) = @_;
3305 my $ret = vm_human_monitor_command
($vmid, "drive_del drive-$deviceid");
3308 return 1 if $ret eq "";
3310 # NB: device not found errors mean the drive was auto-deleted and we ignore the error
3311 return 1 if $ret =~ m/Device \'.*?\' not found/s;
3313 die "deleting drive $deviceid failed : $ret\n";
3316 sub qemu_deviceaddverify
{
3317 my ($vmid, $deviceid) = @_;
3319 for (my $i = 0; $i <= 5; $i++) {
3320 my $devices_list = vm_devices_list
($vmid);
3321 return 1 if defined($devices_list->{$deviceid});
3325 die "error on hotplug device '$deviceid'\n";
3329 sub qemu_devicedelverify
{
3330 my ($vmid, $deviceid) = @_;
3332 # need to verify that the device is correctly removed as device_del
3333 # is async and empty return is not reliable
3335 for (my $i = 0; $i <= 5; $i++) {
3336 my $devices_list = vm_devices_list
($vmid);
3337 return 1 if !defined($devices_list->{$deviceid});
3341 die "error on hot-unplugging device '$deviceid'\n";
3344 sub qemu_findorcreatescsihw
{
3345 my ($storecfg, $conf, $vmid, $device) = @_;
3347 my $maxdev = ($conf->{scsihw
} && ($conf->{scsihw
} !~ m/^lsi/)) ?
256 : 7;
3348 my $controller = int($device->{index} / $maxdev);
3349 my $scsihwid="scsihw$controller";
3350 my $devices_list = vm_devices_list
($vmid);
3352 if(!defined($devices_list->{$scsihwid})) {
3353 vm_deviceplug
($storecfg, $conf, $vmid, $scsihwid);
3359 sub qemu_add_pci_bridge
{
3360 my ($storecfg, $conf, $vmid, $device) = @_;
3366 print_pci_addr
($device, $bridges);
3368 while (my ($k, $v) = each %$bridges) {
3371 return 1 if !defined($bridgeid) || $bridgeid < 1;
3373 my $bridge = "pci.$bridgeid";
3374 my $devices_list = vm_devices_list
($vmid);
3376 if (!defined($devices_list->{$bridge})) {
3377 vm_deviceplug
($storecfg, $conf, $vmid, $bridge);
3383 sub qemu_netdevadd
{
3384 my ($vmid, $conf, $device, $deviceid) = @_;
3386 my $netdev = print_netdev_full
($vmid, $conf, $device, $deviceid);
3387 my %options = split(/[=,]/, $netdev);
3389 vm_mon_cmd
($vmid, "netdev_add", %options);
3393 sub qemu_netdevdel
{
3394 my ($vmid, $deviceid) = @_;
3396 vm_mon_cmd
($vmid, "netdev_del", id
=> $deviceid);
3399 sub qemu_cpu_hotplug
{
3400 my ($vmid, $conf, $cores) = @_;
3402 my $sockets = $conf->{sockets
} || 1;
3403 die "cpu hotplug only works with one socket\n"
3406 die "maxcpus is not defined\n"
3407 if !$conf->{maxcpus
};
3409 die "you can't add more cores than maxcpus\n"
3410 if $cores > $conf->{maxcpus
};
3412 my $currentcores = $conf->{cores
} || 1;
3413 die "online cpu unplug is not yet possible\n"
3414 if $cores < $currentcores;
3416 my $currentrunningcores = vm_mon_cmd
($vmid, "query-cpus");
3417 die "cores number if running vm is different than configuration\n"
3418 if scalar(@{$currentrunningcores}) != $currentcores;
3420 for (my $i = $currentcores; $i < $cores; $i++) {
3421 vm_mon_cmd
($vmid, "cpu-add", id
=> int($i));
3425 sub qemu_block_set_io_throttle
{
3426 my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
3428 return if !check_running
($vmid) ;
3430 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));
3434 # old code, only used to shutdown old VM after update
3436 my ($fh, $timeout) = @_;
3438 my $sel = new IO
::Select
;
3445 while (scalar (@ready = $sel->can_read($timeout))) {
3447 if ($count = $fh->sysread($buf, 8192)) {
3448 if ($buf =~ /^(.*)\(qemu\) $/s) {
3455 if (!defined($count)) {
3462 die "monitor read timeout\n" if !scalar(@ready);
3467 # old code, only used to shutdown old VM after update
3468 sub vm_monitor_command
{
3469 my ($vmid, $cmdstr, $nocheck) = @_;
3474 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
3476 my $sname = "${var_run_tmpdir}/$vmid.mon";
3478 my $sock = IO
::Socket
::UNIX-
>new( Peer
=> $sname ) ||
3479 die "unable to connect to VM $vmid socket - $!\n";
3483 # hack: migrate sometime blocks the monitor (when migrate_downtime
3485 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3486 $timeout = 60*60; # 1 hour
3490 my $data = __read_avail
($sock, $timeout);
3492 if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
3493 die "got unexpected qemu monitor banner\n";
3496 my $sel = new IO
::Select
;
3499 if (!scalar(my @ready = $sel->can_write($timeout))) {
3500 die "monitor write error - timeout";
3503 my $fullcmd = "$cmdstr\r";
3505 # syslog('info', "VM $vmid monitor command: $cmdstr");
3508 if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
3509 die "monitor write error - $!";
3512 return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
3516 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3517 $timeout = 60*60; # 1 hour
3518 } elsif ($cmdstr =~ m/^(eject|change)/) {
3519 $timeout = 60; # note: cdrom mount command is slow
3521 if ($res = __read_avail
($sock, $timeout)) {
3523 my @lines = split("\r?\n", $res);
3525 shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
3527 $res = join("\n", @lines);
3535 syslog
("err", "VM $vmid monitor command failed - $err");
3542 sub qemu_block_resize
{
3543 my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
3545 my $running = check_running
($vmid);
3547 return if !PVE
::Storage
::volume_resize
($storecfg, $volid, $size, $running);
3549 return if !$running;
3551 vm_mon_cmd
($vmid, "block_resize", device
=> $deviceid, size
=> int($size));
3555 sub qemu_volume_snapshot
{
3556 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3558 my $running = check_running
($vmid);
3560 return if !PVE
::Storage
::volume_snapshot
($storecfg, $volid, $snap, $running);
3562 return if !$running;
3564 vm_mon_cmd
($vmid, "snapshot-drive", device
=> $deviceid, name
=> $snap);
3568 sub qemu_volume_snapshot_delete
{
3569 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3571 my $running = check_running
($vmid);
3573 return if !PVE
::Storage
::volume_snapshot_delete
($storecfg, $volid, $snap, $running);
3575 return if !$running;
3577 vm_mon_cmd
($vmid, "delete-drive-snapshot", device
=> $deviceid, name
=> $snap);
3580 sub set_migration_caps
{
3586 "auto-converge" => 1,
3588 "x-rdma-pin-all" => 0,
3592 my $supported_capabilities = vm_mon_cmd_nocheck
($vmid, "query-migrate-capabilities");
3594 for my $supported_capability (@$supported_capabilities) {
3596 capability
=> $supported_capability->{capability
},
3597 state => $enabled_cap->{$supported_capability->{capability
}} ? JSON
::true
: JSON
::false
,
3601 vm_mon_cmd_nocheck
($vmid, "migrate-set-capabilities", capabilities
=> $cap_ref);
3604 my $fast_plug_option = {
3612 # hotplug changes in [PENDING]
3613 # $selection hash can be used to only apply specified options, for
3614 # example: { cores => 1 } (only apply changed 'cores')
3615 # $errors ref is used to return error messages
3616 sub vmconfig_hotplug_pending
{
3617 my ($vmid, $conf, $storecfg, $selection, $errors) = @_;
3619 my $defaults = load_defaults
();
3621 # commit values which do not have any impact on running VM first
3622 # Note: those option cannot raise errors, we we do not care about
3623 # $selection and always apply them.
3625 my $add_error = sub {
3626 my ($opt, $msg) = @_;
3627 $errors->{$opt} = "hotplug problem - $msg";
3631 foreach my $opt (keys %{$conf->{pending
}}) { # add/change
3632 if ($fast_plug_option->{$opt}) {
3633 $conf->{$opt} = $conf->{pending
}->{$opt};
3634 delete $conf->{pending
}->{$opt};
3640 update_config_nolock
($vmid, $conf, 1);
3641 $conf = load_config
($vmid); # update/reload
3644 my $hotplug = defined($conf->{hotplug
}) ?
$conf->{hotplug
} : $defaults->{hotplug
};
3646 my @delete = PVE
::Tools
::split_list
($conf->{pending
}->{delete});
3647 foreach my $opt (@delete) {
3648 next if $selection && !$selection->{$opt};
3650 if ($opt eq 'tablet') {
3651 die "skip\n" if !$hotplug;
3652 if ($defaults->{tablet
}) {
3653 vm_deviceplug
($storecfg, $conf, $vmid, $opt);
3655 vm_deviceunplug
($vmid, $conf, $opt);
3657 } elsif ($opt eq 'cores') {
3658 die "skip\n" if !$hotplug;
3659 qemu_cpu_hotplug
($vmid, $conf, 1);
3660 } elsif ($opt eq 'balloon') {
3661 # enable balloon device is not hotpluggable
3662 die "skip\n" if !defined($conf->{balloon
}) || $conf->{balloon
};
3663 } elsif ($fast_plug_option->{$opt}) {
3665 } elsif ($opt =~ m/^net(\d+)$/) {
3666 die "skip\n" if !$hotplug;
3667 vm_deviceunplug
($vmid, $conf, $opt);
3668 } elsif (valid_drivename
($opt)) {
3669 die "skip\n" if !$hotplug || $opt =~ m/(ide|sata)(\d+)/;
3670 vm_deviceunplug
($vmid, $conf, $opt);
3671 vmconfig_register_unused_drive
($storecfg, $vmid, $conf, parse_drive
($opt, $conf->{$opt}));
3677 &$add_error($opt, $err) if $err ne "skip\n";
3679 # save new config if hotplug was successful
3680 delete $conf->{$opt};
3681 vmconfig_undelete_pending_option
($conf, $opt);
3682 update_config_nolock
($vmid, $conf, 1);
3683 $conf = load_config
($vmid); # update/reload
3687 foreach my $opt (keys %{$conf->{pending
}}) {
3688 next if $selection && !$selection->{$opt};
3689 my $value = $conf->{pending
}->{$opt};
3691 if ($opt eq 'tablet') {
3692 die "skip\n" if !$hotplug;
3694 vm_deviceplug
($storecfg, $conf, $vmid, $opt);
3695 } elsif ($value == 0) {
3696 vm_deviceunplug
($vmid, $conf, $opt);
3698 } elsif ($opt eq 'cores') {
3699 die "skip\n" if !$hotplug;
3700 qemu_cpu_hotplug
($vmid, $conf, $value);
3701 } elsif ($opt eq 'balloon') {
3702 # enable/disable balloning device is not hotpluggable
3703 my $old_balloon_enabled = !defined($conf->{balloon
}) || $conf->{balloon
};
3704 my $new_balloon_enabled = !defined($conf->{pending
}->{balloon
}) || $conf->{pending
}->{balloon
};
3705 die "skip\n" if $old_balloon_enabled != $new_balloon_enabled;
3707 # allow manual ballooning if shares is set to zero
3708 if (!(defined($conf->{shares
}) && ($conf->{shares
} == 0))) {
3709 my $balloon = $conf->{pending
}->{balloon
} || $conf->{memory
} || $defaults->{memory
};
3710 vm_mon_cmd
($vmid, "balloon", value
=> $balloon*1024*1024);
3712 } elsif ($opt =~ m/^net(\d+)$/) {
3713 # some changes can be done without hotplug
3714 vmconfig_update_net
($storecfg, $conf, $vmid, $opt, $value);
3715 } elsif (valid_drivename
($opt)) {
3716 # some changes can be done without hotplug
3717 vmconfig_update_disk
($storecfg, $conf, $vmid, $opt, $value, 1);
3719 die "skip\n"; # skip non-hot-pluggable options
3723 &$add_error($opt, $err) if $err ne "skip\n";
3725 # save new config if hotplug was successful
3726 $conf->{$opt} = $value;
3727 delete $conf->{pending
}->{$opt};
3728 update_config_nolock
($vmid, $conf, 1);
3729 $conf = load_config
($vmid); # update/reload
3734 sub vmconfig_apply_pending
{
3735 my ($vmid, $conf, $storecfg) = @_;
3739 my @delete = PVE
::Tools
::split_list
($conf->{pending
}->{delete});
3740 foreach my $opt (@delete) { # delete
3741 die "internal error" if $opt =~ m/^unused/;
3742 $conf = load_config
($vmid); # update/reload
3743 if (!defined($conf->{$opt})) {
3744 vmconfig_undelete_pending_option
($conf, $opt);
3745 update_config_nolock
($vmid, $conf, 1);
3746 } elsif (valid_drivename
($opt)) {
3747 vmconfig_register_unused_drive
($storecfg, $vmid, $conf, parse_drive
($opt, $conf->{$opt}));
3748 vmconfig_undelete_pending_option
($conf, $opt);
3749 delete $conf->{$opt};
3750 update_config_nolock
($vmid, $conf, 1);
3752 vmconfig_undelete_pending_option
($conf, $opt);
3753 delete $conf->{$opt};
3754 update_config_nolock
($vmid, $conf, 1);
3758 $conf = load_config
($vmid); # update/reload
3760 foreach my $opt (keys %{$conf->{pending
}}) { # add/change
3761 $conf = load_config
($vmid); # update/reload
3763 if (defined($conf->{$opt}) && ($conf->{$opt} eq $conf->{pending
}->{$opt})) {
3764 # skip if nothing changed
3765 } elsif (valid_drivename
($opt)) {
3766 vmconfig_register_unused_drive
($storecfg, $vmid, $conf, parse_drive
($opt, $conf->{$opt}))
3767 if defined($conf->{$opt});
3768 $conf->{$opt} = $conf->{pending
}->{$opt};
3770 $conf->{$opt} = $conf->{pending
}->{$opt};
3773 delete $conf->{pending
}->{$opt};
3774 update_config_nolock
($vmid, $conf, 1);
3778 my $safe_num_ne = sub {
3781 return 0 if !defined($a) && !defined($b);
3782 return 1 if !defined($a);
3783 return 1 if !defined($b);
3788 my $safe_string_ne = sub {
3791 return 0 if !defined($a) && !defined($b);
3792 return 1 if !defined($a);
3793 return 1 if !defined($b);
3798 sub vmconfig_update_net
{
3799 my ($storecfg, $conf, $vmid, $opt, $value) = @_;
3801 my $newnet = parse_net
($value);
3803 if ($conf->{$opt}) {
3804 my $oldnet = parse_net
($conf->{$opt});
3806 if (&$safe_string_ne($oldnet->{model
}, $newnet->{model
}) ||
3807 &$safe_string_ne($oldnet->{macaddr
}, $newnet->{macaddr
}) ||
3808 &$safe_num_ne($oldnet->{queues
}, $newnet->{queues
}) ||
3809 !($newnet->{bridge
} && $oldnet->{bridge
})) { # bridge/nat mode change
3811 # for non online change, we try to hot-unplug
3812 die "skip\n" if !$conf->{hotplug
};
3813 vm_deviceunplug
($vmid, $conf, $opt);
3816 die "internal error" if $opt !~ m/net(\d+)/;
3817 my $iface = "tap${vmid}i$1";
3819 if (&$safe_num_ne($oldnet->{rate
}, $newnet->{rate
})) {
3820 PVE
::Network
::tap_rate_limit
($iface, $newnet->{rate
});
3823 if(&$safe_string_ne($oldnet->{bridge
}, $newnet->{bridge
}) ||
3824 &$safe_num_ne($oldnet->{tag
}, $newnet->{tag
}) ||
3825 &$safe_num_ne($oldnet->{firewall
}, $newnet->{firewall
})) {
3826 PVE
::Network
::tap_unplug
($iface);
3827 PVE
::Network
::tap_plug
($iface, $newnet->{bridge
}, $newnet->{tag
}, $newnet->{firewall
});
3834 if ($conf->{hotplug
}) {
3835 vm_deviceplug
($storecfg, $conf, $vmid, $opt, $newnet);
3841 sub vmconfig_update_disk
{
3842 my ($storecfg, $conf, $vmid, $opt, $value, $force) = @_;
3844 # fixme: do we need force?
3846 my $drive = parse_drive
($opt, $value);
3848 if ($conf->{$opt}) {
3850 if (my $old_drive = parse_drive
($opt, $conf->{$opt})) {
3852 my $media = $drive->{media
} || 'disk';
3853 my $oldmedia = $old_drive->{media
} || 'disk';
3854 die "unable to change media type\n" if $media ne $oldmedia;
3856 if (!drive_is_cdrom
($old_drive)) {
3858 if ($drive->{file
} ne $old_drive->{file
}) {
3860 die "skip\n" if !$conf->{hotplug
};
3862 # unplug and register as unused
3863 vm_deviceunplug
($vmid, $conf, $opt);
3864 vmconfig_register_unused_drive
($storecfg, $vmid, $conf, $old_drive)
3867 # update existing disk
3869 # skip non hotpluggable value
3870 if (&$safe_num_ne($drive->{discard
}, $old_drive->{discard
}) ||
3871 &$safe_string_ne($drive->{cache
}, $old_drive->{cache
})) {
3876 if (&$safe_num_ne($drive->{mbps
}, $old_drive->{mbps
}) ||
3877 &$safe_num_ne($drive->{mbps_rd
}, $old_drive->{mbps_rd
}) ||
3878 &$safe_num_ne($drive->{mbps_wr
}, $old_drive->{mbps_wr
}) ||
3879 &$safe_num_ne($drive->{iops
}, $old_drive->{iops
}) ||
3880 &$safe_num_ne($drive->{iops_rd
}, $old_drive->{iops_rd
}) ||
3881 &$safe_num_ne($drive->{iops_wr
}, $old_drive->{iops_wr
}) ||
3882 &$safe_num_ne($drive->{mbps_max
}, $old_drive->{mbps_max
}) ||
3883 &$safe_num_ne($drive->{mbps_rd_max
}, $old_drive->{mbps_rd_max
}) ||
3884 &$safe_num_ne($drive->{mbps_wr_max
}, $old_drive->{mbps_wr_max
}) ||
3885 &$safe_num_ne($drive->{iops_max
}, $old_drive->{iops_max
}) ||
3886 &$safe_num_ne($drive->{iops_rd_max
}, $old_drive->{iops_rd_max
}) ||
3887 &$safe_num_ne($drive->{iops_wr_max
}, $old_drive->{iops_wr_max
})) {
3889 qemu_block_set_io_throttle
($vmid,"drive-$opt",
3890 ($drive->{mbps
} || 0)*1024*1024,
3891 ($drive->{mbps_rd
} || 0)*1024*1024,
3892 ($drive->{mbps_wr
} || 0)*1024*1024,
3893 $drive->{iops
} || 0,
3894 $drive->{iops_rd
} || 0,
3895 $drive->{iops_wr
} || 0,
3896 ($drive->{mbps_max
} || 0)*1024*1024,
3897 ($drive->{mbps_rd_max
} || 0)*1024*1024,
3898 ($drive->{mbps_wr_max
} || 0)*1024*1024,
3899 $drive->{iops_max
} || 0,
3900 $drive->{iops_rd_max
} || 0,
3901 $drive->{iops_wr_max
} || 0);
3911 if (drive_is_cdrom
($drive)) { # cdrom
3913 if ($drive->{file
} eq 'none') {
3914 vm_mon_cmd
($vmid, "eject",force
=> JSON
::true
,device
=> "drive-$opt");
3916 my $path = get_iso_path
($storecfg, $vmid, $drive->{file
});
3917 vm_mon_cmd
($vmid, "eject", force
=> JSON
::true
,device
=> "drive-$opt"); # force eject if locked
3918 vm_mon_cmd
($vmid, "change", device
=> "drive-$opt",target
=> "$path") if $path;
3922 die "skip\n" if !$conf->{hotplug
} || $opt =~ m/(ide|sata)(\d+)/;
3924 vm_deviceplug
($storecfg, $conf, $vmid, $opt, $drive);
3929 my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused, $forcemachine, $spice_ticket) = @_;
3931 lock_config
($vmid, sub {
3932 my $conf = load_config
($vmid, $migratedfrom);
3934 die "you can't start a vm if it's a template\n" if is_template
($conf);
3936 check_lock
($conf) if !$skiplock;
3938 die "VM $vmid already running\n" if check_running
($vmid, undef, $migratedfrom);
3940 if (!$statefile && scalar(keys %{$conf->{pending
}})) {
3941 vmconfig_apply_pending
($vmid, $conf, $storecfg);
3942 $conf = load_config
($vmid); # update/reload
3945 my $defaults = load_defaults
();
3947 # set environment variable useful inside network script
3948 $ENV{PVE_MIGRATED_FROM
} = $migratedfrom if $migratedfrom;
3950 my ($cmd, $vollist, $spice_port) = config_to_command
($storecfg, $vmid, $conf, $defaults, $forcemachine);
3952 my $migrate_port = 0;
3955 if ($statefile eq 'tcp') {
3956 my $localip = "localhost";
3957 my $datacenterconf = PVE
::Cluster
::cfs_read_file
('datacenter.cfg');
3958 if ($datacenterconf->{migration_unsecure
}) {
3959 my $nodename = PVE
::INotify
::nodename
();
3960 $localip = PVE
::Cluster
::remote_node_ip
($nodename, 1);
3962 $migrate_port = PVE
::Tools
::next_migrate_port
();
3963 $migrate_uri = "tcp:${localip}:${migrate_port}";
3964 push @$cmd, '-incoming', $migrate_uri;
3967 push @$cmd, '-loadstate', $statefile;
3974 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
3975 my $d = parse_hostpci
($conf->{"hostpci$i"});
3977 my $pcidevices = $d->{pciid
};
3978 foreach my $pcidevice (@$pcidevices) {
3979 my $pciid = $pcidevice->{id
}.".".$pcidevice->{function
};
3981 my $info = pci_device_info
("0000:$pciid");
3982 die "IOMMU not present\n" if !check_iommu_support
();
3983 die "no pci device info for device '$pciid'\n" if !$info;
3985 if ($d->{driver
} && $d->{driver
} eq "vfio") {
3986 die "can't unbind/bind pci group to vfio '$pciid'\n" if !pci_dev_group_bind_to_vfio
($pciid);
3988 die "can't unbind/bind to stub pci device '$pciid'\n" if !pci_dev_bind_to_stub
($info);
3991 die "can't reset pci device '$pciid'\n" if $info->{has_fl_reset
} and !pci_dev_reset
($info);
3995 PVE
::Storage
::activate_volumes
($storecfg, $vollist);
3997 eval { run_command
($cmd, timeout
=> $statefile ?
undef : 30,
4000 die "start failed: $err" if $err;
4002 print "migration listens on $migrate_uri\n" if $migrate_uri;
4004 if ($statefile && $statefile ne 'tcp') {
4005 eval { vm_mon_cmd_nocheck
($vmid, "cont"); };
4009 if ($migratedfrom) {
4012 set_migration_caps
($vmid);
4017 print "spice listens on port $spice_port\n";
4018 if ($spice_ticket) {
4019 vm_mon_cmd_nocheck
($vmid, "set_password", protocol
=> 'spice', password
=> $spice_ticket);
4020 vm_mon_cmd_nocheck
($vmid, "expire_password", protocol
=> 'spice', time => "+30");
4026 if (!$statefile && (!defined($conf->{balloon
}) || $conf->{balloon
})) {
4027 vm_mon_cmd_nocheck
($vmid, "balloon", value
=> $conf->{balloon
}*1024*1024)
4028 if $conf->{balloon
};
4029 vm_mon_cmd_nocheck
($vmid, 'qom-set',
4030 path
=> "machine/peripheral/balloon0",
4031 property
=> "guest-stats-polling-interval",
4039 my ($vmid, $execute, %params) = @_;
4041 my $cmd = { execute
=> $execute, arguments
=> \
%params };
4042 vm_qmp_command
($vmid, $cmd);
4045 sub vm_mon_cmd_nocheck
{
4046 my ($vmid, $execute, %params) = @_;
4048 my $cmd = { execute
=> $execute, arguments
=> \
%params };
4049 vm_qmp_command
($vmid, $cmd, 1);
4052 sub vm_qmp_command
{
4053 my ($vmid, $cmd, $nocheck) = @_;
4058 if ($cmd->{arguments
} && $cmd->{arguments
}->{timeout
}) {
4059 $timeout = $cmd->{arguments
}->{timeout
};
4060 delete $cmd->{arguments
}->{timeout
};
4064 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
4065 my $sname = qmp_socket
($vmid);
4066 if (-e
$sname) { # test if VM is reasonambe new and supports qmp/qga
4067 my $qmpclient = PVE
::QMPClient-
>new();
4069 $res = $qmpclient->cmd($vmid, $cmd, $timeout);
4070 } elsif (-e
"${var_run_tmpdir}/$vmid.mon") {
4071 die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
4072 if scalar(%{$cmd->{arguments
}});
4073 vm_monitor_command
($vmid, $cmd->{execute
}, $nocheck);
4075 die "unable to open monitor socket\n";
4079 syslog
("err", "VM $vmid qmp command failed - $err");
4086 sub vm_human_monitor_command
{
4087 my ($vmid, $cmdline) = @_;
4092 execute
=> 'human-monitor-command',
4093 arguments
=> { 'command-line' => $cmdline},
4096 return vm_qmp_command
($vmid, $cmd);
4099 sub vm_commandline
{
4100 my ($storecfg, $vmid) = @_;
4102 my $conf = load_config
($vmid);
4104 my $defaults = load_defaults
();
4106 my $cmd = config_to_command
($storecfg, $vmid, $conf, $defaults);
4108 return join(' ', @$cmd);
4112 my ($vmid, $skiplock) = @_;
4114 lock_config
($vmid, sub {
4116 my $conf = load_config
($vmid);
4118 check_lock
($conf) if !$skiplock;
4120 vm_mon_cmd
($vmid, "system_reset");
4124 sub get_vm_volumes
{
4128 foreach_volid
($conf, sub {
4129 my ($volid, $is_cdrom) = @_;
4131 return if $volid =~ m
|^/|;
4133 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
4136 push @$vollist, $volid;
4142 sub vm_stop_cleanup
{
4143 my ($storecfg, $vmid, $conf, $keepActive) = @_;
4146 fairsched_rmnod
($vmid); # try to destroy group
4149 my $vollist = get_vm_volumes
($conf);
4150 PVE
::Storage
::deactivate_volumes
($storecfg, $vollist);
4153 foreach my $ext (qw(mon qmp pid vnc qga)) {
4154 unlink "/var/run/qemu-server/${vmid}.$ext";
4157 warn $@ if $@; # avoid errors - just warn
4160 # Note: use $nockeck to skip tests if VM configuration file exists.
4161 # We need that when migration VMs to other nodes (files already moved)
4162 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
4164 my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
4166 $force = 1 if !defined($force) && !$shutdown;
4169 my $pid = check_running
($vmid, $nocheck, $migratedfrom);
4170 kill 15, $pid if $pid;
4171 my $conf = load_config
($vmid, $migratedfrom);
4172 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive);
4176 lock_config
($vmid, sub {
4178 my $pid = check_running
($vmid, $nocheck);
4183 $conf = load_config
($vmid);
4184 check_lock
($conf) if !$skiplock;
4185 if (!defined($timeout) && $shutdown && $conf->{startup
}) {
4186 my $opts = parse_startup
($conf->{startup
});
4187 $timeout = $opts->{down
} if $opts->{down
};
4191 $timeout = 60 if !defined($timeout);
4195 if (!$nocheck && $conf->{agent
}) {
4196 vm_qmp_command
($vmid, { execute
=> "guest-shutdown" }, $nocheck);
4198 vm_qmp_command
($vmid, { execute
=> "system_powerdown" }, $nocheck);
4201 vm_qmp_command
($vmid, { execute
=> "quit" }, $nocheck);
4208 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
4213 if ($count >= $timeout) {
4215 warn "VM still running - terminating now with SIGTERM\n";
4218 die "VM quit/powerdown failed - got timeout\n";
4221 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
4226 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
4229 die "VM quit/powerdown failed\n";
4237 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
4242 if ($count >= $timeout) {
4243 warn "VM still running - terminating now with SIGKILL\n";
4248 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
4253 my ($vmid, $skiplock) = @_;
4255 lock_config
($vmid, sub {
4257 my $conf = load_config
($vmid);
4259 check_lock
($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
4261 vm_mon_cmd
($vmid, "stop");
4266 my ($vmid, $skiplock) = @_;
4268 lock_config
($vmid, sub {
4270 my $conf = load_config
($vmid);
4272 check_lock
($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
4274 vm_mon_cmd
($vmid, "cont");
4279 my ($vmid, $skiplock, $key) = @_;
4281 lock_config
($vmid, sub {
4283 my $conf = load_config
($vmid);
4285 # there is no qmp command, so we use the human monitor command
4286 vm_human_monitor_command
($vmid, "sendkey $key");
4291 my ($storecfg, $vmid, $skiplock) = @_;
4293 lock_config
($vmid, sub {
4295 my $conf = load_config
($vmid);
4297 check_lock
($conf) if !$skiplock;
4299 if (!check_running
($vmid)) {
4300 fairsched_rmnod
($vmid); # try to destroy group
4301 destroy_vm
($storecfg, $vmid);
4303 die "VM $vmid is running - destroy failed\n";
4311 my ($filename, $buf) = @_;
4313 my $fh = IO
::File-
>new($filename, "w");
4314 return undef if !$fh;
4316 my $res = print $fh $buf;
4323 sub pci_device_info
{
4328 return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
4329 my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
4331 my $irq = file_read_firstline
("$pcisysfs/devices/$name/irq");
4332 return undef if !defined($irq) || $irq !~ m/^\d+$/;
4334 my $vendor = file_read_firstline
("$pcisysfs/devices/$name/vendor");
4335 return undef if !defined($vendor) || $vendor !~ s/^0x//;
4337 my $product = file_read_firstline
("$pcisysfs/devices/$name/device");
4338 return undef if !defined($product) || $product !~ s/^0x//;
4343 product
=> $product,
4349 has_fl_reset
=> -f
"$pcisysfs/devices/$name/reset" || 0,
4358 my $name = $dev->{name
};
4360 my $fn = "$pcisysfs/devices/$name/reset";
4362 return file_write
($fn, "1");
4365 sub pci_dev_bind_to_stub
{
4368 my $name = $dev->{name
};
4370 my $testdir = "$pcisysfs/drivers/pci-stub/$name";
4371 return 1 if -d
$testdir;
4373 my $data = "$dev->{vendor} $dev->{product}";
4374 return undef if !file_write
("$pcisysfs/drivers/pci-stub/new_id", $data);
4376 my $fn = "$pcisysfs/devices/$name/driver/unbind";
4377 if (!file_write
($fn, $name)) {
4378 return undef if -f
$fn;
4381 $fn = "$pcisysfs/drivers/pci-stub/bind";
4382 if (! -d
$testdir) {
4383 return undef if !file_write
($fn, $name);
4389 sub pci_dev_bind_to_vfio
{
4392 my $name = $dev->{name
};
4394 my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4396 if (!-d
$vfio_basedir) {
4397 system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4399 die "Cannot find vfio-pci module!\n" if !-d
$vfio_basedir;
4401 my $testdir = "$vfio_basedir/$name";
4402 return 1 if -d
$testdir;
4404 my $data = "$dev->{vendor} $dev->{product}";
4405 return undef if !file_write
("$vfio_basedir/new_id", $data);
4407 my $fn = "$pcisysfs/devices/$name/driver/unbind";
4408 if (!file_write
($fn, $name)) {
4409 return undef if -f
$fn;
4412 $fn = "$vfio_basedir/bind";
4413 if (! -d
$testdir) {
4414 return undef if !file_write
($fn, $name);
4420 sub pci_dev_group_bind_to_vfio
{
4423 my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4425 if (!-d
$vfio_basedir) {
4426 system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4428 die "Cannot find vfio-pci module!\n" if !-d
$vfio_basedir;
4430 # get IOMMU group devices
4431 opendir(my $D, "$pcisysfs/devices/0000:$pciid/iommu_group/devices/") || die "Cannot open iommu_group: $!\n";
4432 my @devs = grep /^0000:/, readdir($D);
4435 foreach my $pciid (@devs) {
4436 $pciid =~ m/^([:\.\da-f]+)$/ or die "PCI ID $pciid not valid!\n";
4437 my $info = pci_device_info
($1);
4438 pci_dev_bind_to_vfio
($info) || die "Cannot bind $pciid to vfio\n";
4444 sub print_pci_addr
{
4445 my ($id, $bridges) = @_;
4449 piix3
=> { bus
=> 0, addr
=> 1 },
4450 #addr2 : first videocard
4451 balloon0
=> { bus
=> 0, addr
=> 3 },
4452 watchdog
=> { bus
=> 0, addr
=> 4 },
4453 scsihw0
=> { bus
=> 0, addr
=> 5 },
4454 scsihw1
=> { bus
=> 0, addr
=> 6 },
4455 ahci0
=> { bus
=> 0, addr
=> 7 },
4456 qga0
=> { bus
=> 0, addr
=> 8 },
4457 spice
=> { bus
=> 0, addr
=> 9 },
4458 virtio0
=> { bus
=> 0, addr
=> 10 },
4459 virtio1
=> { bus
=> 0, addr
=> 11 },
4460 virtio2
=> { bus
=> 0, addr
=> 12 },
4461 virtio3
=> { bus
=> 0, addr
=> 13 },
4462 virtio4
=> { bus
=> 0, addr
=> 14 },
4463 virtio5
=> { bus
=> 0, addr
=> 15 },
4464 hostpci0
=> { bus
=> 0, addr
=> 16 },
4465 hostpci1
=> { bus
=> 0, addr
=> 17 },
4466 net0
=> { bus
=> 0, addr
=> 18 },
4467 net1
=> { bus
=> 0, addr
=> 19 },
4468 net2
=> { bus
=> 0, addr
=> 20 },
4469 net3
=> { bus
=> 0, addr
=> 21 },
4470 net4
=> { bus
=> 0, addr
=> 22 },
4471 net5
=> { bus
=> 0, addr
=> 23 },
4472 vga1
=> { bus
=> 0, addr
=> 24 },
4473 vga2
=> { bus
=> 0, addr
=> 25 },
4474 vga3
=> { bus
=> 0, addr
=> 26 },
4475 hostpci2
=> { bus
=> 0, addr
=> 27 },
4476 hostpci3
=> { bus
=> 0, addr
=> 28 },
4477 #addr29 : usb-host (pve-usb.cfg)
4478 'pci.1' => { bus
=> 0, addr
=> 30 },
4479 'pci.2' => { bus
=> 0, addr
=> 31 },
4480 'net6' => { bus
=> 1, addr
=> 1 },
4481 'net7' => { bus
=> 1, addr
=> 2 },
4482 'net8' => { bus
=> 1, addr
=> 3 },
4483 'net9' => { bus
=> 1, addr
=> 4 },
4484 'net10' => { bus
=> 1, addr
=> 5 },
4485 'net11' => { bus
=> 1, addr
=> 6 },
4486 'net12' => { bus
=> 1, addr
=> 7 },
4487 'net13' => { bus
=> 1, addr
=> 8 },
4488 'net14' => { bus
=> 1, addr
=> 9 },
4489 'net15' => { bus
=> 1, addr
=> 10 },
4490 'net16' => { bus
=> 1, addr
=> 11 },
4491 'net17' => { bus
=> 1, addr
=> 12 },
4492 'net18' => { bus
=> 1, addr
=> 13 },
4493 'net19' => { bus
=> 1, addr
=> 14 },
4494 'net20' => { bus
=> 1, addr
=> 15 },
4495 'net21' => { bus
=> 1, addr
=> 16 },
4496 'net22' => { bus
=> 1, addr
=> 17 },
4497 'net23' => { bus
=> 1, addr
=> 18 },
4498 'net24' => { bus
=> 1, addr
=> 19 },
4499 'net25' => { bus
=> 1, addr
=> 20 },
4500 'net26' => { bus
=> 1, addr
=> 21 },
4501 'net27' => { bus
=> 1, addr
=> 22 },
4502 'net28' => { bus
=> 1, addr
=> 23 },
4503 'net29' => { bus
=> 1, addr
=> 24 },
4504 'net30' => { bus
=> 1, addr
=> 25 },
4505 'net31' => { bus
=> 1, addr
=> 26 },
4506 'virtio6' => { bus
=> 2, addr
=> 1 },
4507 'virtio7' => { bus
=> 2, addr
=> 2 },
4508 'virtio8' => { bus
=> 2, addr
=> 3 },
4509 'virtio9' => { bus
=> 2, addr
=> 4 },
4510 'virtio10' => { bus
=> 2, addr
=> 5 },
4511 'virtio11' => { bus
=> 2, addr
=> 6 },
4512 'virtio12' => { bus
=> 2, addr
=> 7 },
4513 'virtio13' => { bus
=> 2, addr
=> 8 },
4514 'virtio14' => { bus
=> 2, addr
=> 9 },
4515 'virtio15' => { bus
=> 2, addr
=> 10 },
4518 if (defined($devices->{$id}->{bus
}) && defined($devices->{$id}->{addr
})) {
4519 my $addr = sprintf("0x%x", $devices->{$id}->{addr
});
4520 my $bus = $devices->{$id}->{bus
};
4521 $res = ",bus=pci.$bus,addr=$addr";
4522 $bridges->{$bus} = 1 if $bridges;
4528 sub print_pcie_addr
{
4533 hostpci0
=> { bus
=> "ich9-pcie-port-1", addr
=> 0 },
4534 hostpci1
=> { bus
=> "ich9-pcie-port-2", addr
=> 0 },
4535 hostpci2
=> { bus
=> "ich9-pcie-port-3", addr
=> 0 },
4536 hostpci3
=> { bus
=> "ich9-pcie-port-4", addr
=> 0 },
4539 if (defined($devices->{$id}->{bus
}) && defined($devices->{$id}->{addr
})) {
4540 my $addr = sprintf("0x%x", $devices->{$id}->{addr
});
4541 my $bus = $devices->{$id}->{bus
};
4542 $res = ",bus=$bus,addr=$addr";
4548 # vzdump restore implementaion
4550 sub tar_archive_read_firstfile
{
4551 my $archive = shift;
4553 die "ERROR: file '$archive' does not exist\n" if ! -f
$archive;
4555 # try to detect archive type first
4556 my $pid = open (TMP
, "tar tf '$archive'|") ||
4557 die "unable to open file '$archive'\n";
4558 my $firstfile = <TMP
>;
4562 die "ERROR: archive contaions no data\n" if !$firstfile;
4568 sub tar_restore_cleanup
{
4569 my ($storecfg, $statfile) = @_;
4571 print STDERR
"starting cleanup\n";
4573 if (my $fd = IO
::File-
>new($statfile, "r")) {
4574 while (defined(my $line = <$fd>)) {
4575 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4578 if ($volid =~ m
|^/|) {
4579 unlink $volid || die 'unlink failed\n';
4581 PVE
::Storage
::vdisk_free
($storecfg, $volid);
4583 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
4585 print STDERR
"unable to cleanup '$volid' - $@" if $@;
4587 print STDERR
"unable to parse line in statfile - $line";
4594 sub restore_archive
{
4595 my ($archive, $vmid, $user, $opts) = @_;
4597 my $format = $opts->{format
};
4600 if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
4601 $format = 'tar' if !$format;
4603 } elsif ($archive =~ m/\.tar$/) {
4604 $format = 'tar' if !$format;
4605 } elsif ($archive =~ m/.tar.lzo$/) {
4606 $format = 'tar' if !$format;
4608 } elsif ($archive =~ m/\.vma$/) {
4609 $format = 'vma' if !$format;
4610 } elsif ($archive =~ m/\.vma\.gz$/) {
4611 $format = 'vma' if !$format;
4613 } elsif ($archive =~ m/\.vma\.lzo$/) {
4614 $format = 'vma' if !$format;
4617 $format = 'vma' if !$format; # default
4620 # try to detect archive format
4621 if ($format eq 'tar') {
4622 return restore_tar_archive
($archive, $vmid, $user, $opts);
4624 return restore_vma_archive
($archive, $vmid, $user, $opts, $comp);
4628 sub restore_update_config_line
{
4629 my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
4631 return if $line =~ m/^\#qmdump\#/;
4632 return if $line =~ m/^\#vzdump\#/;
4633 return if $line =~ m/^lock:/;
4634 return if $line =~ m/^unused\d+:/;
4635 return if $line =~ m/^parent:/;
4636 return if $line =~ m/^template:/; # restored VM is never a template
4638 if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
4639 # try to convert old 1.X settings
4640 my ($id, $ind, $ethcfg) = ($1, $2, $3);
4641 foreach my $devconfig (PVE
::Tools
::split_list
($ethcfg)) {
4642 my ($model, $macaddr) = split(/\=/, $devconfig);
4643 $macaddr = PVE
::Tools
::random_ether_addr
() if !$macaddr || $unique;
4646 bridge
=> "vmbr$ind",
4647 macaddr
=> $macaddr,
4649 my $netstr = print_net
($net);
4651 print $outfd "net$cookie->{netcount}: $netstr\n";
4652 $cookie->{netcount
}++;
4654 } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
4655 my ($id, $netstr) = ($1, $2);
4656 my $net = parse_net
($netstr);
4657 $net->{macaddr
} = PVE
::Tools
::random_ether_addr
() if $net->{macaddr
};
4658 $netstr = print_net
($net);
4659 print $outfd "$id: $netstr\n";
4660 } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
4663 if ($line =~ m/backup=no/) {
4664 print $outfd "#$line";
4665 } elsif ($virtdev && $map->{$virtdev}) {
4666 my $di = parse_drive
($virtdev, $value);
4667 delete $di->{format
}; # format can change on restore
4668 $di->{file
} = $map->{$virtdev};
4669 $value = print_drive
($vmid, $di);
4670 print $outfd "$virtdev: $value\n";
4680 my ($cfg, $vmid) = @_;
4682 my $info = PVE
::Storage
::vdisk_list
($cfg, undef, $vmid);
4684 my $volid_hash = {};
4685 foreach my $storeid (keys %$info) {
4686 foreach my $item (@{$info->{$storeid}}) {
4687 next if !($item->{volid
} && $item->{size
});
4688 $item->{path
} = PVE
::Storage
::path
($cfg, $item->{volid
});
4689 $volid_hash->{$item->{volid
}} = $item;
4696 sub get_used_paths
{
4697 my ($vmid, $storecfg, $conf, $scan_snapshots, $skip_drive) = @_;
4701 my $scan_config = sub {
4702 my ($cref, $snapname) = @_;
4704 foreach my $key (keys %$cref) {
4705 my $value = $cref->{$key};
4706 if (valid_drivename
($key)) {
4707 next if $skip_drive && $key eq $skip_drive;
4708 my $drive = parse_drive
($key, $value);
4709 next if !$drive || !$drive->{file
} || drive_is_cdrom
($drive);
4710 if ($drive->{file
} =~ m!^/!) {
4711 $used_path->{$drive->{file
}}++; # = 1;
4713 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($drive->{file
}, 1);
4715 my $scfg = PVE
::Storage
::storage_config
($storecfg, $storeid, 1);
4717 my $path = PVE
::Storage
::path
($storecfg, $drive->{file
}, $snapname);
4718 $used_path->{$path}++; # = 1;
4724 &$scan_config($conf);
4728 if ($scan_snapshots) {
4729 foreach my $snapname (keys %{$conf->{snapshots
}}) {
4730 &$scan_config($conf->{snapshots
}->{$snapname}, $snapname);
4737 sub update_disksize
{
4738 my ($vmid, $conf, $volid_hash) = @_;
4744 # Note: it is allowed to define multiple storages with same path (alias), so
4745 # we need to check both 'volid' and real 'path' (two different volid can point
4746 # to the same path).
4751 foreach my $opt (keys %$conf) {
4752 if (valid_drivename
($opt)) {
4753 my $drive = parse_drive
($opt, $conf->{$opt});
4754 my $volid = $drive->{file
};
4757 $used->{$volid} = 1;
4758 if ($volid_hash->{$volid} &&
4759 (my $path = $volid_hash->{$volid}->{path
})) {
4760 $usedpath->{$path} = 1;
4763 next if drive_is_cdrom
($drive);
4764 next if !$volid_hash->{$volid};
4766 $drive->{size
} = $volid_hash->{$volid}->{size
};
4767 my $new = print_drive
($vmid, $drive);
4768 if ($new ne $conf->{$opt}) {
4770 $conf->{$opt} = $new;
4775 # remove 'unusedX' entry if volume is used
4776 foreach my $opt (keys %$conf) {
4777 next if $opt !~ m/^unused\d+$/;
4778 my $volid = $conf->{$opt};
4779 my $path = $volid_hash->{$volid}->{path
} if $volid_hash->{$volid};
4780 if ($used->{$volid} || ($path && $usedpath->{$path})) {
4782 delete $conf->{$opt};
4786 foreach my $volid (sort keys %$volid_hash) {
4787 next if $volid =~ m/vm-$vmid-state-/;
4788 next if $used->{$volid};
4789 my $path = $volid_hash->{$volid}->{path
};
4790 next if !$path; # just to be sure
4791 next if $usedpath->{$path};
4793 add_unused_volume
($conf, $volid);
4794 $usedpath->{$path} = 1; # avoid to add more than once (aliases)
4801 my ($vmid, $nolock) = @_;
4803 my $cfg = PVE
::Cluster
::cfs_read_file
("storage.cfg");
4805 my $volid_hash = scan_volids
($cfg, $vmid);
4807 my $updatefn = sub {
4810 my $conf = load_config
($vmid);
4815 foreach my $volid (keys %$volid_hash) {
4816 my $info = $volid_hash->{$volid};
4817 $vm_volids->{$volid} = $info if $info->{vmid
} && $info->{vmid
} == $vmid;
4820 my $changes = update_disksize
($vmid, $conf, $vm_volids);
4822 update_config_nolock
($vmid, $conf, 1) if $changes;
4825 if (defined($vmid)) {
4829 lock_config
($vmid, $updatefn, $vmid);
4832 my $vmlist = config_list
();
4833 foreach my $vmid (keys %$vmlist) {
4837 lock_config
($vmid, $updatefn, $vmid);
4843 sub restore_vma_archive
{
4844 my ($archive, $vmid, $user, $opts, $comp) = @_;
4846 my $input = $archive eq '-' ?
"<&STDIN" : undef;
4847 my $readfrom = $archive;
4852 my $qarchive = PVE
::Tools
::shellquote
($archive);
4853 if ($comp eq 'gzip') {
4854 $uncomp = "zcat $qarchive|";
4855 } elsif ($comp eq 'lzop') {
4856 $uncomp = "lzop -d -c $qarchive|";
4858 die "unknown compression method '$comp'\n";
4863 my $tmpdir = "/var/tmp/vzdumptmp$$";
4866 # disable interrupts (always do cleanups)
4867 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
4868 warn "got interrupt - ignored\n";
4871 my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
4872 POSIX
::mkfifo
($mapfifo, 0600);
4875 my $openfifo = sub {
4876 open($fifofh, '>', $mapfifo) || die $!;
4879 my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
4886 my $rpcenv = PVE
::RPCEnvironment
::get
();
4888 my $conffile = config_file
($vmid);
4889 my $tmpfn = "$conffile.$$.tmp";
4891 # Note: $oldconf is undef if VM does not exists
4892 my $oldconf = PVE
::Cluster
::cfs_read_file
(cfs_config_path
($vmid));
4894 my $print_devmap = sub {
4895 my $virtdev_hash = {};
4897 my $cfgfn = "$tmpdir/qemu-server.conf";
4899 # we can read the config - that is already extracted
4900 my $fh = IO
::File-
>new($cfgfn, "r") ||
4901 "unable to read qemu-server.conf - $!\n";
4903 while (defined(my $line = <$fh>)) {
4904 if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
4905 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
4906 die "archive does not contain data for drive '$virtdev'\n"
4907 if !$devinfo->{$devname};
4908 if (defined($opts->{storage
})) {
4909 $storeid = $opts->{storage
} || 'local';
4910 } elsif (!$storeid) {
4913 $format = 'raw' if !$format;
4914 $devinfo->{$devname}->{devname
} = $devname;
4915 $devinfo->{$devname}->{virtdev
} = $virtdev;
4916 $devinfo->{$devname}->{format
} = $format;
4917 $devinfo->{$devname}->{storeid
} = $storeid;
4919 # check permission on storage
4920 my $pool = $opts->{pool
}; # todo: do we need that?
4921 if ($user ne 'root@pam') {
4922 $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
4925 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
4929 foreach my $devname (keys %$devinfo) {
4930 die "found no device mapping information for device '$devname'\n"
4931 if !$devinfo->{$devname}->{virtdev
};
4934 my $cfg = cfs_read_file
('storage.cfg');
4936 # create empty/temp config
4938 PVE
::Tools
::file_set_contents
($conffile, "memory: 128\n");
4939 foreach_drive
($oldconf, sub {
4940 my ($ds, $drive) = @_;
4942 return if drive_is_cdrom
($drive);
4944 my $volid = $drive->{file
};
4946 return if !$volid || $volid =~ m
|^/|;
4948 my ($path, $owner) = PVE
::Storage
::path
($cfg, $volid);
4949 return if !$path || !$owner || ($owner != $vmid);
4951 # Note: only delete disk we want to restore
4952 # other volumes will become unused
4953 if ($virtdev_hash->{$ds}) {
4954 PVE
::Storage
::vdisk_free
($cfg, $volid);
4960 foreach my $virtdev (sort keys %$virtdev_hash) {
4961 my $d = $virtdev_hash->{$virtdev};
4962 my $alloc_size = int(($d->{size
} + 1024 - 1)/1024);
4963 my $scfg = PVE
::Storage
::storage_config
($cfg, $d->{storeid
});
4965 # test if requested format is supported
4966 my ($defFormat, $validFormats) = PVE
::Storage
::storage_default_format
($cfg, $d->{storeid
});
4967 my $supported = grep { $_ eq $d->{format
} } @$validFormats;
4968 $d->{format
} = $defFormat if !$supported;
4970 my $volid = PVE
::Storage
::vdisk_alloc
($cfg, $d->{storeid
}, $vmid,
4971 $d->{format
}, undef, $alloc_size);
4972 print STDERR
"new volume ID is '$volid'\n";
4973 $d->{volid
} = $volid;
4974 my $path = PVE
::Storage
::path
($cfg, $volid);
4976 my $write_zeros = 1;
4977 # fixme: what other storages types initialize volumes with zero?
4978 if ($scfg->{type
} eq 'dir' || $scfg->{type
} eq 'nfs' || $scfg->{type
} eq 'glusterfs' ||
4979 $scfg->{type
} eq 'sheepdog' || $scfg->{type
} eq 'rbd') {
4983 print $fifofh "${write_zeros}:$d->{devname}=$path\n";
4985 print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
4986 $map->{$virtdev} = $volid;
4989 $fh->seek(0, 0) || die "seek failed - $!\n";
4991 my $outfd = new IO
::File
($tmpfn, "w") ||
4992 die "unable to write config for VM $vmid\n";
4994 my $cookie = { netcount
=> 0 };
4995 while (defined(my $line = <$fh>)) {
4996 restore_update_config_line
($outfd, $cookie, $vmid, $map, $line, $opts->{unique
});
5005 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
5006 die "interrupted by signal\n";
5008 local $SIG{ALRM
} = sub { die "got timeout\n"; };
5010 $oldtimeout = alarm($timeout);
5017 if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
5018 my ($dev_id, $size, $devname) = ($1, $2, $3);
5019 $devinfo->{$devname} = { size
=> $size, dev_id
=> $dev_id };
5020 } elsif ($line =~ m/^CTIME: /) {
5021 # we correctly received the vma config, so we can disable
5022 # the timeout now for disk allocation (set to 10 minutes, so
5023 # that we always timeout if something goes wrong)
5026 print $fifofh "done\n";
5027 my $tmp = $oldtimeout || 0;
5028 $oldtimeout = undef;
5034 print "restore vma archive: $cmd\n";
5035 run_command
($cmd, input
=> $input, outfunc
=> $parser, afterfork
=> $openfifo);
5039 alarm($oldtimeout) if $oldtimeout;
5047 my $cfg = cfs_read_file
('storage.cfg');
5048 foreach my $devname (keys %$devinfo) {
5049 my $volid = $devinfo->{$devname}->{volid
};
5052 if ($volid =~ m
|^/|) {
5053 unlink $volid || die 'unlink failed\n';
5055 PVE
::Storage
::vdisk_free
($cfg, $volid);
5057 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
5059 print STDERR
"unable to cleanup '$volid' - $@" if $@;
5066 rename($tmpfn, $conffile) ||
5067 die "unable to commit configuration file '$conffile'\n";
5069 PVE
::Cluster
::cfs_update
(); # make sure we read new file
5071 eval { rescan
($vmid, 1); };
5075 sub restore_tar_archive
{
5076 my ($archive, $vmid, $user, $opts) = @_;
5078 if ($archive ne '-') {
5079 my $firstfile = tar_archive_read_firstfile
($archive);
5080 die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
5081 if $firstfile ne 'qemu-server.conf';
5084 my $storecfg = cfs_read_file
('storage.cfg');
5086 # destroy existing data - keep empty config
5087 my $vmcfgfn = config_file
($vmid);
5088 destroy_vm
($storecfg, $vmid, 1) if -f
$vmcfgfn;
5090 my $tocmd = "/usr/lib/qemu-server/qmextract";
5092 $tocmd .= " --storage " . PVE
::Tools
::shellquote
($opts->{storage
}) if $opts->{storage
};
5093 $tocmd .= " --pool " . PVE
::Tools
::shellquote
($opts->{pool
}) if $opts->{pool
};
5094 $tocmd .= ' --prealloc' if $opts->{prealloc
};
5095 $tocmd .= ' --info' if $opts->{info
};
5097 # tar option "xf" does not autodetect compression when read from STDIN,
5098 # so we pipe to zcat
5099 my $cmd = "zcat -f|tar xf " . PVE
::Tools
::shellquote
($archive) . " " .
5100 PVE
::Tools
::shellquote
("--to-command=$tocmd");
5102 my $tmpdir = "/var/tmp/vzdumptmp$$";
5105 local $ENV{VZDUMP_TMPDIR
} = $tmpdir;
5106 local $ENV{VZDUMP_VMID
} = $vmid;
5107 local $ENV{VZDUMP_USER
} = $user;
5109 my $conffile = config_file
($vmid);
5110 my $tmpfn = "$conffile.$$.tmp";
5112 # disable interrupts (always do cleanups)
5113 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
5114 print STDERR
"got interrupt - ignored\n";
5119 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
5120 die "interrupted by signal\n";
5123 if ($archive eq '-') {
5124 print "extracting archive from STDIN\n";
5125 run_command
($cmd, input
=> "<&STDIN");
5127 print "extracting archive '$archive'\n";
5131 return if $opts->{info
};
5135 my $statfile = "$tmpdir/qmrestore.stat";
5136 if (my $fd = IO
::File-
>new($statfile, "r")) {
5137 while (defined (my $line = <$fd>)) {
5138 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
5139 $map->{$1} = $2 if $1;
5141 print STDERR
"unable to parse line in statfile - $line\n";
5147 my $confsrc = "$tmpdir/qemu-server.conf";
5149 my $srcfd = new IO
::File
($confsrc, "r") ||
5150 die "unable to open file '$confsrc'\n";
5152 my $outfd = new IO
::File
($tmpfn, "w") ||
5153 die "unable to write config for VM $vmid\n";
5155 my $cookie = { netcount
=> 0 };
5156 while (defined (my $line = <$srcfd>)) {
5157 restore_update_config_line
($outfd, $cookie, $vmid, $map, $line, $opts->{unique
});
5169 tar_restore_cleanup
($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info
};
5176 rename $tmpfn, $conffile ||
5177 die "unable to commit configuration file '$conffile'\n";
5179 PVE
::Cluster
::cfs_update
(); # make sure we read new file
5181 eval { rescan
($vmid, 1); };
5186 # Internal snapshots
5188 # NOTE: Snapshot create/delete involves several non-atomic
5189 # action, and can take a long time.
5190 # So we try to avoid locking the file and use 'lock' variable
5191 # inside the config file instead.
5193 my $snapshot_copy_config = sub {
5194 my ($source, $dest) = @_;
5196 foreach my $k (keys %$source) {
5197 next if $k eq 'snapshots';
5198 next if $k eq 'snapstate';
5199 next if $k eq 'snaptime';
5200 next if $k eq 'vmstate';
5201 next if $k eq 'lock';
5202 next if $k eq 'digest';
5203 next if $k eq 'description';
5204 next if $k =~ m/^unused\d+$/;
5206 $dest->{$k} = $source->{$k};
5210 my $snapshot_apply_config = sub {
5211 my ($conf, $snap) = @_;
5213 # copy snapshot list
5215 snapshots
=> $conf->{snapshots
},
5218 # keep description and list of unused disks
5219 foreach my $k (keys %$conf) {
5220 next if !($k =~ m/^unused\d+$/ || $k eq 'description');
5221 $newconf->{$k} = $conf->{$k};
5224 &$snapshot_copy_config($snap, $newconf);
5229 sub foreach_writable_storage
{
5230 my ($conf, $func) = @_;
5234 foreach my $ds (keys %$conf) {
5235 next if !valid_drivename
($ds);
5237 my $drive = parse_drive
($ds, $conf->{$ds});
5239 next if drive_is_cdrom
($drive);
5241 my $volid = $drive->{file
};
5243 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
5244 $sidhash->{$sid} = $sid if $sid;
5247 foreach my $sid (sort keys %$sidhash) {
5252 my $alloc_vmstate_volid = sub {
5253 my ($storecfg, $vmid, $conf, $snapname) = @_;
5255 # Note: we try to be smart when selecting a $target storage
5259 # search shared storage first
5260 foreach_writable_storage
($conf, sub {
5262 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
5263 return if !$scfg->{shared
};
5265 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage
5269 # now search local storage
5270 foreach_writable_storage
($conf, sub {
5272 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
5273 return if $scfg->{shared
};
5275 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage;
5279 $target = 'local' if !$target;
5281 my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
5282 # we abort live save after $conf->{memory}, so we need at max twice that space
5283 my $size = $conf->{memory
}*2 + $driver_state_size;
5285 my $name = "vm-$vmid-state-$snapname";
5286 my $scfg = PVE
::Storage
::storage_config
($storecfg, $target);
5287 $name .= ".raw" if $scfg->{path
}; # add filename extension for file base storage
5288 my $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $target, $vmid, 'raw', $name, $size*1024);
5293 my $snapshot_prepare = sub {
5294 my ($vmid, $snapname, $save_vmstate, $comment) = @_;
5298 my $updatefn = sub {
5300 my $conf = load_config
($vmid);
5302 die "you can't take a snapshot if it's a template\n"
5303 if is_template
($conf);
5307 $conf->{lock} = 'snapshot';
5309 die "snapshot name '$snapname' already used\n"
5310 if defined($conf->{snapshots
}->{$snapname});
5312 my $storecfg = PVE
::Storage
::config
();
5313 die "snapshot feature is not available" if !has_feature
('snapshot', $conf, $storecfg);
5315 $snap = $conf->{snapshots
}->{$snapname} = {};
5317 if ($save_vmstate && check_running
($vmid)) {
5318 $snap->{vmstate
} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
5321 &$snapshot_copy_config($conf, $snap);
5323 $snap->{snapstate
} = "prepare";
5324 $snap->{snaptime
} = time();
5325 $snap->{description
} = $comment if $comment;
5327 # always overwrite machine if we save vmstate. This makes sure we
5328 # can restore it later using correct machine type
5329 $snap->{machine
} = get_current_qemu_machine
($vmid) if $snap->{vmstate
};
5331 update_config_nolock
($vmid, $conf, 1);
5334 lock_config
($vmid, $updatefn);
5339 my $snapshot_commit = sub {
5340 my ($vmid, $snapname) = @_;
5342 my $updatefn = sub {
5344 my $conf = load_config
($vmid);
5346 die "missing snapshot lock\n"
5347 if !($conf->{lock} && $conf->{lock} eq 'snapshot');
5349 my $has_machine_config = defined($conf->{machine
});
5351 my $snap = $conf->{snapshots
}->{$snapname};
5353 die "snapshot '$snapname' does not exist\n" if !defined($snap);
5355 die "wrong snapshot state\n"
5356 if !($snap->{snapstate
} && $snap->{snapstate
} eq "prepare");
5358 delete $snap->{snapstate
};
5359 delete $conf->{lock};
5361 my $newconf = &$snapshot_apply_config($conf, $snap);
5363 delete $newconf->{machine
} if !$has_machine_config;
5365 $newconf->{parent
} = $snapname;
5367 update_config_nolock
($vmid, $newconf, 1);
5370 lock_config
($vmid, $updatefn);
5373 sub snapshot_rollback
{
5374 my ($vmid, $snapname) = @_;
5380 my $storecfg = PVE
::Storage
::config
();
5382 my $updatefn = sub {
5384 my $conf = load_config
($vmid);
5386 die "you can't rollback if vm is a template\n" if is_template
($conf);
5388 $snap = $conf->{snapshots
}->{$snapname};
5390 die "snapshot '$snapname' does not exist\n" if !defined($snap);
5392 die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
5393 if $snap->{snapstate
};
5397 vm_stop
($storecfg, $vmid, undef, undef, 5, undef, undef);
5400 die "unable to rollback vm $vmid: vm is running\n"
5401 if check_running
($vmid);
5404 $conf->{lock} = 'rollback';
5406 die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
5407 delete $conf->{lock};
5413 my $has_machine_config = defined($conf->{machine
});
5415 # copy snapshot config to current config
5416 $conf = &$snapshot_apply_config($conf, $snap);
5417 $conf->{parent
} = $snapname;
5419 # Note: old code did not store 'machine', so we try to be smart
5420 # and guess the snapshot was generated with kvm 1.4 (pc-i440fx-1.4).
5421 $forcemachine = $conf->{machine
} || 'pc-i440fx-1.4';
5422 # we remove the 'machine' configuration if not explicitly specified
5423 # in the original config.
5424 delete $conf->{machine
} if $snap->{vmstate
} && !$has_machine_config;
5427 update_config_nolock
($vmid, $conf, 1);
5429 if (!$prepare && $snap->{vmstate
}) {
5430 my $statefile = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
5431 vm_start
($storecfg, $vmid, $statefile, undef, undef, undef, $forcemachine);
5435 lock_config
($vmid, $updatefn);
5437 foreach_drive
($snap, sub {
5438 my ($ds, $drive) = @_;
5440 return if drive_is_cdrom
($drive);
5442 my $volid = $drive->{file
};
5443 my $device = "drive-$ds";
5445 PVE
::Storage
::volume_snapshot_rollback
($storecfg, $volid, $snapname);
5449 lock_config
($vmid, $updatefn);
5452 my $savevm_wait = sub {
5456 my $stat = vm_mon_cmd_nocheck
($vmid, "query-savevm");
5457 if (!$stat->{status
}) {
5458 die "savevm not active\n";
5459 } elsif ($stat->{status
} eq 'active') {
5462 } elsif ($stat->{status
} eq 'completed') {
5465 die "query-savevm returned status '$stat->{status}'\n";
5470 sub snapshot_create
{
5471 my ($vmid, $snapname, $save_vmstate, $comment) = @_;
5473 my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
5475 $save_vmstate = 0 if !$snap->{vmstate
}; # vm is not running
5477 my $config = load_config
($vmid);
5479 my $running = check_running
($vmid);
5481 my $freezefs = $running && $config->{agent
};
5482 $freezefs = 0 if $snap->{vmstate
}; # not needed if we save RAM
5487 eval { vm_mon_cmd
($vmid, "guest-fsfreeze-freeze"); };
5488 warn "guest-fsfreeze-freeze problems - $@" if $@;
5492 # create internal snapshots of all drives
5494 my $storecfg = PVE
::Storage
::config
();
5497 if ($snap->{vmstate
}) {
5498 my $path = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
5499 vm_mon_cmd
($vmid, "savevm-start", statefile
=> $path);
5500 &$savevm_wait($vmid);
5502 vm_mon_cmd
($vmid, "savevm-start");
5506 foreach_drive
($snap, sub {
5507 my ($ds, $drive) = @_;
5509 return if drive_is_cdrom
($drive);
5511 my $volid = $drive->{file
};
5512 my $device = "drive-$ds";
5514 qemu_volume_snapshot
($vmid, $device, $storecfg, $volid, $snapname);
5515 $drivehash->{$ds} = 1;
5521 eval { vm_mon_cmd
($vmid, "savevm-end") };
5525 eval { vm_mon_cmd
($vmid, "guest-fsfreeze-thaw"); };
5526 warn "guest-fsfreeze-thaw problems - $@" if $@;
5529 # savevm-end is async, we need to wait
5531 my $stat = vm_mon_cmd_nocheck
($vmid, "query-savevm");
5532 if (!$stat->{bytes
}) {
5535 print "savevm not yet finished\n";
5543 warn "snapshot create failed: starting cleanup\n";
5544 eval { snapshot_delete
($vmid, $snapname, 0, $drivehash); };
5549 &$snapshot_commit($vmid, $snapname);
5552 # Note: $drivehash is only set when called from snapshot_create.
5553 sub snapshot_delete
{
5554 my ($vmid, $snapname, $force, $drivehash) = @_;
5561 my $unlink_parent = sub {
5562 my ($confref, $new_parent) = @_;
5564 if ($confref->{parent
} && $confref->{parent
} eq $snapname) {
5566 $confref->{parent
} = $new_parent;
5568 delete $confref->{parent
};
5573 my $updatefn = sub {
5574 my ($remove_drive) = @_;
5576 my $conf = load_config
($vmid);
5580 die "you can't delete a snapshot if vm is a template\n"
5581 if is_template
($conf);
5584 $snap = $conf->{snapshots
}->{$snapname};
5586 die "snapshot '$snapname' does not exist\n" if !defined($snap);
5588 # remove parent refs
5590 &$unlink_parent($conf, $snap->{parent
});
5591 foreach my $sn (keys %{$conf->{snapshots
}}) {
5592 next if $sn eq $snapname;
5593 &$unlink_parent($conf->{snapshots
}->{$sn}, $snap->{parent
});
5597 if ($remove_drive) {
5598 if ($remove_drive eq 'vmstate') {
5599 delete $snap->{$remove_drive};
5601 my $drive = parse_drive
($remove_drive, $snap->{$remove_drive});
5602 my $volid = $drive->{file
};
5603 delete $snap->{$remove_drive};
5604 add_unused_volume
($conf, $volid);
5609 $snap->{snapstate
} = 'delete';
5611 delete $conf->{snapshots
}->{$snapname};
5612 delete $conf->{lock} if $drivehash;
5613 foreach my $volid (@$unused) {
5614 add_unused_volume
($conf, $volid);
5618 update_config_nolock
($vmid, $conf, 1);
5621 lock_config
($vmid, $updatefn);
5623 # now remove vmstate file
5625 my $storecfg = PVE
::Storage
::config
();
5627 if ($snap->{vmstate
}) {
5628 eval { PVE
::Storage
::vdisk_free
($storecfg, $snap->{vmstate
}); };
5630 die $err if !$force;
5633 # save changes (remove vmstate from snapshot)
5634 lock_config
($vmid, $updatefn, 'vmstate') if !$force;
5637 # now remove all internal snapshots
5638 foreach_drive
($snap, sub {
5639 my ($ds, $drive) = @_;
5641 return if drive_is_cdrom
($drive);
5643 my $volid = $drive->{file
};
5644 my $device = "drive-$ds";
5646 if (!$drivehash || $drivehash->{$ds}) {
5647 eval { qemu_volume_snapshot_delete
($vmid, $device, $storecfg, $volid, $snapname); };
5649 die $err if !$force;
5654 # save changes (remove drive fron snapshot)
5655 lock_config
($vmid, $updatefn, $ds) if !$force;
5656 push @$unused, $volid;
5659 # now cleanup config
5661 lock_config
($vmid, $updatefn);
5665 my ($feature, $conf, $storecfg, $snapname, $running) = @_;
5668 foreach_drive
($conf, sub {
5669 my ($ds, $drive) = @_;
5671 return if drive_is_cdrom
($drive);
5672 my $volid = $drive->{file
};
5673 $err = 1 if !PVE
::Storage
::volume_has_feature
($storecfg, $feature, $volid, $snapname, $running);
5676 return $err ?
0 : 1;
5679 sub template_create
{
5680 my ($vmid, $conf, $disk) = @_;
5682 my $storecfg = PVE
::Storage
::config
();
5684 foreach_drive
($conf, sub {
5685 my ($ds, $drive) = @_;
5687 return if drive_is_cdrom
($drive);
5688 return if $disk && $ds ne $disk;
5690 my $volid = $drive->{file
};
5691 return if !PVE
::Storage
::volume_has_feature
($storecfg, 'template', $volid);
5693 my $voliddst = PVE
::Storage
::vdisk_create_base
($storecfg, $volid);
5694 $drive->{file
} = $voliddst;
5695 $conf->{$ds} = print_drive
($vmid, $drive);
5696 update_config_nolock
($vmid, $conf, 1);
5703 return 1 if defined $conf->{template
} && $conf->{template
} == 1;
5706 sub qemu_img_convert
{
5707 my ($src_volid, $dst_volid, $size, $snapname) = @_;
5709 my $storecfg = PVE
::Storage
::config
();
5710 my ($src_storeid, $src_volname) = PVE
::Storage
::parse_volume_id
($src_volid, 1);
5711 my ($dst_storeid, $dst_volname) = PVE
::Storage
::parse_volume_id
($dst_volid, 1);
5713 if ($src_storeid && $dst_storeid) {
5714 my $src_scfg = PVE
::Storage
::storage_config
($storecfg, $src_storeid);
5715 my $dst_scfg = PVE
::Storage
::storage_config
($storecfg, $dst_storeid);
5717 my $src_format = qemu_img_format
($src_scfg, $src_volname);
5718 my $dst_format = qemu_img_format
($dst_scfg, $dst_volname);
5720 my $src_path = PVE
::Storage
::path
($storecfg, $src_volid, $snapname);
5721 my $dst_path = PVE
::Storage
::path
($storecfg, $dst_volid);
5724 push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-n';
5725 push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
5726 push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
5730 if($line =~ m/\((\S+)\/100\
%\)/){
5732 my $transferred = int($size * $percent / 100);
5733 my $remaining = $size - $transferred;
5735 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
5740 eval { run_command
($cmd, timeout
=> undef, outfunc
=> $parser); };
5742 die "copy failed: $err" if $err;
5746 sub qemu_img_format
{
5747 my ($scfg, $volname) = @_;
5749 if ($scfg->{path
} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/) {
5751 } elsif ($scfg->{type
} eq 'iscsi') {
5752 return "host_device";
5758 sub qemu_drive_mirror
{
5759 my ($vmid, $drive, $dst_volid, $vmiddst) = @_;
5766 my $storecfg = PVE
::Storage
::config
();
5767 my ($dst_storeid, $dst_volname) = PVE
::Storage
::parse_volume_id
($dst_volid);
5769 my $dst_scfg = PVE
::Storage
::storage_config
($storecfg, $dst_storeid);
5772 if ($dst_volname =~ m/\.(raw|qcow2)$/){
5776 my $dst_path = PVE
::Storage
::path
($storecfg, $dst_volid);
5778 my $opts = { timeout
=> 10, device
=> "drive-$drive", mode
=> "existing", sync
=> "full", target
=> $dst_path };
5779 $opts->{format
} = $format if $format;
5781 #fixme : sometime drive-mirror timeout, but works fine after.
5782 # (I have see the problem with big volume > 200GB), so we need to eval
5783 eval { vm_mon_cmd
($vmid, "drive-mirror", %$opts); };
5784 # ignore errors here
5788 my $stats = vm_mon_cmd
($vmid, "query-block-jobs");
5789 my $stat = @$stats[0];
5790 die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
5791 die "error job is not mirroring" if $stat->{type
} ne "mirror";
5793 my $busy = $stat->{busy
};
5795 if (my $total = $stat->{len
}) {
5796 my $transferred = $stat->{offset
} || 0;
5797 my $remaining = $total - $transferred;
5798 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
5800 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent % busy: $busy\n";
5803 if ($stat->{len
} == $stat->{offset
}) {
5804 if ($busy eq 'false') {
5806 last if $vmiddst != $vmid;
5808 # try to switch the disk if source and destination are on the same guest
5809 eval { vm_mon_cmd
($vmid, "block-job-complete", device
=> "drive-$drive") };
5811 die $@ if $@ !~ m/cannot be completed/;
5814 if ($count > $maxwait) {
5815 # if too much writes to disk occurs at the end of migration
5816 #the disk needs to be freezed to be able to complete the migration
5817 vm_suspend
($vmid,1);
5822 $old_len = $stat->{offset
};
5826 vm_resume
($vmid, 1) if $frozen;
5831 my $cancel_job = sub {
5832 vm_mon_cmd
($vmid, "block-job-cancel", device
=> "drive-$drive");
5834 my $stats = vm_mon_cmd
($vmid, "query-block-jobs");
5835 my $stat = @$stats[0];
5842 eval { &$cancel_job(); };
5843 die "mirroring error: $err";
5846 if ($vmiddst != $vmid) {
5847 # if we clone a disk for a new target vm, we don't switch the disk
5848 &$cancel_job(); # so we call block-job-cancel
5853 my ($storecfg, $vmid, $running, $drivename, $drive, $snapname,
5854 $newvmid, $storage, $format, $full, $newvollist) = @_;
5859 print "create linked clone of drive $drivename ($drive->{file})\n";
5860 $newvolid = PVE
::Storage
::vdisk_clone
($storecfg, $drive->{file
}, $newvmid, $snapname);
5861 push @$newvollist, $newvolid;
5863 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($drive->{file
});
5864 $storeid = $storage if $storage;
5866 my ($defFormat, $validFormats) = PVE
::Storage
::storage_default_format
($storecfg, $storeid);
5868 $format = $drive->{format
} || $defFormat;
5871 # test if requested format is supported - else use default
5872 my $supported = grep { $_ eq $format } @$validFormats;
5873 $format = $defFormat if !$supported;
5875 my ($size) = PVE
::Storage
::volume_size_info
($storecfg, $drive->{file
}, 3);
5877 print "create full clone of drive $drivename ($drive->{file})\n";
5878 $newvolid = PVE
::Storage
::vdisk_alloc
($storecfg, $storeid, $newvmid, $format, undef, ($size/1024));
5879 push @$newvollist, $newvolid;
5881 if (!$running || $snapname) {
5882 qemu_img_convert
($drive->{file
}, $newvolid, $size, $snapname);
5884 qemu_drive_mirror
($vmid, $drivename, $newvolid, $newvmid);
5888 my ($size) = PVE
::Storage
::volume_size_info
($storecfg, $newvolid, 3);
5891 $disk->{format
} = undef;
5892 $disk->{file
} = $newvolid;
5893 $disk->{size
} = $size;
5898 # this only works if VM is running
5899 sub get_current_qemu_machine
{
5902 my $cmd = { execute
=> 'query-machines', arguments
=> {} };
5903 my $res = vm_qmp_command
($vmid, $cmd);
5905 my ($current, $default);
5906 foreach my $e (@$res) {
5907 $default = $e->{name
} if $e->{'is-default'};
5908 $current = $e->{name
} if $e->{'is-current'};
5911 # fallback to the default machine if current is not supported by qemu
5912 return $current || $default || 'pc';
5919 dir_glob_foreach
("$pcisysfs/devices", '[a-f0-9]{4}:([a-f0-9]{2}:[a-f0-9]{2})\.([0-9])', sub {
5920 my (undef, $id, $function) = @_;
5921 my $res = { id
=> $id, function
=> $function};
5922 push @{$devices->{$id}}, $res;