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
=> "Maximum cpus for hotplug.",
319 description
=> "Enable/disable ACPI.",
325 description
=> "Enable/disable Qemu GuestAgent.",
331 description
=> "Enable/disable KVM hardware virtualization.",
337 description
=> "Enable/disable time drift fix.",
343 description
=> "Set the real time clock to local time. This is enabled by default if ostype indicates a Microsoft OS.",
348 description
=> "Freeze CPU at startup (use 'c' monitor command to start execution).",
353 description
=> "Select VGA type. If you want to use high resolution modes (>= 1280x1024x16) then you should use option 'std' or 'vmware'. Default is 'std' for win8/win7/w2k8, and 'cirrur' for other OS types. Option 'qxl' enables the SPICE display sever. You can also run without any graphic card using a serial devive as terminal.",
354 enum
=> [qw(std cirrus vmware qxl serial0 serial1 serial2 serial3 qxl2 qxl3 qxl4)],
358 type
=> 'string', format
=> 'pve-qm-watchdog',
359 typetext
=> '[[model=]i6300esb|ib700] [,[action=]reset|shutdown|poweroff|pause|debug|none]',
360 description
=> "Create a virtual hardware watchdog device. Once enabled (by a guest action), the watchdog must be periodically polled by an agent inside the guest or else the guest will be restarted (or execute the action specified)",
365 typetext
=> "(now | YYYY-MM-DD | YYYY-MM-DDTHH:MM:SS)",
366 description
=> "Set the initial date of the real time clock. Valid format for date are: 'now' or '2006-06-17T16:01:21' or '2006-06-17'.",
367 pattern
=> '(now|\d{4}-\d{1,2}-\d{1,2}(T\d{1,2}:\d{1,2}:\d{1,2})?)',
372 type
=> 'string', format
=> 'pve-qm-startup',
373 typetext
=> '[[order=]\d+] [,up=\d+] [,down=\d+] ',
374 description
=> "Startup and shutdown behavior. Order is a non-negative number defining the general startup order. Shutdown in done with reverse ordering. Additionally you can set the 'up' or 'down' delay in seconds, which specifies a delay to wait before the next VM is started or stopped.",
379 description
=> "Enable/disable Template.",
385 description
=> <<EODESCR,
386 Note: this option is for experts only. It allows you to pass arbitrary arguments to kvm, for example:
388 args: -no-reboot -no-hpet
395 description
=> "Enable/disable the usb tablet device. This device is usually needed to allow absolute mouse positioning with VNC. Else the mouse runs out of sync with normal VNC clients. If you're running lots of console-only guests on one host, you may consider disabling this to save some context switches. This is turned of by default if you use spice (vga=qxl).",
400 description
=> "Set maximum speed (in MB/s) for migrations. Value 0 is no limit.",
404 migrate_downtime
=> {
407 description
=> "Set maximum tolerated downtime (in seconds) for migrations.",
413 type
=> 'string', format
=> 'pve-qm-drive',
414 typetext
=> 'volume',
415 description
=> "This is an alias for option -ide2",
419 description
=> "Emulated CPU type.",
421 enum
=> [ qw(486 athlon pentium pentium2 pentium3 coreduo core2duo kvm32 kvm64 qemu32 qemu64 phenom Conroe Penryn Nehalem Westmere SandyBridge Haswell Broadwell Opteron_G1 Opteron_G2 Opteron_G3 Opteron_G4 Opteron_G5 host) ],
424 parent
=> get_standard_option
('pve-snapshot-name', {
426 description
=> "Parent snapshot name. This is used internally, and should not be modified.",
430 description
=> "Timestamp for snapshots.",
436 type
=> 'string', format
=> 'pve-volume-id',
437 description
=> "Reference to a volume which stores the VM state. This is used internally for snapshots.",
440 description
=> "Specific the Qemu machine type.",
442 pattern
=> '(pc|pc(-i440fx)?-\d+\.\d+|q35|pc-q35-\d+\.\d+)',
447 description
=> "Specify SMBIOS type 1 fields.",
448 type
=> 'string', format
=> 'pve-qm-smbios1',
449 typetext
=> "[manufacturer=str][,product=str][,version=str][,serial=str] [,uuid=uuid][,sku=str][,family=str]",
455 # what about other qemu settings ?
457 #machine => 'string',
470 ##soundhw => 'string',
472 while (my ($k, $v) = each %$confdesc) {
473 PVE
::JSONSchema
::register_standard_option
("pve-qm-$k", $v);
476 my $MAX_IDE_DISKS = 4;
477 my $MAX_SCSI_DISKS = 14;
478 my $MAX_VIRTIO_DISKS = 16;
479 my $MAX_SATA_DISKS = 6;
480 my $MAX_USB_DEVICES = 5;
482 my $MAX_UNUSED_DISKS = 8;
483 my $MAX_HOSTPCI_DEVICES = 4;
484 my $MAX_SERIAL_PORTS = 4;
485 my $MAX_PARALLEL_PORTS = 3;
487 my $nic_model_list = ['rtl8139', 'ne2k_pci', 'e1000', 'pcnet', 'virtio',
488 'ne2k_isa', 'i82551', 'i82557b', 'i82559er', 'vmxnet3'];
489 my $nic_model_list_txt = join(' ', sort @$nic_model_list);
493 type
=> 'string', format
=> 'pve-qm-net',
494 typetext
=> "MODEL=XX:XX:XX:XX:XX:XX [,bridge=<dev>][,queues=<nbqueues>][,rate=<mbps>][,tag=<vlanid>][,firewall=0|1]",
495 description
=> <<EODESCR,
496 Specify network devices.
498 MODEL is one of: $nic_model_list_txt
500 XX:XX:XX:XX:XX:XX should be an unique MAC address. This is
501 automatically generated if not specified.
503 The bridge parameter can be used to automatically add the interface to a bridge device. The Proxmox VE standard bridge is called 'vmbr0'.
505 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'.
507 If you specify no bridge, we create a kvm 'user' (NATed) network device, which provides DHCP and DNS services. The following addresses are used:
513 The DHCP server assign addresses to the guest starting from 10.0.2.15.
517 PVE
::JSONSchema
::register_standard_option
("pve-qm-net", $netdesc);
519 for (my $i = 0; $i < $MAX_NETS; $i++) {
520 $confdesc->{"net$i"} = $netdesc;
527 type
=> 'string', format
=> 'pve-qm-drive',
528 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]',
529 description
=> "Use volume as IDE hard disk or CD-ROM (n is 0 to " .($MAX_IDE_DISKS -1) . ").",
531 PVE
::JSONSchema
::register_standard_option
("pve-qm-ide", $idedesc);
535 type
=> 'string', format
=> 'pve-qm-drive',
536 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]',
537 description
=> "Use volume as SCSI hard disk or CD-ROM (n is 0 to " . ($MAX_SCSI_DISKS - 1) . ").",
539 PVE
::JSONSchema
::register_standard_option
("pve-qm-scsi", $scsidesc);
543 type
=> 'string', format
=> 'pve-qm-drive',
544 typetext
=> '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe|directsync] [,format=f] [,backup=yes|no] [,rerror=ignore|report|stop] [,werror=enospc|ignore|report|stop] [,aio=native|threads] [,discard=ignore|on]',
545 description
=> "Use volume as SATA hard disk or CD-ROM (n is 0 to " . ($MAX_SATA_DISKS - 1). ").",
547 PVE
::JSONSchema
::register_standard_option
("pve-qm-sata", $satadesc);
551 type
=> 'string', format
=> 'pve-qm-drive',
552 typetext
=> '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe|directsync] [,format=f] [,backup=yes|no] [,rerror=ignore|report|stop] [,werror=enospc|ignore|report|stop] [,aio=native|threads] [,discard=ignore|on]',
553 description
=> "Use volume as VIRTIO hard disk (n is 0 to " . ($MAX_VIRTIO_DISKS - 1) . ").",
555 PVE
::JSONSchema
::register_standard_option
("pve-qm-virtio", $virtiodesc);
559 type
=> 'string', format
=> 'pve-qm-usb-device',
560 typetext
=> 'host=HOSTUSBDEVICE|spice',
561 description
=> <<EODESCR,
562 Configure an USB device (n is 0 to 4). This can be used to
563 pass-through usb devices to the guest. HOSTUSBDEVICE syntax is:
565 'bus-port(.port)*' (decimal numbers) or
566 'vendor_id:product_id' (hexadeciaml numbers)
568 You can use the 'lsusb -t' command to list existing usb devices.
570 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
572 The value 'spice' can be used to add a usb redirection devices for spice.
576 PVE
::JSONSchema
::register_standard_option
("pve-qm-usb", $usbdesc);
580 type
=> 'string', format
=> 'pve-qm-hostpci',
581 typetext
=> "[host=]HOSTPCIDEVICE [,driver=kvm|vfio] [,rombar=on|off] [,pcie=0|1] [,x-vga=on|off]",
582 description
=> <<EODESCR,
583 Map host pci devices. HOSTPCIDEVICE syntax is:
585 'bus:dev.func' (hexadecimal numbers)
587 You can us the 'lspci' command to list existing pci devices.
589 The 'rombar' option determines whether or not the device's ROM will be visible in the guest's memory map (default is 'on').
591 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
593 Experimental: user reported problems with this option.
596 PVE
::JSONSchema
::register_standard_option
("pve-qm-hostpci", $hostpcidesc);
601 pattern
=> '(/dev/.+|socket)',
602 description
=> <<EODESCR,
603 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).
605 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
607 Experimental: user reported problems with this option.
614 pattern
=> '/dev/parport\d+|/dev/usb/lp\d+',
615 description
=> <<EODESCR,
616 Map host parallel devices (n is 0 to 2).
618 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
620 Experimental: user reported problems with this option.
624 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
625 $confdesc->{"parallel$i"} = $paralleldesc;
628 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
629 $confdesc->{"serial$i"} = $serialdesc;
632 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
633 $confdesc->{"hostpci$i"} = $hostpcidesc;
636 for (my $i = 0; $i < $MAX_IDE_DISKS; $i++) {
637 $drivename_hash->{"ide$i"} = 1;
638 $confdesc->{"ide$i"} = $idedesc;
641 for (my $i = 0; $i < $MAX_SATA_DISKS; $i++) {
642 $drivename_hash->{"sata$i"} = 1;
643 $confdesc->{"sata$i"} = $satadesc;
646 for (my $i = 0; $i < $MAX_SCSI_DISKS; $i++) {
647 $drivename_hash->{"scsi$i"} = 1;
648 $confdesc->{"scsi$i"} = $scsidesc ;
651 for (my $i = 0; $i < $MAX_VIRTIO_DISKS; $i++) {
652 $drivename_hash->{"virtio$i"} = 1;
653 $confdesc->{"virtio$i"} = $virtiodesc;
656 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
657 $confdesc->{"usb$i"} = $usbdesc;
662 type
=> 'string', format
=> 'pve-volume-id',
663 description
=> "Reference to unused volumes.",
666 for (my $i = 0; $i < $MAX_UNUSED_DISKS; $i++) {
667 $confdesc->{"unused$i"} = $unuseddesc;
670 my $kvm_api_version = 0;
674 return $kvm_api_version if $kvm_api_version;
676 my $fh = IO
::File-
>new("</dev/kvm") ||
679 if (my $v = $fh->ioctl(KVM_GET_API_VERSION
(), 0)) {
680 $kvm_api_version = $v;
685 return $kvm_api_version;
688 my $kvm_user_version;
690 sub kvm_user_version
{
692 return $kvm_user_version if $kvm_user_version;
694 $kvm_user_version = 'unknown';
696 my $tmp = `kvm -help 2>/dev/null`;
698 if ($tmp =~ m/^QEMU( PC)? emulator version (\d+\.\d+(\.\d+)?)[,\s]/) {
699 $kvm_user_version = $2;
702 return $kvm_user_version;
706 my $kernel_has_vhost_net = -c
'/dev/vhost-net';
709 # order is important - used to autoselect boot disk
710 return ((map { "ide$_" } (0 .. ($MAX_IDE_DISKS - 1))),
711 (map { "scsi$_" } (0 .. ($MAX_SCSI_DISKS - 1))),
712 (map { "virtio$_" } (0 .. ($MAX_VIRTIO_DISKS - 1))),
713 (map { "sata$_" } (0 .. ($MAX_SATA_DISKS - 1))));
716 sub valid_drivename
{
719 return defined($drivename_hash->{$dev});
724 return defined($confdesc->{$key});
728 return $nic_model_list;
731 sub os_list_description
{
736 w2k
=> 'Windows 2000',
737 w2k3
=>, 'Windows 2003',
738 w2k8
=> 'Windows 2008',
739 wvista
=> 'Windows Vista',
741 win8
=> 'Windows 8/2012',
751 return $cdrom_path if $cdrom_path;
753 return $cdrom_path = "/dev/cdrom" if -l
"/dev/cdrom";
754 return $cdrom_path = "/dev/cdrom1" if -l
"/dev/cdrom1";
755 return $cdrom_path = "/dev/cdrom2" if -l
"/dev/cdrom2";
759 my ($storecfg, $vmid, $cdrom) = @_;
761 if ($cdrom eq 'cdrom') {
762 return get_cdrom_path
();
763 } elsif ($cdrom eq 'none') {
765 } elsif ($cdrom =~ m
|^/|) {
768 return PVE
::Storage
::path
($storecfg, $cdrom);
772 # try to convert old style file names to volume IDs
773 sub filename_to_volume_id
{
774 my ($vmid, $file, $media) = @_;
776 if (!($file eq 'none' || $file eq 'cdrom' ||
777 $file =~ m
|^/dev/.+| || $file =~ m/^([^:]+):(.+)$/)) {
779 return undef if $file =~ m
|/|;
781 if ($media && $media eq 'cdrom') {
782 $file = "local:iso/$file";
784 $file = "local:$vmid/$file";
791 sub verify_media_type
{
792 my ($opt, $vtype, $media) = @_;
797 if ($media eq 'disk') {
799 } elsif ($media eq 'cdrom') {
802 die "internal error";
805 return if ($vtype eq $etype);
807 raise_param_exc
({ $opt => "unexpected media type ($vtype != $etype)" });
810 sub cleanup_drive_path
{
811 my ($opt, $storecfg, $drive) = @_;
813 # try to convert filesystem paths to volume IDs
815 if (($drive->{file
} !~ m/^(cdrom|none)$/) &&
816 ($drive->{file
} !~ m
|^/dev/.+|) &&
817 ($drive->{file
} !~ m/^([^:]+):(.+)$/) &&
818 ($drive->{file
} !~ m/^\d+$/)) {
819 my ($vtype, $volid) = PVE
::Storage
::path_to_volume_id
($storecfg, $drive->{file
});
820 raise_param_exc
({ $opt => "unable to associate path '$drive->{file}' to any storage"}) if !$vtype;
821 $drive->{media
} = 'cdrom' if !$drive->{media
} && $vtype eq 'iso';
822 verify_media_type
($opt, $vtype, $drive->{media
});
823 $drive->{file
} = $volid;
826 $drive->{media
} = 'cdrom' if !$drive->{media
} && $drive->{file
} =~ m/^(cdrom|none)$/;
829 sub create_conf_nolock
{
830 my ($vmid, $settings) = @_;
832 my $filename = config_file
($vmid);
834 die "configuration file '$filename' already exists\n" if -f
$filename;
836 my $defaults = load_defaults
();
838 $settings->{name
} = "vm$vmid" if !$settings->{name
};
839 $settings->{memory
} = $defaults->{memory
} if !$settings->{memory
};
842 foreach my $opt (keys %$settings) {
843 next if !$confdesc->{$opt};
845 my $value = $settings->{$opt};
848 $data .= "$opt: $value\n";
851 PVE
::Tools
::file_set_contents
($filename, $data);
854 my $parse_size = sub {
857 return undef if $value !~ m/^(\d+(\.\d+)?)([KMG])?$/;
858 my ($size, $unit) = ($1, $3);
861 $size = $size * 1024;
862 } elsif ($unit eq 'M') {
863 $size = $size * 1024 * 1024;
864 } elsif ($unit eq 'G') {
865 $size = $size * 1024 * 1024 * 1024;
871 my $format_size = sub {
876 my $kb = int($size/1024);
877 return $size if $kb*1024 != $size;
879 my $mb = int($kb/1024);
880 return "${kb}K" if $mb*1024 != $kb;
882 my $gb = int($mb/1024);
883 return "${mb}M" if $gb*1024 != $mb;
888 # ideX = [volume=]volume-id[,media=d][,cyls=c,heads=h,secs=s[,trans=t]]
889 # [,snapshot=on|off][,cache=on|off][,format=f][,backup=yes|no]
890 # [,rerror=ignore|report|stop][,werror=enospc|ignore|report|stop]
891 # [,aio=native|threads][,discard=ignore|on]
894 my ($key, $data) = @_;
898 # $key may be undefined - used to verify JSON parameters
899 if (!defined($key)) {
900 $res->{interface
} = 'unknown'; # should not harm when used to verify parameters
902 } elsif ($key =~ m/^([^\d]+)(\d+)$/) {
903 $res->{interface
} = $1;
909 foreach my $p (split (/,/, $data)) {
910 next if $p =~ m/^\s*$/;
912 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)=(.+)$/) {
913 my ($k, $v) = ($1, $2);
915 $k = 'file' if $k eq 'volume';
917 return undef if defined $res->{$k};
919 if ($k eq 'bps' || $k eq 'bps_rd' || $k eq 'bps_wr') {
920 return undef if !$v || $v !~ m/^\d+/;
922 $v = sprintf("%.3f", $v / (1024*1024));
926 if (!$res->{file
} && $p !~ m/=/) {
934 return undef if !$res->{file
};
936 if($res->{file
} =~ m/\.(raw|cow|qcow|qcow2|vmdk|cloop)$/){
940 return undef if $res->{cache
} &&
941 $res->{cache
} !~ m/^(off|none|writethrough|writeback|unsafe|directsync)$/;
942 return undef if $res->{snapshot
} && $res->{snapshot
} !~ m/^(on|off)$/;
943 return undef if $res->{cyls
} && $res->{cyls
} !~ m/^\d+$/;
944 return undef if $res->{heads
} && $res->{heads
} !~ m/^\d+$/;
945 return undef if $res->{secs
} && $res->{secs
} !~ m/^\d+$/;
946 return undef if $res->{media
} && $res->{media
} !~ m/^(disk|cdrom)$/;
947 return undef if $res->{trans
} && $res->{trans
} !~ m/^(none|lba|auto)$/;
948 return undef if $res->{format
} && $res->{format
} !~ m/^(raw|cow|qcow|qcow2|vmdk|cloop)$/;
949 return undef if $res->{rerror
} && $res->{rerror
} !~ m/^(ignore|report|stop)$/;
950 return undef if $res->{werror
} && $res->{werror
} !~ m/^(enospc|ignore|report|stop)$/;
951 return undef if $res->{backup
} && $res->{backup
} !~ m/^(yes|no)$/;
952 return undef if $res->{aio
} && $res->{aio
} !~ m/^(native|threads)$/;
953 return undef if $res->{discard
} && $res->{discard
} !~ m/^(ignore|on)$/;
955 return undef if $res->{mbps_rd
} && $res->{mbps
};
956 return undef if $res->{mbps_wr
} && $res->{mbps
};
958 return undef if $res->{mbps
} && $res->{mbps
} !~ m/^\d+(\.\d+)?$/;
959 return undef if $res->{mbps_max
} && $res->{mbps_max
} !~ m/^\d+(\.\d+)?$/;
960 return undef if $res->{mbps_rd
} && $res->{mbps_rd
} !~ m/^\d+(\.\d+)?$/;
961 return undef if $res->{mbps_rd_max
} && $res->{mbps_rd_max
} !~ m/^\d+(\.\d+)?$/;
962 return undef if $res->{mbps_wr
} && $res->{mbps_wr
} !~ m/^\d+(\.\d+)?$/;
963 return undef if $res->{mbps_wr_max
} && $res->{mbps_wr_max
} !~ m/^\d+(\.\d+)?$/;
965 return undef if $res->{iops_rd
} && $res->{iops
};
966 return undef if $res->{iops_wr
} && $res->{iops
};
969 return undef if $res->{iops
} && $res->{iops
} !~ m/^\d+$/;
970 return undef if $res->{iops_max
} && $res->{iops_max
} !~ m/^\d+$/;
971 return undef if $res->{iops_rd
} && $res->{iops_rd
} !~ m/^\d+$/;
972 return undef if $res->{iops_rd_max
} && $res->{iops_rd_max
} !~ m/^\d+$/;
973 return undef if $res->{iops_wr
} && $res->{iops_wr
} !~ m/^\d+$/;
974 return undef if $res->{iops_wr_max
} && $res->{iops_wr_max
} !~ m/^\d+$/;
978 return undef if !defined($res->{size
} = &$parse_size($res->{size
}));
981 if ($res->{media
} && ($res->{media
} eq 'cdrom')) {
982 return undef if $res->{snapshot
} || $res->{trans
} || $res->{format
};
983 return undef if $res->{heads
} || $res->{secs
} || $res->{cyls
};
984 return undef if $res->{interface
} eq 'virtio';
987 # rerror does not work with scsi drives
988 if ($res->{rerror
}) {
989 return undef if $res->{interface
} eq 'scsi';
995 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);
998 my ($vmid, $drive) = @_;
1001 foreach my $o (@qemu_drive_options, 'mbps', 'mbps_rd', 'mbps_wr', 'mbps_max', 'mbps_rd_max', 'mbps_wr_max', 'backup') {
1002 $opts .= ",$o=$drive->{$o}" if $drive->{$o};
1005 if ($drive->{size
}) {
1006 $opts .= ",size=" . &$format_size($drive->{size
});
1009 return "$drive->{file}$opts";
1013 my($fh, $noerr) = @_;
1016 my $SG_GET_VERSION_NUM = 0x2282;
1018 my $versionbuf = "\x00" x
8;
1019 my $ret = ioctl($fh, $SG_GET_VERSION_NUM, $versionbuf);
1021 die "scsi ioctl SG_GET_VERSION_NUM failoed - $!\n" if !$noerr;
1024 my $version = unpack("I", $versionbuf);
1025 if ($version < 30000) {
1026 die "scsi generic interface too old\n" if !$noerr;
1030 my $buf = "\x00" x
36;
1031 my $sensebuf = "\x00" x
8;
1032 my $cmd = pack("C x3 C x1", 0x12, 36);
1034 # see /usr/include/scsi/sg.h
1035 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";
1037 my $packet = pack($sg_io_hdr_t, ord('S'), -3, length($cmd),
1038 length($sensebuf), 0, length($buf), $buf,
1039 $cmd, $sensebuf, 6000);
1041 $ret = ioctl($fh, $SG_IO, $packet);
1043 die "scsi ioctl SG_IO failed - $!\n" if !$noerr;
1047 my @res = unpack($sg_io_hdr_t, $packet);
1048 if ($res[17] || $res[18]) {
1049 die "scsi ioctl SG_IO status error - $!\n" if !$noerr;
1054 (my $byte0, my $byte1, $res->{vendor
},
1055 $res->{product
}, $res->{revision
}) = unpack("C C x6 A8 A16 A4", $buf);
1057 $res->{removable
} = $byte1 & 128 ?
1 : 0;
1058 $res->{type
} = $byte0 & 31;
1066 my $fh = IO
::File-
>new("+<$path") || return undef;
1067 my $res = scsi_inquiry
($fh, 1);
1073 sub machine_type_is_q35
{
1076 return $conf->{machine
} && ($conf->{machine
} =~ m/q35/) ?
1 : 0;
1079 sub print_tabletdevice_full
{
1082 my $q35 = machine_type_is_q35
($conf);
1084 # we use uhci for old VMs because tablet driver was buggy in older qemu
1085 my $usbbus = $q35 ?
"ehci" : "uhci";
1087 return "usb-tablet,id=tablet,bus=$usbbus.0,port=1";
1090 sub print_drivedevice_full
{
1091 my ($storecfg, $conf, $vmid, $drive, $bridges) = @_;
1096 if ($drive->{interface
} eq 'virtio') {
1097 my $pciaddr = print_pci_addr
("$drive->{interface}$drive->{index}", $bridges);
1098 $device = "virtio-blk-pci,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}$pciaddr";
1099 $device .= ",iothread=iothread0" if $conf->{iothread
};
1100 } elsif ($drive->{interface
} eq 'scsi') {
1101 $maxdev = ($conf->{scsihw
} && ($conf->{scsihw
} !~ m/^lsi/)) ?
256 : 7;
1102 my $controller = int($drive->{index} / $maxdev);
1103 my $unit = $drive->{index} % $maxdev;
1104 my $devicetype = 'hd';
1106 if (drive_is_cdrom
($drive)) {
1109 if ($drive->{file
} =~ m
|^/|) {
1110 $path = $drive->{file
};
1112 $path = PVE
::Storage
::path
($storecfg, $drive->{file
});
1115 if($path =~ m/^iscsi\:\/\
//){
1116 $devicetype = 'generic';
1118 if (my $info = path_is_scsi
($path)) {
1119 if ($info->{type
} == 0) {
1120 $devicetype = 'block';
1121 } elsif ($info->{type
} == 1) { # tape
1122 $devicetype = 'generic';
1128 if (!$conf->{scsihw
} || ($conf->{scsihw
} =~ m/^lsi/)){
1129 $device = "scsi-$devicetype,bus=scsihw$controller.0,scsi-id=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1131 $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}";
1134 } elsif ($drive->{interface
} eq 'ide'){
1136 my $controller = int($drive->{index} / $maxdev);
1137 my $unit = $drive->{index} % $maxdev;
1138 my $devicetype = ($drive->{media
} && $drive->{media
} eq 'cdrom') ?
"cd" : "hd";
1140 $device = "ide-$devicetype,bus=ide.$controller,unit=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1141 } elsif ($drive->{interface
} eq 'sata'){
1142 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
1143 my $unit = $drive->{index} % $MAX_SATA_DISKS;
1144 $device = "ide-drive,bus=ahci$controller.$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1145 } elsif ($drive->{interface
} eq 'usb') {
1147 # -device ide-drive,bus=ide.1,unit=0,drive=drive-ide0-1-0,id=ide0-1-0
1149 die "unsupported interface type";
1152 $device .= ",bootindex=$drive->{bootindex}" if $drive->{bootindex
};
1157 sub get_initiator_name
{
1160 my $fh = IO
::File-
>new('/etc/iscsi/initiatorname.iscsi') || return undef;
1161 while (defined(my $line = <$fh>)) {
1162 next if $line !~ m/^\s*InitiatorName\s*=\s*([\.\-:\w]+)/;
1171 sub print_drive_full
{
1172 my ($storecfg, $vmid, $drive) = @_;
1175 foreach my $o (@qemu_drive_options) {
1176 next if $o eq 'bootindex';
1177 $opts .= ",$o=$drive->{$o}" if $drive->{$o};
1180 foreach my $o (qw(bps bps_rd bps_wr)) {
1181 my $v = $drive->{"m$o"};
1182 $opts .= ",$o=" . int($v*1024*1024) if $v;
1185 # use linux-aio by default (qemu default is threads)
1186 $opts .= ",aio=native" if !$drive->{aio
};
1189 my $volid = $drive->{file
};
1190 if (drive_is_cdrom
($drive)) {
1191 $path = get_iso_path
($storecfg, $vmid, $volid);
1193 if ($volid =~ m
|^/|) {
1196 $path = PVE
::Storage
::path
($storecfg, $volid);
1200 $opts .= ",cache=none" if !$drive->{cache
} && !drive_is_cdrom
($drive);
1202 my $detectzeroes = $drive->{discard
} ?
"unmap" : "on";
1203 $opts .= ",detect-zeroes=$detectzeroes" if !drive_is_cdrom
($drive);
1205 my $pathinfo = $path ?
"file=$path," : '';
1207 return "${pathinfo}if=none,id=drive-$drive->{interface}$drive->{index}$opts";
1210 sub print_netdevice_full
{
1211 my ($vmid, $conf, $net, $netid, $bridges) = @_;
1213 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
1215 my $device = $net->{model
};
1216 if ($net->{model
} eq 'virtio') {
1217 $device = 'virtio-net-pci';
1220 # qemu > 0.15 always try to boot from network - we disable that by
1221 # not loading the pxe rom file
1222 my $extra = ($bootorder !~ m/n/) ?
"romfile=," : '';
1223 my $pciaddr = print_pci_addr
("$netid", $bridges);
1224 my $tmpstr = "$device,${extra}mac=$net->{macaddr},netdev=$netid$pciaddr,id=$netid";
1225 if ($net->{queues
} && $net->{queues
} > 1 && $net->{model
} eq 'virtio'){
1226 #Consider we have N queues, the number of vectors needed is 2*N + 2 (plus one config interrupt and control vq)
1227 my $vectors = $net->{queues
} * 2 + 2;
1228 $tmpstr .= ",vectors=$vectors,mq=on";
1230 $tmpstr .= ",bootindex=$net->{bootindex}" if $net->{bootindex
} ;
1234 sub print_netdev_full
{
1235 my ($vmid, $conf, $net, $netid) = @_;
1238 if ($netid =~ m/^net(\d+)$/) {
1242 die "got strange net id '$i'\n" if $i >= ${MAX_NETS
};
1244 my $ifname = "tap${vmid}i$i";
1246 # kvm uses TUNSETIFF ioctl, and that limits ifname length
1247 die "interface name '$ifname' is too long (max 15 character)\n"
1248 if length($ifname) >= 16;
1250 my $vhostparam = '';
1251 $vhostparam = ',vhost=on' if $kernel_has_vhost_net && $net->{model
} eq 'virtio';
1253 my $vmname = $conf->{name
} || "vm$vmid";
1257 if ($net->{bridge
}) {
1258 $netdev = "type=tap,id=$netid,ifname=${ifname},script=/var/lib/qemu-server/pve-bridge,downscript=/var/lib/qemu-server/pve-bridgedown$vhostparam";
1260 $netdev = "type=user,id=$netid,hostname=$vmname";
1263 $netdev .= ",queues=$net->{queues}" if ($net->{queues
} && $net->{model
} eq 'virtio');
1268 sub drive_is_cdrom
{
1271 return $drive && $drive->{media
} && ($drive->{media
} eq 'cdrom');
1278 return undef if !$value;
1281 my @list = split(/,/, $value);
1285 foreach my $kv (@list) {
1287 if ($kv =~ m/^(host=)?([a-f0-9]{2}:[a-f0-9]{2})(\.([a-f0-9]))?$/) {
1290 push @{$res->{pciid
}}, { id
=> $2 , function
=> $4};
1293 my $pcidevices = lspci
($2);
1294 $res->{pciid
} = $pcidevices->{$2};
1296 } elsif ($kv =~ m/^driver=(kvm|vfio)$/) {
1297 $res->{driver
} = $1;
1298 } elsif ($kv =~ m/^rombar=(on|off)$/) {
1299 $res->{rombar
} = $1;
1300 } elsif ($kv =~ m/^x-vga=(on|off)$/) {
1301 $res->{'x-vga'} = $1;
1302 } elsif ($kv =~ m/^pcie=(\d+)$/) {
1303 $res->{pcie
} = 1 if $1 == 1;
1305 warn "unknown hostpci setting '$kv'\n";
1309 return undef if !$found;
1314 # netX: e1000=XX:XX:XX:XX:XX:XX,bridge=vmbr0,rate=<mbps>
1320 foreach my $kvp (split(/,/, $data)) {
1322 if ($kvp =~ m/^(ne2k_pci|e1000|rtl8139|pcnet|virtio|ne2k_isa|i82551|i82557b|i82559er|vmxnet3)(=([0-9a-f]{2}(:[0-9a-f]{2}){5}))?$/i) {
1324 my $mac = defined($3) ?
uc($3) : PVE
::Tools
::random_ether_addr
();
1325 $res->{model
} = $model;
1326 $res->{macaddr
} = $mac;
1327 } elsif ($kvp =~ m/^bridge=(\S+)$/) {
1328 $res->{bridge
} = $1;
1329 } elsif ($kvp =~ m/^queues=(\d+)$/) {
1330 $res->{queues
} = $1;
1331 } elsif ($kvp =~ m/^rate=(\d+(\.\d+)?)$/) {
1333 } elsif ($kvp =~ m/^tag=(\d+)$/) {
1335 } elsif ($kvp =~ m/^firewall=(\d+)$/) {
1336 $res->{firewall
} = $1;
1343 return undef if !$res->{model
};
1351 my $res = "$net->{model}";
1352 $res .= "=$net->{macaddr}" if $net->{macaddr
};
1353 $res .= ",bridge=$net->{bridge}" if $net->{bridge
};
1354 $res .= ",rate=$net->{rate}" if $net->{rate
};
1355 $res .= ",tag=$net->{tag}" if $net->{tag
};
1356 $res .= ",firewall=$net->{firewall}" if $net->{firewall
};
1361 sub add_random_macs
{
1362 my ($settings) = @_;
1364 foreach my $opt (keys %$settings) {
1365 next if $opt !~ m/^net(\d+)$/;
1366 my $net = parse_net
($settings->{$opt});
1368 $settings->{$opt} = print_net
($net);
1372 sub add_unused_volume
{
1373 my ($config, $volid) = @_;
1376 for (my $ind = $MAX_UNUSED_DISKS - 1; $ind >= 0; $ind--) {
1377 my $test = "unused$ind";
1378 if (my $vid = $config->{$test}) {
1379 return if $vid eq $volid; # do not add duplicates
1385 die "To many unused volume - please delete them first.\n" if !$key;
1387 $config->{$key} = $volid;
1392 my $valid_smbios1_options = {
1393 manufacturer
=> '\S+',
1397 uuid
=> '[a-fA-F0-9]{8}(?:-[a-fA-F0-9]{4}){3}-[a-fA-F0-9]{12}',
1402 # smbios: [manufacturer=str][,product=str][,version=str][,serial=str][,uuid=uuid][,sku=str][,family=str]
1408 foreach my $kvp (split(/,/, $data)) {
1409 return undef if $kvp !~ m/^(\S+)=(.+)$/;
1410 my ($k, $v) = split(/=/, $kvp);
1411 return undef if !defined($k) || !defined($v);
1412 return undef if !$valid_smbios1_options->{$k};
1413 return undef if $v !~ m/^$valid_smbios1_options->{$k}$/;
1424 foreach my $k (keys %$smbios1) {
1425 next if !defined($smbios1->{$k});
1426 next if !$valid_smbios1_options->{$k};
1427 $data .= ',' if $data;
1428 $data .= "$k=$smbios1->{$k}";
1433 PVE
::JSONSchema
::register_format
('pve-qm-smbios1', \
&verify_smbios1
);
1434 sub verify_smbios1
{
1435 my ($value, $noerr) = @_;
1437 return $value if parse_smbios1
($value);
1439 return undef if $noerr;
1441 die "unable to parse smbios (type 1) options\n";
1444 PVE
::JSONSchema
::register_format
('pve-qm-bootdisk', \
&verify_bootdisk
);
1445 sub verify_bootdisk
{
1446 my ($value, $noerr) = @_;
1448 return $value if valid_drivename
($value);
1450 return undef if $noerr;
1452 die "invalid boot disk '$value'\n";
1455 PVE
::JSONSchema
::register_format
('pve-qm-net', \
&verify_net
);
1457 my ($value, $noerr) = @_;
1459 return $value if parse_net
($value);
1461 return undef if $noerr;
1463 die "unable to parse network options\n";
1466 PVE
::JSONSchema
::register_format
('pve-qm-drive', \
&verify_drive
);
1468 my ($value, $noerr) = @_;
1470 return $value if parse_drive
(undef, $value);
1472 return undef if $noerr;
1474 die "unable to parse drive options\n";
1477 PVE
::JSONSchema
::register_format
('pve-qm-hostpci', \
&verify_hostpci
);
1478 sub verify_hostpci
{
1479 my ($value, $noerr) = @_;
1481 return $value if parse_hostpci
($value);
1483 return undef if $noerr;
1485 die "unable to parse pci id\n";
1488 PVE
::JSONSchema
::register_format
('pve-qm-watchdog', \
&verify_watchdog
);
1489 sub verify_watchdog
{
1490 my ($value, $noerr) = @_;
1492 return $value if parse_watchdog
($value);
1494 return undef if $noerr;
1496 die "unable to parse watchdog options\n";
1499 sub parse_watchdog
{
1502 return undef if !$value;
1506 foreach my $p (split(/,/, $value)) {
1507 next if $p =~ m/^\s*$/;
1509 if ($p =~ m/^(model=)?(i6300esb|ib700)$/) {
1511 } elsif ($p =~ m/^(action=)?(reset|shutdown|poweroff|pause|debug|none)$/) {
1512 $res->{action
} = $2;
1521 PVE
::JSONSchema
::register_format
('pve-qm-startup', \
&verify_startup
);
1522 sub verify_startup
{
1523 my ($value, $noerr) = @_;
1525 return $value if parse_startup
($value);
1527 return undef if $noerr;
1529 die "unable to parse startup options\n";
1535 return undef if !$value;
1539 foreach my $p (split(/,/, $value)) {
1540 next if $p =~ m/^\s*$/;
1542 if ($p =~ m/^(order=)?(\d+)$/) {
1544 } elsif ($p =~ m/^up=(\d+)$/) {
1546 } elsif ($p =~ m/^down=(\d+)$/) {
1556 sub parse_usb_device
{
1559 return undef if !$value;
1561 my @dl = split(/,/, $value);
1565 foreach my $v (@dl) {
1566 if ($v =~ m/^host=(0x)?([0-9A-Fa-f]{4}):(0x)?([0-9A-Fa-f]{4})$/) {
1568 $res->{vendorid
} = $2;
1569 $res->{productid
} = $4;
1570 } elsif ($v =~ m/^host=(\d+)\-(\d+(\.\d+)*)$/) {
1572 $res->{hostbus
} = $1;
1573 $res->{hostport
} = $2;
1574 } elsif ($v =~ m/^spice$/) {
1581 return undef if !$found;
1586 PVE
::JSONSchema
::register_format
('pve-qm-usb-device', \
&verify_usb_device
);
1587 sub verify_usb_device
{
1588 my ($value, $noerr) = @_;
1590 return $value if parse_usb_device
($value);
1592 return undef if $noerr;
1594 die "unable to parse usb device\n";
1597 # add JSON properties for create and set function
1598 sub json_config_properties
{
1601 foreach my $opt (keys %$confdesc) {
1602 next if $opt eq 'parent' || $opt eq 'snaptime' || $opt eq 'vmstate';
1603 $prop->{$opt} = $confdesc->{$opt};
1610 my ($key, $value) = @_;
1612 die "unknown setting '$key'\n" if !$confdesc->{$key};
1614 my $type = $confdesc->{$key}->{type
};
1616 if (!defined($value)) {
1617 die "got undefined value\n";
1620 if ($value =~ m/[\n\r]/) {
1621 die "property contains a line feed\n";
1624 if ($type eq 'boolean') {
1625 return 1 if ($value eq '1') || ($value =~ m/^(on|yes|true)$/i);
1626 return 0 if ($value eq '0') || ($value =~ m/^(off|no|false)$/i);
1627 die "type check ('boolean') failed - got '$value'\n";
1628 } elsif ($type eq 'integer') {
1629 return int($1) if $value =~ m/^(\d+)$/;
1630 die "type check ('integer') failed - got '$value'\n";
1631 } elsif ($type eq 'number') {
1632 return $value if $value =~ m/^(\d+)(\.\d+)?$/;
1633 die "type check ('number') failed - got '$value'\n";
1634 } elsif ($type eq 'string') {
1635 if (my $fmt = $confdesc->{$key}->{format
}) {
1636 if ($fmt eq 'pve-qm-drive') {
1637 # special case - we need to pass $key to parse_drive()
1638 my $drive = parse_drive
($key, $value);
1639 return $value if $drive;
1640 die "unable to parse drive options\n";
1642 PVE
::JSONSchema
::check_format
($fmt, $value);
1645 $value =~ s/^\"(.*)\"$/$1/;
1648 die "internal error"
1652 sub lock_config_full
{
1653 my ($vmid, $timeout, $code, @param) = @_;
1655 my $filename = config_file_lock
($vmid);
1657 my $res = lock_file
($filename, $timeout, $code, @param);
1664 sub lock_config_mode
{
1665 my ($vmid, $timeout, $shared, $code, @param) = @_;
1667 my $filename = config_file_lock
($vmid);
1669 my $res = lock_file_full
($filename, $timeout, $shared, $code, @param);
1677 my ($vmid, $code, @param) = @_;
1679 return lock_config_full
($vmid, 10, $code, @param);
1682 sub cfs_config_path
{
1683 my ($vmid, $node) = @_;
1685 $node = $nodename if !$node;
1686 return "nodes/$node/qemu-server/$vmid.conf";
1689 sub check_iommu_support
{
1690 #fixme : need to check IOMMU support
1691 #http://www.linux-kvm.org/page/How_to_assign_devices_with_VT-d_in_KVM
1699 my ($vmid, $node) = @_;
1701 my $cfspath = cfs_config_path
($vmid, $node);
1702 return "/etc/pve/$cfspath";
1705 sub config_file_lock
{
1708 return "$lock_dir/lock-$vmid.conf";
1714 my $conf = config_file
($vmid);
1715 utime undef, undef, $conf;
1719 my ($storecfg, $vmid, $keep_empty_config) = @_;
1721 my $conffile = config_file
($vmid);
1723 my $conf = load_config
($vmid);
1727 # only remove disks owned by this VM
1728 foreach_drive
($conf, sub {
1729 my ($ds, $drive) = @_;
1731 return if drive_is_cdrom
($drive);
1733 my $volid = $drive->{file
};
1735 return if !$volid || $volid =~ m
|^/|;
1737 my ($path, $owner) = PVE
::Storage
::path
($storecfg, $volid);
1738 return if !$path || !$owner || ($owner != $vmid);
1740 PVE
::Storage
::vdisk_free
($storecfg, $volid);
1743 if ($keep_empty_config) {
1744 PVE
::Tools
::file_set_contents
($conffile, "memory: 128\n");
1749 # also remove unused disk
1751 my $dl = PVE
::Storage
::vdisk_list
($storecfg, undef, $vmid);
1754 PVE
::Storage
::foreach_volid
($dl, sub {
1755 my ($volid, $sid, $volname, $d) = @_;
1756 PVE
::Storage
::vdisk_free
($storecfg, $volid);
1766 my ($vmid, $node) = @_;
1768 my $cfspath = cfs_config_path
($vmid, $node);
1770 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath);
1772 die "no such VM ('$vmid')\n" if !defined($conf);
1777 sub parse_vm_config
{
1778 my ($filename, $raw) = @_;
1780 return undef if !defined($raw);
1783 digest
=> Digest
::SHA
::sha1_hex
($raw),
1787 $filename =~ m
|/qemu-server/(\d
+)\
.conf
$|
1788 || die "got strange filename '$filename'";
1795 my @lines = split(/\n/, $raw);
1796 foreach my $line (@lines) {
1797 next if $line =~ m/^\s*$/;
1799 if ($line =~ m/^\[([a-z][a-z0-9_\-]+)\]\s*$/i) {
1801 $conf->{description
} = $descr if $descr;
1803 $conf = $res->{snapshots
}->{$snapname} = {};
1807 if ($line =~ m/^\#(.*)\s*$/) {
1808 $descr .= PVE
::Tools
::decode_text
($1) . "\n";
1812 if ($line =~ m/^(description):\s*(.*\S)\s*$/) {
1813 $descr .= PVE
::Tools
::decode_text
($2);
1814 } elsif ($line =~ m/snapstate:\s*(prepare|delete)\s*$/) {
1815 $conf->{snapstate
} = $1;
1816 } elsif ($line =~ m/^(args):\s*(.*\S)\s*$/) {
1819 $conf->{$key} = $value;
1820 } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/) {
1823 eval { $value = check_type
($key, $value); };
1825 warn "vm $vmid - unable to parse value of '$key' - $@";
1827 my $fmt = $confdesc->{$key}->{format
};
1828 if ($fmt && $fmt eq 'pve-qm-drive') {
1829 my $v = parse_drive
($key, $value);
1830 if (my $volid = filename_to_volume_id
($vmid, $v->{file
}, $v->{media
})) {
1831 $v->{file
} = $volid;
1832 $value = print_drive
($vmid, $v);
1834 warn "vm $vmid - unable to parse value of '$key'\n";
1839 if ($key eq 'cdrom') {
1840 $conf->{ide2
} = $value;
1842 $conf->{$key} = $value;
1848 $conf->{description
} = $descr if $descr;
1850 delete $res->{snapstate
}; # just to be sure
1855 sub write_vm_config
{
1856 my ($filename, $conf) = @_;
1858 delete $conf->{snapstate
}; # just to be sure
1860 if ($conf->{cdrom
}) {
1861 die "option ide2 conflicts with cdrom\n" if $conf->{ide2
};
1862 $conf->{ide2
} = $conf->{cdrom
};
1863 delete $conf->{cdrom
};
1866 # we do not use 'smp' any longer
1867 if ($conf->{sockets
}) {
1868 delete $conf->{smp
};
1869 } elsif ($conf->{smp
}) {
1870 $conf->{sockets
} = $conf->{smp
};
1871 delete $conf->{cores
};
1872 delete $conf->{smp
};
1875 if ($conf->{maxcpus
} && $conf->{sockets
}) {
1876 delete $conf->{sockets
};
1879 my $used_volids = {};
1881 my $cleanup_config = sub {
1882 my ($cref, $snapname) = @_;
1884 foreach my $key (keys %$cref) {
1885 next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots' ||
1886 $key eq 'snapstate';
1887 my $value = $cref->{$key};
1888 eval { $value = check_type
($key, $value); };
1889 die "unable to parse value of '$key' - $@" if $@;
1891 $cref->{$key} = $value;
1893 if (!$snapname && valid_drivename
($key)) {
1894 my $drive = parse_drive
($key, $value);
1895 $used_volids->{$drive->{file
}} = 1 if $drive && $drive->{file
};
1900 &$cleanup_config($conf);
1901 foreach my $snapname (keys %{$conf->{snapshots
}}) {
1902 &$cleanup_config($conf->{snapshots
}->{$snapname}, $snapname);
1905 # remove 'unusedX' settings if we re-add a volume
1906 foreach my $key (keys %$conf) {
1907 my $value = $conf->{$key};
1908 if ($key =~ m/^unused/ && $used_volids->{$value}) {
1909 delete $conf->{$key};
1913 my $generate_raw_config = sub {
1918 # add description as comment to top of file
1919 my $descr = $conf->{description
} || '';
1920 foreach my $cl (split(/\n/, $descr)) {
1921 $raw .= '#' . PVE
::Tools
::encode_text
($cl) . "\n";
1924 foreach my $key (sort keys %$conf) {
1925 next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots';
1926 $raw .= "$key: $conf->{$key}\n";
1931 my $raw = &$generate_raw_config($conf);
1932 foreach my $snapname (sort keys %{$conf->{snapshots
}}) {
1933 $raw .= "\n[$snapname]\n";
1934 $raw .= &$generate_raw_config($conf->{snapshots
}->{$snapname});
1940 sub update_config_nolock
{
1941 my ($vmid, $conf, $skiplock) = @_;
1943 check_lock
($conf) if !$skiplock;
1945 my $cfspath = cfs_config_path
($vmid);
1947 PVE
::Cluster
::cfs_write_file
($cfspath, $conf);
1951 my ($vmid, $conf, $skiplock) = @_;
1953 lock_config
($vmid, &update_config_nolock
, $conf, $skiplock);
1960 # we use static defaults from our JSON schema configuration
1961 foreach my $key (keys %$confdesc) {
1962 if (defined(my $default = $confdesc->{$key}->{default})) {
1963 $res->{$key} = $default;
1967 my $conf = PVE
::Cluster
::cfs_read_file
('datacenter.cfg');
1968 $res->{keyboard
} = $conf->{keyboard
} if $conf->{keyboard
};
1974 my $vmlist = PVE
::Cluster
::get_vmlist
();
1976 return $res if !$vmlist || !$vmlist->{ids
};
1977 my $ids = $vmlist->{ids
};
1979 foreach my $vmid (keys %$ids) {
1980 my $d = $ids->{$vmid};
1981 next if !$d->{node
} || $d->{node
} ne $nodename;
1982 next if !$d->{type
} || $d->{type
} ne 'qemu';
1983 $res->{$vmid}->{exists} = 1;
1988 # test if VM uses local resources (to prevent migration)
1989 sub check_local_resources
{
1990 my ($conf, $noerr) = @_;
1994 $loc_res = 1 if $conf->{hostusb
}; # old syntax
1995 $loc_res = 1 if $conf->{hostpci
}; # old syntax
1997 foreach my $k (keys %$conf) {
1998 next if $k =~ m/^usb/ && ($conf->{$k} eq 'spice');
1999 $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/;
2002 die "VM uses local resources\n" if $loc_res && !$noerr;
2007 # check if used storages are available on all nodes (use by migrate)
2008 sub check_storage_availability
{
2009 my ($storecfg, $conf, $node) = @_;
2011 foreach_drive
($conf, sub {
2012 my ($ds, $drive) = @_;
2014 my $volid = $drive->{file
};
2017 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
2020 # check if storage is available on both nodes
2021 my $scfg = PVE
::Storage
::storage_check_node
($storecfg, $sid);
2022 PVE
::Storage
::storage_check_node
($storecfg, $sid, $node);
2026 # list nodes where all VM images are available (used by has_feature API)
2028 my ($conf, $storecfg) = @_;
2030 my $nodelist = PVE
::Cluster
::get_nodelist
();
2031 my $nodehash = { map { $_ => 1 } @$nodelist };
2032 my $nodename = PVE
::INotify
::nodename
();
2034 foreach_drive
($conf, sub {
2035 my ($ds, $drive) = @_;
2037 my $volid = $drive->{file
};
2040 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
2042 my $scfg = PVE
::Storage
::storage_config
($storecfg, $storeid);
2043 if ($scfg->{disable
}) {
2045 } elsif (my $avail = $scfg->{nodes
}) {
2046 foreach my $node (keys %$nodehash) {
2047 delete $nodehash->{$node} if !$avail->{$node};
2049 } elsif (!$scfg->{shared
}) {
2050 foreach my $node (keys %$nodehash) {
2051 delete $nodehash->{$node} if $node ne $nodename
2063 die "VM is locked ($conf->{lock})\n" if $conf->{lock};
2067 my ($pidfile, $pid) = @_;
2069 my $fh = IO
::File-
>new("/proc/$pid/cmdline", "r");
2073 return undef if !$line;
2074 my @param = split(/\0/, $line);
2076 my $cmd = $param[0];
2077 return if !$cmd || ($cmd !~ m
|kvm
$| && $cmd !~ m
|qemu-system-x86_64
$|);
2079 for (my $i = 0; $i < scalar (@param); $i++) {
2082 if (($p eq '-pidfile') || ($p eq '--pidfile')) {
2083 my $p = $param[$i+1];
2084 return 1 if $p && ($p eq $pidfile);
2093 my ($vmid, $nocheck, $node) = @_;
2095 my $filename = config_file
($vmid, $node);
2097 die "unable to find configuration file for VM $vmid - no such machine\n"
2098 if !$nocheck && ! -f
$filename;
2100 my $pidfile = pidfile_name
($vmid);
2102 if (my $fd = IO
::File-
>new("<$pidfile")) {
2107 my $mtime = $st->mtime;
2108 if ($mtime > time()) {
2109 warn "file '$filename' modified in future\n";
2112 if ($line =~ m/^(\d+)$/) {
2114 if (check_cmdline
($pidfile, $pid)) {
2115 if (my $pinfo = PVE
::ProcFSTools
::check_process_running
($pid)) {
2127 my $vzlist = config_list
();
2129 my $fd = IO
::Dir-
>new($var_run_tmpdir) || return $vzlist;
2131 while (defined(my $de = $fd->read)) {
2132 next if $de !~ m/^(\d+)\.pid$/;
2134 next if !defined($vzlist->{$vmid});
2135 if (my $pid = check_running
($vmid)) {
2136 $vzlist->{$vmid}->{pid
} = $pid;
2144 my ($storecfg, $conf) = @_;
2146 my $bootdisk = $conf->{bootdisk
};
2147 return undef if !$bootdisk;
2148 return undef if !valid_drivename
($bootdisk);
2150 return undef if !$conf->{$bootdisk};
2152 my $drive = parse_drive
($bootdisk, $conf->{$bootdisk});
2153 return undef if !defined($drive);
2155 return undef if drive_is_cdrom
($drive);
2157 my $volid = $drive->{file
};
2158 return undef if !$volid;
2160 return $drive->{size
};
2163 my $last_proc_pid_stat;
2165 # get VM status information
2166 # This must be fast and should not block ($full == false)
2167 # We only query KVM using QMP if $full == true (this can be slow)
2169 my ($opt_vmid, $full) = @_;
2173 my $storecfg = PVE
::Storage
::config
();
2175 my $list = vzlist
();
2176 my ($uptime) = PVE
::ProcFSTools
::read_proc_uptime
(1);
2178 my $cpucount = $cpuinfo->{cpus
} || 1;
2180 foreach my $vmid (keys %$list) {
2181 next if $opt_vmid && ($vmid ne $opt_vmid);
2183 my $cfspath = cfs_config_path
($vmid);
2184 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath) || {};
2187 $d->{pid
} = $list->{$vmid}->{pid
};
2189 # fixme: better status?
2190 $d->{status
} = $list->{$vmid}->{pid
} ?
'running' : 'stopped';
2192 my $size = disksize
($storecfg, $conf);
2193 if (defined($size)) {
2194 $d->{disk
} = 0; # no info available
2195 $d->{maxdisk
} = $size;
2201 $d->{cpus
} = ($conf->{sockets
} || 1) * ($conf->{cores
} || 1);
2202 $d->{cpus
} = $cpucount if $d->{cpus
} > $cpucount;
2204 $d->{name
} = $conf->{name
} || "VM $vmid";
2205 $d->{maxmem
} = $conf->{memory
} ?
$conf->{memory
}*(1024*1024) : 0;
2207 if ($conf->{balloon
}) {
2208 $d->{balloon_min
} = $conf->{balloon
}*(1024*1024);
2209 $d->{shares
} = defined($conf->{shares
}) ?
$conf->{shares
} : 1000;
2220 $d->{diskwrite
} = 0;
2222 $d->{template
} = is_template
($conf);
2227 my $netdev = PVE
::ProcFSTools
::read_proc_net_dev
();
2228 foreach my $dev (keys %$netdev) {
2229 next if $dev !~ m/^tap([1-9]\d*)i/;
2231 my $d = $res->{$vmid};
2234 $d->{netout
} += $netdev->{$dev}->{receive
};
2235 $d->{netin
} += $netdev->{$dev}->{transmit
};
2238 my $ctime = gettimeofday
;
2240 foreach my $vmid (keys %$list) {
2242 my $d = $res->{$vmid};
2243 my $pid = $d->{pid
};
2246 my $pstat = PVE
::ProcFSTools
::read_proc_pid_stat
($pid);
2247 next if !$pstat; # not running
2249 my $used = $pstat->{utime} + $pstat->{stime
};
2251 $d->{uptime
} = int(($uptime - $pstat->{starttime
})/$cpuinfo->{user_hz
});
2253 if ($pstat->{vsize
}) {
2254 $d->{mem
} = int(($pstat->{rss
}/$pstat->{vsize
})*$d->{maxmem
});
2257 my $old = $last_proc_pid_stat->{$pid};
2259 $last_proc_pid_stat->{$pid} = {
2267 my $dtime = ($ctime - $old->{time}) * $cpucount * $cpuinfo->{user_hz
};
2269 if ($dtime > 1000) {
2270 my $dutime = $used - $old->{used
};
2272 $d->{cpu
} = (($dutime/$dtime)* $cpucount) / $d->{cpus
};
2273 $last_proc_pid_stat->{$pid} = {
2279 $d->{cpu
} = $old->{cpu
};
2283 return $res if !$full;
2285 my $qmpclient = PVE
::QMPClient-
>new();
2287 my $ballooncb = sub {
2288 my ($vmid, $resp) = @_;
2290 my $info = $resp->{'return'};
2291 return if !$info->{max_mem
};
2293 my $d = $res->{$vmid};
2295 # use memory assigned to VM
2296 $d->{maxmem
} = $info->{max_mem
};
2297 $d->{balloon
} = $info->{actual
};
2299 if (defined($info->{total_mem
}) && defined($info->{free_mem
})) {
2300 $d->{mem
} = $info->{total_mem
} - $info->{free_mem
};
2301 $d->{freemem
} = $info->{free_mem
};
2306 my $blockstatscb = sub {
2307 my ($vmid, $resp) = @_;
2308 my $data = $resp->{'return'} || [];
2309 my $totalrdbytes = 0;
2310 my $totalwrbytes = 0;
2311 for my $blockstat (@$data) {
2312 $totalrdbytes = $totalrdbytes + $blockstat->{stats
}->{rd_bytes
};
2313 $totalwrbytes = $totalwrbytes + $blockstat->{stats
}->{wr_bytes
};
2315 $res->{$vmid}->{diskread
} = $totalrdbytes;
2316 $res->{$vmid}->{diskwrite
} = $totalwrbytes;
2319 my $statuscb = sub {
2320 my ($vmid, $resp) = @_;
2322 $qmpclient->queue_cmd($vmid, $blockstatscb, 'query-blockstats');
2323 # this fails if ballon driver is not loaded, so this must be
2324 # the last commnand (following command are aborted if this fails).
2325 $qmpclient->queue_cmd($vmid, $ballooncb, 'query-balloon');
2327 my $status = 'unknown';
2328 if (!defined($status = $resp->{'return'}->{status
})) {
2329 warn "unable to get VM status\n";
2333 $res->{$vmid}->{qmpstatus
} = $resp->{'return'}->{status
};
2336 foreach my $vmid (keys %$list) {
2337 next if $opt_vmid && ($vmid ne $opt_vmid);
2338 next if !$res->{$vmid}->{pid
}; # not running
2339 $qmpclient->queue_cmd($vmid, $statuscb, 'query-status');
2342 $qmpclient->queue_execute(undef, 1);
2344 foreach my $vmid (keys %$list) {
2345 next if $opt_vmid && ($vmid ne $opt_vmid);
2346 $res->{$vmid}->{qmpstatus
} = $res->{$vmid}->{status
} if !$res->{$vmid}->{qmpstatus
};
2353 my ($conf, $func) = @_;
2355 foreach my $ds (keys %$conf) {
2356 next if !valid_drivename
($ds);
2358 my $drive = parse_drive
($ds, $conf->{$ds});
2361 &$func($ds, $drive);
2366 my ($conf, $func) = @_;
2370 my $test_volid = sub {
2371 my ($volid, $is_cdrom) = @_;
2375 $volhash->{$volid} = $is_cdrom || 0;
2378 foreach_drive
($conf, sub {
2379 my ($ds, $drive) = @_;
2380 &$test_volid($drive->{file
}, drive_is_cdrom
($drive));
2383 foreach my $snapname (keys %{$conf->{snapshots
}}) {
2384 my $snap = $conf->{snapshots
}->{$snapname};
2385 &$test_volid($snap->{vmstate
}, 0);
2386 foreach_drive
($snap, sub {
2387 my ($ds, $drive) = @_;
2388 &$test_volid($drive->{file
}, drive_is_cdrom
($drive));
2392 foreach my $volid (keys %$volhash) {
2393 &$func($volid, $volhash->{$volid});
2397 sub vga_conf_has_spice
{
2400 return 0 if !$vga || $vga !~ m/^qxl([234])?$/;
2405 sub config_to_command
{
2406 my ($storecfg, $vmid, $conf, $defaults, $forcemachine) = @_;
2409 my $globalFlags = [];
2410 my $machineFlags = [];
2416 my $kvmver = kvm_user_version
();
2417 my $vernum = 0; # unknown
2418 if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
2419 $vernum = $1*1000000+$2*1000;
2420 } elsif ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
2421 $vernum = $1*1000000+$2*1000+$3;
2424 die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 15000;
2426 my $have_ovz = -f
'/proc/vz/vestat';
2428 my $q35 = machine_type_is_q35
($conf);
2430 push @$cmd, '/usr/bin/kvm';
2432 push @$cmd, '-id', $vmid;
2436 my $qmpsocket = qmp_socket
($vmid);
2437 push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
2438 push @$cmd, '-mon', "chardev=qmp,mode=control";
2440 my $socket = vnc_socket
($vmid);
2441 push @$cmd, '-vnc', "unix:$socket,x509,password";
2443 push @$cmd, '-pidfile' , pidfile_name
($vmid);
2445 push @$cmd, '-daemonize';
2447 if ($conf->{smbios1
}) {
2448 push @$cmd, '-smbios', "type=1,$conf->{smbios1}";
2451 push @$cmd, '-object', "iothread,id=iothread0" if $conf->{iothread
};
2454 # the q35 chipset support native usb2, so we enable usb controller
2455 # by default for this machine type
2456 push @$devices, '-readconfig', '/usr/share/qemu-server/pve-q35.cfg';
2458 $pciaddr = print_pci_addr
("piix3", $bridges);
2459 push @$devices, '-device', "piix3-usb-uhci,id=uhci$pciaddr.0x2";
2462 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2463 next if !$conf->{"usb$i"};
2466 # include usb device config
2467 push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
2470 my $vga = $conf->{vga
};
2472 my $qxlnum = vga_conf_has_spice
($vga);
2473 $vga = 'qxl' if $qxlnum;
2476 if ($conf->{ostype
} && ($conf->{ostype
} eq 'win8' ||
2477 $conf->{ostype
} eq 'win7' ||
2478 $conf->{ostype
} eq 'w2k8')) {
2485 # enable absolute mouse coordinates (needed by vnc)
2487 if (defined($conf->{tablet
})) {
2488 $tablet = $conf->{tablet
};
2490 $tablet = $defaults->{tablet
};
2491 $tablet = 0 if $qxlnum; # disable for spice because it is not needed
2492 $tablet = 0 if $vga =~ m/^serial\d+$/; # disable if we use serial terminal (no vga card)
2495 push @$devices, '-device', print_tabletdevice_full
($conf) if $tablet;
2498 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
2499 my $d = parse_hostpci
($conf->{"hostpci$i"});
2502 my $pcie = $d->{pcie
};
2504 die "q35 machine model is not enabled" if !$q35;
2505 $pciaddr = print_pcie_addr
("hostpci$i");
2507 $pciaddr = print_pci_addr
("hostpci$i", $bridges);
2510 my $rombar = $d->{rombar
} && $d->{rombar
} eq 'off' ?
",rombar=0" : "";
2511 my $driver = $d->{driver
} && $d->{driver
} eq 'vfio' ?
"vfio-pci" : "pci-assign";
2512 my $xvga = $d->{'x-vga'} && $d->{'x-vga'} eq 'on' ?
",x-vga=on" : "";
2513 if ($xvga && $xvga ne '') {
2514 push @$cpuFlags, 'kvm=off';
2517 $driver = "vfio-pci" if $xvga ne '';
2518 my $pcidevices = $d->{pciid
};
2519 my $multifunction = 1 if @$pcidevices > 1;
2522 foreach my $pcidevice (@$pcidevices) {
2524 my $id = "hostpci$i";
2525 $id .= ".$j" if $multifunction;
2526 my $addr = $pciaddr;
2527 $addr .= ".$j" if $multifunction;
2528 my $devicestr = "$driver,host=$pcidevice->{id}.$pcidevice->{function},id=$id$addr";
2531 $devicestr .= "$rombar$xvga";
2532 $devicestr .= ",multifunction=on" if $multifunction;
2535 push @$devices, '-device', $devicestr;
2541 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2542 my $d = parse_usb_device
($conf->{"usb$i"});
2544 if ($d->{vendorid
} && $d->{productid
}) {
2545 push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2546 } elsif (defined($d->{hostbus
}) && defined($d->{hostport
})) {
2547 push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2548 } elsif ($d->{spice
}) {
2549 # usb redir support for spice
2550 push @$devices, '-chardev', "spicevmc,id=usbredirchardev$i,name=usbredir";
2551 push @$devices, '-device', "usb-redir,chardev=usbredirchardev$i,id=usbredirdev$i,bus=ehci.0";
2556 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
2557 if (my $path = $conf->{"serial$i"}) {
2558 if ($path eq 'socket') {
2559 my $socket = "/var/run/qemu-server/${vmid}.serial$i";
2560 push @$devices, '-chardev', "socket,id=serial$i,path=$socket,server,nowait";
2561 push @$devices, '-device', "isa-serial,chardev=serial$i";
2563 die "no such serial device\n" if ! -c
$path;
2564 push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2565 push @$devices, '-device', "isa-serial,chardev=serial$i";
2571 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
2572 if (my $path = $conf->{"parallel$i"}) {
2573 die "no such parallel device\n" if ! -c
$path;
2574 my $devtype = $path =~ m!^/dev/usb/lp! ?
'tty' : 'parport';
2575 push @$devices, '-chardev', "$devtype,id=parallel$i,path=$path";
2576 push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2580 my $vmname = $conf->{name
} || "vm$vmid";
2582 push @$cmd, '-name', $vmname;
2585 $sockets = $conf->{smp
} if $conf->{smp
}; # old style - no longer iused
2586 $sockets = $conf->{sockets
} if $conf->{sockets
};
2588 my $cores = $conf->{cores
} || 1;
2589 my $maxcpus = $conf->{maxcpus
} if $conf->{maxcpus
};
2591 my $total_cores = $sockets * $cores;
2592 my $allowed_cores = $cpuinfo->{cpus
};
2594 die "MAX $allowed_cores cores allowed per VM on this node\n"
2595 if ($allowed_cores < $total_cores);
2598 push @$cmd, '-smp', "cpus=$cores,maxcpus=$maxcpus";
2600 push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2603 push @$cmd, '-nodefaults';
2605 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
2607 my $bootindex_hash = {};
2609 foreach my $o (split(//, $bootorder)) {
2610 $bootindex_hash->{$o} = $i*100;
2614 push @$cmd, '-boot', "menu=on";
2616 push @$cmd, '-no-acpi' if defined($conf->{acpi
}) && $conf->{acpi
} == 0;
2618 push @$cmd, '-no-reboot' if defined($conf->{reboot
}) && $conf->{reboot
} == 0;
2620 push @$cmd, '-vga', $vga if $vga && $vga !~ m/^serial\d+$/; # for kvm 77 and later
2623 my $tdf = defined($conf->{tdf
}) ?
$conf->{tdf
} : $defaults->{tdf
};
2625 my $nokvm = defined($conf->{kvm
}) && $conf->{kvm
} == 0 ?
1 : 0;
2626 my $useLocaltime = $conf->{localtime};
2628 if (my $ost = $conf->{ostype
}) {
2629 # other, wxp, w2k, w2k3, w2k8, wvista, win7, win8, l24, l26, solaris
2631 if ($ost =~ m/^w/) { # windows
2632 $useLocaltime = 1 if !defined($conf->{localtime});
2634 # use time drift fix when acpi is enabled
2635 if (!(defined($conf->{acpi
}) && $conf->{acpi
} == 0)) {
2636 $tdf = 1 if !defined($conf->{tdf
});
2640 if ($ost eq 'win7' || $ost eq 'win8' || $ost eq 'w2k8' ||
2642 push @$globalFlags, 'kvm-pit.lost_tick_policy=discard';
2643 push @$cmd, '-no-hpet';
2644 #push @$cpuFlags , 'hv_vapic" if !$nokvm; #fixme, my win2008R2 hang at boot with this
2645 push @$cpuFlags , 'hv_spinlocks=0xffff' if !$nokvm;
2648 if ($ost eq 'win7' || $ost eq 'win8') {
2649 push @$cpuFlags , 'hv_relaxed' if !$nokvm;
2653 push @$rtcFlags, 'driftfix=slew' if $tdf;
2656 push @$machineFlags, 'accel=tcg';
2658 die "No accelerator found!\n" if !$cpuinfo->{hvm
};
2661 my $machine_type = $forcemachine || $conf->{machine
};
2662 if ($machine_type) {
2663 push @$machineFlags, "type=${machine_type}";
2666 if ($conf->{startdate
}) {
2667 push @$rtcFlags, "base=$conf->{startdate}";
2668 } elsif ($useLocaltime) {
2669 push @$rtcFlags, 'base=localtime';
2672 my $cpu = $nokvm ?
"qemu64" : "kvm64";
2673 $cpu = $conf->{cpu
} if $conf->{cpu
};
2675 push @$cpuFlags , '+lahf_lm' if $cpu eq 'kvm64';
2677 push @$cpuFlags , '+x2apic' if !$nokvm && $conf->{ostype
} ne 'solaris';
2679 push @$cpuFlags , '-x2apic' if $conf->{ostype
} eq 'solaris';
2681 push @$cpuFlags, '+sep' if $cpu eq 'kvm64' || $cpu eq 'kvm32';
2683 $cpu .= "," . join(',', @$cpuFlags) if scalar(@$cpuFlags);
2685 # Note: enforce needs kernel 3.10, so we do not use it for now
2686 # push @$cmd, '-cpu', "$cpu,enforce";
2687 push @$cmd, '-cpu', $cpu;
2689 push @$cmd, '-S' if $conf->{freeze
};
2691 # set keyboard layout
2692 my $kb = $conf->{keyboard
} || $defaults->{keyboard
};
2693 push @$cmd, '-k', $kb if $kb;
2696 #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2697 #push @$cmd, '-soundhw', 'es1370';
2698 #push @$cmd, '-soundhw', $soundhw if $soundhw;
2700 if($conf->{agent
}) {
2701 my $qgasocket = qmp_socket
($vmid, 1);
2702 my $pciaddr = print_pci_addr
("qga0", $bridges);
2703 push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
2704 push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
2705 push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
2712 if ($conf->{ostype
} && $conf->{ostype
} =~ m/^w/){
2713 for(my $i = 1; $i < $qxlnum; $i++){
2714 my $pciaddr = print_pci_addr
("vga$i", $bridges);
2715 push @$cmd, '-device', "qxl,id=vga$i,ram_size=67108864,vram_size=33554432$pciaddr";
2718 # assume other OS works like Linux
2719 push @$cmd, '-global', 'qxl-vga.ram_size=134217728';
2720 push @$cmd, '-global', 'qxl-vga.vram_size=67108864';
2724 my $pciaddr = print_pci_addr
("spice", $bridges);
2726 $spice_port = PVE
::Tools
::next_spice_port
();
2728 push @$devices, '-spice', "tls-port=${spice_port},addr=127.0.0.1,tls-ciphers=DES-CBC3-SHA,seamless-migration=on";
2730 push @$devices, '-device', "virtio-serial,id=spice$pciaddr";
2731 push @$devices, '-chardev', "spicevmc,id=vdagent,name=vdagent";
2732 push @$devices, '-device', "virtserialport,chardev=vdagent,name=com.redhat.spice.0";
2735 # enable balloon by default, unless explicitly disabled
2736 if (!defined($conf->{balloon
}) || $conf->{balloon
}) {
2737 $pciaddr = print_pci_addr
("balloon0", $bridges);
2738 push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr";
2741 if ($conf->{watchdog
}) {
2742 my $wdopts = parse_watchdog
($conf->{watchdog
});
2743 $pciaddr = print_pci_addr
("watchdog", $bridges);
2744 my $watchdog = $wdopts->{model
} || 'i6300esb';
2745 push @$devices, '-device', "$watchdog$pciaddr";
2746 push @$devices, '-watchdog-action', $wdopts->{action
} if $wdopts->{action
};
2750 my $scsicontroller = {};
2751 my $ahcicontroller = {};
2752 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : $defaults->{scsihw
};
2754 # Add iscsi initiator name if available
2755 if (my $initiator = get_initiator_name
()) {
2756 push @$devices, '-iscsi', "initiator-name=$initiator";
2759 foreach_drive
($conf, sub {
2760 my ($ds, $drive) = @_;
2762 if (PVE
::Storage
::parse_volume_id
($drive->{file
}, 1)) {
2763 push @$vollist, $drive->{file
};
2766 $use_virtio = 1 if $ds =~ m/^virtio/;
2768 if (drive_is_cdrom
($drive)) {
2769 if ($bootindex_hash->{d
}) {
2770 $drive->{bootindex
} = $bootindex_hash->{d
};
2771 $bootindex_hash->{d
} += 1;
2774 if ($bootindex_hash->{c
}) {
2775 $drive->{bootindex
} = $bootindex_hash->{c
} if $conf->{bootdisk
} && ($conf->{bootdisk
} eq $ds);
2776 $bootindex_hash->{c
} += 1;
2780 if ($drive->{interface
} eq 'scsi') {
2782 my $maxdev = ($scsihw !~ m/^lsi/) ?
256 : 7;
2783 my $controller = int($drive->{index} / $maxdev);
2784 $pciaddr = print_pci_addr
("scsihw$controller", $bridges);
2785 push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
2786 $scsicontroller->{$controller}=1;
2789 if ($drive->{interface
} eq 'sata') {
2790 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
2791 $pciaddr = print_pci_addr
("ahci$controller", $bridges);
2792 push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
2793 $ahcicontroller->{$controller}=1;
2796 my $drive_cmd = print_drive_full
($storecfg, $vmid, $drive);
2797 push @$devices, '-drive',$drive_cmd;
2798 push @$devices, '-device', print_drivedevice_full
($storecfg, $conf, $vmid, $drive, $bridges);
2801 push @$cmd, '-m', $conf->{memory
} || $defaults->{memory
};
2803 for (my $i = 0; $i < $MAX_NETS; $i++) {
2804 next if !$conf->{"net$i"};
2805 my $d = parse_net
($conf->{"net$i"});
2808 $use_virtio = 1 if $d->{model
} eq 'virtio';
2810 if ($bootindex_hash->{n
}) {
2811 $d->{bootindex
} = $bootindex_hash->{n
};
2812 $bootindex_hash->{n
} += 1;
2815 my $netdevfull = print_netdev_full
($vmid,$conf,$d,"net$i");
2816 push @$devices, '-netdev', $netdevfull;
2818 my $netdevicefull = print_netdevice_full
($vmid,$conf,$d,"net$i",$bridges);
2819 push @$devices, '-device', $netdevicefull;
2824 while (my ($k, $v) = each %$bridges) {
2825 $pciaddr = print_pci_addr
("pci.$k");
2826 unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
2830 # hack: virtio with fairsched is unreliable, so we do not use fairsched
2831 # when the VM uses virtio devices.
2832 if (!$use_virtio && $have_ovz) {
2834 my $cpuunits = defined($conf->{cpuunits
}) ?
2835 $conf->{cpuunits
} : $defaults->{cpuunits
};
2837 push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
2839 # fixme: cpulimit is currently ignored
2840 #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2844 if ($conf->{args
}) {
2845 my $aa = PVE
::Tools
::split_args
($conf->{args
});
2849 push @$cmd, @$devices;
2850 push @$cmd, '-rtc', join(',', @$rtcFlags)
2851 if scalar(@$rtcFlags);
2852 push @$cmd, '-machine', join(',', @$machineFlags)
2853 if scalar(@$machineFlags);
2854 push @$cmd, '-global', join(',', @$globalFlags)
2855 if scalar(@$globalFlags);
2857 return wantarray ?
($cmd, $vollist, $spice_port) : $cmd;
2862 return "${var_run_tmpdir}/$vmid.vnc";
2868 my $res = vm_mon_cmd
($vmid, 'query-spice');
2870 return $res->{'tls-port'} || $res->{'port'} || die "no spice port\n";
2874 my ($vmid, $qga) = @_;
2875 my $sockettype = $qga ?
'qga' : 'qmp';
2876 return "${var_run_tmpdir}/$vmid.$sockettype";
2881 return "${var_run_tmpdir}/$vmid.pid";
2884 sub vm_devices_list
{
2887 my $res = vm_mon_cmd
($vmid, 'query-pci');
2890 foreach my $pcibus (@$res) {
2891 foreach my $device (@{$pcibus->{devices
}}) {
2892 next if !$device->{'qdev_id'};
2893 $devices->{$device->{'qdev_id'}} = 1;
2897 my $resblock = vm_mon_cmd
($vmid, 'query-block');
2898 foreach my $block (@$resblock) {
2899 if($block->{device
} =~ m/^drive-(\S+)/){
2908 my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2910 return 1 if !check_running
($vmid);
2912 my $q35 = machine_type_is_q35
($conf);
2914 if ($deviceid eq 'tablet') {
2915 qemu_deviceadd
($vmid, print_tabletdevice_full
($conf));
2919 return 1 if !$conf->{hotplug
};
2921 my $devices_list = vm_devices_list
($vmid);
2922 return 1 if defined($devices_list->{$deviceid});
2924 qemu_bridgeadd
($storecfg, $conf, $vmid, $deviceid); #add bridge if we need it for the device
2926 if ($deviceid =~ m/^(virtio)(\d+)$/) {
2927 return undef if !qemu_driveadd
($storecfg, $vmid, $device);
2928 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
2929 qemu_deviceadd
($vmid, $devicefull);
2930 if(!qemu_deviceaddverify
($vmid, $deviceid)) {
2931 qemu_drivedel
($vmid, $deviceid);
2936 if ($deviceid =~ m/^(scsihw)(\d+)$/) {
2937 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : "lsi";
2938 my $pciaddr = print_pci_addr
($deviceid);
2939 my $devicefull = "$scsihw,id=$deviceid$pciaddr";
2940 qemu_deviceadd
($vmid, $devicefull);
2941 return undef if(!qemu_deviceaddverify
($vmid, $deviceid));
2944 if ($deviceid =~ m/^(scsi)(\d+)$/) {
2945 return undef if !qemu_findorcreatescsihw
($storecfg,$conf, $vmid, $device);
2946 return undef if !qemu_driveadd
($storecfg, $vmid, $device);
2947 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
2948 if(!qemu_deviceadd
($vmid, $devicefull)) {
2949 qemu_drivedel
($vmid, $deviceid);
2954 if ($deviceid =~ m/^(net)(\d+)$/) {
2955 return undef if !qemu_netdevadd
($vmid, $conf, $device, $deviceid);
2956 my $netdevicefull = print_netdevice_full
($vmid, $conf, $device, $deviceid);
2957 qemu_deviceadd
($vmid, $netdevicefull);
2958 if(!qemu_deviceaddverify
($vmid, $deviceid)) {
2959 qemu_netdevdel
($vmid, $deviceid);
2965 if (!$q35 && $deviceid =~ m/^(pci\.)(\d+)$/) {
2967 my $pciaddr = print_pci_addr
($deviceid);
2968 my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
2969 qemu_deviceadd
($vmid, $devicefull);
2970 return undef if !qemu_deviceaddverify
($vmid, $deviceid);
2976 sub vm_deviceunplug
{
2977 my ($vmid, $conf, $deviceid) = @_;
2979 return 1 if !check_running
($vmid);
2981 if ($deviceid eq 'tablet') {
2982 qemu_devicedel
($vmid, $deviceid);
2986 return 1 if !$conf->{hotplug
};
2988 my $devices_list = vm_devices_list
($vmid);
2989 return 1 if !defined($devices_list->{$deviceid});
2991 die "can't unplug bootdisk" if $conf->{bootdisk
} && $conf->{bootdisk
} eq $deviceid;
2993 if ($deviceid =~ m/^(virtio)(\d+)$/) {
2994 qemu_devicedel
($vmid, $deviceid);
2995 return undef if !qemu_devicedelverify
($vmid, $deviceid);
2996 return undef if !qemu_drivedel
($vmid, $deviceid);
2999 if ($deviceid =~ m/^(lsi)(\d+)$/) {
3000 return undef if !qemu_devicedel
($vmid, $deviceid);
3003 if ($deviceid =~ m/^(scsi)(\d+)$/) {
3004 return undef if !qemu_devicedel
($vmid, $deviceid);
3005 return undef if !qemu_drivedel
($vmid, $deviceid);
3008 if ($deviceid =~ m/^(net)(\d+)$/) {
3009 qemu_devicedel
($vmid, $deviceid);
3010 return undef if !qemu_devicedelverify
($vmid, $deviceid);
3011 return undef if !qemu_netdevdel
($vmid, $deviceid);
3017 sub qemu_deviceadd
{
3018 my ($vmid, $devicefull) = @_;
3020 $devicefull = "driver=".$devicefull;
3021 my %options = split(/[=,]/, $devicefull);
3023 vm_mon_cmd
($vmid, "device_add" , %options);
3027 sub qemu_devicedel
{
3028 my($vmid, $deviceid) = @_;
3029 my $ret = vm_mon_cmd
($vmid, "device_del", id
=> $deviceid);
3034 my($storecfg, $vmid, $device) = @_;
3036 my $drive = print_drive_full
($storecfg, $vmid, $device);
3037 my $ret = vm_human_monitor_command
($vmid, "drive_add auto $drive");
3038 # If the command succeeds qemu prints: "OK"
3039 if ($ret !~ m/OK/s) {
3040 syslog
("err", "adding drive failed: $ret");
3047 my($vmid, $deviceid) = @_;
3049 my $ret = vm_human_monitor_command
($vmid, "drive_del drive-$deviceid");
3051 if ($ret =~ m/Device \'.*?\' not found/s) {
3052 # NB: device not found errors mean the drive was auto-deleted and we ignore the error
3054 elsif ($ret ne "") {
3055 syslog
("err", "deleting drive $deviceid failed : $ret");
3061 sub qemu_deviceaddverify
{
3062 my ($vmid,$deviceid) = @_;
3064 for (my $i = 0; $i <= 5; $i++) {
3065 my $devices_list = vm_devices_list
($vmid);
3066 return 1 if defined($devices_list->{$deviceid});
3069 syslog
("err", "error on hotplug device $deviceid");
3074 sub qemu_devicedelverify
{
3075 my ($vmid,$deviceid) = @_;
3077 #need to verify the device is correctly remove as device_del is async and empty return is not reliable
3078 for (my $i = 0; $i <= 5; $i++) {
3079 my $devices_list = vm_devices_list
($vmid);
3080 return 1 if !defined($devices_list->{$deviceid});
3083 syslog
("err", "error on hot-unplugging device $deviceid");
3087 sub qemu_findorcreatescsihw
{
3088 my ($storecfg, $conf, $vmid, $device) = @_;
3090 my $maxdev = ($conf->{scsihw
} && ($conf->{scsihw
} !~ m/^lsi/)) ?
256 : 7;
3091 my $controller = int($device->{index} / $maxdev);
3092 my $scsihwid="scsihw$controller";
3093 my $devices_list = vm_devices_list
($vmid);
3095 if(!defined($devices_list->{$scsihwid})) {
3096 return undef if !vm_deviceplug
($storecfg, $conf, $vmid, $scsihwid);
3101 sub qemu_bridgeadd
{
3102 my ($storecfg, $conf, $vmid, $device) = @_;
3105 my $bridgeid = undef;
3106 print_pci_addr
($device, $bridges);
3108 while (my ($k, $v) = each %$bridges) {
3111 return if !$bridgeid || $bridgeid < 1;
3112 my $bridge = "pci.$bridgeid";
3113 my $devices_list = vm_devices_list
($vmid);
3115 if(!defined($devices_list->{$bridge})) {
3116 return undef if !vm_deviceplug
($storecfg, $conf, $vmid, $bridge);
3121 sub qemu_netdevadd
{
3122 my ($vmid, $conf, $device, $deviceid) = @_;
3124 my $netdev = print_netdev_full
($vmid, $conf, $device, $deviceid);
3125 my %options = split(/[=,]/, $netdev);
3127 vm_mon_cmd
($vmid, "netdev_add", %options);
3131 sub qemu_netdevdel
{
3132 my ($vmid, $deviceid) = @_;
3134 vm_mon_cmd
($vmid, "netdev_del", id
=> $deviceid);
3138 sub qemu_cpu_hotplug
{
3139 my ($vmid, $conf, $cores) = @_;
3141 die "new cores config is not defined" if !$cores;
3142 die "you can't add more cores than maxcpus"
3143 if $conf->{maxcpus
} && ($cores > $conf->{maxcpus
});
3144 return if !check_running
($vmid);
3146 my $currentcores = $conf->{cores
} if $conf->{cores
};
3147 die "current cores is not defined" if !$currentcores;
3148 die "maxcpus is not defined" if !$conf->{maxcpus
};
3149 raise_param_exc
({ 'cores' => "online cpu unplug is not yet possible" })
3150 if($cores < $currentcores);
3152 my $currentrunningcores = vm_mon_cmd
($vmid, "query-cpus");
3153 raise_param_exc
({ 'cores' => "cores number if running vm is different than configuration" })
3154 if scalar (@{$currentrunningcores}) != $currentcores;
3156 for(my $i = $currentcores; $i < $cores; $i++) {
3157 vm_mon_cmd
($vmid, "cpu-add", id
=> int($i));
3161 sub qemu_block_set_io_throttle
{
3162 my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
3164 return if !check_running
($vmid) ;
3166 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));
3170 # old code, only used to shutdown old VM after update
3172 my ($fh, $timeout) = @_;
3174 my $sel = new IO
::Select
;
3181 while (scalar (@ready = $sel->can_read($timeout))) {
3183 if ($count = $fh->sysread($buf, 8192)) {
3184 if ($buf =~ /^(.*)\(qemu\) $/s) {
3191 if (!defined($count)) {
3198 die "monitor read timeout\n" if !scalar(@ready);
3203 # old code, only used to shutdown old VM after update
3204 sub vm_monitor_command
{
3205 my ($vmid, $cmdstr, $nocheck) = @_;
3210 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
3212 my $sname = "${var_run_tmpdir}/$vmid.mon";
3214 my $sock = IO
::Socket
::UNIX-
>new( Peer
=> $sname ) ||
3215 die "unable to connect to VM $vmid socket - $!\n";
3219 # hack: migrate sometime blocks the monitor (when migrate_downtime
3221 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3222 $timeout = 60*60; # 1 hour
3226 my $data = __read_avail
($sock, $timeout);
3228 if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
3229 die "got unexpected qemu monitor banner\n";
3232 my $sel = new IO
::Select
;
3235 if (!scalar(my @ready = $sel->can_write($timeout))) {
3236 die "monitor write error - timeout";
3239 my $fullcmd = "$cmdstr\r";
3241 # syslog('info', "VM $vmid monitor command: $cmdstr");
3244 if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
3245 die "monitor write error - $!";
3248 return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
3252 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3253 $timeout = 60*60; # 1 hour
3254 } elsif ($cmdstr =~ m/^(eject|change)/) {
3255 $timeout = 60; # note: cdrom mount command is slow
3257 if ($res = __read_avail
($sock, $timeout)) {
3259 my @lines = split("\r?\n", $res);
3261 shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
3263 $res = join("\n", @lines);
3271 syslog
("err", "VM $vmid monitor command failed - $err");
3278 sub qemu_block_resize
{
3279 my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
3281 my $running = check_running
($vmid);
3283 return if !PVE
::Storage
::volume_resize
($storecfg, $volid, $size, $running);
3285 return if !$running;
3287 vm_mon_cmd
($vmid, "block_resize", device
=> $deviceid, size
=> int($size));
3291 sub qemu_volume_snapshot
{
3292 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3294 my $running = check_running
($vmid);
3296 return if !PVE
::Storage
::volume_snapshot
($storecfg, $volid, $snap, $running);
3298 return if !$running;
3300 vm_mon_cmd
($vmid, "snapshot-drive", device
=> $deviceid, name
=> $snap);
3304 sub qemu_volume_snapshot_delete
{
3305 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3307 my $running = check_running
($vmid);
3309 return if !PVE
::Storage
::volume_snapshot_delete
($storecfg, $volid, $snap, $running);
3311 return if !$running;
3313 vm_mon_cmd
($vmid, "delete-drive-snapshot", device
=> $deviceid, name
=> $snap);
3316 sub set_migration_caps
{
3322 "auto-converge" => 1,
3324 "x-rdma-pin-all" => 0,
3328 my $supported_capabilities = vm_mon_cmd_nocheck
($vmid, "query-migrate-capabilities");
3330 for my $supported_capability (@$supported_capabilities) {
3332 capability
=> $supported_capability->{capability
},
3333 state => $enabled_cap->{$supported_capability->{capability
}} ? JSON
::true
: JSON
::false
,
3337 vm_mon_cmd_nocheck
($vmid, "migrate-set-capabilities", capabilities
=> $cap_ref);
3341 my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused, $forcemachine, $spice_ticket) = @_;
3343 lock_config
($vmid, sub {
3344 my $conf = load_config
($vmid, $migratedfrom);
3346 die "you can't start a vm if it's a template\n" if is_template
($conf);
3348 check_lock
($conf) if !$skiplock;
3350 die "VM $vmid already running\n" if check_running
($vmid, undef, $migratedfrom);
3352 my $defaults = load_defaults
();
3354 # set environment variable useful inside network script
3355 $ENV{PVE_MIGRATED_FROM
} = $migratedfrom if $migratedfrom;
3357 my ($cmd, $vollist, $spice_port) = config_to_command
($storecfg, $vmid, $conf, $defaults, $forcemachine);
3359 my $migrate_port = 0;
3362 if ($statefile eq 'tcp') {
3363 my $localip = "localhost";
3364 my $datacenterconf = PVE
::Cluster
::cfs_read_file
('datacenter.cfg');
3365 if ($datacenterconf->{migration_unsecure
}) {
3366 my $nodename = PVE
::INotify
::nodename
();
3367 $localip = PVE
::Cluster
::remote_node_ip
($nodename, 1);
3369 $migrate_port = PVE
::Tools
::next_migrate_port
();
3370 $migrate_uri = "tcp:${localip}:${migrate_port}";
3371 push @$cmd, '-incoming', $migrate_uri;
3374 push @$cmd, '-loadstate', $statefile;
3381 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
3382 my $d = parse_hostpci
($conf->{"hostpci$i"});
3384 my $pcidevices = $d->{pciid
};
3385 foreach my $pcidevice (@$pcidevices) {
3386 my $pciid = $pcidevice->{id
}.".".$pcidevice->{function
};
3388 my $info = pci_device_info
("0000:$pciid");
3389 die "IOMMU not present\n" if !check_iommu_support
();
3390 die "no pci device info for device '$pciid'\n" if !$info;
3392 if ($d->{driver
} && $d->{driver
} eq "vfio") {
3393 die "can't unbind/bind pci group to vfio '$pciid'\n" if !pci_dev_group_bind_to_vfio
($pciid);
3395 die "can't unbind/bind to stub pci device '$pciid'\n" if !pci_dev_bind_to_stub
($info);
3398 die "can't reset pci device '$pciid'\n" if $info->{has_fl_reset
} and !pci_dev_reset
($info);
3402 PVE
::Storage
::activate_volumes
($storecfg, $vollist);
3404 eval { run_command
($cmd, timeout
=> $statefile ?
undef : 30,
3407 die "start failed: $err" if $err;
3409 print "migration listens on $migrate_uri\n" if $migrate_uri;
3411 if ($statefile && $statefile ne 'tcp') {
3412 eval { vm_mon_cmd_nocheck
($vmid, "cont"); };
3416 if ($migratedfrom) {
3419 PVE
::QemuServer
::set_migration_caps
($vmid);
3424 print "spice listens on port $spice_port\n";
3425 if ($spice_ticket) {
3426 PVE
::QemuServer
::vm_mon_cmd_nocheck
($vmid, "set_password", protocol
=> 'spice', password
=> $spice_ticket);
3427 PVE
::QemuServer
::vm_mon_cmd_nocheck
($vmid, "expire_password", protocol
=> 'spice', time => "+30");
3433 if (!$statefile && (!defined($conf->{balloon
}) || $conf->{balloon
})) {
3434 vm_mon_cmd_nocheck
($vmid, "balloon", value
=> $conf->{balloon
}*1024*1024)
3435 if $conf->{balloon
};
3436 vm_mon_cmd_nocheck
($vmid, 'qom-set',
3437 path
=> "machine/peripheral/balloon0",
3438 property
=> "guest-stats-polling-interval",
3446 my ($vmid, $execute, %params) = @_;
3448 my $cmd = { execute
=> $execute, arguments
=> \
%params };
3449 vm_qmp_command
($vmid, $cmd);
3452 sub vm_mon_cmd_nocheck
{
3453 my ($vmid, $execute, %params) = @_;
3455 my $cmd = { execute
=> $execute, arguments
=> \
%params };
3456 vm_qmp_command
($vmid, $cmd, 1);
3459 sub vm_qmp_command
{
3460 my ($vmid, $cmd, $nocheck) = @_;
3465 if ($cmd->{arguments
} && $cmd->{arguments
}->{timeout
}) {
3466 $timeout = $cmd->{arguments
}->{timeout
};
3467 delete $cmd->{arguments
}->{timeout
};
3471 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
3472 my $sname = qmp_socket
($vmid);
3473 if (-e
$sname) { # test if VM is reasonambe new and supports qmp/qga
3474 my $qmpclient = PVE
::QMPClient-
>new();
3476 $res = $qmpclient->cmd($vmid, $cmd, $timeout);
3477 } elsif (-e
"${var_run_tmpdir}/$vmid.mon") {
3478 die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
3479 if scalar(%{$cmd->{arguments
}});
3480 vm_monitor_command
($vmid, $cmd->{execute
}, $nocheck);
3482 die "unable to open monitor socket\n";
3486 syslog
("err", "VM $vmid qmp command failed - $err");
3493 sub vm_human_monitor_command
{
3494 my ($vmid, $cmdline) = @_;
3499 execute
=> 'human-monitor-command',
3500 arguments
=> { 'command-line' => $cmdline},
3503 return vm_qmp_command
($vmid, $cmd);
3506 sub vm_commandline
{
3507 my ($storecfg, $vmid) = @_;
3509 my $conf = load_config
($vmid);
3511 my $defaults = load_defaults
();
3513 my $cmd = config_to_command
($storecfg, $vmid, $conf, $defaults);
3515 return join(' ', @$cmd);
3519 my ($vmid, $skiplock) = @_;
3521 lock_config
($vmid, sub {
3523 my $conf = load_config
($vmid);
3525 check_lock
($conf) if !$skiplock;
3527 vm_mon_cmd
($vmid, "system_reset");
3531 sub get_vm_volumes
{
3535 foreach_volid
($conf, sub {
3536 my ($volid, $is_cdrom) = @_;
3538 return if $volid =~ m
|^/|;
3540 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
3543 push @$vollist, $volid;
3549 sub vm_stop_cleanup
{
3550 my ($storecfg, $vmid, $conf, $keepActive) = @_;
3553 fairsched_rmnod
($vmid); # try to destroy group
3556 my $vollist = get_vm_volumes
($conf);
3557 PVE
::Storage
::deactivate_volumes
($storecfg, $vollist);
3560 foreach my $ext (qw(mon qmp pid vnc qga)) {
3561 unlink "/var/run/qemu-server/${vmid}.$ext";
3564 warn $@ if $@; # avoid errors - just warn
3567 # Note: use $nockeck to skip tests if VM configuration file exists.
3568 # We need that when migration VMs to other nodes (files already moved)
3569 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3571 my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3573 $force = 1 if !defined($force) && !$shutdown;
3576 my $pid = check_running
($vmid, $nocheck, $migratedfrom);
3577 kill 15, $pid if $pid;
3578 my $conf = load_config
($vmid, $migratedfrom);
3579 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive);
3583 lock_config
($vmid, sub {
3585 my $pid = check_running
($vmid, $nocheck);
3590 $conf = load_config
($vmid);
3591 check_lock
($conf) if !$skiplock;
3592 if (!defined($timeout) && $shutdown && $conf->{startup
}) {
3593 my $opts = parse_startup
($conf->{startup
});
3594 $timeout = $opts->{down
} if $opts->{down
};
3598 $timeout = 60 if !defined($timeout);
3599 my $config = load_config
($vmid);
3603 if ($config->{agent
}) {
3604 vm_qmp_command
($vmid, { execute
=> "guest-shutdown" }, $nocheck);
3606 vm_qmp_command
($vmid, { execute
=> "system_powerdown" }, $nocheck);
3609 vm_qmp_command
($vmid, { execute
=> "quit" }, $nocheck);
3616 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
3621 if ($count >= $timeout) {
3623 warn "VM still running - terminating now with SIGTERM\n";
3626 die "VM quit/powerdown failed - got timeout\n";
3629 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
3634 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3637 die "VM quit/powerdown failed\n";
3645 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
3650 if ($count >= $timeout) {
3651 warn "VM still running - terminating now with SIGKILL\n";
3656 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
3661 my ($vmid, $skiplock) = @_;
3663 lock_config
($vmid, sub {
3665 my $conf = load_config
($vmid);
3667 check_lock
($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3669 vm_mon_cmd
($vmid, "stop");
3674 my ($vmid, $skiplock) = @_;
3676 lock_config
($vmid, sub {
3678 my $conf = load_config
($vmid);
3680 check_lock
($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3682 vm_mon_cmd
($vmid, "cont");
3687 my ($vmid, $skiplock, $key) = @_;
3689 lock_config
($vmid, sub {
3691 my $conf = load_config
($vmid);
3693 # there is no qmp command, so we use the human monitor command
3694 vm_human_monitor_command
($vmid, "sendkey $key");
3699 my ($storecfg, $vmid, $skiplock) = @_;
3701 lock_config
($vmid, sub {
3703 my $conf = load_config
($vmid);
3705 check_lock
($conf) if !$skiplock;
3707 if (!check_running
($vmid)) {
3708 fairsched_rmnod
($vmid); # try to destroy group
3709 destroy_vm
($storecfg, $vmid);
3711 die "VM $vmid is running - destroy failed\n";
3719 my ($filename, $buf) = @_;
3721 my $fh = IO
::File-
>new($filename, "w");
3722 return undef if !$fh;
3724 my $res = print $fh $buf;
3731 sub pci_device_info
{
3736 return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3737 my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3739 my $irq = file_read_firstline
("$pcisysfs/devices/$name/irq");
3740 return undef if !defined($irq) || $irq !~ m/^\d+$/;
3742 my $vendor = file_read_firstline
("$pcisysfs/devices/$name/vendor");
3743 return undef if !defined($vendor) || $vendor !~ s/^0x//;
3745 my $product = file_read_firstline
("$pcisysfs/devices/$name/device");
3746 return undef if !defined($product) || $product !~ s/^0x//;
3751 product
=> $product,
3757 has_fl_reset
=> -f
"$pcisysfs/devices/$name/reset" || 0,
3766 my $name = $dev->{name
};
3768 my $fn = "$pcisysfs/devices/$name/reset";
3770 return file_write
($fn, "1");
3773 sub pci_dev_bind_to_stub
{
3776 my $name = $dev->{name
};
3778 my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3779 return 1 if -d
$testdir;
3781 my $data = "$dev->{vendor} $dev->{product}";
3782 return undef if !file_write
("$pcisysfs/drivers/pci-stub/new_id", $data);
3784 my $fn = "$pcisysfs/devices/$name/driver/unbind";
3785 if (!file_write
($fn, $name)) {
3786 return undef if -f
$fn;
3789 $fn = "$pcisysfs/drivers/pci-stub/bind";
3790 if (! -d
$testdir) {
3791 return undef if !file_write
($fn, $name);
3797 sub pci_dev_bind_to_vfio
{
3800 my $name = $dev->{name
};
3802 my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
3804 if (!-d
$vfio_basedir) {
3805 system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
3807 die "Cannot find vfio-pci module!\n" if !-d
$vfio_basedir;
3809 my $testdir = "$vfio_basedir/$name";
3810 return 1 if -d
$testdir;
3812 my $data = "$dev->{vendor} $dev->{product}";
3813 return undef if !file_write
("$vfio_basedir/new_id", $data);
3815 my $fn = "$pcisysfs/devices/$name/driver/unbind";
3816 if (!file_write
($fn, $name)) {
3817 return undef if -f
$fn;
3820 $fn = "$vfio_basedir/bind";
3821 if (! -d
$testdir) {
3822 return undef if !file_write
($fn, $name);
3828 sub pci_dev_group_bind_to_vfio
{
3831 my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
3833 if (!-d
$vfio_basedir) {
3834 system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
3836 die "Cannot find vfio-pci module!\n" if !-d
$vfio_basedir;
3838 # get IOMMU group devices
3839 opendir(my $D, "$pcisysfs/devices/0000:$pciid/iommu_group/devices/") || die "Cannot open iommu_group: $!\n";
3840 my @devs = grep /^0000:/, readdir($D);
3843 foreach my $pciid (@devs) {
3844 $pciid =~ m/^([:\.\da-f]+)$/ or die "PCI ID $pciid not valid!\n";
3845 my $info = pci_device_info
($1);
3846 pci_dev_bind_to_vfio
($info) || die "Cannot bind $pciid to vfio\n";
3852 sub print_pci_addr
{
3853 my ($id, $bridges) = @_;
3857 piix3
=> { bus
=> 0, addr
=> 1 },
3858 #addr2 : first videocard
3859 balloon0
=> { bus
=> 0, addr
=> 3 },
3860 watchdog
=> { bus
=> 0, addr
=> 4 },
3861 scsihw0
=> { bus
=> 0, addr
=> 5 },
3862 scsihw1
=> { bus
=> 0, addr
=> 6 },
3863 ahci0
=> { bus
=> 0, addr
=> 7 },
3864 qga0
=> { bus
=> 0, addr
=> 8 },
3865 spice
=> { bus
=> 0, addr
=> 9 },
3866 virtio0
=> { bus
=> 0, addr
=> 10 },
3867 virtio1
=> { bus
=> 0, addr
=> 11 },
3868 virtio2
=> { bus
=> 0, addr
=> 12 },
3869 virtio3
=> { bus
=> 0, addr
=> 13 },
3870 virtio4
=> { bus
=> 0, addr
=> 14 },
3871 virtio5
=> { bus
=> 0, addr
=> 15 },
3872 hostpci0
=> { bus
=> 0, addr
=> 16 },
3873 hostpci1
=> { bus
=> 0, addr
=> 17 },
3874 net0
=> { bus
=> 0, addr
=> 18 },
3875 net1
=> { bus
=> 0, addr
=> 19 },
3876 net2
=> { bus
=> 0, addr
=> 20 },
3877 net3
=> { bus
=> 0, addr
=> 21 },
3878 net4
=> { bus
=> 0, addr
=> 22 },
3879 net5
=> { bus
=> 0, addr
=> 23 },
3880 vga1
=> { bus
=> 0, addr
=> 24 },
3881 vga2
=> { bus
=> 0, addr
=> 25 },
3882 vga3
=> { bus
=> 0, addr
=> 26 },
3883 hostpci2
=> { bus
=> 0, addr
=> 27 },
3884 hostpci3
=> { bus
=> 0, addr
=> 28 },
3885 #addr29 : usb-host (pve-usb.cfg)
3886 'pci.1' => { bus
=> 0, addr
=> 30 },
3887 'pci.2' => { bus
=> 0, addr
=> 31 },
3888 'net6' => { bus
=> 1, addr
=> 1 },
3889 'net7' => { bus
=> 1, addr
=> 2 },
3890 'net8' => { bus
=> 1, addr
=> 3 },
3891 'net9' => { bus
=> 1, addr
=> 4 },
3892 'net10' => { bus
=> 1, addr
=> 5 },
3893 'net11' => { bus
=> 1, addr
=> 6 },
3894 'net12' => { bus
=> 1, addr
=> 7 },
3895 'net13' => { bus
=> 1, addr
=> 8 },
3896 'net14' => { bus
=> 1, addr
=> 9 },
3897 'net15' => { bus
=> 1, addr
=> 10 },
3898 'net16' => { bus
=> 1, addr
=> 11 },
3899 'net17' => { bus
=> 1, addr
=> 12 },
3900 'net18' => { bus
=> 1, addr
=> 13 },
3901 'net19' => { bus
=> 1, addr
=> 14 },
3902 'net20' => { bus
=> 1, addr
=> 15 },
3903 'net21' => { bus
=> 1, addr
=> 16 },
3904 'net22' => { bus
=> 1, addr
=> 17 },
3905 'net23' => { bus
=> 1, addr
=> 18 },
3906 'net24' => { bus
=> 1, addr
=> 19 },
3907 'net25' => { bus
=> 1, addr
=> 20 },
3908 'net26' => { bus
=> 1, addr
=> 21 },
3909 'net27' => { bus
=> 1, addr
=> 22 },
3910 'net28' => { bus
=> 1, addr
=> 23 },
3911 'net29' => { bus
=> 1, addr
=> 24 },
3912 'net30' => { bus
=> 1, addr
=> 25 },
3913 'net31' => { bus
=> 1, addr
=> 26 },
3914 'virtio6' => { bus
=> 2, addr
=> 1 },
3915 'virtio7' => { bus
=> 2, addr
=> 2 },
3916 'virtio8' => { bus
=> 2, addr
=> 3 },
3917 'virtio9' => { bus
=> 2, addr
=> 4 },
3918 'virtio10' => { bus
=> 2, addr
=> 5 },
3919 'virtio11' => { bus
=> 2, addr
=> 6 },
3920 'virtio12' => { bus
=> 2, addr
=> 7 },
3921 'virtio13' => { bus
=> 2, addr
=> 8 },
3922 'virtio14' => { bus
=> 2, addr
=> 9 },
3923 'virtio15' => { bus
=> 2, addr
=> 10 },
3926 if (defined($devices->{$id}->{bus
}) && defined($devices->{$id}->{addr
})) {
3927 my $addr = sprintf("0x%x", $devices->{$id}->{addr
});
3928 my $bus = $devices->{$id}->{bus
};
3929 $res = ",bus=pci.$bus,addr=$addr";
3930 $bridges->{$bus} = 1 if $bridges;
3936 sub print_pcie_addr
{
3941 hostpci0
=> { bus
=> "ich9-pcie-port-1", addr
=> 0 },
3942 hostpci1
=> { bus
=> "ich9-pcie-port-2", addr
=> 0 },
3943 hostpci2
=> { bus
=> "ich9-pcie-port-3", addr
=> 0 },
3944 hostpci3
=> { bus
=> "ich9-pcie-port-4", addr
=> 0 },
3947 if (defined($devices->{$id}->{bus
}) && defined($devices->{$id}->{addr
})) {
3948 my $addr = sprintf("0x%x", $devices->{$id}->{addr
});
3949 my $bus = $devices->{$id}->{bus
};
3950 $res = ",bus=$bus,addr=$addr";
3956 # vzdump restore implementaion
3958 sub tar_archive_read_firstfile
{
3959 my $archive = shift;
3961 die "ERROR: file '$archive' does not exist\n" if ! -f
$archive;
3963 # try to detect archive type first
3964 my $pid = open (TMP
, "tar tf '$archive'|") ||
3965 die "unable to open file '$archive'\n";
3966 my $firstfile = <TMP
>;
3970 die "ERROR: archive contaions no data\n" if !$firstfile;
3976 sub tar_restore_cleanup
{
3977 my ($storecfg, $statfile) = @_;
3979 print STDERR
"starting cleanup\n";
3981 if (my $fd = IO
::File-
>new($statfile, "r")) {
3982 while (defined(my $line = <$fd>)) {
3983 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3986 if ($volid =~ m
|^/|) {
3987 unlink $volid || die 'unlink failed\n';
3989 PVE
::Storage
::vdisk_free
($storecfg, $volid);
3991 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
3993 print STDERR
"unable to cleanup '$volid' - $@" if $@;
3995 print STDERR
"unable to parse line in statfile - $line";
4002 sub restore_archive
{
4003 my ($archive, $vmid, $user, $opts) = @_;
4005 my $format = $opts->{format
};
4008 if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
4009 $format = 'tar' if !$format;
4011 } elsif ($archive =~ m/\.tar$/) {
4012 $format = 'tar' if !$format;
4013 } elsif ($archive =~ m/.tar.lzo$/) {
4014 $format = 'tar' if !$format;
4016 } elsif ($archive =~ m/\.vma$/) {
4017 $format = 'vma' if !$format;
4018 } elsif ($archive =~ m/\.vma\.gz$/) {
4019 $format = 'vma' if !$format;
4021 } elsif ($archive =~ m/\.vma\.lzo$/) {
4022 $format = 'vma' if !$format;
4025 $format = 'vma' if !$format; # default
4028 # try to detect archive format
4029 if ($format eq 'tar') {
4030 return restore_tar_archive
($archive, $vmid, $user, $opts);
4032 return restore_vma_archive
($archive, $vmid, $user, $opts, $comp);
4036 sub restore_update_config_line
{
4037 my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
4039 return if $line =~ m/^\#qmdump\#/;
4040 return if $line =~ m/^\#vzdump\#/;
4041 return if $line =~ m/^lock:/;
4042 return if $line =~ m/^unused\d+:/;
4043 return if $line =~ m/^parent:/;
4044 return if $line =~ m/^template:/; # restored VM is never a template
4046 if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
4047 # try to convert old 1.X settings
4048 my ($id, $ind, $ethcfg) = ($1, $2, $3);
4049 foreach my $devconfig (PVE
::Tools
::split_list
($ethcfg)) {
4050 my ($model, $macaddr) = split(/\=/, $devconfig);
4051 $macaddr = PVE
::Tools
::random_ether_addr
() if !$macaddr || $unique;
4054 bridge
=> "vmbr$ind",
4055 macaddr
=> $macaddr,
4057 my $netstr = print_net
($net);
4059 print $outfd "net$cookie->{netcount}: $netstr\n";
4060 $cookie->{netcount
}++;
4062 } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
4063 my ($id, $netstr) = ($1, $2);
4064 my $net = parse_net
($netstr);
4065 $net->{macaddr
} = PVE
::Tools
::random_ether_addr
() if $net->{macaddr
};
4066 $netstr = print_net
($net);
4067 print $outfd "$id: $netstr\n";
4068 } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
4071 if ($line =~ m/backup=no/) {
4072 print $outfd "#$line";
4073 } elsif ($virtdev && $map->{$virtdev}) {
4074 my $di = parse_drive
($virtdev, $value);
4075 delete $di->{format
}; # format can change on restore
4076 $di->{file
} = $map->{$virtdev};
4077 $value = print_drive
($vmid, $di);
4078 print $outfd "$virtdev: $value\n";
4088 my ($cfg, $vmid) = @_;
4090 my $info = PVE
::Storage
::vdisk_list
($cfg, undef, $vmid);
4092 my $volid_hash = {};
4093 foreach my $storeid (keys %$info) {
4094 foreach my $item (@{$info->{$storeid}}) {
4095 next if !($item->{volid
} && $item->{size
});
4096 $item->{path
} = PVE
::Storage
::path
($cfg, $item->{volid
});
4097 $volid_hash->{$item->{volid
}} = $item;
4104 sub get_used_paths
{
4105 my ($vmid, $storecfg, $conf, $scan_snapshots, $skip_drive) = @_;
4109 my $scan_config = sub {
4110 my ($cref, $snapname) = @_;
4112 foreach my $key (keys %$cref) {
4113 my $value = $cref->{$key};
4114 if (valid_drivename
($key)) {
4115 next if $skip_drive && $key eq $skip_drive;
4116 my $drive = parse_drive
($key, $value);
4117 next if !$drive || !$drive->{file
} || drive_is_cdrom
($drive);
4118 if ($drive->{file
} =~ m!^/!) {
4119 $used_path->{$drive->{file
}}++; # = 1;
4121 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($drive->{file
}, 1);
4123 my $scfg = PVE
::Storage
::storage_config
($storecfg, $storeid, 1);
4125 my $path = PVE
::Storage
::path
($storecfg, $drive->{file
}, $snapname);
4126 $used_path->{$path}++; # = 1;
4132 &$scan_config($conf);
4136 if ($scan_snapshots) {
4137 foreach my $snapname (keys %{$conf->{snapshots
}}) {
4138 &$scan_config($conf->{snapshots
}->{$snapname}, $snapname);
4145 sub update_disksize
{
4146 my ($vmid, $conf, $volid_hash) = @_;
4152 # Note: it is allowed to define multiple storages with same path (alias), so
4153 # we need to check both 'volid' and real 'path' (two different volid can point
4154 # to the same path).
4159 foreach my $opt (keys %$conf) {
4160 if (valid_drivename
($opt)) {
4161 my $drive = parse_drive
($opt, $conf->{$opt});
4162 my $volid = $drive->{file
};
4165 $used->{$volid} = 1;
4166 if ($volid_hash->{$volid} &&
4167 (my $path = $volid_hash->{$volid}->{path
})) {
4168 $usedpath->{$path} = 1;
4171 next if drive_is_cdrom
($drive);
4172 next if !$volid_hash->{$volid};
4174 $drive->{size
} = $volid_hash->{$volid}->{size
};
4175 my $new = print_drive
($vmid, $drive);
4176 if ($new ne $conf->{$opt}) {
4178 $conf->{$opt} = $new;
4183 # remove 'unusedX' entry if volume is used
4184 foreach my $opt (keys %$conf) {
4185 next if $opt !~ m/^unused\d+$/;
4186 my $volid = $conf->{$opt};
4187 my $path = $volid_hash->{$volid}->{path
} if $volid_hash->{$volid};
4188 if ($used->{$volid} || ($path && $usedpath->{$path})) {
4190 delete $conf->{$opt};
4194 foreach my $volid (sort keys %$volid_hash) {
4195 next if $volid =~ m/vm-$vmid-state-/;
4196 next if $used->{$volid};
4197 my $path = $volid_hash->{$volid}->{path
};
4198 next if !$path; # just to be sure
4199 next if $usedpath->{$path};
4201 add_unused_volume
($conf, $volid);
4202 $usedpath->{$path} = 1; # avoid to add more than once (aliases)
4209 my ($vmid, $nolock) = @_;
4211 my $cfg = PVE
::Cluster
::cfs_read_file
("storage.cfg");
4213 my $volid_hash = scan_volids
($cfg, $vmid);
4215 my $updatefn = sub {
4218 my $conf = load_config
($vmid);
4223 foreach my $volid (keys %$volid_hash) {
4224 my $info = $volid_hash->{$volid};
4225 $vm_volids->{$volid} = $info if $info->{vmid
} && $info->{vmid
} == $vmid;
4228 my $changes = update_disksize
($vmid, $conf, $vm_volids);
4230 update_config_nolock
($vmid, $conf, 1) if $changes;
4233 if (defined($vmid)) {
4237 lock_config
($vmid, $updatefn, $vmid);
4240 my $vmlist = config_list
();
4241 foreach my $vmid (keys %$vmlist) {
4245 lock_config
($vmid, $updatefn, $vmid);
4251 sub restore_vma_archive
{
4252 my ($archive, $vmid, $user, $opts, $comp) = @_;
4254 my $input = $archive eq '-' ?
"<&STDIN" : undef;
4255 my $readfrom = $archive;
4260 my $qarchive = PVE
::Tools
::shellquote
($archive);
4261 if ($comp eq 'gzip') {
4262 $uncomp = "zcat $qarchive|";
4263 } elsif ($comp eq 'lzop') {
4264 $uncomp = "lzop -d -c $qarchive|";
4266 die "unknown compression method '$comp'\n";
4271 my $tmpdir = "/var/tmp/vzdumptmp$$";
4274 # disable interrupts (always do cleanups)
4275 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
4276 warn "got interrupt - ignored\n";
4279 my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
4280 POSIX
::mkfifo
($mapfifo, 0600);
4283 my $openfifo = sub {
4284 open($fifofh, '>', $mapfifo) || die $!;
4287 my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
4294 my $rpcenv = PVE
::RPCEnvironment
::get
();
4296 my $conffile = config_file
($vmid);
4297 my $tmpfn = "$conffile.$$.tmp";
4299 # Note: $oldconf is undef if VM does not exists
4300 my $oldconf = PVE
::Cluster
::cfs_read_file
(cfs_config_path
($vmid));
4302 my $print_devmap = sub {
4303 my $virtdev_hash = {};
4305 my $cfgfn = "$tmpdir/qemu-server.conf";
4307 # we can read the config - that is already extracted
4308 my $fh = IO
::File-
>new($cfgfn, "r") ||
4309 "unable to read qemu-server.conf - $!\n";
4311 while (defined(my $line = <$fh>)) {
4312 if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
4313 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
4314 die "archive does not contain data for drive '$virtdev'\n"
4315 if !$devinfo->{$devname};
4316 if (defined($opts->{storage
})) {
4317 $storeid = $opts->{storage
} || 'local';
4318 } elsif (!$storeid) {
4321 $format = 'raw' if !$format;
4322 $devinfo->{$devname}->{devname
} = $devname;
4323 $devinfo->{$devname}->{virtdev
} = $virtdev;
4324 $devinfo->{$devname}->{format
} = $format;
4325 $devinfo->{$devname}->{storeid
} = $storeid;
4327 # check permission on storage
4328 my $pool = $opts->{pool
}; # todo: do we need that?
4329 if ($user ne 'root@pam') {
4330 $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
4333 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
4337 foreach my $devname (keys %$devinfo) {
4338 die "found no device mapping information for device '$devname'\n"
4339 if !$devinfo->{$devname}->{virtdev
};
4342 my $cfg = cfs_read_file
('storage.cfg');
4344 # create empty/temp config
4346 PVE
::Tools
::file_set_contents
($conffile, "memory: 128\n");
4347 foreach_drive
($oldconf, sub {
4348 my ($ds, $drive) = @_;
4350 return if drive_is_cdrom
($drive);
4352 my $volid = $drive->{file
};
4354 return if !$volid || $volid =~ m
|^/|;
4356 my ($path, $owner) = PVE
::Storage
::path
($cfg, $volid);
4357 return if !$path || !$owner || ($owner != $vmid);
4359 # Note: only delete disk we want to restore
4360 # other volumes will become unused
4361 if ($virtdev_hash->{$ds}) {
4362 PVE
::Storage
::vdisk_free
($cfg, $volid);
4368 foreach my $virtdev (sort keys %$virtdev_hash) {
4369 my $d = $virtdev_hash->{$virtdev};
4370 my $alloc_size = int(($d->{size
} + 1024 - 1)/1024);
4371 my $scfg = PVE
::Storage
::storage_config
($cfg, $d->{storeid
});
4373 # test if requested format is supported
4374 my ($defFormat, $validFormats) = PVE
::Storage
::storage_default_format
($cfg, $d->{storeid
});
4375 my $supported = grep { $_ eq $d->{format
} } @$validFormats;
4376 $d->{format
} = $defFormat if !$supported;
4378 my $volid = PVE
::Storage
::vdisk_alloc
($cfg, $d->{storeid
}, $vmid,
4379 $d->{format
}, undef, $alloc_size);
4380 print STDERR
"new volume ID is '$volid'\n";
4381 $d->{volid
} = $volid;
4382 my $path = PVE
::Storage
::path
($cfg, $volid);
4384 my $write_zeros = 1;
4385 # fixme: what other storages types initialize volumes with zero?
4386 if ($scfg->{type
} eq 'dir' || $scfg->{type
} eq 'nfs' || $scfg->{type
} eq 'glusterfs' ||
4387 $scfg->{type
} eq 'sheepdog' || $scfg->{type
} eq 'rbd') {
4391 print $fifofh "${write_zeros}:$d->{devname}=$path\n";
4393 print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
4394 $map->{$virtdev} = $volid;
4397 $fh->seek(0, 0) || die "seek failed - $!\n";
4399 my $outfd = new IO
::File
($tmpfn, "w") ||
4400 die "unable to write config for VM $vmid\n";
4402 my $cookie = { netcount
=> 0 };
4403 while (defined(my $line = <$fh>)) {
4404 restore_update_config_line
($outfd, $cookie, $vmid, $map, $line, $opts->{unique
});
4413 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
4414 die "interrupted by signal\n";
4416 local $SIG{ALRM
} = sub { die "got timeout\n"; };
4418 $oldtimeout = alarm($timeout);
4425 if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
4426 my ($dev_id, $size, $devname) = ($1, $2, $3);
4427 $devinfo->{$devname} = { size
=> $size, dev_id
=> $dev_id };
4428 } elsif ($line =~ m/^CTIME: /) {
4429 # we correctly received the vma config, so we can disable
4430 # the timeout now for disk allocation (set to 10 minutes, so
4431 # that we always timeout if something goes wrong)
4434 print $fifofh "done\n";
4435 my $tmp = $oldtimeout || 0;
4436 $oldtimeout = undef;
4442 print "restore vma archive: $cmd\n";
4443 run_command
($cmd, input
=> $input, outfunc
=> $parser, afterfork
=> $openfifo);
4447 alarm($oldtimeout) if $oldtimeout;
4455 my $cfg = cfs_read_file
('storage.cfg');
4456 foreach my $devname (keys %$devinfo) {
4457 my $volid = $devinfo->{$devname}->{volid
};
4460 if ($volid =~ m
|^/|) {
4461 unlink $volid || die 'unlink failed\n';
4463 PVE
::Storage
::vdisk_free
($cfg, $volid);
4465 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
4467 print STDERR
"unable to cleanup '$volid' - $@" if $@;
4474 rename($tmpfn, $conffile) ||
4475 die "unable to commit configuration file '$conffile'\n";
4477 PVE
::Cluster
::cfs_update
(); # make sure we read new file
4479 eval { rescan
($vmid, 1); };
4483 sub restore_tar_archive
{
4484 my ($archive, $vmid, $user, $opts) = @_;
4486 if ($archive ne '-') {
4487 my $firstfile = tar_archive_read_firstfile
($archive);
4488 die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
4489 if $firstfile ne 'qemu-server.conf';
4492 my $storecfg = cfs_read_file
('storage.cfg');
4494 # destroy existing data - keep empty config
4495 my $vmcfgfn = PVE
::QemuServer
::config_file
($vmid);
4496 destroy_vm
($storecfg, $vmid, 1) if -f
$vmcfgfn;
4498 my $tocmd = "/usr/lib/qemu-server/qmextract";
4500 $tocmd .= " --storage " . PVE
::Tools
::shellquote
($opts->{storage
}) if $opts->{storage
};
4501 $tocmd .= " --pool " . PVE
::Tools
::shellquote
($opts->{pool
}) if $opts->{pool
};
4502 $tocmd .= ' --prealloc' if $opts->{prealloc
};
4503 $tocmd .= ' --info' if $opts->{info
};
4505 # tar option "xf" does not autodetect compression when read from STDIN,
4506 # so we pipe to zcat
4507 my $cmd = "zcat -f|tar xf " . PVE
::Tools
::shellquote
($archive) . " " .
4508 PVE
::Tools
::shellquote
("--to-command=$tocmd");
4510 my $tmpdir = "/var/tmp/vzdumptmp$$";
4513 local $ENV{VZDUMP_TMPDIR
} = $tmpdir;
4514 local $ENV{VZDUMP_VMID
} = $vmid;
4515 local $ENV{VZDUMP_USER
} = $user;
4517 my $conffile = config_file
($vmid);
4518 my $tmpfn = "$conffile.$$.tmp";
4520 # disable interrupts (always do cleanups)
4521 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
4522 print STDERR
"got interrupt - ignored\n";
4527 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
4528 die "interrupted by signal\n";
4531 if ($archive eq '-') {
4532 print "extracting archive from STDIN\n";
4533 run_command
($cmd, input
=> "<&STDIN");
4535 print "extracting archive '$archive'\n";
4539 return if $opts->{info
};
4543 my $statfile = "$tmpdir/qmrestore.stat";
4544 if (my $fd = IO
::File-
>new($statfile, "r")) {
4545 while (defined (my $line = <$fd>)) {
4546 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4547 $map->{$1} = $2 if $1;
4549 print STDERR
"unable to parse line in statfile - $line\n";
4555 my $confsrc = "$tmpdir/qemu-server.conf";
4557 my $srcfd = new IO
::File
($confsrc, "r") ||
4558 die "unable to open file '$confsrc'\n";
4560 my $outfd = new IO
::File
($tmpfn, "w") ||
4561 die "unable to write config for VM $vmid\n";
4563 my $cookie = { netcount
=> 0 };
4564 while (defined (my $line = <$srcfd>)) {
4565 restore_update_config_line
($outfd, $cookie, $vmid, $map, $line, $opts->{unique
});
4577 tar_restore_cleanup
($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info
};
4584 rename $tmpfn, $conffile ||
4585 die "unable to commit configuration file '$conffile'\n";
4587 PVE
::Cluster
::cfs_update
(); # make sure we read new file
4589 eval { rescan
($vmid, 1); };
4594 # Internal snapshots
4596 # NOTE: Snapshot create/delete involves several non-atomic
4597 # action, and can take a long time.
4598 # So we try to avoid locking the file and use 'lock' variable
4599 # inside the config file instead.
4601 my $snapshot_copy_config = sub {
4602 my ($source, $dest) = @_;
4604 foreach my $k (keys %$source) {
4605 next if $k eq 'snapshots';
4606 next if $k eq 'snapstate';
4607 next if $k eq 'snaptime';
4608 next if $k eq 'vmstate';
4609 next if $k eq 'lock';
4610 next if $k eq 'digest';
4611 next if $k eq 'description';
4612 next if $k =~ m/^unused\d+$/;
4614 $dest->{$k} = $source->{$k};
4618 my $snapshot_apply_config = sub {
4619 my ($conf, $snap) = @_;
4621 # copy snapshot list
4623 snapshots
=> $conf->{snapshots
},
4626 # keep description and list of unused disks
4627 foreach my $k (keys %$conf) {
4628 next if !($k =~ m/^unused\d+$/ || $k eq 'description');
4629 $newconf->{$k} = $conf->{$k};
4632 &$snapshot_copy_config($snap, $newconf);
4637 sub foreach_writable_storage
{
4638 my ($conf, $func) = @_;
4642 foreach my $ds (keys %$conf) {
4643 next if !valid_drivename
($ds);
4645 my $drive = parse_drive
($ds, $conf->{$ds});
4647 next if drive_is_cdrom
($drive);
4649 my $volid = $drive->{file
};
4651 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
4652 $sidhash->{$sid} = $sid if $sid;
4655 foreach my $sid (sort keys %$sidhash) {
4660 my $alloc_vmstate_volid = sub {
4661 my ($storecfg, $vmid, $conf, $snapname) = @_;
4663 # Note: we try to be smart when selecting a $target storage
4667 # search shared storage first
4668 foreach_writable_storage
($conf, sub {
4670 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
4671 return if !$scfg->{shared
};
4673 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage
4677 # now search local storage
4678 foreach_writable_storage
($conf, sub {
4680 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
4681 return if $scfg->{shared
};
4683 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage;
4687 $target = 'local' if !$target;
4689 my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
4690 # we abort live save after $conf->{memory}, so we need at max twice that space
4691 my $size = $conf->{memory
}*2 + $driver_state_size;
4693 my $name = "vm-$vmid-state-$snapname";
4694 my $scfg = PVE
::Storage
::storage_config
($storecfg, $target);
4695 $name .= ".raw" if $scfg->{path
}; # add filename extension for file base storage
4696 my $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $target, $vmid, 'raw', $name, $size*1024);
4701 my $snapshot_prepare = sub {
4702 my ($vmid, $snapname, $save_vmstate, $comment) = @_;
4706 my $updatefn = sub {
4708 my $conf = load_config
($vmid);
4710 die "you can't take a snapshot if it's a template\n"
4711 if is_template
($conf);
4715 $conf->{lock} = 'snapshot';
4717 die "snapshot name '$snapname' already used\n"
4718 if defined($conf->{snapshots
}->{$snapname});
4720 my $storecfg = PVE
::Storage
::config
();
4721 die "snapshot feature is not available" if !has_feature
('snapshot', $conf, $storecfg);
4723 $snap = $conf->{snapshots
}->{$snapname} = {};
4725 if ($save_vmstate && check_running
($vmid)) {
4726 $snap->{vmstate
} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
4729 &$snapshot_copy_config($conf, $snap);
4731 $snap->{snapstate
} = "prepare";
4732 $snap->{snaptime
} = time();
4733 $snap->{description
} = $comment if $comment;
4735 # always overwrite machine if we save vmstate. This makes sure we
4736 # can restore it later using correct machine type
4737 $snap->{machine
} = get_current_qemu_machine
($vmid) if $snap->{vmstate
};
4739 update_config_nolock
($vmid, $conf, 1);
4742 lock_config
($vmid, $updatefn);
4747 my $snapshot_commit = sub {
4748 my ($vmid, $snapname) = @_;
4750 my $updatefn = sub {
4752 my $conf = load_config
($vmid);
4754 die "missing snapshot lock\n"
4755 if !($conf->{lock} && $conf->{lock} eq 'snapshot');
4757 my $has_machine_config = defined($conf->{machine
});
4759 my $snap = $conf->{snapshots
}->{$snapname};
4761 die "snapshot '$snapname' does not exist\n" if !defined($snap);
4763 die "wrong snapshot state\n"
4764 if !($snap->{snapstate
} && $snap->{snapstate
} eq "prepare");
4766 delete $snap->{snapstate
};
4767 delete $conf->{lock};
4769 my $newconf = &$snapshot_apply_config($conf, $snap);
4771 delete $newconf->{machine
} if !$has_machine_config;
4773 $newconf->{parent
} = $snapname;
4775 update_config_nolock
($vmid, $newconf, 1);
4778 lock_config
($vmid, $updatefn);
4781 sub snapshot_rollback
{
4782 my ($vmid, $snapname) = @_;
4788 my $storecfg = PVE
::Storage
::config
();
4790 my $updatefn = sub {
4792 my $conf = load_config
($vmid);
4794 die "you can't rollback if vm is a template\n" if is_template
($conf);
4796 $snap = $conf->{snapshots
}->{$snapname};
4798 die "snapshot '$snapname' does not exist\n" if !defined($snap);
4800 die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
4801 if $snap->{snapstate
};
4805 vm_stop
($storecfg, $vmid, undef, undef, 5, undef, undef);
4808 die "unable to rollback vm $vmid: vm is running\n"
4809 if check_running
($vmid);
4812 $conf->{lock} = 'rollback';
4814 die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
4815 delete $conf->{lock};
4821 my $has_machine_config = defined($conf->{machine
});
4823 # copy snapshot config to current config
4824 $conf = &$snapshot_apply_config($conf, $snap);
4825 $conf->{parent
} = $snapname;
4827 # Note: old code did not store 'machine', so we try to be smart
4828 # and guess the snapshot was generated with kvm 1.4 (pc-i440fx-1.4).
4829 $forcemachine = $conf->{machine
} || 'pc-i440fx-1.4';
4830 # we remove the 'machine' configuration if not explicitly specified
4831 # in the original config.
4832 delete $conf->{machine
} if $snap->{vmstate
} && !$has_machine_config;
4835 update_config_nolock
($vmid, $conf, 1);
4837 if (!$prepare && $snap->{vmstate
}) {
4838 my $statefile = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
4839 vm_start
($storecfg, $vmid, $statefile, undef, undef, undef, $forcemachine);
4843 lock_config
($vmid, $updatefn);
4845 foreach_drive
($snap, sub {
4846 my ($ds, $drive) = @_;
4848 return if drive_is_cdrom
($drive);
4850 my $volid = $drive->{file
};
4851 my $device = "drive-$ds";
4853 PVE
::Storage
::volume_snapshot_rollback
($storecfg, $volid, $snapname);
4857 lock_config
($vmid, $updatefn);
4860 my $savevm_wait = sub {
4864 my $stat = vm_mon_cmd_nocheck
($vmid, "query-savevm");
4865 if (!$stat->{status
}) {
4866 die "savevm not active\n";
4867 } elsif ($stat->{status
} eq 'active') {
4870 } elsif ($stat->{status
} eq 'completed') {
4873 die "query-savevm returned status '$stat->{status}'\n";
4878 sub snapshot_create
{
4879 my ($vmid, $snapname, $save_vmstate, $comment) = @_;
4881 my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
4883 $save_vmstate = 0 if !$snap->{vmstate
}; # vm is not running
4885 my $config = load_config
($vmid);
4887 my $running = check_running
($vmid);
4889 my $freezefs = $running && $config->{agent
};
4890 $freezefs = 0 if $snap->{vmstate
}; # not needed if we save RAM
4895 eval { vm_mon_cmd
($vmid, "guest-fsfreeze-freeze"); };
4896 warn "guest-fsfreeze-freeze problems - $@" if $@;
4900 # create internal snapshots of all drives
4902 my $storecfg = PVE
::Storage
::config
();
4905 if ($snap->{vmstate
}) {
4906 my $path = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
4907 vm_mon_cmd
($vmid, "savevm-start", statefile
=> $path);
4908 &$savevm_wait($vmid);
4910 vm_mon_cmd
($vmid, "savevm-start");
4914 foreach_drive
($snap, sub {
4915 my ($ds, $drive) = @_;
4917 return if drive_is_cdrom
($drive);
4919 my $volid = $drive->{file
};
4920 my $device = "drive-$ds";
4922 qemu_volume_snapshot
($vmid, $device, $storecfg, $volid, $snapname);
4923 $drivehash->{$ds} = 1;
4929 eval { vm_mon_cmd
($vmid, "savevm-end") };
4933 eval { vm_mon_cmd
($vmid, "guest-fsfreeze-thaw"); };
4934 warn "guest-fsfreeze-thaw problems - $@" if $@;
4937 # savevm-end is async, we need to wait
4939 my $stat = vm_mon_cmd_nocheck
($vmid, "query-savevm");
4940 if (!$stat->{bytes
}) {
4943 print "savevm not yet finished\n";
4951 warn "snapshot create failed: starting cleanup\n";
4952 eval { snapshot_delete
($vmid, $snapname, 0, $drivehash); };
4957 &$snapshot_commit($vmid, $snapname);
4960 # Note: $drivehash is only set when called from snapshot_create.
4961 sub snapshot_delete
{
4962 my ($vmid, $snapname, $force, $drivehash) = @_;
4969 my $unlink_parent = sub {
4970 my ($confref, $new_parent) = @_;
4972 if ($confref->{parent
} && $confref->{parent
} eq $snapname) {
4974 $confref->{parent
} = $new_parent;
4976 delete $confref->{parent
};
4981 my $updatefn = sub {
4982 my ($remove_drive) = @_;
4984 my $conf = load_config
($vmid);
4988 die "you can't delete a snapshot if vm is a template\n"
4989 if is_template
($conf);
4992 $snap = $conf->{snapshots
}->{$snapname};
4994 die "snapshot '$snapname' does not exist\n" if !defined($snap);
4996 # remove parent refs
4998 &$unlink_parent($conf, $snap->{parent
});
4999 foreach my $sn (keys %{$conf->{snapshots
}}) {
5000 next if $sn eq $snapname;
5001 &$unlink_parent($conf->{snapshots
}->{$sn}, $snap->{parent
});
5005 if ($remove_drive) {
5006 if ($remove_drive eq 'vmstate') {
5007 delete $snap->{$remove_drive};
5009 my $drive = parse_drive
($remove_drive, $snap->{$remove_drive});
5010 my $volid = $drive->{file
};
5011 delete $snap->{$remove_drive};
5012 add_unused_volume
($conf, $volid);
5017 $snap->{snapstate
} = 'delete';
5019 delete $conf->{snapshots
}->{$snapname};
5020 delete $conf->{lock} if $drivehash;
5021 foreach my $volid (@$unused) {
5022 add_unused_volume
($conf, $volid);
5026 update_config_nolock
($vmid, $conf, 1);
5029 lock_config
($vmid, $updatefn);
5031 # now remove vmstate file
5033 my $storecfg = PVE
::Storage
::config
();
5035 if ($snap->{vmstate
}) {
5036 eval { PVE
::Storage
::vdisk_free
($storecfg, $snap->{vmstate
}); };
5038 die $err if !$force;
5041 # save changes (remove vmstate from snapshot)
5042 lock_config
($vmid, $updatefn, 'vmstate') if !$force;
5045 # now remove all internal snapshots
5046 foreach_drive
($snap, sub {
5047 my ($ds, $drive) = @_;
5049 return if drive_is_cdrom
($drive);
5051 my $volid = $drive->{file
};
5052 my $device = "drive-$ds";
5054 if (!$drivehash || $drivehash->{$ds}) {
5055 eval { qemu_volume_snapshot_delete
($vmid, $device, $storecfg, $volid, $snapname); };
5057 die $err if !$force;
5062 # save changes (remove drive fron snapshot)
5063 lock_config
($vmid, $updatefn, $ds) if !$force;
5064 push @$unused, $volid;
5067 # now cleanup config
5069 lock_config
($vmid, $updatefn);
5073 my ($feature, $conf, $storecfg, $snapname, $running) = @_;
5076 foreach_drive
($conf, sub {
5077 my ($ds, $drive) = @_;
5079 return if drive_is_cdrom
($drive);
5080 my $volid = $drive->{file
};
5081 $err = 1 if !PVE
::Storage
::volume_has_feature
($storecfg, $feature, $volid, $snapname, $running);
5084 return $err ?
0 : 1;
5087 sub template_create
{
5088 my ($vmid, $conf, $disk) = @_;
5090 my $storecfg = PVE
::Storage
::config
();
5092 foreach_drive
($conf, sub {
5093 my ($ds, $drive) = @_;
5095 return if drive_is_cdrom
($drive);
5096 return if $disk && $ds ne $disk;
5098 my $volid = $drive->{file
};
5099 return if !PVE
::Storage
::volume_has_feature
($storecfg, 'template', $volid);
5101 my $voliddst = PVE
::Storage
::vdisk_create_base
($storecfg, $volid);
5102 $drive->{file
} = $voliddst;
5103 $conf->{$ds} = print_drive
($vmid, $drive);
5104 update_config_nolock
($vmid, $conf, 1);
5111 return 1 if defined $conf->{template
} && $conf->{template
} == 1;
5114 sub qemu_img_convert
{
5115 my ($src_volid, $dst_volid, $size, $snapname) = @_;
5117 my $storecfg = PVE
::Storage
::config
();
5118 my ($src_storeid, $src_volname) = PVE
::Storage
::parse_volume_id
($src_volid, 1);
5119 my ($dst_storeid, $dst_volname) = PVE
::Storage
::parse_volume_id
($dst_volid, 1);
5121 if ($src_storeid && $dst_storeid) {
5122 my $src_scfg = PVE
::Storage
::storage_config
($storecfg, $src_storeid);
5123 my $dst_scfg = PVE
::Storage
::storage_config
($storecfg, $dst_storeid);
5125 my $src_format = qemu_img_format
($src_scfg, $src_volname);
5126 my $dst_format = qemu_img_format
($dst_scfg, $dst_volname);
5128 my $src_path = PVE
::Storage
::path
($storecfg, $src_volid, $snapname);
5129 my $dst_path = PVE
::Storage
::path
($storecfg, $dst_volid);
5132 push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-n';
5133 push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
5134 push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
5138 if($line =~ m/\((\S+)\/100\
%\)/){
5140 my $transferred = int($size * $percent / 100);
5141 my $remaining = $size - $transferred;
5143 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
5148 eval { run_command
($cmd, timeout
=> undef, outfunc
=> $parser); };
5150 die "copy failed: $err" if $err;
5154 sub qemu_img_format
{
5155 my ($scfg, $volname) = @_;
5157 if ($scfg->{path
} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/) {
5159 } elsif ($scfg->{type
} eq 'iscsi') {
5160 return "host_device";
5166 sub qemu_drive_mirror
{
5167 my ($vmid, $drive, $dst_volid, $vmiddst) = @_;
5174 my $storecfg = PVE
::Storage
::config
();
5175 my ($dst_storeid, $dst_volname) = PVE
::Storage
::parse_volume_id
($dst_volid);
5177 my $dst_scfg = PVE
::Storage
::storage_config
($storecfg, $dst_storeid);
5180 if ($dst_volname =~ m/\.(raw|qcow2)$/){
5184 my $dst_path = PVE
::Storage
::path
($storecfg, $dst_volid);
5186 my $opts = { timeout
=> 10, device
=> "drive-$drive", mode
=> "existing", sync
=> "full", target
=> $dst_path };
5187 $opts->{format
} = $format if $format;
5189 #fixme : sometime drive-mirror timeout, but works fine after.
5190 # (I have see the problem with big volume > 200GB), so we need to eval
5191 eval { vm_mon_cmd
($vmid, "drive-mirror", %$opts); };
5192 # ignore errors here
5196 my $stats = vm_mon_cmd
($vmid, "query-block-jobs");
5197 my $stat = @$stats[0];
5198 die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
5199 die "error job is not mirroring" if $stat->{type
} ne "mirror";
5201 my $busy = $stat->{busy
};
5203 if (my $total = $stat->{len
}) {
5204 my $transferred = $stat->{offset
} || 0;
5205 my $remaining = $total - $transferred;
5206 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
5208 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent % busy: $busy\n";
5211 if ($stat->{len
} == $stat->{offset
}) {
5212 if ($busy eq 'false') {
5214 last if $vmiddst != $vmid;
5216 # try to switch the disk if source and destination are on the same guest
5217 eval { vm_mon_cmd
($vmid, "block-job-complete", device
=> "drive-$drive") };
5219 die $@ if $@ !~ m/cannot be completed/;
5222 if ($count > $maxwait) {
5223 # if too much writes to disk occurs at the end of migration
5224 #the disk needs to be freezed to be able to complete the migration
5225 vm_suspend
($vmid,1);
5230 $old_len = $stat->{offset
};
5234 vm_resume
($vmid, 1) if $frozen;
5239 my $cancel_job = sub {
5240 vm_mon_cmd
($vmid, "block-job-cancel", device
=> "drive-$drive");
5242 my $stats = vm_mon_cmd
($vmid, "query-block-jobs");
5243 my $stat = @$stats[0];
5250 eval { &$cancel_job(); };
5251 die "mirroring error: $err";
5254 if ($vmiddst != $vmid) {
5255 # if we clone a disk for a new target vm, we don't switch the disk
5256 &$cancel_job(); # so we call block-job-cancel
5261 my ($storecfg, $vmid, $running, $drivename, $drive, $snapname,
5262 $newvmid, $storage, $format, $full, $newvollist) = @_;
5267 print "create linked clone of drive $drivename ($drive->{file})\n";
5268 $newvolid = PVE
::Storage
::vdisk_clone
($storecfg, $drive->{file
}, $newvmid, $snapname);
5269 push @$newvollist, $newvolid;
5271 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($drive->{file
});
5272 $storeid = $storage if $storage;
5274 my ($defFormat, $validFormats) = PVE
::Storage
::storage_default_format
($storecfg, $storeid);
5276 $format = $drive->{format
} || $defFormat;
5279 # test if requested format is supported - else use default
5280 my $supported = grep { $_ eq $format } @$validFormats;
5281 $format = $defFormat if !$supported;
5283 my ($size) = PVE
::Storage
::volume_size_info
($storecfg, $drive->{file
}, 3);
5285 print "create full clone of drive $drivename ($drive->{file})\n";
5286 $newvolid = PVE
::Storage
::vdisk_alloc
($storecfg, $storeid, $newvmid, $format, undef, ($size/1024));
5287 push @$newvollist, $newvolid;
5289 if (!$running || $snapname) {
5290 qemu_img_convert
($drive->{file
}, $newvolid, $size, $snapname);
5292 qemu_drive_mirror
($vmid, $drivename, $newvolid, $newvmid);
5296 my ($size) = PVE
::Storage
::volume_size_info
($storecfg, $newvolid, 3);
5299 $disk->{format
} = undef;
5300 $disk->{file
} = $newvolid;
5301 $disk->{size
} = $size;
5306 # this only works if VM is running
5307 sub get_current_qemu_machine
{
5310 my $cmd = { execute
=> 'query-machines', arguments
=> {} };
5311 my $res = PVE
::QemuServer
::vm_qmp_command
($vmid, $cmd);
5313 my ($current, $default);
5314 foreach my $e (@$res) {
5315 $default = $e->{name
} if $e->{'is-default'};
5316 $current = $e->{name
} if $e->{'is-current'};
5319 # fallback to the default machine if current is not supported by qemu
5320 return $current || $default || 'pc';
5327 dir_glob_foreach
("$pcisysfs/devices", '[a-f0-9]{4}:([a-f0-9]{2}:[a-f0-9]{2})\.([0-9])', sub {
5328 my (undef, $id, $function) = @_;
5329 my $res = { id
=> $id, function
=> $function};
5330 push @{$devices->{$id}}, $res;