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 'e1000-82540em', 'e1000-82544gc', 'e1000-82545em'];
509 my $nic_model_list_txt = join(' ', sort @$nic_model_list);
513 type
=> 'string', format
=> 'pve-qm-net',
514 typetext
=> "MODEL=XX:XX:XX:XX:XX:XX [,bridge=<dev>][,queues=<nbqueues>][,rate=<mbps>][,tag=<vlanid>][,firewall=0|1]",
515 description
=> <<EODESCR,
516 Specify network devices.
518 MODEL is one of: $nic_model_list_txt
520 XX:XX:XX:XX:XX:XX should be an unique MAC address. This is
521 automatically generated if not specified.
523 The bridge parameter can be used to automatically add the interface to a bridge device. The Proxmox VE standard bridge is called 'vmbr0'.
525 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'.
527 If you specify no bridge, we create a kvm 'user' (NATed) network device, which provides DHCP and DNS services. The following addresses are used:
533 The DHCP server assign addresses to the guest starting from 10.0.2.15.
537 PVE
::JSONSchema
::register_standard_option
("pve-qm-net", $netdesc);
539 for (my $i = 0; $i < $MAX_NETS; $i++) {
540 $confdesc->{"net$i"} = $netdesc;
547 type
=> 'string', format
=> 'pve-qm-drive',
548 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]',
549 description
=> "Use volume as IDE hard disk or CD-ROM (n is 0 to " .($MAX_IDE_DISKS -1) . ").",
551 PVE
::JSONSchema
::register_standard_option
("pve-qm-ide", $idedesc);
555 type
=> 'string', format
=> 'pve-qm-drive',
556 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]',
557 description
=> "Use volume as SCSI hard disk or CD-ROM (n is 0 to " . ($MAX_SCSI_DISKS - 1) . ").",
559 PVE
::JSONSchema
::register_standard_option
("pve-qm-scsi", $scsidesc);
563 type
=> 'string', format
=> 'pve-qm-drive',
564 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]',
565 description
=> "Use volume as SATA hard disk or CD-ROM (n is 0 to " . ($MAX_SATA_DISKS - 1). ").",
567 PVE
::JSONSchema
::register_standard_option
("pve-qm-sata", $satadesc);
571 type
=> 'string', format
=> 'pve-qm-drive',
572 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]',
573 description
=> "Use volume as VIRTIO hard disk (n is 0 to " . ($MAX_VIRTIO_DISKS - 1) . ").",
575 PVE
::JSONSchema
::register_standard_option
("pve-qm-virtio", $virtiodesc);
579 type
=> 'string', format
=> 'pve-qm-usb-device',
580 typetext
=> 'host=HOSTUSBDEVICE|spice',
581 description
=> <<EODESCR,
582 Configure an USB device (n is 0 to 4). This can be used to
583 pass-through usb devices to the guest. HOSTUSBDEVICE syntax is:
585 'bus-port(.port)*' (decimal numbers) or
586 'vendor_id:product_id' (hexadeciaml numbers)
588 You can use the 'lsusb -t' command to list existing usb devices.
590 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
592 The value 'spice' can be used to add a usb redirection devices for spice.
596 PVE
::JSONSchema
::register_standard_option
("pve-qm-usb", $usbdesc);
600 type
=> 'string', format
=> 'pve-qm-hostpci',
601 typetext
=> "[host=]HOSTPCIDEVICE [,driver=kvm|vfio] [,rombar=on|off] [,pcie=0|1] [,x-vga=on|off]",
602 description
=> <<EODESCR,
603 Map host pci devices. HOSTPCIDEVICE syntax is:
605 'bus:dev.func' (hexadecimal numbers)
607 You can us the 'lspci' command to list existing pci devices.
609 The 'rombar' option determines whether or not the device's ROM will be visible in the guest's memory map (default is 'on').
611 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
613 Experimental: user reported problems with this option.
616 PVE
::JSONSchema
::register_standard_option
("pve-qm-hostpci", $hostpcidesc);
621 pattern
=> '(/dev/.+|socket)',
622 description
=> <<EODESCR,
623 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).
625 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
627 Experimental: user reported problems with this option.
634 pattern
=> '/dev/parport\d+|/dev/usb/lp\d+',
635 description
=> <<EODESCR,
636 Map host parallel devices (n is 0 to 2).
638 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
640 Experimental: user reported problems with this option.
644 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
645 $confdesc->{"parallel$i"} = $paralleldesc;
648 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
649 $confdesc->{"serial$i"} = $serialdesc;
652 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
653 $confdesc->{"hostpci$i"} = $hostpcidesc;
656 for (my $i = 0; $i < $MAX_IDE_DISKS; $i++) {
657 $drivename_hash->{"ide$i"} = 1;
658 $confdesc->{"ide$i"} = $idedesc;
661 for (my $i = 0; $i < $MAX_SATA_DISKS; $i++) {
662 $drivename_hash->{"sata$i"} = 1;
663 $confdesc->{"sata$i"} = $satadesc;
666 for (my $i = 0; $i < $MAX_SCSI_DISKS; $i++) {
667 $drivename_hash->{"scsi$i"} = 1;
668 $confdesc->{"scsi$i"} = $scsidesc ;
671 for (my $i = 0; $i < $MAX_VIRTIO_DISKS; $i++) {
672 $drivename_hash->{"virtio$i"} = 1;
673 $confdesc->{"virtio$i"} = $virtiodesc;
676 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
677 $confdesc->{"usb$i"} = $usbdesc;
682 type
=> 'string', format
=> 'pve-volume-id',
683 description
=> "Reference to unused volumes.",
686 for (my $i = 0; $i < $MAX_UNUSED_DISKS; $i++) {
687 $confdesc->{"unused$i"} = $unuseddesc;
690 my $kvm_api_version = 0;
694 return $kvm_api_version if $kvm_api_version;
696 my $fh = IO
::File-
>new("</dev/kvm") ||
699 if (my $v = $fh->ioctl(KVM_GET_API_VERSION
(), 0)) {
700 $kvm_api_version = $v;
705 return $kvm_api_version;
708 my $kvm_user_version;
710 sub kvm_user_version
{
712 return $kvm_user_version if $kvm_user_version;
714 $kvm_user_version = 'unknown';
716 my $tmp = `kvm -help 2>/dev/null`;
718 if ($tmp =~ m/^QEMU( PC)? emulator version (\d+\.\d+(\.\d+)?)[,\s]/) {
719 $kvm_user_version = $2;
722 return $kvm_user_version;
726 my $kernel_has_vhost_net = -c
'/dev/vhost-net';
729 # order is important - used to autoselect boot disk
730 return ((map { "ide$_" } (0 .. ($MAX_IDE_DISKS - 1))),
731 (map { "scsi$_" } (0 .. ($MAX_SCSI_DISKS - 1))),
732 (map { "virtio$_" } (0 .. ($MAX_VIRTIO_DISKS - 1))),
733 (map { "sata$_" } (0 .. ($MAX_SATA_DISKS - 1))));
736 sub valid_drivename
{
739 return defined($drivename_hash->{$dev});
744 return defined($confdesc->{$key});
748 return $nic_model_list;
751 sub os_list_description
{
756 w2k
=> 'Windows 2000',
757 w2k3
=>, 'Windows 2003',
758 w2k8
=> 'Windows 2008',
759 wvista
=> 'Windows Vista',
761 win8
=> 'Windows 8/2012',
771 return $cdrom_path if $cdrom_path;
773 return $cdrom_path = "/dev/cdrom" if -l
"/dev/cdrom";
774 return $cdrom_path = "/dev/cdrom1" if -l
"/dev/cdrom1";
775 return $cdrom_path = "/dev/cdrom2" if -l
"/dev/cdrom2";
779 my ($storecfg, $vmid, $cdrom) = @_;
781 if ($cdrom eq 'cdrom') {
782 return get_cdrom_path
();
783 } elsif ($cdrom eq 'none') {
785 } elsif ($cdrom =~ m
|^/|) {
788 return PVE
::Storage
::path
($storecfg, $cdrom);
792 # try to convert old style file names to volume IDs
793 sub filename_to_volume_id
{
794 my ($vmid, $file, $media) = @_;
796 if (!($file eq 'none' || $file eq 'cdrom' ||
797 $file =~ m
|^/dev/.+| || $file =~ m/^([^:]+):(.+)$/)) {
799 return undef if $file =~ m
|/|;
801 if ($media && $media eq 'cdrom') {
802 $file = "local:iso/$file";
804 $file = "local:$vmid/$file";
811 sub verify_media_type
{
812 my ($opt, $vtype, $media) = @_;
817 if ($media eq 'disk') {
819 } elsif ($media eq 'cdrom') {
822 die "internal error";
825 return if ($vtype eq $etype);
827 raise_param_exc
({ $opt => "unexpected media type ($vtype != $etype)" });
830 sub cleanup_drive_path
{
831 my ($opt, $storecfg, $drive) = @_;
833 # try to convert filesystem paths to volume IDs
835 if (($drive->{file
} !~ m/^(cdrom|none)$/) &&
836 ($drive->{file
} !~ m
|^/dev/.+|) &&
837 ($drive->{file
} !~ m/^([^:]+):(.+)$/) &&
838 ($drive->{file
} !~ m/^\d+$/)) {
839 my ($vtype, $volid) = PVE
::Storage
::path_to_volume_id
($storecfg, $drive->{file
});
840 raise_param_exc
({ $opt => "unable to associate path '$drive->{file}' to any storage"}) if !$vtype;
841 $drive->{media
} = 'cdrom' if !$drive->{media
} && $vtype eq 'iso';
842 verify_media_type
($opt, $vtype, $drive->{media
});
843 $drive->{file
} = $volid;
846 $drive->{media
} = 'cdrom' if !$drive->{media
} && $drive->{file
} =~ m/^(cdrom|none)$/;
849 sub create_conf_nolock
{
850 my ($vmid, $settings) = @_;
852 my $filename = config_file
($vmid);
854 die "configuration file '$filename' already exists\n" if -f
$filename;
856 my $defaults = load_defaults
();
858 $settings->{name
} = "vm$vmid" if !$settings->{name
};
859 $settings->{memory
} = $defaults->{memory
} if !$settings->{memory
};
862 foreach my $opt (keys %$settings) {
863 next if !$confdesc->{$opt};
865 my $value = $settings->{$opt};
868 $data .= "$opt: $value\n";
871 PVE
::Tools
::file_set_contents
($filename, $data);
874 my $parse_size = sub {
877 return undef if $value !~ m/^(\d+(\.\d+)?)([KMG])?$/;
878 my ($size, $unit) = ($1, $3);
881 $size = $size * 1024;
882 } elsif ($unit eq 'M') {
883 $size = $size * 1024 * 1024;
884 } elsif ($unit eq 'G') {
885 $size = $size * 1024 * 1024 * 1024;
891 my $format_size = sub {
896 my $kb = int($size/1024);
897 return $size if $kb*1024 != $size;
899 my $mb = int($kb/1024);
900 return "${kb}K" if $mb*1024 != $kb;
902 my $gb = int($mb/1024);
903 return "${mb}M" if $gb*1024 != $mb;
908 # ideX = [volume=]volume-id[,media=d][,cyls=c,heads=h,secs=s[,trans=t]]
909 # [,snapshot=on|off][,cache=on|off][,format=f][,backup=yes|no]
910 # [,rerror=ignore|report|stop][,werror=enospc|ignore|report|stop]
911 # [,aio=native|threads][,discard=ignore|on]
914 my ($key, $data) = @_;
918 # $key may be undefined - used to verify JSON parameters
919 if (!defined($key)) {
920 $res->{interface
} = 'unknown'; # should not harm when used to verify parameters
922 } elsif ($key =~ m/^([^\d]+)(\d+)$/) {
923 $res->{interface
} = $1;
929 foreach my $p (split (/,/, $data)) {
930 next if $p =~ m/^\s*$/;
932 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)=(.+)$/) {
933 my ($k, $v) = ($1, $2);
935 $k = 'file' if $k eq 'volume';
937 return undef if defined $res->{$k};
939 if ($k eq 'bps' || $k eq 'bps_rd' || $k eq 'bps_wr') {
940 return undef if !$v || $v !~ m/^\d+/;
942 $v = sprintf("%.3f", $v / (1024*1024));
946 if (!$res->{file
} && $p !~ m/=/) {
954 return undef if !$res->{file
};
956 if($res->{file
} =~ m/\.(raw|cow|qcow|qcow2|vmdk|cloop)$/){
960 return undef if $res->{cache
} &&
961 $res->{cache
} !~ m/^(off|none|writethrough|writeback|unsafe|directsync)$/;
962 return undef if $res->{snapshot
} && $res->{snapshot
} !~ m/^(on|off)$/;
963 return undef if $res->{cyls
} && $res->{cyls
} !~ m/^\d+$/;
964 return undef if $res->{heads
} && $res->{heads
} !~ m/^\d+$/;
965 return undef if $res->{secs
} && $res->{secs
} !~ m/^\d+$/;
966 return undef if $res->{media
} && $res->{media
} !~ m/^(disk|cdrom)$/;
967 return undef if $res->{trans
} && $res->{trans
} !~ m/^(none|lba|auto)$/;
968 return undef if $res->{format
} && $res->{format
} !~ m/^(raw|cow|qcow|qcow2|vmdk|cloop)$/;
969 return undef if $res->{rerror
} && $res->{rerror
} !~ m/^(ignore|report|stop)$/;
970 return undef if $res->{werror
} && $res->{werror
} !~ m/^(enospc|ignore|report|stop)$/;
971 return undef if $res->{backup
} && $res->{backup
} !~ m/^(yes|no)$/;
972 return undef if $res->{aio
} && $res->{aio
} !~ m/^(native|threads)$/;
973 return undef if $res->{discard
} && $res->{discard
} !~ m/^(ignore|on)$/;
975 return undef if $res->{mbps_rd
} && $res->{mbps
};
976 return undef if $res->{mbps_wr
} && $res->{mbps
};
978 return undef if $res->{mbps
} && $res->{mbps
} !~ m/^\d+(\.\d+)?$/;
979 return undef if $res->{mbps_max
} && $res->{mbps_max
} !~ m/^\d+(\.\d+)?$/;
980 return undef if $res->{mbps_rd
} && $res->{mbps_rd
} !~ m/^\d+(\.\d+)?$/;
981 return undef if $res->{mbps_rd_max
} && $res->{mbps_rd_max
} !~ m/^\d+(\.\d+)?$/;
982 return undef if $res->{mbps_wr
} && $res->{mbps_wr
} !~ m/^\d+(\.\d+)?$/;
983 return undef if $res->{mbps_wr_max
} && $res->{mbps_wr_max
} !~ m/^\d+(\.\d+)?$/;
985 return undef if $res->{iops_rd
} && $res->{iops
};
986 return undef if $res->{iops_wr
} && $res->{iops
};
989 return undef if $res->{iops
} && $res->{iops
} !~ m/^\d+$/;
990 return undef if $res->{iops_max
} && $res->{iops_max
} !~ m/^\d+$/;
991 return undef if $res->{iops_rd
} && $res->{iops_rd
} !~ m/^\d+$/;
992 return undef if $res->{iops_rd_max
} && $res->{iops_rd_max
} !~ m/^\d+$/;
993 return undef if $res->{iops_wr
} && $res->{iops_wr
} !~ m/^\d+$/;
994 return undef if $res->{iops_wr_max
} && $res->{iops_wr_max
} !~ m/^\d+$/;
998 return undef if !defined($res->{size
} = &$parse_size($res->{size
}));
1001 if ($res->{media
} && ($res->{media
} eq 'cdrom')) {
1002 return undef if $res->{snapshot
} || $res->{trans
} || $res->{format
};
1003 return undef if $res->{heads
} || $res->{secs
} || $res->{cyls
};
1004 return undef if $res->{interface
} eq 'virtio';
1007 # rerror does not work with scsi drives
1008 if ($res->{rerror
}) {
1009 return undef if $res->{interface
} eq 'scsi';
1015 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);
1018 my ($vmid, $drive) = @_;
1021 foreach my $o (@qemu_drive_options, 'mbps', 'mbps_rd', 'mbps_wr', 'mbps_max', 'mbps_rd_max', 'mbps_wr_max', 'backup') {
1022 $opts .= ",$o=$drive->{$o}" if $drive->{$o};
1025 if ($drive->{size
}) {
1026 $opts .= ",size=" . &$format_size($drive->{size
});
1029 return "$drive->{file}$opts";
1033 my($fh, $noerr) = @_;
1036 my $SG_GET_VERSION_NUM = 0x2282;
1038 my $versionbuf = "\x00" x
8;
1039 my $ret = ioctl($fh, $SG_GET_VERSION_NUM, $versionbuf);
1041 die "scsi ioctl SG_GET_VERSION_NUM failoed - $!\n" if !$noerr;
1044 my $version = unpack("I", $versionbuf);
1045 if ($version < 30000) {
1046 die "scsi generic interface too old\n" if !$noerr;
1050 my $buf = "\x00" x
36;
1051 my $sensebuf = "\x00" x
8;
1052 my $cmd = pack("C x3 C x1", 0x12, 36);
1054 # see /usr/include/scsi/sg.h
1055 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";
1057 my $packet = pack($sg_io_hdr_t, ord('S'), -3, length($cmd),
1058 length($sensebuf), 0, length($buf), $buf,
1059 $cmd, $sensebuf, 6000);
1061 $ret = ioctl($fh, $SG_IO, $packet);
1063 die "scsi ioctl SG_IO failed - $!\n" if !$noerr;
1067 my @res = unpack($sg_io_hdr_t, $packet);
1068 if ($res[17] || $res[18]) {
1069 die "scsi ioctl SG_IO status error - $!\n" if !$noerr;
1074 (my $byte0, my $byte1, $res->{vendor
},
1075 $res->{product
}, $res->{revision
}) = unpack("C C x6 A8 A16 A4", $buf);
1077 $res->{removable
} = $byte1 & 128 ?
1 : 0;
1078 $res->{type
} = $byte0 & 31;
1086 my $fh = IO
::File-
>new("+<$path") || return undef;
1087 my $res = scsi_inquiry
($fh, 1);
1093 sub machine_type_is_q35
{
1096 return $conf->{machine
} && ($conf->{machine
} =~ m/q35/) ?
1 : 0;
1099 sub print_tabletdevice_full
{
1102 my $q35 = machine_type_is_q35
($conf);
1104 # we use uhci for old VMs because tablet driver was buggy in older qemu
1105 my $usbbus = $q35 ?
"ehci" : "uhci";
1107 return "usb-tablet,id=tablet,bus=$usbbus.0,port=1";
1110 sub print_drivedevice_full
{
1111 my ($storecfg, $conf, $vmid, $drive, $bridges) = @_;
1116 if ($drive->{interface
} eq 'virtio') {
1117 my $pciaddr = print_pci_addr
("$drive->{interface}$drive->{index}", $bridges);
1118 $device = "virtio-blk-pci,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}$pciaddr";
1119 $device .= ",iothread=iothread0" if $conf->{iothread
};
1120 } elsif ($drive->{interface
} eq 'scsi') {
1121 $maxdev = ($conf->{scsihw
} && ($conf->{scsihw
} !~ m/^lsi/)) ?
256 : 7;
1122 my $controller = int($drive->{index} / $maxdev);
1123 my $unit = $drive->{index} % $maxdev;
1124 my $devicetype = 'hd';
1126 if (drive_is_cdrom
($drive)) {
1129 if ($drive->{file
} =~ m
|^/|) {
1130 $path = $drive->{file
};
1132 $path = PVE
::Storage
::path
($storecfg, $drive->{file
});
1135 if($path =~ m/^iscsi\:\/\
//){
1136 $devicetype = 'generic';
1138 if (my $info = path_is_scsi
($path)) {
1139 if ($info->{type
} == 0) {
1140 $devicetype = 'block';
1141 } elsif ($info->{type
} == 1) { # tape
1142 $devicetype = 'generic';
1148 if (!$conf->{scsihw
} || ($conf->{scsihw
} =~ m/^lsi/)){
1149 $device = "scsi-$devicetype,bus=scsihw$controller.0,scsi-id=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1151 $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}";
1154 } elsif ($drive->{interface
} eq 'ide'){
1156 my $controller = int($drive->{index} / $maxdev);
1157 my $unit = $drive->{index} % $maxdev;
1158 my $devicetype = ($drive->{media
} && $drive->{media
} eq 'cdrom') ?
"cd" : "hd";
1160 $device = "ide-$devicetype,bus=ide.$controller,unit=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1161 } elsif ($drive->{interface
} eq 'sata'){
1162 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
1163 my $unit = $drive->{index} % $MAX_SATA_DISKS;
1164 $device = "ide-drive,bus=ahci$controller.$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1165 } elsif ($drive->{interface
} eq 'usb') {
1167 # -device ide-drive,bus=ide.1,unit=0,drive=drive-ide0-1-0,id=ide0-1-0
1169 die "unsupported interface type";
1172 $device .= ",bootindex=$drive->{bootindex}" if $drive->{bootindex
};
1177 sub get_initiator_name
{
1180 my $fh = IO
::File-
>new('/etc/iscsi/initiatorname.iscsi') || return undef;
1181 while (defined(my $line = <$fh>)) {
1182 next if $line !~ m/^\s*InitiatorName\s*=\s*([\.\-:\w]+)/;
1191 sub print_drive_full
{
1192 my ($storecfg, $vmid, $drive) = @_;
1195 foreach my $o (@qemu_drive_options) {
1196 next if $o eq 'bootindex';
1197 $opts .= ",$o=$drive->{$o}" if $drive->{$o};
1200 foreach my $o (qw(bps bps_rd bps_wr)) {
1201 my $v = $drive->{"m$o"};
1202 $opts .= ",$o=" . int($v*1024*1024) if $v;
1205 # use linux-aio by default (qemu default is threads)
1206 $opts .= ",aio=native" if !$drive->{aio
};
1209 my $volid = $drive->{file
};
1210 if (drive_is_cdrom
($drive)) {
1211 $path = get_iso_path
($storecfg, $vmid, $volid);
1213 if ($volid =~ m
|^/|) {
1216 $path = PVE
::Storage
::path
($storecfg, $volid);
1220 $opts .= ",cache=none" if !$drive->{cache
} && !drive_is_cdrom
($drive);
1222 my $detectzeroes = $drive->{discard
} ?
"unmap" : "on";
1223 $opts .= ",detect-zeroes=$detectzeroes" if !drive_is_cdrom
($drive);
1225 my $pathinfo = $path ?
"file=$path," : '';
1227 return "${pathinfo}if=none,id=drive-$drive->{interface}$drive->{index}$opts";
1230 sub print_netdevice_full
{
1231 my ($vmid, $conf, $net, $netid, $bridges) = @_;
1233 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
1235 my $device = $net->{model
};
1236 if ($net->{model
} eq 'virtio') {
1237 $device = 'virtio-net-pci';
1240 my $pciaddr = print_pci_addr
("$netid", $bridges);
1241 my $tmpstr = "$device,mac=$net->{macaddr},netdev=$netid$pciaddr,id=$netid";
1242 if ($net->{queues
} && $net->{queues
} > 1 && $net->{model
} eq 'virtio'){
1243 #Consider we have N queues, the number of vectors needed is 2*N + 2 (plus one config interrupt and control vq)
1244 my $vectors = $net->{queues
} * 2 + 2;
1245 $tmpstr .= ",vectors=$vectors,mq=on";
1247 $tmpstr .= ",bootindex=$net->{bootindex}" if $net->{bootindex
} ;
1251 sub print_netdev_full
{
1252 my ($vmid, $conf, $net, $netid) = @_;
1255 if ($netid =~ m/^net(\d+)$/) {
1259 die "got strange net id '$i'\n" if $i >= ${MAX_NETS
};
1261 my $ifname = "tap${vmid}i$i";
1263 # kvm uses TUNSETIFF ioctl, and that limits ifname length
1264 die "interface name '$ifname' is too long (max 15 character)\n"
1265 if length($ifname) >= 16;
1267 my $vhostparam = '';
1268 $vhostparam = ',vhost=on' if $kernel_has_vhost_net && $net->{model
} eq 'virtio';
1270 my $vmname = $conf->{name
} || "vm$vmid";
1274 if ($net->{bridge
}) {
1275 $netdev = "type=tap,id=$netid,ifname=${ifname},script=/var/lib/qemu-server/pve-bridge,downscript=/var/lib/qemu-server/pve-bridgedown$vhostparam";
1277 $netdev = "type=user,id=$netid,hostname=$vmname";
1280 $netdev .= ",queues=$net->{queues}" if ($net->{queues
} && $net->{model
} eq 'virtio');
1285 sub drive_is_cdrom
{
1288 return $drive && $drive->{media
} && ($drive->{media
} eq 'cdrom');
1297 foreach my $kvp (split(/,/, $data)) {
1299 if ($kvp =~ m/^memory=(\S+)$/) {
1300 $res->{memory
} = $1;
1301 } elsif ($kvp =~ m/^policy=(preferred|bind|interleave)$/) {
1302 $res->{policy
} = $1;
1303 } elsif ($kvp =~ m/^cpus=(\d+)(-(\d+))?$/) {
1304 $res->{cpus
}->{start
} = $1;
1305 $res->{cpus
}->{end
} = $3;
1306 } elsif ($kvp =~ m/^hostnodes=(\d+)(-(\d+))?$/) {
1307 $res->{hostnodes
}->{start
} = $1;
1308 $res->{hostnodes
}->{end
} = $3;
1320 return undef if !$value;
1323 my @list = split(/,/, $value);
1327 foreach my $kv (@list) {
1329 if ($kv =~ m/^(host=)?([a-f0-9]{2}:[a-f0-9]{2})(\.([a-f0-9]))?$/) {
1332 push @{$res->{pciid
}}, { id
=> $2 , function
=> $4};
1335 my $pcidevices = lspci
($2);
1336 $res->{pciid
} = $pcidevices->{$2};
1338 } elsif ($kv =~ m/^driver=(kvm|vfio)$/) {
1339 $res->{driver
} = $1;
1340 } elsif ($kv =~ m/^rombar=(on|off)$/) {
1341 $res->{rombar
} = $1;
1342 } elsif ($kv =~ m/^x-vga=(on|off)$/) {
1343 $res->{'x-vga'} = $1;
1344 } elsif ($kv =~ m/^pcie=(\d+)$/) {
1345 $res->{pcie
} = 1 if $1 == 1;
1347 warn "unknown hostpci setting '$kv'\n";
1351 return undef if !$found;
1356 # netX: e1000=XX:XX:XX:XX:XX:XX,bridge=vmbr0,rate=<mbps>
1362 foreach my $kvp (split(/,/, $data)) {
1364 if ($kvp =~ m/^(ne2k_pci|e1000|e1000-82540em|e1000-82544gc|e1000-82545em|rtl8139|pcnet|virtio|ne2k_isa|i82551|i82557b|i82559er|vmxnet3)(=([0-9a-f]{2}(:[0-9a-f]{2}){5}))?$/i) {
1366 my $mac = defined($3) ?
uc($3) : PVE
::Tools
::random_ether_addr
();
1367 $res->{model
} = $model;
1368 $res->{macaddr
} = $mac;
1369 } elsif ($kvp =~ m/^bridge=(\S+)$/) {
1370 $res->{bridge
} = $1;
1371 } elsif ($kvp =~ m/^queues=(\d+)$/) {
1372 $res->{queues
} = $1;
1373 } elsif ($kvp =~ m/^rate=(\d+(\.\d+)?)$/) {
1375 } elsif ($kvp =~ m/^tag=(\d+)$/) {
1377 } elsif ($kvp =~ m/^firewall=(\d+)$/) {
1378 $res->{firewall
} = $1;
1385 return undef if !$res->{model
};
1393 my $res = "$net->{model}";
1394 $res .= "=$net->{macaddr}" if $net->{macaddr
};
1395 $res .= ",bridge=$net->{bridge}" if $net->{bridge
};
1396 $res .= ",rate=$net->{rate}" if $net->{rate
};
1397 $res .= ",tag=$net->{tag}" if $net->{tag
};
1398 $res .= ",firewall=$net->{firewall}" if $net->{firewall
};
1403 sub add_random_macs
{
1404 my ($settings) = @_;
1406 foreach my $opt (keys %$settings) {
1407 next if $opt !~ m/^net(\d+)$/;
1408 my $net = parse_net
($settings->{$opt});
1410 $settings->{$opt} = print_net
($net);
1414 sub add_unused_volume
{
1415 my ($config, $volid) = @_;
1418 for (my $ind = $MAX_UNUSED_DISKS - 1; $ind >= 0; $ind--) {
1419 my $test = "unused$ind";
1420 if (my $vid = $config->{$test}) {
1421 return if $vid eq $volid; # do not add duplicates
1427 die "To many unused volume - please delete them first.\n" if !$key;
1429 $config->{$key} = $volid;
1434 sub vm_is_volid_owner
{
1435 my ($storecfg, $vmid, $volid) = @_;
1437 if ($volid !~ m
|^/|) {
1439 eval { ($path, $owner) = PVE
::Storage
::path
($storecfg, $volid); };
1440 if ($owner && ($owner == $vmid)) {
1448 sub vmconfig_delete_pending_option
{
1449 my ($conf, $key) = @_;
1451 delete $conf->{pending
}->{$key};
1452 my $pending_delete_hash = { $key => 1 };
1453 foreach my $opt (PVE
::Tools
::split_list
($conf->{pending
}->{delete})) {
1454 $pending_delete_hash->{$opt} = 1;
1456 $conf->{pending
}->{delete} = join(',', keys %$pending_delete_hash);
1459 sub vmconfig_undelete_pending_option
{
1460 my ($conf, $key) = @_;
1462 my $pending_delete_hash = {};
1463 foreach my $opt (PVE
::Tools
::split_list
($conf->{pending
}->{delete})) {
1464 $pending_delete_hash->{$opt} = 1;
1466 delete $pending_delete_hash->{$key};
1468 my @keylist = keys %$pending_delete_hash;
1469 if (scalar(@keylist)) {
1470 $conf->{pending
}->{delete} = join(',', @keylist);
1472 delete $conf->{pending
}->{delete};
1476 sub vmconfig_register_unused_drive
{
1477 my ($storecfg, $vmid, $conf, $drive) = @_;
1479 if (!drive_is_cdrom
($drive)) {
1480 my $volid = $drive->{file
};
1481 if (vm_is_volid_owner
($storecfg, $vmid, $volid)) {
1482 add_unused_volume
($conf, $volid, $vmid);
1487 sub vmconfig_cleanup_pending
{
1490 # remove pending changes when nothing changed
1492 foreach my $opt (keys %{$conf->{pending
}}) {
1493 if (defined($conf->{$opt}) && ($conf->{pending
}->{$opt} eq $conf->{$opt})) {
1495 delete $conf->{pending
}->{$opt};
1499 # remove delete if option is not set
1500 my $pending_delete_hash = {};
1501 foreach my $opt (PVE
::Tools
::split_list
($conf->{pending
}->{delete})) {
1502 if (defined($conf->{$opt})) {
1503 $pending_delete_hash->{$opt} = 1;
1509 my @keylist = keys %$pending_delete_hash;
1510 if (scalar(@keylist)) {
1511 $conf->{pending
}->{delete} = join(',', @keylist);
1513 delete $conf->{pending
}->{delete};
1519 my $valid_smbios1_options = {
1520 manufacturer
=> '\S+',
1524 uuid
=> '[a-fA-F0-9]{8}(?:-[a-fA-F0-9]{4}){3}-[a-fA-F0-9]{12}',
1529 # smbios: [manufacturer=str][,product=str][,version=str][,serial=str][,uuid=uuid][,sku=str][,family=str]
1535 foreach my $kvp (split(/,/, $data)) {
1536 return undef if $kvp !~ m/^(\S+)=(.+)$/;
1537 my ($k, $v) = split(/=/, $kvp);
1538 return undef if !defined($k) || !defined($v);
1539 return undef if !$valid_smbios1_options->{$k};
1540 return undef if $v !~ m/^$valid_smbios1_options->{$k}$/;
1551 foreach my $k (keys %$smbios1) {
1552 next if !defined($smbios1->{$k});
1553 next if !$valid_smbios1_options->{$k};
1554 $data .= ',' if $data;
1555 $data .= "$k=$smbios1->{$k}";
1560 PVE
::JSONSchema
::register_format
('pve-qm-smbios1', \
&verify_smbios1
);
1561 sub verify_smbios1
{
1562 my ($value, $noerr) = @_;
1564 return $value if parse_smbios1
($value);
1566 return undef if $noerr;
1568 die "unable to parse smbios (type 1) options\n";
1571 PVE
::JSONSchema
::register_format
('pve-qm-bootdisk', \
&verify_bootdisk
);
1572 sub verify_bootdisk
{
1573 my ($value, $noerr) = @_;
1575 return $value if valid_drivename
($value);
1577 return undef if $noerr;
1579 die "invalid boot disk '$value'\n";
1582 PVE
::JSONSchema
::register_format
('pve-qm-numanode', \
&verify_numa
);
1584 my ($value, $noerr) = @_;
1586 return $value if parse_numa
($value);
1588 return undef if $noerr;
1590 die "unable to parse numa options\n";
1593 PVE
::JSONSchema
::register_format
('pve-qm-net', \
&verify_net
);
1595 my ($value, $noerr) = @_;
1597 return $value if parse_net
($value);
1599 return undef if $noerr;
1601 die "unable to parse network options\n";
1604 PVE
::JSONSchema
::register_format
('pve-qm-drive', \
&verify_drive
);
1606 my ($value, $noerr) = @_;
1608 return $value if parse_drive
(undef, $value);
1610 return undef if $noerr;
1612 die "unable to parse drive options\n";
1615 PVE
::JSONSchema
::register_format
('pve-qm-hostpci', \
&verify_hostpci
);
1616 sub verify_hostpci
{
1617 my ($value, $noerr) = @_;
1619 return $value if parse_hostpci
($value);
1621 return undef if $noerr;
1623 die "unable to parse pci id\n";
1626 PVE
::JSONSchema
::register_format
('pve-qm-watchdog', \
&verify_watchdog
);
1627 sub verify_watchdog
{
1628 my ($value, $noerr) = @_;
1630 return $value if parse_watchdog
($value);
1632 return undef if $noerr;
1634 die "unable to parse watchdog options\n";
1637 sub parse_watchdog
{
1640 return undef if !$value;
1644 foreach my $p (split(/,/, $value)) {
1645 next if $p =~ m/^\s*$/;
1647 if ($p =~ m/^(model=)?(i6300esb|ib700)$/) {
1649 } elsif ($p =~ m/^(action=)?(reset|shutdown|poweroff|pause|debug|none)$/) {
1650 $res->{action
} = $2;
1659 PVE
::JSONSchema
::register_format
('pve-qm-startup', \
&verify_startup
);
1660 sub verify_startup
{
1661 my ($value, $noerr) = @_;
1663 return $value if parse_startup
($value);
1665 return undef if $noerr;
1667 die "unable to parse startup options\n";
1673 return undef if !$value;
1677 foreach my $p (split(/,/, $value)) {
1678 next if $p =~ m/^\s*$/;
1680 if ($p =~ m/^(order=)?(\d+)$/) {
1682 } elsif ($p =~ m/^up=(\d+)$/) {
1684 } elsif ($p =~ m/^down=(\d+)$/) {
1694 sub parse_usb_device
{
1697 return undef if !$value;
1699 my @dl = split(/,/, $value);
1703 foreach my $v (@dl) {
1704 if ($v =~ m/^host=(0x)?([0-9A-Fa-f]{4}):(0x)?([0-9A-Fa-f]{4})$/) {
1706 $res->{vendorid
} = $2;
1707 $res->{productid
} = $4;
1708 } elsif ($v =~ m/^host=(\d+)\-(\d+(\.\d+)*)$/) {
1710 $res->{hostbus
} = $1;
1711 $res->{hostport
} = $2;
1712 } elsif ($v =~ m/^spice$/) {
1719 return undef if !$found;
1724 PVE
::JSONSchema
::register_format
('pve-qm-usb-device', \
&verify_usb_device
);
1725 sub verify_usb_device
{
1726 my ($value, $noerr) = @_;
1728 return $value if parse_usb_device
($value);
1730 return undef if $noerr;
1732 die "unable to parse usb device\n";
1735 # add JSON properties for create and set function
1736 sub json_config_properties
{
1739 foreach my $opt (keys %$confdesc) {
1740 next if $opt eq 'parent' || $opt eq 'snaptime' || $opt eq 'vmstate';
1741 $prop->{$opt} = $confdesc->{$opt};
1748 my ($key, $value) = @_;
1750 die "unknown setting '$key'\n" if !$confdesc->{$key};
1752 my $type = $confdesc->{$key}->{type
};
1754 if (!defined($value)) {
1755 die "got undefined value\n";
1758 if ($value =~ m/[\n\r]/) {
1759 die "property contains a line feed\n";
1762 if ($type eq 'boolean') {
1763 return 1 if ($value eq '1') || ($value =~ m/^(on|yes|true)$/i);
1764 return 0 if ($value eq '0') || ($value =~ m/^(off|no|false)$/i);
1765 die "type check ('boolean') failed - got '$value'\n";
1766 } elsif ($type eq 'integer') {
1767 return int($1) if $value =~ m/^(\d+)$/;
1768 die "type check ('integer') failed - got '$value'\n";
1769 } elsif ($type eq 'number') {
1770 return $value if $value =~ m/^(\d+)(\.\d+)?$/;
1771 die "type check ('number') failed - got '$value'\n";
1772 } elsif ($type eq 'string') {
1773 if (my $fmt = $confdesc->{$key}->{format
}) {
1774 if ($fmt eq 'pve-qm-drive') {
1775 # special case - we need to pass $key to parse_drive()
1776 my $drive = parse_drive
($key, $value);
1777 return $value if $drive;
1778 die "unable to parse drive options\n";
1780 PVE
::JSONSchema
::check_format
($fmt, $value);
1783 $value =~ s/^\"(.*)\"$/$1/;
1786 die "internal error"
1790 sub lock_config_full
{
1791 my ($vmid, $timeout, $code, @param) = @_;
1793 my $filename = config_file_lock
($vmid);
1795 my $res = lock_file
($filename, $timeout, $code, @param);
1802 sub lock_config_mode
{
1803 my ($vmid, $timeout, $shared, $code, @param) = @_;
1805 my $filename = config_file_lock
($vmid);
1807 my $res = lock_file_full
($filename, $timeout, $shared, $code, @param);
1815 my ($vmid, $code, @param) = @_;
1817 return lock_config_full
($vmid, 10, $code, @param);
1820 sub cfs_config_path
{
1821 my ($vmid, $node) = @_;
1823 $node = $nodename if !$node;
1824 return "nodes/$node/qemu-server/$vmid.conf";
1827 sub check_iommu_support
{
1828 #fixme : need to check IOMMU support
1829 #http://www.linux-kvm.org/page/How_to_assign_devices_with_VT-d_in_KVM
1837 my ($vmid, $node) = @_;
1839 my $cfspath = cfs_config_path
($vmid, $node);
1840 return "/etc/pve/$cfspath";
1843 sub config_file_lock
{
1846 return "$lock_dir/lock-$vmid.conf";
1852 my $conf = config_file
($vmid);
1853 utime undef, undef, $conf;
1857 my ($storecfg, $vmid, $keep_empty_config) = @_;
1859 my $conffile = config_file
($vmid);
1861 my $conf = load_config
($vmid);
1865 # only remove disks owned by this VM
1866 foreach_drive
($conf, sub {
1867 my ($ds, $drive) = @_;
1869 return if drive_is_cdrom
($drive);
1871 my $volid = $drive->{file
};
1873 return if !$volid || $volid =~ m
|^/|;
1875 my ($path, $owner) = PVE
::Storage
::path
($storecfg, $volid);
1876 return if !$path || !$owner || ($owner != $vmid);
1878 PVE
::Storage
::vdisk_free
($storecfg, $volid);
1881 if ($keep_empty_config) {
1882 PVE
::Tools
::file_set_contents
($conffile, "memory: 128\n");
1887 # also remove unused disk
1889 my $dl = PVE
::Storage
::vdisk_list
($storecfg, undef, $vmid);
1892 PVE
::Storage
::foreach_volid
($dl, sub {
1893 my ($volid, $sid, $volname, $d) = @_;
1894 PVE
::Storage
::vdisk_free
($storecfg, $volid);
1904 my ($vmid, $node) = @_;
1906 my $cfspath = cfs_config_path
($vmid, $node);
1908 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath);
1910 die "no such VM ('$vmid')\n" if !defined($conf);
1915 sub parse_vm_config
{
1916 my ($filename, $raw) = @_;
1918 return undef if !defined($raw);
1921 digest
=> Digest
::SHA
::sha1_hex
($raw),
1926 $filename =~ m
|/qemu-server/(\d
+)\
.conf
$|
1927 || die "got strange filename '$filename'";
1935 my @lines = split(/\n/, $raw);
1936 foreach my $line (@lines) {
1937 next if $line =~ m/^\s*$/;
1939 if ($line =~ m/^\[PENDING\]\s*$/i) {
1940 $section = 'pending';
1941 $conf->{description
} = $descr if $descr;
1943 $conf = $res->{$section} = {};
1946 } elsif ($line =~ m/^\[([a-z][a-z0-9_\-]+)\]\s*$/i) {
1948 $conf->{description
} = $descr if $descr;
1950 $conf = $res->{snapshots
}->{$section} = {};
1954 if ($line =~ m/^\#(.*)\s*$/) {
1955 $descr .= PVE
::Tools
::decode_text
($1) . "\n";
1959 if ($line =~ m/^(description):\s*(.*\S)\s*$/) {
1960 $descr .= PVE
::Tools
::decode_text
($2);
1961 } elsif ($line =~ m/snapstate:\s*(prepare|delete)\s*$/) {
1962 $conf->{snapstate
} = $1;
1963 } elsif ($line =~ m/^(args):\s*(.*\S)\s*$/) {
1966 $conf->{$key} = $value;
1967 } elsif ($line =~ m/^delete:\s*(.*\S)\s*$/) {
1969 if ($section eq 'pending') {
1970 $conf->{delete} = $value; # we parse this later
1972 warn "vm $vmid - propertry 'delete' is only allowed in [PENDING]\n";
1974 } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/) {
1977 eval { $value = check_type
($key, $value); };
1979 warn "vm $vmid - unable to parse value of '$key' - $@";
1981 my $fmt = $confdesc->{$key}->{format
};
1982 if ($fmt && $fmt eq 'pve-qm-drive') {
1983 my $v = parse_drive
($key, $value);
1984 if (my $volid = filename_to_volume_id
($vmid, $v->{file
}, $v->{media
})) {
1985 $v->{file
} = $volid;
1986 $value = print_drive
($vmid, $v);
1988 warn "vm $vmid - unable to parse value of '$key'\n";
1993 if ($key eq 'cdrom') {
1994 $conf->{ide2
} = $value;
1996 $conf->{$key} = $value;
2002 $conf->{description
} = $descr if $descr;
2004 delete $res->{snapstate
}; # just to be sure
2009 sub write_vm_config
{
2010 my ($filename, $conf) = @_;
2012 delete $conf->{snapstate
}; # just to be sure
2014 if ($conf->{cdrom
}) {
2015 die "option ide2 conflicts with cdrom\n" if $conf->{ide2
};
2016 $conf->{ide2
} = $conf->{cdrom
};
2017 delete $conf->{cdrom
};
2020 # we do not use 'smp' any longer
2021 if ($conf->{sockets
}) {
2022 delete $conf->{smp
};
2023 } elsif ($conf->{smp
}) {
2024 $conf->{sockets
} = $conf->{smp
};
2025 delete $conf->{cores
};
2026 delete $conf->{smp
};
2029 if ($conf->{maxcpus
} && $conf->{sockets
}) {
2030 delete $conf->{sockets
};
2033 my $used_volids = {};
2035 my $cleanup_config = sub {
2036 my ($cref, $pending, $snapname) = @_;
2038 foreach my $key (keys %$cref) {
2039 next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots' ||
2040 $key eq 'snapstate' || $key eq 'pending';
2041 my $value = $cref->{$key};
2042 if ($key eq 'delete') {
2043 die "propertry 'delete' is only allowed in [PENDING]\n"
2045 # fixme: check syntax?
2048 eval { $value = check_type
($key, $value); };
2049 die "unable to parse value of '$key' - $@" if $@;
2051 $cref->{$key} = $value;
2053 if (!$snapname && valid_drivename
($key)) {
2054 my $drive = parse_drive
($key, $value);
2055 $used_volids->{$drive->{file
}} = 1 if $drive && $drive->{file
};
2060 &$cleanup_config($conf);
2062 &$cleanup_config($conf->{pending
}, 1);
2064 foreach my $snapname (keys %{$conf->{snapshots
}}) {
2065 die "internal error" if $snapname eq 'pending';
2066 &$cleanup_config($conf->{snapshots
}->{$snapname}, undef, $snapname);
2069 # remove 'unusedX' settings if we re-add a volume
2070 foreach my $key (keys %$conf) {
2071 my $value = $conf->{$key};
2072 if ($key =~ m/^unused/ && $used_volids->{$value}) {
2073 delete $conf->{$key};
2077 my $generate_raw_config = sub {
2082 # add description as comment to top of file
2083 my $descr = $conf->{description
} || '';
2084 foreach my $cl (split(/\n/, $descr)) {
2085 $raw .= '#' . PVE
::Tools
::encode_text
($cl) . "\n";
2088 foreach my $key (sort keys %$conf) {
2089 next if $key eq 'digest' || $key eq 'description' || $key eq 'pending' || $key eq 'snapshots';
2090 $raw .= "$key: $conf->{$key}\n";
2095 my $raw = &$generate_raw_config($conf);
2097 if (scalar(keys %{$conf->{pending
}})){
2098 $raw .= "\n[PENDING]\n";
2099 $raw .= &$generate_raw_config($conf->{pending
});
2102 foreach my $snapname (sort keys %{$conf->{snapshots
}}) {
2103 $raw .= "\n[$snapname]\n";
2104 $raw .= &$generate_raw_config($conf->{snapshots
}->{$snapname});
2110 sub update_config_nolock
{
2111 my ($vmid, $conf, $skiplock) = @_;
2113 check_lock
($conf) if !$skiplock;
2115 my $cfspath = cfs_config_path
($vmid);
2117 PVE
::Cluster
::cfs_write_file
($cfspath, $conf);
2121 my ($vmid, $conf, $skiplock) = @_;
2123 lock_config
($vmid, &update_config_nolock
, $conf, $skiplock);
2130 # we use static defaults from our JSON schema configuration
2131 foreach my $key (keys %$confdesc) {
2132 if (defined(my $default = $confdesc->{$key}->{default})) {
2133 $res->{$key} = $default;
2137 my $conf = PVE
::Cluster
::cfs_read_file
('datacenter.cfg');
2138 $res->{keyboard
} = $conf->{keyboard
} if $conf->{keyboard
};
2144 my $vmlist = PVE
::Cluster
::get_vmlist
();
2146 return $res if !$vmlist || !$vmlist->{ids
};
2147 my $ids = $vmlist->{ids
};
2149 foreach my $vmid (keys %$ids) {
2150 my $d = $ids->{$vmid};
2151 next if !$d->{node
} || $d->{node
} ne $nodename;
2152 next if !$d->{type
} || $d->{type
} ne 'qemu';
2153 $res->{$vmid}->{exists} = 1;
2158 # test if VM uses local resources (to prevent migration)
2159 sub check_local_resources
{
2160 my ($conf, $noerr) = @_;
2164 $loc_res = 1 if $conf->{hostusb
}; # old syntax
2165 $loc_res = 1 if $conf->{hostpci
}; # old syntax
2167 foreach my $k (keys %$conf) {
2168 next if $k =~ m/^usb/ && ($conf->{$k} eq 'spice');
2169 $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/;
2172 die "VM uses local resources\n" if $loc_res && !$noerr;
2177 # check if used storages are available on all nodes (use by migrate)
2178 sub check_storage_availability
{
2179 my ($storecfg, $conf, $node) = @_;
2181 foreach_drive
($conf, sub {
2182 my ($ds, $drive) = @_;
2184 my $volid = $drive->{file
};
2187 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
2190 # check if storage is available on both nodes
2191 my $scfg = PVE
::Storage
::storage_check_node
($storecfg, $sid);
2192 PVE
::Storage
::storage_check_node
($storecfg, $sid, $node);
2196 # list nodes where all VM images are available (used by has_feature API)
2198 my ($conf, $storecfg) = @_;
2200 my $nodelist = PVE
::Cluster
::get_nodelist
();
2201 my $nodehash = { map { $_ => 1 } @$nodelist };
2202 my $nodename = PVE
::INotify
::nodename
();
2204 foreach_drive
($conf, sub {
2205 my ($ds, $drive) = @_;
2207 my $volid = $drive->{file
};
2210 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
2212 my $scfg = PVE
::Storage
::storage_config
($storecfg, $storeid);
2213 if ($scfg->{disable
}) {
2215 } elsif (my $avail = $scfg->{nodes
}) {
2216 foreach my $node (keys %$nodehash) {
2217 delete $nodehash->{$node} if !$avail->{$node};
2219 } elsif (!$scfg->{shared
}) {
2220 foreach my $node (keys %$nodehash) {
2221 delete $nodehash->{$node} if $node ne $nodename
2233 die "VM is locked ($conf->{lock})\n" if $conf->{lock};
2237 my ($pidfile, $pid) = @_;
2239 my $fh = IO
::File-
>new("/proc/$pid/cmdline", "r");
2243 return undef if !$line;
2244 my @param = split(/\0/, $line);
2246 my $cmd = $param[0];
2247 return if !$cmd || ($cmd !~ m
|kvm
$| && $cmd !~ m
|qemu-system-x86_64
$|);
2249 for (my $i = 0; $i < scalar (@param); $i++) {
2252 if (($p eq '-pidfile') || ($p eq '--pidfile')) {
2253 my $p = $param[$i+1];
2254 return 1 if $p && ($p eq $pidfile);
2263 my ($vmid, $nocheck, $node) = @_;
2265 my $filename = config_file
($vmid, $node);
2267 die "unable to find configuration file for VM $vmid - no such machine\n"
2268 if !$nocheck && ! -f
$filename;
2270 my $pidfile = pidfile_name
($vmid);
2272 if (my $fd = IO
::File-
>new("<$pidfile")) {
2277 my $mtime = $st->mtime;
2278 if ($mtime > time()) {
2279 warn "file '$filename' modified in future\n";
2282 if ($line =~ m/^(\d+)$/) {
2284 if (check_cmdline
($pidfile, $pid)) {
2285 if (my $pinfo = PVE
::ProcFSTools
::check_process_running
($pid)) {
2297 my $vzlist = config_list
();
2299 my $fd = IO
::Dir-
>new($var_run_tmpdir) || return $vzlist;
2301 while (defined(my $de = $fd->read)) {
2302 next if $de !~ m/^(\d+)\.pid$/;
2304 next if !defined($vzlist->{$vmid});
2305 if (my $pid = check_running
($vmid)) {
2306 $vzlist->{$vmid}->{pid
} = $pid;
2314 my ($storecfg, $conf) = @_;
2316 my $bootdisk = $conf->{bootdisk
};
2317 return undef if !$bootdisk;
2318 return undef if !valid_drivename
($bootdisk);
2320 return undef if !$conf->{$bootdisk};
2322 my $drive = parse_drive
($bootdisk, $conf->{$bootdisk});
2323 return undef if !defined($drive);
2325 return undef if drive_is_cdrom
($drive);
2327 my $volid = $drive->{file
};
2328 return undef if !$volid;
2330 return $drive->{size
};
2333 my $last_proc_pid_stat;
2335 # get VM status information
2336 # This must be fast and should not block ($full == false)
2337 # We only query KVM using QMP if $full == true (this can be slow)
2339 my ($opt_vmid, $full) = @_;
2343 my $storecfg = PVE
::Storage
::config
();
2345 my $list = vzlist
();
2346 my ($uptime) = PVE
::ProcFSTools
::read_proc_uptime
(1);
2348 my $cpucount = $cpuinfo->{cpus
} || 1;
2350 foreach my $vmid (keys %$list) {
2351 next if $opt_vmid && ($vmid ne $opt_vmid);
2353 my $cfspath = cfs_config_path
($vmid);
2354 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath) || {};
2357 $d->{pid
} = $list->{$vmid}->{pid
};
2359 # fixme: better status?
2360 $d->{status
} = $list->{$vmid}->{pid
} ?
'running' : 'stopped';
2362 my $size = disksize
($storecfg, $conf);
2363 if (defined($size)) {
2364 $d->{disk
} = 0; # no info available
2365 $d->{maxdisk
} = $size;
2371 $d->{cpus
} = ($conf->{sockets
} || 1) * ($conf->{cores
} || 1);
2372 $d->{cpus
} = $cpucount if $d->{cpus
} > $cpucount;
2374 $d->{name
} = $conf->{name
} || "VM $vmid";
2375 $d->{maxmem
} = $conf->{memory
} ?
$conf->{memory
}*(1024*1024) : 0;
2377 if ($conf->{balloon
}) {
2378 $d->{balloon_min
} = $conf->{balloon
}*(1024*1024);
2379 $d->{shares
} = defined($conf->{shares
}) ?
$conf->{shares
} : 1000;
2390 $d->{diskwrite
} = 0;
2392 $d->{template
} = is_template
($conf);
2397 my $netdev = PVE
::ProcFSTools
::read_proc_net_dev
();
2398 foreach my $dev (keys %$netdev) {
2399 next if $dev !~ m/^tap([1-9]\d*)i/;
2401 my $d = $res->{$vmid};
2404 $d->{netout
} += $netdev->{$dev}->{receive
};
2405 $d->{netin
} += $netdev->{$dev}->{transmit
};
2408 my $ctime = gettimeofday
;
2410 foreach my $vmid (keys %$list) {
2412 my $d = $res->{$vmid};
2413 my $pid = $d->{pid
};
2416 my $pstat = PVE
::ProcFSTools
::read_proc_pid_stat
($pid);
2417 next if !$pstat; # not running
2419 my $used = $pstat->{utime} + $pstat->{stime
};
2421 $d->{uptime
} = int(($uptime - $pstat->{starttime
})/$cpuinfo->{user_hz
});
2423 if ($pstat->{vsize
}) {
2424 $d->{mem
} = int(($pstat->{rss
}/$pstat->{vsize
})*$d->{maxmem
});
2427 my $old = $last_proc_pid_stat->{$pid};
2429 $last_proc_pid_stat->{$pid} = {
2437 my $dtime = ($ctime - $old->{time}) * $cpucount * $cpuinfo->{user_hz
};
2439 if ($dtime > 1000) {
2440 my $dutime = $used - $old->{used
};
2442 $d->{cpu
} = (($dutime/$dtime)* $cpucount) / $d->{cpus
};
2443 $last_proc_pid_stat->{$pid} = {
2449 $d->{cpu
} = $old->{cpu
};
2453 return $res if !$full;
2455 my $qmpclient = PVE
::QMPClient-
>new();
2457 my $ballooncb = sub {
2458 my ($vmid, $resp) = @_;
2460 my $info = $resp->{'return'};
2461 return if !$info->{max_mem
};
2463 my $d = $res->{$vmid};
2465 # use memory assigned to VM
2466 $d->{maxmem
} = $info->{max_mem
};
2467 $d->{balloon
} = $info->{actual
};
2469 if (defined($info->{total_mem
}) && defined($info->{free_mem
})) {
2470 $d->{mem
} = $info->{total_mem
} - $info->{free_mem
};
2471 $d->{freemem
} = $info->{free_mem
};
2476 my $blockstatscb = sub {
2477 my ($vmid, $resp) = @_;
2478 my $data = $resp->{'return'} || [];
2479 my $totalrdbytes = 0;
2480 my $totalwrbytes = 0;
2481 for my $blockstat (@$data) {
2482 $totalrdbytes = $totalrdbytes + $blockstat->{stats
}->{rd_bytes
};
2483 $totalwrbytes = $totalwrbytes + $blockstat->{stats
}->{wr_bytes
};
2485 $res->{$vmid}->{diskread
} = $totalrdbytes;
2486 $res->{$vmid}->{diskwrite
} = $totalwrbytes;
2489 my $statuscb = sub {
2490 my ($vmid, $resp) = @_;
2492 $qmpclient->queue_cmd($vmid, $blockstatscb, 'query-blockstats');
2493 # this fails if ballon driver is not loaded, so this must be
2494 # the last commnand (following command are aborted if this fails).
2495 $qmpclient->queue_cmd($vmid, $ballooncb, 'query-balloon');
2497 my $status = 'unknown';
2498 if (!defined($status = $resp->{'return'}->{status
})) {
2499 warn "unable to get VM status\n";
2503 $res->{$vmid}->{qmpstatus
} = $resp->{'return'}->{status
};
2506 foreach my $vmid (keys %$list) {
2507 next if $opt_vmid && ($vmid ne $opt_vmid);
2508 next if !$res->{$vmid}->{pid
}; # not running
2509 $qmpclient->queue_cmd($vmid, $statuscb, 'query-status');
2512 $qmpclient->queue_execute(undef, 1);
2514 foreach my $vmid (keys %$list) {
2515 next if $opt_vmid && ($vmid ne $opt_vmid);
2516 $res->{$vmid}->{qmpstatus
} = $res->{$vmid}->{status
} if !$res->{$vmid}->{qmpstatus
};
2523 my ($conf, $func) = @_;
2525 foreach my $ds (keys %$conf) {
2526 next if !valid_drivename
($ds);
2528 my $drive = parse_drive
($ds, $conf->{$ds});
2531 &$func($ds, $drive);
2536 my ($conf, $func) = @_;
2540 my $test_volid = sub {
2541 my ($volid, $is_cdrom) = @_;
2545 $volhash->{$volid} = $is_cdrom || 0;
2548 foreach_drive
($conf, sub {
2549 my ($ds, $drive) = @_;
2550 &$test_volid($drive->{file
}, drive_is_cdrom
($drive));
2553 foreach my $snapname (keys %{$conf->{snapshots
}}) {
2554 my $snap = $conf->{snapshots
}->{$snapname};
2555 &$test_volid($snap->{vmstate
}, 0);
2556 foreach_drive
($snap, sub {
2557 my ($ds, $drive) = @_;
2558 &$test_volid($drive->{file
}, drive_is_cdrom
($drive));
2562 foreach my $volid (keys %$volhash) {
2563 &$func($volid, $volhash->{$volid});
2567 sub vga_conf_has_spice
{
2570 return 0 if !$vga || $vga !~ m/^qxl([234])?$/;
2575 sub config_to_command
{
2576 my ($storecfg, $vmid, $conf, $defaults, $forcemachine) = @_;
2579 my $globalFlags = [];
2580 my $machineFlags = [];
2586 my $kvmver = kvm_user_version
();
2587 my $vernum = 0; # unknown
2588 if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
2589 $vernum = $1*1000000+$2*1000;
2590 } elsif ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
2591 $vernum = $1*1000000+$2*1000+$3;
2594 die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 15000;
2596 my $have_ovz = -f
'/proc/vz/vestat';
2598 my $q35 = machine_type_is_q35
($conf);
2600 push @$cmd, '/usr/bin/kvm';
2602 push @$cmd, '-id', $vmid;
2606 my $qmpsocket = qmp_socket
($vmid);
2607 push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
2608 push @$cmd, '-mon', "chardev=qmp,mode=control";
2610 my $socket = vnc_socket
($vmid);
2611 push @$cmd, '-vnc', "unix:$socket,x509,password";
2613 push @$cmd, '-pidfile' , pidfile_name
($vmid);
2615 push @$cmd, '-daemonize';
2617 if ($conf->{smbios1
}) {
2618 push @$cmd, '-smbios', "type=1,$conf->{smbios1}";
2621 push @$cmd, '-object', "iothread,id=iothread0" if $conf->{iothread
};
2624 # the q35 chipset support native usb2, so we enable usb controller
2625 # by default for this machine type
2626 push @$devices, '-readconfig', '/usr/share/qemu-server/pve-q35.cfg';
2628 $pciaddr = print_pci_addr
("piix3", $bridges);
2629 push @$devices, '-device', "piix3-usb-uhci,id=uhci$pciaddr.0x2";
2632 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2633 next if !$conf->{"usb$i"};
2636 # include usb device config
2637 push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
2640 my $vga = $conf->{vga
};
2642 my $qxlnum = vga_conf_has_spice
($vga);
2643 $vga = 'qxl' if $qxlnum;
2646 if ($conf->{ostype
} && ($conf->{ostype
} eq 'win8' ||
2647 $conf->{ostype
} eq 'win7' ||
2648 $conf->{ostype
} eq 'w2k8')) {
2655 # enable absolute mouse coordinates (needed by vnc)
2657 if (defined($conf->{tablet
})) {
2658 $tablet = $conf->{tablet
};
2660 $tablet = $defaults->{tablet
};
2661 $tablet = 0 if $qxlnum; # disable for spice because it is not needed
2662 $tablet = 0 if $vga =~ m/^serial\d+$/; # disable if we use serial terminal (no vga card)
2665 push @$devices, '-device', print_tabletdevice_full
($conf) if $tablet;
2668 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
2669 my $d = parse_hostpci
($conf->{"hostpci$i"});
2672 my $pcie = $d->{pcie
};
2674 die "q35 machine model is not enabled" if !$q35;
2675 $pciaddr = print_pcie_addr
("hostpci$i");
2677 $pciaddr = print_pci_addr
("hostpci$i", $bridges);
2680 my $rombar = $d->{rombar
} && $d->{rombar
} eq 'off' ?
",rombar=0" : "";
2681 my $driver = $d->{driver
} && $d->{driver
} eq 'vfio' ?
"vfio-pci" : "pci-assign";
2682 my $xvga = $d->{'x-vga'} && $d->{'x-vga'} eq 'on' ?
",x-vga=on" : "";
2683 if ($xvga && $xvga ne '') {
2684 push @$cpuFlags, 'kvm=off';
2687 $driver = "vfio-pci" if $xvga ne '';
2688 my $pcidevices = $d->{pciid
};
2689 my $multifunction = 1 if @$pcidevices > 1;
2692 foreach my $pcidevice (@$pcidevices) {
2694 my $id = "hostpci$i";
2695 $id .= ".$j" if $multifunction;
2696 my $addr = $pciaddr;
2697 $addr .= ".$j" if $multifunction;
2698 my $devicestr = "$driver,host=$pcidevice->{id}.$pcidevice->{function},id=$id$addr";
2701 $devicestr .= "$rombar$xvga";
2702 $devicestr .= ",multifunction=on" if $multifunction;
2705 push @$devices, '-device', $devicestr;
2711 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2712 my $d = parse_usb_device
($conf->{"usb$i"});
2714 if ($d->{vendorid
} && $d->{productid
}) {
2715 push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2716 } elsif (defined($d->{hostbus
}) && defined($d->{hostport
})) {
2717 push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2718 } elsif ($d->{spice
}) {
2719 # usb redir support for spice
2720 push @$devices, '-chardev', "spicevmc,id=usbredirchardev$i,name=usbredir";
2721 push @$devices, '-device', "usb-redir,chardev=usbredirchardev$i,id=usbredirdev$i,bus=ehci.0";
2726 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
2727 if (my $path = $conf->{"serial$i"}) {
2728 if ($path eq 'socket') {
2729 my $socket = "/var/run/qemu-server/${vmid}.serial$i";
2730 push @$devices, '-chardev', "socket,id=serial$i,path=$socket,server,nowait";
2731 push @$devices, '-device', "isa-serial,chardev=serial$i";
2733 die "no such serial device\n" if ! -c
$path;
2734 push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2735 push @$devices, '-device', "isa-serial,chardev=serial$i";
2741 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
2742 if (my $path = $conf->{"parallel$i"}) {
2743 die "no such parallel device\n" if ! -c
$path;
2744 my $devtype = $path =~ m!^/dev/usb/lp! ?
'tty' : 'parport';
2745 push @$devices, '-chardev', "$devtype,id=parallel$i,path=$path";
2746 push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2750 my $vmname = $conf->{name
} || "vm$vmid";
2752 push @$cmd, '-name', $vmname;
2755 $sockets = $conf->{smp
} if $conf->{smp
}; # old style - no longer iused
2756 $sockets = $conf->{sockets
} if $conf->{sockets
};
2758 my $cores = $conf->{cores
} || 1;
2759 my $maxcpus = $conf->{maxcpus
} if $conf->{maxcpus
};
2761 my $total_cores = $sockets * $cores;
2762 my $allowed_cores = $cpuinfo->{cpus
};
2764 die "MAX $allowed_cores cores allowed per VM on this node\n"
2765 if ($allowed_cores < $total_cores);
2768 push @$cmd, '-smp', "cpus=$cores,maxcpus=$maxcpus";
2770 push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2773 push @$cmd, '-nodefaults';
2775 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
2777 my $bootindex_hash = {};
2779 foreach my $o (split(//, $bootorder)) {
2780 $bootindex_hash->{$o} = $i*100;
2784 push @$cmd, '-boot', "menu=on,strict=on,reboot-timeout=1000";
2786 push @$cmd, '-no-acpi' if defined($conf->{acpi
}) && $conf->{acpi
} == 0;
2788 push @$cmd, '-no-reboot' if defined($conf->{reboot
}) && $conf->{reboot
} == 0;
2790 push @$cmd, '-vga', $vga if $vga && $vga !~ m/^serial\d+$/; # for kvm 77 and later
2793 my $tdf = defined($conf->{tdf
}) ?
$conf->{tdf
} : $defaults->{tdf
};
2795 my $nokvm = defined($conf->{kvm
}) && $conf->{kvm
} == 0 ?
1 : 0;
2796 my $useLocaltime = $conf->{localtime};
2798 if (my $ost = $conf->{ostype
}) {
2799 # other, wxp, w2k, w2k3, w2k8, wvista, win7, win8, l24, l26, solaris
2801 if ($ost =~ m/^w/) { # windows
2802 $useLocaltime = 1 if !defined($conf->{localtime});
2804 # use time drift fix when acpi is enabled
2805 if (!(defined($conf->{acpi
}) && $conf->{acpi
} == 0)) {
2806 $tdf = 1 if !defined($conf->{tdf
});
2810 if ($ost eq 'win7' || $ost eq 'win8' || $ost eq 'w2k8' ||
2812 push @$globalFlags, 'kvm-pit.lost_tick_policy=discard';
2813 push @$cmd, '-no-hpet';
2814 #push @$cpuFlags , 'hv_vapic" if !$nokvm; #fixme, my win2008R2 hang at boot with this
2815 push @$cpuFlags , 'hv_spinlocks=0xffff' if !$nokvm;
2818 if ($ost eq 'win7' || $ost eq 'win8') {
2819 push @$cpuFlags , 'hv_relaxed' if !$nokvm;
2823 push @$rtcFlags, 'driftfix=slew' if $tdf;
2826 push @$machineFlags, 'accel=tcg';
2828 die "No accelerator found!\n" if !$cpuinfo->{hvm
};
2831 my $machine_type = $forcemachine || $conf->{machine
};
2832 if ($machine_type) {
2833 push @$machineFlags, "type=${machine_type}";
2836 if ($conf->{startdate
}) {
2837 push @$rtcFlags, "base=$conf->{startdate}";
2838 } elsif ($useLocaltime) {
2839 push @$rtcFlags, 'base=localtime';
2842 my $cpu = $nokvm ?
"qemu64" : "kvm64";
2843 $cpu = $conf->{cpu
} if $conf->{cpu
};
2845 push @$cpuFlags , '+lahf_lm' if $cpu eq 'kvm64';
2847 push @$cpuFlags , '+x2apic' if !$nokvm && $conf->{ostype
} ne 'solaris';
2849 push @$cpuFlags , '-x2apic' if $conf->{ostype
} eq 'solaris';
2851 push @$cpuFlags, '+sep' if $cpu eq 'kvm64' || $cpu eq 'kvm32';
2853 $cpu .= "," . join(',', @$cpuFlags) if scalar(@$cpuFlags);
2855 # Note: enforce needs kernel 3.10, so we do not use it for now
2856 # push @$cmd, '-cpu', "$cpu,enforce";
2857 push @$cmd, '-cpu', $cpu;
2859 my $memory = $conf->{memory
} || $defaults->{memory
};
2860 push @$cmd, '-m', $memory;
2862 if ($conf->{numa
}) {
2864 my $numa_totalmemory = undef;
2865 for (my $i = 0; $i < $MAX_NUMA; $i++) {
2866 next if !$conf->{"numa$i"};
2867 my $numa = parse_numa
($conf->{"numa$i"});
2870 die "missing numa node$i memory value\n" if !$numa->{memory
};
2871 my $numa_memory = $numa->{memory
};
2872 $numa_totalmemory += $numa_memory;
2873 my $numa_object = "memory-backend-ram,id=ram-node$i,size=$numa_memory"."M";
2876 my $cpus_start = $numa->{cpus
}->{start
};
2877 die "missing numa node$i cpus\n" if !defined($cpus_start);
2878 my $cpus_end = $numa->{cpus
}->{end
} if defined($numa->{cpus
}->{end
});
2879 my $cpus = $cpus_start;
2880 if (defined($cpus_end)) {
2881 $cpus .= "-$cpus_end";
2882 die "numa node$i : cpu range $cpus is incorrect\n" if $cpus_end <= $cpus_start;
2886 my $hostnodes_start = $numa->{hostnodes
}->{start
};
2887 if (defined($hostnodes_start)) {
2888 my $hostnodes_end = $numa->{hostnodes
}->{end
} if defined($numa->{hostnodes
}->{end
});
2889 my $hostnodes = $hostnodes_start;
2890 if (defined($hostnodes_end)) {
2891 $hostnodes .= "-$hostnodes_end";
2892 die "host node $hostnodes range is incorrect\n" if $hostnodes_end <= $hostnodes_start;
2895 my $hostnodes_end_range = defined($hostnodes_end) ?
$hostnodes_end : $hostnodes_start;
2896 for (my $i = $hostnodes_start; $i <= $hostnodes_end_range; $i++ ) {
2897 die "host numa node$i don't exist\n" if ! -d
"/sys/devices/system/node/node$i/";
2901 my $policy = $numa->{policy
};
2902 die "you need to define a policy for hostnode $hostnodes\n" if !$policy;
2903 $numa_object .= ",host-nodes=$hostnodes,policy=$policy";
2906 push @$cmd, '-object', $numa_object;
2907 push @$cmd, '-numa', "node,nodeid=$i,cpus=$cpus,memdev=ram-node$i";
2910 die "total memory for NUMA nodes must be equal to vm memory\n"
2911 if $numa_totalmemory && $numa_totalmemory != $memory;
2913 #if no custom tology, we split memory and cores across numa nodes
2914 if(!$numa_totalmemory) {
2916 my $numa_memory = ($memory / $sockets) . "M";
2918 for (my $i = 0; $i < $sockets; $i++) {
2920 my $cpustart = ($cores * $i);
2921 my $cpuend = ($cpustart + $cores - 1) if $cores && $cores > 1;
2922 my $cpus = $cpustart;
2923 $cpus .= "-$cpuend" if $cpuend;
2925 push @$cmd, '-object', "memory-backend-ram,size=$numa_memory,id=ram-node$i";
2926 push @$cmd, '-numa', "node,nodeid=$i,cpus=$cpus,memdev=ram-node$i";
2931 push @$cmd, '-S' if $conf->{freeze
};
2933 # set keyboard layout
2934 my $kb = $conf->{keyboard
} || $defaults->{keyboard
};
2935 push @$cmd, '-k', $kb if $kb;
2938 #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2939 #push @$cmd, '-soundhw', 'es1370';
2940 #push @$cmd, '-soundhw', $soundhw if $soundhw;
2942 if($conf->{agent
}) {
2943 my $qgasocket = qmp_socket
($vmid, 1);
2944 my $pciaddr = print_pci_addr
("qga0", $bridges);
2945 push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
2946 push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
2947 push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
2954 if ($conf->{ostype
} && $conf->{ostype
} =~ m/^w/){
2955 for(my $i = 1; $i < $qxlnum; $i++){
2956 my $pciaddr = print_pci_addr
("vga$i", $bridges);
2957 push @$cmd, '-device', "qxl,id=vga$i,ram_size=67108864,vram_size=33554432$pciaddr";
2960 # assume other OS works like Linux
2961 push @$cmd, '-global', 'qxl-vga.ram_size=134217728';
2962 push @$cmd, '-global', 'qxl-vga.vram_size=67108864';
2966 my $pciaddr = print_pci_addr
("spice", $bridges);
2968 $spice_port = PVE
::Tools
::next_spice_port
();
2970 push @$devices, '-spice', "tls-port=${spice_port},addr=127.0.0.1,tls-ciphers=DES-CBC3-SHA,seamless-migration=on";
2972 push @$devices, '-device', "virtio-serial,id=spice$pciaddr";
2973 push @$devices, '-chardev', "spicevmc,id=vdagent,name=vdagent";
2974 push @$devices, '-device', "virtserialport,chardev=vdagent,name=com.redhat.spice.0";
2977 # enable balloon by default, unless explicitly disabled
2978 if (!defined($conf->{balloon
}) || $conf->{balloon
}) {
2979 $pciaddr = print_pci_addr
("balloon0", $bridges);
2980 push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr";
2983 if ($conf->{watchdog
}) {
2984 my $wdopts = parse_watchdog
($conf->{watchdog
});
2985 $pciaddr = print_pci_addr
("watchdog", $bridges);
2986 my $watchdog = $wdopts->{model
} || 'i6300esb';
2987 push @$devices, '-device', "$watchdog$pciaddr";
2988 push @$devices, '-watchdog-action', $wdopts->{action
} if $wdopts->{action
};
2992 my $scsicontroller = {};
2993 my $ahcicontroller = {};
2994 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : $defaults->{scsihw
};
2996 # Add iscsi initiator name if available
2997 if (my $initiator = get_initiator_name
()) {
2998 push @$devices, '-iscsi', "initiator-name=$initiator";
3001 foreach_drive
($conf, sub {
3002 my ($ds, $drive) = @_;
3004 if (PVE
::Storage
::parse_volume_id
($drive->{file
}, 1)) {
3005 push @$vollist, $drive->{file
};
3008 $use_virtio = 1 if $ds =~ m/^virtio/;
3010 if (drive_is_cdrom
($drive)) {
3011 if ($bootindex_hash->{d
}) {
3012 $drive->{bootindex
} = $bootindex_hash->{d
};
3013 $bootindex_hash->{d
} += 1;
3016 if ($bootindex_hash->{c
}) {
3017 $drive->{bootindex
} = $bootindex_hash->{c
} if $conf->{bootdisk
} && ($conf->{bootdisk
} eq $ds);
3018 $bootindex_hash->{c
} += 1;
3022 if ($drive->{interface
} eq 'scsi') {
3024 my $maxdev = ($scsihw !~ m/^lsi/) ?
256 : 7;
3025 my $controller = int($drive->{index} / $maxdev);
3026 $pciaddr = print_pci_addr
("scsihw$controller", $bridges);
3027 push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
3028 $scsicontroller->{$controller}=1;
3031 if ($drive->{interface
} eq 'sata') {
3032 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
3033 $pciaddr = print_pci_addr
("ahci$controller", $bridges);
3034 push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
3035 $ahcicontroller->{$controller}=1;
3038 my $drive_cmd = print_drive_full
($storecfg, $vmid, $drive);
3039 push @$devices, '-drive',$drive_cmd;
3040 push @$devices, '-device', print_drivedevice_full
($storecfg, $conf, $vmid, $drive, $bridges);
3043 for (my $i = 0; $i < $MAX_NETS; $i++) {
3044 next if !$conf->{"net$i"};
3045 my $d = parse_net
($conf->{"net$i"});
3048 $use_virtio = 1 if $d->{model
} eq 'virtio';
3050 if ($bootindex_hash->{n
}) {
3051 $d->{bootindex
} = $bootindex_hash->{n
};
3052 $bootindex_hash->{n
} += 1;
3055 my $netdevfull = print_netdev_full
($vmid,$conf,$d,"net$i");
3056 push @$devices, '-netdev', $netdevfull;
3058 my $netdevicefull = print_netdevice_full
($vmid,$conf,$d,"net$i",$bridges);
3059 push @$devices, '-device', $netdevicefull;
3064 while (my ($k, $v) = each %$bridges) {
3065 $pciaddr = print_pci_addr
("pci.$k");
3066 unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
3070 # hack: virtio with fairsched is unreliable, so we do not use fairsched
3071 # when the VM uses virtio devices.
3072 if (!$use_virtio && $have_ovz) {
3074 my $cpuunits = defined($conf->{cpuunits
}) ?
3075 $conf->{cpuunits
} : $defaults->{cpuunits
};
3077 push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
3079 # fixme: cpulimit is currently ignored
3080 #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
3084 if ($conf->{args
}) {
3085 my $aa = PVE
::Tools
::split_args
($conf->{args
});
3089 push @$cmd, @$devices;
3090 push @$cmd, '-rtc', join(',', @$rtcFlags)
3091 if scalar(@$rtcFlags);
3092 push @$cmd, '-machine', join(',', @$machineFlags)
3093 if scalar(@$machineFlags);
3094 push @$cmd, '-global', join(',', @$globalFlags)
3095 if scalar(@$globalFlags);
3097 return wantarray ?
($cmd, $vollist, $spice_port) : $cmd;
3102 return "${var_run_tmpdir}/$vmid.vnc";
3108 my $res = vm_mon_cmd
($vmid, 'query-spice');
3110 return $res->{'tls-port'} || $res->{'port'} || die "no spice port\n";
3114 my ($vmid, $qga) = @_;
3115 my $sockettype = $qga ?
'qga' : 'qmp';
3116 return "${var_run_tmpdir}/$vmid.$sockettype";
3121 return "${var_run_tmpdir}/$vmid.pid";
3124 sub vm_devices_list
{
3127 my $res = vm_mon_cmd
($vmid, 'query-pci');
3129 foreach my $pcibus (@$res) {
3130 foreach my $device (@{$pcibus->{devices
}}) {
3131 next if !$device->{'qdev_id'};
3132 $devices->{$device->{'qdev_id'}} = 1;
3136 my $resblock = vm_mon_cmd
($vmid, 'query-block');
3137 foreach my $block (@$resblock) {
3138 if($block->{device
} =~ m/^drive-(\S+)/){
3143 my $resmice = vm_mon_cmd
($vmid, 'query-mice');
3144 foreach my $mice (@$resmice) {
3145 if ($mice->{name
} eq 'QEMU HID Tablet') {
3146 $devices->{tablet
} = 1;
3155 my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
3157 die "internal error" if !$conf->{hotplug
};
3159 my $q35 = machine_type_is_q35
($conf);
3161 my $devices_list = vm_devices_list
($vmid);
3162 return 1 if defined($devices_list->{$deviceid});
3164 qemu_add_pci_bridge
($storecfg, $conf, $vmid, $deviceid); # add PCI bridge if we need it for the device
3166 if ($deviceid eq 'tablet') {
3168 qemu_deviceadd
($vmid, print_tabletdevice_full
($conf));
3170 } elsif ($deviceid =~ m/^(virtio)(\d+)$/) {
3172 qemu_driveadd
($storecfg, $vmid, $device);
3173 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
3175 qemu_deviceadd
($vmid, $devicefull);
3176 eval { qemu_deviceaddverify
($vmid, $deviceid); };
3178 eval { qemu_drivedel
($vmid, $deviceid); };
3183 } elsif ($deviceid =~ m/^(scsihw)(\d+)$/) {
3185 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : "lsi";
3186 my $pciaddr = print_pci_addr
($deviceid);
3187 my $devicefull = "$scsihw,id=$deviceid$pciaddr";
3189 qemu_deviceadd
($vmid, $devicefull);
3190 qemu_deviceaddverify
($vmid, $deviceid);
3192 } elsif ($deviceid =~ m/^(scsi)(\d+)$/) {
3194 qemu_findorcreatescsihw
($storecfg,$conf, $vmid, $device);
3195 qemu_driveadd
($storecfg, $vmid, $device);
3197 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
3198 eval { qemu_deviceadd
($vmid, $devicefull); };
3200 eval { qemu_drivedel
($vmid, $deviceid); };
3205 } elsif ($deviceid =~ m/^(net)(\d+)$/) {
3207 return undef if !qemu_netdevadd
($vmid, $conf, $device, $deviceid);
3208 my $netdevicefull = print_netdevice_full
($vmid, $conf, $device, $deviceid);
3209 qemu_deviceadd
($vmid, $netdevicefull);
3210 eval { qemu_deviceaddverify
($vmid, $deviceid); };
3212 eval { qemu_netdevdel
($vmid, $deviceid); };
3217 } elsif (!$q35 && $deviceid =~ m/^(pci\.)(\d+)$/) {
3220 my $pciaddr = print_pci_addr
($deviceid);
3221 my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
3223 qemu_deviceadd
($vmid, $devicefull);
3224 qemu_deviceaddverify
($vmid, $deviceid);
3227 die "can't hotplug device '$deviceid'\n";
3233 # fixme: this should raise exceptions on error!
3234 sub vm_deviceunplug
{
3235 my ($vmid, $conf, $deviceid) = @_;
3237 die "internal error" if !$conf->{hotplug
};
3239 my $devices_list = vm_devices_list
($vmid);
3240 return 1 if !defined($devices_list->{$deviceid});
3242 die "can't unplug bootdisk" if $conf->{bootdisk
} && $conf->{bootdisk
} eq $deviceid;
3244 if ($deviceid eq 'tablet') {
3246 qemu_devicedel
($vmid, $deviceid);
3248 } elsif ($deviceid =~ m/^(virtio)(\d+)$/) {
3250 qemu_devicedel
($vmid, $deviceid);
3251 qemu_devicedelverify
($vmid, $deviceid);
3252 qemu_drivedel
($vmid, $deviceid);
3254 } elsif ($deviceid =~ m/^(lsi)(\d+)$/) {
3256 qemu_devicedel
($vmid, $deviceid);
3258 } elsif ($deviceid =~ m/^(scsi)(\d+)$/) {
3260 qemu_devicedel
($vmid, $deviceid);
3261 qemu_drivedel
($vmid, $deviceid);
3263 } elsif ($deviceid =~ m/^(net)(\d+)$/) {
3265 qemu_devicedel
($vmid, $deviceid);
3266 qemu_devicedelverify
($vmid, $deviceid);
3267 qemu_netdevdel
($vmid, $deviceid);
3270 die "can't unplug device '$deviceid'\n";
3276 sub qemu_deviceadd
{
3277 my ($vmid, $devicefull) = @_;
3279 $devicefull = "driver=".$devicefull;
3280 my %options = split(/[=,]/, $devicefull);
3282 vm_mon_cmd
($vmid, "device_add" , %options);
3285 sub qemu_devicedel
{
3286 my ($vmid, $deviceid) = @_;
3288 my $ret = vm_mon_cmd
($vmid, "device_del", id
=> $deviceid);
3292 my ($storecfg, $vmid, $device) = @_;
3294 my $drive = print_drive_full
($storecfg, $vmid, $device);
3295 my $ret = vm_human_monitor_command
($vmid, "drive_add auto $drive");
3297 # If the command succeeds qemu prints: "OK"
3298 return 1 if $ret =~ m/OK/s;
3300 die "adding drive failed: $ret\n";
3304 my($vmid, $deviceid) = @_;
3306 my $ret = vm_human_monitor_command
($vmid, "drive_del drive-$deviceid");
3309 return 1 if $ret eq "";
3311 # NB: device not found errors mean the drive was auto-deleted and we ignore the error
3312 return 1 if $ret =~ m/Device \'.*?\' not found/s;
3314 die "deleting drive $deviceid failed : $ret\n";
3317 sub qemu_deviceaddverify
{
3318 my ($vmid, $deviceid) = @_;
3320 for (my $i = 0; $i <= 5; $i++) {
3321 my $devices_list = vm_devices_list
($vmid);
3322 return 1 if defined($devices_list->{$deviceid});
3326 die "error on hotplug device '$deviceid'\n";
3330 sub qemu_devicedelverify
{
3331 my ($vmid, $deviceid) = @_;
3333 # need to verify that the device is correctly removed as device_del
3334 # is async and empty return is not reliable
3336 for (my $i = 0; $i <= 5; $i++) {
3337 my $devices_list = vm_devices_list
($vmid);
3338 return 1 if !defined($devices_list->{$deviceid});
3342 die "error on hot-unplugging device '$deviceid'\n";
3345 sub qemu_findorcreatescsihw
{
3346 my ($storecfg, $conf, $vmid, $device) = @_;
3348 my $maxdev = ($conf->{scsihw
} && ($conf->{scsihw
} !~ m/^lsi/)) ?
256 : 7;
3349 my $controller = int($device->{index} / $maxdev);
3350 my $scsihwid="scsihw$controller";
3351 my $devices_list = vm_devices_list
($vmid);
3353 if(!defined($devices_list->{$scsihwid})) {
3354 vm_deviceplug
($storecfg, $conf, $vmid, $scsihwid);
3360 sub qemu_add_pci_bridge
{
3361 my ($storecfg, $conf, $vmid, $device) = @_;
3367 print_pci_addr
($device, $bridges);
3369 while (my ($k, $v) = each %$bridges) {
3372 return 1 if !defined($bridgeid) || $bridgeid < 1;
3374 my $bridge = "pci.$bridgeid";
3375 my $devices_list = vm_devices_list
($vmid);
3377 if (!defined($devices_list->{$bridge})) {
3378 vm_deviceplug
($storecfg, $conf, $vmid, $bridge);
3384 sub qemu_netdevadd
{
3385 my ($vmid, $conf, $device, $deviceid) = @_;
3387 my $netdev = print_netdev_full
($vmid, $conf, $device, $deviceid);
3388 my %options = split(/[=,]/, $netdev);
3390 vm_mon_cmd
($vmid, "netdev_add", %options);
3394 sub qemu_netdevdel
{
3395 my ($vmid, $deviceid) = @_;
3397 vm_mon_cmd
($vmid, "netdev_del", id
=> $deviceid);
3400 sub qemu_cpu_hotplug
{
3401 my ($vmid, $conf, $cores) = @_;
3403 my $sockets = $conf->{sockets
} || 1;
3404 die "cpu hotplug only works with one socket\n"
3407 die "maxcpus is not defined\n"
3408 if !$conf->{maxcpus
};
3410 die "you can't add more cores than maxcpus\n"
3411 if $cores > $conf->{maxcpus
};
3413 my $currentcores = $conf->{cores
} || 1;
3414 die "online cpu unplug is not yet possible\n"
3415 if $cores < $currentcores;
3417 my $currentrunningcores = vm_mon_cmd
($vmid, "query-cpus");
3418 die "cores number if running vm is different than configuration\n"
3419 if scalar(@{$currentrunningcores}) != $currentcores;
3421 for (my $i = $currentcores; $i < $cores; $i++) {
3422 vm_mon_cmd
($vmid, "cpu-add", id
=> int($i));
3426 sub qemu_block_set_io_throttle
{
3427 my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
3429 return if !check_running
($vmid) ;
3431 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));
3435 # old code, only used to shutdown old VM after update
3437 my ($fh, $timeout) = @_;
3439 my $sel = new IO
::Select
;
3446 while (scalar (@ready = $sel->can_read($timeout))) {
3448 if ($count = $fh->sysread($buf, 8192)) {
3449 if ($buf =~ /^(.*)\(qemu\) $/s) {
3456 if (!defined($count)) {
3463 die "monitor read timeout\n" if !scalar(@ready);
3468 # old code, only used to shutdown old VM after update
3469 sub vm_monitor_command
{
3470 my ($vmid, $cmdstr, $nocheck) = @_;
3475 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
3477 my $sname = "${var_run_tmpdir}/$vmid.mon";
3479 my $sock = IO
::Socket
::UNIX-
>new( Peer
=> $sname ) ||
3480 die "unable to connect to VM $vmid socket - $!\n";
3484 # hack: migrate sometime blocks the monitor (when migrate_downtime
3486 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3487 $timeout = 60*60; # 1 hour
3491 my $data = __read_avail
($sock, $timeout);
3493 if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
3494 die "got unexpected qemu monitor banner\n";
3497 my $sel = new IO
::Select
;
3500 if (!scalar(my @ready = $sel->can_write($timeout))) {
3501 die "monitor write error - timeout";
3504 my $fullcmd = "$cmdstr\r";
3506 # syslog('info', "VM $vmid monitor command: $cmdstr");
3509 if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
3510 die "monitor write error - $!";
3513 return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
3517 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3518 $timeout = 60*60; # 1 hour
3519 } elsif ($cmdstr =~ m/^(eject|change)/) {
3520 $timeout = 60; # note: cdrom mount command is slow
3522 if ($res = __read_avail
($sock, $timeout)) {
3524 my @lines = split("\r?\n", $res);
3526 shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
3528 $res = join("\n", @lines);
3536 syslog
("err", "VM $vmid monitor command failed - $err");
3543 sub qemu_block_resize
{
3544 my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
3546 my $running = check_running
($vmid);
3548 return if !PVE
::Storage
::volume_resize
($storecfg, $volid, $size, $running);
3550 return if !$running;
3552 vm_mon_cmd
($vmid, "block_resize", device
=> $deviceid, size
=> int($size));
3556 sub qemu_volume_snapshot
{
3557 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3559 my $running = check_running
($vmid);
3561 return if !PVE
::Storage
::volume_snapshot
($storecfg, $volid, $snap, $running);
3563 return if !$running;
3565 vm_mon_cmd
($vmid, "snapshot-drive", device
=> $deviceid, name
=> $snap);
3569 sub qemu_volume_snapshot_delete
{
3570 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3572 my $running = check_running
($vmid);
3574 return if !PVE
::Storage
::volume_snapshot_delete
($storecfg, $volid, $snap, $running);
3576 return if !$running;
3578 vm_mon_cmd
($vmid, "delete-drive-snapshot", device
=> $deviceid, name
=> $snap);
3581 sub set_migration_caps
{
3587 "auto-converge" => 1,
3589 "x-rdma-pin-all" => 0,
3593 my $supported_capabilities = vm_mon_cmd_nocheck
($vmid, "query-migrate-capabilities");
3595 for my $supported_capability (@$supported_capabilities) {
3597 capability
=> $supported_capability->{capability
},
3598 state => $enabled_cap->{$supported_capability->{capability
}} ? JSON
::true
: JSON
::false
,
3602 vm_mon_cmd_nocheck
($vmid, "migrate-set-capabilities", capabilities
=> $cap_ref);
3605 my $fast_plug_option = {
3613 # hotplug changes in [PENDING]
3614 # $selection hash can be used to only apply specified options, for
3615 # example: { cores => 1 } (only apply changed 'cores')
3616 # $errors ref is used to return error messages
3617 sub vmconfig_hotplug_pending
{
3618 my ($vmid, $conf, $storecfg, $selection, $errors) = @_;
3620 my $defaults = load_defaults
();
3622 # commit values which do not have any impact on running VM first
3623 # Note: those option cannot raise errors, we we do not care about
3624 # $selection and always apply them.
3626 my $add_error = sub {
3627 my ($opt, $msg) = @_;
3628 $errors->{$opt} = "hotplug problem - $msg";
3632 foreach my $opt (keys %{$conf->{pending
}}) { # add/change
3633 if ($fast_plug_option->{$opt}) {
3634 $conf->{$opt} = $conf->{pending
}->{$opt};
3635 delete $conf->{pending
}->{$opt};
3641 update_config_nolock
($vmid, $conf, 1);
3642 $conf = load_config
($vmid); # update/reload
3645 my $hotplug = defined($conf->{hotplug
}) ?
$conf->{hotplug
} : $defaults->{hotplug
};
3647 my @delete = PVE
::Tools
::split_list
($conf->{pending
}->{delete});
3648 foreach my $opt (@delete) {
3649 next if $selection && !$selection->{$opt};
3651 if ($opt eq 'tablet') {
3652 die "skip\n" if !$hotplug;
3653 if ($defaults->{tablet
}) {
3654 vm_deviceplug
($storecfg, $conf, $vmid, $opt);
3656 vm_deviceunplug
($vmid, $conf, $opt);
3658 } elsif ($opt eq 'cores') {
3659 die "skip\n" if !$hotplug;
3660 qemu_cpu_hotplug
($vmid, $conf, 1);
3661 } elsif ($opt eq 'balloon') {
3662 # enable balloon device is not hotpluggable
3663 die "skip\n" if !defined($conf->{balloon
}) || $conf->{balloon
};
3664 } elsif ($fast_plug_option->{$opt}) {
3666 } elsif ($opt =~ m/^net(\d+)$/) {
3667 die "skip\n" if !$hotplug;
3668 vm_deviceunplug
($vmid, $conf, $opt);
3669 } elsif (valid_drivename
($opt)) {
3670 die "skip\n" if !$hotplug || $opt =~ m/(ide|sata)(\d+)/;
3671 vm_deviceunplug
($vmid, $conf, $opt);
3672 vmconfig_register_unused_drive
($storecfg, $vmid, $conf, parse_drive
($opt, $conf->{$opt}));
3678 &$add_error($opt, $err) if $err ne "skip\n";
3680 # save new config if hotplug was successful
3681 delete $conf->{$opt};
3682 vmconfig_undelete_pending_option
($conf, $opt);
3683 update_config_nolock
($vmid, $conf, 1);
3684 $conf = load_config
($vmid); # update/reload
3688 foreach my $opt (keys %{$conf->{pending
}}) {
3689 next if $selection && !$selection->{$opt};
3690 my $value = $conf->{pending
}->{$opt};
3692 if ($opt eq 'tablet') {
3693 die "skip\n" if !$hotplug;
3695 vm_deviceplug
($storecfg, $conf, $vmid, $opt);
3696 } elsif ($value == 0) {
3697 vm_deviceunplug
($vmid, $conf, $opt);
3699 } elsif ($opt eq 'cores') {
3700 die "skip\n" if !$hotplug;
3701 qemu_cpu_hotplug
($vmid, $conf, $value);
3702 } elsif ($opt eq 'balloon') {
3703 # enable/disable balloning device is not hotpluggable
3704 my $old_balloon_enabled = !!(!defined($conf->{balloon
}) || $conf->{balloon
});
3705 my $new_balloon_enabled = !!(!defined($conf->{pending
}->{balloon
}) || $conf->{pending
}->{balloon
});
3706 die "skip\n" if $old_balloon_enabled != $new_balloon_enabled;
3708 # allow manual ballooning if shares is set to zero
3709 if (!(defined($conf->{shares
}) && ($conf->{shares
} == 0))) {
3710 my $balloon = $conf->{pending
}->{balloon
} || $conf->{memory
} || $defaults->{memory
};
3711 vm_mon_cmd
($vmid, "balloon", value
=> $balloon*1024*1024);
3713 } elsif ($opt =~ m/^net(\d+)$/) {
3714 # some changes can be done without hotplug
3715 vmconfig_update_net
($storecfg, $conf, $vmid, $opt, $value);
3716 } elsif (valid_drivename
($opt)) {
3717 # some changes can be done without hotplug
3718 vmconfig_update_disk
($storecfg, $conf, $vmid, $opt, $value, 1);
3720 die "skip\n"; # skip non-hot-pluggable options
3724 &$add_error($opt, $err) if $err ne "skip\n";
3726 # save new config if hotplug was successful
3727 $conf->{$opt} = $value;
3728 delete $conf->{pending
}->{$opt};
3729 update_config_nolock
($vmid, $conf, 1);
3730 $conf = load_config
($vmid); # update/reload
3735 sub vmconfig_apply_pending
{
3736 my ($vmid, $conf, $storecfg) = @_;
3740 my @delete = PVE
::Tools
::split_list
($conf->{pending
}->{delete});
3741 foreach my $opt (@delete) { # delete
3742 die "internal error" if $opt =~ m/^unused/;
3743 $conf = load_config
($vmid); # update/reload
3744 if (!defined($conf->{$opt})) {
3745 vmconfig_undelete_pending_option
($conf, $opt);
3746 update_config_nolock
($vmid, $conf, 1);
3747 } elsif (valid_drivename
($opt)) {
3748 vmconfig_register_unused_drive
($storecfg, $vmid, $conf, parse_drive
($opt, $conf->{$opt}));
3749 vmconfig_undelete_pending_option
($conf, $opt);
3750 delete $conf->{$opt};
3751 update_config_nolock
($vmid, $conf, 1);
3753 vmconfig_undelete_pending_option
($conf, $opt);
3754 delete $conf->{$opt};
3755 update_config_nolock
($vmid, $conf, 1);
3759 $conf = load_config
($vmid); # update/reload
3761 foreach my $opt (keys %{$conf->{pending
}}) { # add/change
3762 $conf = load_config
($vmid); # update/reload
3764 if (defined($conf->{$opt}) && ($conf->{$opt} eq $conf->{pending
}->{$opt})) {
3765 # skip if nothing changed
3766 } elsif (valid_drivename
($opt)) {
3767 vmconfig_register_unused_drive
($storecfg, $vmid, $conf, parse_drive
($opt, $conf->{$opt}))
3768 if defined($conf->{$opt});
3769 $conf->{$opt} = $conf->{pending
}->{$opt};
3771 $conf->{$opt} = $conf->{pending
}->{$opt};
3774 delete $conf->{pending
}->{$opt};
3775 update_config_nolock
($vmid, $conf, 1);
3779 my $safe_num_ne = sub {
3782 return 0 if !defined($a) && !defined($b);
3783 return 1 if !defined($a);
3784 return 1 if !defined($b);
3789 my $safe_string_ne = sub {
3792 return 0 if !defined($a) && !defined($b);
3793 return 1 if !defined($a);
3794 return 1 if !defined($b);
3799 sub vmconfig_update_net
{
3800 my ($storecfg, $conf, $vmid, $opt, $value) = @_;
3802 my $newnet = parse_net
($value);
3804 if ($conf->{$opt}) {
3805 my $oldnet = parse_net
($conf->{$opt});
3807 if (&$safe_string_ne($oldnet->{model
}, $newnet->{model
}) ||
3808 &$safe_string_ne($oldnet->{macaddr
}, $newnet->{macaddr
}) ||
3809 &$safe_num_ne($oldnet->{queues
}, $newnet->{queues
}) ||
3810 !($newnet->{bridge
} && $oldnet->{bridge
})) { # bridge/nat mode change
3812 # for non online change, we try to hot-unplug
3813 die "skip\n" if !$conf->{hotplug
};
3814 vm_deviceunplug
($vmid, $conf, $opt);
3817 die "internal error" if $opt !~ m/net(\d+)/;
3818 my $iface = "tap${vmid}i$1";
3820 if (&$safe_num_ne($oldnet->{rate
}, $newnet->{rate
})) {
3821 PVE
::Network
::tap_rate_limit
($iface, $newnet->{rate
});
3824 if(&$safe_string_ne($oldnet->{bridge
}, $newnet->{bridge
}) ||
3825 &$safe_num_ne($oldnet->{tag
}, $newnet->{tag
}) ||
3826 &$safe_num_ne($oldnet->{firewall
}, $newnet->{firewall
})) {
3827 PVE
::Network
::tap_unplug
($iface);
3828 PVE
::Network
::tap_plug
($iface, $newnet->{bridge
}, $newnet->{tag
}, $newnet->{firewall
});
3835 if ($conf->{hotplug
}) {
3836 vm_deviceplug
($storecfg, $conf, $vmid, $opt, $newnet);
3842 sub vmconfig_update_disk
{
3843 my ($storecfg, $conf, $vmid, $opt, $value, $force) = @_;
3845 # fixme: do we need force?
3847 my $drive = parse_drive
($opt, $value);
3849 if ($conf->{$opt}) {
3851 if (my $old_drive = parse_drive
($opt, $conf->{$opt})) {
3853 my $media = $drive->{media
} || 'disk';
3854 my $oldmedia = $old_drive->{media
} || 'disk';
3855 die "unable to change media type\n" if $media ne $oldmedia;
3857 if (!drive_is_cdrom
($old_drive)) {
3859 if ($drive->{file
} ne $old_drive->{file
}) {
3861 die "skip\n" if !$conf->{hotplug
};
3863 # unplug and register as unused
3864 vm_deviceunplug
($vmid, $conf, $opt);
3865 vmconfig_register_unused_drive
($storecfg, $vmid, $conf, $old_drive)
3868 # update existing disk
3870 # skip non hotpluggable value
3871 if (&$safe_num_ne($drive->{discard
}, $old_drive->{discard
}) ||
3872 &$safe_string_ne($drive->{cache
}, $old_drive->{cache
})) {
3877 if (&$safe_num_ne($drive->{mbps
}, $old_drive->{mbps
}) ||
3878 &$safe_num_ne($drive->{mbps_rd
}, $old_drive->{mbps_rd
}) ||
3879 &$safe_num_ne($drive->{mbps_wr
}, $old_drive->{mbps_wr
}) ||
3880 &$safe_num_ne($drive->{iops
}, $old_drive->{iops
}) ||
3881 &$safe_num_ne($drive->{iops_rd
}, $old_drive->{iops_rd
}) ||
3882 &$safe_num_ne($drive->{iops_wr
}, $old_drive->{iops_wr
}) ||
3883 &$safe_num_ne($drive->{mbps_max
}, $old_drive->{mbps_max
}) ||
3884 &$safe_num_ne($drive->{mbps_rd_max
}, $old_drive->{mbps_rd_max
}) ||
3885 &$safe_num_ne($drive->{mbps_wr_max
}, $old_drive->{mbps_wr_max
}) ||
3886 &$safe_num_ne($drive->{iops_max
}, $old_drive->{iops_max
}) ||
3887 &$safe_num_ne($drive->{iops_rd_max
}, $old_drive->{iops_rd_max
}) ||
3888 &$safe_num_ne($drive->{iops_wr_max
}, $old_drive->{iops_wr_max
})) {
3890 qemu_block_set_io_throttle
($vmid,"drive-$opt",
3891 ($drive->{mbps
} || 0)*1024*1024,
3892 ($drive->{mbps_rd
} || 0)*1024*1024,
3893 ($drive->{mbps_wr
} || 0)*1024*1024,
3894 $drive->{iops
} || 0,
3895 $drive->{iops_rd
} || 0,
3896 $drive->{iops_wr
} || 0,
3897 ($drive->{mbps_max
} || 0)*1024*1024,
3898 ($drive->{mbps_rd_max
} || 0)*1024*1024,
3899 ($drive->{mbps_wr_max
} || 0)*1024*1024,
3900 $drive->{iops_max
} || 0,
3901 $drive->{iops_rd_max
} || 0,
3902 $drive->{iops_wr_max
} || 0);
3912 if (drive_is_cdrom
($drive)) { # cdrom
3914 if ($drive->{file
} eq 'none') {
3915 vm_mon_cmd
($vmid, "eject",force
=> JSON
::true
,device
=> "drive-$opt");
3917 my $path = get_iso_path
($storecfg, $vmid, $drive->{file
});
3918 vm_mon_cmd
($vmid, "eject", force
=> JSON
::true
,device
=> "drive-$opt"); # force eject if locked
3919 vm_mon_cmd
($vmid, "change", device
=> "drive-$opt",target
=> "$path") if $path;
3923 die "skip\n" if !$conf->{hotplug
} || $opt =~ m/(ide|sata)(\d+)/;
3925 vm_deviceplug
($storecfg, $conf, $vmid, $opt, $drive);
3930 my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused, $forcemachine, $spice_ticket) = @_;
3932 lock_config
($vmid, sub {
3933 my $conf = load_config
($vmid, $migratedfrom);
3935 die "you can't start a vm if it's a template\n" if is_template
($conf);
3937 check_lock
($conf) if !$skiplock;
3939 die "VM $vmid already running\n" if check_running
($vmid, undef, $migratedfrom);
3941 if (!$statefile && scalar(keys %{$conf->{pending
}})) {
3942 vmconfig_apply_pending
($vmid, $conf, $storecfg);
3943 $conf = load_config
($vmid); # update/reload
3946 my $defaults = load_defaults
();
3948 # set environment variable useful inside network script
3949 $ENV{PVE_MIGRATED_FROM
} = $migratedfrom if $migratedfrom;
3951 my ($cmd, $vollist, $spice_port) = config_to_command
($storecfg, $vmid, $conf, $defaults, $forcemachine);
3953 my $migrate_port = 0;
3956 if ($statefile eq 'tcp') {
3957 my $localip = "localhost";
3958 my $datacenterconf = PVE
::Cluster
::cfs_read_file
('datacenter.cfg');
3959 if ($datacenterconf->{migration_unsecure
}) {
3960 my $nodename = PVE
::INotify
::nodename
();
3961 $localip = PVE
::Cluster
::remote_node_ip
($nodename, 1);
3963 $migrate_port = PVE
::Tools
::next_migrate_port
();
3964 $migrate_uri = "tcp:${localip}:${migrate_port}";
3965 push @$cmd, '-incoming', $migrate_uri;
3968 push @$cmd, '-loadstate', $statefile;
3975 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
3976 my $d = parse_hostpci
($conf->{"hostpci$i"});
3978 my $pcidevices = $d->{pciid
};
3979 foreach my $pcidevice (@$pcidevices) {
3980 my $pciid = $pcidevice->{id
}.".".$pcidevice->{function
};
3982 my $info = pci_device_info
("0000:$pciid");
3983 die "IOMMU not present\n" if !check_iommu_support
();
3984 die "no pci device info for device '$pciid'\n" if !$info;
3986 if ($d->{driver
} && $d->{driver
} eq "vfio") {
3987 die "can't unbind/bind pci group to vfio '$pciid'\n" if !pci_dev_group_bind_to_vfio
($pciid);
3989 die "can't unbind/bind to stub pci device '$pciid'\n" if !pci_dev_bind_to_stub
($info);
3992 die "can't reset pci device '$pciid'\n" if $info->{has_fl_reset
} and !pci_dev_reset
($info);
3996 PVE
::Storage
::activate_volumes
($storecfg, $vollist);
3998 eval { run_command
($cmd, timeout
=> $statefile ?
undef : 30,
4001 die "start failed: $err" if $err;
4003 print "migration listens on $migrate_uri\n" if $migrate_uri;
4005 if ($statefile && $statefile ne 'tcp') {
4006 eval { vm_mon_cmd_nocheck
($vmid, "cont"); };
4010 if ($migratedfrom) {
4013 set_migration_caps
($vmid);
4018 print "spice listens on port $spice_port\n";
4019 if ($spice_ticket) {
4020 vm_mon_cmd_nocheck
($vmid, "set_password", protocol
=> 'spice', password
=> $spice_ticket);
4021 vm_mon_cmd_nocheck
($vmid, "expire_password", protocol
=> 'spice', time => "+30");
4027 if (!$statefile && (!defined($conf->{balloon
}) || $conf->{balloon
})) {
4028 vm_mon_cmd_nocheck
($vmid, "balloon", value
=> $conf->{balloon
}*1024*1024)
4029 if $conf->{balloon
};
4030 vm_mon_cmd_nocheck
($vmid, 'qom-set',
4031 path
=> "machine/peripheral/balloon0",
4032 property
=> "guest-stats-polling-interval",
4040 my ($vmid, $execute, %params) = @_;
4042 my $cmd = { execute
=> $execute, arguments
=> \
%params };
4043 vm_qmp_command
($vmid, $cmd);
4046 sub vm_mon_cmd_nocheck
{
4047 my ($vmid, $execute, %params) = @_;
4049 my $cmd = { execute
=> $execute, arguments
=> \
%params };
4050 vm_qmp_command
($vmid, $cmd, 1);
4053 sub vm_qmp_command
{
4054 my ($vmid, $cmd, $nocheck) = @_;
4059 if ($cmd->{arguments
} && $cmd->{arguments
}->{timeout
}) {
4060 $timeout = $cmd->{arguments
}->{timeout
};
4061 delete $cmd->{arguments
}->{timeout
};
4065 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
4066 my $sname = qmp_socket
($vmid);
4067 if (-e
$sname) { # test if VM is reasonambe new and supports qmp/qga
4068 my $qmpclient = PVE
::QMPClient-
>new();
4070 $res = $qmpclient->cmd($vmid, $cmd, $timeout);
4071 } elsif (-e
"${var_run_tmpdir}/$vmid.mon") {
4072 die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
4073 if scalar(%{$cmd->{arguments
}});
4074 vm_monitor_command
($vmid, $cmd->{execute
}, $nocheck);
4076 die "unable to open monitor socket\n";
4080 syslog
("err", "VM $vmid qmp command failed - $err");
4087 sub vm_human_monitor_command
{
4088 my ($vmid, $cmdline) = @_;
4093 execute
=> 'human-monitor-command',
4094 arguments
=> { 'command-line' => $cmdline},
4097 return vm_qmp_command
($vmid, $cmd);
4100 sub vm_commandline
{
4101 my ($storecfg, $vmid) = @_;
4103 my $conf = load_config
($vmid);
4105 my $defaults = load_defaults
();
4107 my $cmd = config_to_command
($storecfg, $vmid, $conf, $defaults);
4109 return join(' ', @$cmd);
4113 my ($vmid, $skiplock) = @_;
4115 lock_config
($vmid, sub {
4117 my $conf = load_config
($vmid);
4119 check_lock
($conf) if !$skiplock;
4121 vm_mon_cmd
($vmid, "system_reset");
4125 sub get_vm_volumes
{
4129 foreach_volid
($conf, sub {
4130 my ($volid, $is_cdrom) = @_;
4132 return if $volid =~ m
|^/|;
4134 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
4137 push @$vollist, $volid;
4143 sub vm_stop_cleanup
{
4144 my ($storecfg, $vmid, $conf, $keepActive) = @_;
4147 fairsched_rmnod
($vmid); # try to destroy group
4150 my $vollist = get_vm_volumes
($conf);
4151 PVE
::Storage
::deactivate_volumes
($storecfg, $vollist);
4154 foreach my $ext (qw(mon qmp pid vnc qga)) {
4155 unlink "/var/run/qemu-server/${vmid}.$ext";
4158 warn $@ if $@; # avoid errors - just warn
4161 # Note: use $nockeck to skip tests if VM configuration file exists.
4162 # We need that when migration VMs to other nodes (files already moved)
4163 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
4165 my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
4167 $force = 1 if !defined($force) && !$shutdown;
4170 my $pid = check_running
($vmid, $nocheck, $migratedfrom);
4171 kill 15, $pid if $pid;
4172 my $conf = load_config
($vmid, $migratedfrom);
4173 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive);
4177 lock_config
($vmid, sub {
4179 my $pid = check_running
($vmid, $nocheck);
4184 $conf = load_config
($vmid);
4185 check_lock
($conf) if !$skiplock;
4186 if (!defined($timeout) && $shutdown && $conf->{startup
}) {
4187 my $opts = parse_startup
($conf->{startup
});
4188 $timeout = $opts->{down
} if $opts->{down
};
4192 $timeout = 60 if !defined($timeout);
4196 if (!$nocheck && $conf->{agent
}) {
4197 vm_qmp_command
($vmid, { execute
=> "guest-shutdown" }, $nocheck);
4199 vm_qmp_command
($vmid, { execute
=> "system_powerdown" }, $nocheck);
4202 vm_qmp_command
($vmid, { execute
=> "quit" }, $nocheck);
4209 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
4214 if ($count >= $timeout) {
4216 warn "VM still running - terminating now with SIGTERM\n";
4219 die "VM quit/powerdown failed - got timeout\n";
4222 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
4227 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
4230 die "VM quit/powerdown failed\n";
4238 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
4243 if ($count >= $timeout) {
4244 warn "VM still running - terminating now with SIGKILL\n";
4249 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
4254 my ($vmid, $skiplock) = @_;
4256 lock_config
($vmid, sub {
4258 my $conf = load_config
($vmid);
4260 check_lock
($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
4262 vm_mon_cmd
($vmid, "stop");
4267 my ($vmid, $skiplock) = @_;
4269 lock_config
($vmid, sub {
4271 my $conf = load_config
($vmid);
4273 check_lock
($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
4275 vm_mon_cmd
($vmid, "cont");
4280 my ($vmid, $skiplock, $key) = @_;
4282 lock_config
($vmid, sub {
4284 my $conf = load_config
($vmid);
4286 # there is no qmp command, so we use the human monitor command
4287 vm_human_monitor_command
($vmid, "sendkey $key");
4292 my ($storecfg, $vmid, $skiplock) = @_;
4294 lock_config
($vmid, sub {
4296 my $conf = load_config
($vmid);
4298 check_lock
($conf) if !$skiplock;
4300 if (!check_running
($vmid)) {
4301 fairsched_rmnod
($vmid); # try to destroy group
4302 destroy_vm
($storecfg, $vmid);
4304 die "VM $vmid is running - destroy failed\n";
4312 my ($filename, $buf) = @_;
4314 my $fh = IO
::File-
>new($filename, "w");
4315 return undef if !$fh;
4317 my $res = print $fh $buf;
4324 sub pci_device_info
{
4329 return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
4330 my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
4332 my $irq = file_read_firstline
("$pcisysfs/devices/$name/irq");
4333 return undef if !defined($irq) || $irq !~ m/^\d+$/;
4335 my $vendor = file_read_firstline
("$pcisysfs/devices/$name/vendor");
4336 return undef if !defined($vendor) || $vendor !~ s/^0x//;
4338 my $product = file_read_firstline
("$pcisysfs/devices/$name/device");
4339 return undef if !defined($product) || $product !~ s/^0x//;
4344 product
=> $product,
4350 has_fl_reset
=> -f
"$pcisysfs/devices/$name/reset" || 0,
4359 my $name = $dev->{name
};
4361 my $fn = "$pcisysfs/devices/$name/reset";
4363 return file_write
($fn, "1");
4366 sub pci_dev_bind_to_stub
{
4369 my $name = $dev->{name
};
4371 my $testdir = "$pcisysfs/drivers/pci-stub/$name";
4372 return 1 if -d
$testdir;
4374 my $data = "$dev->{vendor} $dev->{product}";
4375 return undef if !file_write
("$pcisysfs/drivers/pci-stub/new_id", $data);
4377 my $fn = "$pcisysfs/devices/$name/driver/unbind";
4378 if (!file_write
($fn, $name)) {
4379 return undef if -f
$fn;
4382 $fn = "$pcisysfs/drivers/pci-stub/bind";
4383 if (! -d
$testdir) {
4384 return undef if !file_write
($fn, $name);
4390 sub pci_dev_bind_to_vfio
{
4393 my $name = $dev->{name
};
4395 my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4397 if (!-d
$vfio_basedir) {
4398 system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4400 die "Cannot find vfio-pci module!\n" if !-d
$vfio_basedir;
4402 my $testdir = "$vfio_basedir/$name";
4403 return 1 if -d
$testdir;
4405 my $data = "$dev->{vendor} $dev->{product}";
4406 return undef if !file_write
("$vfio_basedir/new_id", $data);
4408 my $fn = "$pcisysfs/devices/$name/driver/unbind";
4409 if (!file_write
($fn, $name)) {
4410 return undef if -f
$fn;
4413 $fn = "$vfio_basedir/bind";
4414 if (! -d
$testdir) {
4415 return undef if !file_write
($fn, $name);
4421 sub pci_dev_group_bind_to_vfio
{
4424 my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4426 if (!-d
$vfio_basedir) {
4427 system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4429 die "Cannot find vfio-pci module!\n" if !-d
$vfio_basedir;
4431 # get IOMMU group devices
4432 opendir(my $D, "$pcisysfs/devices/0000:$pciid/iommu_group/devices/") || die "Cannot open iommu_group: $!\n";
4433 my @devs = grep /^0000:/, readdir($D);
4436 foreach my $pciid (@devs) {
4437 $pciid =~ m/^([:\.\da-f]+)$/ or die "PCI ID $pciid not valid!\n";
4438 my $info = pci_device_info
($1);
4439 pci_dev_bind_to_vfio
($info) || die "Cannot bind $pciid to vfio\n";
4445 sub print_pci_addr
{
4446 my ($id, $bridges) = @_;
4450 piix3
=> { bus
=> 0, addr
=> 1 },
4451 #addr2 : first videocard
4452 balloon0
=> { bus
=> 0, addr
=> 3 },
4453 watchdog
=> { bus
=> 0, addr
=> 4 },
4454 scsihw0
=> { bus
=> 0, addr
=> 5 },
4455 scsihw1
=> { bus
=> 0, addr
=> 6 },
4456 ahci0
=> { bus
=> 0, addr
=> 7 },
4457 qga0
=> { bus
=> 0, addr
=> 8 },
4458 spice
=> { bus
=> 0, addr
=> 9 },
4459 virtio0
=> { bus
=> 0, addr
=> 10 },
4460 virtio1
=> { bus
=> 0, addr
=> 11 },
4461 virtio2
=> { bus
=> 0, addr
=> 12 },
4462 virtio3
=> { bus
=> 0, addr
=> 13 },
4463 virtio4
=> { bus
=> 0, addr
=> 14 },
4464 virtio5
=> { bus
=> 0, addr
=> 15 },
4465 hostpci0
=> { bus
=> 0, addr
=> 16 },
4466 hostpci1
=> { bus
=> 0, addr
=> 17 },
4467 net0
=> { bus
=> 0, addr
=> 18 },
4468 net1
=> { bus
=> 0, addr
=> 19 },
4469 net2
=> { bus
=> 0, addr
=> 20 },
4470 net3
=> { bus
=> 0, addr
=> 21 },
4471 net4
=> { bus
=> 0, addr
=> 22 },
4472 net5
=> { bus
=> 0, addr
=> 23 },
4473 vga1
=> { bus
=> 0, addr
=> 24 },
4474 vga2
=> { bus
=> 0, addr
=> 25 },
4475 vga3
=> { bus
=> 0, addr
=> 26 },
4476 hostpci2
=> { bus
=> 0, addr
=> 27 },
4477 hostpci3
=> { bus
=> 0, addr
=> 28 },
4478 #addr29 : usb-host (pve-usb.cfg)
4479 'pci.1' => { bus
=> 0, addr
=> 30 },
4480 'pci.2' => { bus
=> 0, addr
=> 31 },
4481 'net6' => { bus
=> 1, addr
=> 1 },
4482 'net7' => { bus
=> 1, addr
=> 2 },
4483 'net8' => { bus
=> 1, addr
=> 3 },
4484 'net9' => { bus
=> 1, addr
=> 4 },
4485 'net10' => { bus
=> 1, addr
=> 5 },
4486 'net11' => { bus
=> 1, addr
=> 6 },
4487 'net12' => { bus
=> 1, addr
=> 7 },
4488 'net13' => { bus
=> 1, addr
=> 8 },
4489 'net14' => { bus
=> 1, addr
=> 9 },
4490 'net15' => { bus
=> 1, addr
=> 10 },
4491 'net16' => { bus
=> 1, addr
=> 11 },
4492 'net17' => { bus
=> 1, addr
=> 12 },
4493 'net18' => { bus
=> 1, addr
=> 13 },
4494 'net19' => { bus
=> 1, addr
=> 14 },
4495 'net20' => { bus
=> 1, addr
=> 15 },
4496 'net21' => { bus
=> 1, addr
=> 16 },
4497 'net22' => { bus
=> 1, addr
=> 17 },
4498 'net23' => { bus
=> 1, addr
=> 18 },
4499 'net24' => { bus
=> 1, addr
=> 19 },
4500 'net25' => { bus
=> 1, addr
=> 20 },
4501 'net26' => { bus
=> 1, addr
=> 21 },
4502 'net27' => { bus
=> 1, addr
=> 22 },
4503 'net28' => { bus
=> 1, addr
=> 23 },
4504 'net29' => { bus
=> 1, addr
=> 24 },
4505 'net30' => { bus
=> 1, addr
=> 25 },
4506 'net31' => { bus
=> 1, addr
=> 26 },
4507 'virtio6' => { bus
=> 2, addr
=> 1 },
4508 'virtio7' => { bus
=> 2, addr
=> 2 },
4509 'virtio8' => { bus
=> 2, addr
=> 3 },
4510 'virtio9' => { bus
=> 2, addr
=> 4 },
4511 'virtio10' => { bus
=> 2, addr
=> 5 },
4512 'virtio11' => { bus
=> 2, addr
=> 6 },
4513 'virtio12' => { bus
=> 2, addr
=> 7 },
4514 'virtio13' => { bus
=> 2, addr
=> 8 },
4515 'virtio14' => { bus
=> 2, addr
=> 9 },
4516 'virtio15' => { bus
=> 2, addr
=> 10 },
4519 if (defined($devices->{$id}->{bus
}) && defined($devices->{$id}->{addr
})) {
4520 my $addr = sprintf("0x%x", $devices->{$id}->{addr
});
4521 my $bus = $devices->{$id}->{bus
};
4522 $res = ",bus=pci.$bus,addr=$addr";
4523 $bridges->{$bus} = 1 if $bridges;
4529 sub print_pcie_addr
{
4534 hostpci0
=> { bus
=> "ich9-pcie-port-1", addr
=> 0 },
4535 hostpci1
=> { bus
=> "ich9-pcie-port-2", addr
=> 0 },
4536 hostpci2
=> { bus
=> "ich9-pcie-port-3", addr
=> 0 },
4537 hostpci3
=> { bus
=> "ich9-pcie-port-4", addr
=> 0 },
4540 if (defined($devices->{$id}->{bus
}) && defined($devices->{$id}->{addr
})) {
4541 my $addr = sprintf("0x%x", $devices->{$id}->{addr
});
4542 my $bus = $devices->{$id}->{bus
};
4543 $res = ",bus=$bus,addr=$addr";
4549 # vzdump restore implementaion
4551 sub tar_archive_read_firstfile
{
4552 my $archive = shift;
4554 die "ERROR: file '$archive' does not exist\n" if ! -f
$archive;
4556 # try to detect archive type first
4557 my $pid = open (TMP
, "tar tf '$archive'|") ||
4558 die "unable to open file '$archive'\n";
4559 my $firstfile = <TMP
>;
4563 die "ERROR: archive contaions no data\n" if !$firstfile;
4569 sub tar_restore_cleanup
{
4570 my ($storecfg, $statfile) = @_;
4572 print STDERR
"starting cleanup\n";
4574 if (my $fd = IO
::File-
>new($statfile, "r")) {
4575 while (defined(my $line = <$fd>)) {
4576 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4579 if ($volid =~ m
|^/|) {
4580 unlink $volid || die 'unlink failed\n';
4582 PVE
::Storage
::vdisk_free
($storecfg, $volid);
4584 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
4586 print STDERR
"unable to cleanup '$volid' - $@" if $@;
4588 print STDERR
"unable to parse line in statfile - $line";
4595 sub restore_archive
{
4596 my ($archive, $vmid, $user, $opts) = @_;
4598 my $format = $opts->{format
};
4601 if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
4602 $format = 'tar' if !$format;
4604 } elsif ($archive =~ m/\.tar$/) {
4605 $format = 'tar' if !$format;
4606 } elsif ($archive =~ m/.tar.lzo$/) {
4607 $format = 'tar' if !$format;
4609 } elsif ($archive =~ m/\.vma$/) {
4610 $format = 'vma' if !$format;
4611 } elsif ($archive =~ m/\.vma\.gz$/) {
4612 $format = 'vma' if !$format;
4614 } elsif ($archive =~ m/\.vma\.lzo$/) {
4615 $format = 'vma' if !$format;
4618 $format = 'vma' if !$format; # default
4621 # try to detect archive format
4622 if ($format eq 'tar') {
4623 return restore_tar_archive
($archive, $vmid, $user, $opts);
4625 return restore_vma_archive
($archive, $vmid, $user, $opts, $comp);
4629 sub restore_update_config_line
{
4630 my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
4632 return if $line =~ m/^\#qmdump\#/;
4633 return if $line =~ m/^\#vzdump\#/;
4634 return if $line =~ m/^lock:/;
4635 return if $line =~ m/^unused\d+:/;
4636 return if $line =~ m/^parent:/;
4637 return if $line =~ m/^template:/; # restored VM is never a template
4639 if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
4640 # try to convert old 1.X settings
4641 my ($id, $ind, $ethcfg) = ($1, $2, $3);
4642 foreach my $devconfig (PVE
::Tools
::split_list
($ethcfg)) {
4643 my ($model, $macaddr) = split(/\=/, $devconfig);
4644 $macaddr = PVE
::Tools
::random_ether_addr
() if !$macaddr || $unique;
4647 bridge
=> "vmbr$ind",
4648 macaddr
=> $macaddr,
4650 my $netstr = print_net
($net);
4652 print $outfd "net$cookie->{netcount}: $netstr\n";
4653 $cookie->{netcount
}++;
4655 } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
4656 my ($id, $netstr) = ($1, $2);
4657 my $net = parse_net
($netstr);
4658 $net->{macaddr
} = PVE
::Tools
::random_ether_addr
() if $net->{macaddr
};
4659 $netstr = print_net
($net);
4660 print $outfd "$id: $netstr\n";
4661 } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
4664 if ($line =~ m/backup=no/) {
4665 print $outfd "#$line";
4666 } elsif ($virtdev && $map->{$virtdev}) {
4667 my $di = parse_drive
($virtdev, $value);
4668 delete $di->{format
}; # format can change on restore
4669 $di->{file
} = $map->{$virtdev};
4670 $value = print_drive
($vmid, $di);
4671 print $outfd "$virtdev: $value\n";
4681 my ($cfg, $vmid) = @_;
4683 my $info = PVE
::Storage
::vdisk_list
($cfg, undef, $vmid);
4685 my $volid_hash = {};
4686 foreach my $storeid (keys %$info) {
4687 foreach my $item (@{$info->{$storeid}}) {
4688 next if !($item->{volid
} && $item->{size
});
4689 $item->{path
} = PVE
::Storage
::path
($cfg, $item->{volid
});
4690 $volid_hash->{$item->{volid
}} = $item;
4697 sub get_used_paths
{
4698 my ($vmid, $storecfg, $conf, $scan_snapshots, $skip_drive) = @_;
4702 my $scan_config = sub {
4703 my ($cref, $snapname) = @_;
4705 foreach my $key (keys %$cref) {
4706 my $value = $cref->{$key};
4707 if (valid_drivename
($key)) {
4708 next if $skip_drive && $key eq $skip_drive;
4709 my $drive = parse_drive
($key, $value);
4710 next if !$drive || !$drive->{file
} || drive_is_cdrom
($drive);
4711 if ($drive->{file
} =~ m!^/!) {
4712 $used_path->{$drive->{file
}}++; # = 1;
4714 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($drive->{file
}, 1);
4716 my $scfg = PVE
::Storage
::storage_config
($storecfg, $storeid, 1);
4718 my $path = PVE
::Storage
::path
($storecfg, $drive->{file
}, $snapname);
4719 $used_path->{$path}++; # = 1;
4725 &$scan_config($conf);
4729 if ($scan_snapshots) {
4730 foreach my $snapname (keys %{$conf->{snapshots
}}) {
4731 &$scan_config($conf->{snapshots
}->{$snapname}, $snapname);
4738 sub update_disksize
{
4739 my ($vmid, $conf, $volid_hash) = @_;
4745 # Note: it is allowed to define multiple storages with same path (alias), so
4746 # we need to check both 'volid' and real 'path' (two different volid can point
4747 # to the same path).
4752 foreach my $opt (keys %$conf) {
4753 if (valid_drivename
($opt)) {
4754 my $drive = parse_drive
($opt, $conf->{$opt});
4755 my $volid = $drive->{file
};
4758 $used->{$volid} = 1;
4759 if ($volid_hash->{$volid} &&
4760 (my $path = $volid_hash->{$volid}->{path
})) {
4761 $usedpath->{$path} = 1;
4764 next if drive_is_cdrom
($drive);
4765 next if !$volid_hash->{$volid};
4767 $drive->{size
} = $volid_hash->{$volid}->{size
};
4768 my $new = print_drive
($vmid, $drive);
4769 if ($new ne $conf->{$opt}) {
4771 $conf->{$opt} = $new;
4776 # remove 'unusedX' entry if volume is used
4777 foreach my $opt (keys %$conf) {
4778 next if $opt !~ m/^unused\d+$/;
4779 my $volid = $conf->{$opt};
4780 my $path = $volid_hash->{$volid}->{path
} if $volid_hash->{$volid};
4781 if ($used->{$volid} || ($path && $usedpath->{$path})) {
4783 delete $conf->{$opt};
4787 foreach my $volid (sort keys %$volid_hash) {
4788 next if $volid =~ m/vm-$vmid-state-/;
4789 next if $used->{$volid};
4790 my $path = $volid_hash->{$volid}->{path
};
4791 next if !$path; # just to be sure
4792 next if $usedpath->{$path};
4794 add_unused_volume
($conf, $volid);
4795 $usedpath->{$path} = 1; # avoid to add more than once (aliases)
4802 my ($vmid, $nolock) = @_;
4804 my $cfg = PVE
::Cluster
::cfs_read_file
("storage.cfg");
4806 my $volid_hash = scan_volids
($cfg, $vmid);
4808 my $updatefn = sub {
4811 my $conf = load_config
($vmid);
4816 foreach my $volid (keys %$volid_hash) {
4817 my $info = $volid_hash->{$volid};
4818 $vm_volids->{$volid} = $info if $info->{vmid
} && $info->{vmid
} == $vmid;
4821 my $changes = update_disksize
($vmid, $conf, $vm_volids);
4823 update_config_nolock
($vmid, $conf, 1) if $changes;
4826 if (defined($vmid)) {
4830 lock_config
($vmid, $updatefn, $vmid);
4833 my $vmlist = config_list
();
4834 foreach my $vmid (keys %$vmlist) {
4838 lock_config
($vmid, $updatefn, $vmid);
4844 sub restore_vma_archive
{
4845 my ($archive, $vmid, $user, $opts, $comp) = @_;
4847 my $input = $archive eq '-' ?
"<&STDIN" : undef;
4848 my $readfrom = $archive;
4853 my $qarchive = PVE
::Tools
::shellquote
($archive);
4854 if ($comp eq 'gzip') {
4855 $uncomp = "zcat $qarchive|";
4856 } elsif ($comp eq 'lzop') {
4857 $uncomp = "lzop -d -c $qarchive|";
4859 die "unknown compression method '$comp'\n";
4864 my $tmpdir = "/var/tmp/vzdumptmp$$";
4867 # disable interrupts (always do cleanups)
4868 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
4869 warn "got interrupt - ignored\n";
4872 my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
4873 POSIX
::mkfifo
($mapfifo, 0600);
4876 my $openfifo = sub {
4877 open($fifofh, '>', $mapfifo) || die $!;
4880 my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
4887 my $rpcenv = PVE
::RPCEnvironment
::get
();
4889 my $conffile = config_file
($vmid);
4890 my $tmpfn = "$conffile.$$.tmp";
4892 # Note: $oldconf is undef if VM does not exists
4893 my $oldconf = PVE
::Cluster
::cfs_read_file
(cfs_config_path
($vmid));
4895 my $print_devmap = sub {
4896 my $virtdev_hash = {};
4898 my $cfgfn = "$tmpdir/qemu-server.conf";
4900 # we can read the config - that is already extracted
4901 my $fh = IO
::File-
>new($cfgfn, "r") ||
4902 "unable to read qemu-server.conf - $!\n";
4904 while (defined(my $line = <$fh>)) {
4905 if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
4906 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
4907 die "archive does not contain data for drive '$virtdev'\n"
4908 if !$devinfo->{$devname};
4909 if (defined($opts->{storage
})) {
4910 $storeid = $opts->{storage
} || 'local';
4911 } elsif (!$storeid) {
4914 $format = 'raw' if !$format;
4915 $devinfo->{$devname}->{devname
} = $devname;
4916 $devinfo->{$devname}->{virtdev
} = $virtdev;
4917 $devinfo->{$devname}->{format
} = $format;
4918 $devinfo->{$devname}->{storeid
} = $storeid;
4920 # check permission on storage
4921 my $pool = $opts->{pool
}; # todo: do we need that?
4922 if ($user ne 'root@pam') {
4923 $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
4926 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
4930 foreach my $devname (keys %$devinfo) {
4931 die "found no device mapping information for device '$devname'\n"
4932 if !$devinfo->{$devname}->{virtdev
};
4935 my $cfg = cfs_read_file
('storage.cfg');
4937 # create empty/temp config
4939 PVE
::Tools
::file_set_contents
($conffile, "memory: 128\n");
4940 foreach_drive
($oldconf, sub {
4941 my ($ds, $drive) = @_;
4943 return if drive_is_cdrom
($drive);
4945 my $volid = $drive->{file
};
4947 return if !$volid || $volid =~ m
|^/|;
4949 my ($path, $owner) = PVE
::Storage
::path
($cfg, $volid);
4950 return if !$path || !$owner || ($owner != $vmid);
4952 # Note: only delete disk we want to restore
4953 # other volumes will become unused
4954 if ($virtdev_hash->{$ds}) {
4955 PVE
::Storage
::vdisk_free
($cfg, $volid);
4961 foreach my $virtdev (sort keys %$virtdev_hash) {
4962 my $d = $virtdev_hash->{$virtdev};
4963 my $alloc_size = int(($d->{size
} + 1024 - 1)/1024);
4964 my $scfg = PVE
::Storage
::storage_config
($cfg, $d->{storeid
});
4966 # test if requested format is supported
4967 my ($defFormat, $validFormats) = PVE
::Storage
::storage_default_format
($cfg, $d->{storeid
});
4968 my $supported = grep { $_ eq $d->{format
} } @$validFormats;
4969 $d->{format
} = $defFormat if !$supported;
4971 my $volid = PVE
::Storage
::vdisk_alloc
($cfg, $d->{storeid
}, $vmid,
4972 $d->{format
}, undef, $alloc_size);
4973 print STDERR
"new volume ID is '$volid'\n";
4974 $d->{volid
} = $volid;
4975 my $path = PVE
::Storage
::path
($cfg, $volid);
4977 my $write_zeros = 1;
4978 # fixme: what other storages types initialize volumes with zero?
4979 if ($scfg->{type
} eq 'dir' || $scfg->{type
} eq 'nfs' || $scfg->{type
} eq 'glusterfs' ||
4980 $scfg->{type
} eq 'sheepdog' || $scfg->{type
} eq 'rbd') {
4984 print $fifofh "${write_zeros}:$d->{devname}=$path\n";
4986 print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
4987 $map->{$virtdev} = $volid;
4990 $fh->seek(0, 0) || die "seek failed - $!\n";
4992 my $outfd = new IO
::File
($tmpfn, "w") ||
4993 die "unable to write config for VM $vmid\n";
4995 my $cookie = { netcount
=> 0 };
4996 while (defined(my $line = <$fh>)) {
4997 restore_update_config_line
($outfd, $cookie, $vmid, $map, $line, $opts->{unique
});
5006 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
5007 die "interrupted by signal\n";
5009 local $SIG{ALRM
} = sub { die "got timeout\n"; };
5011 $oldtimeout = alarm($timeout);
5018 if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
5019 my ($dev_id, $size, $devname) = ($1, $2, $3);
5020 $devinfo->{$devname} = { size
=> $size, dev_id
=> $dev_id };
5021 } elsif ($line =~ m/^CTIME: /) {
5022 # we correctly received the vma config, so we can disable
5023 # the timeout now for disk allocation (set to 10 minutes, so
5024 # that we always timeout if something goes wrong)
5027 print $fifofh "done\n";
5028 my $tmp = $oldtimeout || 0;
5029 $oldtimeout = undef;
5035 print "restore vma archive: $cmd\n";
5036 run_command
($cmd, input
=> $input, outfunc
=> $parser, afterfork
=> $openfifo);
5040 alarm($oldtimeout) if $oldtimeout;
5048 my $cfg = cfs_read_file
('storage.cfg');
5049 foreach my $devname (keys %$devinfo) {
5050 my $volid = $devinfo->{$devname}->{volid
};
5053 if ($volid =~ m
|^/|) {
5054 unlink $volid || die 'unlink failed\n';
5056 PVE
::Storage
::vdisk_free
($cfg, $volid);
5058 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
5060 print STDERR
"unable to cleanup '$volid' - $@" if $@;
5067 rename($tmpfn, $conffile) ||
5068 die "unable to commit configuration file '$conffile'\n";
5070 PVE
::Cluster
::cfs_update
(); # make sure we read new file
5072 eval { rescan
($vmid, 1); };
5076 sub restore_tar_archive
{
5077 my ($archive, $vmid, $user, $opts) = @_;
5079 if ($archive ne '-') {
5080 my $firstfile = tar_archive_read_firstfile
($archive);
5081 die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
5082 if $firstfile ne 'qemu-server.conf';
5085 my $storecfg = cfs_read_file
('storage.cfg');
5087 # destroy existing data - keep empty config
5088 my $vmcfgfn = config_file
($vmid);
5089 destroy_vm
($storecfg, $vmid, 1) if -f
$vmcfgfn;
5091 my $tocmd = "/usr/lib/qemu-server/qmextract";
5093 $tocmd .= " --storage " . PVE
::Tools
::shellquote
($opts->{storage
}) if $opts->{storage
};
5094 $tocmd .= " --pool " . PVE
::Tools
::shellquote
($opts->{pool
}) if $opts->{pool
};
5095 $tocmd .= ' --prealloc' if $opts->{prealloc
};
5096 $tocmd .= ' --info' if $opts->{info
};
5098 # tar option "xf" does not autodetect compression when read from STDIN,
5099 # so we pipe to zcat
5100 my $cmd = "zcat -f|tar xf " . PVE
::Tools
::shellquote
($archive) . " " .
5101 PVE
::Tools
::shellquote
("--to-command=$tocmd");
5103 my $tmpdir = "/var/tmp/vzdumptmp$$";
5106 local $ENV{VZDUMP_TMPDIR
} = $tmpdir;
5107 local $ENV{VZDUMP_VMID
} = $vmid;
5108 local $ENV{VZDUMP_USER
} = $user;
5110 my $conffile = config_file
($vmid);
5111 my $tmpfn = "$conffile.$$.tmp";
5113 # disable interrupts (always do cleanups)
5114 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
5115 print STDERR
"got interrupt - ignored\n";
5120 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
5121 die "interrupted by signal\n";
5124 if ($archive eq '-') {
5125 print "extracting archive from STDIN\n";
5126 run_command
($cmd, input
=> "<&STDIN");
5128 print "extracting archive '$archive'\n";
5132 return if $opts->{info
};
5136 my $statfile = "$tmpdir/qmrestore.stat";
5137 if (my $fd = IO
::File-
>new($statfile, "r")) {
5138 while (defined (my $line = <$fd>)) {
5139 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
5140 $map->{$1} = $2 if $1;
5142 print STDERR
"unable to parse line in statfile - $line\n";
5148 my $confsrc = "$tmpdir/qemu-server.conf";
5150 my $srcfd = new IO
::File
($confsrc, "r") ||
5151 die "unable to open file '$confsrc'\n";
5153 my $outfd = new IO
::File
($tmpfn, "w") ||
5154 die "unable to write config for VM $vmid\n";
5156 my $cookie = { netcount
=> 0 };
5157 while (defined (my $line = <$srcfd>)) {
5158 restore_update_config_line
($outfd, $cookie, $vmid, $map, $line, $opts->{unique
});
5170 tar_restore_cleanup
($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info
};
5177 rename $tmpfn, $conffile ||
5178 die "unable to commit configuration file '$conffile'\n";
5180 PVE
::Cluster
::cfs_update
(); # make sure we read new file
5182 eval { rescan
($vmid, 1); };
5187 # Internal snapshots
5189 # NOTE: Snapshot create/delete involves several non-atomic
5190 # action, and can take a long time.
5191 # So we try to avoid locking the file and use 'lock' variable
5192 # inside the config file instead.
5194 my $snapshot_copy_config = sub {
5195 my ($source, $dest) = @_;
5197 foreach my $k (keys %$source) {
5198 next if $k eq 'snapshots';
5199 next if $k eq 'snapstate';
5200 next if $k eq 'snaptime';
5201 next if $k eq 'vmstate';
5202 next if $k eq 'lock';
5203 next if $k eq 'digest';
5204 next if $k eq 'description';
5205 next if $k =~ m/^unused\d+$/;
5207 $dest->{$k} = $source->{$k};
5211 my $snapshot_apply_config = sub {
5212 my ($conf, $snap) = @_;
5214 # copy snapshot list
5216 snapshots
=> $conf->{snapshots
},
5219 # keep description and list of unused disks
5220 foreach my $k (keys %$conf) {
5221 next if !($k =~ m/^unused\d+$/ || $k eq 'description');
5222 $newconf->{$k} = $conf->{$k};
5225 &$snapshot_copy_config($snap, $newconf);
5230 sub foreach_writable_storage
{
5231 my ($conf, $func) = @_;
5235 foreach my $ds (keys %$conf) {
5236 next if !valid_drivename
($ds);
5238 my $drive = parse_drive
($ds, $conf->{$ds});
5240 next if drive_is_cdrom
($drive);
5242 my $volid = $drive->{file
};
5244 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
5245 $sidhash->{$sid} = $sid if $sid;
5248 foreach my $sid (sort keys %$sidhash) {
5253 my $alloc_vmstate_volid = sub {
5254 my ($storecfg, $vmid, $conf, $snapname) = @_;
5256 # Note: we try to be smart when selecting a $target storage
5260 # search shared storage first
5261 foreach_writable_storage
($conf, sub {
5263 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
5264 return if !$scfg->{shared
};
5266 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage
5270 # now search local storage
5271 foreach_writable_storage
($conf, sub {
5273 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
5274 return if $scfg->{shared
};
5276 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage;
5280 $target = 'local' if !$target;
5282 my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
5283 # we abort live save after $conf->{memory}, so we need at max twice that space
5284 my $size = $conf->{memory
}*2 + $driver_state_size;
5286 my $name = "vm-$vmid-state-$snapname";
5287 my $scfg = PVE
::Storage
::storage_config
($storecfg, $target);
5288 $name .= ".raw" if $scfg->{path
}; # add filename extension for file base storage
5289 my $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $target, $vmid, 'raw', $name, $size*1024);
5294 my $snapshot_prepare = sub {
5295 my ($vmid, $snapname, $save_vmstate, $comment) = @_;
5299 my $updatefn = sub {
5301 my $conf = load_config
($vmid);
5303 die "you can't take a snapshot if it's a template\n"
5304 if is_template
($conf);
5308 $conf->{lock} = 'snapshot';
5310 die "snapshot name '$snapname' already used\n"
5311 if defined($conf->{snapshots
}->{$snapname});
5313 my $storecfg = PVE
::Storage
::config
();
5314 die "snapshot feature is not available" if !has_feature
('snapshot', $conf, $storecfg);
5316 $snap = $conf->{snapshots
}->{$snapname} = {};
5318 if ($save_vmstate && check_running
($vmid)) {
5319 $snap->{vmstate
} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
5322 &$snapshot_copy_config($conf, $snap);
5324 $snap->{snapstate
} = "prepare";
5325 $snap->{snaptime
} = time();
5326 $snap->{description
} = $comment if $comment;
5328 # always overwrite machine if we save vmstate. This makes sure we
5329 # can restore it later using correct machine type
5330 $snap->{machine
} = get_current_qemu_machine
($vmid) if $snap->{vmstate
};
5332 update_config_nolock
($vmid, $conf, 1);
5335 lock_config
($vmid, $updatefn);
5340 my $snapshot_commit = sub {
5341 my ($vmid, $snapname) = @_;
5343 my $updatefn = sub {
5345 my $conf = load_config
($vmid);
5347 die "missing snapshot lock\n"
5348 if !($conf->{lock} && $conf->{lock} eq 'snapshot');
5350 my $has_machine_config = defined($conf->{machine
});
5352 my $snap = $conf->{snapshots
}->{$snapname};
5354 die "snapshot '$snapname' does not exist\n" if !defined($snap);
5356 die "wrong snapshot state\n"
5357 if !($snap->{snapstate
} && $snap->{snapstate
} eq "prepare");
5359 delete $snap->{snapstate
};
5360 delete $conf->{lock};
5362 my $newconf = &$snapshot_apply_config($conf, $snap);
5364 delete $newconf->{machine
} if !$has_machine_config;
5366 $newconf->{parent
} = $snapname;
5368 update_config_nolock
($vmid, $newconf, 1);
5371 lock_config
($vmid, $updatefn);
5374 sub snapshot_rollback
{
5375 my ($vmid, $snapname) = @_;
5381 my $storecfg = PVE
::Storage
::config
();
5383 my $updatefn = sub {
5385 my $conf = load_config
($vmid);
5387 die "you can't rollback if vm is a template\n" if is_template
($conf);
5389 $snap = $conf->{snapshots
}->{$snapname};
5391 die "snapshot '$snapname' does not exist\n" if !defined($snap);
5393 die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
5394 if $snap->{snapstate
};
5398 vm_stop
($storecfg, $vmid, undef, undef, 5, undef, undef);
5401 die "unable to rollback vm $vmid: vm is running\n"
5402 if check_running
($vmid);
5405 $conf->{lock} = 'rollback';
5407 die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
5408 delete $conf->{lock};
5414 my $has_machine_config = defined($conf->{machine
});
5416 # copy snapshot config to current config
5417 $conf = &$snapshot_apply_config($conf, $snap);
5418 $conf->{parent
} = $snapname;
5420 # Note: old code did not store 'machine', so we try to be smart
5421 # and guess the snapshot was generated with kvm 1.4 (pc-i440fx-1.4).
5422 $forcemachine = $conf->{machine
} || 'pc-i440fx-1.4';
5423 # we remove the 'machine' configuration if not explicitly specified
5424 # in the original config.
5425 delete $conf->{machine
} if $snap->{vmstate
} && !$has_machine_config;
5428 update_config_nolock
($vmid, $conf, 1);
5430 if (!$prepare && $snap->{vmstate
}) {
5431 my $statefile = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
5432 vm_start
($storecfg, $vmid, $statefile, undef, undef, undef, $forcemachine);
5436 lock_config
($vmid, $updatefn);
5438 foreach_drive
($snap, sub {
5439 my ($ds, $drive) = @_;
5441 return if drive_is_cdrom
($drive);
5443 my $volid = $drive->{file
};
5444 my $device = "drive-$ds";
5446 PVE
::Storage
::volume_snapshot_rollback
($storecfg, $volid, $snapname);
5450 lock_config
($vmid, $updatefn);
5453 my $savevm_wait = sub {
5457 my $stat = vm_mon_cmd_nocheck
($vmid, "query-savevm");
5458 if (!$stat->{status
}) {
5459 die "savevm not active\n";
5460 } elsif ($stat->{status
} eq 'active') {
5463 } elsif ($stat->{status
} eq 'completed') {
5466 die "query-savevm returned status '$stat->{status}'\n";
5471 sub snapshot_create
{
5472 my ($vmid, $snapname, $save_vmstate, $comment) = @_;
5474 my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
5476 $save_vmstate = 0 if !$snap->{vmstate
}; # vm is not running
5478 my $config = load_config
($vmid);
5480 my $running = check_running
($vmid);
5482 my $freezefs = $running && $config->{agent
};
5483 $freezefs = 0 if $snap->{vmstate
}; # not needed if we save RAM
5488 eval { vm_mon_cmd
($vmid, "guest-fsfreeze-freeze"); };
5489 warn "guest-fsfreeze-freeze problems - $@" if $@;
5493 # create internal snapshots of all drives
5495 my $storecfg = PVE
::Storage
::config
();
5498 if ($snap->{vmstate
}) {
5499 my $path = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
5500 vm_mon_cmd
($vmid, "savevm-start", statefile
=> $path);
5501 &$savevm_wait($vmid);
5503 vm_mon_cmd
($vmid, "savevm-start");
5507 foreach_drive
($snap, sub {
5508 my ($ds, $drive) = @_;
5510 return if drive_is_cdrom
($drive);
5512 my $volid = $drive->{file
};
5513 my $device = "drive-$ds";
5515 qemu_volume_snapshot
($vmid, $device, $storecfg, $volid, $snapname);
5516 $drivehash->{$ds} = 1;
5522 eval { vm_mon_cmd
($vmid, "savevm-end") };
5526 eval { vm_mon_cmd
($vmid, "guest-fsfreeze-thaw"); };
5527 warn "guest-fsfreeze-thaw problems - $@" if $@;
5530 # savevm-end is async, we need to wait
5532 my $stat = vm_mon_cmd_nocheck
($vmid, "query-savevm");
5533 if (!$stat->{bytes
}) {
5536 print "savevm not yet finished\n";
5544 warn "snapshot create failed: starting cleanup\n";
5545 eval { snapshot_delete
($vmid, $snapname, 0, $drivehash); };
5550 &$snapshot_commit($vmid, $snapname);
5553 # Note: $drivehash is only set when called from snapshot_create.
5554 sub snapshot_delete
{
5555 my ($vmid, $snapname, $force, $drivehash) = @_;
5562 my $unlink_parent = sub {
5563 my ($confref, $new_parent) = @_;
5565 if ($confref->{parent
} && $confref->{parent
} eq $snapname) {
5567 $confref->{parent
} = $new_parent;
5569 delete $confref->{parent
};
5574 my $updatefn = sub {
5575 my ($remove_drive) = @_;
5577 my $conf = load_config
($vmid);
5581 die "you can't delete a snapshot if vm is a template\n"
5582 if is_template
($conf);
5585 $snap = $conf->{snapshots
}->{$snapname};
5587 die "snapshot '$snapname' does not exist\n" if !defined($snap);
5589 # remove parent refs
5591 &$unlink_parent($conf, $snap->{parent
});
5592 foreach my $sn (keys %{$conf->{snapshots
}}) {
5593 next if $sn eq $snapname;
5594 &$unlink_parent($conf->{snapshots
}->{$sn}, $snap->{parent
});
5598 if ($remove_drive) {
5599 if ($remove_drive eq 'vmstate') {
5600 delete $snap->{$remove_drive};
5602 my $drive = parse_drive
($remove_drive, $snap->{$remove_drive});
5603 my $volid = $drive->{file
};
5604 delete $snap->{$remove_drive};
5605 add_unused_volume
($conf, $volid);
5610 $snap->{snapstate
} = 'delete';
5612 delete $conf->{snapshots
}->{$snapname};
5613 delete $conf->{lock} if $drivehash;
5614 foreach my $volid (@$unused) {
5615 add_unused_volume
($conf, $volid);
5619 update_config_nolock
($vmid, $conf, 1);
5622 lock_config
($vmid, $updatefn);
5624 # now remove vmstate file
5626 my $storecfg = PVE
::Storage
::config
();
5628 if ($snap->{vmstate
}) {
5629 eval { PVE
::Storage
::vdisk_free
($storecfg, $snap->{vmstate
}); };
5631 die $err if !$force;
5634 # save changes (remove vmstate from snapshot)
5635 lock_config
($vmid, $updatefn, 'vmstate') if !$force;
5638 # now remove all internal snapshots
5639 foreach_drive
($snap, sub {
5640 my ($ds, $drive) = @_;
5642 return if drive_is_cdrom
($drive);
5644 my $volid = $drive->{file
};
5645 my $device = "drive-$ds";
5647 if (!$drivehash || $drivehash->{$ds}) {
5648 eval { qemu_volume_snapshot_delete
($vmid, $device, $storecfg, $volid, $snapname); };
5650 die $err if !$force;
5655 # save changes (remove drive fron snapshot)
5656 lock_config
($vmid, $updatefn, $ds) if !$force;
5657 push @$unused, $volid;
5660 # now cleanup config
5662 lock_config
($vmid, $updatefn);
5666 my ($feature, $conf, $storecfg, $snapname, $running) = @_;
5669 foreach_drive
($conf, sub {
5670 my ($ds, $drive) = @_;
5672 return if drive_is_cdrom
($drive);
5673 my $volid = $drive->{file
};
5674 $err = 1 if !PVE
::Storage
::volume_has_feature
($storecfg, $feature, $volid, $snapname, $running);
5677 return $err ?
0 : 1;
5680 sub template_create
{
5681 my ($vmid, $conf, $disk) = @_;
5683 my $storecfg = PVE
::Storage
::config
();
5685 foreach_drive
($conf, sub {
5686 my ($ds, $drive) = @_;
5688 return if drive_is_cdrom
($drive);
5689 return if $disk && $ds ne $disk;
5691 my $volid = $drive->{file
};
5692 return if !PVE
::Storage
::volume_has_feature
($storecfg, 'template', $volid);
5694 my $voliddst = PVE
::Storage
::vdisk_create_base
($storecfg, $volid);
5695 $drive->{file
} = $voliddst;
5696 $conf->{$ds} = print_drive
($vmid, $drive);
5697 update_config_nolock
($vmid, $conf, 1);
5704 return 1 if defined $conf->{template
} && $conf->{template
} == 1;
5707 sub qemu_img_convert
{
5708 my ($src_volid, $dst_volid, $size, $snapname) = @_;
5710 my $storecfg = PVE
::Storage
::config
();
5711 my ($src_storeid, $src_volname) = PVE
::Storage
::parse_volume_id
($src_volid, 1);
5712 my ($dst_storeid, $dst_volname) = PVE
::Storage
::parse_volume_id
($dst_volid, 1);
5714 if ($src_storeid && $dst_storeid) {
5715 my $src_scfg = PVE
::Storage
::storage_config
($storecfg, $src_storeid);
5716 my $dst_scfg = PVE
::Storage
::storage_config
($storecfg, $dst_storeid);
5718 my $src_format = qemu_img_format
($src_scfg, $src_volname);
5719 my $dst_format = qemu_img_format
($dst_scfg, $dst_volname);
5721 my $src_path = PVE
::Storage
::path
($storecfg, $src_volid, $snapname);
5722 my $dst_path = PVE
::Storage
::path
($storecfg, $dst_volid);
5725 push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-n';
5726 push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
5727 push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
5731 if($line =~ m/\((\S+)\/100\
%\)/){
5733 my $transferred = int($size * $percent / 100);
5734 my $remaining = $size - $transferred;
5736 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
5741 eval { run_command
($cmd, timeout
=> undef, outfunc
=> $parser); };
5743 die "copy failed: $err" if $err;
5747 sub qemu_img_format
{
5748 my ($scfg, $volname) = @_;
5750 if ($scfg->{path
} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/) {
5752 } elsif ($scfg->{type
} eq 'iscsi') {
5753 return "host_device";
5759 sub qemu_drive_mirror
{
5760 my ($vmid, $drive, $dst_volid, $vmiddst) = @_;
5767 my $storecfg = PVE
::Storage
::config
();
5768 my ($dst_storeid, $dst_volname) = PVE
::Storage
::parse_volume_id
($dst_volid);
5770 my $dst_scfg = PVE
::Storage
::storage_config
($storecfg, $dst_storeid);
5773 if ($dst_volname =~ m/\.(raw|qcow2)$/){
5777 my $dst_path = PVE
::Storage
::path
($storecfg, $dst_volid);
5779 my $opts = { timeout
=> 10, device
=> "drive-$drive", mode
=> "existing", sync
=> "full", target
=> $dst_path };
5780 $opts->{format
} = $format if $format;
5782 #fixme : sometime drive-mirror timeout, but works fine after.
5783 # (I have see the problem with big volume > 200GB), so we need to eval
5784 eval { vm_mon_cmd
($vmid, "drive-mirror", %$opts); };
5785 # ignore errors here
5789 my $stats = vm_mon_cmd
($vmid, "query-block-jobs");
5790 my $stat = @$stats[0];
5791 die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
5792 die "error job is not mirroring" if $stat->{type
} ne "mirror";
5794 my $busy = $stat->{busy
};
5796 if (my $total = $stat->{len
}) {
5797 my $transferred = $stat->{offset
} || 0;
5798 my $remaining = $total - $transferred;
5799 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
5801 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent % busy: $busy\n";
5804 if ($stat->{len
} == $stat->{offset
}) {
5805 if ($busy eq 'false') {
5807 last if $vmiddst != $vmid;
5809 # try to switch the disk if source and destination are on the same guest
5810 eval { vm_mon_cmd
($vmid, "block-job-complete", device
=> "drive-$drive") };
5812 die $@ if $@ !~ m/cannot be completed/;
5815 if ($count > $maxwait) {
5816 # if too much writes to disk occurs at the end of migration
5817 #the disk needs to be freezed to be able to complete the migration
5818 vm_suspend
($vmid,1);
5823 $old_len = $stat->{offset
};
5827 vm_resume
($vmid, 1) if $frozen;
5832 my $cancel_job = sub {
5833 vm_mon_cmd
($vmid, "block-job-cancel", device
=> "drive-$drive");
5835 my $stats = vm_mon_cmd
($vmid, "query-block-jobs");
5836 my $stat = @$stats[0];
5843 eval { &$cancel_job(); };
5844 die "mirroring error: $err";
5847 if ($vmiddst != $vmid) {
5848 # if we clone a disk for a new target vm, we don't switch the disk
5849 &$cancel_job(); # so we call block-job-cancel
5854 my ($storecfg, $vmid, $running, $drivename, $drive, $snapname,
5855 $newvmid, $storage, $format, $full, $newvollist) = @_;
5860 print "create linked clone of drive $drivename ($drive->{file})\n";
5861 $newvolid = PVE
::Storage
::vdisk_clone
($storecfg, $drive->{file
}, $newvmid, $snapname);
5862 push @$newvollist, $newvolid;
5864 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($drive->{file
});
5865 $storeid = $storage if $storage;
5867 my ($defFormat, $validFormats) = PVE
::Storage
::storage_default_format
($storecfg, $storeid);
5869 $format = $drive->{format
} || $defFormat;
5872 # test if requested format is supported - else use default
5873 my $supported = grep { $_ eq $format } @$validFormats;
5874 $format = $defFormat if !$supported;
5876 my ($size) = PVE
::Storage
::volume_size_info
($storecfg, $drive->{file
}, 3);
5878 print "create full clone of drive $drivename ($drive->{file})\n";
5879 $newvolid = PVE
::Storage
::vdisk_alloc
($storecfg, $storeid, $newvmid, $format, undef, ($size/1024));
5880 push @$newvollist, $newvolid;
5882 if (!$running || $snapname) {
5883 qemu_img_convert
($drive->{file
}, $newvolid, $size, $snapname);
5885 qemu_drive_mirror
($vmid, $drivename, $newvolid, $newvmid);
5889 my ($size) = PVE
::Storage
::volume_size_info
($storecfg, $newvolid, 3);
5892 $disk->{format
} = undef;
5893 $disk->{file
} = $newvolid;
5894 $disk->{size
} = $size;
5899 # this only works if VM is running
5900 sub get_current_qemu_machine
{
5903 my $cmd = { execute
=> 'query-machines', arguments
=> {} };
5904 my $res = vm_qmp_command
($vmid, $cmd);
5906 my ($current, $default);
5907 foreach my $e (@$res) {
5908 $default = $e->{name
} if $e->{'is-default'};
5909 $current = $e->{name
} if $e->{'is-current'};
5912 # fallback to the default machine if current is not supported by qemu
5913 return $current || $default || 'pc';
5920 dir_glob_foreach
("$pcisysfs/devices", '[a-f0-9]{4}:([a-f0-9]{2}:[a-f0-9]{2})\.([0-9])', sub {
5921 my (undef, $id, $function) = @_;
5922 my $res = { id
=> $id, function
=> $function};
5923 push @{$devices->{$id}}, $res;