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",
339 enum
=> [qw(std cirrus vmware)],
343 type
=> 'string', format
=> 'pve-qm-watchdog',
344 typetext
=> '[[model=]i6300esb|ib700] [,[action=]reset|shutdown|poweroff|pause|debug|none]',
345 description
=> "Create a virtual hardware watchdog device. Once enabled (by a guest action), the watchdog must be periodically polled by an agent inside the guest or else the guest will be restarted (or execute the action specified)",
350 typetext
=> "(now | YYYY-MM-DD | YYYY-MM-DDTHH:MM:SS)",
351 description
=> "Set the initial date of the real time clock. Valid format for date are: 'now' or '2006-06-17T16:01:21' or '2006-06-17'.",
352 pattern
=> '(now|\d{4}-\d{1,2}-\d{1,2}(T\d{1,2}:\d{1,2}:\d{1,2})?)',
357 type
=> 'string', format
=> 'pve-qm-startup',
358 typetext
=> '[[order=]\d+] [,up=\d+] [,down=\d+] ',
359 description
=> "Startup and shutdown behavior. Order is a non-negative number defining the general startup order. Shutdown in done with reverse ordering. Additionally you can set the 'up' or 'down' delay in seconds, which specifies a delay to wait before the next VM is started or stopped.",
364 description
=> "Enable/disable Template.",
370 description
=> <<EODESCR,
371 Note: this option is for experts only. It allows you to pass arbitrary arguments to kvm, for example:
373 args: -no-reboot -no-hpet
380 description
=> "Enable/disable the usb tablet device. This device is usually needed to allow absolute mouse positioning. Else the mouse runs out of sync with normal vnc clients. If you're running lots of console-only guests on one host, you may consider disabling this to save some context switches.",
385 description
=> "Set maximum speed (in MB/s) for migrations. Value 0 is no limit.",
389 migrate_downtime
=> {
392 description
=> "Set maximum tolerated downtime (in seconds) for migrations.",
398 type
=> 'string', format
=> 'pve-qm-drive',
399 typetext
=> 'volume',
400 description
=> "This is an alias for option -ide2",
404 description
=> "Emulated CPU type.",
406 enum
=> [ qw(486 athlon pentium pentium2 pentium3 coreduo core2duo kvm32 kvm64 qemu32 qemu64 phenom Conroe Penryn Nehalem Westmere SandyBridge Haswell Opteron_G1 Opteron_G2 Opteron_G3 Opteron_G4 Opteron_G5 host) ],
409 parent
=> get_standard_option
('pve-snapshot-name', {
411 description
=> "Parent snapshot name. This is used internally, and should not be modified.",
415 description
=> "Timestamp for snapshots.",
421 type
=> 'string', format
=> 'pve-volume-id',
422 description
=> "Reference to a volume which stores the VM state. This is used internally for snapshots.",
426 # what about other qemu settings ?
428 #machine => 'string',
441 ##soundhw => 'string',
443 while (my ($k, $v) = each %$confdesc) {
444 PVE
::JSONSchema
::register_standard_option
("pve-qm-$k", $v);
447 my $MAX_IDE_DISKS = 4;
448 my $MAX_SCSI_DISKS = 14;
449 my $MAX_VIRTIO_DISKS = 16;
450 my $MAX_SATA_DISKS = 6;
451 my $MAX_USB_DEVICES = 5;
453 my $MAX_UNUSED_DISKS = 8;
454 my $MAX_HOSTPCI_DEVICES = 2;
455 my $MAX_SERIAL_PORTS = 4;
456 my $MAX_PARALLEL_PORTS = 3;
458 my $nic_model_list = ['rtl8139', 'ne2k_pci', 'e1000', 'pcnet', 'virtio',
459 'ne2k_isa', 'i82551', 'i82557b', 'i82559er'];
460 my $nic_model_list_txt = join(' ', sort @$nic_model_list);
464 type
=> 'string', format
=> 'pve-qm-net',
465 typetext
=> "MODEL=XX:XX:XX:XX:XX:XX [,bridge=<dev>][,rate=<mbps>][,tag=<vlanid>]",
466 description
=> <<EODESCR,
467 Specify network devices.
469 MODEL is one of: $nic_model_list_txt
471 XX:XX:XX:XX:XX:XX should be an unique MAC address. This is
472 automatically generated if not specified.
474 The bridge parameter can be used to automatically add the interface to a bridge device. The Proxmox VE standard bridge is called 'vmbr0'.
476 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'.
478 If you specify no bridge, we create a kvm 'user' (NATed) network device, which provides DHCP and DNS services. The following addresses are used:
484 The DHCP server assign addresses to the guest starting from 10.0.2.15.
488 PVE
::JSONSchema
::register_standard_option
("pve-qm-net", $netdesc);
490 for (my $i = 0; $i < $MAX_NETS; $i++) {
491 $confdesc->{"net$i"} = $netdesc;
498 type
=> 'string', format
=> 'pve-qm-drive',
499 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]',
500 description
=> "Use volume as IDE hard disk or CD-ROM (n is 0 to " .($MAX_IDE_DISKS -1) . ").",
502 PVE
::JSONSchema
::register_standard_option
("pve-qm-ide", $idedesc);
506 type
=> 'string', format
=> 'pve-qm-drive',
507 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]',
508 description
=> "Use volume as SCSI hard disk or CD-ROM (n is 0 to " . ($MAX_SCSI_DISKS - 1) . ").",
510 PVE
::JSONSchema
::register_standard_option
("pve-qm-scsi", $scsidesc);
514 type
=> 'string', format
=> 'pve-qm-drive',
515 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]',
516 description
=> "Use volume as SATA hard disk or CD-ROM (n is 0 to " . ($MAX_SATA_DISKS - 1). ").",
518 PVE
::JSONSchema
::register_standard_option
("pve-qm-sata", $satadesc);
522 type
=> 'string', format
=> 'pve-qm-drive',
523 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]',
524 description
=> "Use volume as VIRTIO hard disk (n is 0 to " . ($MAX_VIRTIO_DISKS - 1) . ").",
526 PVE
::JSONSchema
::register_standard_option
("pve-qm-virtio", $virtiodesc);
530 type
=> 'string', format
=> 'pve-qm-usb-device',
531 typetext
=> 'host=HOSTUSBDEVICE',
532 description
=> <<EODESCR,
533 Configure an USB device (n is 0 to 4). This can be used to
534 pass-through usb devices to the guest. HOSTUSBDEVICE syntax is:
536 'bus-port(.port)*' (decimal numbers) or
537 'vendor_id:product_id' (hexadeciaml numbers)
539 You can use the 'lsusb -t' command to list existing usb devices.
541 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
545 PVE
::JSONSchema
::register_standard_option
("pve-qm-usb", $usbdesc);
549 type
=> 'string', format
=> 'pve-qm-hostpci',
550 typetext
=> "HOSTPCIDEVICE",
551 description
=> <<EODESCR,
552 Map host pci devices. HOSTPCIDEVICE syntax is:
554 'bus:dev.func' (hexadecimal numbers)
556 You can us the 'lspci' command to list existing pci devices.
558 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
560 Experimental: user reported problems with this option.
563 PVE
::JSONSchema
::register_standard_option
("pve-qm-hostpci", $hostpcidesc);
568 pattern
=> '/dev/ttyS\d+',
569 description
=> <<EODESCR,
570 Map host serial devices (n is 0 to 3).
572 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
574 Experimental: user reported problems with this option.
581 pattern
=> '/dev/parport\d+',
582 description
=> <<EODESCR,
583 Map host parallel devices (n is 0 to 2).
585 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
587 Experimental: user reported problems with this option.
591 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
592 $confdesc->{"parallel$i"} = $paralleldesc;
595 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
596 $confdesc->{"serial$i"} = $serialdesc;
599 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
600 $confdesc->{"hostpci$i"} = $hostpcidesc;
603 for (my $i = 0; $i < $MAX_IDE_DISKS; $i++) {
604 $drivename_hash->{"ide$i"} = 1;
605 $confdesc->{"ide$i"} = $idedesc;
608 for (my $i = 0; $i < $MAX_SATA_DISKS; $i++) {
609 $drivename_hash->{"sata$i"} = 1;
610 $confdesc->{"sata$i"} = $satadesc;
613 for (my $i = 0; $i < $MAX_SCSI_DISKS; $i++) {
614 $drivename_hash->{"scsi$i"} = 1;
615 $confdesc->{"scsi$i"} = $scsidesc ;
618 for (my $i = 0; $i < $MAX_VIRTIO_DISKS; $i++) {
619 $drivename_hash->{"virtio$i"} = 1;
620 $confdesc->{"virtio$i"} = $virtiodesc;
623 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
624 $confdesc->{"usb$i"} = $usbdesc;
629 type
=> 'string', format
=> 'pve-volume-id',
630 description
=> "Reference to unused volumes.",
633 for (my $i = 0; $i < $MAX_UNUSED_DISKS; $i++) {
634 $confdesc->{"unused$i"} = $unuseddesc;
637 my $kvm_api_version = 0;
641 return $kvm_api_version if $kvm_api_version;
643 my $fh = IO
::File-
>new("</dev/kvm") ||
646 if (my $v = $fh->ioctl(KVM_GET_API_VERSION
(), 0)) {
647 $kvm_api_version = $v;
652 return $kvm_api_version;
655 my $kvm_user_version;
657 sub kvm_user_version
{
659 return $kvm_user_version if $kvm_user_version;
661 $kvm_user_version = 'unknown';
663 my $tmp = `kvm -help 2>/dev/null`;
665 if ($tmp =~ m/^QEMU( PC)? emulator version (\d+\.\d+(\.\d+)?)[,\s]/) {
666 $kvm_user_version = $2;
669 return $kvm_user_version;
673 my $kernel_has_vhost_net = -c
'/dev/vhost-net';
676 # order is important - used to autoselect boot disk
677 return ((map { "ide$_" } (0 .. ($MAX_IDE_DISKS - 1))),
678 (map { "scsi$_" } (0 .. ($MAX_SCSI_DISKS - 1))),
679 (map { "virtio$_" } (0 .. ($MAX_VIRTIO_DISKS - 1))),
680 (map { "sata$_" } (0 .. ($MAX_SATA_DISKS - 1))));
683 sub valid_drivename
{
686 return defined($drivename_hash->{$dev});
691 return defined($confdesc->{$key});
695 return $nic_model_list;
698 sub os_list_description
{
703 w2k
=> 'Windows 2000',
704 w2k3
=>, 'Windows 2003',
705 w2k8
=> 'Windows 2008',
706 wvista
=> 'Windows Vista',
708 win8
=> 'Windows 8/2012',
718 return $cdrom_path if $cdrom_path;
720 return $cdrom_path = "/dev/cdrom" if -l
"/dev/cdrom";
721 return $cdrom_path = "/dev/cdrom1" if -l
"/dev/cdrom1";
722 return $cdrom_path = "/dev/cdrom2" if -l
"/dev/cdrom2";
726 my ($storecfg, $vmid, $cdrom) = @_;
728 if ($cdrom eq 'cdrom') {
729 return get_cdrom_path
();
730 } elsif ($cdrom eq 'none') {
732 } elsif ($cdrom =~ m
|^/|) {
735 return PVE
::Storage
::path
($storecfg, $cdrom);
739 # try to convert old style file names to volume IDs
740 sub filename_to_volume_id
{
741 my ($vmid, $file, $media) = @_;
743 if (!($file eq 'none' || $file eq 'cdrom' ||
744 $file =~ m
|^/dev/.+| || $file =~ m/^([^:]+):(.+)$/)) {
746 return undef if $file =~ m
|/|;
748 if ($media && $media eq 'cdrom') {
749 $file = "local:iso/$file";
751 $file = "local:$vmid/$file";
758 sub verify_media_type
{
759 my ($opt, $vtype, $media) = @_;
764 if ($media eq 'disk') {
766 } elsif ($media eq 'cdrom') {
769 die "internal error";
772 return if ($vtype eq $etype);
774 raise_param_exc
({ $opt => "unexpected media type ($vtype != $etype)" });
777 sub cleanup_drive_path
{
778 my ($opt, $storecfg, $drive) = @_;
780 # try to convert filesystem paths to volume IDs
782 if (($drive->{file
} !~ m/^(cdrom|none)$/) &&
783 ($drive->{file
} !~ m
|^/dev/.+|) &&
784 ($drive->{file
} !~ m/^([^:]+):(.+)$/) &&
785 ($drive->{file
} !~ m/^\d+$/)) {
786 my ($vtype, $volid) = PVE
::Storage
::path_to_volume_id
($storecfg, $drive->{file
});
787 raise_param_exc
({ $opt => "unable to associate path '$drive->{file}' to any storage"}) if !$vtype;
788 $drive->{media
} = 'cdrom' if !$drive->{media
} && $vtype eq 'iso';
789 verify_media_type
($opt, $vtype, $drive->{media
});
790 $drive->{file
} = $volid;
793 $drive->{media
} = 'cdrom' if !$drive->{media
} && $drive->{file
} =~ m/^(cdrom|none)$/;
796 sub create_conf_nolock
{
797 my ($vmid, $settings) = @_;
799 my $filename = config_file
($vmid);
801 die "configuration file '$filename' already exists\n" if -f
$filename;
803 my $defaults = load_defaults
();
805 $settings->{name
} = "vm$vmid" if !$settings->{name
};
806 $settings->{memory
} = $defaults->{memory
} if !$settings->{memory
};
809 foreach my $opt (keys %$settings) {
810 next if !$confdesc->{$opt};
812 my $value = $settings->{$opt};
815 $data .= "$opt: $value\n";
818 PVE
::Tools
::file_set_contents
($filename, $data);
821 my $parse_size = sub {
824 return undef if $value !~ m/^(\d+(\.\d+)?)([KMG])?$/;
825 my ($size, $unit) = ($1, $3);
828 $size = $size * 1024;
829 } elsif ($unit eq 'M') {
830 $size = $size * 1024 * 1024;
831 } elsif ($unit eq 'G') {
832 $size = $size * 1024 * 1024 * 1024;
838 my $format_size = sub {
843 my $kb = int($size/1024);
844 return $size if $kb*1024 != $size;
846 my $mb = int($kb/1024);
847 return "${kb}K" if $mb*1024 != $kb;
849 my $gb = int($mb/1024);
850 return "${mb}M" if $gb*1024 != $mb;
855 # ideX = [volume=]volume-id[,media=d][,cyls=c,heads=h,secs=s[,trans=t]]
856 # [,snapshot=on|off][,cache=on|off][,format=f][,backup=yes|no]
857 # [,rerror=ignore|report|stop][,werror=enospc|ignore|report|stop]
858 # [,aio=native|threads]
861 my ($key, $data) = @_;
865 # $key may be undefined - used to verify JSON parameters
866 if (!defined($key)) {
867 $res->{interface
} = 'unknown'; # should not harm when used to verify parameters
869 } elsif ($key =~ m/^([^\d]+)(\d+)$/) {
870 $res->{interface
} = $1;
876 foreach my $p (split (/,/, $data)) {
877 next if $p =~ m/^\s*$/;
879 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)=(.+)$/) {
880 my ($k, $v) = ($1, $2);
882 $k = 'file' if $k eq 'volume';
884 return undef if defined $res->{$k};
886 if ($k eq 'bps' || $k eq 'bps_rd' || $k eq 'bps_wr') {
887 return undef if !$v || $v !~ m/^\d+/;
889 $v = sprintf("%.3f", $v / (1024*1024));
893 if (!$res->{file
} && $p !~ m/=/) {
901 return undef if !$res->{file
};
903 return undef if $res->{cache
} &&
904 $res->{cache
} !~ m/^(off|none|writethrough|writeback|unsafe|directsync)$/;
905 return undef if $res->{snapshot
} && $res->{snapshot
} !~ m/^(on|off)$/;
906 return undef if $res->{cyls
} && $res->{cyls
} !~ m/^\d+$/;
907 return undef if $res->{heads
} && $res->{heads
} !~ m/^\d+$/;
908 return undef if $res->{secs
} && $res->{secs
} !~ m/^\d+$/;
909 return undef if $res->{media
} && $res->{media
} !~ m/^(disk|cdrom)$/;
910 return undef if $res->{trans
} && $res->{trans
} !~ m/^(none|lba|auto)$/;
911 return undef if $res->{format
} && $res->{format
} !~ m/^(raw|cow|qcow|qcow2|vmdk|cloop)$/;
912 return undef if $res->{rerror
} && $res->{rerror
} !~ m/^(ignore|report|stop)$/;
913 return undef if $res->{werror
} && $res->{werror
} !~ m/^(enospc|ignore|report|stop)$/;
914 return undef if $res->{backup
} && $res->{backup
} !~ m/^(yes|no)$/;
915 return undef if $res->{aio
} && $res->{aio
} !~ m/^(native|threads)$/;
918 return undef if $res->{mbps_rd
} && $res->{mbps
};
919 return undef if $res->{mbps_wr
} && $res->{mbps
};
921 return undef if $res->{mbps
} && $res->{mbps
} !~ m/^\d+(\.\d+)?$/;
922 return undef if $res->{mbps_rd
} && $res->{mbps_rd
} !~ m/^\d+(\.\d+)?$/;
923 return undef if $res->{mbps_wr
} && $res->{mbps_wr
} !~ m/^\d+(\.\d+)?$/;
925 return undef if $res->{iops_rd
} && $res->{iops
};
926 return undef if $res->{iops_wr
} && $res->{iops
};
927 return undef if $res->{iops
} && $res->{iops
} !~ m/^\d+$/;
928 return undef if $res->{iops_rd
} && $res->{iops_rd
} !~ m/^\d+$/;
929 return undef if $res->{iops_wr
} && $res->{iops_wr
} !~ m/^\d+$/;
933 return undef if !defined($res->{size
} = &$parse_size($res->{size
}));
936 if ($res->{media
} && ($res->{media
} eq 'cdrom')) {
937 return undef if $res->{snapshot
} || $res->{trans
} || $res->{format
};
938 return undef if $res->{heads
} || $res->{secs
} || $res->{cyls
};
939 return undef if $res->{interface
} eq 'virtio';
942 # rerror does not work with scsi drives
943 if ($res->{rerror
}) {
944 return undef if $res->{interface
} eq 'scsi';
950 my @qemu_drive_options = qw(heads secs cyls trans media format cache snapshot rerror werror aio iops iops_rd iops_wr);
953 my ($vmid, $drive) = @_;
956 foreach my $o (@qemu_drive_options, 'mbps', 'mbps_rd', 'mbps_wr', 'backup') {
957 $opts .= ",$o=$drive->{$o}" if $drive->{$o};
960 if ($drive->{size
}) {
961 $opts .= ",size=" . &$format_size($drive->{size
});
964 return "$drive->{file}$opts";
968 my($fh, $noerr) = @_;
971 my $SG_GET_VERSION_NUM = 0x2282;
973 my $versionbuf = "\x00" x
8;
974 my $ret = ioctl($fh, $SG_GET_VERSION_NUM, $versionbuf);
976 die "scsi ioctl SG_GET_VERSION_NUM failoed - $!\n" if !$noerr;
979 my $version = unpack("I", $versionbuf);
980 if ($version < 30000) {
981 die "scsi generic interface too old\n" if !$noerr;
985 my $buf = "\x00" x
36;
986 my $sensebuf = "\x00" x
8;
987 my $cmd = pack("C x3 C x11", 0x12, 36);
989 # see /usr/include/scsi/sg.h
990 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";
992 my $packet = pack($sg_io_hdr_t, ord('S'), -3, length($cmd),
993 length($sensebuf), 0, length($buf), $buf,
994 $cmd, $sensebuf, 6000);
996 $ret = ioctl($fh, $SG_IO, $packet);
998 die "scsi ioctl SG_IO failed - $!\n" if !$noerr;
1002 my @res = unpack($sg_io_hdr_t, $packet);
1003 if ($res[17] || $res[18]) {
1004 die "scsi ioctl SG_IO status error - $!\n" if !$noerr;
1009 ($res->{device
}, $res->{removable
}, $res->{venodor
},
1010 $res->{product
}, $res->{revision
}) = unpack("C C x6 A8 A16 A4", $buf);
1018 my $fh = IO
::File-
>new("+<$path") || return undef;
1019 my $res = scsi_inquiry
($fh, 1);
1025 sub print_drivedevice_full
{
1026 my ($storecfg, $conf, $vmid, $drive, $bridges) = @_;
1031 if ($drive->{interface
} eq 'virtio') {
1032 my $pciaddr = print_pci_addr
("$drive->{interface}$drive->{index}", $bridges);
1033 $device = "virtio-blk-pci,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}$pciaddr";
1034 } elsif ($drive->{interface
} eq 'scsi') {
1035 $maxdev = ($conf->{scsihw
} && $conf->{scsihw
} ne 'lsi') ?
256 : 7;
1036 my $controller = int($drive->{index} / $maxdev);
1037 my $unit = $drive->{index} % $maxdev;
1038 my $devicetype = 'hd';
1040 if (drive_is_cdrom
($drive)) {
1043 if ($drive->{file
} =~ m
|^/|) {
1044 $path = $drive->{file
};
1046 $path = PVE
::Storage
::path
($storecfg, $drive->{file
});
1049 if($path =~ m/^iscsi\:\/\
//){
1050 $devicetype = 'generic';
1053 $devicetype = 'block' if path_is_scsi
($path);
1057 if (!$conf->{scsihw
} || $conf->{scsihw
} eq 'lsi'){
1058 $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';
1060 $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}";
1063 } elsif ($drive->{interface
} eq 'ide'){
1065 my $controller = int($drive->{index} / $maxdev);
1066 my $unit = $drive->{index} % $maxdev;
1067 my $devicetype = ($drive->{media
} && $drive->{media
} eq 'cdrom') ?
"cd" : "hd";
1069 $device = "ide-$devicetype,bus=ide.$controller,unit=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1070 } elsif ($drive->{interface
} eq 'sata'){
1071 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
1072 my $unit = $drive->{index} % $MAX_SATA_DISKS;
1073 $device = "ide-drive,bus=ahci$controller.$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1074 } elsif ($drive->{interface
} eq 'usb') {
1076 # -device ide-drive,bus=ide.1,unit=0,drive=drive-ide0-1-0,id=ide0-1-0
1078 die "unsupported interface type";
1081 $device .= ",bootindex=$drive->{bootindex}" if $drive->{bootindex
};
1086 sub print_drive_full
{
1087 my ($storecfg, $vmid, $drive) = @_;
1090 foreach my $o (@qemu_drive_options) {
1091 next if $o eq 'bootindex';
1092 $opts .= ",$o=$drive->{$o}" if $drive->{$o};
1095 foreach my $o (qw(bps bps_rd bps_wr)) {
1096 my $v = $drive->{"m$o"};
1097 $opts .= ",$o=" . int($v*1024*1024) if $v;
1100 # use linux-aio by default (qemu default is threads)
1101 $opts .= ",aio=native" if !$drive->{aio
};
1104 my $volid = $drive->{file
};
1105 if (drive_is_cdrom
($drive)) {
1106 $path = get_iso_path
($storecfg, $vmid, $volid);
1108 if ($volid =~ m
|^/|) {
1111 $path = PVE
::Storage
::path
($storecfg, $volid);
1115 $opts .= ",cache=none" if !$drive->{cache
} && !drive_is_cdrom
($drive);
1117 my $pathinfo = $path ?
"file=$path," : '';
1119 return "${pathinfo}if=none,id=drive-$drive->{interface}$drive->{index}$opts";
1122 sub print_netdevice_full
{
1123 my ($vmid, $conf, $net, $netid, $bridges) = @_;
1125 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
1127 my $device = $net->{model
};
1128 if ($net->{model
} eq 'virtio') {
1129 $device = 'virtio-net-pci';
1132 # qemu > 0.15 always try to boot from network - we disable that by
1133 # not loading the pxe rom file
1134 my $extra = ($bootorder !~ m/n/) ?
"romfile=," : '';
1135 my $pciaddr = print_pci_addr
("$netid", $bridges);
1136 my $tmpstr = "$device,${extra}mac=$net->{macaddr},netdev=$netid$pciaddr,id=$netid";
1137 $tmpstr .= ",bootindex=$net->{bootindex}" if $net->{bootindex
} ;
1141 sub print_netdev_full
{
1142 my ($vmid, $conf, $net, $netid) = @_;
1145 if ($netid =~ m/^net(\d+)$/) {
1149 die "got strange net id '$i'\n" if $i >= ${MAX_NETS
};
1151 my $ifname = "tap${vmid}i$i";
1153 # kvm uses TUNSETIFF ioctl, and that limits ifname length
1154 die "interface name '$ifname' is too long (max 15 character)\n"
1155 if length($ifname) >= 16;
1157 my $vhostparam = '';
1158 $vhostparam = ',vhost=on' if $kernel_has_vhost_net && $net->{model
} eq 'virtio';
1160 my $vmname = $conf->{name
} || "vm$vmid";
1162 if ($net->{bridge
}) {
1163 return "type=tap,id=$netid,ifname=${ifname},script=/var/lib/qemu-server/pve-bridge$vhostparam";
1165 return "type=user,id=$netid,hostname=$vmname";
1169 sub drive_is_cdrom
{
1172 return $drive && $drive->{media
} && ($drive->{media
} eq 'cdrom');
1179 return undef if !$value;
1183 if ($value =~ m/^[a-f0-9]{2}:[a-f0-9]{2}\.[a-f0-9]$/) {
1184 $res->{pciid
} = $value;
1192 # netX: e1000=XX:XX:XX:XX:XX:XX,bridge=vmbr0,rate=<mbps>
1198 foreach my $kvp (split(/,/, $data)) {
1200 if ($kvp =~ m/^(ne2k_pci|e1000|rtl8139|pcnet|virtio|ne2k_isa|i82551|i82557b|i82559er)(=([0-9a-f]{2}(:[0-9a-f]{2}){5}))?$/i) {
1202 my $mac = defined($3) ?
uc($3) : PVE
::Tools
::random_ether_addr
();
1203 $res->{model
} = $model;
1204 $res->{macaddr
} = $mac;
1205 } elsif ($kvp =~ m/^bridge=(\S+)$/) {
1206 $res->{bridge
} = $1;
1207 } elsif ($kvp =~ m/^rate=(\d+(\.\d+)?)$/) {
1209 } elsif ($kvp =~ m/^tag=(\d+)$/) {
1217 return undef if !$res->{model
};
1225 my $res = "$net->{model}";
1226 $res .= "=$net->{macaddr}" if $net->{macaddr
};
1227 $res .= ",bridge=$net->{bridge}" if $net->{bridge
};
1228 $res .= ",rate=$net->{rate}" if $net->{rate
};
1229 $res .= ",tag=$net->{tag}" if $net->{tag
};
1234 sub add_random_macs
{
1235 my ($settings) = @_;
1237 foreach my $opt (keys %$settings) {
1238 next if $opt !~ m/^net(\d+)$/;
1239 my $net = parse_net
($settings->{$opt});
1241 $settings->{$opt} = print_net
($net);
1245 sub add_unused_volume
{
1246 my ($config, $volid) = @_;
1249 for (my $ind = $MAX_UNUSED_DISKS - 1; $ind >= 0; $ind--) {
1250 my $test = "unused$ind";
1251 if (my $vid = $config->{$test}) {
1252 return if $vid eq $volid; # do not add duplicates
1258 die "To many unused volume - please delete them first.\n" if !$key;
1260 $config->{$key} = $volid;
1265 PVE
::JSONSchema
::register_format
('pve-qm-bootdisk', \
&verify_bootdisk
);
1266 sub verify_bootdisk
{
1267 my ($value, $noerr) = @_;
1269 return $value if valid_drivename
($value);
1271 return undef if $noerr;
1273 die "invalid boot disk '$value'\n";
1276 PVE
::JSONSchema
::register_format
('pve-qm-net', \
&verify_net
);
1278 my ($value, $noerr) = @_;
1280 return $value if parse_net
($value);
1282 return undef if $noerr;
1284 die "unable to parse network options\n";
1287 PVE
::JSONSchema
::register_format
('pve-qm-drive', \
&verify_drive
);
1289 my ($value, $noerr) = @_;
1291 return $value if parse_drive
(undef, $value);
1293 return undef if $noerr;
1295 die "unable to parse drive options\n";
1298 PVE
::JSONSchema
::register_format
('pve-qm-hostpci', \
&verify_hostpci
);
1299 sub verify_hostpci
{
1300 my ($value, $noerr) = @_;
1302 return $value if parse_hostpci
($value);
1304 return undef if $noerr;
1306 die "unable to parse pci id\n";
1309 PVE
::JSONSchema
::register_format
('pve-qm-watchdog', \
&verify_watchdog
);
1310 sub verify_watchdog
{
1311 my ($value, $noerr) = @_;
1313 return $value if parse_watchdog
($value);
1315 return undef if $noerr;
1317 die "unable to parse watchdog options\n";
1320 sub parse_watchdog
{
1323 return undef if !$value;
1327 foreach my $p (split(/,/, $value)) {
1328 next if $p =~ m/^\s*$/;
1330 if ($p =~ m/^(model=)?(i6300esb|ib700)$/) {
1332 } elsif ($p =~ m/^(action=)?(reset|shutdown|poweroff|pause|debug|none)$/) {
1333 $res->{action
} = $2;
1342 PVE
::JSONSchema
::register_format
('pve-qm-startup', \
&verify_startup
);
1343 sub verify_startup
{
1344 my ($value, $noerr) = @_;
1346 return $value if parse_startup
($value);
1348 return undef if $noerr;
1350 die "unable to parse startup options\n";
1356 return undef if !$value;
1360 foreach my $p (split(/,/, $value)) {
1361 next if $p =~ m/^\s*$/;
1363 if ($p =~ m/^(order=)?(\d+)$/) {
1365 } elsif ($p =~ m/^up=(\d+)$/) {
1367 } elsif ($p =~ m/^down=(\d+)$/) {
1377 sub parse_usb_device
{
1380 return undef if !$value;
1382 my @dl = split(/,/, $value);
1386 foreach my $v (@dl) {
1387 if ($v =~ m/^host=(0x)?([0-9A-Fa-f]{4}):(0x)?([0-9A-Fa-f]{4})$/) {
1389 $res->{vendorid
} = $2;
1390 $res->{productid
} = $4;
1391 } elsif ($v =~ m/^host=(\d+)\-(\d+(\.\d+)*)$/) {
1393 $res->{hostbus
} = $1;
1394 $res->{hostport
} = $2;
1399 return undef if !$found;
1404 PVE
::JSONSchema
::register_format
('pve-qm-usb-device', \
&verify_usb_device
);
1405 sub verify_usb_device
{
1406 my ($value, $noerr) = @_;
1408 return $value if parse_usb_device
($value);
1410 return undef if $noerr;
1412 die "unable to parse usb device\n";
1415 # add JSON properties for create and set function
1416 sub json_config_properties
{
1419 foreach my $opt (keys %$confdesc) {
1420 next if $opt eq 'parent' || $opt eq 'snaptime' || $opt eq 'vmstate';
1421 $prop->{$opt} = $confdesc->{$opt};
1428 my ($key, $value) = @_;
1430 die "unknown setting '$key'\n" if !$confdesc->{$key};
1432 my $type = $confdesc->{$key}->{type
};
1434 if (!defined($value)) {
1435 die "got undefined value\n";
1438 if ($value =~ m/[\n\r]/) {
1439 die "property contains a line feed\n";
1442 if ($type eq 'boolean') {
1443 return 1 if ($value eq '1') || ($value =~ m/^(on|yes|true)$/i);
1444 return 0 if ($value eq '0') || ($value =~ m/^(off|no|false)$/i);
1445 die "type check ('boolean') failed - got '$value'\n";
1446 } elsif ($type eq 'integer') {
1447 return int($1) if $value =~ m/^(\d+)$/;
1448 die "type check ('integer') failed - got '$value'\n";
1449 } elsif ($type eq 'number') {
1450 return $value if $value =~ m/^(\d+)(\.\d+)?$/;
1451 die "type check ('number') failed - got '$value'\n";
1452 } elsif ($type eq 'string') {
1453 if (my $fmt = $confdesc->{$key}->{format
}) {
1454 if ($fmt eq 'pve-qm-drive') {
1455 # special case - we need to pass $key to parse_drive()
1456 my $drive = parse_drive
($key, $value);
1457 return $value if $drive;
1458 die "unable to parse drive options\n";
1460 PVE
::JSONSchema
::check_format
($fmt, $value);
1463 $value =~ s/^\"(.*)\"$/$1/;
1466 die "internal error"
1470 sub lock_config_full
{
1471 my ($vmid, $timeout, $code, @param) = @_;
1473 my $filename = config_file_lock
($vmid);
1475 my $res = lock_file
($filename, $timeout, $code, @param);
1482 sub lock_config_shared
{
1483 my ($vmid, $timeout, $code, @param) = @_;
1485 my $filename = config_file_lock
($vmid);
1487 my $res = lock_file_full
($filename, $timeout, 1, $code, @param);
1495 my ($vmid, $code, @param) = @_;
1497 return lock_config_full
($vmid, 10, $code, @param);
1500 sub cfs_config_path
{
1501 my ($vmid, $node) = @_;
1503 $node = $nodename if !$node;
1504 return "nodes/$node/qemu-server/$vmid.conf";
1507 sub check_iommu_support
{
1508 #fixme : need to check IOMMU support
1509 #http://www.linux-kvm.org/page/How_to_assign_devices_with_VT-d_in_KVM
1517 my ($vmid, $node) = @_;
1519 my $cfspath = cfs_config_path
($vmid, $node);
1520 return "/etc/pve/$cfspath";
1523 sub config_file_lock
{
1526 return "$lock_dir/lock-$vmid.conf";
1532 my $conf = config_file
($vmid);
1533 utime undef, undef, $conf;
1537 my ($storecfg, $vmid, $keep_empty_config) = @_;
1539 my $conffile = config_file
($vmid);
1541 my $conf = load_config
($vmid);
1545 # only remove disks owned by this VM
1546 foreach_drive
($conf, sub {
1547 my ($ds, $drive) = @_;
1549 return if drive_is_cdrom
($drive);
1551 my $volid = $drive->{file
};
1553 return if !$volid || $volid =~ m
|^/|;
1555 my ($path, $owner) = PVE
::Storage
::path
($storecfg, $volid);
1556 return if !$path || !$owner || ($owner != $vmid);
1558 PVE
::Storage
::vdisk_free
($storecfg, $volid);
1561 if ($keep_empty_config) {
1562 PVE
::Tools
::file_set_contents
($conffile, "memory: 128\n");
1567 # also remove unused disk
1569 my $dl = PVE
::Storage
::vdisk_list
($storecfg, undef, $vmid);
1572 PVE
::Storage
::foreach_volid
($dl, sub {
1573 my ($volid, $sid, $volname, $d) = @_;
1574 PVE
::Storage
::vdisk_free
($storecfg, $volid);
1584 my ($vmid, $node) = @_;
1586 my $cfspath = cfs_config_path
($vmid, $node);
1588 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath);
1590 die "no such VM ('$vmid')\n" if !defined($conf);
1595 sub parse_vm_config
{
1596 my ($filename, $raw) = @_;
1598 return undef if !defined($raw);
1601 digest
=> Digest
::SHA
::sha1_hex
($raw),
1605 $filename =~ m
|/qemu-server/(\d
+)\
.conf
$|
1606 || die "got strange filename '$filename'";
1613 my @lines = split(/\n/, $raw);
1614 foreach my $line (@lines) {
1615 next if $line =~ m/^\s*$/;
1617 if ($line =~ m/^\[([a-z][a-z0-9_\-]+)\]\s*$/i) {
1619 $conf->{description
} = $descr if $descr;
1621 $conf = $res->{snapshots
}->{$snapname} = {};
1625 if ($line =~ m/^\#(.*)\s*$/) {
1626 $descr .= PVE
::Tools
::decode_text
($1) . "\n";
1630 if ($line =~ m/^(description):\s*(.*\S)\s*$/) {
1631 $descr .= PVE
::Tools
::decode_text
($2);
1632 } elsif ($line =~ m/snapstate:\s*(prepare|delete)\s*$/) {
1633 $conf->{snapstate
} = $1;
1634 } elsif ($line =~ m/^(args):\s*(.*\S)\s*$/) {
1637 $conf->{$key} = $value;
1638 } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/) {
1641 eval { $value = check_type
($key, $value); };
1643 warn "vm $vmid - unable to parse value of '$key' - $@";
1645 my $fmt = $confdesc->{$key}->{format
};
1646 if ($fmt && $fmt eq 'pve-qm-drive') {
1647 my $v = parse_drive
($key, $value);
1648 if (my $volid = filename_to_volume_id
($vmid, $v->{file
}, $v->{media
})) {
1649 $v->{file
} = $volid;
1650 $value = print_drive
($vmid, $v);
1652 warn "vm $vmid - unable to parse value of '$key'\n";
1657 if ($key eq 'cdrom') {
1658 $conf->{ide2
} = $value;
1660 $conf->{$key} = $value;
1666 $conf->{description
} = $descr if $descr;
1668 delete $res->{snapstate
}; # just to be sure
1673 sub write_vm_config
{
1674 my ($filename, $conf) = @_;
1676 delete $conf->{snapstate
}; # just to be sure
1678 if ($conf->{cdrom
}) {
1679 die "option ide2 conflicts with cdrom\n" if $conf->{ide2
};
1680 $conf->{ide2
} = $conf->{cdrom
};
1681 delete $conf->{cdrom
};
1684 # we do not use 'smp' any longer
1685 if ($conf->{sockets
}) {
1686 delete $conf->{smp
};
1687 } elsif ($conf->{smp
}) {
1688 $conf->{sockets
} = $conf->{smp
};
1689 delete $conf->{cores
};
1690 delete $conf->{smp
};
1693 my $used_volids = {};
1695 my $cleanup_config = sub {
1698 foreach my $key (keys %$cref) {
1699 next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots' ||
1700 $key eq 'snapstate';
1701 my $value = $cref->{$key};
1702 eval { $value = check_type
($key, $value); };
1703 die "unable to parse value of '$key' - $@" if $@;
1705 $cref->{$key} = $value;
1707 if (valid_drivename
($key)) {
1708 my $drive = parse_drive
($key, $value);
1709 $used_volids->{$drive->{file
}} = 1 if $drive && $drive->{file
};
1714 &$cleanup_config($conf);
1715 foreach my $snapname (keys %{$conf->{snapshots
}}) {
1716 &$cleanup_config($conf->{snapshots
}->{$snapname});
1719 # remove 'unusedX' settings if we re-add a volume
1720 foreach my $key (keys %$conf) {
1721 my $value = $conf->{$key};
1722 if ($key =~ m/^unused/ && $used_volids->{$value}) {
1723 delete $conf->{$key};
1727 my $generate_raw_config = sub {
1732 # add description as comment to top of file
1733 my $descr = $conf->{description
} || '';
1734 foreach my $cl (split(/\n/, $descr)) {
1735 $raw .= '#' . PVE
::Tools
::encode_text
($cl) . "\n";
1738 foreach my $key (sort keys %$conf) {
1739 next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots';
1740 $raw .= "$key: $conf->{$key}\n";
1745 my $raw = &$generate_raw_config($conf);
1746 foreach my $snapname (sort keys %{$conf->{snapshots
}}) {
1747 $raw .= "\n[$snapname]\n";
1748 $raw .= &$generate_raw_config($conf->{snapshots
}->{$snapname});
1754 sub update_config_nolock
{
1755 my ($vmid, $conf, $skiplock) = @_;
1757 check_lock
($conf) if !$skiplock;
1759 my $cfspath = cfs_config_path
($vmid);
1761 PVE
::Cluster
::cfs_write_file
($cfspath, $conf);
1765 my ($vmid, $conf, $skiplock) = @_;
1767 lock_config
($vmid, &update_config_nolock
, $conf, $skiplock);
1774 # we use static defaults from our JSON schema configuration
1775 foreach my $key (keys %$confdesc) {
1776 if (defined(my $default = $confdesc->{$key}->{default})) {
1777 $res->{$key} = $default;
1781 my $conf = PVE
::Cluster
::cfs_read_file
('datacenter.cfg');
1782 $res->{keyboard
} = $conf->{keyboard
} if $conf->{keyboard
};
1788 my $vmlist = PVE
::Cluster
::get_vmlist
();
1790 return $res if !$vmlist || !$vmlist->{ids
};
1791 my $ids = $vmlist->{ids
};
1793 foreach my $vmid (keys %$ids) {
1794 my $d = $ids->{$vmid};
1795 next if !$d->{node
} || $d->{node
} ne $nodename;
1796 next if !$d->{type
} || $d->{type
} ne 'qemu';
1797 $res->{$vmid}->{exists} = 1;
1802 # test if VM uses local resources (to prevent migration)
1803 sub check_local_resources
{
1804 my ($conf, $noerr) = @_;
1808 $loc_res = 1 if $conf->{hostusb
}; # old syntax
1809 $loc_res = 1 if $conf->{hostpci
}; # old syntax
1811 foreach my $k (keys %$conf) {
1812 $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/;
1815 die "VM uses local resources\n" if $loc_res && !$noerr;
1820 # check is used storages are available on all nodes (use by migrate)
1821 sub check_storage_availability
{
1822 my ($storecfg, $conf, $node) = @_;
1824 foreach_drive
($conf, sub {
1825 my ($ds, $drive) = @_;
1827 my $volid = $drive->{file
};
1830 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
1833 # check if storage is available on both nodes
1834 my $scfg = PVE
::Storage
::storage_check_node
($storecfg, $sid);
1835 PVE
::Storage
::storage_check_node
($storecfg, $sid, $node);
1842 die "VM is locked ($conf->{lock})\n" if $conf->{lock};
1846 my ($pidfile, $pid) = @_;
1848 my $fh = IO
::File-
>new("/proc/$pid/cmdline", "r");
1852 return undef if !$line;
1853 my @param = split(/\0/, $line);
1855 my $cmd = $param[0];
1856 return if !$cmd || ($cmd !~ m
|kvm
$| && $cmd !~ m
|qemu-system-x86_64
$|);
1858 for (my $i = 0; $i < scalar (@param); $i++) {
1861 if (($p eq '-pidfile') || ($p eq '--pidfile')) {
1862 my $p = $param[$i+1];
1863 return 1 if $p && ($p eq $pidfile);
1872 my ($vmid, $nocheck, $node) = @_;
1874 my $filename = config_file
($vmid, $node);
1876 die "unable to find configuration file for VM $vmid - no such machine\n"
1877 if !$nocheck && ! -f
$filename;
1879 my $pidfile = pidfile_name
($vmid);
1881 if (my $fd = IO
::File-
>new("<$pidfile")) {
1886 my $mtime = $st->mtime;
1887 if ($mtime > time()) {
1888 warn "file '$filename' modified in future\n";
1891 if ($line =~ m/^(\d+)$/) {
1893 if (check_cmdline
($pidfile, $pid)) {
1894 if (my $pinfo = PVE
::ProcFSTools
::check_process_running
($pid)) {
1906 my $vzlist = config_list
();
1908 my $fd = IO
::Dir-
>new($var_run_tmpdir) || return $vzlist;
1910 while (defined(my $de = $fd->read)) {
1911 next if $de !~ m/^(\d+)\.pid$/;
1913 next if !defined($vzlist->{$vmid});
1914 if (my $pid = check_running
($vmid)) {
1915 $vzlist->{$vmid}->{pid
} = $pid;
1923 my ($storecfg, $conf) = @_;
1925 my $bootdisk = $conf->{bootdisk
};
1926 return undef if !$bootdisk;
1927 return undef if !valid_drivename
($bootdisk);
1929 return undef if !$conf->{$bootdisk};
1931 my $drive = parse_drive
($bootdisk, $conf->{$bootdisk});
1932 return undef if !defined($drive);
1934 return undef if drive_is_cdrom
($drive);
1936 my $volid = $drive->{file
};
1937 return undef if !$volid;
1939 return $drive->{size
};
1942 my $last_proc_pid_stat;
1944 # get VM status information
1945 # This must be fast and should not block ($full == false)
1946 # We only query KVM using QMP if $full == true (this can be slow)
1948 my ($opt_vmid, $full) = @_;
1952 my $storecfg = PVE
::Storage
::config
();
1954 my $list = vzlist
();
1955 my ($uptime) = PVE
::ProcFSTools
::read_proc_uptime
(1);
1957 my $cpucount = $cpuinfo->{cpus
} || 1;
1959 foreach my $vmid (keys %$list) {
1960 next if $opt_vmid && ($vmid ne $opt_vmid);
1962 my $cfspath = cfs_config_path
($vmid);
1963 my $conf = PVE
::Cluster
::cfs_read_file
($cfspath) || {};
1966 $d->{pid
} = $list->{$vmid}->{pid
};
1968 # fixme: better status?
1969 $d->{status
} = $list->{$vmid}->{pid
} ?
'running' : 'stopped';
1971 my $size = disksize
($storecfg, $conf);
1972 if (defined($size)) {
1973 $d->{disk
} = 0; # no info available
1974 $d->{maxdisk
} = $size;
1980 $d->{cpus
} = ($conf->{sockets
} || 1) * ($conf->{cores
} || 1);
1981 $d->{cpus
} = $cpucount if $d->{cpus
} > $cpucount;
1983 $d->{name
} = $conf->{name
} || "VM $vmid";
1984 $d->{maxmem
} = $conf->{memory
} ?
$conf->{memory
}*(1024*1024) : 0;
1986 if ($conf->{balloon
}) {
1987 $d->{balloon_min
} = $conf->{balloon
}*(1024*1024);
1988 $d->{shares
} = defined($conf->{shares
}) ?
$conf->{shares
} : 1000;
1999 $d->{diskwrite
} = 0;
2001 $d->{template
} = is_template
($conf);
2006 my $netdev = PVE
::ProcFSTools
::read_proc_net_dev
();
2007 foreach my $dev (keys %$netdev) {
2008 next if $dev !~ m/^tap([1-9]\d*)i/;
2010 my $d = $res->{$vmid};
2013 $d->{netout
} += $netdev->{$dev}->{receive
};
2014 $d->{netin
} += $netdev->{$dev}->{transmit
};
2017 my $ctime = gettimeofday
;
2019 foreach my $vmid (keys %$list) {
2021 my $d = $res->{$vmid};
2022 my $pid = $d->{pid
};
2025 my $pstat = PVE
::ProcFSTools
::read_proc_pid_stat
($pid);
2026 next if !$pstat; # not running
2028 my $used = $pstat->{utime} + $pstat->{stime
};
2030 $d->{uptime
} = int(($uptime - $pstat->{starttime
})/$cpuinfo->{user_hz
});
2032 if ($pstat->{vsize
}) {
2033 $d->{mem
} = int(($pstat->{rss
}/$pstat->{vsize
})*$d->{maxmem
});
2036 my $old = $last_proc_pid_stat->{$pid};
2038 $last_proc_pid_stat->{$pid} = {
2046 my $dtime = ($ctime - $old->{time}) * $cpucount * $cpuinfo->{user_hz
};
2048 if ($dtime > 1000) {
2049 my $dutime = $used - $old->{used
};
2051 $d->{cpu
} = (($dutime/$dtime)* $cpucount) / $d->{cpus
};
2052 $last_proc_pid_stat->{$pid} = {
2058 $d->{cpu
} = $old->{cpu
};
2062 return $res if !$full;
2064 my $qmpclient = PVE
::QMPClient-
>new();
2066 my $ballooncb = sub {
2067 my ($vmid, $resp) = @_;
2069 my $info = $resp->{'return'};
2070 return if !$info->{max_mem
};
2072 my $d = $res->{$vmid};
2074 # use memory assigned to VM
2075 $d->{maxmem
} = $info->{max_mem
};
2076 $d->{balloon
} = $info->{actual
};
2078 if (defined($info->{total_mem
}) && defined($info->{free_mem
})) {
2079 $d->{mem
} = $info->{total_mem
} - $info->{free_mem
};
2080 $d->{freemem
} = $info->{free_mem
};
2085 my $blockstatscb = sub {
2086 my ($vmid, $resp) = @_;
2087 my $data = $resp->{'return'} || [];
2088 my $totalrdbytes = 0;
2089 my $totalwrbytes = 0;
2090 for my $blockstat (@$data) {
2091 $totalrdbytes = $totalrdbytes + $blockstat->{stats
}->{rd_bytes
};
2092 $totalwrbytes = $totalwrbytes + $blockstat->{stats
}->{wr_bytes
};
2094 $res->{$vmid}->{diskread
} = $totalrdbytes;
2095 $res->{$vmid}->{diskwrite
} = $totalwrbytes;
2098 my $statuscb = sub {
2099 my ($vmid, $resp) = @_;
2101 $qmpclient->queue_cmd($vmid, $blockstatscb, 'query-blockstats');
2102 # this fails if ballon driver is not loaded, so this must be
2103 # the last commnand (following command are aborted if this fails).
2104 $qmpclient->queue_cmd($vmid, $ballooncb, 'query-balloon');
2106 my $status = 'unknown';
2107 if (!defined($status = $resp->{'return'}->{status
})) {
2108 warn "unable to get VM status\n";
2112 $res->{$vmid}->{qmpstatus
} = $resp->{'return'}->{status
};
2115 foreach my $vmid (keys %$list) {
2116 next if $opt_vmid && ($vmid ne $opt_vmid);
2117 next if !$res->{$vmid}->{pid
}; # not running
2118 $qmpclient->queue_cmd($vmid, $statuscb, 'query-status');
2121 $qmpclient->queue_execute();
2123 foreach my $vmid (keys %$list) {
2124 next if $opt_vmid && ($vmid ne $opt_vmid);
2125 $res->{$vmid}->{qmpstatus
} = $res->{$vmid}->{status
} if !$res->{$vmid}->{qmpstatus
};
2132 my ($conf, $func) = @_;
2134 foreach my $ds (keys %$conf) {
2135 next if !valid_drivename
($ds);
2137 my $drive = parse_drive
($ds, $conf->{$ds});
2140 &$func($ds, $drive);
2145 my ($conf, $func) = @_;
2149 my $test_volid = sub {
2150 my ($volid, $is_cdrom) = @_;
2154 $volhash->{$volid} = $is_cdrom || 0;
2157 foreach_drive
($conf, sub {
2158 my ($ds, $drive) = @_;
2159 &$test_volid($drive->{file
}, drive_is_cdrom
($drive));
2162 foreach my $snapname (keys %{$conf->{snapshots
}}) {
2163 my $snap = $conf->{snapshots
}->{$snapname};
2164 &$test_volid($snap->{vmstate
}, 0);
2165 foreach_drive
($snap, sub {
2166 my ($ds, $drive) = @_;
2167 &$test_volid($drive->{file
}, drive_is_cdrom
($drive));
2171 foreach my $volid (keys %$volhash) {
2172 &$func($volid, $volhash->{$volid});
2176 sub config_to_command
{
2177 my ($storecfg, $vmid, $conf, $defaults) = @_;
2180 my $globalFlags = [];
2181 my $machineFlags = [];
2186 my $kvmver = kvm_user_version
();
2187 my $vernum = 0; # unknown
2188 if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
2189 $vernum = $1*1000000+$2*1000;
2190 } elsif ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
2191 $vernum = $1*1000000+$2*1000+$3;
2194 die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 15000;
2196 my $have_ovz = -f
'/proc/vz/vestat';
2198 push @$cmd, '/usr/bin/kvm';
2200 push @$cmd, '-id', $vmid;
2204 my $qmpsocket = qmp_socket
($vmid);
2205 push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
2206 push @$cmd, '-mon', "chardev=qmp,mode=control";
2208 my $socket = vnc_socket
($vmid);
2209 push @$cmd, '-vnc', "unix:$socket,x509,password";
2211 push @$cmd, '-pidfile' , pidfile_name
($vmid);
2213 push @$cmd, '-daemonize';
2215 $pciaddr = print_pci_addr
("piix3", $bridges);
2216 push @$devices, '-device', "piix3-usb-uhci,id=uhci$pciaddr.0x2";
2219 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2220 next if !$conf->{"usb$i"};
2223 # include usb device config
2224 push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
2226 # enable absolute mouse coordinates (needed by vnc)
2227 my $tablet = defined($conf->{tablet
}) ?
$conf->{tablet
} : $defaults->{tablet
};
2228 push @$devices, '-device', 'usb-tablet,id=tablet,bus=uhci.0,port=1' if $tablet;
2231 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
2232 my $d = parse_hostpci
($conf->{"hostpci$i"});
2234 $pciaddr = print_pci_addr
("hostpci$i", $bridges);
2235 push @$devices, '-device', "pci-assign,host=$d->{pciid},id=hostpci$i$pciaddr";
2239 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++) {
2240 my $d = parse_usb_device
($conf->{"usb$i"});
2242 if ($d->{vendorid
} && $d->{productid
}) {
2243 push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2244 } elsif (defined($d->{hostbus
}) && defined($d->{hostport
})) {
2245 push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2250 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++) {
2251 if (my $path = $conf->{"serial$i"}) {
2252 die "no such serial device\n" if ! -c
$path;
2253 push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2254 push @$devices, '-device', "isa-serial,chardev=serial$i";
2259 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++) {
2260 if (my $path = $conf->{"parallel$i"}) {
2261 die "no such parallel device\n" if ! -c
$path;
2262 push @$devices, '-chardev', "parport,id=parallel$i,path=$path";
2263 push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2267 my $vmname = $conf->{name
} || "vm$vmid";
2269 push @$cmd, '-name', $vmname;
2272 $sockets = $conf->{smp
} if $conf->{smp
}; # old style - no longer iused
2273 $sockets = $conf->{sockets
} if $conf->{sockets
};
2275 my $cores = $conf->{cores
} || 1;
2277 push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2279 push @$cmd, '-cpu', $conf->{cpu
} if $conf->{cpu
};
2281 push @$cmd, '-nodefaults';
2283 my $bootorder = $conf->{boot
} || $confdesc->{boot
}->{default};
2285 my $bootindex_hash = {};
2287 foreach my $o (split(//, $bootorder)) {
2288 $bootindex_hash->{$o} = $i*100;
2292 push @$cmd, '-boot', "menu=on";
2294 push @$cmd, '-no-acpi' if defined($conf->{acpi
}) && $conf->{acpi
} == 0;
2296 push @$cmd, '-no-reboot' if defined($conf->{reboot
}) && $conf->{reboot
} == 0;
2298 my $vga = $conf->{vga
};
2300 if ($conf->{ostype
} && ($conf->{ostype
} eq 'win8' || $conf->{ostype
} eq 'win7' || $conf->{ostype
} eq 'w2k8')) {
2307 push @$cmd, '-vga', $vga if $vga; # for kvm 77 and later
2310 my $tdf = defined($conf->{tdf
}) ?
$conf->{tdf
} : $defaults->{tdf
};
2312 my $nokvm = defined($conf->{kvm
}) && $conf->{kvm
} == 0 ?
1 : 0;
2313 my $useLocaltime = $conf->{localtime};
2315 if (my $ost = $conf->{ostype
}) {
2316 # other, wxp, w2k, w2k3, w2k8, wvista, win7, win8, l24, l26
2318 if ($ost =~ m/^w/) { # windows
2319 $useLocaltime = 1 if !defined($conf->{localtime});
2321 # use time drift fix when acpi is enabled
2322 if (!(defined($conf->{acpi
}) && $conf->{acpi
} == 0)) {
2323 $tdf = 1 if !defined($conf->{tdf
});
2327 if ($ost eq 'win7' || $ost eq 'win8' || $ost eq 'w2k8' ||
2329 push @$globalFlags, 'kvm-pit.lost_tick_policy=discard';
2330 push @$cmd, '-no-hpet';
2334 push @$rtcFlags, 'driftfix=slew' if $tdf;
2337 push @$machineFlags, 'accel=tcg';
2339 die "No accelerator found!\n" if !$cpuinfo->{hvm
};
2342 if ($conf->{startdate
}) {
2343 push @$rtcFlags, "base=$conf->{startdate}";
2344 } elsif ($useLocaltime) {
2345 push @$rtcFlags, 'base=localtime';
2348 push @$cmd, '-S' if $conf->{freeze
};
2350 # set keyboard layout
2351 my $kb = $conf->{keyboard
} || $defaults->{keyboard
};
2352 push @$cmd, '-k', $kb if $kb;
2355 #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2356 #push @$cmd, '-soundhw', 'es1370';
2357 #push @$cmd, '-soundhw', $soundhw if $soundhw;
2359 if($conf->{agent
}) {
2360 my $qgasocket = qga_socket
($vmid);
2361 my $pciaddr = print_pci_addr
("qga0", $bridges);
2362 push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
2363 push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
2364 push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
2367 # enable balloon by default, unless explicitly disabled
2368 if (!defined($conf->{balloon
}) || $conf->{balloon
}) {
2369 $pciaddr = print_pci_addr
("balloon0", $bridges);
2370 push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr";
2373 if ($conf->{watchdog
}) {
2374 my $wdopts = parse_watchdog
($conf->{watchdog
});
2375 $pciaddr = print_pci_addr
("watchdog", $bridges);
2376 my $watchdog = $wdopts->{model
} || 'i6300esb';
2377 push @$devices, '-device', "$watchdog$pciaddr";
2378 push @$devices, '-watchdog-action', $wdopts->{action
} if $wdopts->{action
};
2382 my $scsicontroller = {};
2383 my $ahcicontroller = {};
2384 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : $defaults->{scsihw
};
2386 foreach_drive
($conf, sub {
2387 my ($ds, $drive) = @_;
2389 if (PVE
::Storage
::parse_volume_id
($drive->{file
}, 1)) {
2390 push @$vollist, $drive->{file
};
2393 $use_virtio = 1 if $ds =~ m/^virtio/;
2395 if (drive_is_cdrom
($drive)) {
2396 if ($bootindex_hash->{d
}) {
2397 $drive->{bootindex
} = $bootindex_hash->{d
};
2398 $bootindex_hash->{d
} += 1;
2401 if ($bootindex_hash->{c
}) {
2402 $drive->{bootindex
} = $bootindex_hash->{c
} if $conf->{bootdisk
} && ($conf->{bootdisk
} eq $ds);
2403 $bootindex_hash->{c
} += 1;
2407 if ($drive->{interface
} eq 'scsi') {
2409 my $maxdev = ($scsihw ne 'lsi') ?
256 : 7;
2410 my $controller = int($drive->{index} / $maxdev);
2411 $pciaddr = print_pci_addr
("scsihw$controller", $bridges);
2412 push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
2413 $scsicontroller->{$controller}=1;
2416 if ($drive->{interface
} eq 'sata') {
2417 my $controller = int($drive->{index} / $MAX_SATA_DISKS);
2418 $pciaddr = print_pci_addr
("ahci$controller", $bridges);
2419 push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
2420 $ahcicontroller->{$controller}=1;
2423 push @$devices, '-drive',print_drive_full
($storecfg, $vmid, $drive);
2424 push @$devices, '-device',print_drivedevice_full
($storecfg, $conf, $vmid, $drive, $bridges);
2427 push @$cmd, '-m', $conf->{memory
} || $defaults->{memory
};
2429 for (my $i = 0; $i < $MAX_NETS; $i++) {
2430 next if !$conf->{"net$i"};
2431 my $d = parse_net
($conf->{"net$i"});
2434 $use_virtio = 1 if $d->{model
} eq 'virtio';
2436 if ($bootindex_hash->{n
}) {
2437 $d->{bootindex
} = $bootindex_hash->{n
};
2438 $bootindex_hash->{n
} += 1;
2441 my $netdevfull = print_netdev_full
($vmid,$conf,$d,"net$i");
2442 push @$devices, '-netdev', $netdevfull;
2444 my $netdevicefull = print_netdevice_full
($vmid,$conf,$d,"net$i",$bridges);
2445 push @$devices, '-device', $netdevicefull;
2449 while (my ($k, $v) = each %$bridges) {
2450 $pciaddr = print_pci_addr
("pci.$k");
2451 unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
2455 # hack: virtio with fairsched is unreliable, so we do not use fairsched
2456 # when the VM uses virtio devices.
2457 if (!$use_virtio && $have_ovz) {
2459 my $cpuunits = defined($conf->{cpuunits
}) ?
2460 $conf->{cpuunits
} : $defaults->{cpuunits
};
2462 push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
2464 # fixme: cpulimit is currently ignored
2465 #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2469 if ($conf->{args
}) {
2470 my $aa = PVE
::Tools
::split_args
($conf->{args
});
2474 push @$cmd, @$devices;
2475 push @$cmd, '-rtc', join(',', @$rtcFlags)
2476 if scalar(@$rtcFlags);
2477 push @$cmd, '-machine', join(',', @$machineFlags)
2478 if scalar(@$machineFlags);
2479 push @$cmd, '-global', join(',', @$globalFlags)
2480 if scalar(@$globalFlags);
2482 return wantarray ?
($cmd, $vollist) : $cmd;
2487 return "${var_run_tmpdir}/$vmid.vnc";
2492 return "${var_run_tmpdir}/$vmid.qmp";
2497 return "${var_run_tmpdir}/$vmid.qga";
2502 return "${var_run_tmpdir}/$vmid.pid";
2505 sub next_migrate_port
{
2507 for (my $p = 60000; $p < 60010; $p++) {
2509 my $sock = IO
::Socket
::INET-
>new(Listen
=> 5,
2510 LocalAddr
=> 'localhost',
2521 die "unable to find free migration port";
2524 sub vm_devices_list
{
2527 my $res = vm_mon_cmd
($vmid, 'query-pci');
2530 foreach my $pcibus (@$res) {
2531 foreach my $device (@{$pcibus->{devices
}}) {
2532 next if !$device->{'qdev_id'};
2533 $devices->{$device->{'qdev_id'}} = $device;
2541 my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2543 return 1 if !check_running
($vmid);
2545 if ($deviceid eq 'tablet') {
2546 my $devicefull = "usb-tablet,id=tablet,bus=uhci.0,port=1";
2547 qemu_deviceadd
($vmid, $devicefull);
2551 return 1 if !$conf->{hotplug
};
2553 my $devices_list = vm_devices_list
($vmid);
2554 return 1 if defined($devices_list->{$deviceid});
2556 qemu_bridgeadd
($storecfg, $conf, $vmid, $deviceid); #add bridge if we need it for the device
2558 if ($deviceid =~ m/^(virtio)(\d+)$/) {
2559 return undef if !qemu_driveadd
($storecfg, $vmid, $device);
2560 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
2561 qemu_deviceadd
($vmid, $devicefull);
2562 if(!qemu_deviceaddverify
($vmid, $deviceid)) {
2563 qemu_drivedel
($vmid, $deviceid);
2568 if ($deviceid =~ m/^(scsihw)(\d+)$/) {
2569 my $scsihw = defined($conf->{scsihw
}) ?
$conf->{scsihw
} : "lsi";
2570 my $pciaddr = print_pci_addr
($deviceid);
2571 my $devicefull = "$scsihw,id=$deviceid$pciaddr";
2572 qemu_deviceadd
($vmid, $devicefull);
2573 return undef if(!qemu_deviceaddverify
($vmid, $deviceid));
2576 if ($deviceid =~ m/^(scsi)(\d+)$/) {
2577 return 1 if ($conf->{scsihw
} && $conf->{scsihw
} ne 'lsi'); #virtio-scsi not yet support hotplug
2578 return undef if !qemu_findorcreatescsihw
($storecfg,$conf, $vmid, $device);
2579 return undef if !qemu_driveadd
($storecfg, $vmid, $device);
2580 my $devicefull = print_drivedevice_full
($storecfg, $conf, $vmid, $device);
2581 if(!qemu_deviceadd
($vmid, $devicefull)) {
2582 qemu_drivedel
($vmid, $deviceid);
2587 if ($deviceid =~ m/^(net)(\d+)$/) {
2588 return undef if !qemu_netdevadd
($vmid, $conf, $device, $deviceid);
2589 my $netdevicefull = print_netdevice_full
($vmid, $conf, $device, $deviceid);
2590 qemu_deviceadd
($vmid, $netdevicefull);
2591 if(!qemu_deviceaddverify
($vmid, $deviceid)) {
2592 qemu_netdevdel
($vmid, $deviceid);
2597 if ($deviceid =~ m/^(pci\.)(\d+)$/) {
2599 my $pciaddr = print_pci_addr
($deviceid);
2600 my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
2601 qemu_deviceadd
($vmid, $devicefull);
2602 return undef if !qemu_deviceaddverify
($vmid, $deviceid);
2608 sub vm_deviceunplug
{
2609 my ($vmid, $conf, $deviceid) = @_;
2611 return 1 if !check_running
($vmid);
2613 if ($deviceid eq 'tablet') {
2614 qemu_devicedel
($vmid, $deviceid);
2618 return 1 if !$conf->{hotplug
};
2620 my $devices_list = vm_devices_list
($vmid);
2621 return 1 if !defined($devices_list->{$deviceid});
2623 die "can't unplug bootdisk" if $conf->{bootdisk
} && $conf->{bootdisk
} eq $deviceid;
2625 if ($deviceid =~ m/^(virtio)(\d+)$/) {
2626 qemu_devicedel
($vmid, $deviceid);
2627 return undef if !qemu_devicedelverify
($vmid, $deviceid);
2628 return undef if !qemu_drivedel
($vmid, $deviceid);
2631 if ($deviceid =~ m/^(lsi)(\d+)$/) {
2632 return undef if !qemu_devicedel
($vmid, $deviceid);
2635 if ($deviceid =~ m/^(scsi)(\d+)$/) {
2636 return undef if !qemu_devicedel
($vmid, $deviceid);
2637 return undef if !qemu_drivedel
($vmid, $deviceid);
2640 if ($deviceid =~ m/^(net)(\d+)$/) {
2641 qemu_devicedel
($vmid, $deviceid);
2642 return undef if !qemu_devicedelverify
($vmid, $deviceid);
2643 return undef if !qemu_netdevdel
($vmid, $deviceid);
2649 sub qemu_deviceadd
{
2650 my ($vmid, $devicefull) = @_;
2652 $devicefull = "driver=".$devicefull;
2653 my %options = split(/[=,]/, $devicefull);
2655 vm_mon_cmd
($vmid, "device_add" , %options);
2659 sub qemu_devicedel
{
2660 my($vmid, $deviceid) = @_;
2661 my $ret = vm_mon_cmd
($vmid, "device_del", id
=> $deviceid);
2666 my($storecfg, $vmid, $device) = @_;
2668 my $drive = print_drive_full
($storecfg, $vmid, $device);
2669 my $ret = vm_human_monitor_command
($vmid, "drive_add auto $drive");
2670 # If the command succeeds qemu prints: "OK"
2671 if ($ret !~ m/OK/s) {
2672 syslog
("err", "adding drive failed: $ret");
2679 my($vmid, $deviceid) = @_;
2681 my $ret = vm_human_monitor_command
($vmid, "drive_del drive-$deviceid");
2683 if ($ret =~ m/Device \'.*?\' not found/s) {
2684 # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2686 elsif ($ret ne "") {
2687 syslog
("err", "deleting drive $deviceid failed : $ret");
2693 sub qemu_deviceaddverify
{
2694 my ($vmid,$deviceid) = @_;
2696 for (my $i = 0; $i <= 5; $i++) {
2697 my $devices_list = vm_devices_list
($vmid);
2698 return 1 if defined($devices_list->{$deviceid});
2701 syslog
("err", "error on hotplug device $deviceid");
2706 sub qemu_devicedelverify
{
2707 my ($vmid,$deviceid) = @_;
2709 #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2710 for (my $i = 0; $i <= 5; $i++) {
2711 my $devices_list = vm_devices_list
($vmid);
2712 return 1 if !defined($devices_list->{$deviceid});
2715 syslog
("err", "error on hot-unplugging device $deviceid");
2719 sub qemu_findorcreatescsihw
{
2720 my ($storecfg, $conf, $vmid, $device) = @_;
2722 my $maxdev = ($conf->{scsihw
} && $conf->{scsihw
} ne 'lsi') ?
256 : 7;
2723 my $controller = int($device->{index} / $maxdev);
2724 my $scsihwid="scsihw$controller";
2725 my $devices_list = vm_devices_list
($vmid);
2727 if(!defined($devices_list->{$scsihwid})) {
2728 return undef if !vm_deviceplug
($storecfg, $conf, $vmid, $scsihwid);
2733 sub qemu_bridgeadd
{
2734 my ($storecfg, $conf, $vmid, $device) = @_;
2737 my $bridgeid = undef;
2738 print_pci_addr
($device, $bridges);
2740 while (my ($k, $v) = each %$bridges) {
2743 return if $bridgeid < 1;
2744 my $bridge = "pci.$bridgeid";
2745 my $devices_list = vm_devices_list
($vmid);
2747 if(!defined($devices_list->{$bridge})) {
2748 return undef if !vm_deviceplug
($storecfg, $conf, $vmid, $bridge);
2753 sub qemu_netdevadd
{
2754 my ($vmid, $conf, $device, $deviceid) = @_;
2756 my $netdev = print_netdev_full
($vmid, $conf, $device, $deviceid);
2757 my %options = split(/[=,]/, $netdev);
2759 vm_mon_cmd
($vmid, "netdev_add", %options);
2763 sub qemu_netdevdel
{
2764 my ($vmid, $deviceid) = @_;
2766 vm_mon_cmd
($vmid, "netdev_del", id
=> $deviceid);
2770 sub qemu_block_set_io_throttle
{
2771 my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
2773 return if !check_running
($vmid) ;
2776 $bps_rd = 0 if !$bps_rd;
2777 $bps_wr = 0 if !$bps_wr;
2778 $iops = 0 if !$iops;
2779 $iops_rd = 0 if !$iops_rd;
2780 $iops_wr = 0 if !$iops_wr;
2782 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));
2786 # old code, only used to shutdown old VM after update
2788 my ($fh, $timeout) = @_;
2790 my $sel = new IO
::Select
;
2797 while (scalar (@ready = $sel->can_read($timeout))) {
2799 if ($count = $fh->sysread($buf, 8192)) {
2800 if ($buf =~ /^(.*)\(qemu\) $/s) {
2807 if (!defined($count)) {
2814 die "monitor read timeout\n" if !scalar(@ready);
2819 # old code, only used to shutdown old VM after update
2820 sub vm_monitor_command
{
2821 my ($vmid, $cmdstr, $nocheck) = @_;
2826 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
2828 my $sname = "${var_run_tmpdir}/$vmid.mon";
2830 my $sock = IO
::Socket
::UNIX-
>new( Peer
=> $sname ) ||
2831 die "unable to connect to VM $vmid socket - $!\n";
2835 # hack: migrate sometime blocks the monitor (when migrate_downtime
2837 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2838 $timeout = 60*60; # 1 hour
2842 my $data = __read_avail
($sock, $timeout);
2844 if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
2845 die "got unexpected qemu monitor banner\n";
2848 my $sel = new IO
::Select
;
2851 if (!scalar(my @ready = $sel->can_write($timeout))) {
2852 die "monitor write error - timeout";
2855 my $fullcmd = "$cmdstr\r";
2857 # syslog('info', "VM $vmid monitor command: $cmdstr");
2860 if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
2861 die "monitor write error - $!";
2864 return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
2868 if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2869 $timeout = 60*60; # 1 hour
2870 } elsif ($cmdstr =~ m/^(eject|change)/) {
2871 $timeout = 60; # note: cdrom mount command is slow
2873 if ($res = __read_avail
($sock, $timeout)) {
2875 my @lines = split("\r?\n", $res);
2877 shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
2879 $res = join("\n", @lines);
2887 syslog
("err", "VM $vmid monitor command failed - $err");
2894 sub qemu_block_resize
{
2895 my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
2897 my $running = check_running
($vmid);
2899 return if !PVE
::Storage
::volume_resize
($storecfg, $volid, $size, $running);
2901 return if !$running;
2903 vm_mon_cmd
($vmid, "block_resize", device
=> $deviceid, size
=> int($size));
2907 sub qemu_volume_snapshot
{
2908 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
2910 my $running = check_running
($vmid);
2912 return if !PVE
::Storage
::volume_snapshot
($storecfg, $volid, $snap, $running);
2914 return if !$running;
2916 vm_mon_cmd
($vmid, "snapshot-drive", device
=> $deviceid, name
=> $snap);
2920 sub qemu_volume_snapshot_delete
{
2921 my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
2923 my $running = check_running
($vmid);
2925 return if !PVE
::Storage
::volume_snapshot_delete
($storecfg, $volid, $snap, $running);
2927 return if !$running;
2929 vm_mon_cmd
($vmid, "delete-drive-snapshot", device
=> $deviceid, name
=> $snap);
2935 #need to impplement call to qemu-ga
2938 sub qga_unfreezefs
{
2941 #need to impplement call to qemu-ga
2945 my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused) = @_;
2947 lock_config
($vmid, sub {
2948 my $conf = load_config
($vmid, $migratedfrom);
2950 die "you can't start a vm if it's a template\n" if is_template
($conf);
2952 check_lock
($conf) if !$skiplock;
2954 die "VM $vmid already running\n" if check_running
($vmid, undef, $migratedfrom);
2956 my $defaults = load_defaults
();
2958 # set environment variable useful inside network script
2959 $ENV{PVE_MIGRATED_FROM
} = $migratedfrom if $migratedfrom;
2961 my ($cmd, $vollist) = config_to_command
($storecfg, $vmid, $conf, $defaults);
2963 my $migrate_port = 0;
2966 if ($statefile eq 'tcp') {
2967 $migrate_port = next_migrate_port
();
2968 my $migrate_uri = "tcp:localhost:${migrate_port}";
2969 push @$cmd, '-incoming', $migrate_uri;
2972 push @$cmd, '-loadstate', $statefile;
2979 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++) {
2980 my $d = parse_hostpci
($conf->{"hostpci$i"});
2982 my $info = pci_device_info
("0000:$d->{pciid}");
2983 die "IOMMU not present\n" if !check_iommu_support
();
2984 die "no pci device info for device '$d->{pciid}'\n" if !$info;
2985 die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub
($info);
2986 die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset
($info);
2989 PVE
::Storage
::activate_volumes
($storecfg, $vollist);
2991 eval { run_command
($cmd, timeout
=> $statefile ?
undef : 30,
2994 die "start failed: $err" if $err;
2996 print "migration listens on port $migrate_port\n" if $migrate_port;
2998 if ($statefile && $statefile ne 'tcp') {
2999 eval { vm_mon_cmd_nocheck
($vmid, "cont"); };
3004 my $capabilities = {};
3005 $capabilities->{capability
} = "xbzrle";
3006 $capabilities->{state} = JSON
::true
;
3007 eval { vm_mon_cmd_nocheck
($vmid, "migrate-set-capabilities", capabilities
=> [$capabilities]); };
3011 if (!defined($conf->{balloon
}) || $conf->{balloon
}) {
3012 vm_mon_cmd_nocheck
($vmid, "balloon", value
=> $conf->{balloon
}*1024*1024)
3013 if $conf->{balloon
};
3014 vm_mon_cmd_nocheck
($vmid, 'qom-set',
3015 path
=> "machine/peripheral/balloon0",
3016 property
=> "guest-stats-polling-interval",
3024 my ($vmid, $execute, %params) = @_;
3026 my $cmd = { execute
=> $execute, arguments
=> \
%params };
3027 vm_qmp_command
($vmid, $cmd);
3030 sub vm_mon_cmd_nocheck
{
3031 my ($vmid, $execute, %params) = @_;
3033 my $cmd = { execute
=> $execute, arguments
=> \
%params };
3034 vm_qmp_command
($vmid, $cmd, 1);
3037 sub vm_qmp_command
{
3038 my ($vmid, $cmd, $nocheck) = @_;
3043 if ($cmd->{arguments
} && $cmd->{arguments
}->{timeout
}) {
3044 $timeout = $cmd->{arguments
}->{timeout
};
3045 delete $cmd->{arguments
}->{timeout
};
3049 die "VM $vmid not running\n" if !check_running
($vmid, $nocheck);
3050 my $sname = qmp_socket
($vmid);
3052 my $qmpclient = PVE
::QMPClient-
>new();
3054 $res = $qmpclient->cmd($vmid, $cmd, $timeout);
3055 } elsif (-e
"${var_run_tmpdir}/$vmid.mon") {
3056 die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
3057 if scalar(%{$cmd->{arguments
}});
3058 vm_monitor_command
($vmid, $cmd->{execute
}, $nocheck);
3060 die "unable to open monitor socket\n";
3064 syslog
("err", "VM $vmid qmp command failed - $err");
3071 sub vm_human_monitor_command
{
3072 my ($vmid, $cmdline) = @_;
3077 execute
=> 'human-monitor-command',
3078 arguments
=> { 'command-line' => $cmdline},
3081 return vm_qmp_command
($vmid, $cmd);
3084 sub vm_commandline
{
3085 my ($storecfg, $vmid) = @_;
3087 my $conf = load_config
($vmid);
3089 my $defaults = load_defaults
();
3091 my $cmd = config_to_command
($storecfg, $vmid, $conf, $defaults);
3093 return join(' ', @$cmd);
3097 my ($vmid, $skiplock) = @_;
3099 lock_config
($vmid, sub {
3101 my $conf = load_config
($vmid);
3103 check_lock
($conf) if !$skiplock;
3105 vm_mon_cmd
($vmid, "system_reset");
3109 sub get_vm_volumes
{
3113 foreach_volid
($conf, sub {
3114 my ($volid, $is_cdrom) = @_;
3116 return if $volid =~ m
|^/|;
3118 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
3121 push @$vollist, $volid;
3127 sub vm_stop_cleanup
{
3128 my ($storecfg, $vmid, $conf, $keepActive) = @_;
3131 fairsched_rmnod
($vmid); # try to destroy group
3134 my $vollist = get_vm_volumes
($conf);
3135 PVE
::Storage
::deactivate_volumes
($storecfg, $vollist);
3138 foreach my $ext (qw(mon qmp pid vnc qga)) {
3139 unlink "/var/run/qemu-server/${vmid}.$ext";
3142 warn $@ if $@; # avoid errors - just warn
3145 # Note: use $nockeck to skip tests if VM configuration file exists.
3146 # We need that when migration VMs to other nodes (files already moved)
3147 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3149 my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3151 $force = 1 if !defined($force) && !$shutdown;
3154 my $pid = check_running
($vmid, $nocheck, $migratedfrom);
3155 kill 15, $pid if $pid;
3156 my $conf = load_config
($vmid, $migratedfrom);
3157 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive);
3161 lock_config
($vmid, sub {
3163 my $pid = check_running
($vmid, $nocheck);
3168 $conf = load_config
($vmid);
3169 check_lock
($conf) if !$skiplock;
3170 if (!defined($timeout) && $shutdown && $conf->{startup
}) {
3171 my $opts = parse_startup
($conf->{startup
});
3172 $timeout = $opts->{down
} if $opts->{down
};
3176 $timeout = 60 if !defined($timeout);
3180 $nocheck ? vm_mon_cmd_nocheck
($vmid, "system_powerdown") : vm_mon_cmd
($vmid, "system_powerdown");
3183 $nocheck ? vm_mon_cmd_nocheck
($vmid, "quit") : vm_mon_cmd
($vmid, "quit");
3190 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
3195 if ($count >= $timeout) {
3197 warn "VM still running - terminating now with SIGTERM\n";
3200 die "VM quit/powerdown failed - got timeout\n";
3203 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
3208 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3211 die "VM quit/powerdown failed\n";
3219 while (($count < $timeout) && check_running
($vmid, $nocheck)) {
3224 if ($count >= $timeout) {
3225 warn "VM still running - terminating now with SIGKILL\n";
3230 vm_stop_cleanup
($storecfg, $vmid, $conf, $keepActive) if $conf;
3235 my ($vmid, $skiplock) = @_;
3237 lock_config
($vmid, sub {
3239 my $conf = load_config
($vmid);
3241 check_lock
($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3243 vm_mon_cmd
($vmid, "stop");
3248 my ($vmid, $skiplock) = @_;
3250 lock_config
($vmid, sub {
3252 my $conf = load_config
($vmid);
3254 check_lock
($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3256 vm_mon_cmd
($vmid, "cont");
3261 my ($vmid, $skiplock, $key) = @_;
3263 lock_config
($vmid, sub {
3265 my $conf = load_config
($vmid);
3267 # there is no qmp command, so we use the human monitor command
3268 vm_human_monitor_command
($vmid, "sendkey $key");
3273 my ($storecfg, $vmid, $skiplock) = @_;
3275 lock_config
($vmid, sub {
3277 my $conf = load_config
($vmid);
3279 check_lock
($conf) if !$skiplock;
3281 if (!check_running
($vmid)) {
3282 fairsched_rmnod
($vmid); # try to destroy group
3283 destroy_vm
($storecfg, $vmid);
3285 die "VM $vmid is running - destroy failed\n";
3293 my ($filename, $buf) = @_;
3295 my $fh = IO
::File-
>new($filename, "w");
3296 return undef if !$fh;
3298 my $res = print $fh $buf;
3305 sub pci_device_info
{
3310 return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3311 my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3313 my $irq = file_read_firstline
("$pcisysfs/devices/$name/irq");
3314 return undef if !defined($irq) || $irq !~ m/^\d+$/;
3316 my $vendor = file_read_firstline
("$pcisysfs/devices/$name/vendor");
3317 return undef if !defined($vendor) || $vendor !~ s/^0x//;
3319 my $product = file_read_firstline
("$pcisysfs/devices/$name/device");
3320 return undef if !defined($product) || $product !~ s/^0x//;
3325 product
=> $product,
3331 has_fl_reset
=> -f
"$pcisysfs/devices/$name/reset" || 0,
3340 my $name = $dev->{name
};
3342 my $fn = "$pcisysfs/devices/$name/reset";
3344 return file_write
($fn, "1");
3347 sub pci_dev_bind_to_stub
{
3350 my $name = $dev->{name
};
3352 my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3353 return 1 if -d
$testdir;
3355 my $data = "$dev->{vendor} $dev->{product}";
3356 return undef if !file_write
("$pcisysfs/drivers/pci-stub/new_id", $data);
3358 my $fn = "$pcisysfs/devices/$name/driver/unbind";
3359 if (!file_write
($fn, $name)) {
3360 return undef if -f
$fn;
3363 $fn = "$pcisysfs/drivers/pci-stub/bind";
3364 if (! -d
$testdir) {
3365 return undef if !file_write
($fn, $name);
3371 sub print_pci_addr
{
3372 my ($id, $bridges) = @_;
3376 piix3
=> { bus
=> 0, addr
=> 1 },
3377 #addr2 : first videocard
3378 balloon0
=> { bus
=> 0, addr
=> 3 },
3379 watchdog
=> { bus
=> 0, addr
=> 4 },
3380 scsihw0
=> { bus
=> 0, addr
=> 5 },
3381 scsihw1
=> { bus
=> 0, addr
=> 6 },
3382 ahci0
=> { bus
=> 0, addr
=> 7 },
3383 qga0
=> { bus
=> 0, addr
=> 8 },
3384 virtio0
=> { bus
=> 0, addr
=> 10 },
3385 virtio1
=> { bus
=> 0, addr
=> 11 },
3386 virtio2
=> { bus
=> 0, addr
=> 12 },
3387 virtio3
=> { bus
=> 0, addr
=> 13 },
3388 virtio4
=> { bus
=> 0, addr
=> 14 },
3389 virtio5
=> { bus
=> 0, addr
=> 15 },
3390 hostpci0
=> { bus
=> 0, addr
=> 16 },
3391 hostpci1
=> { bus
=> 0, addr
=> 17 },
3392 net0
=> { bus
=> 0, addr
=> 18 },
3393 net1
=> { bus
=> 0, addr
=> 19 },
3394 net2
=> { bus
=> 0, addr
=> 20 },
3395 net3
=> { bus
=> 0, addr
=> 21 },
3396 net4
=> { bus
=> 0, addr
=> 22 },
3397 net5
=> { bus
=> 0, addr
=> 23 },
3398 #addr29 : usb-host (pve-usb.cfg)
3399 'pci.1' => { bus
=> 0, addr
=> 30 },
3400 'pci.2' => { bus
=> 0, addr
=> 31 },
3401 'net6' => { bus
=> 1, addr
=> 1 },
3402 'net7' => { bus
=> 1, addr
=> 2 },
3403 'net8' => { bus
=> 1, addr
=> 3 },
3404 'net9' => { bus
=> 1, addr
=> 4 },
3405 'net10' => { bus
=> 1, addr
=> 5 },
3406 'net11' => { bus
=> 1, addr
=> 6 },
3407 'net12' => { bus
=> 1, addr
=> 7 },
3408 'net13' => { bus
=> 1, addr
=> 8 },
3409 'net14' => { bus
=> 1, addr
=> 9 },
3410 'net15' => { bus
=> 1, addr
=> 10 },
3411 'net16' => { bus
=> 1, addr
=> 11 },
3412 'net17' => { bus
=> 1, addr
=> 12 },
3413 'net18' => { bus
=> 1, addr
=> 13 },
3414 'net19' => { bus
=> 1, addr
=> 14 },
3415 'net20' => { bus
=> 1, addr
=> 15 },
3416 'net21' => { bus
=> 1, addr
=> 16 },
3417 'net22' => { bus
=> 1, addr
=> 17 },
3418 'net23' => { bus
=> 1, addr
=> 18 },
3419 'net24' => { bus
=> 1, addr
=> 19 },
3420 'net25' => { bus
=> 1, addr
=> 20 },
3421 'net26' => { bus
=> 1, addr
=> 21 },
3422 'net27' => { bus
=> 1, addr
=> 22 },
3423 'net28' => { bus
=> 1, addr
=> 23 },
3424 'net29' => { bus
=> 1, addr
=> 24 },
3425 'net30' => { bus
=> 1, addr
=> 25 },
3426 'net31' => { bus
=> 1, addr
=> 26 },
3427 'virtio6' => { bus
=> 2, addr
=> 1 },
3428 'virtio7' => { bus
=> 2, addr
=> 2 },
3429 'virtio8' => { bus
=> 2, addr
=> 3 },
3430 'virtio9' => { bus
=> 2, addr
=> 4 },
3431 'virtio10' => { bus
=> 2, addr
=> 5 },
3432 'virtio11' => { bus
=> 2, addr
=> 6 },
3433 'virtio12' => { bus
=> 2, addr
=> 7 },
3434 'virtio13' => { bus
=> 2, addr
=> 8 },
3435 'virtio14' => { bus
=> 2, addr
=> 9 },
3436 'virtio15' => { bus
=> 2, addr
=> 10 },
3439 if (defined($devices->{$id}->{bus
}) && defined($devices->{$id}->{addr
})) {
3440 my $addr = sprintf("0x%x", $devices->{$id}->{addr
});
3441 my $bus = $devices->{$id}->{bus
};
3442 $res = ",bus=pci.$bus,addr=$addr";
3443 $bridges->{$bus} = 1 if $bridges;
3449 # vzdump restore implementaion
3451 sub tar_archive_read_firstfile
{
3452 my $archive = shift;
3454 die "ERROR: file '$archive' does not exist\n" if ! -f
$archive;
3456 # try to detect archive type first
3457 my $pid = open (TMP
, "tar tf '$archive'|") ||
3458 die "unable to open file '$archive'\n";
3459 my $firstfile = <TMP
>;
3463 die "ERROR: archive contaions no data\n" if !$firstfile;
3469 sub tar_restore_cleanup
{
3470 my ($storecfg, $statfile) = @_;
3472 print STDERR
"starting cleanup\n";
3474 if (my $fd = IO
::File-
>new($statfile, "r")) {
3475 while (defined(my $line = <$fd>)) {
3476 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3479 if ($volid =~ m
|^/|) {
3480 unlink $volid || die 'unlink failed\n';
3482 PVE
::Storage
::vdisk_free
($storecfg, $volid);
3484 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
3486 print STDERR
"unable to cleanup '$volid' - $@" if $@;
3488 print STDERR
"unable to parse line in statfile - $line";
3495 sub restore_archive
{
3496 my ($archive, $vmid, $user, $opts) = @_;
3498 my $format = $opts->{format
};
3501 if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
3502 $format = 'tar' if !$format;
3504 } elsif ($archive =~ m/\.tar$/) {
3505 $format = 'tar' if !$format;
3506 } elsif ($archive =~ m/.tar.lzo$/) {
3507 $format = 'tar' if !$format;
3509 } elsif ($archive =~ m/\.vma$/) {
3510 $format = 'vma' if !$format;
3511 } elsif ($archive =~ m/\.vma\.gz$/) {
3512 $format = 'vma' if !$format;
3514 } elsif ($archive =~ m/\.vma\.lzo$/) {
3515 $format = 'vma' if !$format;
3518 $format = 'vma' if !$format; # default
3521 # try to detect archive format
3522 if ($format eq 'tar') {
3523 return restore_tar_archive
($archive, $vmid, $user, $opts);
3525 return restore_vma_archive
($archive, $vmid, $user, $opts, $comp);
3529 sub restore_update_config_line
{
3530 my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
3532 return if $line =~ m/^\#qmdump\#/;
3533 return if $line =~ m/^\#vzdump\#/;
3534 return if $line =~ m/^lock:/;
3535 return if $line =~ m/^unused\d+:/;
3536 return if $line =~ m/^parent:/;
3538 if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3539 # try to convert old 1.X settings
3540 my ($id, $ind, $ethcfg) = ($1, $2, $3);
3541 foreach my $devconfig (PVE
::Tools
::split_list
($ethcfg)) {
3542 my ($model, $macaddr) = split(/\=/, $devconfig);
3543 $macaddr = PVE
::Tools
::random_ether_addr
() if !$macaddr || $unique;
3546 bridge
=> "vmbr$ind",
3547 macaddr
=> $macaddr,
3549 my $netstr = print_net
($net);
3551 print $outfd "net$cookie->{netcount}: $netstr\n";
3552 $cookie->{netcount
}++;
3554 } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
3555 my ($id, $netstr) = ($1, $2);
3556 my $net = parse_net
($netstr);
3557 $net->{macaddr
} = PVE
::Tools
::random_ether_addr
() if $net->{macaddr
};
3558 $netstr = print_net
($net);
3559 print $outfd "$id: $netstr\n";
3560 } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
3563 if ($line =~ m/backup=no/) {
3564 print $outfd "#$line";
3565 } elsif ($virtdev && $map->{$virtdev}) {
3566 my $di = parse_drive
($virtdev, $value);
3567 $di->{file
} = $map->{$virtdev};
3568 $value = print_drive
($vmid, $di);
3569 print $outfd "$virtdev: $value\n";
3579 my ($cfg, $vmid) = @_;
3581 my $info = PVE
::Storage
::vdisk_list
($cfg, undef, $vmid);
3583 my $volid_hash = {};
3584 foreach my $storeid (keys %$info) {
3585 foreach my $item (@{$info->{$storeid}}) {
3586 next if !($item->{volid
} && $item->{size
});
3587 $volid_hash->{$item->{volid
}} = $item;
3594 sub update_disksize
{
3595 my ($vmid, $conf, $volid_hash) = @_;
3602 foreach my $opt (keys %$conf) {
3603 if (valid_drivename
($opt)) {
3604 my $drive = parse_drive
($opt, $conf->{$opt});
3605 my $volid = $drive->{file
};
3608 $used->{$volid} = 1;
3610 next if drive_is_cdrom
($drive);
3611 next if !$volid_hash->{$volid};
3613 $drive->{size
} = $volid_hash->{$volid}->{size
};
3615 $conf->{$opt} = print_drive
($vmid, $drive);
3619 foreach my $volid (sort keys %$volid_hash) {
3620 next if $volid =~ m/vm-$vmid-state-/;
3621 next if $used->{$volid};
3623 add_unused_volume
($conf, $volid);
3630 my ($vmid, $nolock) = @_;
3632 my $cfg = PVE
::Cluster
::cfs_read_file
("storage.cfg");
3634 my $volid_hash = scan_volids
($cfg, $vmid);
3636 my $updatefn = sub {
3639 my $conf = load_config
($vmid);
3644 foreach my $volid (keys %$volid_hash) {
3645 my $info = $volid_hash->{$volid};
3646 $vm_volids->{$volid} = $info if $info->{vmid
} && $info->{vmid
} == $vmid;
3649 my $changes = update_disksize
($vmid, $conf, $vm_volids);
3651 update_config_nolock
($vmid, $conf, 1) if $changes;
3654 if (defined($vmid)) {
3658 lock_config
($vmid, $updatefn, $vmid);
3661 my $vmlist = config_list
();
3662 foreach my $vmid (keys %$vmlist) {
3666 lock_config
($vmid, $updatefn, $vmid);
3672 sub restore_vma_archive
{
3673 my ($archive, $vmid, $user, $opts, $comp) = @_;
3675 my $input = $archive eq '-' ?
"<&STDIN" : undef;
3676 my $readfrom = $archive;
3681 my $qarchive = PVE
::Tools
::shellquote
($archive);
3682 if ($comp eq 'gzip') {
3683 $uncomp = "zcat $qarchive|";
3684 } elsif ($comp eq 'lzop') {
3685 $uncomp = "lzop -d -c $qarchive|";
3687 die "unknown compression method '$comp'\n";
3692 my $tmpdir = "/var/tmp/vzdumptmp$$";
3695 # disable interrupts (always do cleanups)
3696 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
3697 warn "got interrupt - ignored\n";
3700 my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
3701 POSIX
::mkfifo
($mapfifo, 0600);
3704 my $openfifo = sub {
3705 open($fifofh, '>', $mapfifo) || die $!;
3708 my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
3715 my $rpcenv = PVE
::RPCEnvironment
::get
();
3717 my $conffile = config_file
($vmid);
3718 my $tmpfn = "$conffile.$$.tmp";
3720 # Note: $oldconf is undef if VM does not exists
3721 my $oldconf = PVE
::Cluster
::cfs_read_file
(cfs_config_path
($vmid));
3723 my $print_devmap = sub {
3724 my $virtdev_hash = {};
3726 my $cfgfn = "$tmpdir/qemu-server.conf";
3728 # we can read the config - that is already extracted
3729 my $fh = IO
::File-
>new($cfgfn, "r") ||
3730 "unable to read qemu-server.conf - $!\n";
3732 while (defined(my $line = <$fh>)) {
3733 if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
3734 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
3735 die "archive does not contain data for drive '$virtdev'\n"
3736 if !$devinfo->{$devname};
3737 if (defined($opts->{storage
})) {
3738 $storeid = $opts->{storage
} || 'local';
3739 } elsif (!$storeid) {
3742 $format = 'raw' if !$format;
3743 $devinfo->{$devname}->{devname
} = $devname;
3744 $devinfo->{$devname}->{virtdev
} = $virtdev;
3745 $devinfo->{$devname}->{format
} = $format;
3746 $devinfo->{$devname}->{storeid
} = $storeid;
3748 # check permission on storage
3749 my $pool = $opts->{pool
}; # todo: do we need that?
3750 if ($user ne 'root@pam') {
3751 $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
3754 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
3758 foreach my $devname (keys %$devinfo) {
3759 die "found no device mapping information for device '$devname'\n"
3760 if !$devinfo->{$devname}->{virtdev
};
3763 my $cfg = cfs_read_file
('storage.cfg');
3765 # create empty/temp config
3767 PVE
::Tools
::file_set_contents
($conffile, "memory: 128\n");
3768 foreach_drive
($oldconf, sub {
3769 my ($ds, $drive) = @_;
3771 return if drive_is_cdrom
($drive);
3773 my $volid = $drive->{file
};
3775 return if !$volid || $volid =~ m
|^/|;
3777 my ($path, $owner) = PVE
::Storage
::path
($cfg, $volid);
3778 return if !$path || !$owner || ($owner != $vmid);
3780 # Note: only delete disk we want to restore
3781 # other volumes will become unused
3782 if ($virtdev_hash->{$ds}) {
3783 PVE
::Storage
::vdisk_free
($cfg, $volid);
3789 foreach my $virtdev (sort keys %$virtdev_hash) {
3790 my $d = $virtdev_hash->{$virtdev};
3791 my $alloc_size = int(($d->{size
} + 1024 - 1)/1024);
3792 my $scfg = PVE
::Storage
::storage_config
($cfg, $d->{storeid
});
3793 my $volid = PVE
::Storage
::vdisk_alloc
($cfg, $d->{storeid
}, $vmid,
3794 $d->{format
}, undef, $alloc_size);
3795 print STDERR
"new volume ID is '$volid'\n";
3796 $d->{volid
} = $volid;
3797 my $path = PVE
::Storage
::path
($cfg, $volid);
3799 my $write_zeros = 1;
3800 # fixme: what other storages types initialize volumes with zero?
3801 if ($scfg->{type
} eq 'dir' || $scfg->{type
} eq 'nfs' ||
3802 $scfg->{type
} eq 'sheepdog' || $scfg->{type
} eq 'rbd') {
3806 print $fifofh "${write_zeros}:$d->{devname}=$path\n";
3808 print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
3809 $map->{$virtdev} = $volid;
3812 $fh->seek(0, 0) || die "seek failed - $!\n";
3814 my $outfd = new IO
::File
($tmpfn, "w") ||
3815 die "unable to write config for VM $vmid\n";
3817 my $cookie = { netcount
=> 0 };
3818 while (defined(my $line = <$fh>)) {
3819 restore_update_config_line
($outfd, $cookie, $vmid, $map, $line, $opts->{unique
});
3828 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
3829 die "interrupted by signal\n";
3831 local $SIG{ALRM
} = sub { die "got timeout\n"; };
3833 $oldtimeout = alarm($timeout);
3840 if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
3841 my ($dev_id, $size, $devname) = ($1, $2, $3);
3842 $devinfo->{$devname} = { size
=> $size, dev_id
=> $dev_id };
3843 } elsif ($line =~ m/^CTIME: /) {
3845 print $fifofh "done\n";
3846 my $tmp = $oldtimeout || 0;
3847 $oldtimeout = undef;
3853 print "restore vma archive: $cmd\n";
3854 run_command
($cmd, input
=> $input, outfunc
=> $parser, afterfork
=> $openfifo);
3858 alarm($oldtimeout) if $oldtimeout;
3866 my $cfg = cfs_read_file
('storage.cfg');
3867 foreach my $devname (keys %$devinfo) {
3868 my $volid = $devinfo->{$devname}->{volid
};
3871 if ($volid =~ m
|^/|) {
3872 unlink $volid || die 'unlink failed\n';
3874 PVE
::Storage
::vdisk_free
($cfg, $volid);
3876 print STDERR
"temporary volume '$volid' sucessfuly removed\n";
3878 print STDERR
"unable to cleanup '$volid' - $@" if $@;
3885 rename($tmpfn, $conffile) ||
3886 die "unable to commit configuration file '$conffile'\n";
3888 PVE
::Cluster
::cfs_update
(); # make sure we read new file
3890 eval { rescan
($vmid, 1); };
3894 sub restore_tar_archive
{
3895 my ($archive, $vmid, $user, $opts) = @_;
3897 if ($archive ne '-') {
3898 my $firstfile = tar_archive_read_firstfile
($archive);
3899 die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
3900 if $firstfile ne 'qemu-server.conf';
3903 my $storecfg = cfs_read_file
('storage.cfg');
3905 # destroy existing data - keep empty config
3906 my $vmcfgfn = PVE
::QemuServer
::config_file
($vmid);
3907 destroy_vm
($storecfg, $vmid, 1) if -f
$vmcfgfn;
3909 my $tocmd = "/usr/lib/qemu-server/qmextract";
3911 $tocmd .= " --storage " . PVE
::Tools
::shellquote
($opts->{storage
}) if $opts->{storage
};
3912 $tocmd .= " --pool " . PVE
::Tools
::shellquote
($opts->{pool
}) if $opts->{pool
};
3913 $tocmd .= ' --prealloc' if $opts->{prealloc
};
3914 $tocmd .= ' --info' if $opts->{info
};
3916 # tar option "xf" does not autodetect compression when read from STDIN,
3917 # so we pipe to zcat
3918 my $cmd = "zcat -f|tar xf " . PVE
::Tools
::shellquote
($archive) . " " .
3919 PVE
::Tools
::shellquote
("--to-command=$tocmd");
3921 my $tmpdir = "/var/tmp/vzdumptmp$$";
3924 local $ENV{VZDUMP_TMPDIR
} = $tmpdir;
3925 local $ENV{VZDUMP_VMID
} = $vmid;
3926 local $ENV{VZDUMP_USER
} = $user;
3928 my $conffile = config_file
($vmid);
3929 my $tmpfn = "$conffile.$$.tmp";
3931 # disable interrupts (always do cleanups)
3932 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = sub {
3933 print STDERR
"got interrupt - ignored\n";
3938 local $SIG{INT
} = $SIG{TERM
} = $SIG{QUIT
} = $SIG{HUP
} = $SIG{PIPE
} = sub {
3939 die "interrupted by signal\n";
3942 if ($archive eq '-') {
3943 print "extracting archive from STDIN\n";
3944 run_command
($cmd, input
=> "<&STDIN");
3946 print "extracting archive '$archive'\n";
3950 return if $opts->{info
};
3954 my $statfile = "$tmpdir/qmrestore.stat";
3955 if (my $fd = IO
::File-
>new($statfile, "r")) {
3956 while (defined (my $line = <$fd>)) {
3957 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3958 $map->{$1} = $2 if $1;
3960 print STDERR
"unable to parse line in statfile - $line\n";
3966 my $confsrc = "$tmpdir/qemu-server.conf";
3968 my $srcfd = new IO
::File
($confsrc, "r") ||
3969 die "unable to open file '$confsrc'\n";
3971 my $outfd = new IO
::File
($tmpfn, "w") ||
3972 die "unable to write config for VM $vmid\n";
3974 my $cookie = { netcount
=> 0 };
3975 while (defined (my $line = <$srcfd>)) {
3976 restore_update_config_line
($outfd, $cookie, $vmid, $map, $line, $opts->{unique
});
3988 tar_restore_cleanup
($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info
};
3995 rename $tmpfn, $conffile ||
3996 die "unable to commit configuration file '$conffile'\n";
3998 PVE
::Cluster
::cfs_update
(); # make sure we read new file
4000 eval { rescan
($vmid, 1); };
4005 # Internal snapshots
4007 # NOTE: Snapshot create/delete involves several non-atomic
4008 # action, and can take a long time.
4009 # So we try to avoid locking the file and use 'lock' variable
4010 # inside the config file instead.
4012 my $snapshot_copy_config = sub {
4013 my ($source, $dest) = @_;
4015 foreach my $k (keys %$source) {
4016 next if $k eq 'snapshots';
4017 next if $k eq 'snapstate';
4018 next if $k eq 'snaptime';
4019 next if $k eq 'vmstate';
4020 next if $k eq 'lock';
4021 next if $k eq 'digest';
4022 next if $k eq 'description';
4023 next if $k =~ m/^unused\d+$/;
4025 $dest->{$k} = $source->{$k};
4029 my $snapshot_apply_config = sub {
4030 my ($conf, $snap) = @_;
4032 # copy snapshot list
4034 snapshots
=> $conf->{snapshots
},
4037 # keep description and list of unused disks
4038 foreach my $k (keys %$conf) {
4039 next if !($k =~ m/^unused\d+$/ || $k eq 'description');
4040 $newconf->{$k} = $conf->{$k};
4043 &$snapshot_copy_config($snap, $newconf);
4048 sub foreach_writable_storage
{
4049 my ($conf, $func) = @_;
4053 foreach my $ds (keys %$conf) {
4054 next if !valid_drivename
($ds);
4056 my $drive = parse_drive
($ds, $conf->{$ds});
4058 next if drive_is_cdrom
($drive);
4060 my $volid = $drive->{file
};
4062 my ($sid, $volname) = PVE
::Storage
::parse_volume_id
($volid, 1);
4063 $sidhash->{$sid} = $sid if $sid;
4066 foreach my $sid (sort keys %$sidhash) {
4071 my $alloc_vmstate_volid = sub {
4072 my ($storecfg, $vmid, $conf, $snapname) = @_;
4074 # Note: we try to be smart when selecting a $target storage
4078 # search shared storage first
4079 foreach_writable_storage
($conf, sub {
4081 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
4082 return if !$scfg->{shared
};
4084 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage
4088 # now search local storage
4089 foreach_writable_storage
($conf, sub {
4091 my $scfg = PVE
::Storage
::storage_config
($storecfg, $sid);
4092 return if $scfg->{shared
};
4094 $target = $sid if !$target || $scfg->{path
}; # prefer file based storage;
4098 $target = 'local' if !$target;
4100 my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
4101 # we abort live save after $conf->{memory}, so we need at max twice that space
4102 my $size = $conf->{memory
}*2 + $driver_state_size;
4104 my $name = "vm-$vmid-state-$snapname";
4105 my $scfg = PVE
::Storage
::storage_config
($storecfg, $target);
4106 $name .= ".raw" if $scfg->{path
}; # add filename extension for file base storage
4107 my $volid = PVE
::Storage
::vdisk_alloc
($storecfg, $target, $vmid, 'raw', $name, $size*1024);
4112 my $snapshot_prepare = sub {
4113 my ($vmid, $snapname, $save_vmstate, $comment) = @_;
4117 my $updatefn = sub {
4119 my $conf = load_config
($vmid);
4121 die "you can't take a snapshot if it's a template\n"
4122 if is_template
($conf);
4126 $conf->{lock} = 'snapshot';
4128 die "snapshot name '$snapname' already used\n"
4129 if defined($conf->{snapshots
}->{$snapname});
4131 my $storecfg = PVE
::Storage
::config
();
4132 die "snapshot feature is not available" if !has_feature
('snapshot', $conf, $storecfg);
4134 $snap = $conf->{snapshots
}->{$snapname} = {};
4136 if ($save_vmstate && check_running
($vmid)) {
4137 $snap->{vmstate
} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
4140 &$snapshot_copy_config($conf, $snap);
4142 $snap->{snapstate
} = "prepare";
4143 $snap->{snaptime
} = time();
4144 $snap->{description
} = $comment if $comment;
4146 update_config_nolock
($vmid, $conf, 1);
4149 lock_config
($vmid, $updatefn);
4154 my $snapshot_commit = sub {
4155 my ($vmid, $snapname) = @_;
4157 my $updatefn = sub {
4159 my $conf = load_config
($vmid);
4161 die "missing snapshot lock\n"
4162 if !($conf->{lock} && $conf->{lock} eq 'snapshot');
4164 my $snap = $conf->{snapshots
}->{$snapname};
4166 die "snapshot '$snapname' does not exist\n" if !defined($snap);
4168 die "wrong snapshot state\n"
4169 if !($snap->{snapstate
} && $snap->{snapstate
} eq "prepare");
4171 delete $snap->{snapstate
};
4172 delete $conf->{lock};
4174 my $newconf = &$snapshot_apply_config($conf, $snap);
4176 $newconf->{parent
} = $snapname;
4178 update_config_nolock
($vmid, $newconf, 1);
4181 lock_config
($vmid, $updatefn);
4184 sub snapshot_rollback
{
4185 my ($vmid, $snapname) = @_;
4191 my $storecfg = PVE
::Storage
::config
();
4193 my $updatefn = sub {
4195 my $conf = load_config
($vmid);
4197 die "you can't rollback if vm is a template\n" if is_template
($conf);
4199 $snap = $conf->{snapshots
}->{$snapname};
4201 die "snapshot '$snapname' does not exist\n" if !defined($snap);
4203 die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
4204 if $snap->{snapstate
};
4208 vm_stop
($storecfg, $vmid, undef, undef, 5, undef, undef);
4211 die "unable to rollback vm $vmid: vm is running\n"
4212 if check_running
($vmid);
4215 $conf->{lock} = 'rollback';
4217 die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
4218 delete $conf->{lock};
4222 # copy snapshot config to current config
4223 $conf = &$snapshot_apply_config($conf, $snap);
4224 $conf->{parent
} = $snapname;
4227 update_config_nolock
($vmid, $conf, 1);
4229 if (!$prepare && $snap->{vmstate
}) {
4230 my $statefile = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
4231 vm_start
($storecfg, $vmid, $statefile);
4235 lock_config
($vmid, $updatefn);
4237 foreach_drive
($snap, sub {
4238 my ($ds, $drive) = @_;
4240 return if drive_is_cdrom
($drive);
4242 my $volid = $drive->{file
};
4243 my $device = "drive-$ds";
4245 PVE
::Storage
::volume_snapshot_rollback
($storecfg, $volid, $snapname);
4249 lock_config
($vmid, $updatefn);
4252 my $savevm_wait = sub {
4256 my $stat = vm_mon_cmd_nocheck
($vmid, "query-savevm");
4257 if (!$stat->{status
}) {
4258 die "savevm not active\n";
4259 } elsif ($stat->{status
} eq 'active') {
4262 } elsif ($stat->{status
} eq 'completed') {
4265 die "query-savevm returned status '$stat->{status}'\n";
4270 sub snapshot_create
{
4271 my ($vmid, $snapname, $save_vmstate, $freezefs, $comment) = @_;
4273 my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
4275 $freezefs = $save_vmstate = 0 if !$snap->{vmstate
}; # vm is not running
4279 my $running = check_running
($vmid);
4282 # create internal snapshots of all drives
4284 my $storecfg = PVE
::Storage
::config
();
4287 if ($snap->{vmstate
}) {
4288 my $path = PVE
::Storage
::path
($storecfg, $snap->{vmstate
});
4289 vm_mon_cmd
($vmid, "savevm-start", statefile
=> $path);
4290 &$savevm_wait($vmid);
4292 vm_mon_cmd
($vmid, "savevm-start");
4296 qga_freezefs
($vmid) if $running && $freezefs;
4298 foreach_drive
($snap, sub {
4299 my ($ds, $drive) = @_;
4301 return if drive_is_cdrom
($drive);
4303 my $volid = $drive->{file
};
4304 my $device = "drive-$ds";
4306 qemu_volume_snapshot
($vmid, $device, $storecfg, $volid, $snapname);
4307 $drivehash->{$ds} = 1;
4312 eval { gqa_unfreezefs
($vmid) if $running && $freezefs; };
4315 eval { vm_mon_cmd
($vmid, "savevm-end") if $running; };
4319 warn "snapshot create failed: starting cleanup\n";
4320 eval { snapshot_delete
($vmid, $snapname, 0, $drivehash); };
4325 &$snapshot_commit($vmid, $snapname);
4328 # Note: $drivehash is only set when called from snapshot_create.
4329 sub snapshot_delete
{
4330 my ($vmid, $snapname, $force, $drivehash) = @_;
4337 my $unlink_parent = sub {
4338 my ($confref, $new_parent) = @_;
4340 if ($confref->{parent
} && $confref->{parent
} eq $snapname) {
4342 $confref->{parent
} = $new_parent;
4344 delete $confref->{parent
};
4349 my $updatefn = sub {
4350 my ($remove_drive) = @_;
4352 my $conf = load_config
($vmid);
4356 die "you can't delete a snapshot if vm is a template\n"
4357 if is_template
($conf);
4360 $snap = $conf->{snapshots
}->{$snapname};
4362 die "snapshot '$snapname' does not exist\n" if !defined($snap);
4364 # remove parent refs
4365 &$unlink_parent($conf, $snap->{parent
});
4366 foreach my $sn (keys %{$conf->{snapshots
}}) {
4367 next if $sn eq $snapname;
4368 &$unlink_parent($conf->{snapshots
}->{$sn}, $snap->{parent
});
4371 if ($remove_drive) {
4372 if ($remove_drive eq 'vmstate') {
4373 delete $snap->{$remove_drive};
4375 my $drive = parse_drive
($remove_drive, $snap->{$remove_drive});
4376 my $volid = $drive->{file
};
4377 delete $snap->{$remove_drive};
4378 add_unused_volume
($conf, $volid);
4383 $snap->{snapstate
} = 'delete';
4385 delete $conf->{snapshots
}->{$snapname};
4386 delete $conf->{lock} if $drivehash;
4387 foreach my $volid (@$unused) {
4388 add_unused_volume
($conf, $volid);
4392 update_config_nolock
($vmid, $conf, 1);
4395 lock_config
($vmid, $updatefn);
4397 # now remove vmstate file
4399 my $storecfg = PVE
::Storage
::config
();
4401 if ($snap->{vmstate
}) {
4402 eval { PVE
::Storage
::vdisk_free
($storecfg, $snap->{vmstate
}); };
4404 die $err if !$force;
4407 # save changes (remove vmstate from snapshot)
4408 lock_config
($vmid, $updatefn, 'vmstate') if !$force;
4411 # now remove all internal snapshots
4412 foreach_drive
($snap, sub {
4413 my ($ds, $drive) = @_;
4415 return if drive_is_cdrom
($drive);
4417 my $volid = $drive->{file
};
4418 my $device = "drive-$ds";
4420 if (!$drivehash || $drivehash->{$ds}) {
4421 eval { qemu_volume_snapshot_delete
($vmid, $device, $storecfg, $volid, $snapname); };
4423 die $err if !$force;
4428 # save changes (remove drive fron snapshot)
4429 lock_config
($vmid, $updatefn, $ds) if !$force;
4430 push @$unused, $volid;
4433 # now cleanup config
4435 lock_config
($vmid, $updatefn);
4439 my ($feature, $conf, $storecfg, $snapname, $running) = @_;
4442 foreach_drive
($conf, sub {
4443 my ($ds, $drive) = @_;
4445 return if drive_is_cdrom
($drive);
4446 my $volid = $drive->{file
};
4447 $err = 1 if !PVE
::Storage
::volume_has_feature
($storecfg, $feature, $volid, $snapname, $running);
4453 sub template_create
{
4454 my ($vmid, $conf, $disk) = @_;
4456 my $storecfg = PVE
::Storage
::config
();
4458 foreach_drive
($conf, sub {
4459 my ($ds, $drive) = @_;
4461 return if drive_is_cdrom
($drive);
4462 return if $disk && $ds ne $disk;
4464 my $volid = $drive->{file
};
4465 return if !PVE
::Storage
::volume_has_feature
($storecfg, 'template', $volid);
4467 my $voliddst = PVE
::Storage
::vdisk_create_base
($storecfg, $volid);
4468 $drive->{file
} = $voliddst;
4469 $conf->{$ds} = PVE
::QemuServer
::print_drive
($vmid, $drive);
4470 PVE
::QemuServer
::update_config_nolock
($vmid, $conf, 1);
4477 return 1 if defined $conf->{template
} && $conf->{template
} == 1;