1 package PVE
::QemuServer
;
21 use Storable
qw(dclone);
22 use PVE
::Exception
qw(raise raise_param_exc);
24 use PVE
::Tools
qw(run_command lock_file lock_file_full file_read_firstline);
25 use PVE
::JSONSchema
qw(get_standard_option);
26 use PVE
::Cluster
qw(cfs_register_file cfs_read_file cfs_write_file cfs_lock_file);
30 use PVE
::RPCEnvironment
;
31 use Time
::HiRes
qw(gettimeofday);
33 my $cpuinfo = PVE
::ProcFSTools
::read_cpuinfo
();
35 # Note about locking: we use flock on the config file protect
36 # against concurent actions.
37 # Aditionaly, we have a 'lock' setting in the config file. This
38 # can be set to 'migrate', 'backup', 'snapshot' or 'rollback'. Most actions are not
39 # allowed when such lock is set. But you can ignore this kind of
40 # lock with the --skiplock flag.
42 cfs_register_file
('/qemu-server/',
46 PVE
::JSONSchema
::register_standard_option
('skiplock', {
47 description
=> "Ignore locks - only root is allowed to use this option.",
52 PVE
::JSONSchema
::register_standard_option
('pve-qm-stateuri', {
53 description
=> "Some command save/restore state from this location.",
59 PVE
::JSONSchema
::register_standard_option
('pve-snapshot-name', {
60 description
=> "The name of the snapshot.",
61 type
=> 'string', format
=> 'pve-configid',
65 #no warnings 'redefine';
67 unless(defined(&_VZSYSCALLS_H_
)) {
68 eval 'sub _VZSYSCALLS_H_ () {1;}' unless defined(&_VZSYSCALLS_H_
);
69 require 'sys/syscall.ph';
70 if(defined(&__x86_64__
)) {
71 eval 'sub __NR_fairsched_vcpus () {499;}' unless defined(&__NR_fairsched_vcpus
);
72 eval 'sub __NR_fairsched_mknod () {504;}' unless defined(&__NR_fairsched_mknod
);
73 eval 'sub __NR_fairsched_rmnod () {505;}' unless defined(&__NR_fairsched_rmnod
);
74 eval 'sub __NR_fairsched_chwt () {506;}' unless defined(&__NR_fairsched_chwt
);
75 eval 'sub __NR_fairsched_mvpr () {507;}' unless defined(&__NR_fairsched_mvpr
);
76 eval 'sub __NR_fairsched_rate () {508;}' unless defined(&__NR_fairsched_rate
);
77 eval 'sub __NR_setluid () {501;}' unless defined(&__NR_setluid
);
78 eval 'sub __NR_setublimit () {502;}' unless defined(&__NR_setublimit
);
80 elsif(defined( &__i386__
) ) {
81 eval 'sub __NR_fairsched_mknod () {500;}' unless defined(&__NR_fairsched_mknod
);
82 eval 'sub __NR_fairsched_rmnod () {501;}' unless defined(&__NR_fairsched_rmnod
);
83 eval 'sub __NR_fairsched_chwt () {502;}' unless defined(&__NR_fairsched_chwt
);
84 eval 'sub __NR_fairsched_mvpr () {503;}' unless defined(&__NR_fairsched_mvpr
);
85 eval 'sub __NR_fairsched_rate () {504;}' unless defined(&__NR_fairsched_rate
);
86 eval 'sub __NR_fairsched_vcpus () {505;}' unless defined(&__NR_fairsched_vcpus
);
87 eval 'sub __NR_setluid () {511;}' unless defined(&__NR_setluid
);
88 eval 'sub __NR_setublimit () {512;}' unless defined(&__NR_setublimit
);
90 die("no fairsched syscall for this arch");
92 require 'asm/ioctl.ph';
93 eval 'sub KVM_GET_API_VERSION () { &_IO(0xAE, 0x);}' unless defined(&KVM_GET_API_VERSION
);
97 my ($parent, $weight, $desired) = @_;
99 return syscall(&__NR_fairsched_mknod
, int($parent), int($weight), int($desired));
102 sub fairsched_rmnod
{
105 return syscall(&__NR_fairsched_rmnod
, int($id));
109 my ($pid, $newid) = @_;
111 return syscall(&__NR_fairsched_mvpr
, int($pid), int($newid));
114 sub fairsched_vcpus
{
115 my ($id, $vcpus) = @_;
117 return syscall(&__NR_fairsched_vcpus
, int($id), int($vcpus));
121 my ($id, $op, $rate) = @_;
123 return syscall(&__NR_fairsched_rate
, int($id), int($op), int($rate));
126 use constant FAIRSCHED_SET_RATE
=> 0;
127 use constant FAIRSCHED_DROP_RATE
=> 1;
128 use constant FAIRSCHED_GET_RATE
=> 2;
130 sub fairsched_cpulimit
{
131 my ($id, $limit) = @_;
133 my $cpulim1024 = int($limit * 1024 / 100);
134 my $op = $cpulim1024 ? FAIRSCHED_SET_RATE
: FAIRSCHED_DROP_RATE
;
136 return fairsched_rate
($id, $op, $cpulim1024);
139 my $nodename = PVE
::INotify
::nodename
();
141 mkdir "/etc/pve/nodes/$nodename";
142 my $confdir = "/etc/pve/nodes/$nodename/qemu-server";
145 my $var_run_tmpdir = "/var/run/qemu-server";
146 mkdir $var_run_tmpdir;
148 my $lock_dir = "/var/lock/qemu-server";
151 my $pcisysfs = "/sys/bus/pci";
157 description
=> "Specifies whether a VM will be started during system bootup.",
163 description
=> "Automatic restart after crash (currently ignored).",
169 description
=> "Allow hotplug for disk and network device",
175 description
=> "Allow reboot. If set to '0' the VM exit on reboot.",
181 description
=> "Lock/unlock the VM.",
182 enum
=> [qw(migrate backup snapshot rollback)],
187 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.",
194 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.",
202 description
=> "Amount of RAM for the VM in MB. This is the maximum available memory when you use the balloon device.",
209 description
=> "Amount of target RAM for the VM in MB. Using zero disables the ballon driver.",
215 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",
223 description
=> "Keybord layout for vnc server. Default is read from the datacenter configuration file.",
224 enum
=> PVE
::Tools
::kvmkeymaplist
(),
229 type
=> 'string', format
=> 'dns-name',
230 description
=> "Set a name for the VM. Only used on the configuration web interface.",
235 description
=> "scsi controller model",
236 enum
=> [qw(lsi virtio-scsi-pci megasas)],
242 description
=> "Description for the VM. Only used on the configuration web interface. This is saved as comment inside the configuration file.",
247 enum
=> [qw(other wxp w2k w2k3 w2k8 wvista win7 win8 l24 l26)],
248 description
=> <<EODESC,
249 Used to enable special optimization/features for specific
252 other => unspecified OS
253 wxp => Microsoft Windows XP
254 w2k => Microsoft Windows 2000
255 w2k3 => Microsoft Windows 2003
256 w2k8 => Microsoft Windows 2008
257 wvista => Microsoft Windows Vista
258 win7 => Microsoft Windows 7
259 win8 => Microsoft Windows 8/2012
260 l24 => Linux 2.4 Kernel
261 l26 => Linux 2.6/3.X Kernel
263 other|l24|l26 ... no special behaviour
264 wxp|w2k|w2k3|w2k8|wvista|win7|win8 ... use --localtime switch
270 description
=> "Boot on floppy (a), hard disk (c), CD-ROM (d), or network (n).",
271 pattern
=> '[acdn]{1,4}',
276 type
=> 'string', format
=> 'pve-qm-bootdisk',
277 description
=> "Enable booting from specified disk.",
278 pattern
=> '(ide|sata|scsi|virtio)\d+',
283 description
=> "The number of CPUs. Please use option -sockets instead.",
290 description
=> "The number of CPU sockets.",
297 description
=> "The number of cores per socket.",
304 description
=> "Enable/disable ACPI.",
310 description
=> "Enable/disable Qemu GuestAgent.",
316 description
=> "Enable/disable KVM hardware virtualization.",
322 description
=> "Enable/disable time drift fix.",
328 description
=> "Set the real time clock to local time. This is enabled by default if ostype indicates a Microsoft OS.",
333 description
=> "Freeze CPU at startup (use 'c' monitor command to start execution).",
338 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.",
339 enum
=> [qw(std cirrus vmware qxl)],
343 type
=> 'string', format
=> 'pve-qm-watchdog',
344 typetext
=> '[[model=]i6300esb|ib700] [,[action=]reset|shutdown|poweroff|pause|debug|none]',
345 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)",
350 typetext
=> "(now | YYYY-MM-DD | YYYY-MM-DDTHH:MM:SS)",
351 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'.",
352 pattern
=> '(now|\d{4}-\d{1,2}-\d{1,2}(T\d{1,2}:\d{1,2}:\d{1,2})?)',
357 type
=> 'string', format
=> 'pve-qm-startup',
358 typetext
=> '[[order=]\d+] [,up=\d+] [,down=\d+] ',
359 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.",
364 description
=> "Enable/disable Template.",
370 description
=> <<EODESCR,
371 Note: this option is for experts only. It allows you to pass arbitrary arguments to kvm, for example:
373 args: -no-reboot -no-hpet
380 description
=> "Enable/disable the usb tablet device. This device is usually needed to allow absolute mouse positioning. Else the mouse runs out of sync with normal vnc clients. If you're running lots of console-only guests on one host, you may consider disabling this to save some context switches.",
385 description
=> "Set maximum speed (in MB/s) for migrations. Value 0 is no limit.",
389 migrate_downtime
=> {
392 description
=> "Set maximum tolerated downtime (in seconds) for migrations.",
398 type
=> 'string', format
=> 'pve-qm-drive',
399 typetext
=> 'volume',
400 description
=> "This is an alias for option -ide2",
404 description
=> "Emulated CPU type.",
406 enum
=> [ qw(486 athlon pentium pentium2 pentium3 coreduo core2duo kvm32 kvm64 qemu32 qemu64 phenom Conroe Penryn Nehalem Westmere SandyBridge Haswell Opteron_G1 Opteron_G2 Opteron_G3 Opteron_G4 Opteron_G5 host) ],
409 parent
=> get_standard_option
('pve-snapshot-name', {
411 description
=> "Parent snapshot name. This is used internally, and should not be modified.",
415 description
=> "Timestamp for snapshots.",
421 type
=> 'string', format
=> 'pve-volume-id',
422 description
=> "Reference to a volume which stores the VM state. This is used internally for snapshots.",
425 description
=> "Specific the Qemu machine type.",
427 pattern
=> '(pc|pc(-i440fx)?-\d+\.\d+|q35|pc-q35-\d+\.\d+)',
433 # what about other qemu settings ?
435 #machine => 'string',
448 ##soundhw => 'string',
450 while (my ($k, $v) = each %$confdesc) {
451 PVE
::JSONSchema
::register_standard_option
("pve-qm-$k", $v);
454 my $MAX_IDE_DISKS = 4;
455 my $MAX_SCSI_DISKS = 14;
456 my $MAX_VIRTIO_DISKS = 16;
457 my $MAX_SATA_DISKS = 6;
458 my $MAX_USB_DEVICES = 5;
460 my $MAX_UNUSED_DISKS = 8;
461 my $MAX_HOSTPCI_DEVICES = 2;
462 my $MAX_SERIAL_PORTS = 4;
463 my $MAX_PARALLEL_PORTS = 3;
465 my $nic_model_list = ['rtl8139', 'ne2k_pci', 'e1000', 'pcnet', 'virtio',
466 'ne2k_isa', 'i82551', 'i82557b', 'i82559er'];
467 my $nic_model_list_txt = join(' ', sort @$nic_model_list);
471 type
=> 'string', format
=> 'pve-qm-net',
472 typetext
=> "MODEL=XX:XX:XX:XX:XX:XX [,bridge=<dev>][,rate=<mbps>][,tag=<vlanid>]",
473 description
=> <<EODESCR,
474 Specify network devices.
476 MODEL is one of: $nic_model_list_txt
478 XX:XX:XX:XX:XX:XX should be an unique MAC address. This is
479 automatically generated if not specified.
481 The bridge parameter can be used to automatically add the interface to a bridge device. The Proxmox VE standard bridge is called 'vmbr0'.
483 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'.
485 If you specify no bridge, we create a kvm 'user' (NATed) network device, which provides DHCP and DNS services. The following addresses are used:
491 The DHCP server assign addresses to the guest starting from 10.0.2.15.
495 PVE
::JSONSchema
::register_standard_option
("pve-qm-net", $netdesc);
497 for (my $i = 0; $i < $MAX_NETS; $i++) {
498 $confdesc->{"net$i"} = $netdesc;
505 type
=> 'string', format
=> 'pve-qm-drive',
506 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]',
507 description
=> "Use volume as IDE hard disk or CD-ROM (n is 0 to " .($MAX_IDE_DISKS -1) . ").",
509 PVE
::JSONSchema
::register_standard_option
("pve-qm-ide", $idedesc);
513 type
=> 'string', format
=> 'pve-qm-drive',
514 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]',
515 description
=> "Use volume as SCSI hard disk or CD-ROM (n is 0 to " . ($MAX_SCSI_DISKS - 1) . ").",
517 PVE
::JSONSchema
::register_standard_option
("pve-qm-scsi", $scsidesc);
521 type
=> 'string', format
=> 'pve-qm-drive',
522 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]',
523 description
=> "Use volume as SATA hard disk or CD-ROM (n is 0 to " . ($MAX_SATA_DISKS - 1). ").",
525 PVE
::JSONSchema
::register_standard_option
("pve-qm-sata", $satadesc);
529 type
=> 'string', format
=> 'pve-qm-drive',
530 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]',
531 description
=> "Use volume as VIRTIO hard disk (n is 0 to " . ($MAX_VIRTIO_DISKS - 1) . ").",
533 PVE
::JSONSchema
::register_standard_option
("pve-qm-virtio", $virtiodesc);
537 type
=> 'string', format
=> 'pve-qm-usb-device',
538 typetext
=> 'host=HOSTUSBDEVICE',
539 description
=> <<EODESCR,
540 Configure an USB device (n is 0 to 4). This can be used to
541 pass-through usb devices to the guest. HOSTUSBDEVICE syntax is:
543 'bus-port(.port)*' (decimal numbers) or
544 'vendor_id:product_id' (hexadeciaml numbers)
546 You can use the 'lsusb -t' command to list existing usb devices.
548 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
552 PVE
::JSONSchema
::register_standard_option
("pve-qm-usb", $usbdesc);
556 type
=> 'string', format
=> 'pve-qm-hostpci',
557 typetext
=> "HOSTPCIDEVICE",
558 description
=> <<EODESCR,
559 Map host pci devices. HOSTPCIDEVICE syntax is:
561 'bus:dev.func' (hexadecimal numbers)
563 You can us the 'lspci' command to list existing pci devices.
565 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
567 Experimental: user reported problems with this option.
570 PVE
::JSONSchema
::register_standard_option
("pve-qm-hostpci", $hostpcidesc);
575 pattern
=> '/dev/ttyS\d+',
576 description
=> <<EODESCR,
577 Map host serial devices (n is 0 to 3).
579 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
581 Experimental: user reported problems with this option.
588 pattern
=> '/dev/parport\d+',
589 description
=> <<EODESCR,
590 Map host parallel devices (n is 0 to 2).
592 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
594 Experimental: user reported problems with this option.
598 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
599 $confdesc->{"parallel$i"} = $paralleldesc;
602 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
603 $confdesc->{"serial$i"} = $serialdesc;
606 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
607 $confdesc->{"hostpci$i"} = $hostpcidesc;
610 for (my $i = 0; $i < $MAX_IDE_DISKS; $i++) {
611 $drivename_hash->{"ide$i"} = 1;
612 $confdesc->{"ide$i"} = $idedesc;
615 for (my $i = 0; $i < $MAX_SATA_DISKS; $i++) {
616 $drivename_hash->{"sata$i"} = 1;
617 $confdesc->{"sata$i"} = $satadesc;
620 for (my $i = 0; $i < $MAX_SCSI_DISKS; $i++) {
621 $drivename_hash->{"scsi$i"} = 1;
622 $confdesc->{"scsi$i"} = $scsidesc ;
625 for (my $i = 0; $i < $MAX_VIRTIO_DISKS; $i++) {
626 $drivename_hash->{"virtio$i"} = 1;
627 $confdesc->{"virtio$i"} = $virtiodesc;
630 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
631 $confdesc->{"usb$i"} = $usbdesc;
636 type
=> 'string', format
=> 'pve-volume-id',
637 description
=> "Reference to unused volumes.",
640 for (my $i = 0; $i < $MAX_UNUSED_DISKS; $i++) {
641 $confdesc->{"unused$i"} = $unuseddesc;
644 my $kvm_api_version = 0;
648 return $kvm_api_version if $kvm_api_version;
650 my $fh = IO
::File-
>new("</dev/kvm") ||
653 if (my $v = $fh->ioctl(KVM_GET_API_VERSION
(), 0)) {
654 $kvm_api_version = $v;
659 return $kvm_api_version;
662 my $kvm_user_version;
664 sub kvm_user_version
{
666 return $kvm_user_version if $kvm_user_version;
668 $kvm_user_version = 'unknown';
670 my $tmp = `kvm -help 2>/dev/null`;
672 if ($tmp =~ m/^QEMU( PC)? emulator version (\d+\.\d+(\.\d+)?)[,\s]/) {
673 $kvm_user_version = $2;
676 return $kvm_user_version;
680 my $kernel_has_vhost_net = -c
'/dev/vhost-net';
683 # order is important - used to autoselect boot disk
684 return ((map { "ide$_" } (0 .. ($MAX_IDE_DISKS - 1))),
685 (map { "scsi$_" } (0 .. ($MAX_SCSI_DISKS - 1))),
686 (map { "virtio$_" } (0 .. ($MAX_VIRTIO_DISKS - 1))),
687 (map { "sata$_" } (0 .. ($MAX_SATA_DISKS - 1))));
690 sub valid_drivename
{
693 return defined($drivename_hash->{$dev});
698 return defined($confdesc->{$key});
702 return $nic_model_list;
705 sub os_list_description
{
710 w2k
=> 'Windows 2000',
711 w2k3
=>, 'Windows 2003',
712 w2k8
=> 'Windows 2008',
713 wvista
=> 'Windows Vista',
715 win8
=> 'Windows 8/2012',
725 return $cdrom_path if $cdrom_path;
727 return $cdrom_path = "/dev/cdrom" if -l
"/dev/cdrom";
728 return $cdrom_path = "/dev/cdrom1" if -l
"/dev/cdrom1";
729 return $cdrom_path = "/dev/cdrom2" if -l
"/dev/cdrom2";
733 my ($storecfg, $vmid, $cdrom) = @_;
735 if ($cdrom eq 'cdrom') {
736 return get_cdrom_path
();
737 } elsif ($cdrom eq 'none') {
739 } elsif ($cdrom =~ m
|^/|) {
742 return PVE
::Storage
::path
($storecfg, $cdrom);
746 # try to convert old style file names to volume IDs
747 sub filename_to_volume_id
{
748 my ($vmid, $file, $media) = @_;
750 if (!($file eq 'none' || $file eq 'cdrom' ||
751 $file =~ m
|^/dev/.+| || $file =~ m/^([^:]+):(.+)$/)) {
753 return undef if $file =~ m
|/|;
755 if ($media && $media eq 'cdrom') {
756 $file = "local:iso/$file";
758 $file = "local:$vmid/$file";
765 sub verify_media_type
{
766 my ($opt, $vtype, $media) = @_;
771 if ($media eq 'disk') {
773 } elsif ($media eq 'cdrom') {
776 die "internal error";
779 return if ($vtype eq $etype);
781 raise_param_exc
({ $opt => "unexpected media type ($vtype != $etype)" });
784 sub cleanup_drive_path
{
785 my ($opt, $storecfg, $drive) = @_;
787 # try to convert filesystem paths to volume IDs
789 if (($drive->{file
} !~ m/^(cdrom|none)$/) &&
790 ($drive->{file
} !~ m
|^/dev/.+|) &&
791 ($drive->{file
} !~ m/^([^:]+):(.+)$/) &&
792 ($drive->{file
} !~ m/^\d+$/)) {
793 my ($vtype, $volid) = PVE
::Storage
::path_to_volume_id
($storecfg, $drive->{file
});
794 raise_param_exc
({ $opt => "unable to associate path '$drive->{file}' to any storage"}) if !$vtype;
795 $drive->{media
} = 'cdrom' if !$drive->{media
} && $vtype eq 'iso';
796 verify_media_type
($opt, $vtype, $drive->{media
});
797 $drive->{file
} = $volid;
800 $drive->{media
} = 'cdrom' if !$drive->{media
} && $drive->{file
} =~ m/^(cdrom|none)$/;
803 sub create_conf_nolock
{
804 my ($vmid, $settings) = @_;
806 my $filename = config_file
($vmid);
808 die "configuration file '$filename' already exists\n" if -f
$filename;
810 my $defaults = load_defaults
();
812 $settings->{name
} = "vm$vmid" if !$settings->{name
};
813 $settings->{memory
} = $defaults->{memory
} if !$settings->{memory
};
816 foreach my $opt (keys %$settings) {
817 next if !$confdesc->{$opt};
819 my $value = $settings->{$opt};
822 $data .= "$opt: $value\n";
825 PVE
::Tools
::file_set_contents
($filename, $data);
828 my $parse_size = sub {
831 return undef if $value !~ m/^(\d+(\.\d+)?)([KMG])?$/;
832 my ($size, $unit) = ($1, $3);
835 $size = $size * 1024;
836 } elsif ($unit eq 'M') {
837 $size = $size * 1024 * 1024;
838 } elsif ($unit eq 'G') {
839 $size = $size * 1024 * 1024 * 1024;
845 my $format_size = sub {
850 my $kb = int($size/1024);
851 return $size if $kb*1024 != $size;
853 my $mb = int($kb/1024);
854 return "${kb}K" if $mb*1024 != $kb;
856 my $gb = int($mb/1024);
857 return "${mb}M" if $gb*1024 != $mb;
862 # ideX = [volume=]volume-id[,media=d][,cyls=c,heads=h,secs=s[,trans=t]]
863 # [,snapshot=on|off][,cache=on|off][,format=f][,backup=yes|no]
864 # [,rerror=ignore|report|stop][,werror=enospc|ignore|report|stop]
865 # [,aio=native|threads]
868 my ($key, $data) = @_;
872 # $key may be undefined - used to verify JSON parameters
873 if (!defined($key)) {
874 $res->{interface
} = 'unknown'; # should not harm when used to verify parameters
876 } elsif ($key =~ m/^([^\d]+)(\d+)$/) {
877 $res->{interface
} = $1;
883 foreach my $p (split (/,/, $data)) {
884 next if $p =~ m/^\s*$/;
886 if ($p =~ m/^(file|volume|cyls|heads|secs|trans|media|snapshot|cache|format|rerror|werror|backup|aio|bps|mbps|bps_rd|mbps_rd|bps_wr|mbps_wr|iops|iops_rd|iops_wr|size)=(.+)$/) {
887 my ($k, $v) = ($1, $2);
889 $k = 'file' if $k eq 'volume';
891 return undef if defined $res->{$k};
893 if ($k eq 'bps' || $k eq 'bps_rd' || $k eq 'bps_wr') {
894 return undef if !$v || $v !~ m/^\d+/;
896 $v = sprintf("%.3f", $v / (1024*1024));
900 if (!$res->{file
} && $p !~ m/=/) {
908 return undef if !$res->{file
};
910 if($res->{file
} =~ m/\.(raw|cow|qcow|qcow2|vmdk|cloop)$/){
914 return undef if $res->{cache
} &&
915 $res->{cache
} !~ m/^(off|none|writethrough|writeback|unsafe|directsync)$/;
916 return undef if $res->{snapshot
} && $res->{snapshot
} !~ m/^(on|off)$/;
917 return undef if $res->{cyls
} && $res->{cyls
} !~ m/^\d+$/;
918 return undef if $res->{heads
} && $res->{heads
} !~ m/^\d+$/;
919 return undef if $res->{secs
} && $res->{secs
} !~ m/^\d+$/;
920 return undef if $res->{media
} && $res->{media
} !~ m/^(disk|cdrom)$/;
921 return undef if $res->{trans
} && $res->{trans
} !~ m/^(none|lba|auto)$/;
922 return undef if $res->{format
} && $res->{format
} !~ m/^(raw|cow|qcow|qcow2|vmdk|cloop)$/;
923 return undef if $res->{rerror
} && $res->{rerror
} !~ m/^(ignore|report|stop)$/;
924 return undef if $res->{werror
} && $res->{werror
} !~ m/^(enospc|ignore|report|stop)$/;
925 return undef if $res->{backup
} && $res->{backup
} !~ m/^(yes|no)$/;
926 return undef if $res->{aio
} && $res->{aio
} !~ m/^(native|threads)$/;
929 return undef if $res->{mbps_rd
} && $res->{mbps
};
930 return undef if $res->{mbps_wr
} && $res->{mbps
};
932 return undef if $res->{mbps
} && $res->{mbps
} !~ m/^\d+(\.\d+)?$/;
933 return undef if $res->{mbps_rd
} && $res->{mbps_rd
} !~ m/^\d+(\.\d+)?$/;
934 return undef if $res->{mbps_wr
} && $res->{mbps_wr
} !~ m/^\d+(\.\d+)?$/;
936 return undef if $res->{iops_rd
} && $res->{iops
};
937 return undef if $res->{iops_wr
} && $res->{iops
};
938 return undef if $res->{iops
} && $res->{iops
} !~ m/^\d+$/;
939 return undef if $res->{iops_rd
} && $res->{iops_rd
} !~ m/^\d+$/;
940 return undef if $res->{iops_wr
} && $res->{iops_wr
} !~ m/^\d+$/;
944 return undef if !defined($res->{size
} = &$parse_size($res->{size
}));
947 if ($res->{media
} && ($res->{media
} eq 'cdrom')) {
948 return undef if $res->{snapshot
} || $res->{trans
} || $res->{format
};
949 return undef if $res->{heads
} || $res->{secs
} || $res->{cyls
};
950 return undef if $res->{interface
} eq 'virtio';
953 # rerror does not work with scsi drives
954 if ($res->{rerror
}) {
955 return undef if $res->{interface
} eq 'scsi';
961 my @qemu_drive_options = qw(heads secs cyls trans media format cache snapshot rerror werror aio iops iops_rd iops_wr);
964 my ($vmid, $drive) = @_;
967 foreach my $o (@qemu_drive_options, 'mbps', 'mbps_rd', 'mbps_wr', 'backup') {
968 $opts .= ",$o=$drive->{$o}" if $drive->{$o};
971 if ($drive->{size
}) {
972 $opts .= ",size=" . &$format_size($drive->{size
});
975 return "$drive->{file}$opts";
979 my($fh, $noerr) = @_;
982 my $SG_GET_VERSION_NUM = 0x2282;
984 my $versionbuf = "\x00" x
8;
985 my $ret = ioctl($fh, $SG_GET_VERSION_NUM, $versionbuf);
987 die "scsi ioctl SG_GET_VERSION_NUM failoed - $!\n" if !$noerr;
990 my $version = unpack("I", $versionbuf);
991 if ($version < 30000) {
992 die "scsi generic interface too old\n" if !$noerr;
996 my $buf = "\x00" x
36;
997 my $sensebuf = "\x00" x
8;
998 my $cmd = pack("C x3 C x1", 0x12, 36);
1000 # see /usr/include/scsi/sg.h
1001 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";
1003 my $packet = pack($sg_io_hdr_t, ord('S'), -3, length($cmd),
1004 length($sensebuf), 0, length($buf), $buf,
1005 $cmd, $sensebuf, 6000);
1007 $ret = ioctl($fh, $SG_IO, $packet);
1009 die "scsi ioctl SG_IO failed - $!\n" if !$noerr;
1013 my @res = unpack($sg_io_hdr_t, $packet);
1014 if ($res[17] || $res[18]) {
1015 die "scsi ioctl SG_IO status error - $!\n" if !$noerr;
1020 (my $byte0, my $byte1, $res->{vendor
},
1021 $res->{product
}, $res->{revision
}) = unpack("C C x6 A8 A16 A4", $buf);
1023 $res->{removable
} = $byte1 & 128 ?
1 : 0;
1024 $res->{type
} = $byte0 & 31;
1032 my $fh = IO
::File-
>new("+<$path") || return undef;
1033 my $res = scsi_inquiry
($fh, 1);
1039 sub print_drivedevice_full
{
1040 my ($storecfg, $conf, $vmid, $drive, $bridges) = @_;
1045 if ($drive->{interface
} eq 'virtio') {
1046 my $pciaddr = print_pci_addr
("$drive->{interface}$drive->{index}", $bridges);
1047 $device = "virtio-blk-pci,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}$pciaddr";
1048 } elsif ($drive->{interface
} eq 'scsi') {
1049 $maxdev = ($conf->{scsihw
} && $conf->{scsihw
} ne 'lsi') ?
256 : 7;
1050 my $controller = int($drive->{index} / $maxdev);
1051 my $unit = $drive->{index} % $maxdev;
1052 my $devicetype = 'hd';
1054 if (drive_is_cdrom
($drive)) {
1057 if ($drive->{file
} =~ m
|^/|) {
1058 $path = $drive->{file
};
1060 $path = PVE
::Storage
::path
($storecfg, $drive->{file
});
1063 if($path =~ m/^iscsi\:\/\
//){
1064 $devicetype = 'generic';
1066 if (my $info = path_is_scsi
($path)) {
1067 if ($info->{type
} == 0) {
1068 $devicetype = 'block';
1069 } elsif ($info->{type
} == 1) { # tape
1070 $devicetype = 'generic';
1076 if (!$conf->{scsihw
} || $conf->{scsihw
} eq 'lsi'){
1077 $device = "scsi-$devicetype,bus=scsihw$controller.0,scsi-id=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}" if !$conf->{scsihw
} || $conf->{scsihw
} eq 'lsi';
1079 $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}";
1082 } elsif ($drive->{interface
} eq 'ide'){
1084 my $controller = int($drive->{index} / $maxdev);
1085 my $unit = $drive->{index} % $maxdev;
1086 my $devicetype = ($drive->{media
} && $drive->{media
} eq 'cdrom') ?
"cd" : "hd";
1088 $device = "ide-$devicetype,bus=ide.$controller,unit=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1089 } elsif ($drive->{interface
} eq 'sata'){
1090 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
1091 my $unit = $drive->{index} % $MAX_SATA_DISKS;
1092 $device = "ide-drive,bus=ahci$controller.$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1093 } elsif ($drive->{interface
} eq 'usb') {
1095 # -device ide-drive,bus=ide.1,unit=0,drive=drive-ide0-1-0,id=ide0-1-0
1097 die "unsupported interface type";
1100 $device .= ",bootindex=$drive->{bootindex}" if $drive->{bootindex
};
1105 sub print_drive_full
{
1106 my ($storecfg, $vmid, $drive) = @_;
1109 foreach my $o (@qemu_drive_options) {
1110 next if $o eq 'bootindex';
1111 $opts .= ",$o=$drive->{$o}" if $drive->{$o};
1114 foreach my $o (qw(bps bps_rd bps_wr)) {
1115 my $v = $drive->{"m$o"};
1116 $opts .= ",$o=" . int($v*1024*1024) if $v;
1119 # use linux-aio by default (qemu default is threads)
1120 $opts .= ",aio=native" if !$drive->{aio
};
1123 my $volid = $drive->{file
};
1124 if (drive_is_cdrom
($drive)) {
1125 $path = get_iso_path
($storecfg, $vmid, $volid);
1127 if ($volid =~ m
|^/|) {
1130 $path = PVE
::Storage
::path
($storecfg, $volid);
1134 $opts .= ",cache=none" if !$drive->{cache
} && !drive_is_cdrom
($drive);
1136 my $pathinfo = $path ?
"file=$path," : '';
1138 return "${pathinfo}if=none,id=drive-$drive->{interface}$drive->{index}$opts";
1141 sub print_netdevice_full
{
1142 my ($vmid, $conf, $net, $netid, $bridges) = @_;
1144 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
1146 my $device = $net->{model
};
1147 if ($net->{model
} eq 'virtio') {
1148 $device = 'virtio-net-pci';
1151 # qemu > 0.15 always try to boot from network - we disable that by
1152 # not loading the pxe rom file
1153 my $extra = ($bootorder !~ m/n/) ?
"romfile=," : '';
1154 my $pciaddr = print_pci_addr
("$netid", $bridges);
1155 my $tmpstr = "$device,${extra}mac=$net->{macaddr},netdev=$netid$pciaddr,id=$netid";
1156 $tmpstr .= ",bootindex=$net->{bootindex}" if $net->{bootindex
} ;
1160 sub print_netdev_full
{
1161 my ($vmid, $conf, $net, $netid) = @_;
1164 if ($netid =~ m/^net(\d+)$/) {
1168 die "got strange net id '$i'\n" if $i >= ${MAX_NETS
};
1170 my $ifname = "tap${vmid}i$i";
1172 # kvm uses TUNSETIFF ioctl, and that limits ifname length
1173 die "interface name '$ifname' is too long (max 15 character)\n"
1174 if length($ifname) >= 16;
1176 my $vhostparam = '';
1177 $vhostparam = ',vhost=on' if $kernel_has_vhost_net && $net->{model
} eq 'virtio';
1179 my $vmname = $conf->{name
} || "vm$vmid";
1181 if ($net->{bridge
}) {
1182 return "type=tap,id=$netid,ifname=${ifname},script=/var/lib/qemu-server/pve-bridge$vhostparam";
1184 return "type=user,id=$netid,hostname=$vmname";
1188 sub drive_is_cdrom
{
1191 return $drive && $drive->{media
} && ($drive->{media
} eq 'cdrom');
1198 return undef if !$value;
1202 if ($value =~ m/^[a-f0-9]{2}:[a-f0-9]{2}\.[a-f0-9]$/) {
1203 $res->{pciid
} = $value;
1211 # netX: e1000=XX:XX:XX:XX:XX:XX,bridge=vmbr0,rate=<mbps>
1217 foreach my $kvp (split(/,/, $data)) {
1219 if ($kvp =~ m/^(ne2k_pci|e1000|rtl8139|pcnet|virtio|ne2k_isa|i82551|i82557b|i82559er)(=([0-9a-f]{2}(:[0-9a-f]{2}){5}))?$/i) {
1221 my $mac = defined($3) ?
uc($3) : PVE
::Tools
::random_ether_addr
();
1222 $res->{model
} = $model;
1223 $res->{macaddr
} = $mac;
1224 } elsif ($kvp =~ m/^bridge=(\S+)$/) {
1225 $res->{bridge
} = $1;
1226 } elsif ($kvp =~ m/^rate=(\d+(\.\d+)?)$/) {
1228 } elsif ($kvp =~ m/^tag=(\d+)$/) {
1236 return undef if !$res->{model
};
1244 my $res = "$net->{model}";
1245 $res .= "=$net->{macaddr}" if $net->{macaddr
};
1246 $res .= ",bridge=$net->{bridge}" if $net->{bridge
};
1247 $res .= ",rate=$net->{rate}" if $net->{rate
};
1248 $res .= ",tag=$net->{tag}" if $net->{tag
};
1253 sub add_random_macs
{
1254 my ($settings) = @_;
1256 foreach my $opt (keys %$settings) {
1257 next if $opt !~ m/^net(\d+)$/;
1258 my $net = parse_net
($settings->{$opt});
1260 $settings->{$opt} = print_net
($net);
1264 sub add_unused_volume
{
1265 my ($config, $volid) = @_;
1268 for (my $ind = $MAX_UNUSED_DISKS - 1; $ind >= 0; $ind--) {
1269 my $test = "unused$ind";
1270 if (my $vid = $config->{$test}) {
1271 return if $vid eq $volid; # do not add duplicates
1277 die "To many unused volume - please delete them first.\n" if !$key;
1279 $config->{$key} = $volid;
1284 PVE
::JSONSchema
::register_format
('pve-qm-bootdisk', \
&verify_bootdisk
);
1285 sub verify_bootdisk
{
1286 my ($value, $noerr) = @_;
1288 return $value if valid_drivename
($value);
1290 return undef if $noerr;
1292 die "invalid boot disk '$value'\n";
1295 PVE
::JSONSchema
::register_format
('pve-qm-net', \
&verify_net
);
1297 my ($value, $noerr) = @_;
1299 return $value if parse_net
($value);
1301 return undef if $noerr;
1303 die "unable to parse network options\n";
1306 PVE
::JSONSchema
::register_format
('pve-qm-drive', \
&verify_drive
);
1308 my ($value, $noerr) = @_;
1310 return $value if parse_drive
(undef, $value);
1312 return undef if $noerr;
1314 die "unable to parse drive options\n";
1317 PVE
::JSONSchema
::register_format
('pve-qm-hostpci', \
&verify_hostpci
);
1318 sub verify_hostpci
{
1319 my ($value, $noerr) = @_;
1321 return $value if parse_hostpci
($value);
1323 return undef if $noerr;
1325 die "unable to parse pci id\n";
1328 PVE
::JSONSchema
::register_format
('pve-qm-watchdog', \
&verify_watchdog
);
1329 sub verify_watchdog
{
1330 my ($value, $noerr) = @_;
1332 return $value if parse_watchdog
($value);
1334 return undef if $noerr;
1336 die "unable to parse watchdog options\n";
1339 sub parse_watchdog
{
1342 return undef if !$value;
1346 foreach my $p (split(/,/, $value)) {
1347 next if $p =~ m/^\s*$/;
1349 if ($p =~ m/^(model=)?(i6300esb|ib700)$/) {
1351 } elsif ($p =~ m/^(action=)?(reset|shutdown|poweroff|pause|debug|none)$/) {
1352 $res->{action
} = $2;
1361 PVE
::JSONSchema
::register_format
('pve-qm-startup', \
&verify_startup
);
1362 sub verify_startup
{
1363 my ($value, $noerr) = @_;
1365 return $value if parse_startup
($value);
1367 return undef if $noerr;
1369 die "unable to parse startup options\n";
1375 return undef if !$value;
1379 foreach my $p (split(/,/, $value)) {
1380 next if $p =~ m/^\s*$/;
1382 if ($p =~ m/^(order=)?(\d+)$/) {
1384 } elsif ($p =~ m/^up=(\d+)$/) {
1386 } elsif ($p =~ m/^down=(\d+)$/) {
1396 sub parse_usb_device
{
1399 return undef if !$value;
1401 my @dl = split(/,/, $value);
1405 foreach my $v (@dl) {
1406 if ($v =~ m/^host=(0x)?([0-9A-Fa-f]{4}):(0x)?([0-9A-Fa-f]{4})$/) {
1408 $res->{vendorid
} = $2;
1409 $res->{productid
} = $4;
1410 } elsif ($v =~ m/^host=(\d+)\-(\d+(\.\d+)*)$/) {
1412 $res->{hostbus
} = $1;
1413 $res->{hostport
} = $2;
1418 return undef if !$found;
1423 PVE
::JSONSchema
::register_format
('pve-qm-usb-device', \
&verify_usb_device
);
1424 sub verify_usb_device
{
1425 my ($value, $noerr) = @_;
1427 return $value if parse_usb_device
($value);
1429 return undef if $noerr;
1431 die "unable to parse usb device\n";
1434 # add JSON properties for create and set function
1435 sub json_config_properties
{
1438 foreach my $opt (keys %$confdesc) {
1439 next if $opt eq 'parent' || $opt eq 'snaptime' || $opt eq 'vmstate';
1440 $prop->{$opt} = $confdesc->{$opt};
1447 my ($key, $value) = @_;
1449 die "unknown setting '$key'\n" if !$confdesc->{$key};
1451 my $type = $confdesc->{$key}->{type
};
1453 if (!defined($value)) {
1454 die "got undefined value\n";
1457 if ($value =~ m/[\n\r]/) {
1458 die "property contains a line feed\n";
1461 if ($type eq 'boolean') {
1462 return 1 if ($value eq '1') || ($value =~ m/^(on|yes|true)$/i);
1463 return 0 if ($value eq '0') || ($value =~ m/^(off|no|false)$/i);
1464 die "type check ('boolean') failed - got '$value'\n";
1465 } elsif ($type eq 'integer') {
1466 return int($1) if $value =~ m/^(\d+)$/;
1467 die "type check ('integer') failed - got '$value'\n";
1468 } elsif ($type eq 'number') {
1469 return $value if $value =~ m/^(\d+)(\.\d+)?$/;
1470 die "type check ('number') failed - got '$value'\n";
1471 } elsif ($type eq 'string') {
1472 if (my $fmt = $confdesc->{$key}->{format
}) {
1473 if ($fmt eq 'pve-qm-drive') {
1474 # special case - we need to pass $key to parse_drive()
1475 my $drive = parse_drive
($key, $value);
1476 return $value if $drive;
1477 die "unable to parse drive options\n";
1479 PVE
::JSONSchema
::check_format
($fmt, $value);
1482 $value =~ s/^\"(.*)\"$/$1/;
1485 die "internal error"
1489 sub lock_config_full
{
1490 my ($vmid, $timeout, $code, @param) = @_;
1492 my $filename = config_file_lock
($vmid);
1494 my $res = lock_file
($filename, $timeout, $code, @param);
1501 sub lock_config_mode
{
1502 my ($vmid, $timeout, $shared, $code, @param) = @_;
1504 my $filename = config_file_lock
($vmid);
1506 my $res = lock_file_full
($filename, $timeout, $shared, $code, @param);
1514 my ($vmid, $code, @param) = @_;
1516 return lock_config_full
($vmid, 10, $code, @param);
1519 sub cfs_config_path
{
1520 my ($vmid, $node) = @_;
1522 $node = $nodename if !$node;
1523 return "nodes/$node/qemu-server/$vmid.conf";
1526 sub check_iommu_support
{
1527 #fixme : need to check IOMMU support
1528 #http://www.linux-kvm.org/page/How_to_assign_devices_with_VT-d_in_KVM
1536 my ($vmid, $node) = @_;
1538 my $cfspath = cfs_config_path
($vmid, $node);
1539 return "/etc/pve/$cfspath";
1542 sub config_file_lock
{
1545 return "$lock_dir/lock-$vmid.conf";
1551 my $conf = config_file
($vmid);
1552 utime undef, undef, $conf;
1556 my ($storecfg, $vmid, $keep_empty_config) = @_;
1558 my $conffile = config_file
($vmid);
1560 my $conf = load_config
($vmid);
1564 # only remove disks owned by this VM
1565 foreach_drive
($conf, sub {
1566 my ($ds, $drive) = @_;
1568 return if drive_is_cdrom
($drive);
1570 my $volid = $drive->{file
};
1572 return if !$volid || $volid =~ m
|^/|;
1574 my ($path, $owner) = PVE
::Storage
::path
($storecfg, $volid);
1575 return if !$path || !$owner || ($owner != $vmid);
1577 PVE
::Storage
::vdisk_free
($storecfg, $volid);
1580 if ($keep_empty_config) {
1581 PVE
::Tools
::file_set_contents
($conffile, "memory: 128\n");
1586 # also remove unused disk
1588 my $dl = PVE
::Storage
::vdisk_list
($storecfg, undef, $vmid);
1591 PVE
::Storage
::foreach_volid
($dl, sub {
1592 my ($volid, $sid, $volname, $d) = @_;
1593 PVE
::Storage
::vdisk_free
($storecfg, $volid);
1603 my ($vmid, $node) = @_;
1605 my $cfspath = cfs_config_path
($vmid, $node);
1607 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath);
1609 die "no such VM ('$vmid')\n" if !defined($conf);
1614 sub parse_vm_config
{
1615 my ($filename, $raw) = @_;
1617 return undef if !defined($raw);
1620 digest
=> Digest
::SHA
::sha1_hex
($raw),
1624 $filename =~ m
|/qemu-server/(\d
+)\
.conf
$|
1625 || die "got strange filename '$filename'";
1632 my @lines = split(/\n/, $raw);
1633 foreach my $line (@lines) {
1634 next if $line =~ m/^\s*$/;
1636 if ($line =~ m/^\[([a-z][a-z0-9_\-]+)\]\s*$/i) {
1638 $conf->{description
} = $descr if $descr;
1640 $conf = $res->{snapshots
}->{$snapname} = {};
1644 if ($line =~ m/^\#(.*)\s*$/) {
1645 $descr .= PVE
::Tools
::decode_text
($1) . "\n";
1649 if ($line =~ m/^(description):\s*(.*\S)\s*$/) {
1650 $descr .= PVE
::Tools
::decode_text
($2);
1651 } elsif ($line =~ m/snapstate:\s*(prepare|delete)\s*$/) {
1652 $conf->{snapstate
} = $1;
1653 } elsif ($line =~ m/^(args):\s*(.*\S)\s*$/) {
1656 $conf->{$key} = $value;
1657 } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/) {
1660 eval { $value = check_type
($key, $value); };
1662 warn "vm $vmid - unable to parse value of '$key' - $@";
1664 my $fmt = $confdesc->{$key}->{format
};
1665 if ($fmt && $fmt eq 'pve-qm-drive') {
1666 my $v = parse_drive
($key, $value);
1667 if (my $volid = filename_to_volume_id
($vmid, $v->{file
}, $v->{media
})) {
1668 $v->{file
} = $volid;
1669 $value = print_drive
($vmid, $v);
1671 warn "vm $vmid - unable to parse value of '$key'\n";
1676 if ($key eq 'cdrom') {
1677 $conf->{ide2
} = $value;
1679 $conf->{$key} = $value;
1685 $conf->{description
} = $descr if $descr;
1687 delete $res->{snapstate
}; # just to be sure
1692 sub write_vm_config
{
1693 my ($filename, $conf) = @_;
1695 delete $conf->{snapstate
}; # just to be sure
1697 if ($conf->{cdrom
}) {
1698 die "option ide2 conflicts with cdrom\n" if $conf->{ide2
};
1699 $conf->{ide2
} = $conf->{cdrom
};
1700 delete $conf->{cdrom
};
1703 # we do not use 'smp' any longer
1704 if ($conf->{sockets
}) {
1705 delete $conf->{smp
};
1706 } elsif ($conf->{smp
}) {
1707 $conf->{sockets
} = $conf->{smp
};
1708 delete $conf->{cores
};
1709 delete $conf->{smp
};
1712 my $used_volids = {};
1714 my $cleanup_config = sub {
1715 my ($cref, $snapname) = @_;
1717 foreach my $key (keys %$cref) {
1718 next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots' ||
1719 $key eq 'snapstate';
1720 my $value = $cref->{$key};
1721 eval { $value = check_type
($key, $value); };
1722 die "unable to parse value of '$key' - $@" if $@;
1724 $cref->{$key} = $value;
1726 if (!$snapname && valid_drivename
($key)) {
1727 my $drive = parse_drive
($key, $value);
1728 $used_volids->{$drive->{file
}} = 1 if $drive && $drive->{file
};
1733 &$cleanup_config($conf);
1734 foreach my $snapname (keys %{$conf->{snapshots
}}) {
1735 &$cleanup_config($conf->{snapshots
}->{$snapname}, $snapname);
1738 # remove 'unusedX' settings if we re-add a volume
1739 foreach my $key (keys %$conf) {
1740 my $value = $conf->{$key};
1741 if ($key =~ m/^unused/ && $used_volids->{$value}) {
1742 delete $conf->{$key};
1746 my $generate_raw_config = sub {
1751 # add description as comment to top of file
1752 my $descr = $conf->{description
} || '';
1753 foreach my $cl (split(/\n/, $descr)) {
1754 $raw .= '#' . PVE
::Tools
::encode_text
($cl) . "\n";
1757 foreach my $key (sort keys %$conf) {
1758 next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots';
1759 $raw .= "$key: $conf->{$key}\n";
1764 my $raw = &$generate_raw_config($conf);
1765 foreach my $snapname (sort keys %{$conf->{snapshots
}}) {
1766 $raw .= "\n[$snapname]\n";
1767 $raw .= &$generate_raw_config($conf->{snapshots
}->{$snapname});
1773 sub update_config_nolock
{
1774 my ($vmid, $conf, $skiplock) = @_;
1776 check_lock
($conf) if !$skiplock;
1778 my $cfspath = cfs_config_path
($vmid);
1780 PVE
::Cluster
::cfs_write_file
($cfspath, $conf);
1784 my ($vmid, $conf, $skiplock) = @_;
1786 lock_config
($vmid, &update_config_nolock
, $conf, $skiplock);
1793 # we use static defaults from our JSON schema configuration
1794 foreach my $key (keys %$confdesc) {
1795 if (defined(my $default = $confdesc->{$key}->{default})) {
1796 $res->{$key} = $default;
1800 my $conf = PVE
::Cluster
::cfs_read_file
('datacenter.cfg');
1801 $res->{keyboard
} = $conf->{keyboard
} if $conf->{keyboard
};
1807 my $vmlist = PVE
::Cluster
::get_vmlist
();
1809 return $res if !$vmlist || !$vmlist->{ids
};
1810 my $ids = $vmlist->{ids
};
1812 foreach my $vmid (keys %$ids) {
1813 my $d = $ids->{$vmid};
1814 next if !$d->{node
} || $d->{node
} ne $nodename;
1815 next if !$d->{type
} || $d->{type
} ne 'qemu';
1816 $res->{$vmid}->{exists} = 1;
1821 # test if VM uses local resources (to prevent migration)
1822 sub check_local_resources
{
1823 my ($conf, $noerr) = @_;
1827 $loc_res = 1 if $conf->{hostusb
}; # old syntax
1828 $loc_res = 1 if $conf->{hostpci
}; # old syntax
1830 foreach my $k (keys %$conf) {
1831 $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/;
1834 die "VM uses local resources\n" if $loc_res && !$noerr;
1839 # check if used storages are available on all nodes (use by migrate)
1840 sub check_storage_availability
{
1841 my ($storecfg, $conf, $node) = @_;
1843 foreach_drive
($conf, sub {
1844 my ($ds, $drive) = @_;
1846 my $volid = $drive->{file
};
1849 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
1852 # check if storage is available on both nodes
1853 my $scfg = PVE
::Storage
::storage_check_node
($storecfg, $sid);
1854 PVE
::Storage
::storage_check_node
($storecfg, $sid, $node);
1858 # list nodes where all VM images are available (used by has_feature API)
1860 my ($conf, $storecfg) = @_;
1862 my $nodelist = PVE
::Cluster
::get_nodelist
();
1863 my $nodehash = { map { $_ => 1 } @$nodelist };
1864 my $nodename = PVE
::INotify
::nodename
();
1866 foreach_drive
($conf, sub {
1867 my ($ds, $drive) = @_;
1869 my $volid = $drive->{file
};
1872 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
1874 my $scfg = PVE
::Storage
::storage_config
($storecfg, $storeid);
1875 if ($scfg->{disable
}) {
1877 } elsif (my $avail = $scfg->{nodes
}) {
1878 foreach my $node (keys %$nodehash) {
1879 delete $nodehash->{$node} if !$avail->{$node};
1881 } elsif (!$scfg->{shared
}) {
1882 foreach my $node (keys %$nodehash) {
1883 delete $nodehash->{$node} if $node ne $nodename
1895 die "VM is locked ($conf->{lock})\n" if $conf->{lock};
1899 my ($pidfile, $pid) = @_;
1901 my $fh = IO
::File-
>new("/proc/$pid/cmdline", "r");
1905 return undef if !$line;
1906 my @param = split(/\0/, $line);
1908 my $cmd = $param[0];
1909 return if !$cmd || ($cmd !~ m
|kvm
$| && $cmd !~ m
|qemu-system-x86_64
$|);
1911 for (my $i = 0; $i < scalar (@param); $i++) {
1914 if (($p eq '-pidfile') || ($p eq '--pidfile')) {
1915 my $p = $param[$i+1];
1916 return 1 if $p && ($p eq $pidfile);
1925 my ($vmid, $nocheck, $node) = @_;
1927 my $filename = config_file
($vmid, $node);
1929 die "unable to find configuration file for VM $vmid - no such machine\n"
1930 if !$nocheck && ! -f
$filename;
1932 my $pidfile = pidfile_name
($vmid);
1934 if (my $fd = IO
::File-
>new("<$pidfile")) {
1939 my $mtime = $st->mtime;
1940 if ($mtime > time()) {
1941 warn "file '$filename' modified in future\n";
1944 if ($line =~ m/^(\d+)$/) {
1946 if (check_cmdline
($pidfile, $pid)) {
1947 if (my $pinfo = PVE
::ProcFSTools
::check_process_running
($pid)) {
1959 my $vzlist = config_list
();
1961 my $fd = IO
::Dir-
>new($var_run_tmpdir) || return $vzlist;
1963 while (defined(my $de = $fd->read)) {
1964 next if $de !~ m/^(\d+)\.pid$/;
1966 next if !defined($vzlist->{$vmid});
1967 if (my $pid = check_running
($vmid)) {
1968 $vzlist->{$vmid}->{pid
} = $pid;
1976 my ($storecfg, $conf) = @_;
1978 my $bootdisk = $conf->{bootdisk
};
1979 return undef if !$bootdisk;
1980 return undef if !valid_drivename
($bootdisk);
1982 return undef if !$conf->{$bootdisk};
1984 my $drive = parse_drive
($bootdisk, $conf->{$bootdisk});
1985 return undef if !defined($drive);
1987 return undef if drive_is_cdrom
($drive);
1989 my $volid = $drive->{file
};
1990 return undef if !$volid;
1992 return $drive->{size
};
1995 my $last_proc_pid_stat;
1997 # get VM status information
1998 # This must be fast and should not block ($full == false)
1999 # We only query KVM using QMP if $full == true (this can be slow)
2001 my ($opt_vmid, $full) = @_;
2005 my $storecfg = PVE
::Storage
::config
();
2007 my $list = vzlist
();
2008 my ($uptime) = PVE
::ProcFSTools
::read_proc_uptime
(1);
2010 my $cpucount = $cpuinfo->{cpus
} || 1;
2012 foreach my $vmid (keys %$list) {
2013 next if $opt_vmid && ($vmid ne $opt_vmid);
2015 my $cfspath = cfs_config_path
($vmid);
2016 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath) || {};
2019 $d->{pid
} = $list->{$vmid}->{pid
};
2021 # fixme: better status?
2022 $d->{status
} = $list->{$vmid}->{pid
} ?
'running' : 'stopped';
2024 my $size = disksize
($storecfg, $conf);
2025 if (defined($size)) {
2026 $d->{disk
} = 0; # no info available
2027 $d->{maxdisk
} = $size;
2033 $d->{cpus
} = ($conf->{sockets
} || 1) * ($conf->{cores
} || 1);
2034 $d->{cpus
} = $cpucount if $d->{cpus
} > $cpucount;
2036 $d->{name
} = $conf->{name
} || "VM $vmid";
2037 $d->{maxmem
} = $conf->{memory
} ?
$conf->{memory
}*(1024*1024) : 0;
2039 if ($conf->{balloon
}) {
2040 $d->{balloon_min
} = $conf->{balloon
}*(1024*1024);
2041 $d->{shares
} = defined($conf->{shares
}) ?
$conf->{shares
} : 1000;
2052 $d->{diskwrite
} = 0;
2054 $d->{template
} = is_template
($conf);
2059 my $netdev = PVE
::ProcFSTools
::read_proc_net_dev
();
2060 foreach my $dev (keys %$netdev) {
2061 next if $dev !~ m/^tap([1-9]\d*)i/;
2063 my $d = $res->{$vmid};
2066 $d->{netout
} += $netdev->{$dev}->{receive
};
2067 $d->{netin
} += $netdev->{$dev}->{transmit
};
2070 my $ctime = gettimeofday
;
2072 foreach my $vmid (keys %$list) {
2074 my $d = $res->{$vmid};
2075 my $pid = $d->{pid
};
2078 my $pstat = PVE
::ProcFSTools
::read_proc_pid_stat
($pid);
2079 next if !$pstat; # not running
2081 my $used = $pstat->{utime} + $pstat->{stime
};
2083 $d->{uptime
} = int(($uptime - $pstat->{starttime
})/$cpuinfo->{user_hz
});
2085 if ($pstat->{vsize
}) {
2086 $d->{mem
} = int(($pstat->{rss
}/$pstat->{vsize
})*$d->{maxmem
});
2089 my $old = $last_proc_pid_stat->{$pid};
2091 $last_proc_pid_stat->{$pid} = {
2099 my $dtime = ($ctime - $old->{time}) * $cpucount * $cpuinfo->{user_hz
};
2101 if ($dtime > 1000) {
2102 my $dutime = $used - $old->{used
};
2104 $d->{cpu
} = (($dutime/$dtime)* $cpucount) / $d->{cpus
};
2105 $last_proc_pid_stat->{$pid} = {
2111 $d->{cpu
} = $old->{cpu
};
2115 return $res if !$full;
2117 my $qmpclient = PVE
::QMPClient-
>new();
2119 my $ballooncb = sub {
2120 my ($vmid, $resp) = @_;
2122 my $info = $resp->{'return'};
2123 return if !$info->{max_mem
};
2125 my $d = $res->{$vmid};
2127 # use memory assigned to VM
2128 $d->{maxmem
} = $info->{max_mem
};
2129 $d->{balloon
} = $info->{actual
};
2131 if (defined($info->{total_mem
}) && defined($info->{free_mem
})) {
2132 $d->{mem
} = $info->{total_mem
} - $info->{free_mem
};
2133 $d->{freemem
} = $info->{free_mem
};
2138 my $blockstatscb = sub {
2139 my ($vmid, $resp) = @_;
2140 my $data = $resp->{'return'} || [];
2141 my $totalrdbytes = 0;
2142 my $totalwrbytes = 0;
2143 for my $blockstat (@$data) {
2144 $totalrdbytes = $totalrdbytes + $blockstat->{stats
}->{rd_bytes
};
2145 $totalwrbytes = $totalwrbytes + $blockstat->{stats
}->{wr_bytes
};
2147 $res->{$vmid}->{diskread
} = $totalrdbytes;
2148 $res->{$vmid}->{diskwrite
} = $totalwrbytes;
2151 my $statuscb = sub {
2152 my ($vmid, $resp) = @_;
2154 $qmpclient->queue_cmd($vmid, $blockstatscb, 'query-blockstats');
2155 # this fails if ballon driver is not loaded, so this must be
2156 # the last commnand (following command are aborted if this fails).
2157 $qmpclient->queue_cmd($vmid, $ballooncb, 'query-balloon');
2159 my $status = 'unknown';
2160 if (!defined($status = $resp->{'return'}->{status
})) {
2161 warn "unable to get VM status\n";
2165 $res->{$vmid}->{qmpstatus
} = $resp->{'return'}->{status
};
2168 foreach my $vmid (keys %$list) {
2169 next if $opt_vmid && ($vmid ne $opt_vmid);
2170 next if !$res->{$vmid}->{pid
}; # not running
2171 $qmpclient->queue_cmd($vmid, $statuscb, 'query-status');
2174 $qmpclient->queue_execute();
2176 foreach my $vmid (keys %$list) {
2177 next if $opt_vmid && ($vmid ne $opt_vmid);
2178 $res->{$vmid}->{qmpstatus
} = $res->{$vmid}->{status
} if !$res->{$vmid}->{qmpstatus
};
2185 my ($conf, $func) = @_;
2187 foreach my $ds (keys %$conf) {
2188 next if !valid_drivename
($ds);
2190 my $drive = parse_drive
($ds, $conf->{$ds});
2193 &$func($ds, $drive);
2198 my ($conf, $func) = @_;
2202 my $test_volid = sub {
2203 my ($volid, $is_cdrom) = @_;
2207 $volhash->{$volid} = $is_cdrom || 0;
2210 foreach_drive
($conf, sub {
2211 my ($ds, $drive) = @_;
2212 &$test_volid($drive->{file
}, drive_is_cdrom
($drive));
2215 foreach my $snapname (keys %{$conf->{snapshots
}}) {
2216 my $snap = $conf->{snapshots
}->{$snapname};
2217 &$test_volid($snap->{vmstate
}, 0);
2218 foreach_drive
($snap, sub {
2219 my ($ds, $drive) = @_;
2220 &$test_volid($drive->{file
}, drive_is_cdrom
($drive));
2224 foreach my $volid (keys %$volhash) {
2225 &$func($volid, $volhash->{$volid});
2229 sub config_to_command
{
2230 my ($storecfg, $vmid, $conf, $defaults, $forcemachine) = @_;
2233 my $globalFlags = [];
2234 my $machineFlags = [];
2240 my $kvmver = kvm_user_version
();
2241 my $vernum = 0; # unknown
2242 if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
2243 $vernum = $1*1000000+$2*1000;
2244 } elsif ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
2245 $vernum = $1*1000000+$2*1000+$3;
2248 die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 15000;
2250 my $have_ovz = -f
'/proc/vz/vestat';
2252 push @$cmd, '/usr/bin/kvm';
2254 push @$cmd, '-id', $vmid;
2258 my $qmpsocket = qmp_socket
($vmid);
2259 push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
2260 push @$cmd, '-mon', "chardev=qmp,mode=control";
2262 my $socket = vnc_socket
($vmid);
2263 push @$cmd, '-vnc', "unix:$socket,x509,password";
2265 push @$cmd, '-pidfile' , pidfile_name
($vmid);
2267 push @$cmd, '-daemonize';
2269 $pciaddr = print_pci_addr
("piix3", $bridges);
2270 push @$devices, '-device', "piix3-usb-uhci,id=uhci$pciaddr.0x2";
2273 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2274 next if !$conf->{"usb$i"};
2277 # include usb device config
2278 push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
2280 # enable absolute mouse coordinates (needed by vnc)
2281 my $tablet = defined($conf->{tablet
}) ?
$conf->{tablet
} : $defaults->{tablet
};
2282 push @$devices, '-device', 'usb-tablet,id=tablet,bus=uhci.0,port=1' if $tablet;
2285 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
2286 my $d = parse_hostpci
($conf->{"hostpci$i"});
2288 $pciaddr = print_pci_addr
("hostpci$i", $bridges);
2289 push @$devices, '-device', "pci-assign,host=$d->{pciid},id=hostpci$i$pciaddr";
2293 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2294 my $d = parse_usb_device
($conf->{"usb$i"});
2296 if ($d->{vendorid
} && $d->{productid
}) {
2297 push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2298 } elsif (defined($d->{hostbus
}) && defined($d->{hostport
})) {
2299 push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2304 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
2305 if (my $path = $conf->{"serial$i"}) {
2306 die "no such serial device\n" if ! -c
$path;
2307 push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2308 push @$devices, '-device', "isa-serial,chardev=serial$i";
2313 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
2314 if (my $path = $conf->{"parallel$i"}) {
2315 die "no such parallel device\n" if ! -c
$path;
2316 push @$devices, '-chardev', "parport,id=parallel$i,path=$path";
2317 push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2321 my $vmname = $conf->{name
} || "vm$vmid";
2323 push @$cmd, '-name', $vmname;
2326 $sockets = $conf->{smp
} if $conf->{smp
}; # old style - no longer iused
2327 $sockets = $conf->{sockets
} if $conf->{sockets
};
2329 my $cores = $conf->{cores
} || 1;
2330 push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2332 push @$cmd, '-nodefaults';
2334 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
2336 my $bootindex_hash = {};
2338 foreach my $o (split(//, $bootorder)) {
2339 $bootindex_hash->{$o} = $i*100;
2343 push @$cmd, '-boot', "menu=on";
2345 push @$cmd, '-no-acpi' if defined($conf->{acpi
}) && $conf->{acpi
} == 0;
2347 push @$cmd, '-no-reboot' if defined($conf->{reboot
}) && $conf->{reboot
} == 0;
2349 my $vga = $conf->{vga
};
2351 if ($conf->{ostype
} && ($conf->{ostype
} eq 'win8' || $conf->{ostype
} eq 'win7' || $conf->{ostype
} eq 'w2k8')) {
2358 push @$cmd, '-vga', $vga if $vga; # for kvm 77 and later
2361 my $tdf = defined($conf->{tdf
}) ?
$conf->{tdf
} : $defaults->{tdf
};
2363 my $nokvm = defined($conf->{kvm
}) && $conf->{kvm
} == 0 ?
1 : 0;
2364 my $useLocaltime = $conf->{localtime};
2366 if (my $ost = $conf->{ostype
}) {
2367 # other, wxp, w2k, w2k3, w2k8, wvista, win7, win8, l24, l26
2369 if ($ost =~ m/^w/) { # windows
2370 $useLocaltime = 1 if !defined($conf->{localtime});
2372 # use time drift fix when acpi is enabled
2373 if (!(defined($conf->{acpi
}) && $conf->{acpi
} == 0)) {
2374 $tdf = 1 if !defined($conf->{tdf
});
2378 if ($ost eq 'win7' || $ost eq 'win8' || $ost eq 'w2k8' ||
2380 push @$globalFlags, 'kvm-pit.lost_tick_policy=discard';
2381 push @$cmd, '-no-hpet';
2382 #push @$cpuFlags , 'hv_vapic" if !$nokvm; #fixme, my win2008R2 hang at boot with this
2383 push @$cpuFlags , 'hv_spinlocks=0xffff' if !$nokvm;
2386 if ($ost eq 'win7' || $ost eq 'win8') {
2387 push @$cpuFlags , 'hv_relaxed' if !$nokvm;
2391 push @$rtcFlags, 'driftfix=slew' if $tdf;
2394 push @$machineFlags, 'accel=tcg';
2396 die "No accelerator found!\n" if !$cpuinfo->{hvm
};
2399 my $machine_type = $forcemachine || $conf->{machine
};
2400 if ($machine_type) {
2401 push @$machineFlags, "type=${machine_type}";
2404 if ($conf->{startdate
}) {
2405 push @$rtcFlags, "base=$conf->{startdate}";
2406 } elsif ($useLocaltime) {
2407 push @$rtcFlags, 'base=localtime';
2410 my $cpu = $nokvm ?
"qemu64" : "kvm64";
2411 $cpu = $conf->{cpu
} if $conf->{cpu
};
2413 push @$cpuFlags , '+x2apic' if !$nokvm;
2415 push @$cpuFlags, '+sep' if $cpu eq 'kvm64' || $cpu eq 'kvm32';
2417 $cpu .= "," . join(',', @$cpuFlags) if scalar(@$cpuFlags);
2419 push @$cmd, '-cpu', $cpu;
2421 push @$cmd, '-S' if $conf->{freeze
};
2423 # set keyboard layout
2424 my $kb = $conf->{keyboard
} || $defaults->{keyboard
};
2425 push @$cmd, '-k', $kb if $kb;
2428 #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2429 #push @$cmd, '-soundhw', 'es1370';
2430 #push @$cmd, '-soundhw', $soundhw if $soundhw;
2432 if($conf->{agent
}) {
2433 my $qgasocket = qga_socket
($vmid);
2434 my $pciaddr = print_pci_addr
("qga0", $bridges);
2435 push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
2436 push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
2437 push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
2440 if ($vga eq 'qxl') {
2441 my $pciaddr = print_pci_addr
("spice", $bridges);
2443 my $x509 = "x509-key-file=/etc/pve/local/pve-ssl.key" .
2444 ",x509-cert-file=/etc/pve/local/pve-ssl.pem" .
2445 ",x509-cacert-file=/etc/pve/pve-root-ca.pem";
2447 my $port = PVE
::Tools
::next_unused_port
(61000, 61099);
2449 push @$cmd, '-spice', "tls-port=$port,addr=127.0.0.1,$x509,tls-ciphers=DES-CBC3-SHA";
2452 push @$cmd, '-device', "virtio-serial,id=spice$pciaddr";
2453 push @$cmd, '-chardev', "spicevmc,id=vdagent,name=vdagent";
2454 push @$cmd, '-device', "virtserialport,chardev=vdagent,name=com.redhat.spice.0";
2457 # enable balloon by default, unless explicitly disabled
2458 if (!defined($conf->{balloon
}) || $conf->{balloon
}) {
2459 $pciaddr = print_pci_addr
("balloon0", $bridges);
2460 push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr";
2463 if ($conf->{watchdog
}) {
2464 my $wdopts = parse_watchdog
($conf->{watchdog
});
2465 $pciaddr = print_pci_addr
("watchdog", $bridges);
2466 my $watchdog = $wdopts->{model
} || 'i6300esb';
2467 push @$devices, '-device', "$watchdog$pciaddr";
2468 push @$devices, '-watchdog-action', $wdopts->{action
} if $wdopts->{action
};
2472 my $scsicontroller = {};
2473 my $ahcicontroller = {};
2474 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : $defaults->{scsihw
};
2476 foreach_drive
($conf, sub {
2477 my ($ds, $drive) = @_;
2479 if (PVE
::Storage
::parse_volume_id
($drive->{file
}, 1)) {
2480 push @$vollist, $drive->{file
};
2483 $use_virtio = 1 if $ds =~ m/^virtio/;
2485 if (drive_is_cdrom
($drive)) {
2486 if ($bootindex_hash->{d
}) {
2487 $drive->{bootindex
} = $bootindex_hash->{d
};
2488 $bootindex_hash->{d
} += 1;
2491 if ($bootindex_hash->{c
}) {
2492 $drive->{bootindex
} = $bootindex_hash->{c
} if $conf->{bootdisk
} && ($conf->{bootdisk
} eq $ds);
2493 $bootindex_hash->{c
} += 1;
2497 if ($drive->{interface
} eq 'scsi') {
2499 my $maxdev = ($scsihw ne 'lsi') ?
256 : 7;
2500 my $controller = int($drive->{index} / $maxdev);
2501 $pciaddr = print_pci_addr
("scsihw$controller", $bridges);
2502 push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
2503 $scsicontroller->{$controller}=1;
2506 if ($drive->{interface
} eq 'sata') {
2507 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
2508 $pciaddr = print_pci_addr
("ahci$controller", $bridges);
2509 push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
2510 $ahcicontroller->{$controller}=1;
2513 push @$devices, '-drive',print_drive_full
($storecfg, $vmid, $drive);
2514 push @$devices, '-device',print_drivedevice_full
($storecfg, $conf, $vmid, $drive, $bridges);
2517 push @$cmd, '-m', $conf->{memory
} || $defaults->{memory
};
2519 for (my $i = 0; $i < $MAX_NETS; $i++) {
2520 next if !$conf->{"net$i"};
2521 my $d = parse_net
($conf->{"net$i"});
2524 $use_virtio = 1 if $d->{model
} eq 'virtio';
2526 if ($bootindex_hash->{n
}) {
2527 $d->{bootindex
} = $bootindex_hash->{n
};
2528 $bootindex_hash->{n
} += 1;
2531 my $netdevfull = print_netdev_full
($vmid,$conf,$d,"net$i");
2532 push @$devices, '-netdev', $netdevfull;
2534 my $netdevicefull = print_netdevice_full
($vmid,$conf,$d,"net$i",$bridges);
2535 push @$devices, '-device', $netdevicefull;
2539 while (my ($k, $v) = each %$bridges) {
2540 $pciaddr = print_pci_addr
("pci.$k");
2541 unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
2545 # hack: virtio with fairsched is unreliable, so we do not use fairsched
2546 # when the VM uses virtio devices.
2547 if (!$use_virtio && $have_ovz) {
2549 my $cpuunits = defined($conf->{cpuunits
}) ?
2550 $conf->{cpuunits
} : $defaults->{cpuunits
};
2552 push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
2554 # fixme: cpulimit is currently ignored
2555 #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2559 if ($conf->{args
}) {
2560 my $aa = PVE
::Tools
::split_args
($conf->{args
});
2564 push @$cmd, @$devices;
2565 push @$cmd, '-rtc', join(',', @$rtcFlags)
2566 if scalar(@$rtcFlags);
2567 push @$cmd, '-machine', join(',', @$machineFlags)
2568 if scalar(@$machineFlags);
2569 push @$cmd, '-global', join(',', @$globalFlags)
2570 if scalar(@$globalFlags);
2572 return wantarray ?
($cmd, $vollist) : $cmd;
2577 return "${var_run_tmpdir}/$vmid.vnc";
2583 my $res = vm_mon_cmd
($vmid, 'query-spice');
2585 return $res->{'tls-port'} || $res->{'port'} || die "no spice port\n";
2590 return "${var_run_tmpdir}/$vmid.qmp";
2595 return "${var_run_tmpdir}/$vmid.qga";
2600 return "${var_run_tmpdir}/$vmid.pid";
2603 sub vm_devices_list
{
2606 my $res = vm_mon_cmd
($vmid, 'query-pci');
2609 foreach my $pcibus (@$res) {
2610 foreach my $device (@{$pcibus->{devices
}}) {
2611 next if !$device->{'qdev_id'};
2612 $devices->{$device->{'qdev_id'}} = $device;
2620 my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2622 return 1 if !check_running
($vmid);
2624 if ($deviceid eq 'tablet') {
2625 my $devicefull = "usb-tablet,id=tablet,bus=uhci.0,port=1";
2626 qemu_deviceadd
($vmid, $devicefull);
2630 return 1 if !$conf->{hotplug
};
2632 my $devices_list = vm_devices_list
($vmid);
2633 return 1 if defined($devices_list->{$deviceid});
2635 qemu_bridgeadd
($storecfg, $conf, $vmid, $deviceid); #add bridge if we need it for the device
2637 if ($deviceid =~ m/^(virtio)(\d+)$/) {
2638 return undef if !qemu_driveadd
($storecfg, $vmid, $device);
2639 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
2640 qemu_deviceadd
($vmid, $devicefull);
2641 if(!qemu_deviceaddverify
($vmid, $deviceid)) {
2642 qemu_drivedel
($vmid, $deviceid);
2647 if ($deviceid =~ m/^(scsihw)(\d+)$/) {
2648 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : "lsi";
2649 my $pciaddr = print_pci_addr
($deviceid);
2650 my $devicefull = "$scsihw,id=$deviceid$pciaddr";
2651 qemu_deviceadd
($vmid, $devicefull);
2652 return undef if(!qemu_deviceaddverify
($vmid, $deviceid));
2655 if ($deviceid =~ m/^(scsi)(\d+)$/) {
2656 return 1 if ($conf->{scsihw
} && $conf->{scsihw
} ne 'lsi'); #virtio-scsi not yet support hotplug
2657 return undef if !qemu_findorcreatescsihw
($storecfg,$conf, $vmid, $device);
2658 return undef if !qemu_driveadd
($storecfg, $vmid, $device);
2659 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
2660 if(!qemu_deviceadd
($vmid, $devicefull)) {
2661 qemu_drivedel
($vmid, $deviceid);
2666 if ($deviceid =~ m/^(net)(\d+)$/) {
2667 return undef if !qemu_netdevadd
($vmid, $conf, $device, $deviceid);
2668 my $netdevicefull = print_netdevice_full
($vmid, $conf, $device, $deviceid);
2669 qemu_deviceadd
($vmid, $netdevicefull);
2670 if(!qemu_deviceaddverify
($vmid, $deviceid)) {
2671 qemu_netdevdel
($vmid, $deviceid);
2676 if ($deviceid =~ m/^(pci\.)(\d+)$/) {
2678 my $pciaddr = print_pci_addr
($deviceid);
2679 my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
2680 qemu_deviceadd
($vmid, $devicefull);
2681 return undef if !qemu_deviceaddverify
($vmid, $deviceid);
2687 sub vm_deviceunplug
{
2688 my ($vmid, $conf, $deviceid) = @_;
2690 return 1 if !check_running
($vmid);
2692 if ($deviceid eq 'tablet') {
2693 qemu_devicedel
($vmid, $deviceid);
2697 return 1 if !$conf->{hotplug
};
2699 my $devices_list = vm_devices_list
($vmid);
2700 return 1 if !defined($devices_list->{$deviceid});
2702 die "can't unplug bootdisk" if $conf->{bootdisk
} && $conf->{bootdisk
} eq $deviceid;
2704 if ($deviceid =~ m/^(virtio)(\d+)$/) {
2705 qemu_devicedel
($vmid, $deviceid);
2706 return undef if !qemu_devicedelverify
($vmid, $deviceid);
2707 return undef if !qemu_drivedel
($vmid, $deviceid);
2710 if ($deviceid =~ m/^(lsi)(\d+)$/) {
2711 return undef if !qemu_devicedel
($vmid, $deviceid);
2714 if ($deviceid =~ m/^(scsi)(\d+)$/) {
2715 return undef if !qemu_devicedel
($vmid, $deviceid);
2716 return undef if !qemu_drivedel
($vmid, $deviceid);
2719 if ($deviceid =~ m/^(net)(\d+)$/) {
2720 qemu_devicedel
($vmid, $deviceid);
2721 return undef if !qemu_devicedelverify
($vmid, $deviceid);
2722 return undef if !qemu_netdevdel
($vmid, $deviceid);
2728 sub qemu_deviceadd
{
2729 my ($vmid, $devicefull) = @_;
2731 $devicefull = "driver=".$devicefull;
2732 my %options = split(/[=,]/, $devicefull);
2734 vm_mon_cmd
($vmid, "device_add" , %options);
2738 sub qemu_devicedel
{
2739 my($vmid, $deviceid) = @_;
2740 my $ret = vm_mon_cmd
($vmid, "device_del", id
=> $deviceid);
2745 my($storecfg, $vmid, $device) = @_;
2747 my $drive = print_drive_full
($storecfg, $vmid, $device);
2748 my $ret = vm_human_monitor_command
($vmid, "drive_add auto $drive");
2749 # If the command succeeds qemu prints: "OK"
2750 if ($ret !~ m/OK/s) {
2751 syslog
("err", "adding drive failed: $ret");
2758 my($vmid, $deviceid) = @_;
2760 my $ret = vm_human_monitor_command
($vmid, "drive_del drive-$deviceid");
2762 if ($ret =~ m/Device \'.*?\' not found/s) {
2763 # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2765 elsif ($ret ne "") {
2766 syslog
("err", "deleting drive $deviceid failed : $ret");
2772 sub qemu_deviceaddverify
{
2773 my ($vmid,$deviceid) = @_;
2775 for (my $i = 0; $i <= 5; $i++) {
2776 my $devices_list = vm_devices_list
($vmid);
2777 return 1 if defined($devices_list->{$deviceid});
2780 syslog
("err", "error on hotplug device $deviceid");
2785 sub qemu_devicedelverify
{
2786 my ($vmid,$deviceid) = @_;
2788 #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2789 for (my $i = 0; $i <= 5; $i++) {
2790 my $devices_list = vm_devices_list
($vmid);
2791 return 1 if !defined($devices_list->{$deviceid});
2794 syslog
("err", "error on hot-unplugging device $deviceid");
2798 sub qemu_findorcreatescsihw
{
2799 my ($storecfg, $conf, $vmid, $device) = @_;
2801 my $maxdev = ($conf->{scsihw
} && $conf->{scsihw
} ne 'lsi') ?
256 : 7;
2802 my $controller = int($device->{index} / $maxdev);
2803 my $scsihwid="scsihw$controller";
2804 my $devices_list = vm_devices_list
($vmid);
2806 if(!defined($devices_list->{$scsihwid})) {
2807 return undef if !vm_deviceplug
($storecfg, $conf, $vmid, $scsihwid);
2812 sub qemu_bridgeadd
{
2813 my ($storecfg, $conf, $vmid, $device) = @_;
2816 my $bridgeid = undef;
2817 print_pci_addr
($device, $bridges);
2819 while (my ($k, $v) = each %$bridges) {
2822 return if !$bridgeid || $bridgeid < 1;
2823 my $bridge = "pci.$bridgeid";
2824 my $devices_list = vm_devices_list
($vmid);
2826 if(!defined($devices_list->{$bridge})) {
2827 return undef if !vm_deviceplug
($storecfg, $conf, $vmid, $bridge);
2832 sub qemu_netdevadd
{
2833 my ($vmid, $conf, $device, $deviceid) = @_;
2835 my $netdev = print_netdev_full
($vmid, $conf, $device, $deviceid);
2836 my %options = split(/[=,]/, $netdev);
2838 vm_mon_cmd
($vmid, "netdev_add", %options);
2842 sub qemu_netdevdel
{
2843 my ($vmid, $deviceid) = @_;
2845 vm_mon_cmd
($vmid, "netdev_del", id
=> $deviceid);
2849 sub qemu_block_set_io_throttle
{
2850 my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
2852 return if !check_running
($vmid) ;
2854 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));
2858 # old code, only used to shutdown old VM after update
2860 my ($fh, $timeout) = @_;
2862 my $sel = new IO
::Select
;
2869 while (scalar (@ready = $sel->can_read($timeout))) {
2871 if ($count = $fh->sysread($buf, 8192)) {
2872 if ($buf =~ /^(.*)\(qemu\) $/s) {
2879 if (!defined($count)) {
2886 die "monitor read timeout\n" if !scalar(@ready);
2891 # old code, only used to shutdown old VM after update
2892 sub vm_monitor_command
{
2893 my ($vmid, $cmdstr, $nocheck) = @_;
2898 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
2900 my $sname = "${var_run_tmpdir}/$vmid.mon";
2902 my $sock = IO
::Socket
::UNIX-
>new( Peer
=> $sname ) ||
2903 die "unable to connect to VM $vmid socket - $!\n";
2907 # hack: migrate sometime blocks the monitor (when migrate_downtime
2909 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2910 $timeout = 60*60; # 1 hour
2914 my $data = __read_avail
($sock, $timeout);
2916 if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
2917 die "got unexpected qemu monitor banner\n";
2920 my $sel = new IO
::Select
;
2923 if (!scalar(my @ready = $sel->can_write($timeout))) {
2924 die "monitor write error - timeout";
2927 my $fullcmd = "$cmdstr\r";
2929 # syslog('info', "VM $vmid monitor command: $cmdstr");
2932 if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
2933 die "monitor write error - $!";
2936 return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
2940 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2941 $timeout = 60*60; # 1 hour
2942 } elsif ($cmdstr =~ m/^(eject|change)/) {
2943 $timeout = 60; # note: cdrom mount command is slow
2945 if ($res = __read_avail
($sock, $timeout)) {
2947 my @lines = split("\r?\n", $res);
2949 shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
2951 $res = join("\n", @lines);
2959 syslog
("err", "VM $vmid monitor command failed - $err");
2966 sub qemu_block_resize
{
2967 my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
2969 my $running = check_running
($vmid);
2971 return if !PVE
::Storage
::volume_resize
($storecfg, $volid, $size, $running);
2973 return if !$running;
2975 vm_mon_cmd
($vmid, "block_resize", device
=> $deviceid, size
=> int($size));
2979 sub qemu_volume_snapshot
{
2980 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
2982 my $running = check_running
($vmid);
2984 return if !PVE
::Storage
::volume_snapshot
($storecfg, $volid, $snap, $running);
2986 return if !$running;
2988 vm_mon_cmd
($vmid, "snapshot-drive", device
=> $deviceid, name
=> $snap);
2992 sub qemu_volume_snapshot_delete
{
2993 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
2995 my $running = check_running
($vmid);
2997 return if !PVE
::Storage
::volume_snapshot_delete
($storecfg, $volid, $snap, $running);
2999 return if !$running;
3001 vm_mon_cmd
($vmid, "delete-drive-snapshot", device
=> $deviceid, name
=> $snap);
3007 #need to impplement call to qemu-ga
3010 sub qga_unfreezefs
{
3013 #need to impplement call to qemu-ga
3017 my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused, $forcemachine) = @_;
3019 lock_config
($vmid, sub {
3020 my $conf = load_config
($vmid, $migratedfrom);
3022 die "you can't start a vm if it's a template\n" if is_template
($conf);
3024 check_lock
($conf) if !$skiplock;
3026 die "VM $vmid already running\n" if check_running
($vmid, undef, $migratedfrom);
3028 my $defaults = load_defaults
();
3030 # set environment variable useful inside network script
3031 $ENV{PVE_MIGRATED_FROM
} = $migratedfrom if $migratedfrom;
3033 my ($cmd, $vollist) = config_to_command
($storecfg, $vmid, $conf, $defaults, $forcemachine);
3035 my $migrate_port = 0;
3038 if ($statefile eq 'tcp') {
3039 $migrate_port = PVE
::Tools
::next_migrate_port
();
3040 my $migrate_uri = "tcp:localhost:${migrate_port}";
3041 push @$cmd, '-incoming', $migrate_uri;
3044 push @$cmd, '-loadstate', $statefile;
3051 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
3052 my $d = parse_hostpci
($conf->{"hostpci$i"});
3054 my $info = pci_device_info
("0000:$d->{pciid}");
3055 die "IOMMU not present\n" if !check_iommu_support
();
3056 die "no pci device info for device '$d->{pciid}'\n" if !$info;
3057 die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub
($info);
3058 die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset
($info);
3061 PVE
::Storage
::activate_volumes
($storecfg, $vollist);
3063 eval { run_command
($cmd, timeout
=> $statefile ?
undef : 30,
3066 die "start failed: $err" if $err;
3068 print "migration listens on port $migrate_port\n" if $migrate_port;
3070 if ($statefile && $statefile ne 'tcp') {
3071 eval { vm_mon_cmd_nocheck
($vmid, "cont"); };
3076 my $capabilities = {};
3077 $capabilities->{capability
} = "xbzrle";
3078 $capabilities->{state} = JSON
::true
;
3079 eval { vm_mon_cmd_nocheck
($vmid, "migrate-set-capabilities", capabilities
=> [$capabilities]); };
3083 if (!$statefile && (!defined($conf->{balloon
}) || $conf->{balloon
})) {
3084 vm_mon_cmd_nocheck
($vmid, "balloon", value
=> $conf->{balloon
}*1024*1024)
3085 if $conf->{balloon
};
3086 vm_mon_cmd_nocheck
($vmid, 'qom-set',
3087 path
=> "machine/peripheral/balloon0",
3088 property
=> "guest-stats-polling-interval",
3096 my ($vmid, $execute, %params) = @_;
3098 my $cmd = { execute
=> $execute, arguments
=> \
%params };
3099 vm_qmp_command
($vmid, $cmd);
3102 sub vm_mon_cmd_nocheck
{
3103 my ($vmid, $execute, %params) = @_;
3105 my $cmd = { execute
=> $execute, arguments
=> \
%params };
3106 vm_qmp_command
($vmid, $cmd, 1);
3109 sub vm_qmp_command
{
3110 my ($vmid, $cmd, $nocheck) = @_;
3115 if ($cmd->{arguments
} && $cmd->{arguments
}->{timeout
}) {
3116 $timeout = $cmd->{arguments
}->{timeout
};
3117 delete $cmd->{arguments
}->{timeout
};
3121 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
3122 my $sname = qmp_socket
($vmid);
3124 my $qmpclient = PVE
::QMPClient-
>new();
3126 $res = $qmpclient->cmd($vmid, $cmd, $timeout);
3127 } elsif (-e
"${var_run_tmpdir}/$vmid.mon") {
3128 die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
3129 if scalar(%{$cmd->{arguments
}});
3130 vm_monitor_command
($vmid, $cmd->{execute
}, $nocheck);
3132 die "unable to open monitor socket\n";
3136 syslog
("err", "VM $vmid qmp command failed - $err");
3143 sub vm_human_monitor_command
{
3144 my ($vmid, $cmdline) = @_;
3149 execute
=> 'human-monitor-command',
3150 arguments
=> { 'command-line' => $cmdline},
3153 return vm_qmp_command
($vmid, $cmd);
3156 sub vm_commandline
{
3157 my ($storecfg, $vmid) = @_;
3159 my $conf = load_config
($vmid);
3161 my $defaults = load_defaults
();
3163 my $cmd = config_to_command
($storecfg, $vmid, $conf, $defaults);
3165 return join(' ', @$cmd);
3169 my ($vmid, $skiplock) = @_;
3171 lock_config
($vmid, sub {
3173 my $conf = load_config
($vmid);
3175 check_lock
($conf) if !$skiplock;
3177 vm_mon_cmd
($vmid, "system_reset");
3181 sub get_vm_volumes
{
3185 foreach_volid
($conf, sub {
3186 my ($volid, $is_cdrom) = @_;
3188 return if $volid =~ m
|^/|;
3190 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
3193 push @$vollist, $volid;
3199 sub vm_stop_cleanup
{
3200 my ($storecfg, $vmid, $conf, $keepActive) = @_;
3203 fairsched_rmnod
($vmid); # try to destroy group
3206 my $vollist = get_vm_volumes
($conf);
3207 PVE
::Storage
::deactivate_volumes
($storecfg, $vollist);
3210 foreach my $ext (qw(mon qmp pid vnc qga)) {
3211 unlink "/var/run/qemu-server/${vmid}.$ext";
3214 warn $@ if $@; # avoid errors - just warn
3217 # Note: use $nockeck to skip tests if VM configuration file exists.
3218 # We need that when migration VMs to other nodes (files already moved)
3219 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3221 my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3223 $force = 1 if !defined($force) && !$shutdown;
3226 my $pid = check_running
($vmid, $nocheck, $migratedfrom);
3227 kill 15, $pid if $pid;
3228 my $conf = load_config
($vmid, $migratedfrom);
3229 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive);
3233 lock_config
($vmid, sub {
3235 my $pid = check_running
($vmid, $nocheck);
3240 $conf = load_config
($vmid);
3241 check_lock
($conf) if !$skiplock;
3242 if (!defined($timeout) && $shutdown && $conf->{startup
}) {
3243 my $opts = parse_startup
($conf->{startup
});
3244 $timeout = $opts->{down
} if $opts->{down
};
3248 $timeout = 60 if !defined($timeout);
3252 $nocheck ? vm_mon_cmd_nocheck
($vmid, "system_powerdown") : vm_mon_cmd
($vmid, "system_powerdown");
3255 $nocheck ? vm_mon_cmd_nocheck
($vmid, "quit") : vm_mon_cmd
($vmid, "quit");
3262 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
3267 if ($count >= $timeout) {
3269 warn "VM still running - terminating now with SIGTERM\n";
3272 die "VM quit/powerdown failed - got timeout\n";
3275 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
3280 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3283 die "VM quit/powerdown failed\n";
3291 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
3296 if ($count >= $timeout) {
3297 warn "VM still running - terminating now with SIGKILL\n";
3302 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
3307 my ($vmid, $skiplock) = @_;
3309 lock_config
($vmid, sub {
3311 my $conf = load_config
($vmid);
3313 check_lock
($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3315 vm_mon_cmd
($vmid, "stop");
3320 my ($vmid, $skiplock) = @_;
3322 lock_config
($vmid, sub {
3324 my $conf = load_config
($vmid);
3326 check_lock
($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3328 vm_mon_cmd
($vmid, "cont");
3333 my ($vmid, $skiplock, $key) = @_;
3335 lock_config
($vmid, sub {
3337 my $conf = load_config
($vmid);
3339 # there is no qmp command, so we use the human monitor command
3340 vm_human_monitor_command
($vmid, "sendkey $key");
3345 my ($storecfg, $vmid, $skiplock) = @_;
3347 lock_config
($vmid, sub {
3349 my $conf = load_config
($vmid);
3351 check_lock
($conf) if !$skiplock;
3353 if (!check_running
($vmid)) {
3354 fairsched_rmnod
($vmid); # try to destroy group
3355 destroy_vm
($storecfg, $vmid);
3357 die "VM $vmid is running - destroy failed\n";
3365 my ($filename, $buf) = @_;
3367 my $fh = IO
::File-
>new($filename, "w");
3368 return undef if !$fh;
3370 my $res = print $fh $buf;
3377 sub pci_device_info
{
3382 return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3383 my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3385 my $irq = file_read_firstline
("$pcisysfs/devices/$name/irq");
3386 return undef if !defined($irq) || $irq !~ m/^\d+$/;
3388 my $vendor = file_read_firstline
("$pcisysfs/devices/$name/vendor");
3389 return undef if !defined($vendor) || $vendor !~ s/^0x//;
3391 my $product = file_read_firstline
("$pcisysfs/devices/$name/device");
3392 return undef if !defined($product) || $product !~ s/^0x//;
3397 product
=> $product,
3403 has_fl_reset
=> -f
"$pcisysfs/devices/$name/reset" || 0,
3412 my $name = $dev->{name
};
3414 my $fn = "$pcisysfs/devices/$name/reset";
3416 return file_write
($fn, "1");
3419 sub pci_dev_bind_to_stub
{
3422 my $name = $dev->{name
};
3424 my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3425 return 1 if -d
$testdir;
3427 my $data = "$dev->{vendor} $dev->{product}";
3428 return undef if !file_write
("$pcisysfs/drivers/pci-stub/new_id", $data);
3430 my $fn = "$pcisysfs/devices/$name/driver/unbind";
3431 if (!file_write
($fn, $name)) {
3432 return undef if -f
$fn;
3435 $fn = "$pcisysfs/drivers/pci-stub/bind";
3436 if (! -d
$testdir) {
3437 return undef if !file_write
($fn, $name);
3443 sub print_pci_addr
{
3444 my ($id, $bridges) = @_;
3448 piix3
=> { bus
=> 0, addr
=> 1 },
3449 #addr2 : first videocard
3450 balloon0
=> { bus
=> 0, addr
=> 3 },
3451 watchdog
=> { bus
=> 0, addr
=> 4 },
3452 scsihw0
=> { bus
=> 0, addr
=> 5 },
3453 scsihw1
=> { bus
=> 0, addr
=> 6 },
3454 ahci0
=> { bus
=> 0, addr
=> 7 },
3455 qga0
=> { bus
=> 0, addr
=> 8 },
3456 spice
=> { bus
=> 0, addr
=> 9 },
3457 virtio0
=> { bus
=> 0, addr
=> 10 },
3458 virtio1
=> { bus
=> 0, addr
=> 11 },
3459 virtio2
=> { bus
=> 0, addr
=> 12 },
3460 virtio3
=> { bus
=> 0, addr
=> 13 },
3461 virtio4
=> { bus
=> 0, addr
=> 14 },
3462 virtio5
=> { bus
=> 0, addr
=> 15 },
3463 hostpci0
=> { bus
=> 0, addr
=> 16 },
3464 hostpci1
=> { bus
=> 0, addr
=> 17 },
3465 net0
=> { bus
=> 0, addr
=> 18 },
3466 net1
=> { bus
=> 0, addr
=> 19 },
3467 net2
=> { bus
=> 0, addr
=> 20 },
3468 net3
=> { bus
=> 0, addr
=> 21 },
3469 net4
=> { bus
=> 0, addr
=> 22 },
3470 net5
=> { bus
=> 0, addr
=> 23 },
3471 #addr29 : usb-host (pve-usb.cfg)
3472 'pci.1' => { bus
=> 0, addr
=> 30 },
3473 'pci.2' => { bus
=> 0, addr
=> 31 },
3474 'net6' => { bus
=> 1, addr
=> 1 },
3475 'net7' => { bus
=> 1, addr
=> 2 },
3476 'net8' => { bus
=> 1, addr
=> 3 },
3477 'net9' => { bus
=> 1, addr
=> 4 },
3478 'net10' => { bus
=> 1, addr
=> 5 },
3479 'net11' => { bus
=> 1, addr
=> 6 },
3480 'net12' => { bus
=> 1, addr
=> 7 },
3481 'net13' => { bus
=> 1, addr
=> 8 },
3482 'net14' => { bus
=> 1, addr
=> 9 },
3483 'net15' => { bus
=> 1, addr
=> 10 },
3484 'net16' => { bus
=> 1, addr
=> 11 },
3485 'net17' => { bus
=> 1, addr
=> 12 },
3486 'net18' => { bus
=> 1, addr
=> 13 },
3487 'net19' => { bus
=> 1, addr
=> 14 },
3488 'net20' => { bus
=> 1, addr
=> 15 },
3489 'net21' => { bus
=> 1, addr
=> 16 },
3490 'net22' => { bus
=> 1, addr
=> 17 },
3491 'net23' => { bus
=> 1, addr
=> 18 },
3492 'net24' => { bus
=> 1, addr
=> 19 },
3493 'net25' => { bus
=> 1, addr
=> 20 },
3494 'net26' => { bus
=> 1, addr
=> 21 },
3495 'net27' => { bus
=> 1, addr
=> 22 },
3496 'net28' => { bus
=> 1, addr
=> 23 },
3497 'net29' => { bus
=> 1, addr
=> 24 },
3498 'net30' => { bus
=> 1, addr
=> 25 },
3499 'net31' => { bus
=> 1, addr
=> 26 },
3500 'virtio6' => { bus
=> 2, addr
=> 1 },
3501 'virtio7' => { bus
=> 2, addr
=> 2 },
3502 'virtio8' => { bus
=> 2, addr
=> 3 },
3503 'virtio9' => { bus
=> 2, addr
=> 4 },
3504 'virtio10' => { bus
=> 2, addr
=> 5 },
3505 'virtio11' => { bus
=> 2, addr
=> 6 },
3506 'virtio12' => { bus
=> 2, addr
=> 7 },
3507 'virtio13' => { bus
=> 2, addr
=> 8 },
3508 'virtio14' => { bus
=> 2, addr
=> 9 },
3509 'virtio15' => { bus
=> 2, addr
=> 10 },
3512 if (defined($devices->{$id}->{bus
}) && defined($devices->{$id}->{addr
})) {
3513 my $addr = sprintf("0x%x", $devices->{$id}->{addr
});
3514 my $bus = $devices->{$id}->{bus
};
3515 $res = ",bus=pci.$bus,addr=$addr";
3516 $bridges->{$bus} = 1 if $bridges;
3522 # vzdump restore implementaion
3524 sub tar_archive_read_firstfile
{
3525 my $archive = shift;
3527 die "ERROR: file '$archive' does not exist\n" if ! -f
$archive;
3529 # try to detect archive type first
3530 my $pid = open (TMP
, "tar tf '$archive'|") ||
3531 die "unable to open file '$archive'\n";
3532 my $firstfile = <TMP
>;
3536 die "ERROR: archive contaions no data\n" if !$firstfile;
3542 sub tar_restore_cleanup
{
3543 my ($storecfg, $statfile) = @_;
3545 print STDERR
"starting cleanup\n";
3547 if (my $fd = IO
::File-
>new($statfile, "r")) {
3548 while (defined(my $line = <$fd>)) {
3549 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3552 if ($volid =~ m
|^/|) {
3553 unlink $volid || die 'unlink failed\n';
3555 PVE
::Storage
::vdisk_free
($storecfg, $volid);
3557 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
3559 print STDERR
"unable to cleanup '$volid' - $@" if $@;
3561 print STDERR
"unable to parse line in statfile - $line";
3568 sub restore_archive
{
3569 my ($archive, $vmid, $user, $opts) = @_;
3571 my $format = $opts->{format
};
3574 if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
3575 $format = 'tar' if !$format;
3577 } elsif ($archive =~ m/\.tar$/) {
3578 $format = 'tar' if !$format;
3579 } elsif ($archive =~ m/.tar.lzo$/) {
3580 $format = 'tar' if !$format;
3582 } elsif ($archive =~ m/\.vma$/) {
3583 $format = 'vma' if !$format;
3584 } elsif ($archive =~ m/\.vma\.gz$/) {
3585 $format = 'vma' if !$format;
3587 } elsif ($archive =~ m/\.vma\.lzo$/) {
3588 $format = 'vma' if !$format;
3591 $format = 'vma' if !$format; # default
3594 # try to detect archive format
3595 if ($format eq 'tar') {
3596 return restore_tar_archive
($archive, $vmid, $user, $opts);
3598 return restore_vma_archive
($archive, $vmid, $user, $opts, $comp);
3602 sub restore_update_config_line
{
3603 my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
3605 return if $line =~ m/^\#qmdump\#/;
3606 return if $line =~ m/^\#vzdump\#/;
3607 return if $line =~ m/^lock:/;
3608 return if $line =~ m/^unused\d+:/;
3609 return if $line =~ m/^parent:/;
3610 return if $line =~ m/^template:/; # restored VM is never a template
3612 if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3613 # try to convert old 1.X settings
3614 my ($id, $ind, $ethcfg) = ($1, $2, $3);
3615 foreach my $devconfig (PVE
::Tools
::split_list
($ethcfg)) {
3616 my ($model, $macaddr) = split(/\=/, $devconfig);
3617 $macaddr = PVE
::Tools
::random_ether_addr
() if !$macaddr || $unique;
3620 bridge
=> "vmbr$ind",
3621 macaddr
=> $macaddr,
3623 my $netstr = print_net
($net);
3625 print $outfd "net$cookie->{netcount}: $netstr\n";
3626 $cookie->{netcount
}++;
3628 } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
3629 my ($id, $netstr) = ($1, $2);
3630 my $net = parse_net
($netstr);
3631 $net->{macaddr
} = PVE
::Tools
::random_ether_addr
() if $net->{macaddr
};
3632 $netstr = print_net
($net);
3633 print $outfd "$id: $netstr\n";
3634 } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
3637 if ($line =~ m/backup=no/) {
3638 print $outfd "#$line";
3639 } elsif ($virtdev && $map->{$virtdev}) {
3640 my $di = parse_drive
($virtdev, $value);
3641 delete $di->{format
}; # format can change on restore
3642 $di->{file
} = $map->{$virtdev};
3643 $value = print_drive
($vmid, $di);
3644 print $outfd "$virtdev: $value\n";
3654 my ($cfg, $vmid) = @_;
3656 my $info = PVE
::Storage
::vdisk_list
($cfg, undef, $vmid);
3658 my $volid_hash = {};
3659 foreach my $storeid (keys %$info) {
3660 foreach my $item (@{$info->{$storeid}}) {
3661 next if !($item->{volid
} && $item->{size
});
3662 $item->{path
} = PVE
::Storage
::path
($cfg, $item->{volid
});
3663 $volid_hash->{$item->{volid
}} = $item;
3670 sub get_used_paths
{
3671 my ($vmid, $storecfg, $conf, $scan_snapshots, $skip_drive) = @_;
3675 my $scan_config = sub {
3676 my ($cref, $snapname) = @_;
3678 foreach my $key (keys %$cref) {
3679 my $value = $cref->{$key};
3680 if (valid_drivename
($key)) {
3681 next if $skip_drive && $key eq $skip_drive;
3682 my $drive = parse_drive
($key, $value);
3683 next if !$drive || !$drive->{file
} || drive_is_cdrom
($drive);
3684 if ($drive->{file
} =~ m!^/!) {
3685 $used_path->{$drive->{file
}}++; # = 1;
3687 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($drive->{file
}, 1);
3689 my $scfg = PVE
::Storage
::storage_config
($storecfg, $storeid, 1);
3691 my $path = PVE
::Storage
::path
($storecfg, $drive->{file
}, $snapname);
3692 $used_path->{$path}++; # = 1;
3698 &$scan_config($conf);
3702 if ($scan_snapshots) {
3703 foreach my $snapname (keys %{$conf->{snapshots
}}) {
3704 &$scan_config($conf->{snapshots
}->{$snapname}, $snapname);
3711 sub update_disksize
{
3712 my ($vmid, $conf, $volid_hash) = @_;
3718 # Note: it is allowed to define multiple storages with same path (alias), so
3719 # we need to check both 'volid' and real 'path' (two different volid can point
3720 # to the same path).
3725 foreach my $opt (keys %$conf) {
3726 if (valid_drivename
($opt)) {
3727 my $drive = parse_drive
($opt, $conf->{$opt});
3728 my $volid = $drive->{file
};
3731 $used->{$volid} = 1;
3732 if ($volid_hash->{$volid} &&
3733 (my $path = $volid_hash->{$volid}->{path
})) {
3734 $usedpath->{$path} = 1;
3737 next if drive_is_cdrom
($drive);
3738 next if !$volid_hash->{$volid};
3740 $drive->{size
} = $volid_hash->{$volid}->{size
};
3741 my $new = print_drive
($vmid, $drive);
3742 if ($new ne $conf->{$opt}) {
3744 $conf->{$opt} = $new;
3749 # remove 'unusedX' entry if volume is used
3750 foreach my $opt (keys %$conf) {
3751 next if $opt !~ m/^unused\d+$/;
3752 my $volid = $conf->{$opt};
3753 my $path = $volid_hash->{$volid}->{path
} if $volid_hash->{$volid};
3754 if ($used->{$volid} || ($path && $usedpath->{$path})) {
3756 delete $conf->{$opt};
3760 foreach my $volid (sort keys %$volid_hash) {
3761 next if $volid =~ m/vm-$vmid-state-/;
3762 next if $used->{$volid};
3763 my $path = $volid_hash->{$volid}->{path
};
3764 next if !$path; # just to be sure
3765 next if $usedpath->{$path};
3767 add_unused_volume
($conf, $volid);
3768 $usedpath->{$path} = 1; # avoid to add more than once (aliases)
3775 my ($vmid, $nolock) = @_;
3777 my $cfg = PVE
::Cluster
::cfs_read_file
("storage.cfg");
3779 my $volid_hash = scan_volids
($cfg, $vmid);
3781 my $updatefn = sub {
3784 my $conf = load_config
($vmid);
3789 foreach my $volid (keys %$volid_hash) {
3790 my $info = $volid_hash->{$volid};
3791 $vm_volids->{$volid} = $info if $info->{vmid
} && $info->{vmid
} == $vmid;
3794 my $changes = update_disksize
($vmid, $conf, $vm_volids);
3796 update_config_nolock
($vmid, $conf, 1) if $changes;
3799 if (defined($vmid)) {
3803 lock_config
($vmid, $updatefn, $vmid);
3806 my $vmlist = config_list
();
3807 foreach my $vmid (keys %$vmlist) {
3811 lock_config
($vmid, $updatefn, $vmid);
3817 sub restore_vma_archive
{
3818 my ($archive, $vmid, $user, $opts, $comp) = @_;
3820 my $input = $archive eq '-' ?
"<&STDIN" : undef;
3821 my $readfrom = $archive;
3826 my $qarchive = PVE
::Tools
::shellquote
($archive);
3827 if ($comp eq 'gzip') {
3828 $uncomp = "zcat $qarchive|";
3829 } elsif ($comp eq 'lzop') {
3830 $uncomp = "lzop -d -c $qarchive|";
3832 die "unknown compression method '$comp'\n";
3837 my $tmpdir = "/var/tmp/vzdumptmp$$";
3840 # disable interrupts (always do cleanups)
3841 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
3842 warn "got interrupt - ignored\n";
3845 my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
3846 POSIX
::mkfifo
($mapfifo, 0600);
3849 my $openfifo = sub {
3850 open($fifofh, '>', $mapfifo) || die $!;
3853 my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
3860 my $rpcenv = PVE
::RPCEnvironment
::get
();
3862 my $conffile = config_file
($vmid);
3863 my $tmpfn = "$conffile.$$.tmp";
3865 # Note: $oldconf is undef if VM does not exists
3866 my $oldconf = PVE
::Cluster
::cfs_read_file
(cfs_config_path
($vmid));
3868 my $print_devmap = sub {
3869 my $virtdev_hash = {};
3871 my $cfgfn = "$tmpdir/qemu-server.conf";
3873 # we can read the config - that is already extracted
3874 my $fh = IO
::File-
>new($cfgfn, "r") ||
3875 "unable to read qemu-server.conf - $!\n";
3877 while (defined(my $line = <$fh>)) {
3878 if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
3879 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
3880 die "archive does not contain data for drive '$virtdev'\n"
3881 if !$devinfo->{$devname};
3882 if (defined($opts->{storage
})) {
3883 $storeid = $opts->{storage
} || 'local';
3884 } elsif (!$storeid) {
3887 $format = 'raw' if !$format;
3888 $devinfo->{$devname}->{devname
} = $devname;
3889 $devinfo->{$devname}->{virtdev
} = $virtdev;
3890 $devinfo->{$devname}->{format
} = $format;
3891 $devinfo->{$devname}->{storeid
} = $storeid;
3893 # check permission on storage
3894 my $pool = $opts->{pool
}; # todo: do we need that?
3895 if ($user ne 'root@pam') {
3896 $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
3899 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
3903 foreach my $devname (keys %$devinfo) {
3904 die "found no device mapping information for device '$devname'\n"
3905 if !$devinfo->{$devname}->{virtdev
};
3908 my $cfg = cfs_read_file
('storage.cfg');
3910 # create empty/temp config
3912 PVE
::Tools
::file_set_contents
($conffile, "memory: 128\n");
3913 foreach_drive
($oldconf, sub {
3914 my ($ds, $drive) = @_;
3916 return if drive_is_cdrom
($drive);
3918 my $volid = $drive->{file
};
3920 return if !$volid || $volid =~ m
|^/|;
3922 my ($path, $owner) = PVE
::Storage
::path
($cfg, $volid);
3923 return if !$path || !$owner || ($owner != $vmid);
3925 # Note: only delete disk we want to restore
3926 # other volumes will become unused
3927 if ($virtdev_hash->{$ds}) {
3928 PVE
::Storage
::vdisk_free
($cfg, $volid);
3934 foreach my $virtdev (sort keys %$virtdev_hash) {
3935 my $d = $virtdev_hash->{$virtdev};
3936 my $alloc_size = int(($d->{size
} + 1024 - 1)/1024);
3937 my $scfg = PVE
::Storage
::storage_config
($cfg, $d->{storeid
});
3939 # test if requested format is supported
3940 my ($defFormat, $validFormats) = PVE
::Storage
::storage_default_format
($cfg, $d->{storeid
});
3941 my $supported = grep { $_ eq $d->{format
} } @$validFormats;
3942 $d->{format
} = $defFormat if !$supported;
3944 my $volid = PVE
::Storage
::vdisk_alloc
($cfg, $d->{storeid
}, $vmid,
3945 $d->{format
}, undef, $alloc_size);
3946 print STDERR
"new volume ID is '$volid'\n";
3947 $d->{volid
} = $volid;
3948 my $path = PVE
::Storage
::path
($cfg, $volid);
3950 my $write_zeros = 1;
3951 # fixme: what other storages types initialize volumes with zero?
3952 if ($scfg->{type
} eq 'dir' || $scfg->{type
} eq 'nfs' ||
3953 $scfg->{type
} eq 'sheepdog' || $scfg->{type
} eq 'rbd') {
3957 print $fifofh "${write_zeros}:$d->{devname}=$path\n";
3959 print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
3960 $map->{$virtdev} = $volid;
3963 $fh->seek(0, 0) || die "seek failed - $!\n";
3965 my $outfd = new IO
::File
($tmpfn, "w") ||
3966 die "unable to write config for VM $vmid\n";
3968 my $cookie = { netcount
=> 0 };
3969 while (defined(my $line = <$fh>)) {
3970 restore_update_config_line
($outfd, $cookie, $vmid, $map, $line, $opts->{unique
});
3979 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
3980 die "interrupted by signal\n";
3982 local $SIG{ALRM
} = sub { die "got timeout\n"; };
3984 $oldtimeout = alarm($timeout);
3991 if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
3992 my ($dev_id, $size, $devname) = ($1, $2, $3);
3993 $devinfo->{$devname} = { size
=> $size, dev_id
=> $dev_id };
3994 } elsif ($line =~ m/^CTIME: /) {
3996 print $fifofh "done\n";
3997 my $tmp = $oldtimeout || 0;
3998 $oldtimeout = undef;
4004 print "restore vma archive: $cmd\n";
4005 run_command
($cmd, input
=> $input, outfunc
=> $parser, afterfork
=> $openfifo);
4009 alarm($oldtimeout) if $oldtimeout;
4017 my $cfg = cfs_read_file
('storage.cfg');
4018 foreach my $devname (keys %$devinfo) {
4019 my $volid = $devinfo->{$devname}->{volid
};
4022 if ($volid =~ m
|^/|) {
4023 unlink $volid || die 'unlink failed\n';
4025 PVE
::Storage
::vdisk_free
($cfg, $volid);
4027 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
4029 print STDERR
"unable to cleanup '$volid' - $@" if $@;
4036 rename($tmpfn, $conffile) ||
4037 die "unable to commit configuration file '$conffile'\n";
4039 PVE
::Cluster
::cfs_update
(); # make sure we read new file
4041 eval { rescan
($vmid, 1); };
4045 sub restore_tar_archive
{
4046 my ($archive, $vmid, $user, $opts) = @_;
4048 if ($archive ne '-') {
4049 my $firstfile = tar_archive_read_firstfile
($archive);
4050 die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
4051 if $firstfile ne 'qemu-server.conf';
4054 my $storecfg = cfs_read_file
('storage.cfg');
4056 # destroy existing data - keep empty config
4057 my $vmcfgfn = PVE
::QemuServer
::config_file
($vmid);
4058 destroy_vm
($storecfg, $vmid, 1) if -f
$vmcfgfn;
4060 my $tocmd = "/usr/lib/qemu-server/qmextract";
4062 $tocmd .= " --storage " . PVE
::Tools
::shellquote
($opts->{storage
}) if $opts->{storage
};
4063 $tocmd .= " --pool " . PVE
::Tools
::shellquote
($opts->{pool
}) if $opts->{pool
};
4064 $tocmd .= ' --prealloc' if $opts->{prealloc
};
4065 $tocmd .= ' --info' if $opts->{info
};
4067 # tar option "xf" does not autodetect compression when read from STDIN,
4068 # so we pipe to zcat
4069 my $cmd = "zcat -f|tar xf " . PVE
::Tools
::shellquote
($archive) . " " .
4070 PVE
::Tools
::shellquote
("--to-command=$tocmd");
4072 my $tmpdir = "/var/tmp/vzdumptmp$$";
4075 local $ENV{VZDUMP_TMPDIR
} = $tmpdir;
4076 local $ENV{VZDUMP_VMID
} = $vmid;
4077 local $ENV{VZDUMP_USER
} = $user;
4079 my $conffile = config_file
($vmid);
4080 my $tmpfn = "$conffile.$$.tmp";
4082 # disable interrupts (always do cleanups)
4083 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
4084 print STDERR
"got interrupt - ignored\n";
4089 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
4090 die "interrupted by signal\n";
4093 if ($archive eq '-') {
4094 print "extracting archive from STDIN\n";
4095 run_command
($cmd, input
=> "<&STDIN");
4097 print "extracting archive '$archive'\n";
4101 return if $opts->{info
};
4105 my $statfile = "$tmpdir/qmrestore.stat";
4106 if (my $fd = IO
::File-
>new($statfile, "r")) {
4107 while (defined (my $line = <$fd>)) {
4108 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4109 $map->{$1} = $2 if $1;
4111 print STDERR
"unable to parse line in statfile - $line\n";
4117 my $confsrc = "$tmpdir/qemu-server.conf";
4119 my $srcfd = new IO
::File
($confsrc, "r") ||
4120 die "unable to open file '$confsrc'\n";
4122 my $outfd = new IO
::File
($tmpfn, "w") ||
4123 die "unable to write config for VM $vmid\n";
4125 my $cookie = { netcount
=> 0 };
4126 while (defined (my $line = <$srcfd>)) {
4127 restore_update_config_line
($outfd, $cookie, $vmid, $map, $line, $opts->{unique
});
4139 tar_restore_cleanup
($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info
};
4146 rename $tmpfn, $conffile ||
4147 die "unable to commit configuration file '$conffile'\n";
4149 PVE
::Cluster
::cfs_update
(); # make sure we read new file
4151 eval { rescan
($vmid, 1); };
4156 # Internal snapshots
4158 # NOTE: Snapshot create/delete involves several non-atomic
4159 # action, and can take a long time.
4160 # So we try to avoid locking the file and use 'lock' variable
4161 # inside the config file instead.
4163 my $snapshot_copy_config = sub {
4164 my ($source, $dest) = @_;
4166 foreach my $k (keys %$source) {
4167 next if $k eq 'snapshots';
4168 next if $k eq 'snapstate';
4169 next if $k eq 'snaptime';
4170 next if $k eq 'vmstate';
4171 next if $k eq 'lock';
4172 next if $k eq 'digest';
4173 next if $k eq 'description';
4174 next if $k =~ m/^unused\d+$/;
4176 $dest->{$k} = $source->{$k};
4180 my $snapshot_apply_config = sub {
4181 my ($conf, $snap) = @_;
4183 # copy snapshot list
4185 snapshots
=> $conf->{snapshots
},
4188 # keep description and list of unused disks
4189 foreach my $k (keys %$conf) {
4190 next if !($k =~ m/^unused\d+$/ || $k eq 'description');
4191 $newconf->{$k} = $conf->{$k};
4194 &$snapshot_copy_config($snap, $newconf);
4199 sub foreach_writable_storage
{
4200 my ($conf, $func) = @_;
4204 foreach my $ds (keys %$conf) {
4205 next if !valid_drivename
($ds);
4207 my $drive = parse_drive
($ds, $conf->{$ds});
4209 next if drive_is_cdrom
($drive);
4211 my $volid = $drive->{file
};
4213 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
4214 $sidhash->{$sid} = $sid if $sid;
4217 foreach my $sid (sort keys %$sidhash) {
4222 my $alloc_vmstate_volid = sub {
4223 my ($storecfg, $vmid, $conf, $snapname) = @_;
4225 # Note: we try to be smart when selecting a $target storage
4229 # search shared storage first
4230 foreach_writable_storage
($conf, sub {
4232 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
4233 return if !$scfg->{shared
};
4235 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage
4239 # now search local storage
4240 foreach_writable_storage
($conf, sub {
4242 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
4243 return if $scfg->{shared
};
4245 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage;
4249 $target = 'local' if !$target;
4251 my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
4252 # we abort live save after $conf->{memory}, so we need at max twice that space
4253 my $size = $conf->{memory
}*2 + $driver_state_size;
4255 my $name = "vm-$vmid-state-$snapname";
4256 my $scfg = PVE
::Storage
::storage_config
($storecfg, $target);
4257 $name .= ".raw" if $scfg->{path
}; # add filename extension for file base storage
4258 my $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $target, $vmid, 'raw', $name, $size*1024);
4263 my $snapshot_prepare = sub {
4264 my ($vmid, $snapname, $save_vmstate, $comment) = @_;
4268 my $updatefn = sub {
4270 my $conf = load_config
($vmid);
4272 die "you can't take a snapshot if it's a template\n"
4273 if is_template
($conf);
4277 $conf->{lock} = 'snapshot';
4279 die "snapshot name '$snapname' already used\n"
4280 if defined($conf->{snapshots
}->{$snapname});
4282 my $storecfg = PVE
::Storage
::config
();
4283 die "snapshot feature is not available" if !has_feature
('snapshot', $conf, $storecfg);
4285 $snap = $conf->{snapshots
}->{$snapname} = {};
4287 if ($save_vmstate && check_running
($vmid)) {
4288 $snap->{vmstate
} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
4291 &$snapshot_copy_config($conf, $snap);
4293 $snap->{snapstate
} = "prepare";
4294 $snap->{snaptime
} = time();
4295 $snap->{description
} = $comment if $comment;
4297 # always overwrite machine if we save vmstate. This makes sure we
4298 # can restore it later using correct machine type
4299 $snap->{machine
} = get_current_qemu_machine
($vmid) if $snap->{vmstate
};
4301 update_config_nolock
($vmid, $conf, 1);
4304 lock_config
($vmid, $updatefn);
4309 my $snapshot_commit = sub {
4310 my ($vmid, $snapname) = @_;
4312 my $updatefn = sub {
4314 my $conf = load_config
($vmid);
4316 die "missing snapshot lock\n"
4317 if !($conf->{lock} && $conf->{lock} eq 'snapshot');
4319 my $snap = $conf->{snapshots
}->{$snapname};
4321 die "snapshot '$snapname' does not exist\n" if !defined($snap);
4323 die "wrong snapshot state\n"
4324 if !($snap->{snapstate
} && $snap->{snapstate
} eq "prepare");
4326 delete $snap->{snapstate
};
4327 delete $conf->{lock};
4329 my $newconf = &$snapshot_apply_config($conf, $snap);
4331 $newconf->{parent
} = $snapname;
4333 update_config_nolock
($vmid, $newconf, 1);
4336 lock_config
($vmid, $updatefn);
4339 sub snapshot_rollback
{
4340 my ($vmid, $snapname) = @_;
4346 my $storecfg = PVE
::Storage
::config
();
4348 my $updatefn = sub {
4350 my $conf = load_config
($vmid);
4352 die "you can't rollback if vm is a template\n" if is_template
($conf);
4354 $snap = $conf->{snapshots
}->{$snapname};
4356 die "snapshot '$snapname' does not exist\n" if !defined($snap);
4358 die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
4359 if $snap->{snapstate
};
4363 vm_stop
($storecfg, $vmid, undef, undef, 5, undef, undef);
4366 die "unable to rollback vm $vmid: vm is running\n"
4367 if check_running
($vmid);
4370 $conf->{lock} = 'rollback';
4372 die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
4373 delete $conf->{lock};
4379 my $has_machine_config = defined($conf->{machine
});
4381 # copy snapshot config to current config
4382 $conf = &$snapshot_apply_config($conf, $snap);
4383 $conf->{parent
} = $snapname;
4385 # Note: old code did not store 'machine', so we try to be smart
4386 # and guess the snapshot was generated with kvm 1.4 (pc-i440fx-1.4).
4387 $forcemachine = $conf->{machine
} || 'pc-i440fx-1.4';
4388 # we remove the 'machine' configuration if not explicitly specified
4389 # in the original config.
4390 delete $conf->{machine
} if $snap->{vmstate
} && !$has_machine_config;
4393 update_config_nolock
($vmid, $conf, 1);
4395 if (!$prepare && $snap->{vmstate
}) {
4396 my $statefile = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
4397 vm_start
($storecfg, $vmid, $statefile, undef, undef, undef, $forcemachine);
4401 lock_config
($vmid, $updatefn);
4403 foreach_drive
($snap, sub {
4404 my ($ds, $drive) = @_;
4406 return if drive_is_cdrom
($drive);
4408 my $volid = $drive->{file
};
4409 my $device = "drive-$ds";
4411 PVE
::Storage
::volume_snapshot_rollback
($storecfg, $volid, $snapname);
4415 lock_config
($vmid, $updatefn);
4418 my $savevm_wait = sub {
4422 my $stat = vm_mon_cmd_nocheck
($vmid, "query-savevm");
4423 if (!$stat->{status
}) {
4424 die "savevm not active\n";
4425 } elsif ($stat->{status
} eq 'active') {
4428 } elsif ($stat->{status
} eq 'completed') {
4431 die "query-savevm returned status '$stat->{status}'\n";
4436 sub snapshot_create
{
4437 my ($vmid, $snapname, $save_vmstate, $freezefs, $comment) = @_;
4439 my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
4441 $freezefs = $save_vmstate = 0 if !$snap->{vmstate
}; # vm is not running
4445 my $running = check_running
($vmid);
4448 # create internal snapshots of all drives
4450 my $storecfg = PVE
::Storage
::config
();
4453 if ($snap->{vmstate
}) {
4454 my $path = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
4455 vm_mon_cmd
($vmid, "savevm-start", statefile
=> $path);
4456 &$savevm_wait($vmid);
4458 vm_mon_cmd
($vmid, "savevm-start");
4462 qga_freezefs
($vmid) if $running && $freezefs;
4464 foreach_drive
($snap, sub {
4465 my ($ds, $drive) = @_;
4467 return if drive_is_cdrom
($drive);
4469 my $volid = $drive->{file
};
4470 my $device = "drive-$ds";
4472 qemu_volume_snapshot
($vmid, $device, $storecfg, $volid, $snapname);
4473 $drivehash->{$ds} = 1;
4478 eval { qga_unfreezefs
($vmid) if $running && $freezefs; };
4481 eval { vm_mon_cmd
($vmid, "savevm-end") if $running; };
4485 warn "snapshot create failed: starting cleanup\n";
4486 eval { snapshot_delete
($vmid, $snapname, 0, $drivehash); };
4491 &$snapshot_commit($vmid, $snapname);
4494 # Note: $drivehash is only set when called from snapshot_create.
4495 sub snapshot_delete
{
4496 my ($vmid, $snapname, $force, $drivehash) = @_;
4503 my $unlink_parent = sub {
4504 my ($confref, $new_parent) = @_;
4506 if ($confref->{parent
} && $confref->{parent
} eq $snapname) {
4508 $confref->{parent
} = $new_parent;
4510 delete $confref->{parent
};
4515 my $updatefn = sub {
4516 my ($remove_drive) = @_;
4518 my $conf = load_config
($vmid);
4522 die "you can't delete a snapshot if vm is a template\n"
4523 if is_template
($conf);
4526 $snap = $conf->{snapshots
}->{$snapname};
4528 die "snapshot '$snapname' does not exist\n" if !defined($snap);
4530 # remove parent refs
4531 &$unlink_parent($conf, $snap->{parent
});
4532 foreach my $sn (keys %{$conf->{snapshots
}}) {
4533 next if $sn eq $snapname;
4534 &$unlink_parent($conf->{snapshots
}->{$sn}, $snap->{parent
});
4537 if ($remove_drive) {
4538 if ($remove_drive eq 'vmstate') {
4539 delete $snap->{$remove_drive};
4541 my $drive = parse_drive
($remove_drive, $snap->{$remove_drive});
4542 my $volid = $drive->{file
};
4543 delete $snap->{$remove_drive};
4544 add_unused_volume
($conf, $volid);
4549 $snap->{snapstate
} = 'delete';
4551 delete $conf->{snapshots
}->{$snapname};
4552 delete $conf->{lock} if $drivehash;
4553 foreach my $volid (@$unused) {
4554 add_unused_volume
($conf, $volid);
4558 update_config_nolock
($vmid, $conf, 1);
4561 lock_config
($vmid, $updatefn);
4563 # now remove vmstate file
4565 my $storecfg = PVE
::Storage
::config
();
4567 if ($snap->{vmstate
}) {
4568 eval { PVE
::Storage
::vdisk_free
($storecfg, $snap->{vmstate
}); };
4570 die $err if !$force;
4573 # save changes (remove vmstate from snapshot)
4574 lock_config
($vmid, $updatefn, 'vmstate') if !$force;
4577 # now remove all internal snapshots
4578 foreach_drive
($snap, sub {
4579 my ($ds, $drive) = @_;
4581 return if drive_is_cdrom
($drive);
4583 my $volid = $drive->{file
};
4584 my $device = "drive-$ds";
4586 if (!$drivehash || $drivehash->{$ds}) {
4587 eval { qemu_volume_snapshot_delete
($vmid, $device, $storecfg, $volid, $snapname); };
4589 die $err if !$force;
4594 # save changes (remove drive fron snapshot)
4595 lock_config
($vmid, $updatefn, $ds) if !$force;
4596 push @$unused, $volid;
4599 # now cleanup config
4601 lock_config
($vmid, $updatefn);
4605 my ($feature, $conf, $storecfg, $snapname, $running) = @_;
4608 foreach_drive
($conf, sub {
4609 my ($ds, $drive) = @_;
4611 return if drive_is_cdrom
($drive);
4612 my $volid = $drive->{file
};
4613 $err = 1 if !PVE
::Storage
::volume_has_feature
($storecfg, $feature, $volid, $snapname, $running);
4616 return $err ?
0 : 1;
4619 sub template_create
{
4620 my ($vmid, $conf, $disk) = @_;
4622 my $storecfg = PVE
::Storage
::config
();
4624 foreach_drive
($conf, sub {
4625 my ($ds, $drive) = @_;
4627 return if drive_is_cdrom
($drive);
4628 return if $disk && $ds ne $disk;
4630 my $volid = $drive->{file
};
4631 return if !PVE
::Storage
::volume_has_feature
($storecfg, 'template', $volid);
4633 my $voliddst = PVE
::Storage
::vdisk_create_base
($storecfg, $volid);
4634 $drive->{file
} = $voliddst;
4635 $conf->{$ds} = print_drive
($vmid, $drive);
4636 update_config_nolock
($vmid, $conf, 1);
4643 return 1 if defined $conf->{template
} && $conf->{template
} == 1;
4646 sub qemu_img_convert
{
4647 my ($src_volid, $dst_volid, $size, $snapname) = @_;
4649 my $storecfg = PVE
::Storage
::config
();
4650 my ($src_storeid, $src_volname) = PVE
::Storage
::parse_volume_id
($src_volid, 1);
4651 my ($dst_storeid, $dst_volname) = PVE
::Storage
::parse_volume_id
($dst_volid, 1);
4653 if ($src_storeid && $dst_storeid) {
4654 my $src_scfg = PVE
::Storage
::storage_config
($storecfg, $src_storeid);
4655 my $dst_scfg = PVE
::Storage
::storage_config
($storecfg, $dst_storeid);
4657 my $src_format = qemu_img_format
($src_scfg, $src_volname);
4658 my $dst_format = qemu_img_format
($dst_scfg, $dst_volname);
4660 my $src_path = PVE
::Storage
::path
($storecfg, $src_volid, $snapname);
4661 my $dst_path = PVE
::Storage
::path
($storecfg, $dst_volid);
4664 push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-C';
4665 push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
4666 push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
4670 if($line =~ m/\((\S+)\/100\
%\)/){
4672 my $transferred = int($size * $percent / 100);
4673 my $remaining = $size - $transferred;
4675 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
4680 eval { run_command
($cmd, timeout
=> undef, outfunc
=> $parser); };
4682 die "copy failed: $err" if $err;
4686 sub qemu_img_format
{
4687 my ($scfg, $volname) = @_;
4689 if ($scfg->{path
} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/) {
4691 } elsif ($scfg->{type
} eq 'iscsi') {
4692 return "host_device";
4698 sub qemu_drive_mirror
{
4699 my ($vmid, $drive, $dst_volid, $vmiddst, $maxwait) = @_;
4705 my $storecfg = PVE
::Storage
::config
();
4706 my ($dst_storeid, $dst_volname) = PVE
::Storage
::parse_volume_id
($dst_volid, 1);
4709 my $dst_scfg = PVE
::Storage
::storage_config
($storecfg, $dst_storeid);
4712 if ($dst_volname =~ m/\.(raw|qcow2)$/){
4716 my $dst_path = PVE
::Storage
::path
($storecfg, $dst_volid);
4719 #fixme : sometime drive-mirror timeout, but works fine after.
4720 # (I have see the problem with big volume > 200GB), so we need to eval
4721 eval { vm_mon_cmd
($vmid, "drive-mirror", timeout
=> 10, device
=> "drive-$drive", mode
=> "existing",
4722 sync
=> "full", target
=> $dst_path, format
=> $format); };
4724 eval { vm_mon_cmd
($vmid, "drive-mirror", timeout
=> 10, device
=> "drive-$drive", mode
=> "existing",
4725 sync
=> "full", target
=> $dst_path); };
4730 my $stats = vm_mon_cmd
($vmid, "query-block-jobs");
4731 my $stat = @$stats[0];
4732 die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
4733 die "error job is not mirroring" if $stat->{type
} ne "mirror";
4735 my $transferred = $stat->{offset
};
4736 my $total = $stat->{len
};
4737 my $remaining = $total - $transferred;
4738 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
4740 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent %\n";
4742 last if ($stat->{len
} == $stat->{offset
});
4743 if ($old_len == $stat->{offset
}) {
4744 if ($maxwait && $count > $maxwait) {
4745 # if writes to disk occurs the disk needs to be freezed
4746 # to be able to complete the migration
4747 vm_suspend
($vmid,1);
4751 $count++ unless $frozen;
4757 $old_len = $stat->{offset
};
4761 if ($vmiddst == $vmid) {
4762 # switch the disk if source and destination are on the same guest
4763 vm_mon_cmd
($vmid, "block-job-complete", device
=> "drive-$drive");
4767 eval { vm_mon_cmd
($vmid, "block-job-cancel", device
=> "drive-$drive"); };
4768 die "mirroring error: $err";
4771 if ($vmiddst != $vmid) {
4772 # if we clone a disk for a new target vm, we don't switch the disk
4773 vm_mon_cmd
($vmid, "block-job-cancel", device
=> "drive-$drive");
4779 my ($storecfg, $vmid, $running, $drivename, $drive, $snapname,
4780 $newvmid, $storage, $format, $full, $newvollist) = @_;
4785 print "create linked clone of drive $drivename ($drive->{file})\n";
4786 $newvolid = PVE
::Storage
::vdisk_clone
($storecfg, $drive->{file
}, $newvmid);
4787 push @$newvollist, $newvolid;
4789 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($drive->{file
});
4790 $storeid = $storage if $storage;
4792 my ($defFormat, $validFormats) = PVE
::Storage
::storage_default_format
($storecfg, $storeid);
4794 $format = $drive->{format
} || $defFormat;
4797 # test if requested format is supported - else use default
4798 my $supported = grep { $_ eq $format } @$validFormats;
4799 $format = $defFormat if !$supported;
4801 my ($size) = PVE
::Storage
::volume_size_info
($storecfg, $drive->{file
}, 3);
4803 print "create full clone of drive $drivename ($drive->{file})\n";
4804 $newvolid = PVE
::Storage
::vdisk_alloc
($storecfg, $storeid, $newvmid, $format, undef, ($size/1024));
4805 push @$newvollist, $newvolid;
4807 if (!$running || $snapname) {
4808 qemu_img_convert
($drive->{file
}, $newvolid, $size, $snapname);
4810 qemu_drive_mirror
($vmid, $drivename, $newvolid, $newvmid);
4814 my ($size) = PVE
::Storage
::volume_size_info
($storecfg, $newvolid, 3);
4817 $disk->{format
} = undef;
4818 $disk->{file
} = $newvolid;
4819 $disk->{size
} = $size;
4824 # this only works if VM is running
4825 sub get_current_qemu_machine
{
4828 my $cmd = { execute
=> 'query-machines', arguments
=> {} };
4829 my $res = PVE
::QemuServer
::vm_qmp_command
($vmid, $cmd);
4831 my ($current, $default);
4832 foreach my $e (@$res) {
4833 $default = $e->{name
} if $e->{'is-default'};
4834 $current = $e->{name
} if $e->{'is-current'};
4837 # fallback to the default machine if current is not supported by qemu
4838 return $current || $default || 'pc';