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. You can also run without any graphic card using a serial devive as terminal.",
339 enum
=> [qw(std cirrus vmware qxl serial0 serial1 serial2 serial3)],
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 with VNC. Else the mouse runs out of sync with normal VNC clients. If you're running lots of console-only guests on one host, you may consider disabling this to save some context switches. This is turned of by default if you use spice (vga=qxl).",
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|spice',
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.
550 The value 'spice' can be used to add a usb redirection devices for spice.
554 PVE
::JSONSchema
::register_standard_option
("pve-qm-usb", $usbdesc);
558 type
=> 'string', format
=> 'pve-qm-hostpci',
559 typetext
=> "HOSTPCIDEVICE",
560 description
=> <<EODESCR,
561 Map host pci devices. HOSTPCIDEVICE syntax is:
563 'bus:dev.func' (hexadecimal numbers)
565 You can us the 'lspci' command to list existing pci devices.
567 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
569 Experimental: user reported problems with this option.
572 PVE
::JSONSchema
::register_standard_option
("pve-qm-hostpci", $hostpcidesc);
577 pattern
=> '(/dev/ttyS\d+|socket)',
578 description
=> <<EODESCR,
579 Create a serial device inside the VM (n is 0 to 3), and pass through a host serial device, or create a unix socket on the host side (use 'qm terminal' to open a terminal connection).
581 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
583 Experimental: user reported problems with this option.
590 pattern
=> '/dev/parport\d+',
591 description
=> <<EODESCR,
592 Map host parallel devices (n is 0 to 2).
594 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
596 Experimental: user reported problems with this option.
600 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
601 $confdesc->{"parallel$i"} = $paralleldesc;
604 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
605 $confdesc->{"serial$i"} = $serialdesc;
608 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
609 $confdesc->{"hostpci$i"} = $hostpcidesc;
612 for (my $i = 0; $i < $MAX_IDE_DISKS; $i++) {
613 $drivename_hash->{"ide$i"} = 1;
614 $confdesc->{"ide$i"} = $idedesc;
617 for (my $i = 0; $i < $MAX_SATA_DISKS; $i++) {
618 $drivename_hash->{"sata$i"} = 1;
619 $confdesc->{"sata$i"} = $satadesc;
622 for (my $i = 0; $i < $MAX_SCSI_DISKS; $i++) {
623 $drivename_hash->{"scsi$i"} = 1;
624 $confdesc->{"scsi$i"} = $scsidesc ;
627 for (my $i = 0; $i < $MAX_VIRTIO_DISKS; $i++) {
628 $drivename_hash->{"virtio$i"} = 1;
629 $confdesc->{"virtio$i"} = $virtiodesc;
632 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
633 $confdesc->{"usb$i"} = $usbdesc;
638 type
=> 'string', format
=> 'pve-volume-id',
639 description
=> "Reference to unused volumes.",
642 for (my $i = 0; $i < $MAX_UNUSED_DISKS; $i++) {
643 $confdesc->{"unused$i"} = $unuseddesc;
646 my $kvm_api_version = 0;
650 return $kvm_api_version if $kvm_api_version;
652 my $fh = IO
::File-
>new("</dev/kvm") ||
655 if (my $v = $fh->ioctl(KVM_GET_API_VERSION
(), 0)) {
656 $kvm_api_version = $v;
661 return $kvm_api_version;
664 my $kvm_user_version;
666 sub kvm_user_version
{
668 return $kvm_user_version if $kvm_user_version;
670 $kvm_user_version = 'unknown';
672 my $tmp = `kvm -help 2>/dev/null`;
674 if ($tmp =~ m/^QEMU( PC)? emulator version (\d+\.\d+(\.\d+)?)[,\s]/) {
675 $kvm_user_version = $2;
678 return $kvm_user_version;
682 my $kernel_has_vhost_net = -c
'/dev/vhost-net';
685 # order is important - used to autoselect boot disk
686 return ((map { "ide$_" } (0 .. ($MAX_IDE_DISKS - 1))),
687 (map { "scsi$_" } (0 .. ($MAX_SCSI_DISKS - 1))),
688 (map { "virtio$_" } (0 .. ($MAX_VIRTIO_DISKS - 1))),
689 (map { "sata$_" } (0 .. ($MAX_SATA_DISKS - 1))));
692 sub valid_drivename
{
695 return defined($drivename_hash->{$dev});
700 return defined($confdesc->{$key});
704 return $nic_model_list;
707 sub os_list_description
{
712 w2k
=> 'Windows 2000',
713 w2k3
=>, 'Windows 2003',
714 w2k8
=> 'Windows 2008',
715 wvista
=> 'Windows Vista',
717 win8
=> 'Windows 8/2012',
727 return $cdrom_path if $cdrom_path;
729 return $cdrom_path = "/dev/cdrom" if -l
"/dev/cdrom";
730 return $cdrom_path = "/dev/cdrom1" if -l
"/dev/cdrom1";
731 return $cdrom_path = "/dev/cdrom2" if -l
"/dev/cdrom2";
735 my ($storecfg, $vmid, $cdrom) = @_;
737 if ($cdrom eq 'cdrom') {
738 return get_cdrom_path
();
739 } elsif ($cdrom eq 'none') {
741 } elsif ($cdrom =~ m
|^/|) {
744 return PVE
::Storage
::path
($storecfg, $cdrom);
748 # try to convert old style file names to volume IDs
749 sub filename_to_volume_id
{
750 my ($vmid, $file, $media) = @_;
752 if (!($file eq 'none' || $file eq 'cdrom' ||
753 $file =~ m
|^/dev/.+| || $file =~ m/^([^:]+):(.+)$/)) {
755 return undef if $file =~ m
|/|;
757 if ($media && $media eq 'cdrom') {
758 $file = "local:iso/$file";
760 $file = "local:$vmid/$file";
767 sub verify_media_type
{
768 my ($opt, $vtype, $media) = @_;
773 if ($media eq 'disk') {
775 } elsif ($media eq 'cdrom') {
778 die "internal error";
781 return if ($vtype eq $etype);
783 raise_param_exc
({ $opt => "unexpected media type ($vtype != $etype)" });
786 sub cleanup_drive_path
{
787 my ($opt, $storecfg, $drive) = @_;
789 # try to convert filesystem paths to volume IDs
791 if (($drive->{file
} !~ m/^(cdrom|none)$/) &&
792 ($drive->{file
} !~ m
|^/dev/.+|) &&
793 ($drive->{file
} !~ m/^([^:]+):(.+)$/) &&
794 ($drive->{file
} !~ m/^\d+$/)) {
795 my ($vtype, $volid) = PVE
::Storage
::path_to_volume_id
($storecfg, $drive->{file
});
796 raise_param_exc
({ $opt => "unable to associate path '$drive->{file}' to any storage"}) if !$vtype;
797 $drive->{media
} = 'cdrom' if !$drive->{media
} && $vtype eq 'iso';
798 verify_media_type
($opt, $vtype, $drive->{media
});
799 $drive->{file
} = $volid;
802 $drive->{media
} = 'cdrom' if !$drive->{media
} && $drive->{file
} =~ m/^(cdrom|none)$/;
805 sub create_conf_nolock
{
806 my ($vmid, $settings) = @_;
808 my $filename = config_file
($vmid);
810 die "configuration file '$filename' already exists\n" if -f
$filename;
812 my $defaults = load_defaults
();
814 $settings->{name
} = "vm$vmid" if !$settings->{name
};
815 $settings->{memory
} = $defaults->{memory
} if !$settings->{memory
};
818 foreach my $opt (keys %$settings) {
819 next if !$confdesc->{$opt};
821 my $value = $settings->{$opt};
824 $data .= "$opt: $value\n";
827 PVE
::Tools
::file_set_contents
($filename, $data);
830 my $parse_size = sub {
833 return undef if $value !~ m/^(\d+(\.\d+)?)([KMG])?$/;
834 my ($size, $unit) = ($1, $3);
837 $size = $size * 1024;
838 } elsif ($unit eq 'M') {
839 $size = $size * 1024 * 1024;
840 } elsif ($unit eq 'G') {
841 $size = $size * 1024 * 1024 * 1024;
847 my $format_size = sub {
852 my $kb = int($size/1024);
853 return $size if $kb*1024 != $size;
855 my $mb = int($kb/1024);
856 return "${kb}K" if $mb*1024 != $kb;
858 my $gb = int($mb/1024);
859 return "${mb}M" if $gb*1024 != $mb;
864 # ideX = [volume=]volume-id[,media=d][,cyls=c,heads=h,secs=s[,trans=t]]
865 # [,snapshot=on|off][,cache=on|off][,format=f][,backup=yes|no]
866 # [,rerror=ignore|report|stop][,werror=enospc|ignore|report|stop]
867 # [,aio=native|threads]
870 my ($key, $data) = @_;
874 # $key may be undefined - used to verify JSON parameters
875 if (!defined($key)) {
876 $res->{interface
} = 'unknown'; # should not harm when used to verify parameters
878 } elsif ($key =~ m/^([^\d]+)(\d+)$/) {
879 $res->{interface
} = $1;
885 foreach my $p (split (/,/, $data)) {
886 next if $p =~ m/^\s*$/;
888 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)=(.+)$/) {
889 my ($k, $v) = ($1, $2);
891 $k = 'file' if $k eq 'volume';
893 return undef if defined $res->{$k};
895 if ($k eq 'bps' || $k eq 'bps_rd' || $k eq 'bps_wr') {
896 return undef if !$v || $v !~ m/^\d+/;
898 $v = sprintf("%.3f", $v / (1024*1024));
902 if (!$res->{file
} && $p !~ m/=/) {
910 return undef if !$res->{file
};
912 if($res->{file
} =~ m/\.(raw|cow|qcow|qcow2|vmdk|cloop)$/){
916 return undef if $res->{cache
} &&
917 $res->{cache
} !~ m/^(off|none|writethrough|writeback|unsafe|directsync)$/;
918 return undef if $res->{snapshot
} && $res->{snapshot
} !~ m/^(on|off)$/;
919 return undef if $res->{cyls
} && $res->{cyls
} !~ m/^\d+$/;
920 return undef if $res->{heads
} && $res->{heads
} !~ m/^\d+$/;
921 return undef if $res->{secs
} && $res->{secs
} !~ m/^\d+$/;
922 return undef if $res->{media
} && $res->{media
} !~ m/^(disk|cdrom)$/;
923 return undef if $res->{trans
} && $res->{trans
} !~ m/^(none|lba|auto)$/;
924 return undef if $res->{format
} && $res->{format
} !~ m/^(raw|cow|qcow|qcow2|vmdk|cloop)$/;
925 return undef if $res->{rerror
} && $res->{rerror
} !~ m/^(ignore|report|stop)$/;
926 return undef if $res->{werror
} && $res->{werror
} !~ m/^(enospc|ignore|report|stop)$/;
927 return undef if $res->{backup
} && $res->{backup
} !~ m/^(yes|no)$/;
928 return undef if $res->{aio
} && $res->{aio
} !~ m/^(native|threads)$/;
931 return undef if $res->{mbps_rd
} && $res->{mbps
};
932 return undef if $res->{mbps_wr
} && $res->{mbps
};
934 return undef if $res->{mbps
} && $res->{mbps
} !~ m/^\d+(\.\d+)?$/;
935 return undef if $res->{mbps_rd
} && $res->{mbps_rd
} !~ m/^\d+(\.\d+)?$/;
936 return undef if $res->{mbps_wr
} && $res->{mbps_wr
} !~ m/^\d+(\.\d+)?$/;
938 return undef if $res->{iops_rd
} && $res->{iops
};
939 return undef if $res->{iops_wr
} && $res->{iops
};
940 return undef if $res->{iops
} && $res->{iops
} !~ m/^\d+$/;
941 return undef if $res->{iops_rd
} && $res->{iops_rd
} !~ m/^\d+$/;
942 return undef if $res->{iops_wr
} && $res->{iops_wr
} !~ m/^\d+$/;
946 return undef if !defined($res->{size
} = &$parse_size($res->{size
}));
949 if ($res->{media
} && ($res->{media
} eq 'cdrom')) {
950 return undef if $res->{snapshot
} || $res->{trans
} || $res->{format
};
951 return undef if $res->{heads
} || $res->{secs
} || $res->{cyls
};
952 return undef if $res->{interface
} eq 'virtio';
955 # rerror does not work with scsi drives
956 if ($res->{rerror
}) {
957 return undef if $res->{interface
} eq 'scsi';
963 my @qemu_drive_options = qw(heads secs cyls trans media format cache snapshot rerror werror aio iops iops_rd iops_wr);
966 my ($vmid, $drive) = @_;
969 foreach my $o (@qemu_drive_options, 'mbps', 'mbps_rd', 'mbps_wr', 'backup') {
970 $opts .= ",$o=$drive->{$o}" if $drive->{$o};
973 if ($drive->{size
}) {
974 $opts .= ",size=" . &$format_size($drive->{size
});
977 return "$drive->{file}$opts";
981 my($fh, $noerr) = @_;
984 my $SG_GET_VERSION_NUM = 0x2282;
986 my $versionbuf = "\x00" x
8;
987 my $ret = ioctl($fh, $SG_GET_VERSION_NUM, $versionbuf);
989 die "scsi ioctl SG_GET_VERSION_NUM failoed - $!\n" if !$noerr;
992 my $version = unpack("I", $versionbuf);
993 if ($version < 30000) {
994 die "scsi generic interface too old\n" if !$noerr;
998 my $buf = "\x00" x
36;
999 my $sensebuf = "\x00" x
8;
1000 my $cmd = pack("C x3 C x1", 0x12, 36);
1002 # see /usr/include/scsi/sg.h
1003 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";
1005 my $packet = pack($sg_io_hdr_t, ord('S'), -3, length($cmd),
1006 length($sensebuf), 0, length($buf), $buf,
1007 $cmd, $sensebuf, 6000);
1009 $ret = ioctl($fh, $SG_IO, $packet);
1011 die "scsi ioctl SG_IO failed - $!\n" if !$noerr;
1015 my @res = unpack($sg_io_hdr_t, $packet);
1016 if ($res[17] || $res[18]) {
1017 die "scsi ioctl SG_IO status error - $!\n" if !$noerr;
1022 (my $byte0, my $byte1, $res->{vendor
},
1023 $res->{product
}, $res->{revision
}) = unpack("C C x6 A8 A16 A4", $buf);
1025 $res->{removable
} = $byte1 & 128 ?
1 : 0;
1026 $res->{type
} = $byte0 & 31;
1034 my $fh = IO
::File-
>new("+<$path") || return undef;
1035 my $res = scsi_inquiry
($fh, 1);
1041 sub print_drivedevice_full
{
1042 my ($storecfg, $conf, $vmid, $drive, $bridges) = @_;
1047 if ($drive->{interface
} eq 'virtio') {
1048 my $pciaddr = print_pci_addr
("$drive->{interface}$drive->{index}", $bridges);
1049 $device = "virtio-blk-pci,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}$pciaddr";
1050 } elsif ($drive->{interface
} eq 'scsi') {
1051 $maxdev = ($conf->{scsihw
} && $conf->{scsihw
} ne 'lsi') ?
256 : 7;
1052 my $controller = int($drive->{index} / $maxdev);
1053 my $unit = $drive->{index} % $maxdev;
1054 my $devicetype = 'hd';
1056 if (drive_is_cdrom
($drive)) {
1059 if ($drive->{file
} =~ m
|^/|) {
1060 $path = $drive->{file
};
1062 $path = PVE
::Storage
::path
($storecfg, $drive->{file
});
1065 if($path =~ m/^iscsi\:\/\
//){
1066 $devicetype = 'generic';
1068 if (my $info = path_is_scsi
($path)) {
1069 if ($info->{type
} == 0) {
1070 $devicetype = 'block';
1071 } elsif ($info->{type
} == 1) { # tape
1072 $devicetype = 'generic';
1078 if (!$conf->{scsihw
} || $conf->{scsihw
} eq 'lsi'){
1079 $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';
1081 $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}";
1084 } elsif ($drive->{interface
} eq 'ide'){
1086 my $controller = int($drive->{index} / $maxdev);
1087 my $unit = $drive->{index} % $maxdev;
1088 my $devicetype = ($drive->{media
} && $drive->{media
} eq 'cdrom') ?
"cd" : "hd";
1090 $device = "ide-$devicetype,bus=ide.$controller,unit=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1091 } elsif ($drive->{interface
} eq 'sata'){
1092 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
1093 my $unit = $drive->{index} % $MAX_SATA_DISKS;
1094 $device = "ide-drive,bus=ahci$controller.$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1095 } elsif ($drive->{interface
} eq 'usb') {
1097 # -device ide-drive,bus=ide.1,unit=0,drive=drive-ide0-1-0,id=ide0-1-0
1099 die "unsupported interface type";
1102 $device .= ",bootindex=$drive->{bootindex}" if $drive->{bootindex
};
1107 sub print_drive_full
{
1108 my ($storecfg, $vmid, $drive) = @_;
1111 foreach my $o (@qemu_drive_options) {
1112 next if $o eq 'bootindex';
1113 $opts .= ",$o=$drive->{$o}" if $drive->{$o};
1116 foreach my $o (qw(bps bps_rd bps_wr)) {
1117 my $v = $drive->{"m$o"};
1118 $opts .= ",$o=" . int($v*1024*1024) if $v;
1121 # use linux-aio by default (qemu default is threads)
1122 $opts .= ",aio=native" if !$drive->{aio
};
1125 my $volid = $drive->{file
};
1126 if (drive_is_cdrom
($drive)) {
1127 $path = get_iso_path
($storecfg, $vmid, $volid);
1129 if ($volid =~ m
|^/|) {
1132 $path = PVE
::Storage
::path
($storecfg, $volid);
1136 $opts .= ",cache=none" if !$drive->{cache
} && !drive_is_cdrom
($drive);
1138 my $pathinfo = $path ?
"file=$path," : '';
1140 return "${pathinfo}if=none,id=drive-$drive->{interface}$drive->{index}$opts";
1143 sub print_netdevice_full
{
1144 my ($vmid, $conf, $net, $netid, $bridges) = @_;
1146 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
1148 my $device = $net->{model
};
1149 if ($net->{model
} eq 'virtio') {
1150 $device = 'virtio-net-pci';
1153 # qemu > 0.15 always try to boot from network - we disable that by
1154 # not loading the pxe rom file
1155 my $extra = ($bootorder !~ m/n/) ?
"romfile=," : '';
1156 my $pciaddr = print_pci_addr
("$netid", $bridges);
1157 my $tmpstr = "$device,${extra}mac=$net->{macaddr},netdev=$netid$pciaddr,id=$netid";
1158 $tmpstr .= ",bootindex=$net->{bootindex}" if $net->{bootindex
} ;
1162 sub print_netdev_full
{
1163 my ($vmid, $conf, $net, $netid) = @_;
1166 if ($netid =~ m/^net(\d+)$/) {
1170 die "got strange net id '$i'\n" if $i >= ${MAX_NETS
};
1172 my $ifname = "tap${vmid}i$i";
1174 # kvm uses TUNSETIFF ioctl, and that limits ifname length
1175 die "interface name '$ifname' is too long (max 15 character)\n"
1176 if length($ifname) >= 16;
1178 my $vhostparam = '';
1179 $vhostparam = ',vhost=on' if $kernel_has_vhost_net && $net->{model
} eq 'virtio';
1181 my $vmname = $conf->{name
} || "vm$vmid";
1183 if ($net->{bridge
}) {
1184 return "type=tap,id=$netid,ifname=${ifname},script=/var/lib/qemu-server/pve-bridge$vhostparam";
1186 return "type=user,id=$netid,hostname=$vmname";
1190 sub drive_is_cdrom
{
1193 return $drive && $drive->{media
} && ($drive->{media
} eq 'cdrom');
1200 return undef if !$value;
1204 if ($value =~ m/^[a-f0-9]{2}:[a-f0-9]{2}\.[a-f0-9]$/) {
1205 $res->{pciid
} = $value;
1213 # netX: e1000=XX:XX:XX:XX:XX:XX,bridge=vmbr0,rate=<mbps>
1219 foreach my $kvp (split(/,/, $data)) {
1221 if ($kvp =~ m/^(ne2k_pci|e1000|rtl8139|pcnet|virtio|ne2k_isa|i82551|i82557b|i82559er)(=([0-9a-f]{2}(:[0-9a-f]{2}){5}))?$/i) {
1223 my $mac = defined($3) ?
uc($3) : PVE
::Tools
::random_ether_addr
();
1224 $res->{model
} = $model;
1225 $res->{macaddr
} = $mac;
1226 } elsif ($kvp =~ m/^bridge=(\S+)$/) {
1227 $res->{bridge
} = $1;
1228 } elsif ($kvp =~ m/^rate=(\d+(\.\d+)?)$/) {
1230 } elsif ($kvp =~ m/^tag=(\d+)$/) {
1238 return undef if !$res->{model
};
1246 my $res = "$net->{model}";
1247 $res .= "=$net->{macaddr}" if $net->{macaddr
};
1248 $res .= ",bridge=$net->{bridge}" if $net->{bridge
};
1249 $res .= ",rate=$net->{rate}" if $net->{rate
};
1250 $res .= ",tag=$net->{tag}" if $net->{tag
};
1255 sub add_random_macs
{
1256 my ($settings) = @_;
1258 foreach my $opt (keys %$settings) {
1259 next if $opt !~ m/^net(\d+)$/;
1260 my $net = parse_net
($settings->{$opt});
1262 $settings->{$opt} = print_net
($net);
1266 sub add_unused_volume
{
1267 my ($config, $volid) = @_;
1270 for (my $ind = $MAX_UNUSED_DISKS - 1; $ind >= 0; $ind--) {
1271 my $test = "unused$ind";
1272 if (my $vid = $config->{$test}) {
1273 return if $vid eq $volid; # do not add duplicates
1279 die "To many unused volume - please delete them first.\n" if !$key;
1281 $config->{$key} = $volid;
1286 PVE
::JSONSchema
::register_format
('pve-qm-bootdisk', \
&verify_bootdisk
);
1287 sub verify_bootdisk
{
1288 my ($value, $noerr) = @_;
1290 return $value if valid_drivename
($value);
1292 return undef if $noerr;
1294 die "invalid boot disk '$value'\n";
1297 PVE
::JSONSchema
::register_format
('pve-qm-net', \
&verify_net
);
1299 my ($value, $noerr) = @_;
1301 return $value if parse_net
($value);
1303 return undef if $noerr;
1305 die "unable to parse network options\n";
1308 PVE
::JSONSchema
::register_format
('pve-qm-drive', \
&verify_drive
);
1310 my ($value, $noerr) = @_;
1312 return $value if parse_drive
(undef, $value);
1314 return undef if $noerr;
1316 die "unable to parse drive options\n";
1319 PVE
::JSONSchema
::register_format
('pve-qm-hostpci', \
&verify_hostpci
);
1320 sub verify_hostpci
{
1321 my ($value, $noerr) = @_;
1323 return $value if parse_hostpci
($value);
1325 return undef if $noerr;
1327 die "unable to parse pci id\n";
1330 PVE
::JSONSchema
::register_format
('pve-qm-watchdog', \
&verify_watchdog
);
1331 sub verify_watchdog
{
1332 my ($value, $noerr) = @_;
1334 return $value if parse_watchdog
($value);
1336 return undef if $noerr;
1338 die "unable to parse watchdog options\n";
1341 sub parse_watchdog
{
1344 return undef if !$value;
1348 foreach my $p (split(/,/, $value)) {
1349 next if $p =~ m/^\s*$/;
1351 if ($p =~ m/^(model=)?(i6300esb|ib700)$/) {
1353 } elsif ($p =~ m/^(action=)?(reset|shutdown|poweroff|pause|debug|none)$/) {
1354 $res->{action
} = $2;
1363 PVE
::JSONSchema
::register_format
('pve-qm-startup', \
&verify_startup
);
1364 sub verify_startup
{
1365 my ($value, $noerr) = @_;
1367 return $value if parse_startup
($value);
1369 return undef if $noerr;
1371 die "unable to parse startup options\n";
1377 return undef if !$value;
1381 foreach my $p (split(/,/, $value)) {
1382 next if $p =~ m/^\s*$/;
1384 if ($p =~ m/^(order=)?(\d+)$/) {
1386 } elsif ($p =~ m/^up=(\d+)$/) {
1388 } elsif ($p =~ m/^down=(\d+)$/) {
1398 sub parse_usb_device
{
1401 return undef if !$value;
1403 my @dl = split(/,/, $value);
1407 foreach my $v (@dl) {
1408 if ($v =~ m/^host=(0x)?([0-9A-Fa-f]{4}):(0x)?([0-9A-Fa-f]{4})$/) {
1410 $res->{vendorid
} = $2;
1411 $res->{productid
} = $4;
1412 } elsif ($v =~ m/^host=(\d+)\-(\d+(\.\d+)*)$/) {
1414 $res->{hostbus
} = $1;
1415 $res->{hostport
} = $2;
1416 } elsif ($v =~ m/^spice$/) {
1423 return undef if !$found;
1428 PVE
::JSONSchema
::register_format
('pve-qm-usb-device', \
&verify_usb_device
);
1429 sub verify_usb_device
{
1430 my ($value, $noerr) = @_;
1432 return $value if parse_usb_device
($value);
1434 return undef if $noerr;
1436 die "unable to parse usb device\n";
1439 # add JSON properties for create and set function
1440 sub json_config_properties
{
1443 foreach my $opt (keys %$confdesc) {
1444 next if $opt eq 'parent' || $opt eq 'snaptime' || $opt eq 'vmstate';
1445 $prop->{$opt} = $confdesc->{$opt};
1452 my ($key, $value) = @_;
1454 die "unknown setting '$key'\n" if !$confdesc->{$key};
1456 my $type = $confdesc->{$key}->{type
};
1458 if (!defined($value)) {
1459 die "got undefined value\n";
1462 if ($value =~ m/[\n\r]/) {
1463 die "property contains a line feed\n";
1466 if ($type eq 'boolean') {
1467 return 1 if ($value eq '1') || ($value =~ m/^(on|yes|true)$/i);
1468 return 0 if ($value eq '0') || ($value =~ m/^(off|no|false)$/i);
1469 die "type check ('boolean') failed - got '$value'\n";
1470 } elsif ($type eq 'integer') {
1471 return int($1) if $value =~ m/^(\d+)$/;
1472 die "type check ('integer') failed - got '$value'\n";
1473 } elsif ($type eq 'number') {
1474 return $value if $value =~ m/^(\d+)(\.\d+)?$/;
1475 die "type check ('number') failed - got '$value'\n";
1476 } elsif ($type eq 'string') {
1477 if (my $fmt = $confdesc->{$key}->{format
}) {
1478 if ($fmt eq 'pve-qm-drive') {
1479 # special case - we need to pass $key to parse_drive()
1480 my $drive = parse_drive
($key, $value);
1481 return $value if $drive;
1482 die "unable to parse drive options\n";
1484 PVE
::JSONSchema
::check_format
($fmt, $value);
1487 $value =~ s/^\"(.*)\"$/$1/;
1490 die "internal error"
1494 sub lock_config_full
{
1495 my ($vmid, $timeout, $code, @param) = @_;
1497 my $filename = config_file_lock
($vmid);
1499 my $res = lock_file
($filename, $timeout, $code, @param);
1506 sub lock_config_mode
{
1507 my ($vmid, $timeout, $shared, $code, @param) = @_;
1509 my $filename = config_file_lock
($vmid);
1511 my $res = lock_file_full
($filename, $timeout, $shared, $code, @param);
1519 my ($vmid, $code, @param) = @_;
1521 return lock_config_full
($vmid, 10, $code, @param);
1524 sub cfs_config_path
{
1525 my ($vmid, $node) = @_;
1527 $node = $nodename if !$node;
1528 return "nodes/$node/qemu-server/$vmid.conf";
1531 sub check_iommu_support
{
1532 #fixme : need to check IOMMU support
1533 #http://www.linux-kvm.org/page/How_to_assign_devices_with_VT-d_in_KVM
1541 my ($vmid, $node) = @_;
1543 my $cfspath = cfs_config_path
($vmid, $node);
1544 return "/etc/pve/$cfspath";
1547 sub config_file_lock
{
1550 return "$lock_dir/lock-$vmid.conf";
1556 my $conf = config_file
($vmid);
1557 utime undef, undef, $conf;
1561 my ($storecfg, $vmid, $keep_empty_config) = @_;
1563 my $conffile = config_file
($vmid);
1565 my $conf = load_config
($vmid);
1569 # only remove disks owned by this VM
1570 foreach_drive
($conf, sub {
1571 my ($ds, $drive) = @_;
1573 return if drive_is_cdrom
($drive);
1575 my $volid = $drive->{file
};
1577 return if !$volid || $volid =~ m
|^/|;
1579 my ($path, $owner) = PVE
::Storage
::path
($storecfg, $volid);
1580 return if !$path || !$owner || ($owner != $vmid);
1582 PVE
::Storage
::vdisk_free
($storecfg, $volid);
1585 if ($keep_empty_config) {
1586 PVE
::Tools
::file_set_contents
($conffile, "memory: 128\n");
1591 # also remove unused disk
1593 my $dl = PVE
::Storage
::vdisk_list
($storecfg, undef, $vmid);
1596 PVE
::Storage
::foreach_volid
($dl, sub {
1597 my ($volid, $sid, $volname, $d) = @_;
1598 PVE
::Storage
::vdisk_free
($storecfg, $volid);
1608 my ($vmid, $node) = @_;
1610 my $cfspath = cfs_config_path
($vmid, $node);
1612 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath);
1614 die "no such VM ('$vmid')\n" if !defined($conf);
1619 sub parse_vm_config
{
1620 my ($filename, $raw) = @_;
1622 return undef if !defined($raw);
1625 digest
=> Digest
::SHA
::sha1_hex
($raw),
1629 $filename =~ m
|/qemu-server/(\d
+)\
.conf
$|
1630 || die "got strange filename '$filename'";
1637 my @lines = split(/\n/, $raw);
1638 foreach my $line (@lines) {
1639 next if $line =~ m/^\s*$/;
1641 if ($line =~ m/^\[([a-z][a-z0-9_\-]+)\]\s*$/i) {
1643 $conf->{description
} = $descr if $descr;
1645 $conf = $res->{snapshots
}->{$snapname} = {};
1649 if ($line =~ m/^\#(.*)\s*$/) {
1650 $descr .= PVE
::Tools
::decode_text
($1) . "\n";
1654 if ($line =~ m/^(description):\s*(.*\S)\s*$/) {
1655 $descr .= PVE
::Tools
::decode_text
($2);
1656 } elsif ($line =~ m/snapstate:\s*(prepare|delete)\s*$/) {
1657 $conf->{snapstate
} = $1;
1658 } elsif ($line =~ m/^(args):\s*(.*\S)\s*$/) {
1661 $conf->{$key} = $value;
1662 } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/) {
1665 eval { $value = check_type
($key, $value); };
1667 warn "vm $vmid - unable to parse value of '$key' - $@";
1669 my $fmt = $confdesc->{$key}->{format
};
1670 if ($fmt && $fmt eq 'pve-qm-drive') {
1671 my $v = parse_drive
($key, $value);
1672 if (my $volid = filename_to_volume_id
($vmid, $v->{file
}, $v->{media
})) {
1673 $v->{file
} = $volid;
1674 $value = print_drive
($vmid, $v);
1676 warn "vm $vmid - unable to parse value of '$key'\n";
1681 if ($key eq 'cdrom') {
1682 $conf->{ide2
} = $value;
1684 $conf->{$key} = $value;
1690 $conf->{description
} = $descr if $descr;
1692 delete $res->{snapstate
}; # just to be sure
1697 sub write_vm_config
{
1698 my ($filename, $conf) = @_;
1700 delete $conf->{snapstate
}; # just to be sure
1702 if ($conf->{cdrom
}) {
1703 die "option ide2 conflicts with cdrom\n" if $conf->{ide2
};
1704 $conf->{ide2
} = $conf->{cdrom
};
1705 delete $conf->{cdrom
};
1708 # we do not use 'smp' any longer
1709 if ($conf->{sockets
}) {
1710 delete $conf->{smp
};
1711 } elsif ($conf->{smp
}) {
1712 $conf->{sockets
} = $conf->{smp
};
1713 delete $conf->{cores
};
1714 delete $conf->{smp
};
1717 my $used_volids = {};
1719 my $cleanup_config = sub {
1720 my ($cref, $snapname) = @_;
1722 foreach my $key (keys %$cref) {
1723 next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots' ||
1724 $key eq 'snapstate';
1725 my $value = $cref->{$key};
1726 eval { $value = check_type
($key, $value); };
1727 die "unable to parse value of '$key' - $@" if $@;
1729 $cref->{$key} = $value;
1731 if (!$snapname && valid_drivename
($key)) {
1732 my $drive = parse_drive
($key, $value);
1733 $used_volids->{$drive->{file
}} = 1 if $drive && $drive->{file
};
1738 &$cleanup_config($conf);
1739 foreach my $snapname (keys %{$conf->{snapshots
}}) {
1740 &$cleanup_config($conf->{snapshots
}->{$snapname}, $snapname);
1743 # remove 'unusedX' settings if we re-add a volume
1744 foreach my $key (keys %$conf) {
1745 my $value = $conf->{$key};
1746 if ($key =~ m/^unused/ && $used_volids->{$value}) {
1747 delete $conf->{$key};
1751 my $generate_raw_config = sub {
1756 # add description as comment to top of file
1757 my $descr = $conf->{description
} || '';
1758 foreach my $cl (split(/\n/, $descr)) {
1759 $raw .= '#' . PVE
::Tools
::encode_text
($cl) . "\n";
1762 foreach my $key (sort keys %$conf) {
1763 next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots';
1764 $raw .= "$key: $conf->{$key}\n";
1769 my $raw = &$generate_raw_config($conf);
1770 foreach my $snapname (sort keys %{$conf->{snapshots
}}) {
1771 $raw .= "\n[$snapname]\n";
1772 $raw .= &$generate_raw_config($conf->{snapshots
}->{$snapname});
1778 sub update_config_nolock
{
1779 my ($vmid, $conf, $skiplock) = @_;
1781 check_lock
($conf) if !$skiplock;
1783 my $cfspath = cfs_config_path
($vmid);
1785 PVE
::Cluster
::cfs_write_file
($cfspath, $conf);
1789 my ($vmid, $conf, $skiplock) = @_;
1791 lock_config
($vmid, &update_config_nolock
, $conf, $skiplock);
1798 # we use static defaults from our JSON schema configuration
1799 foreach my $key (keys %$confdesc) {
1800 if (defined(my $default = $confdesc->{$key}->{default})) {
1801 $res->{$key} = $default;
1805 my $conf = PVE
::Cluster
::cfs_read_file
('datacenter.cfg');
1806 $res->{keyboard
} = $conf->{keyboard
} if $conf->{keyboard
};
1812 my $vmlist = PVE
::Cluster
::get_vmlist
();
1814 return $res if !$vmlist || !$vmlist->{ids
};
1815 my $ids = $vmlist->{ids
};
1817 foreach my $vmid (keys %$ids) {
1818 my $d = $ids->{$vmid};
1819 next if !$d->{node
} || $d->{node
} ne $nodename;
1820 next if !$d->{type
} || $d->{type
} ne 'qemu';
1821 $res->{$vmid}->{exists} = 1;
1826 # test if VM uses local resources (to prevent migration)
1827 sub check_local_resources
{
1828 my ($conf, $noerr) = @_;
1832 $loc_res = 1 if $conf->{hostusb
}; # old syntax
1833 $loc_res = 1 if $conf->{hostpci
}; # old syntax
1835 foreach my $k (keys %$conf) {
1836 $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/;
1839 die "VM uses local resources\n" if $loc_res && !$noerr;
1844 # check if used storages are available on all nodes (use by migrate)
1845 sub check_storage_availability
{
1846 my ($storecfg, $conf, $node) = @_;
1848 foreach_drive
($conf, sub {
1849 my ($ds, $drive) = @_;
1851 my $volid = $drive->{file
};
1854 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
1857 # check if storage is available on both nodes
1858 my $scfg = PVE
::Storage
::storage_check_node
($storecfg, $sid);
1859 PVE
::Storage
::storage_check_node
($storecfg, $sid, $node);
1863 # list nodes where all VM images are available (used by has_feature API)
1865 my ($conf, $storecfg) = @_;
1867 my $nodelist = PVE
::Cluster
::get_nodelist
();
1868 my $nodehash = { map { $_ => 1 } @$nodelist };
1869 my $nodename = PVE
::INotify
::nodename
();
1871 foreach_drive
($conf, sub {
1872 my ($ds, $drive) = @_;
1874 my $volid = $drive->{file
};
1877 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
1879 my $scfg = PVE
::Storage
::storage_config
($storecfg, $storeid);
1880 if ($scfg->{disable
}) {
1882 } elsif (my $avail = $scfg->{nodes
}) {
1883 foreach my $node (keys %$nodehash) {
1884 delete $nodehash->{$node} if !$avail->{$node};
1886 } elsif (!$scfg->{shared
}) {
1887 foreach my $node (keys %$nodehash) {
1888 delete $nodehash->{$node} if $node ne $nodename
1900 die "VM is locked ($conf->{lock})\n" if $conf->{lock};
1904 my ($pidfile, $pid) = @_;
1906 my $fh = IO
::File-
>new("/proc/$pid/cmdline", "r");
1910 return undef if !$line;
1911 my @param = split(/\0/, $line);
1913 my $cmd = $param[0];
1914 return if !$cmd || ($cmd !~ m
|kvm
$| && $cmd !~ m
|qemu-system-x86_64
$|);
1916 for (my $i = 0; $i < scalar (@param); $i++) {
1919 if (($p eq '-pidfile') || ($p eq '--pidfile')) {
1920 my $p = $param[$i+1];
1921 return 1 if $p && ($p eq $pidfile);
1930 my ($vmid, $nocheck, $node) = @_;
1932 my $filename = config_file
($vmid, $node);
1934 die "unable to find configuration file for VM $vmid - no such machine\n"
1935 if !$nocheck && ! -f
$filename;
1937 my $pidfile = pidfile_name
($vmid);
1939 if (my $fd = IO
::File-
>new("<$pidfile")) {
1944 my $mtime = $st->mtime;
1945 if ($mtime > time()) {
1946 warn "file '$filename' modified in future\n";
1949 if ($line =~ m/^(\d+)$/) {
1951 if (check_cmdline
($pidfile, $pid)) {
1952 if (my $pinfo = PVE
::ProcFSTools
::check_process_running
($pid)) {
1964 my $vzlist = config_list
();
1966 my $fd = IO
::Dir-
>new($var_run_tmpdir) || return $vzlist;
1968 while (defined(my $de = $fd->read)) {
1969 next if $de !~ m/^(\d+)\.pid$/;
1971 next if !defined($vzlist->{$vmid});
1972 if (my $pid = check_running
($vmid)) {
1973 $vzlist->{$vmid}->{pid
} = $pid;
1981 my ($storecfg, $conf) = @_;
1983 my $bootdisk = $conf->{bootdisk
};
1984 return undef if !$bootdisk;
1985 return undef if !valid_drivename
($bootdisk);
1987 return undef if !$conf->{$bootdisk};
1989 my $drive = parse_drive
($bootdisk, $conf->{$bootdisk});
1990 return undef if !defined($drive);
1992 return undef if drive_is_cdrom
($drive);
1994 my $volid = $drive->{file
};
1995 return undef if !$volid;
1997 return $drive->{size
};
2000 my $last_proc_pid_stat;
2002 # get VM status information
2003 # This must be fast and should not block ($full == false)
2004 # We only query KVM using QMP if $full == true (this can be slow)
2006 my ($opt_vmid, $full) = @_;
2010 my $storecfg = PVE
::Storage
::config
();
2012 my $list = vzlist
();
2013 my ($uptime) = PVE
::ProcFSTools
::read_proc_uptime
(1);
2015 my $cpucount = $cpuinfo->{cpus
} || 1;
2017 foreach my $vmid (keys %$list) {
2018 next if $opt_vmid && ($vmid ne $opt_vmid);
2020 my $cfspath = cfs_config_path
($vmid);
2021 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath) || {};
2024 $d->{pid
} = $list->{$vmid}->{pid
};
2026 # fixme: better status?
2027 $d->{status
} = $list->{$vmid}->{pid
} ?
'running' : 'stopped';
2029 my $size = disksize
($storecfg, $conf);
2030 if (defined($size)) {
2031 $d->{disk
} = 0; # no info available
2032 $d->{maxdisk
} = $size;
2038 $d->{cpus
} = ($conf->{sockets
} || 1) * ($conf->{cores
} || 1);
2039 $d->{cpus
} = $cpucount if $d->{cpus
} > $cpucount;
2041 $d->{name
} = $conf->{name
} || "VM $vmid";
2042 $d->{maxmem
} = $conf->{memory
} ?
$conf->{memory
}*(1024*1024) : 0;
2044 if ($conf->{balloon
}) {
2045 $d->{balloon_min
} = $conf->{balloon
}*(1024*1024);
2046 $d->{shares
} = defined($conf->{shares
}) ?
$conf->{shares
} : 1000;
2057 $d->{diskwrite
} = 0;
2059 $d->{template
} = is_template
($conf);
2064 my $netdev = PVE
::ProcFSTools
::read_proc_net_dev
();
2065 foreach my $dev (keys %$netdev) {
2066 next if $dev !~ m/^tap([1-9]\d*)i/;
2068 my $d = $res->{$vmid};
2071 $d->{netout
} += $netdev->{$dev}->{receive
};
2072 $d->{netin
} += $netdev->{$dev}->{transmit
};
2075 my $ctime = gettimeofday
;
2077 foreach my $vmid (keys %$list) {
2079 my $d = $res->{$vmid};
2080 my $pid = $d->{pid
};
2083 my $pstat = PVE
::ProcFSTools
::read_proc_pid_stat
($pid);
2084 next if !$pstat; # not running
2086 my $used = $pstat->{utime} + $pstat->{stime
};
2088 $d->{uptime
} = int(($uptime - $pstat->{starttime
})/$cpuinfo->{user_hz
});
2090 if ($pstat->{vsize
}) {
2091 $d->{mem
} = int(($pstat->{rss
}/$pstat->{vsize
})*$d->{maxmem
});
2094 my $old = $last_proc_pid_stat->{$pid};
2096 $last_proc_pid_stat->{$pid} = {
2104 my $dtime = ($ctime - $old->{time}) * $cpucount * $cpuinfo->{user_hz
};
2106 if ($dtime > 1000) {
2107 my $dutime = $used - $old->{used
};
2109 $d->{cpu
} = (($dutime/$dtime)* $cpucount) / $d->{cpus
};
2110 $last_proc_pid_stat->{$pid} = {
2116 $d->{cpu
} = $old->{cpu
};
2120 return $res if !$full;
2122 my $qmpclient = PVE
::QMPClient-
>new();
2124 my $ballooncb = sub {
2125 my ($vmid, $resp) = @_;
2127 my $info = $resp->{'return'};
2128 return if !$info->{max_mem
};
2130 my $d = $res->{$vmid};
2132 # use memory assigned to VM
2133 $d->{maxmem
} = $info->{max_mem
};
2134 $d->{balloon
} = $info->{actual
};
2136 if (defined($info->{total_mem
}) && defined($info->{free_mem
})) {
2137 $d->{mem
} = $info->{total_mem
} - $info->{free_mem
};
2138 $d->{freemem
} = $info->{free_mem
};
2143 my $blockstatscb = sub {
2144 my ($vmid, $resp) = @_;
2145 my $data = $resp->{'return'} || [];
2146 my $totalrdbytes = 0;
2147 my $totalwrbytes = 0;
2148 for my $blockstat (@$data) {
2149 $totalrdbytes = $totalrdbytes + $blockstat->{stats
}->{rd_bytes
};
2150 $totalwrbytes = $totalwrbytes + $blockstat->{stats
}->{wr_bytes
};
2152 $res->{$vmid}->{diskread
} = $totalrdbytes;
2153 $res->{$vmid}->{diskwrite
} = $totalwrbytes;
2156 my $statuscb = sub {
2157 my ($vmid, $resp) = @_;
2159 $qmpclient->queue_cmd($vmid, $blockstatscb, 'query-blockstats');
2160 # this fails if ballon driver is not loaded, so this must be
2161 # the last commnand (following command are aborted if this fails).
2162 $qmpclient->queue_cmd($vmid, $ballooncb, 'query-balloon');
2164 my $status = 'unknown';
2165 if (!defined($status = $resp->{'return'}->{status
})) {
2166 warn "unable to get VM status\n";
2170 $res->{$vmid}->{qmpstatus
} = $resp->{'return'}->{status
};
2173 foreach my $vmid (keys %$list) {
2174 next if $opt_vmid && ($vmid ne $opt_vmid);
2175 next if !$res->{$vmid}->{pid
}; # not running
2176 $qmpclient->queue_cmd($vmid, $statuscb, 'query-status');
2179 $qmpclient->queue_execute();
2181 foreach my $vmid (keys %$list) {
2182 next if $opt_vmid && ($vmid ne $opt_vmid);
2183 $res->{$vmid}->{qmpstatus
} = $res->{$vmid}->{status
} if !$res->{$vmid}->{qmpstatus
};
2190 my ($conf, $func) = @_;
2192 foreach my $ds (keys %$conf) {
2193 next if !valid_drivename
($ds);
2195 my $drive = parse_drive
($ds, $conf->{$ds});
2198 &$func($ds, $drive);
2203 my ($conf, $func) = @_;
2207 my $test_volid = sub {
2208 my ($volid, $is_cdrom) = @_;
2212 $volhash->{$volid} = $is_cdrom || 0;
2215 foreach_drive
($conf, sub {
2216 my ($ds, $drive) = @_;
2217 &$test_volid($drive->{file
}, drive_is_cdrom
($drive));
2220 foreach my $snapname (keys %{$conf->{snapshots
}}) {
2221 my $snap = $conf->{snapshots
}->{$snapname};
2222 &$test_volid($snap->{vmstate
}, 0);
2223 foreach_drive
($snap, sub {
2224 my ($ds, $drive) = @_;
2225 &$test_volid($drive->{file
}, drive_is_cdrom
($drive));
2229 foreach my $volid (keys %$volhash) {
2230 &$func($volid, $volhash->{$volid});
2234 sub vga_conf_has_spice
{
2237 return $vga && ($vga eq 'qxl');
2240 sub config_to_command
{
2241 my ($storecfg, $vmid, $conf, $defaults, $forcemachine) = @_;
2244 my $globalFlags = [];
2245 my $machineFlags = [];
2251 my $kvmver = kvm_user_version
();
2252 my $vernum = 0; # unknown
2253 if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
2254 $vernum = $1*1000000+$2*1000;
2255 } elsif ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
2256 $vernum = $1*1000000+$2*1000+$3;
2259 die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 15000;
2261 my $have_ovz = -f
'/proc/vz/vestat';
2263 push @$cmd, '/usr/bin/kvm';
2265 push @$cmd, '-id', $vmid;
2269 my $qmpsocket = qmp_socket
($vmid);
2270 push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
2271 push @$cmd, '-mon', "chardev=qmp,mode=control";
2273 my $socket = vnc_socket
($vmid);
2274 push @$cmd, '-vnc', "unix:$socket,x509,password";
2276 push @$cmd, '-pidfile' , pidfile_name
($vmid);
2278 push @$cmd, '-daemonize';
2280 $pciaddr = print_pci_addr
("piix3", $bridges);
2281 push @$devices, '-device', "piix3-usb-uhci,id=uhci$pciaddr.0x2";
2284 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2285 next if !$conf->{"usb$i"};
2288 # include usb device config
2289 push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
2291 my $vga = $conf->{vga
};
2293 if ($conf->{ostype
} && ($conf->{ostype
} eq 'win8' ||
2294 $conf->{ostype
} eq 'win7' ||
2295 $conf->{ostype
} eq 'w2k8')) {
2302 # enable absolute mouse coordinates (needed by vnc)
2304 if (defined($conf->{tablet
})) {
2305 $tablet = $conf->{tablet
};
2307 $tablet = $defaults->{tablet
};
2308 $tablet = 0 if vga_conf_has_spice
($vga); # disable for spice because it is not needed
2309 $tablet = 0 if $vga =~ m/^serial\d+$/; # disable if we use serial terminal (no vga card)
2312 push @$devices, '-device', 'usb-tablet,id=tablet,bus=uhci.0,port=1' if $tablet;
2315 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
2316 my $d = parse_hostpci
($conf->{"hostpci$i"});
2318 $pciaddr = print_pci_addr
("hostpci$i", $bridges);
2319 push @$devices, '-device', "pci-assign,host=$d->{pciid},id=hostpci$i$pciaddr";
2323 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2324 my $d = parse_usb_device
($conf->{"usb$i"});
2326 if ($d->{vendorid
} && $d->{productid
}) {
2327 push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2328 } elsif (defined($d->{hostbus
}) && defined($d->{hostport
})) {
2329 push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2330 } elsif ($d->{spice
}) {
2331 # usb redir support for spice
2332 push @$devices, '-chardev', "spicevmc,id=usbredirchardev$i,name=usbredir";
2333 push @$devices, '-device', "usb-redir,chardev=usbredirchardev$i,id=usbredirdev$i,bus=ehci.0";
2338 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
2339 if (my $path = $conf->{"serial$i"}) {
2340 if ($path eq 'socket') {
2341 my $socket = "/var/run/qemu-server/${vmid}.serial$i";
2342 push @$devices, '-chardev', "socket,id=serial$i,path=$socket,server,nowait";
2343 push @$devices, '-device', "isa-serial,chardev=serial$i";
2345 die "no such serial device\n" if ! -c
$path;
2346 push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2347 push @$devices, '-device', "isa-serial,chardev=serial$i";
2353 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
2354 if (my $path = $conf->{"parallel$i"}) {
2355 die "no such parallel device\n" if ! -c
$path;
2356 push @$devices, '-chardev', "parport,id=parallel$i,path=$path";
2357 push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2361 my $vmname = $conf->{name
} || "vm$vmid";
2363 push @$cmd, '-name', $vmname;
2366 $sockets = $conf->{smp
} if $conf->{smp
}; # old style - no longer iused
2367 $sockets = $conf->{sockets
} if $conf->{sockets
};
2369 my $cores = $conf->{cores
} || 1;
2370 push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2372 push @$cmd, '-nodefaults';
2374 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
2376 my $bootindex_hash = {};
2378 foreach my $o (split(//, $bootorder)) {
2379 $bootindex_hash->{$o} = $i*100;
2383 push @$cmd, '-boot', "menu=on";
2385 push @$cmd, '-no-acpi' if defined($conf->{acpi
}) && $conf->{acpi
} == 0;
2387 push @$cmd, '-no-reboot' if defined($conf->{reboot
}) && $conf->{reboot
} == 0;
2389 push @$cmd, '-vga', $vga if $vga && $vga !~ m/^serial\d+$/; # for kvm 77 and later
2392 my $tdf = defined($conf->{tdf
}) ?
$conf->{tdf
} : $defaults->{tdf
};
2394 my $nokvm = defined($conf->{kvm
}) && $conf->{kvm
} == 0 ?
1 : 0;
2395 my $useLocaltime = $conf->{localtime};
2397 if (my $ost = $conf->{ostype
}) {
2398 # other, wxp, w2k, w2k3, w2k8, wvista, win7, win8, l24, l26
2400 if ($ost =~ m/^w/) { # windows
2401 $useLocaltime = 1 if !defined($conf->{localtime});
2403 # use time drift fix when acpi is enabled
2404 if (!(defined($conf->{acpi
}) && $conf->{acpi
} == 0)) {
2405 $tdf = 1 if !defined($conf->{tdf
});
2409 if ($ost eq 'win7' || $ost eq 'win8' || $ost eq 'w2k8' ||
2411 push @$globalFlags, 'kvm-pit.lost_tick_policy=discard';
2412 push @$cmd, '-no-hpet';
2413 #push @$cpuFlags , 'hv_vapic" if !$nokvm; #fixme, my win2008R2 hang at boot with this
2414 push @$cpuFlags , 'hv_spinlocks=0xffff' if !$nokvm;
2417 if ($ost eq 'win7' || $ost eq 'win8') {
2418 push @$cpuFlags , 'hv_relaxed' if !$nokvm;
2422 push @$rtcFlags, 'driftfix=slew' if $tdf;
2425 push @$machineFlags, 'accel=tcg';
2427 die "No accelerator found!\n" if !$cpuinfo->{hvm
};
2430 my $machine_type = $forcemachine || $conf->{machine
};
2431 if ($machine_type) {
2432 push @$machineFlags, "type=${machine_type}";
2435 if ($conf->{startdate
}) {
2436 push @$rtcFlags, "base=$conf->{startdate}";
2437 } elsif ($useLocaltime) {
2438 push @$rtcFlags, 'base=localtime';
2441 my $cpu = $nokvm ?
"qemu64" : "kvm64";
2442 $cpu = $conf->{cpu
} if $conf->{cpu
};
2444 push @$cpuFlags , '+x2apic' if !$nokvm;
2446 push @$cpuFlags, '+sep' if $cpu eq 'kvm64' || $cpu eq 'kvm32';
2448 $cpu .= "," . join(',', @$cpuFlags) if scalar(@$cpuFlags);
2450 push @$cmd, '-cpu', $cpu;
2452 push @$cmd, '-S' if $conf->{freeze
};
2454 # set keyboard layout
2455 my $kb = $conf->{keyboard
} || $defaults->{keyboard
};
2456 push @$cmd, '-k', $kb if $kb;
2459 #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2460 #push @$cmd, '-soundhw', 'es1370';
2461 #push @$cmd, '-soundhw', $soundhw if $soundhw;
2463 if($conf->{agent
}) {
2464 my $qgasocket = qga_socket
($vmid);
2465 my $pciaddr = print_pci_addr
("qga0", $bridges);
2466 push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
2467 push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
2468 push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
2472 if (vga_conf_has_spice
($vga)) {
2473 my $pciaddr = print_pci_addr
("spice", $bridges);
2475 $spice_port = PVE
::Tools
::next_unused_port
(61000, 61099);
2477 push @$cmd, '-spice', "tls-port=${spice_port},addr=127.0.0.1,tls-ciphers=DES-CBC3-SHA,seamless-migration=on";
2479 push @$cmd, '-device', "virtio-serial,id=spice$pciaddr";
2480 push @$cmd, '-chardev', "spicevmc,id=vdagent,name=vdagent";
2481 push @$cmd, '-device', "virtserialport,chardev=vdagent,name=com.redhat.spice.0";
2484 # enable balloon by default, unless explicitly disabled
2485 if (!defined($conf->{balloon
}) || $conf->{balloon
}) {
2486 $pciaddr = print_pci_addr
("balloon0", $bridges);
2487 push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr";
2490 if ($conf->{watchdog
}) {
2491 my $wdopts = parse_watchdog
($conf->{watchdog
});
2492 $pciaddr = print_pci_addr
("watchdog", $bridges);
2493 my $watchdog = $wdopts->{model
} || 'i6300esb';
2494 push @$devices, '-device', "$watchdog$pciaddr";
2495 push @$devices, '-watchdog-action', $wdopts->{action
} if $wdopts->{action
};
2499 my $scsicontroller = {};
2500 my $ahcicontroller = {};
2501 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : $defaults->{scsihw
};
2503 foreach_drive
($conf, sub {
2504 my ($ds, $drive) = @_;
2506 if (PVE
::Storage
::parse_volume_id
($drive->{file
}, 1)) {
2507 push @$vollist, $drive->{file
};
2510 $use_virtio = 1 if $ds =~ m/^virtio/;
2512 if (drive_is_cdrom
($drive)) {
2513 if ($bootindex_hash->{d
}) {
2514 $drive->{bootindex
} = $bootindex_hash->{d
};
2515 $bootindex_hash->{d
} += 1;
2518 if ($bootindex_hash->{c
}) {
2519 $drive->{bootindex
} = $bootindex_hash->{c
} if $conf->{bootdisk
} && ($conf->{bootdisk
} eq $ds);
2520 $bootindex_hash->{c
} += 1;
2524 if ($drive->{interface
} eq 'scsi') {
2526 my $maxdev = ($scsihw ne 'lsi') ?
256 : 7;
2527 my $controller = int($drive->{index} / $maxdev);
2528 $pciaddr = print_pci_addr
("scsihw$controller", $bridges);
2529 push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
2530 $scsicontroller->{$controller}=1;
2533 if ($drive->{interface
} eq 'sata') {
2534 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
2535 $pciaddr = print_pci_addr
("ahci$controller", $bridges);
2536 push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
2537 $ahcicontroller->{$controller}=1;
2540 push @$devices, '-drive',print_drive_full
($storecfg, $vmid, $drive);
2541 push @$devices, '-device',print_drivedevice_full
($storecfg, $conf, $vmid, $drive, $bridges);
2544 push @$cmd, '-m', $conf->{memory
} || $defaults->{memory
};
2546 for (my $i = 0; $i < $MAX_NETS; $i++) {
2547 next if !$conf->{"net$i"};
2548 my $d = parse_net
($conf->{"net$i"});
2551 $use_virtio = 1 if $d->{model
} eq 'virtio';
2553 if ($bootindex_hash->{n
}) {
2554 $d->{bootindex
} = $bootindex_hash->{n
};
2555 $bootindex_hash->{n
} += 1;
2558 my $netdevfull = print_netdev_full
($vmid,$conf,$d,"net$i");
2559 push @$devices, '-netdev', $netdevfull;
2561 my $netdevicefull = print_netdevice_full
($vmid,$conf,$d,"net$i",$bridges);
2562 push @$devices, '-device', $netdevicefull;
2566 while (my ($k, $v) = each %$bridges) {
2567 $pciaddr = print_pci_addr
("pci.$k");
2568 unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
2572 # hack: virtio with fairsched is unreliable, so we do not use fairsched
2573 # when the VM uses virtio devices.
2574 if (!$use_virtio && $have_ovz) {
2576 my $cpuunits = defined($conf->{cpuunits
}) ?
2577 $conf->{cpuunits
} : $defaults->{cpuunits
};
2579 push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
2581 # fixme: cpulimit is currently ignored
2582 #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2586 if ($conf->{args
}) {
2587 my $aa = PVE
::Tools
::split_args
($conf->{args
});
2591 push @$cmd, @$devices;
2592 push @$cmd, '-rtc', join(',', @$rtcFlags)
2593 if scalar(@$rtcFlags);
2594 push @$cmd, '-machine', join(',', @$machineFlags)
2595 if scalar(@$machineFlags);
2596 push @$cmd, '-global', join(',', @$globalFlags)
2597 if scalar(@$globalFlags);
2599 return wantarray ?
($cmd, $vollist, $spice_port) : $cmd;
2604 return "${var_run_tmpdir}/$vmid.vnc";
2610 my $res = vm_mon_cmd
($vmid, 'query-spice');
2612 return $res->{'tls-port'} || $res->{'port'} || die "no spice port\n";
2617 return "${var_run_tmpdir}/$vmid.qmp";
2622 return "${var_run_tmpdir}/$vmid.qga";
2627 return "${var_run_tmpdir}/$vmid.pid";
2630 sub vm_devices_list
{
2633 my $res = vm_mon_cmd
($vmid, 'query-pci');
2636 foreach my $pcibus (@$res) {
2637 foreach my $device (@{$pcibus->{devices
}}) {
2638 next if !$device->{'qdev_id'};
2639 $devices->{$device->{'qdev_id'}} = $device;
2647 my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2649 return 1 if !check_running
($vmid);
2651 if ($deviceid eq 'tablet') {
2652 my $devicefull = "usb-tablet,id=tablet,bus=uhci.0,port=1";
2653 qemu_deviceadd
($vmid, $devicefull);
2657 return 1 if !$conf->{hotplug
};
2659 my $devices_list = vm_devices_list
($vmid);
2660 return 1 if defined($devices_list->{$deviceid});
2662 qemu_bridgeadd
($storecfg, $conf, $vmid, $deviceid); #add bridge if we need it for the device
2664 if ($deviceid =~ m/^(virtio)(\d+)$/) {
2665 return undef if !qemu_driveadd
($storecfg, $vmid, $device);
2666 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
2667 qemu_deviceadd
($vmid, $devicefull);
2668 if(!qemu_deviceaddverify
($vmid, $deviceid)) {
2669 qemu_drivedel
($vmid, $deviceid);
2674 if ($deviceid =~ m/^(scsihw)(\d+)$/) {
2675 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : "lsi";
2676 my $pciaddr = print_pci_addr
($deviceid);
2677 my $devicefull = "$scsihw,id=$deviceid$pciaddr";
2678 qemu_deviceadd
($vmid, $devicefull);
2679 return undef if(!qemu_deviceaddverify
($vmid, $deviceid));
2682 if ($deviceid =~ m/^(scsi)(\d+)$/) {
2683 return 1 if ($conf->{scsihw
} && $conf->{scsihw
} ne 'lsi'); #virtio-scsi not yet support hotplug
2684 return undef if !qemu_findorcreatescsihw
($storecfg,$conf, $vmid, $device);
2685 return undef if !qemu_driveadd
($storecfg, $vmid, $device);
2686 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
2687 if(!qemu_deviceadd
($vmid, $devicefull)) {
2688 qemu_drivedel
($vmid, $deviceid);
2693 if ($deviceid =~ m/^(net)(\d+)$/) {
2694 return undef if !qemu_netdevadd
($vmid, $conf, $device, $deviceid);
2695 my $netdevicefull = print_netdevice_full
($vmid, $conf, $device, $deviceid);
2696 qemu_deviceadd
($vmid, $netdevicefull);
2697 if(!qemu_deviceaddverify
($vmid, $deviceid)) {
2698 qemu_netdevdel
($vmid, $deviceid);
2703 if ($deviceid =~ m/^(pci\.)(\d+)$/) {
2705 my $pciaddr = print_pci_addr
($deviceid);
2706 my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
2707 qemu_deviceadd
($vmid, $devicefull);
2708 return undef if !qemu_deviceaddverify
($vmid, $deviceid);
2714 sub vm_deviceunplug
{
2715 my ($vmid, $conf, $deviceid) = @_;
2717 return 1 if !check_running
($vmid);
2719 if ($deviceid eq 'tablet') {
2720 qemu_devicedel
($vmid, $deviceid);
2724 return 1 if !$conf->{hotplug
};
2726 my $devices_list = vm_devices_list
($vmid);
2727 return 1 if !defined($devices_list->{$deviceid});
2729 die "can't unplug bootdisk" if $conf->{bootdisk
} && $conf->{bootdisk
} eq $deviceid;
2731 if ($deviceid =~ m/^(virtio)(\d+)$/) {
2732 qemu_devicedel
($vmid, $deviceid);
2733 return undef if !qemu_devicedelverify
($vmid, $deviceid);
2734 return undef if !qemu_drivedel
($vmid, $deviceid);
2737 if ($deviceid =~ m/^(lsi)(\d+)$/) {
2738 return undef if !qemu_devicedel
($vmid, $deviceid);
2741 if ($deviceid =~ m/^(scsi)(\d+)$/) {
2742 return undef if !qemu_devicedel
($vmid, $deviceid);
2743 return undef if !qemu_drivedel
($vmid, $deviceid);
2746 if ($deviceid =~ m/^(net)(\d+)$/) {
2747 qemu_devicedel
($vmid, $deviceid);
2748 return undef if !qemu_devicedelverify
($vmid, $deviceid);
2749 return undef if !qemu_netdevdel
($vmid, $deviceid);
2755 sub qemu_deviceadd
{
2756 my ($vmid, $devicefull) = @_;
2758 $devicefull = "driver=".$devicefull;
2759 my %options = split(/[=,]/, $devicefull);
2761 vm_mon_cmd
($vmid, "device_add" , %options);
2765 sub qemu_devicedel
{
2766 my($vmid, $deviceid) = @_;
2767 my $ret = vm_mon_cmd
($vmid, "device_del", id
=> $deviceid);
2772 my($storecfg, $vmid, $device) = @_;
2774 my $drive = print_drive_full
($storecfg, $vmid, $device);
2775 my $ret = vm_human_monitor_command
($vmid, "drive_add auto $drive");
2776 # If the command succeeds qemu prints: "OK"
2777 if ($ret !~ m/OK/s) {
2778 syslog
("err", "adding drive failed: $ret");
2785 my($vmid, $deviceid) = @_;
2787 my $ret = vm_human_monitor_command
($vmid, "drive_del drive-$deviceid");
2789 if ($ret =~ m/Device \'.*?\' not found/s) {
2790 # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2792 elsif ($ret ne "") {
2793 syslog
("err", "deleting drive $deviceid failed : $ret");
2799 sub qemu_deviceaddverify
{
2800 my ($vmid,$deviceid) = @_;
2802 for (my $i = 0; $i <= 5; $i++) {
2803 my $devices_list = vm_devices_list
($vmid);
2804 return 1 if defined($devices_list->{$deviceid});
2807 syslog
("err", "error on hotplug device $deviceid");
2812 sub qemu_devicedelverify
{
2813 my ($vmid,$deviceid) = @_;
2815 #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2816 for (my $i = 0; $i <= 5; $i++) {
2817 my $devices_list = vm_devices_list
($vmid);
2818 return 1 if !defined($devices_list->{$deviceid});
2821 syslog
("err", "error on hot-unplugging device $deviceid");
2825 sub qemu_findorcreatescsihw
{
2826 my ($storecfg, $conf, $vmid, $device) = @_;
2828 my $maxdev = ($conf->{scsihw
} && $conf->{scsihw
} ne 'lsi') ?
256 : 7;
2829 my $controller = int($device->{index} / $maxdev);
2830 my $scsihwid="scsihw$controller";
2831 my $devices_list = vm_devices_list
($vmid);
2833 if(!defined($devices_list->{$scsihwid})) {
2834 return undef if !vm_deviceplug
($storecfg, $conf, $vmid, $scsihwid);
2839 sub qemu_bridgeadd
{
2840 my ($storecfg, $conf, $vmid, $device) = @_;
2843 my $bridgeid = undef;
2844 print_pci_addr
($device, $bridges);
2846 while (my ($k, $v) = each %$bridges) {
2849 return if !$bridgeid || $bridgeid < 1;
2850 my $bridge = "pci.$bridgeid";
2851 my $devices_list = vm_devices_list
($vmid);
2853 if(!defined($devices_list->{$bridge})) {
2854 return undef if !vm_deviceplug
($storecfg, $conf, $vmid, $bridge);
2859 sub qemu_netdevadd
{
2860 my ($vmid, $conf, $device, $deviceid) = @_;
2862 my $netdev = print_netdev_full
($vmid, $conf, $device, $deviceid);
2863 my %options = split(/[=,]/, $netdev);
2865 vm_mon_cmd
($vmid, "netdev_add", %options);
2869 sub qemu_netdevdel
{
2870 my ($vmid, $deviceid) = @_;
2872 vm_mon_cmd
($vmid, "netdev_del", id
=> $deviceid);
2876 sub qemu_block_set_io_throttle
{
2877 my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
2879 return if !check_running
($vmid) ;
2881 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));
2885 # old code, only used to shutdown old VM after update
2887 my ($fh, $timeout) = @_;
2889 my $sel = new IO
::Select
;
2896 while (scalar (@ready = $sel->can_read($timeout))) {
2898 if ($count = $fh->sysread($buf, 8192)) {
2899 if ($buf =~ /^(.*)\(qemu\) $/s) {
2906 if (!defined($count)) {
2913 die "monitor read timeout\n" if !scalar(@ready);
2918 # old code, only used to shutdown old VM after update
2919 sub vm_monitor_command
{
2920 my ($vmid, $cmdstr, $nocheck) = @_;
2925 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
2927 my $sname = "${var_run_tmpdir}/$vmid.mon";
2929 my $sock = IO
::Socket
::UNIX-
>new( Peer
=> $sname ) ||
2930 die "unable to connect to VM $vmid socket - $!\n";
2934 # hack: migrate sometime blocks the monitor (when migrate_downtime
2936 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2937 $timeout = 60*60; # 1 hour
2941 my $data = __read_avail
($sock, $timeout);
2943 if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
2944 die "got unexpected qemu monitor banner\n";
2947 my $sel = new IO
::Select
;
2950 if (!scalar(my @ready = $sel->can_write($timeout))) {
2951 die "monitor write error - timeout";
2954 my $fullcmd = "$cmdstr\r";
2956 # syslog('info', "VM $vmid monitor command: $cmdstr");
2959 if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
2960 die "monitor write error - $!";
2963 return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
2967 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2968 $timeout = 60*60; # 1 hour
2969 } elsif ($cmdstr =~ m/^(eject|change)/) {
2970 $timeout = 60; # note: cdrom mount command is slow
2972 if ($res = __read_avail
($sock, $timeout)) {
2974 my @lines = split("\r?\n", $res);
2976 shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
2978 $res = join("\n", @lines);
2986 syslog
("err", "VM $vmid monitor command failed - $err");
2993 sub qemu_block_resize
{
2994 my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
2996 my $running = check_running
($vmid);
2998 return if !PVE
::Storage
::volume_resize
($storecfg, $volid, $size, $running);
3000 return if !$running;
3002 vm_mon_cmd
($vmid, "block_resize", device
=> $deviceid, size
=> int($size));
3006 sub qemu_volume_snapshot
{
3007 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3009 my $running = check_running
($vmid);
3011 return if !PVE
::Storage
::volume_snapshot
($storecfg, $volid, $snap, $running);
3013 return if !$running;
3015 vm_mon_cmd
($vmid, "snapshot-drive", device
=> $deviceid, name
=> $snap);
3019 sub qemu_volume_snapshot_delete
{
3020 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3022 my $running = check_running
($vmid);
3024 return if !PVE
::Storage
::volume_snapshot_delete
($storecfg, $volid, $snap, $running);
3026 return if !$running;
3028 vm_mon_cmd
($vmid, "delete-drive-snapshot", device
=> $deviceid, name
=> $snap);
3034 #need to impplement call to qemu-ga
3037 sub qga_unfreezefs
{
3040 #need to impplement call to qemu-ga
3044 my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused, $forcemachine, $spice_ticket) = @_;
3046 lock_config
($vmid, sub {
3047 my $conf = load_config
($vmid, $migratedfrom);
3049 die "you can't start a vm if it's a template\n" if is_template
($conf);
3051 check_lock
($conf) if !$skiplock;
3053 die "VM $vmid already running\n" if check_running
($vmid, undef, $migratedfrom);
3055 my $defaults = load_defaults
();
3057 # set environment variable useful inside network script
3058 $ENV{PVE_MIGRATED_FROM
} = $migratedfrom if $migratedfrom;
3060 my ($cmd, $vollist, $spice_port) = config_to_command
($storecfg, $vmid, $conf, $defaults, $forcemachine);
3062 my $migrate_port = 0;
3065 if ($statefile eq 'tcp') {
3066 my $localip = "localhost";
3067 my $datacenterconf = PVE
::Cluster
::cfs_read_file
('datacenter.cfg');
3068 if ($datacenterconf->{migration_unsecure
}) {
3069 my $nodename = PVE
::INotify
::nodename
();
3070 $localip = PVE
::Cluster
::remote_node_ip
($nodename, 1);
3072 $migrate_port = PVE
::Tools
::next_migrate_port
();
3073 $migrate_uri = "tcp:${localip}:${migrate_port}";
3074 push @$cmd, '-incoming', $migrate_uri;
3077 push @$cmd, '-loadstate', $statefile;
3084 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
3085 my $d = parse_hostpci
($conf->{"hostpci$i"});
3087 my $info = pci_device_info
("0000:$d->{pciid}");
3088 die "IOMMU not present\n" if !check_iommu_support
();
3089 die "no pci device info for device '$d->{pciid}'\n" if !$info;
3090 die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub
($info);
3091 die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset
($info);
3094 PVE
::Storage
::activate_volumes
($storecfg, $vollist);
3096 eval { run_command
($cmd, timeout
=> $statefile ?
undef : 30,
3099 die "start failed: $err" if $err;
3101 print "migration listens on $migrate_uri\n" if $migrate_uri;
3103 if ($statefile && $statefile ne 'tcp') {
3104 eval { vm_mon_cmd_nocheck
($vmid, "cont"); };
3108 if ($migratedfrom) {
3109 my $capabilities = {};
3110 $capabilities->{capability
} = "xbzrle";
3111 $capabilities->{state} = JSON
::true
;
3112 eval { vm_mon_cmd_nocheck
($vmid, "migrate-set-capabilities", capabilities
=> [$capabilities]); };
3116 print "spice listens on port $spice_port\n";
3117 if ($spice_ticket) {
3118 PVE
::QemuServer
::vm_mon_cmd_nocheck
($vmid, "set_password", protocol
=> 'spice', password
=> $spice_ticket);
3119 PVE
::QemuServer
::vm_mon_cmd_nocheck
($vmid, "expire_password", protocol
=> 'spice', time => "+30");
3125 if (!$statefile && (!defined($conf->{balloon
}) || $conf->{balloon
})) {
3126 vm_mon_cmd_nocheck
($vmid, "balloon", value
=> $conf->{balloon
}*1024*1024)
3127 if $conf->{balloon
};
3128 vm_mon_cmd_nocheck
($vmid, 'qom-set',
3129 path
=> "machine/peripheral/balloon0",
3130 property
=> "guest-stats-polling-interval",
3138 my ($vmid, $execute, %params) = @_;
3140 my $cmd = { execute
=> $execute, arguments
=> \
%params };
3141 vm_qmp_command
($vmid, $cmd);
3144 sub vm_mon_cmd_nocheck
{
3145 my ($vmid, $execute, %params) = @_;
3147 my $cmd = { execute
=> $execute, arguments
=> \
%params };
3148 vm_qmp_command
($vmid, $cmd, 1);
3151 sub vm_qmp_command
{
3152 my ($vmid, $cmd, $nocheck) = @_;
3157 if ($cmd->{arguments
} && $cmd->{arguments
}->{timeout
}) {
3158 $timeout = $cmd->{arguments
}->{timeout
};
3159 delete $cmd->{arguments
}->{timeout
};
3163 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
3164 my $sname = qmp_socket
($vmid);
3166 my $qmpclient = PVE
::QMPClient-
>new();
3168 $res = $qmpclient->cmd($vmid, $cmd, $timeout);
3169 } elsif (-e
"${var_run_tmpdir}/$vmid.mon") {
3170 die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
3171 if scalar(%{$cmd->{arguments
}});
3172 vm_monitor_command
($vmid, $cmd->{execute
}, $nocheck);
3174 die "unable to open monitor socket\n";
3178 syslog
("err", "VM $vmid qmp command failed - $err");
3185 sub vm_human_monitor_command
{
3186 my ($vmid, $cmdline) = @_;
3191 execute
=> 'human-monitor-command',
3192 arguments
=> { 'command-line' => $cmdline},
3195 return vm_qmp_command
($vmid, $cmd);
3198 sub vm_commandline
{
3199 my ($storecfg, $vmid) = @_;
3201 my $conf = load_config
($vmid);
3203 my $defaults = load_defaults
();
3205 my $cmd = config_to_command
($storecfg, $vmid, $conf, $defaults);
3207 return join(' ', @$cmd);
3211 my ($vmid, $skiplock) = @_;
3213 lock_config
($vmid, sub {
3215 my $conf = load_config
($vmid);
3217 check_lock
($conf) if !$skiplock;
3219 vm_mon_cmd
($vmid, "system_reset");
3223 sub get_vm_volumes
{
3227 foreach_volid
($conf, sub {
3228 my ($volid, $is_cdrom) = @_;
3230 return if $volid =~ m
|^/|;
3232 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
3235 push @$vollist, $volid;
3241 sub vm_stop_cleanup
{
3242 my ($storecfg, $vmid, $conf, $keepActive) = @_;
3245 fairsched_rmnod
($vmid); # try to destroy group
3248 my $vollist = get_vm_volumes
($conf);
3249 PVE
::Storage
::deactivate_volumes
($storecfg, $vollist);
3252 foreach my $ext (qw(mon qmp pid vnc qga)) {
3253 unlink "/var/run/qemu-server/${vmid}.$ext";
3256 warn $@ if $@; # avoid errors - just warn
3259 # Note: use $nockeck to skip tests if VM configuration file exists.
3260 # We need that when migration VMs to other nodes (files already moved)
3261 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3263 my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3265 $force = 1 if !defined($force) && !$shutdown;
3268 my $pid = check_running
($vmid, $nocheck, $migratedfrom);
3269 kill 15, $pid if $pid;
3270 my $conf = load_config
($vmid, $migratedfrom);
3271 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive);
3275 lock_config
($vmid, sub {
3277 my $pid = check_running
($vmid, $nocheck);
3282 $conf = load_config
($vmid);
3283 check_lock
($conf) if !$skiplock;
3284 if (!defined($timeout) && $shutdown && $conf->{startup
}) {
3285 my $opts = parse_startup
($conf->{startup
});
3286 $timeout = $opts->{down
} if $opts->{down
};
3290 $timeout = 60 if !defined($timeout);
3294 $nocheck ? vm_mon_cmd_nocheck
($vmid, "system_powerdown") : vm_mon_cmd
($vmid, "system_powerdown");
3297 $nocheck ? vm_mon_cmd_nocheck
($vmid, "quit") : vm_mon_cmd
($vmid, "quit");
3304 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
3309 if ($count >= $timeout) {
3311 warn "VM still running - terminating now with SIGTERM\n";
3314 die "VM quit/powerdown failed - got timeout\n";
3317 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
3322 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3325 die "VM quit/powerdown failed\n";
3333 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
3338 if ($count >= $timeout) {
3339 warn "VM still running - terminating now with SIGKILL\n";
3344 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
3349 my ($vmid, $skiplock) = @_;
3351 lock_config
($vmid, sub {
3353 my $conf = load_config
($vmid);
3355 check_lock
($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3357 vm_mon_cmd
($vmid, "stop");
3362 my ($vmid, $skiplock) = @_;
3364 lock_config
($vmid, sub {
3366 my $conf = load_config
($vmid);
3368 check_lock
($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3370 vm_mon_cmd
($vmid, "cont");
3375 my ($vmid, $skiplock, $key) = @_;
3377 lock_config
($vmid, sub {
3379 my $conf = load_config
($vmid);
3381 # there is no qmp command, so we use the human monitor command
3382 vm_human_monitor_command
($vmid, "sendkey $key");
3387 my ($storecfg, $vmid, $skiplock) = @_;
3389 lock_config
($vmid, sub {
3391 my $conf = load_config
($vmid);
3393 check_lock
($conf) if !$skiplock;
3395 if (!check_running
($vmid)) {
3396 fairsched_rmnod
($vmid); # try to destroy group
3397 destroy_vm
($storecfg, $vmid);
3399 die "VM $vmid is running - destroy failed\n";
3407 my ($filename, $buf) = @_;
3409 my $fh = IO
::File-
>new($filename, "w");
3410 return undef if !$fh;
3412 my $res = print $fh $buf;
3419 sub pci_device_info
{
3424 return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3425 my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3427 my $irq = file_read_firstline
("$pcisysfs/devices/$name/irq");
3428 return undef if !defined($irq) || $irq !~ m/^\d+$/;
3430 my $vendor = file_read_firstline
("$pcisysfs/devices/$name/vendor");
3431 return undef if !defined($vendor) || $vendor !~ s/^0x//;
3433 my $product = file_read_firstline
("$pcisysfs/devices/$name/device");
3434 return undef if !defined($product) || $product !~ s/^0x//;
3439 product
=> $product,
3445 has_fl_reset
=> -f
"$pcisysfs/devices/$name/reset" || 0,
3454 my $name = $dev->{name
};
3456 my $fn = "$pcisysfs/devices/$name/reset";
3458 return file_write
($fn, "1");
3461 sub pci_dev_bind_to_stub
{
3464 my $name = $dev->{name
};
3466 my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3467 return 1 if -d
$testdir;
3469 my $data = "$dev->{vendor} $dev->{product}";
3470 return undef if !file_write
("$pcisysfs/drivers/pci-stub/new_id", $data);
3472 my $fn = "$pcisysfs/devices/$name/driver/unbind";
3473 if (!file_write
($fn, $name)) {
3474 return undef if -f
$fn;
3477 $fn = "$pcisysfs/drivers/pci-stub/bind";
3478 if (! -d
$testdir) {
3479 return undef if !file_write
($fn, $name);
3485 sub print_pci_addr
{
3486 my ($id, $bridges) = @_;
3490 piix3
=> { bus
=> 0, addr
=> 1 },
3491 #addr2 : first videocard
3492 balloon0
=> { bus
=> 0, addr
=> 3 },
3493 watchdog
=> { bus
=> 0, addr
=> 4 },
3494 scsihw0
=> { bus
=> 0, addr
=> 5 },
3495 scsihw1
=> { bus
=> 0, addr
=> 6 },
3496 ahci0
=> { bus
=> 0, addr
=> 7 },
3497 qga0
=> { bus
=> 0, addr
=> 8 },
3498 spice
=> { bus
=> 0, addr
=> 9 },
3499 virtio0
=> { bus
=> 0, addr
=> 10 },
3500 virtio1
=> { bus
=> 0, addr
=> 11 },
3501 virtio2
=> { bus
=> 0, addr
=> 12 },
3502 virtio3
=> { bus
=> 0, addr
=> 13 },
3503 virtio4
=> { bus
=> 0, addr
=> 14 },
3504 virtio5
=> { bus
=> 0, addr
=> 15 },
3505 hostpci0
=> { bus
=> 0, addr
=> 16 },
3506 hostpci1
=> { bus
=> 0, addr
=> 17 },
3507 net0
=> { bus
=> 0, addr
=> 18 },
3508 net1
=> { bus
=> 0, addr
=> 19 },
3509 net2
=> { bus
=> 0, addr
=> 20 },
3510 net3
=> { bus
=> 0, addr
=> 21 },
3511 net4
=> { bus
=> 0, addr
=> 22 },
3512 net5
=> { bus
=> 0, addr
=> 23 },
3513 #addr29 : usb-host (pve-usb.cfg)
3514 'pci.1' => { bus
=> 0, addr
=> 30 },
3515 'pci.2' => { bus
=> 0, addr
=> 31 },
3516 'net6' => { bus
=> 1, addr
=> 1 },
3517 'net7' => { bus
=> 1, addr
=> 2 },
3518 'net8' => { bus
=> 1, addr
=> 3 },
3519 'net9' => { bus
=> 1, addr
=> 4 },
3520 'net10' => { bus
=> 1, addr
=> 5 },
3521 'net11' => { bus
=> 1, addr
=> 6 },
3522 'net12' => { bus
=> 1, addr
=> 7 },
3523 'net13' => { bus
=> 1, addr
=> 8 },
3524 'net14' => { bus
=> 1, addr
=> 9 },
3525 'net15' => { bus
=> 1, addr
=> 10 },
3526 'net16' => { bus
=> 1, addr
=> 11 },
3527 'net17' => { bus
=> 1, addr
=> 12 },
3528 'net18' => { bus
=> 1, addr
=> 13 },
3529 'net19' => { bus
=> 1, addr
=> 14 },
3530 'net20' => { bus
=> 1, addr
=> 15 },
3531 'net21' => { bus
=> 1, addr
=> 16 },
3532 'net22' => { bus
=> 1, addr
=> 17 },
3533 'net23' => { bus
=> 1, addr
=> 18 },
3534 'net24' => { bus
=> 1, addr
=> 19 },
3535 'net25' => { bus
=> 1, addr
=> 20 },
3536 'net26' => { bus
=> 1, addr
=> 21 },
3537 'net27' => { bus
=> 1, addr
=> 22 },
3538 'net28' => { bus
=> 1, addr
=> 23 },
3539 'net29' => { bus
=> 1, addr
=> 24 },
3540 'net30' => { bus
=> 1, addr
=> 25 },
3541 'net31' => { bus
=> 1, addr
=> 26 },
3542 'virtio6' => { bus
=> 2, addr
=> 1 },
3543 'virtio7' => { bus
=> 2, addr
=> 2 },
3544 'virtio8' => { bus
=> 2, addr
=> 3 },
3545 'virtio9' => { bus
=> 2, addr
=> 4 },
3546 'virtio10' => { bus
=> 2, addr
=> 5 },
3547 'virtio11' => { bus
=> 2, addr
=> 6 },
3548 'virtio12' => { bus
=> 2, addr
=> 7 },
3549 'virtio13' => { bus
=> 2, addr
=> 8 },
3550 'virtio14' => { bus
=> 2, addr
=> 9 },
3551 'virtio15' => { bus
=> 2, addr
=> 10 },
3554 if (defined($devices->{$id}->{bus
}) && defined($devices->{$id}->{addr
})) {
3555 my $addr = sprintf("0x%x", $devices->{$id}->{addr
});
3556 my $bus = $devices->{$id}->{bus
};
3557 $res = ",bus=pci.$bus,addr=$addr";
3558 $bridges->{$bus} = 1 if $bridges;
3564 # vzdump restore implementaion
3566 sub tar_archive_read_firstfile
{
3567 my $archive = shift;
3569 die "ERROR: file '$archive' does not exist\n" if ! -f
$archive;
3571 # try to detect archive type first
3572 my $pid = open (TMP
, "tar tf '$archive'|") ||
3573 die "unable to open file '$archive'\n";
3574 my $firstfile = <TMP
>;
3578 die "ERROR: archive contaions no data\n" if !$firstfile;
3584 sub tar_restore_cleanup
{
3585 my ($storecfg, $statfile) = @_;
3587 print STDERR
"starting cleanup\n";
3589 if (my $fd = IO
::File-
>new($statfile, "r")) {
3590 while (defined(my $line = <$fd>)) {
3591 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3594 if ($volid =~ m
|^/|) {
3595 unlink $volid || die 'unlink failed\n';
3597 PVE
::Storage
::vdisk_free
($storecfg, $volid);
3599 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
3601 print STDERR
"unable to cleanup '$volid' - $@" if $@;
3603 print STDERR
"unable to parse line in statfile - $line";
3610 sub restore_archive
{
3611 my ($archive, $vmid, $user, $opts) = @_;
3613 my $format = $opts->{format
};
3616 if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
3617 $format = 'tar' if !$format;
3619 } elsif ($archive =~ m/\.tar$/) {
3620 $format = 'tar' if !$format;
3621 } elsif ($archive =~ m/.tar.lzo$/) {
3622 $format = 'tar' if !$format;
3624 } elsif ($archive =~ m/\.vma$/) {
3625 $format = 'vma' if !$format;
3626 } elsif ($archive =~ m/\.vma\.gz$/) {
3627 $format = 'vma' if !$format;
3629 } elsif ($archive =~ m/\.vma\.lzo$/) {
3630 $format = 'vma' if !$format;
3633 $format = 'vma' if !$format; # default
3636 # try to detect archive format
3637 if ($format eq 'tar') {
3638 return restore_tar_archive
($archive, $vmid, $user, $opts);
3640 return restore_vma_archive
($archive, $vmid, $user, $opts, $comp);
3644 sub restore_update_config_line
{
3645 my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
3647 return if $line =~ m/^\#qmdump\#/;
3648 return if $line =~ m/^\#vzdump\#/;
3649 return if $line =~ m/^lock:/;
3650 return if $line =~ m/^unused\d+:/;
3651 return if $line =~ m/^parent:/;
3652 return if $line =~ m/^template:/; # restored VM is never a template
3654 if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3655 # try to convert old 1.X settings
3656 my ($id, $ind, $ethcfg) = ($1, $2, $3);
3657 foreach my $devconfig (PVE
::Tools
::split_list
($ethcfg)) {
3658 my ($model, $macaddr) = split(/\=/, $devconfig);
3659 $macaddr = PVE
::Tools
::random_ether_addr
() if !$macaddr || $unique;
3662 bridge
=> "vmbr$ind",
3663 macaddr
=> $macaddr,
3665 my $netstr = print_net
($net);
3667 print $outfd "net$cookie->{netcount}: $netstr\n";
3668 $cookie->{netcount
}++;
3670 } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
3671 my ($id, $netstr) = ($1, $2);
3672 my $net = parse_net
($netstr);
3673 $net->{macaddr
} = PVE
::Tools
::random_ether_addr
() if $net->{macaddr
};
3674 $netstr = print_net
($net);
3675 print $outfd "$id: $netstr\n";
3676 } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
3679 if ($line =~ m/backup=no/) {
3680 print $outfd "#$line";
3681 } elsif ($virtdev && $map->{$virtdev}) {
3682 my $di = parse_drive
($virtdev, $value);
3683 delete $di->{format
}; # format can change on restore
3684 $di->{file
} = $map->{$virtdev};
3685 $value = print_drive
($vmid, $di);
3686 print $outfd "$virtdev: $value\n";
3696 my ($cfg, $vmid) = @_;
3698 my $info = PVE
::Storage
::vdisk_list
($cfg, undef, $vmid);
3700 my $volid_hash = {};
3701 foreach my $storeid (keys %$info) {
3702 foreach my $item (@{$info->{$storeid}}) {
3703 next if !($item->{volid
} && $item->{size
});
3704 $item->{path
} = PVE
::Storage
::path
($cfg, $item->{volid
});
3705 $volid_hash->{$item->{volid
}} = $item;
3712 sub get_used_paths
{
3713 my ($vmid, $storecfg, $conf, $scan_snapshots, $skip_drive) = @_;
3717 my $scan_config = sub {
3718 my ($cref, $snapname) = @_;
3720 foreach my $key (keys %$cref) {
3721 my $value = $cref->{$key};
3722 if (valid_drivename
($key)) {
3723 next if $skip_drive && $key eq $skip_drive;
3724 my $drive = parse_drive
($key, $value);
3725 next if !$drive || !$drive->{file
} || drive_is_cdrom
($drive);
3726 if ($drive->{file
} =~ m!^/!) {
3727 $used_path->{$drive->{file
}}++; # = 1;
3729 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($drive->{file
}, 1);
3731 my $scfg = PVE
::Storage
::storage_config
($storecfg, $storeid, 1);
3733 my $path = PVE
::Storage
::path
($storecfg, $drive->{file
}, $snapname);
3734 $used_path->{$path}++; # = 1;
3740 &$scan_config($conf);
3744 if ($scan_snapshots) {
3745 foreach my $snapname (keys %{$conf->{snapshots
}}) {
3746 &$scan_config($conf->{snapshots
}->{$snapname}, $snapname);
3753 sub update_disksize
{
3754 my ($vmid, $conf, $volid_hash) = @_;
3760 # Note: it is allowed to define multiple storages with same path (alias), so
3761 # we need to check both 'volid' and real 'path' (two different volid can point
3762 # to the same path).
3767 foreach my $opt (keys %$conf) {
3768 if (valid_drivename
($opt)) {
3769 my $drive = parse_drive
($opt, $conf->{$opt});
3770 my $volid = $drive->{file
};
3773 $used->{$volid} = 1;
3774 if ($volid_hash->{$volid} &&
3775 (my $path = $volid_hash->{$volid}->{path
})) {
3776 $usedpath->{$path} = 1;
3779 next if drive_is_cdrom
($drive);
3780 next if !$volid_hash->{$volid};
3782 $drive->{size
} = $volid_hash->{$volid}->{size
};
3783 my $new = print_drive
($vmid, $drive);
3784 if ($new ne $conf->{$opt}) {
3786 $conf->{$opt} = $new;
3791 # remove 'unusedX' entry if volume is used
3792 foreach my $opt (keys %$conf) {
3793 next if $opt !~ m/^unused\d+$/;
3794 my $volid = $conf->{$opt};
3795 my $path = $volid_hash->{$volid}->{path
} if $volid_hash->{$volid};
3796 if ($used->{$volid} || ($path && $usedpath->{$path})) {
3798 delete $conf->{$opt};
3802 foreach my $volid (sort keys %$volid_hash) {
3803 next if $volid =~ m/vm-$vmid-state-/;
3804 next if $used->{$volid};
3805 my $path = $volid_hash->{$volid}->{path
};
3806 next if !$path; # just to be sure
3807 next if $usedpath->{$path};
3809 add_unused_volume
($conf, $volid);
3810 $usedpath->{$path} = 1; # avoid to add more than once (aliases)
3817 my ($vmid, $nolock) = @_;
3819 my $cfg = PVE
::Cluster
::cfs_read_file
("storage.cfg");
3821 my $volid_hash = scan_volids
($cfg, $vmid);
3823 my $updatefn = sub {
3826 my $conf = load_config
($vmid);
3831 foreach my $volid (keys %$volid_hash) {
3832 my $info = $volid_hash->{$volid};
3833 $vm_volids->{$volid} = $info if $info->{vmid
} && $info->{vmid
} == $vmid;
3836 my $changes = update_disksize
($vmid, $conf, $vm_volids);
3838 update_config_nolock
($vmid, $conf, 1) if $changes;
3841 if (defined($vmid)) {
3845 lock_config
($vmid, $updatefn, $vmid);
3848 my $vmlist = config_list
();
3849 foreach my $vmid (keys %$vmlist) {
3853 lock_config
($vmid, $updatefn, $vmid);
3859 sub restore_vma_archive
{
3860 my ($archive, $vmid, $user, $opts, $comp) = @_;
3862 my $input = $archive eq '-' ?
"<&STDIN" : undef;
3863 my $readfrom = $archive;
3868 my $qarchive = PVE
::Tools
::shellquote
($archive);
3869 if ($comp eq 'gzip') {
3870 $uncomp = "zcat $qarchive|";
3871 } elsif ($comp eq 'lzop') {
3872 $uncomp = "lzop -d -c $qarchive|";
3874 die "unknown compression method '$comp'\n";
3879 my $tmpdir = "/var/tmp/vzdumptmp$$";
3882 # disable interrupts (always do cleanups)
3883 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
3884 warn "got interrupt - ignored\n";
3887 my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
3888 POSIX
::mkfifo
($mapfifo, 0600);
3891 my $openfifo = sub {
3892 open($fifofh, '>', $mapfifo) || die $!;
3895 my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
3902 my $rpcenv = PVE
::RPCEnvironment
::get
();
3904 my $conffile = config_file
($vmid);
3905 my $tmpfn = "$conffile.$$.tmp";
3907 # Note: $oldconf is undef if VM does not exists
3908 my $oldconf = PVE
::Cluster
::cfs_read_file
(cfs_config_path
($vmid));
3910 my $print_devmap = sub {
3911 my $virtdev_hash = {};
3913 my $cfgfn = "$tmpdir/qemu-server.conf";
3915 # we can read the config - that is already extracted
3916 my $fh = IO
::File-
>new($cfgfn, "r") ||
3917 "unable to read qemu-server.conf - $!\n";
3919 while (defined(my $line = <$fh>)) {
3920 if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
3921 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
3922 die "archive does not contain data for drive '$virtdev'\n"
3923 if !$devinfo->{$devname};
3924 if (defined($opts->{storage
})) {
3925 $storeid = $opts->{storage
} || 'local';
3926 } elsif (!$storeid) {
3929 $format = 'raw' if !$format;
3930 $devinfo->{$devname}->{devname
} = $devname;
3931 $devinfo->{$devname}->{virtdev
} = $virtdev;
3932 $devinfo->{$devname}->{format
} = $format;
3933 $devinfo->{$devname}->{storeid
} = $storeid;
3935 # check permission on storage
3936 my $pool = $opts->{pool
}; # todo: do we need that?
3937 if ($user ne 'root@pam') {
3938 $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
3941 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
3945 foreach my $devname (keys %$devinfo) {
3946 die "found no device mapping information for device '$devname'\n"
3947 if !$devinfo->{$devname}->{virtdev
};
3950 my $cfg = cfs_read_file
('storage.cfg');
3952 # create empty/temp config
3954 PVE
::Tools
::file_set_contents
($conffile, "memory: 128\n");
3955 foreach_drive
($oldconf, sub {
3956 my ($ds, $drive) = @_;
3958 return if drive_is_cdrom
($drive);
3960 my $volid = $drive->{file
};
3962 return if !$volid || $volid =~ m
|^/|;
3964 my ($path, $owner) = PVE
::Storage
::path
($cfg, $volid);
3965 return if !$path || !$owner || ($owner != $vmid);
3967 # Note: only delete disk we want to restore
3968 # other volumes will become unused
3969 if ($virtdev_hash->{$ds}) {
3970 PVE
::Storage
::vdisk_free
($cfg, $volid);
3976 foreach my $virtdev (sort keys %$virtdev_hash) {
3977 my $d = $virtdev_hash->{$virtdev};
3978 my $alloc_size = int(($d->{size
} + 1024 - 1)/1024);
3979 my $scfg = PVE
::Storage
::storage_config
($cfg, $d->{storeid
});
3981 # test if requested format is supported
3982 my ($defFormat, $validFormats) = PVE
::Storage
::storage_default_format
($cfg, $d->{storeid
});
3983 my $supported = grep { $_ eq $d->{format
} } @$validFormats;
3984 $d->{format
} = $defFormat if !$supported;
3986 my $volid = PVE
::Storage
::vdisk_alloc
($cfg, $d->{storeid
}, $vmid,
3987 $d->{format
}, undef, $alloc_size);
3988 print STDERR
"new volume ID is '$volid'\n";
3989 $d->{volid
} = $volid;
3990 my $path = PVE
::Storage
::path
($cfg, $volid);
3992 my $write_zeros = 1;
3993 # fixme: what other storages types initialize volumes with zero?
3994 if ($scfg->{type
} eq 'dir' || $scfg->{type
} eq 'nfs' ||
3995 $scfg->{type
} eq 'sheepdog' || $scfg->{type
} eq 'rbd') {
3999 print $fifofh "${write_zeros}:$d->{devname}=$path\n";
4001 print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
4002 $map->{$virtdev} = $volid;
4005 $fh->seek(0, 0) || die "seek failed - $!\n";
4007 my $outfd = new IO
::File
($tmpfn, "w") ||
4008 die "unable to write config for VM $vmid\n";
4010 my $cookie = { netcount
=> 0 };
4011 while (defined(my $line = <$fh>)) {
4012 restore_update_config_line
($outfd, $cookie, $vmid, $map, $line, $opts->{unique
});
4021 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
4022 die "interrupted by signal\n";
4024 local $SIG{ALRM
} = sub { die "got timeout\n"; };
4026 $oldtimeout = alarm($timeout);
4033 if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
4034 my ($dev_id, $size, $devname) = ($1, $2, $3);
4035 $devinfo->{$devname} = { size
=> $size, dev_id
=> $dev_id };
4036 } elsif ($line =~ m/^CTIME: /) {
4038 print $fifofh "done\n";
4039 my $tmp = $oldtimeout || 0;
4040 $oldtimeout = undef;
4046 print "restore vma archive: $cmd\n";
4047 run_command
($cmd, input
=> $input, outfunc
=> $parser, afterfork
=> $openfifo);
4051 alarm($oldtimeout) if $oldtimeout;
4059 my $cfg = cfs_read_file
('storage.cfg');
4060 foreach my $devname (keys %$devinfo) {
4061 my $volid = $devinfo->{$devname}->{volid
};
4064 if ($volid =~ m
|^/|) {
4065 unlink $volid || die 'unlink failed\n';
4067 PVE
::Storage
::vdisk_free
($cfg, $volid);
4069 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
4071 print STDERR
"unable to cleanup '$volid' - $@" if $@;
4078 rename($tmpfn, $conffile) ||
4079 die "unable to commit configuration file '$conffile'\n";
4081 PVE
::Cluster
::cfs_update
(); # make sure we read new file
4083 eval { rescan
($vmid, 1); };
4087 sub restore_tar_archive
{
4088 my ($archive, $vmid, $user, $opts) = @_;
4090 if ($archive ne '-') {
4091 my $firstfile = tar_archive_read_firstfile
($archive);
4092 die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
4093 if $firstfile ne 'qemu-server.conf';
4096 my $storecfg = cfs_read_file
('storage.cfg');
4098 # destroy existing data - keep empty config
4099 my $vmcfgfn = PVE
::QemuServer
::config_file
($vmid);
4100 destroy_vm
($storecfg, $vmid, 1) if -f
$vmcfgfn;
4102 my $tocmd = "/usr/lib/qemu-server/qmextract";
4104 $tocmd .= " --storage " . PVE
::Tools
::shellquote
($opts->{storage
}) if $opts->{storage
};
4105 $tocmd .= " --pool " . PVE
::Tools
::shellquote
($opts->{pool
}) if $opts->{pool
};
4106 $tocmd .= ' --prealloc' if $opts->{prealloc
};
4107 $tocmd .= ' --info' if $opts->{info
};
4109 # tar option "xf" does not autodetect compression when read from STDIN,
4110 # so we pipe to zcat
4111 my $cmd = "zcat -f|tar xf " . PVE
::Tools
::shellquote
($archive) . " " .
4112 PVE
::Tools
::shellquote
("--to-command=$tocmd");
4114 my $tmpdir = "/var/tmp/vzdumptmp$$";
4117 local $ENV{VZDUMP_TMPDIR
} = $tmpdir;
4118 local $ENV{VZDUMP_VMID
} = $vmid;
4119 local $ENV{VZDUMP_USER
} = $user;
4121 my $conffile = config_file
($vmid);
4122 my $tmpfn = "$conffile.$$.tmp";
4124 # disable interrupts (always do cleanups)
4125 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
4126 print STDERR
"got interrupt - ignored\n";
4131 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
4132 die "interrupted by signal\n";
4135 if ($archive eq '-') {
4136 print "extracting archive from STDIN\n";
4137 run_command
($cmd, input
=> "<&STDIN");
4139 print "extracting archive '$archive'\n";
4143 return if $opts->{info
};
4147 my $statfile = "$tmpdir/qmrestore.stat";
4148 if (my $fd = IO
::File-
>new($statfile, "r")) {
4149 while (defined (my $line = <$fd>)) {
4150 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4151 $map->{$1} = $2 if $1;
4153 print STDERR
"unable to parse line in statfile - $line\n";
4159 my $confsrc = "$tmpdir/qemu-server.conf";
4161 my $srcfd = new IO
::File
($confsrc, "r") ||
4162 die "unable to open file '$confsrc'\n";
4164 my $outfd = new IO
::File
($tmpfn, "w") ||
4165 die "unable to write config for VM $vmid\n";
4167 my $cookie = { netcount
=> 0 };
4168 while (defined (my $line = <$srcfd>)) {
4169 restore_update_config_line
($outfd, $cookie, $vmid, $map, $line, $opts->{unique
});
4181 tar_restore_cleanup
($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info
};
4188 rename $tmpfn, $conffile ||
4189 die "unable to commit configuration file '$conffile'\n";
4191 PVE
::Cluster
::cfs_update
(); # make sure we read new file
4193 eval { rescan
($vmid, 1); };
4198 # Internal snapshots
4200 # NOTE: Snapshot create/delete involves several non-atomic
4201 # action, and can take a long time.
4202 # So we try to avoid locking the file and use 'lock' variable
4203 # inside the config file instead.
4205 my $snapshot_copy_config = sub {
4206 my ($source, $dest) = @_;
4208 foreach my $k (keys %$source) {
4209 next if $k eq 'snapshots';
4210 next if $k eq 'snapstate';
4211 next if $k eq 'snaptime';
4212 next if $k eq 'vmstate';
4213 next if $k eq 'lock';
4214 next if $k eq 'digest';
4215 next if $k eq 'description';
4216 next if $k =~ m/^unused\d+$/;
4218 $dest->{$k} = $source->{$k};
4222 my $snapshot_apply_config = sub {
4223 my ($conf, $snap) = @_;
4225 # copy snapshot list
4227 snapshots
=> $conf->{snapshots
},
4230 # keep description and list of unused disks
4231 foreach my $k (keys %$conf) {
4232 next if !($k =~ m/^unused\d+$/ || $k eq 'description');
4233 $newconf->{$k} = $conf->{$k};
4236 &$snapshot_copy_config($snap, $newconf);
4241 sub foreach_writable_storage
{
4242 my ($conf, $func) = @_;
4246 foreach my $ds (keys %$conf) {
4247 next if !valid_drivename
($ds);
4249 my $drive = parse_drive
($ds, $conf->{$ds});
4251 next if drive_is_cdrom
($drive);
4253 my $volid = $drive->{file
};
4255 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
4256 $sidhash->{$sid} = $sid if $sid;
4259 foreach my $sid (sort keys %$sidhash) {
4264 my $alloc_vmstate_volid = sub {
4265 my ($storecfg, $vmid, $conf, $snapname) = @_;
4267 # Note: we try to be smart when selecting a $target storage
4271 # search shared storage first
4272 foreach_writable_storage
($conf, sub {
4274 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
4275 return if !$scfg->{shared
};
4277 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage
4281 # now search local storage
4282 foreach_writable_storage
($conf, sub {
4284 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
4285 return if $scfg->{shared
};
4287 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage;
4291 $target = 'local' if !$target;
4293 my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
4294 # we abort live save after $conf->{memory}, so we need at max twice that space
4295 my $size = $conf->{memory
}*2 + $driver_state_size;
4297 my $name = "vm-$vmid-state-$snapname";
4298 my $scfg = PVE
::Storage
::storage_config
($storecfg, $target);
4299 $name .= ".raw" if $scfg->{path
}; # add filename extension for file base storage
4300 my $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $target, $vmid, 'raw', $name, $size*1024);
4305 my $snapshot_prepare = sub {
4306 my ($vmid, $snapname, $save_vmstate, $comment) = @_;
4310 my $updatefn = sub {
4312 my $conf = load_config
($vmid);
4314 die "you can't take a snapshot if it's a template\n"
4315 if is_template
($conf);
4319 $conf->{lock} = 'snapshot';
4321 die "snapshot name '$snapname' already used\n"
4322 if defined($conf->{snapshots
}->{$snapname});
4324 my $storecfg = PVE
::Storage
::config
();
4325 die "snapshot feature is not available" if !has_feature
('snapshot', $conf, $storecfg);
4327 $snap = $conf->{snapshots
}->{$snapname} = {};
4329 if ($save_vmstate && check_running
($vmid)) {
4330 $snap->{vmstate
} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
4333 &$snapshot_copy_config($conf, $snap);
4335 $snap->{snapstate
} = "prepare";
4336 $snap->{snaptime
} = time();
4337 $snap->{description
} = $comment if $comment;
4339 # always overwrite machine if we save vmstate. This makes sure we
4340 # can restore it later using correct machine type
4341 $snap->{machine
} = get_current_qemu_machine
($vmid) if $snap->{vmstate
};
4343 update_config_nolock
($vmid, $conf, 1);
4346 lock_config
($vmid, $updatefn);
4351 my $snapshot_commit = sub {
4352 my ($vmid, $snapname) = @_;
4354 my $updatefn = sub {
4356 my $conf = load_config
($vmid);
4358 die "missing snapshot lock\n"
4359 if !($conf->{lock} && $conf->{lock} eq 'snapshot');
4361 my $snap = $conf->{snapshots
}->{$snapname};
4363 die "snapshot '$snapname' does not exist\n" if !defined($snap);
4365 die "wrong snapshot state\n"
4366 if !($snap->{snapstate
} && $snap->{snapstate
} eq "prepare");
4368 delete $snap->{snapstate
};
4369 delete $conf->{lock};
4371 my $newconf = &$snapshot_apply_config($conf, $snap);
4373 $newconf->{parent
} = $snapname;
4375 update_config_nolock
($vmid, $newconf, 1);
4378 lock_config
($vmid, $updatefn);
4381 sub snapshot_rollback
{
4382 my ($vmid, $snapname) = @_;
4388 my $storecfg = PVE
::Storage
::config
();
4390 my $updatefn = sub {
4392 my $conf = load_config
($vmid);
4394 die "you can't rollback if vm is a template\n" if is_template
($conf);
4396 $snap = $conf->{snapshots
}->{$snapname};
4398 die "snapshot '$snapname' does not exist\n" if !defined($snap);
4400 die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
4401 if $snap->{snapstate
};
4405 vm_stop
($storecfg, $vmid, undef, undef, 5, undef, undef);
4408 die "unable to rollback vm $vmid: vm is running\n"
4409 if check_running
($vmid);
4412 $conf->{lock} = 'rollback';
4414 die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
4415 delete $conf->{lock};
4421 my $has_machine_config = defined($conf->{machine
});
4423 # copy snapshot config to current config
4424 $conf = &$snapshot_apply_config($conf, $snap);
4425 $conf->{parent
} = $snapname;
4427 # Note: old code did not store 'machine', so we try to be smart
4428 # and guess the snapshot was generated with kvm 1.4 (pc-i440fx-1.4).
4429 $forcemachine = $conf->{machine
} || 'pc-i440fx-1.4';
4430 # we remove the 'machine' configuration if not explicitly specified
4431 # in the original config.
4432 delete $conf->{machine
} if $snap->{vmstate
} && !$has_machine_config;
4435 update_config_nolock
($vmid, $conf, 1);
4437 if (!$prepare && $snap->{vmstate
}) {
4438 my $statefile = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
4439 vm_start
($storecfg, $vmid, $statefile, undef, undef, undef, $forcemachine);
4443 lock_config
($vmid, $updatefn);
4445 foreach_drive
($snap, sub {
4446 my ($ds, $drive) = @_;
4448 return if drive_is_cdrom
($drive);
4450 my $volid = $drive->{file
};
4451 my $device = "drive-$ds";
4453 PVE
::Storage
::volume_snapshot_rollback
($storecfg, $volid, $snapname);
4457 lock_config
($vmid, $updatefn);
4460 my $savevm_wait = sub {
4464 my $stat = vm_mon_cmd_nocheck
($vmid, "query-savevm");
4465 if (!$stat->{status
}) {
4466 die "savevm not active\n";
4467 } elsif ($stat->{status
} eq 'active') {
4470 } elsif ($stat->{status
} eq 'completed') {
4473 die "query-savevm returned status '$stat->{status}'\n";
4478 sub snapshot_create
{
4479 my ($vmid, $snapname, $save_vmstate, $freezefs, $comment) = @_;
4481 my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
4483 $freezefs = $save_vmstate = 0 if !$snap->{vmstate
}; # vm is not running
4487 my $running = check_running
($vmid);
4490 # create internal snapshots of all drives
4492 my $storecfg = PVE
::Storage
::config
();
4495 if ($snap->{vmstate
}) {
4496 my $path = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
4497 vm_mon_cmd
($vmid, "savevm-start", statefile
=> $path);
4498 &$savevm_wait($vmid);
4500 vm_mon_cmd
($vmid, "savevm-start");
4504 qga_freezefs
($vmid) if $running && $freezefs;
4506 foreach_drive
($snap, sub {
4507 my ($ds, $drive) = @_;
4509 return if drive_is_cdrom
($drive);
4511 my $volid = $drive->{file
};
4512 my $device = "drive-$ds";
4514 qemu_volume_snapshot
($vmid, $device, $storecfg, $volid, $snapname);
4515 $drivehash->{$ds} = 1;
4520 eval { qga_unfreezefs
($vmid) if $running && $freezefs; };
4523 eval { vm_mon_cmd
($vmid, "savevm-end") if $running; };
4527 warn "snapshot create failed: starting cleanup\n";
4528 eval { snapshot_delete
($vmid, $snapname, 0, $drivehash); };
4533 &$snapshot_commit($vmid, $snapname);
4536 # Note: $drivehash is only set when called from snapshot_create.
4537 sub snapshot_delete
{
4538 my ($vmid, $snapname, $force, $drivehash) = @_;
4545 my $unlink_parent = sub {
4546 my ($confref, $new_parent) = @_;
4548 if ($confref->{parent
} && $confref->{parent
} eq $snapname) {
4550 $confref->{parent
} = $new_parent;
4552 delete $confref->{parent
};
4557 my $updatefn = sub {
4558 my ($remove_drive) = @_;
4560 my $conf = load_config
($vmid);
4564 die "you can't delete a snapshot if vm is a template\n"
4565 if is_template
($conf);
4568 $snap = $conf->{snapshots
}->{$snapname};
4570 die "snapshot '$snapname' does not exist\n" if !defined($snap);
4572 # remove parent refs
4573 &$unlink_parent($conf, $snap->{parent
});
4574 foreach my $sn (keys %{$conf->{snapshots
}}) {
4575 next if $sn eq $snapname;
4576 &$unlink_parent($conf->{snapshots
}->{$sn}, $snap->{parent
});
4579 if ($remove_drive) {
4580 if ($remove_drive eq 'vmstate') {
4581 delete $snap->{$remove_drive};
4583 my $drive = parse_drive
($remove_drive, $snap->{$remove_drive});
4584 my $volid = $drive->{file
};
4585 delete $snap->{$remove_drive};
4586 add_unused_volume
($conf, $volid);
4591 $snap->{snapstate
} = 'delete';
4593 delete $conf->{snapshots
}->{$snapname};
4594 delete $conf->{lock} if $drivehash;
4595 foreach my $volid (@$unused) {
4596 add_unused_volume
($conf, $volid);
4600 update_config_nolock
($vmid, $conf, 1);
4603 lock_config
($vmid, $updatefn);
4605 # now remove vmstate file
4607 my $storecfg = PVE
::Storage
::config
();
4609 if ($snap->{vmstate
}) {
4610 eval { PVE
::Storage
::vdisk_free
($storecfg, $snap->{vmstate
}); };
4612 die $err if !$force;
4615 # save changes (remove vmstate from snapshot)
4616 lock_config
($vmid, $updatefn, 'vmstate') if !$force;
4619 # now remove all internal snapshots
4620 foreach_drive
($snap, sub {
4621 my ($ds, $drive) = @_;
4623 return if drive_is_cdrom
($drive);
4625 my $volid = $drive->{file
};
4626 my $device = "drive-$ds";
4628 if (!$drivehash || $drivehash->{$ds}) {
4629 eval { qemu_volume_snapshot_delete
($vmid, $device, $storecfg, $volid, $snapname); };
4631 die $err if !$force;
4636 # save changes (remove drive fron snapshot)
4637 lock_config
($vmid, $updatefn, $ds) if !$force;
4638 push @$unused, $volid;
4641 # now cleanup config
4643 lock_config
($vmid, $updatefn);
4647 my ($feature, $conf, $storecfg, $snapname, $running) = @_;
4650 foreach_drive
($conf, sub {
4651 my ($ds, $drive) = @_;
4653 return if drive_is_cdrom
($drive);
4654 my $volid = $drive->{file
};
4655 $err = 1 if !PVE
::Storage
::volume_has_feature
($storecfg, $feature, $volid, $snapname, $running);
4658 return $err ?
0 : 1;
4661 sub template_create
{
4662 my ($vmid, $conf, $disk) = @_;
4664 my $storecfg = PVE
::Storage
::config
();
4666 foreach_drive
($conf, sub {
4667 my ($ds, $drive) = @_;
4669 return if drive_is_cdrom
($drive);
4670 return if $disk && $ds ne $disk;
4672 my $volid = $drive->{file
};
4673 return if !PVE
::Storage
::volume_has_feature
($storecfg, 'template', $volid);
4675 my $voliddst = PVE
::Storage
::vdisk_create_base
($storecfg, $volid);
4676 $drive->{file
} = $voliddst;
4677 $conf->{$ds} = print_drive
($vmid, $drive);
4678 update_config_nolock
($vmid, $conf, 1);
4685 return 1 if defined $conf->{template
} && $conf->{template
} == 1;
4688 sub qemu_img_convert
{
4689 my ($src_volid, $dst_volid, $size, $snapname) = @_;
4691 my $storecfg = PVE
::Storage
::config
();
4692 my ($src_storeid, $src_volname) = PVE
::Storage
::parse_volume_id
($src_volid, 1);
4693 my ($dst_storeid, $dst_volname) = PVE
::Storage
::parse_volume_id
($dst_volid, 1);
4695 if ($src_storeid && $dst_storeid) {
4696 my $src_scfg = PVE
::Storage
::storage_config
($storecfg, $src_storeid);
4697 my $dst_scfg = PVE
::Storage
::storage_config
($storecfg, $dst_storeid);
4699 my $src_format = qemu_img_format
($src_scfg, $src_volname);
4700 my $dst_format = qemu_img_format
($dst_scfg, $dst_volname);
4702 my $src_path = PVE
::Storage
::path
($storecfg, $src_volid, $snapname);
4703 my $dst_path = PVE
::Storage
::path
($storecfg, $dst_volid);
4706 push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-C';
4707 push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
4708 push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
4712 if($line =~ m/\((\S+)\/100\
%\)/){
4714 my $transferred = int($size * $percent / 100);
4715 my $remaining = $size - $transferred;
4717 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
4722 eval { run_command
($cmd, timeout
=> undef, outfunc
=> $parser); };
4724 die "copy failed: $err" if $err;
4728 sub qemu_img_format
{
4729 my ($scfg, $volname) = @_;
4731 if ($scfg->{path
} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/) {
4733 } elsif ($scfg->{type
} eq 'iscsi') {
4734 return "host_device";
4740 sub qemu_drive_mirror
{
4741 my ($vmid, $drive, $dst_volid, $vmiddst, $maxwait) = @_;
4747 my $storecfg = PVE
::Storage
::config
();
4748 my ($dst_storeid, $dst_volname) = PVE
::Storage
::parse_volume_id
($dst_volid, 1);
4751 my $dst_scfg = PVE
::Storage
::storage_config
($storecfg, $dst_storeid);
4754 if ($dst_volname =~ m/\.(raw|qcow2)$/){
4758 my $dst_path = PVE
::Storage
::path
($storecfg, $dst_volid);
4761 #fixme : sometime drive-mirror timeout, but works fine after.
4762 # (I have see the problem with big volume > 200GB), so we need to eval
4763 eval { vm_mon_cmd
($vmid, "drive-mirror", timeout
=> 10, device
=> "drive-$drive", mode
=> "existing",
4764 sync
=> "full", target
=> $dst_path, format
=> $format); };
4766 eval { vm_mon_cmd
($vmid, "drive-mirror", timeout
=> 10, device
=> "drive-$drive", mode
=> "existing",
4767 sync
=> "full", target
=> $dst_path); };
4772 my $stats = vm_mon_cmd
($vmid, "query-block-jobs");
4773 my $stat = @$stats[0];
4774 die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
4775 die "error job is not mirroring" if $stat->{type
} ne "mirror";
4777 my $transferred = $stat->{offset
};
4778 my $total = $stat->{len
};
4779 my $remaining = $total - $transferred;
4780 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
4782 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent %\n";
4784 last if ($stat->{len
} == $stat->{offset
});
4785 if ($old_len == $stat->{offset
}) {
4786 if ($maxwait && $count > $maxwait) {
4787 # if writes to disk occurs the disk needs to be freezed
4788 # to be able to complete the migration
4789 vm_suspend
($vmid,1);
4793 $count++ unless $frozen;
4799 $old_len = $stat->{offset
};
4803 if ($vmiddst == $vmid) {
4804 # switch the disk if source and destination are on the same guest
4805 vm_mon_cmd
($vmid, "block-job-complete", device
=> "drive-$drive");
4809 eval { vm_mon_cmd
($vmid, "block-job-cancel", device
=> "drive-$drive"); };
4810 die "mirroring error: $err";
4813 if ($vmiddst != $vmid) {
4814 # if we clone a disk for a new target vm, we don't switch the disk
4815 vm_mon_cmd
($vmid, "block-job-cancel", device
=> "drive-$drive");
4821 my ($storecfg, $vmid, $running, $drivename, $drive, $snapname,
4822 $newvmid, $storage, $format, $full, $newvollist) = @_;
4827 print "create linked clone of drive $drivename ($drive->{file})\n";
4828 $newvolid = PVE
::Storage
::vdisk_clone
($storecfg, $drive->{file
}, $newvmid);
4829 push @$newvollist, $newvolid;
4831 my ($storeid, $volname) = PVE
::Storage
::parse_volume_id
($drive->{file
});
4832 $storeid = $storage if $storage;
4834 my ($defFormat, $validFormats) = PVE
::Storage
::storage_default_format
($storecfg, $storeid);
4836 $format = $drive->{format
} || $defFormat;
4839 # test if requested format is supported - else use default
4840 my $supported = grep { $_ eq $format } @$validFormats;
4841 $format = $defFormat if !$supported;
4843 my ($size) = PVE
::Storage
::volume_size_info
($storecfg, $drive->{file
}, 3);
4845 print "create full clone of drive $drivename ($drive->{file})\n";
4846 $newvolid = PVE
::Storage
::vdisk_alloc
($storecfg, $storeid, $newvmid, $format, undef, ($size/1024));
4847 push @$newvollist, $newvolid;
4849 if (!$running || $snapname) {
4850 qemu_img_convert
($drive->{file
}, $newvolid, $size, $snapname);
4852 qemu_drive_mirror
($vmid, $drivename, $newvolid, $newvmid);
4856 my ($size) = PVE
::Storage
::volume_size_info
($storecfg, $newvolid, 3);
4859 $disk->{format
} = undef;
4860 $disk->{file
} = $newvolid;
4861 $disk->{size
} = $size;
4866 # this only works if VM is running
4867 sub get_current_qemu_machine
{
4870 my $cmd = { execute
=> 'query-machines', arguments
=> {} };
4871 my $res = PVE
::QemuServer
::vm_qmp_command
($vmid, $cmd);
4873 my ($current, $default);
4874 foreach my $e (@$res) {
4875 $default = $e->{name
} if $e->{'is-default'};
4876 $current = $e->{name
} if $e->{'is-current'};
4879 # fallback to the default machine if current is not supported by qemu
4880 return $current || $default || 'pc';
4883 sub read_x509_subject_spice
{
4884 my ($filename) = @_;
4887 my $bio = Net
::SSLeay
::BIO_new_file
($filename, 'r');
4888 my $x509 = Net
::SSLeay
::PEM_read_bio_X509
($bio);
4889 Net
::SSLeay
::BIO_free
($bio);
4890 my $nameobj = Net
::SSLeay
::X509_get_subject_name
($x509);
4891 my $subject = Net
::SSLeay
::X509_NAME_oneline
($nameobj);
4892 Net
::SSLeay
::X509_free
($x509);
4894 # remote-viewer wants comma as seperator (not '/')
4896 $subject =~ s!/(\w+=)!,$1!g;