PVE/QemuServer.pm

   1 package PVE::QemuServer;
   2
   3 use strict;
   4 use warnings;
   5 use POSIX;
   6 use IO::Handle;
   7 use IO::Select;
   8 use IO::File;
   9 use IO::Dir;
  10 use IO::Socket::UNIX;
  11 use File::Basename;
  12 use File::Path;
  13 use File::stat;
  14 use Getopt::Long;
  15 use Digest::SHA;
  16 use Fcntl ':flock';
  17 use Cwd 'abs_path';
  18 use IPC::Open3;
  19 use JSON;
  20 use Fcntl;
  21 use PVE::SafeSyslog;
  22 use Storable qw(dclone);
  23 use PVE::Exception qw(raise raise_param_exc);
  24 use PVE::Storage;
  25 use PVE::Tools qw(run_command lock_file lock_file_full file_read_firstline dir_glob_foreach);
  26 use PVE::JSONSchema qw(get_standard_option);
  27 use PVE::Cluster qw(cfs_register_file cfs_read_file cfs_write_file cfs_lock_file);
  28 use PVE::INotify;
  29 use PVE::ProcFSTools;
  30 use PVE::QMPClient;
  31 use PVE::RPCEnvironment;
  32 use Time::HiRes qw(gettimeofday);
  33
  34 my $cpuinfo = PVE::ProcFSTools::read_cpuinfo();
  35
  36 # Note about locking: we use flock on the config file protect
  37 # against concurent actions.
  38 # Aditionaly, we have a 'lock' setting in the config file. This
  39 # can be set to 'migrate', 'backup', 'snapshot' or 'rollback'. Most actions are not
  40 # allowed when such lock is set. But you can ignore this kind of
  41 # lock with the --skiplock flag.
  42
  43 cfs_register_file('/qemu-server/',
  44                   \&parse_vm_config,
  45                   \&write_vm_config);
  46
  47 PVE::JSONSchema::register_standard_option('skiplock', {
  48     description => "Ignore locks - only root is allowed to use this option.",
  49     type => 'boolean',
  50     optional => 1,
  51 });
  52
  53 PVE::JSONSchema::register_standard_option('pve-qm-stateuri', {
  54     description => "Some command save/restore state from this location.",
  55     type => 'string',
  56     maxLength => 128,
  57     optional => 1,
  58 });
  59
  60 PVE::JSONSchema::register_standard_option('pve-snapshot-name', {
  61     description => "The name of the snapshot.",
  62     type => 'string', format => 'pve-configid',
  63     maxLength => 40,
  64 });
  65
  66 #no warnings 'redefine';
  67
  68 unless(defined(&_VZSYSCALLS_H_)) {
  69     eval 'sub _VZSYSCALLS_H_ () {1;}' unless defined(&_VZSYSCALLS_H_);
  70     require 'sys/syscall.ph';
  71     if(defined(&__x86_64__)) {
  72         eval 'sub __NR_fairsched_vcpus () {499;}' unless defined(&__NR_fairsched_vcpus);
  73         eval 'sub __NR_fairsched_mknod () {504;}' unless defined(&__NR_fairsched_mknod);
  74         eval 'sub __NR_fairsched_rmnod () {505;}' unless defined(&__NR_fairsched_rmnod);
  75         eval 'sub __NR_fairsched_chwt () {506;}' unless defined(&__NR_fairsched_chwt);
  76         eval 'sub __NR_fairsched_mvpr () {507;}' unless defined(&__NR_fairsched_mvpr);
  77         eval 'sub __NR_fairsched_rate () {508;}' unless defined(&__NR_fairsched_rate);
  78         eval 'sub __NR_setluid () {501;}' unless defined(&__NR_setluid);
  79         eval 'sub __NR_setublimit () {502;}' unless defined(&__NR_setublimit);
  80     }
  81     elsif(defined( &__i386__) ) {
  82         eval 'sub __NR_fairsched_mknod () {500;}' unless defined(&__NR_fairsched_mknod);
  83         eval 'sub __NR_fairsched_rmnod () {501;}' unless defined(&__NR_fairsched_rmnod);
  84         eval 'sub __NR_fairsched_chwt () {502;}' unless defined(&__NR_fairsched_chwt);
  85         eval 'sub __NR_fairsched_mvpr () {503;}' unless defined(&__NR_fairsched_mvpr);
  86         eval 'sub __NR_fairsched_rate () {504;}' unless defined(&__NR_fairsched_rate);
  87         eval 'sub __NR_fairsched_vcpus () {505;}' unless defined(&__NR_fairsched_vcpus);
  88         eval 'sub __NR_setluid () {511;}' unless defined(&__NR_setluid);
  89         eval 'sub __NR_setublimit () {512;}' unless defined(&__NR_setublimit);
  90     } else {
  91         die("no fairsched syscall for this arch");
  92     }
  93     require 'asm/ioctl.ph';
  94     eval 'sub KVM_GET_API_VERSION () { &_IO(0xAE, 0x);}' unless defined(&KVM_GET_API_VERSION);
  95 }
  96
  97 sub fairsched_mknod {
  98     my ($parent, $weight, $desired) = @_;
  99
 100     return syscall(&__NR_fairsched_mknod, int($parent), int($weight), int($desired));
 101 }
 102
 103 sub fairsched_rmnod {
 104     my ($id) = @_;
 105
 106     return syscall(&__NR_fairsched_rmnod, int($id));
 107 }
 108
 109 sub fairsched_mvpr {
 110     my ($pid, $newid) = @_;
 111
 112     return syscall(&__NR_fairsched_mvpr, int($pid), int($newid));
 113 }
 114
 115 sub fairsched_vcpus {
 116     my ($id, $vcpus) = @_;
 117
 118     return syscall(&__NR_fairsched_vcpus, int($id), int($vcpus));
 119 }
 120
 121 sub fairsched_rate {
 122     my ($id, $op, $rate) = @_;
 123
 124     return syscall(&__NR_fairsched_rate, int($id), int($op), int($rate));
 125 }
 126
 127 use constant FAIRSCHED_SET_RATE  => 0;
 128 use constant FAIRSCHED_DROP_RATE => 1;
 129 use constant FAIRSCHED_GET_RATE  => 2;
 130
 131 sub fairsched_cpulimit {
 132     my ($id, $limit) = @_;
 133
 134     my $cpulim1024 = int($limit * 1024 / 100);
 135     my $op = $cpulim1024 ? FAIRSCHED_SET_RATE : FAIRSCHED_DROP_RATE;
 136
 137     return fairsched_rate($id, $op, $cpulim1024);
 138 }
 139
 140 my $nodename = PVE::INotify::nodename();
 141
 142 mkdir "/etc/pve/nodes/$nodename";
 143 my $confdir = "/etc/pve/nodes/$nodename/qemu-server";
 144 mkdir $confdir;
 145
 146 my $var_run_tmpdir = "/var/run/qemu-server";
 147 mkdir $var_run_tmpdir;
 148
 149 my $lock_dir = "/var/lock/qemu-server";
 150 mkdir $lock_dir;
 151
 152 my $pcisysfs = "/sys/bus/pci";
 153
 154 my $confdesc = {
 155     iothread => {
 156         optional => 1,
 157         type => 'boolean',
 158         description => "Enable iothread dataplane.",
 159         default => 0,
 160     },
 161     onboot => {
 162         optional => 1,
 163         type => 'boolean',
 164         description => "Specifies whether a VM will be started during system bootup.",
 165         default => 0,
 166     },
 167     autostart => {
 168         optional => 1,
 169         type => 'boolean',
 170         description => "Automatic restart after crash (currently ignored).",
 171         default => 0,
 172     },
 173     hotplug => {
 174         optional => 1,
 175         type => 'string', format => 'pve-hotplug-features',
 176         description => "Selectively enable hotplug features. This is a comma separated list of hotplug features: 'network', 'disk', 'cpu', 'memory' and 'usb'. Use '0' to disable hotplug completely. Value '1' is an alias for the default 'network,disk,usb'.",
 177         default => 'network,disk,usb',
 178     },
 179     reboot => {
 180         optional => 1,
 181         type => 'boolean',
 182         description => "Allow reboot. If set to '0' the VM exit on reboot.",
 183         default => 1,
 184     },
 185     lock => {
 186         optional => 1,
 187         type => 'string',
 188         description => "Lock/unlock the VM.",
 189         enum => [qw(migrate backup snapshot rollback)],
 190     },
 191     cpulimit => {
 192         optional => 1,
 193         type => 'integer',
 194         description => "Limit of CPU usage in per cent. Note if the computer has 2 CPUs, it has total of 200% CPU time. Value '0' indicates no CPU limit.\n\nNOTE: This option is currently ignored.",
 195         minimum => 0,
 196         default => 0,
 197     },
 198     cpuunits => {
 199         optional => 1,
 200         type => 'integer',
 201         description => "CPU weight for a VM. Argument is used in the kernel fair scheduler. The larger the number is, the more CPU time this VM gets. Number is relative to weights of all the other running VMs.\n\nNOTE: You can disable fair-scheduler configuration by setting this to 0.",
 202         minimum => 0,
 203         maximum => 500000,
 204         default => 1000,
 205     },
 206     memory => {
 207         optional => 1,
 208         type => 'integer',
 209         description => "Amount of RAM for the VM in MB. This is the maximum available memory when you use the balloon device.",
 210         minimum => 16,
 211         default => 512,
 212     },
 213     balloon => {
 214         optional => 1,
 215         type => 'integer',
 216         description => "Amount of target RAM for the VM in MB. Using zero disables the ballon driver.",
 217         minimum => 0,
 218     },
 219     shares => {
 220         optional => 1,
 221         type => 'integer',
 222         description => "Amount of memory shares for auto-ballooning. The larger the number is, the more memory this VM gets. Number is relative to weights of all other running VMs. Using zero disables auto-ballooning",
 223         minimum => 0,
 224         maximum => 50000,
 225         default => 1000,
 226     },
 227     keyboard => {
 228         optional => 1,
 229         type => 'string',
 230         description => "Keybord layout for vnc server. Default is read from the datacenter configuration file.",
 231         enum => PVE::Tools::kvmkeymaplist(),
 232         default => 'en-us',
 233     },
 234     name => {
 235         optional => 1,
 236         type => 'string', format => 'dns-name',
 237         description => "Set a name for the VM. Only used on the configuration web interface.",
 238     },
 239     scsihw => {
 240         optional => 1,
 241         type => 'string',
 242         description => "scsi controller model",
 243         enum => [qw(lsi lsi53c810 virtio-scsi-pci megasas pvscsi)],
 244         default => 'lsi',
 245     },
 246     description => {
 247         optional => 1,
 248         type => 'string',
 249         description => "Description for the VM. Only used on the configuration web interface. This is saved as comment inside the configuration file.",
 250     },
 251     ostype => {
 252         optional => 1,
 253         type => 'string',
 254         enum => [qw(other wxp w2k w2k3 w2k8 wvista win7 win8 l24 l26 solaris)],
 255         description => <<EODESC,
 256 Used to enable special optimization/features for specific
 257 operating systems:
 258
 259 other  => unspecified OS
 260 wxp    => Microsoft Windows XP
 261 w2k    => Microsoft Windows 2000
 262 w2k3   => Microsoft Windows 2003
 263 w2k8   => Microsoft Windows 2008
 264 wvista => Microsoft Windows Vista
 265 win7   => Microsoft Windows 7
 266 win8   => Microsoft Windows 8/2012
 267 l24    => Linux 2.4 Kernel
 268 l26    => Linux 2.6/3.X Kernel
 269 solaris => solaris/opensolaris/openindiania kernel
 270
 271 other|l24|l26|solaris                       ... no special behaviour
 272 wxp|w2k|w2k3|w2k8|wvista|win7|win8  ... use --localtime switch
 273 EODESC
 274     },
 275     boot => {
 276         optional => 1,
 277         type => 'string',
 278         description => "Boot on floppy (a), hard disk (c), CD-ROM (d), or network (n).",
 279         pattern => '[acdn]{1,4}',
 280         default => 'cdn',
 281     },
 282     bootdisk => {
 283         optional => 1,
 284         type => 'string', format => 'pve-qm-bootdisk',
 285         description => "Enable booting from specified disk.",
 286         pattern => '(ide|sata|scsi|virtio)\d+',
 287     },
 288     smp => {
 289         optional => 1,
 290         type => 'integer',
 291         description => "The number of CPUs. Please use option -sockets instead.",
 292         minimum => 1,
 293         default => 1,
 294     },
 295     sockets => {
 296         optional => 1,
 297         type => 'integer',
 298         description => "The number of CPU sockets.",
 299         minimum => 1,
 300         default => 1,
 301     },
 302     cores => {
 303         optional => 1,
 304         type => 'integer',
 305         description => "The number of cores per socket.",
 306         minimum => 1,
 307         default => 1,
 308     },
 309     numa => {
 310         optional => 1,
 311         type => 'boolean',
 312         description => "Enable/disable Numa.",
 313         default => 0,
 314     },
 315     vcpus => {
 316         optional => 1,
 317         type => 'integer',
 318         description => "Number of hotplugged vcpus.",
 319         minimum => 1,
 320         default => 0,
 321     },
 322     acpi => {
 323         optional => 1,
 324         type => 'boolean',
 325         description => "Enable/disable ACPI.",
 326         default => 1,
 327     },
 328     agent => {
 329         optional => 1,
 330         type => 'boolean',
 331         description => "Enable/disable Qemu GuestAgent.",
 332         default => 0,
 333     },
 334     kvm => {
 335         optional => 1,
 336         type => 'boolean',
 337         description => "Enable/disable KVM hardware virtualization.",
 338         default => 1,
 339     },
 340     tdf => {
 341         optional => 1,
 342         type => 'boolean',
 343         description => "Enable/disable time drift fix.",
 344         default => 0,
 345     },
 346     localtime => {
 347         optional => 1,
 348         type => 'boolean',
 349         description => "Set the real time clock to local time. This is enabled by default if ostype indicates a Microsoft OS.",
 350     },
 351     freeze => {
 352         optional => 1,
 353         type => 'boolean',
 354         description => "Freeze CPU at startup (use 'c' monitor command to start execution).",
 355     },
 356     vga => {
 357         optional => 1,
 358         type => 'string',
 359         description => "Select VGA type. If you want to use high resolution modes (>= 1280x1024x16) then you should use option 'std' or 'vmware'. Default is 'std' for win8/win7/w2k8, and 'cirrur' for other OS types. Option 'qxl' enables the SPICE display sever. You can also run without any graphic card using a serial devive as terminal.",
 360         enum => [qw(std cirrus vmware qxl serial0 serial1 serial2 serial3 qxl2 qxl3 qxl4)],
 361     },
 362     watchdog => {
 363         optional => 1,
 364         type => 'string', format => 'pve-qm-watchdog',
 365         typetext => '[[model=]i6300esb|ib700] [,[action=]reset|shutdown|poweroff|pause|debug|none]',
 366         description => "Create a virtual hardware watchdog device.  Once enabled (by a guest action), the watchdog must be periodically polled by an agent inside the guest or else the guest will be restarted (or execute the action specified)",
 367     },
 368     startdate => {
 369         optional => 1,
 370         type => 'string',
 371         typetext => "(now | YYYY-MM-DD | YYYY-MM-DDTHH:MM:SS)",
 372         description => "Set the initial date of the real time clock. Valid format for date are: 'now' or '2006-06-17T16:01:21' or '2006-06-17'.",
 373         pattern => '(now|\d{4}-\d{1,2}-\d{1,2}(T\d{1,2}:\d{1,2}:\d{1,2})?)',
 374         default => 'now',
 375     },
 376     startup => {
 377         optional => 1,
 378         type => 'string', format => 'pve-qm-startup',
 379         typetext => '[[order=]\d+] [,up=\d+] [,down=\d+] ',
 380         description => "Startup and shutdown behavior. Order is a non-negative number defining the general startup order. Shutdown in done with reverse ordering. Additionally you can set the 'up' or 'down' delay in seconds, which specifies a delay to wait before the next VM is started or stopped.",
 381     },
 382     template => {
 383         optional => 1,
 384         type => 'boolean',
 385         description => "Enable/disable Template.",
 386         default => 0,
 387     },
 388     args => {
 389         optional => 1,
 390         type => 'string',
 391         description => <<EODESCR,
 392 Note: this option is for experts only. It allows you to pass arbitrary arguments to kvm, for example:
 393
 394 args: -no-reboot -no-hpet
 395 EODESCR
 396     },
 397     tablet => {
 398         optional => 1,
 399         type => 'boolean',
 400         default => 1,
 401         description => "Enable/disable the usb tablet device. This device is usually needed to allow absolute mouse positioning with VNC. Else the mouse runs out of sync with normal VNC clients. If you're running lots of console-only guests on one host, you may consider disabling this to save some context switches. This is turned of by default if you use spice (vga=qxl).",
 402     },
 403     migrate_speed => {
 404         optional => 1,
 405         type => 'integer',
 406         description => "Set maximum speed (in MB/s) for migrations. Value 0 is no limit.",
 407         minimum => 0,
 408         default => 0,
 409     },
 410     migrate_downtime => {
 411         optional => 1,
 412         type => 'number',
 413         description => "Set maximum tolerated downtime (in seconds) for migrations.",
 414         minimum => 0,
 415         default => 0.1,
 416     },
 417     cdrom => {
 418         optional => 1,
 419         type => 'string', format => 'pve-qm-drive',
 420         typetext => 'volume',
 421         description => "This is an alias for option -ide2",
 422     },
 423     cpu => {
 424         optional => 1,
 425         description => "Emulated CPU type.",
 426         type => 'string',
 427         enum => [ qw(486 athlon pentium pentium2 pentium3 coreduo core2duo kvm32 kvm64 qemu32 qemu64 phenom Conroe Penryn Nehalem Westmere SandyBridge Haswell Broadwell Opteron_G1 Opteron_G2 Opteron_G3 Opteron_G4 Opteron_G5 host) ],
 428         default => 'kvm64',
 429     },
 430     parent => get_standard_option('pve-snapshot-name', {
 431         optional => 1,
 432         description => "Parent snapshot name. This is used internally, and should not be modified.",
 433     }),
 434     snaptime => {
 435         optional => 1,
 436         description => "Timestamp for snapshots.",
 437         type => 'integer',
 438         minimum => 0,
 439     },
 440     vmstate => {
 441         optional => 1,
 442         type => 'string', format => 'pve-volume-id',
 443         description => "Reference to a volume which stores the VM state. This is used internally for snapshots.",
 444     },
 445     machine => {
 446         description => "Specific the Qemu machine type.",
 447         type => 'string',
 448         pattern => '(pc|pc(-i440fx)?-\d+\.\d+|q35|pc-q35-\d+\.\d+)',
 449         maxLength => 40,
 450         optional => 1,
 451     },
 452     smbios1 => {
 453         description => "Specify SMBIOS type 1 fields.",
 454         type => 'string', format => 'pve-qm-smbios1',
 455         typetext => "[manufacturer=str][,product=str][,version=str][,serial=str] [,uuid=uuid][,sku=str][,family=str]",
 456         maxLength => 256,
 457         optional => 1,
 458     },
 459 };
 460
 461 # what about other qemu settings ?
 462 #cpu => 'string',
 463 #machine => 'string',
 464 #fda => 'file',
 465 #fdb => 'file',
 466 #mtdblock => 'file',
 467 #sd => 'file',
 468 #pflash => 'file',
 469 #snapshot => 'bool',
 470 #bootp => 'file',
 471 ##tftp => 'dir',
 472 ##smb => 'dir',
 473 #kernel => 'file',
 474 #append => 'string',
 475 #initrd => 'file',
 476 ##soundhw => 'string',
 477
 478 while (my ($k, $v) = each %$confdesc) {
 479     PVE::JSONSchema::register_standard_option("pve-qm-$k", $v);
 480 }
 481
 482 my $MAX_IDE_DISKS = 4;
 483 my $MAX_SCSI_DISKS = 14;
 484 my $MAX_VIRTIO_DISKS = 16;
 485 my $MAX_SATA_DISKS = 6;
 486 my $MAX_USB_DEVICES = 5;
 487 my $MAX_NETS = 32;
 488 my $MAX_UNUSED_DISKS = 8;
 489 my $MAX_HOSTPCI_DEVICES = 4;
 490 my $MAX_SERIAL_PORTS = 4;
 491 my $MAX_PARALLEL_PORTS = 3;
 492 my $MAX_NUMA = 8;
 493 my $MAX_MEM = 4194304;
 494 my $STATICMEM = 1024;
 495
 496 my $numadesc = {
 497     optional => 1,
 498     type => 'string', format => 'pve-qm-numanode',
 499     typetext => "cpus=<id[-id],memory=<mb>[[,hostnodes=<id[-id]>] [,policy=<preferred|bind|interleave>]]",
 500     description => "numa topology",
 501 };
 502 PVE::JSONSchema::register_standard_option("pve-qm-numanode", $numadesc);
 503
 504 for (my $i = 0; $i < $MAX_NUMA; $i++)  {
 505     $confdesc->{"numa$i"} = $numadesc;
 506 }
 507
 508 my $nic_model_list = ['rtl8139', 'ne2k_pci', 'e1000',  'pcnet',  'virtio',
 509                       'ne2k_isa', 'i82551', 'i82557b', 'i82559er', 'vmxnet3',
 510                       'e1000-82540em', 'e1000-82544gc', 'e1000-82545em'];
 511 my $nic_model_list_txt = join(' ', sort @$nic_model_list);
 512
 513 my $netdesc = {
 514     optional => 1,
 515     type => 'string', format => 'pve-qm-net',
 516     typetext => "MODEL=XX:XX:XX:XX:XX:XX [,bridge=<dev>][,queues=<nbqueues>][,rate=<mbps>] [,tag=<vlanid>][,firewall=0|1],link_down=0|1]",
 517     description => <<EODESCR,
 518 Specify network devices.
 519
 520 MODEL is one of: $nic_model_list_txt
 521
 522 XX:XX:XX:XX:XX:XX should be an unique MAC address. This is
 523 automatically generated if not specified.
 524
 525 The bridge parameter can be used to automatically add the interface to a bridge device. The Proxmox VE standard bridge is called 'vmbr0'.
 526
 527 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'.
 528
 529 If you specify no bridge, we create a kvm 'user' (NATed) network device, which provides DHCP and DNS services. The following addresses are used:
 530
 531 10.0.2.2   Gateway
 532 10.0.2.3   DNS Server
 533 10.0.2.4   SMB Server
 534
 535 The DHCP server assign addresses to the guest starting from 10.0.2.15.
 536
 537 EODESCR
 538 };
 539 PVE::JSONSchema::register_standard_option("pve-qm-net", $netdesc);
 540
 541 for (my $i = 0; $i < $MAX_NETS; $i++)  {
 542     $confdesc->{"net$i"} = $netdesc;
 543 }
 544
 545 my $drivename_hash;
 546
 547 my $idedesc = {
 548     optional => 1,
 549     type => 'string', format => 'pve-qm-drive',
 550     typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe|directsync] [,format=f] [,backup=yes|no] [,rerror=ignore|report|stop] [,werror=enospc|ignore|report|stop] [,aio=native|threads] [,discard=ignore|on]',
 551     description => "Use volume as IDE hard disk or CD-ROM (n is 0 to " .($MAX_IDE_DISKS -1) . ").",
 552 };
 553 PVE::JSONSchema::register_standard_option("pve-qm-ide", $idedesc);
 554
 555 my $scsidesc = {
 556     optional => 1,
 557     type => 'string', format => 'pve-qm-drive',
 558     typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe|directsync] [,format=f] [,backup=yes|no] [,rerror=ignore|report|stop] [,werror=enospc|ignore|report|stop] [,aio=native|threads] [,discard=ignore|on]',
 559     description => "Use volume as SCSI hard disk or CD-ROM (n is 0 to " . ($MAX_SCSI_DISKS - 1) . ").",
 560 };
 561 PVE::JSONSchema::register_standard_option("pve-qm-scsi", $scsidesc);
 562
 563 my $satadesc = {
 564     optional => 1,
 565     type => 'string', format => 'pve-qm-drive',
 566     typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe|directsync] [,format=f] [,backup=yes|no] [,rerror=ignore|report|stop] [,werror=enospc|ignore|report|stop] [,aio=native|threads]  [,discard=ignore|on]',
 567     description => "Use volume as SATA hard disk or CD-ROM (n is 0 to " . ($MAX_SATA_DISKS - 1). ").",
 568 };
 569 PVE::JSONSchema::register_standard_option("pve-qm-sata", $satadesc);
 570
 571 my $virtiodesc = {
 572     optional => 1,
 573     type => 'string', format => 'pve-qm-drive',
 574     typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe|directsync] [,format=f] [,backup=yes|no] [,rerror=ignore|report|stop] [,werror=enospc|ignore|report|stop] [,aio=native|threads]  [,discard=ignore|on]',
 575     description => "Use volume as VIRTIO hard disk (n is 0 to " . ($MAX_VIRTIO_DISKS - 1) . ").",
 576 };
 577 PVE::JSONSchema::register_standard_option("pve-qm-virtio", $virtiodesc);
 578
 579 my $usbdesc = {
 580     optional => 1,
 581     type => 'string', format => 'pve-qm-usb-device',
 582     typetext => 'host=HOSTUSBDEVICE|spice',
 583     description => <<EODESCR,
 584 Configure an USB device (n is 0 to 4). This can be used to
 585 pass-through usb devices to the guest. HOSTUSBDEVICE syntax is:
 586
 587 'bus-port(.port)*' (decimal numbers) or
 588 'vendor_id:product_id' (hexadeciaml numbers)
 589
 590 You can use the 'lsusb -t' command to list existing usb devices.
 591
 592 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 593
 594 The value 'spice' can be used to add a usb redirection devices for spice.
 595
 596 EODESCR
 597 };
 598 PVE::JSONSchema::register_standard_option("pve-qm-usb", $usbdesc);
 599
 600 my $hostpcidesc = {
 601         optional => 1,
 602         type => 'string', format => 'pve-qm-hostpci',
 603         typetext => "[host=]HOSTPCIDEVICE [,driver=kvm|vfio] [,rombar=on|off] [,pcie=0|1] [,x-vga=on|off]",
 604         description => <<EODESCR,
 605 Map host pci devices. HOSTPCIDEVICE syntax is:
 606
 607 'bus:dev.func' (hexadecimal numbers)
 608
 609 You can us the 'lspci' command to list existing pci devices.
 610
 611 The 'rombar' option determines whether or not the device's ROM will be visible in the guest's memory map (default is 'on').
 612
 613 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 614
 615 Experimental: user reported problems with this option.
 616 EODESCR
 617 };
 618 PVE::JSONSchema::register_standard_option("pve-qm-hostpci", $hostpcidesc);
 619
 620 my $serialdesc = {
 621         optional => 1,
 622         type => 'string',
 623         pattern => '(/dev/.+|socket)',
 624         description =>  <<EODESCR,
 625 Create a serial device inside the VM (n is 0 to 3), and pass through a host serial device (i.e. /dev/ttyS0), or create a unix socket on the host side (use 'qm terminal' to open a terminal connection).
 626
 627 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 628
 629 Experimental: user reported problems with this option.
 630 EODESCR
 631 };
 632
 633 my $paralleldesc= {
 634         optional => 1,
 635         type => 'string',
 636         pattern => '/dev/parport\d+|/dev/usb/lp\d+',
 637         description =>  <<EODESCR,
 638 Map host parallel devices (n is 0 to 2).
 639
 640 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 641
 642 Experimental: user reported problems with this option.
 643 EODESCR
 644 };
 645
 646 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++)  {
 647     $confdesc->{"parallel$i"} = $paralleldesc;
 648 }
 649
 650 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++)  {
 651     $confdesc->{"serial$i"} = $serialdesc;
 652 }
 653
 654 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
 655     $confdesc->{"hostpci$i"} = $hostpcidesc;
 656 }
 657
 658 for (my $i = 0; $i < $MAX_IDE_DISKS; $i++)  {
 659     $drivename_hash->{"ide$i"} = 1;
 660     $confdesc->{"ide$i"} = $idedesc;
 661 }
 662
 663 for (my $i = 0; $i < $MAX_SATA_DISKS; $i++)  {
 664     $drivename_hash->{"sata$i"} = 1;
 665     $confdesc->{"sata$i"} = $satadesc;
 666 }
 667
 668 for (my $i = 0; $i < $MAX_SCSI_DISKS; $i++)  {
 669     $drivename_hash->{"scsi$i"} = 1;
 670     $confdesc->{"scsi$i"} = $scsidesc ;
 671 }
 672
 673 for (my $i = 0; $i < $MAX_VIRTIO_DISKS; $i++)  {
 674     $drivename_hash->{"virtio$i"} = 1;
 675     $confdesc->{"virtio$i"} = $virtiodesc;
 676 }
 677
 678 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
 679     $confdesc->{"usb$i"} = $usbdesc;
 680 }
 681
 682 my $unuseddesc = {
 683     optional => 1,
 684     type => 'string', format => 'pve-volume-id',
 685     description => "Reference to unused volumes.",
 686 };
 687
 688 for (my $i = 0; $i < $MAX_UNUSED_DISKS; $i++)  {
 689     $confdesc->{"unused$i"} = $unuseddesc;
 690 }
 691
 692 my $kvm_api_version = 0;
 693
 694 sub kvm_version {
 695
 696     return $kvm_api_version if $kvm_api_version;
 697
 698     my $fh = IO::File->new("</dev/kvm") ||
 699         return 0;
 700
 701     if (my $v = $fh->ioctl(KVM_GET_API_VERSION(), 0)) {
 702         $kvm_api_version = $v;
 703     }
 704
 705     $fh->close();
 706
 707     return  $kvm_api_version;
 708 }
 709
 710 my $kvm_user_version;
 711
 712 sub kvm_user_version {
 713
 714     return $kvm_user_version if $kvm_user_version;
 715
 716     $kvm_user_version = 'unknown';
 717
 718     my $tmp = `kvm -help 2>/dev/null`;
 719
 720     if ($tmp =~ m/^QEMU( PC)? emulator version (\d+\.\d+(\.\d+)?)[,\s]/) {
 721         $kvm_user_version = $2;
 722     }
 723
 724     return $kvm_user_version;
 725
 726 }
 727
 728 my $kernel_has_vhost_net = -c '/dev/vhost-net';
 729
 730 sub disknames {
 731     # order is important - used to autoselect boot disk
 732     return ((map { "ide$_" } (0 .. ($MAX_IDE_DISKS - 1))),
 733             (map { "scsi$_" } (0 .. ($MAX_SCSI_DISKS - 1))),
 734             (map { "virtio$_" } (0 .. ($MAX_VIRTIO_DISKS - 1))),
 735             (map { "sata$_" } (0 .. ($MAX_SATA_DISKS - 1))));
 736 }
 737
 738 sub valid_drivename {
 739     my $dev = shift;
 740
 741     return defined($drivename_hash->{$dev});
 742 }
 743
 744 sub option_exists {
 745     my $key = shift;
 746     return defined($confdesc->{$key});
 747 }
 748
 749 sub nic_models {
 750     return $nic_model_list;
 751 }
 752
 753 sub os_list_description {
 754
 755     return {
 756         other => 'Other',
 757         wxp => 'Windows XP',
 758         w2k => 'Windows 2000',
 759         w2k3 =>, 'Windows 2003',
 760         w2k8 => 'Windows 2008',
 761         wvista => 'Windows Vista',
 762         win7 => 'Windows 7',
 763         win8 => 'Windows 8/2012',
 764         l24 => 'Linux 2.4',
 765         l26 => 'Linux 2.6',
 766     };
 767 }
 768
 769 my $cdrom_path;
 770
 771 sub get_cdrom_path {
 772
 773     return  $cdrom_path if $cdrom_path;
 774
 775     return $cdrom_path = "/dev/cdrom" if -l "/dev/cdrom";
 776     return $cdrom_path = "/dev/cdrom1" if -l "/dev/cdrom1";
 777     return $cdrom_path = "/dev/cdrom2" if -l "/dev/cdrom2";
 778 }
 779
 780 sub get_iso_path {
 781     my ($storecfg, $vmid, $cdrom) = @_;
 782
 783     if ($cdrom eq 'cdrom') {
 784         return get_cdrom_path();
 785     } elsif ($cdrom eq 'none') {
 786         return '';
 787     } elsif ($cdrom =~ m|^/|) {
 788         return $cdrom;
 789     } else {
 790         return PVE::Storage::path($storecfg, $cdrom);
 791     }
 792 }
 793
 794 # try to convert old style file names to volume IDs
 795 sub filename_to_volume_id {
 796     my ($vmid, $file, $media) = @_;
 797
 798     if (!($file eq 'none' || $file eq 'cdrom' ||
 799           $file =~ m|^/dev/.+| || $file =~ m/^([^:]+):(.+)$/)) {
 800
 801         return undef if $file =~ m|/|;
 802
 803         if ($media && $media eq 'cdrom') {
 804             $file = "local:iso/$file";
 805         } else {
 806             $file = "local:$vmid/$file";
 807         }
 808     }
 809
 810     return $file;
 811 }
 812
 813 sub verify_media_type {
 814     my ($opt, $vtype, $media) = @_;
 815
 816     return if !$media;
 817
 818     my $etype;
 819     if ($media eq 'disk') {
 820         $etype = 'images';
 821     } elsif ($media eq 'cdrom') {
 822         $etype = 'iso';
 823     } else {
 824         die "internal error";
 825     }
 826
 827     return if ($vtype eq $etype);
 828
 829     raise_param_exc({ $opt => "unexpected media type ($vtype != $etype)" });
 830 }
 831
 832 sub cleanup_drive_path {
 833     my ($opt, $storecfg, $drive) = @_;
 834
 835     # try to convert filesystem paths to volume IDs
 836
 837     if (($drive->{file} !~ m/^(cdrom|none)$/) &&
 838         ($drive->{file} !~ m|^/dev/.+|) &&
 839         ($drive->{file} !~ m/^([^:]+):(.+)$/) &&
 840         ($drive->{file} !~ m/^\d+$/)) {
 841         my ($vtype, $volid) = PVE::Storage::path_to_volume_id($storecfg, $drive->{file});
 842         raise_param_exc({ $opt => "unable to associate path '$drive->{file}' to any storage"}) if !$vtype;
 843         $drive->{media} = 'cdrom' if !$drive->{media} && $vtype eq 'iso';
 844         verify_media_type($opt, $vtype, $drive->{media});
 845         $drive->{file} = $volid;
 846     }
 847
 848     $drive->{media} = 'cdrom' if !$drive->{media} && $drive->{file} =~ m/^(cdrom|none)$/;
 849 }
 850
 851 sub create_conf_nolock {
 852     my ($vmid, $settings) = @_;
 853
 854     my $filename = config_file($vmid);
 855
 856     die "configuration file '$filename' already exists\n" if -f $filename;
 857
 858     my $defaults = load_defaults();
 859
 860     $settings->{name} = "vm$vmid" if !$settings->{name};
 861     $settings->{memory} = $defaults->{memory} if !$settings->{memory};
 862
 863     my $data = '';
 864     foreach my $opt (keys %$settings) {
 865         next if !$confdesc->{$opt};
 866
 867         my $value = $settings->{$opt};
 868         next if !$value;
 869
 870         $data .= "$opt: $value\n";
 871     }
 872
 873     PVE::Tools::file_set_contents($filename, $data);
 874 }
 875
 876 sub parse_hotplug_features {
 877     my ($data) = @_;
 878
 879     my $res = {};
 880
 881     return $res if $data eq '0';
 882
 883     $data = $confdesc->{hotplug}->{default} if $data eq '1';
 884
 885     foreach my $feature (PVE::Tools::split_list($data)) {
 886         if ($feature =~ m/^(network|disk|cpu|memory|usb)$/) {
 887             $res->{$1} = 1;
 888         } else {
 889             warn "ignoring unknown hotplug feature '$feature'\n";
 890         }
 891     }
 892     return $res;
 893 }
 894
 895 PVE::JSONSchema::register_format('pve-hotplug-features', \&pve_verify_hotplug_features);
 896 sub pve_verify_hotplug_features {
 897     my ($value, $noerr) = @_;
 898
 899     return $value if parse_hotplug_features($value);
 900
 901     return undef if $noerr;
 902
 903     die "unable to parse hotplug option\n";
 904 }
 905
 906 my $parse_size = sub {
 907     my ($value) = @_;
 908
 909     return undef if $value !~ m/^(\d+(\.\d+)?)([KMG])?$/;
 910     my ($size, $unit) = ($1, $3);
 911     if ($unit) {
 912         if ($unit eq 'K') {
 913             $size = $size * 1024;
 914         } elsif ($unit eq 'M') {
 915             $size = $size * 1024 * 1024;
 916         } elsif ($unit eq 'G') {
 917             $size = $size * 1024 * 1024 * 1024;
 918         }
 919     }
 920     return int($size);
 921 };
 922
 923 my $format_size = sub {
 924     my ($size) = @_;
 925
 926     $size = int($size);
 927
 928     my $kb = int($size/1024);
 929     return $size if $kb*1024 != $size;
 930
 931     my $mb = int($kb/1024);
 932     return "${kb}K" if $mb*1024 != $kb;
 933
 934     my $gb = int($mb/1024);
 935     return "${mb}M" if $gb*1024 != $mb;
 936
 937     return "${gb}G";
 938 };
 939
 940 # ideX = [volume=]volume-id[,media=d][,cyls=c,heads=h,secs=s[,trans=t]]
 941 #        [,snapshot=on|off][,cache=on|off][,format=f][,backup=yes|no]
 942 #        [,rerror=ignore|report|stop][,werror=enospc|ignore|report|stop]
 943 #        [,aio=native|threads][,discard=ignore|on]
 944
 945 sub parse_drive {
 946     my ($key, $data) = @_;
 947
 948     my $res = {};
 949
 950     # $key may be undefined - used to verify JSON parameters
 951     if (!defined($key)) {
 952         $res->{interface} = 'unknown'; # should not harm when used to verify parameters
 953         $res->{index} = 0;
 954     } elsif ($key =~ m/^([^\d]+)(\d+)$/) {
 955         $res->{interface} = $1;
 956         $res->{index} = $2;
 957     } else {
 958         return undef;
 959     }
 960
 961     foreach my $p (split (/,/, $data)) {
 962         next if $p =~ m/^\s*$/;
 963
 964         if ($p =~ m/^(file|volume|cyls|heads|secs|trans|media|snapshot|cache|format|rerror|werror|backup|aio|bps|mbps|mbps_max|bps_rd|mbps_rd|mbps_rd_max|bps_wr|mbps_wr|mbps_wr_max|iops|iops_max|iops_rd|iops_rd_max|iops_wr|iops_wr_max|size|discard)=(.+)$/) {
 965             my ($k, $v) = ($1, $2);
 966
 967             $k = 'file' if $k eq 'volume';
 968
 969             return undef if defined $res->{$k};
 970
 971             if ($k eq 'bps' || $k eq 'bps_rd' || $k eq 'bps_wr') {
 972                 return undef if !$v || $v !~ m/^\d+/;
 973                 $k = "m$k";
 974                 $v = sprintf("%.3f", $v / (1024*1024));
 975             }
 976             $res->{$k} = $v;
 977         } else {
 978             if (!$res->{file} && $p !~ m/=/) {
 979                 $res->{file} = $p;
 980             } else {
 981                 return undef;
 982             }
 983         }
 984     }
 985
 986     return undef if !$res->{file};
 987
 988     if($res->{file} =~ m/\.(raw|cow|qcow|qcow2|vmdk|cloop)$/){
 989         $res->{format} = $1;
 990     }
 991
 992     return undef if $res->{cache} &&
 993         $res->{cache} !~ m/^(off|none|writethrough|writeback|unsafe|directsync)$/;
 994     return undef if $res->{snapshot} && $res->{snapshot} !~ m/^(on|off)$/;
 995     return undef if $res->{cyls} && $res->{cyls} !~ m/^\d+$/;
 996     return undef if $res->{heads} && $res->{heads} !~ m/^\d+$/;
 997     return undef if $res->{secs} && $res->{secs} !~ m/^\d+$/;
 998     return undef if $res->{media} && $res->{media} !~ m/^(disk|cdrom)$/;
 999     return undef if $res->{trans} && $res->{trans} !~ m/^(none|lba|auto)$/;
1000     return undef if $res->{format} && $res->{format} !~ m/^(raw|cow|qcow|qcow2|vmdk|cloop)$/;
1001     return undef if $res->{rerror} && $res->{rerror} !~ m/^(ignore|report|stop)$/;
1002     return undef if $res->{werror} && $res->{werror} !~ m/^(enospc|ignore|report|stop)$/;
1003     return undef if $res->{backup} && $res->{backup} !~ m/^(yes|no)$/;
1004     return undef if $res->{aio} && $res->{aio} !~ m/^(native|threads)$/;
1005     return undef if $res->{discard} && $res->{discard} !~ m/^(ignore|on)$/;
1006
1007     return undef if $res->{mbps_rd} && $res->{mbps};
1008     return undef if $res->{mbps_wr} && $res->{mbps};
1009
1010     return undef if $res->{mbps} && $res->{mbps} !~ m/^\d+(\.\d+)?$/;
1011     return undef if $res->{mbps_max} && $res->{mbps_max} !~ m/^\d+(\.\d+)?$/;
1012     return undef if $res->{mbps_rd} && $res->{mbps_rd} !~ m/^\d+(\.\d+)?$/;
1013     return undef if $res->{mbps_rd_max} && $res->{mbps_rd_max} !~ m/^\d+(\.\d+)?$/;
1014     return undef if $res->{mbps_wr} && $res->{mbps_wr} !~ m/^\d+(\.\d+)?$/;
1015     return undef if $res->{mbps_wr_max} && $res->{mbps_wr_max} !~ m/^\d+(\.\d+)?$/;
1016
1017     return undef if $res->{iops_rd} && $res->{iops};
1018     return undef if $res->{iops_wr} && $res->{iops};
1019
1020
1021     return undef if $res->{iops} && $res->{iops} !~ m/^\d+$/;
1022     return undef if $res->{iops_max} && $res->{iops_max} !~ m/^\d+$/;
1023     return undef if $res->{iops_rd} && $res->{iops_rd} !~ m/^\d+$/;
1024     return undef if $res->{iops_rd_max} && $res->{iops_rd_max} !~ m/^\d+$/;
1025     return undef if $res->{iops_wr} && $res->{iops_wr} !~ m/^\d+$/;
1026     return undef if $res->{iops_wr_max} && $res->{iops_wr_max} !~ m/^\d+$/;
1027
1028
1029     if ($res->{size}) {
1030         return undef if !defined($res->{size} = &$parse_size($res->{size}));
1031     }
1032
1033     if ($res->{media} && ($res->{media} eq 'cdrom')) {
1034         return undef if $res->{snapshot} || $res->{trans} || $res->{format};
1035         return undef if $res->{heads} || $res->{secs} || $res->{cyls};
1036         return undef if $res->{interface} eq 'virtio';
1037     }
1038
1039     # rerror does not work with scsi drives
1040     if ($res->{rerror}) {
1041         return undef if $res->{interface} eq 'scsi';
1042     }
1043
1044     return $res;
1045 }
1046
1047 my @qemu_drive_options = qw(heads secs cyls trans media format cache snapshot rerror werror aio discard iops iops_rd iops_wr iops_max iops_rd_max iops_wr_max);
1048
1049 sub print_drive {
1050     my ($vmid, $drive) = @_;
1051
1052     my $opts = '';
1053     foreach my $o (@qemu_drive_options, 'mbps', 'mbps_rd', 'mbps_wr', 'mbps_max', 'mbps_rd_max', 'mbps_wr_max', 'backup') {
1054         $opts .= ",$o=$drive->{$o}" if $drive->{$o};
1055     }
1056
1057     if ($drive->{size}) {
1058         $opts .= ",size=" . &$format_size($drive->{size});
1059     }
1060
1061     return "$drive->{file}$opts";
1062 }
1063
1064 sub scsi_inquiry {
1065     my($fh, $noerr) = @_;
1066
1067     my $SG_IO = 0x2285;
1068     my $SG_GET_VERSION_NUM = 0x2282;
1069
1070     my $versionbuf = "\x00" x 8;
1071     my $ret = ioctl($fh, $SG_GET_VERSION_NUM, $versionbuf);
1072     if (!$ret) {
1073         die "scsi ioctl SG_GET_VERSION_NUM failoed - $!\n" if !$noerr;
1074         return undef;
1075     }
1076     my $version = unpack("I", $versionbuf);
1077     if ($version < 30000) {
1078         die "scsi generic interface too old\n"  if !$noerr;
1079         return undef;
1080     }
1081
1082     my $buf = "\x00" x 36;
1083     my $sensebuf = "\x00" x 8;
1084     my $cmd = pack("C x3 C x1", 0x12, 36);
1085
1086     # see /usr/include/scsi/sg.h
1087     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";
1088
1089     my $packet = pack($sg_io_hdr_t, ord('S'), -3, length($cmd),
1090                       length($sensebuf), 0, length($buf), $buf,
1091                       $cmd, $sensebuf, 6000);
1092
1093     $ret = ioctl($fh, $SG_IO, $packet);
1094     if (!$ret) {
1095         die "scsi ioctl SG_IO failed - $!\n" if !$noerr;
1096         return undef;
1097     }
1098
1099     my @res = unpack($sg_io_hdr_t, $packet);
1100     if ($res[17] || $res[18]) {
1101         die "scsi ioctl SG_IO status error - $!\n" if !$noerr;
1102         return undef;
1103     }
1104
1105     my $res = {};
1106     (my $byte0, my $byte1, $res->{vendor},
1107      $res->{product}, $res->{revision}) = unpack("C C x6 A8 A16 A4", $buf);
1108
1109     $res->{removable} = $byte1 & 128 ? 1 : 0;
1110     $res->{type} = $byte0 & 31;
1111
1112     return $res;
1113 }
1114
1115 sub path_is_scsi {
1116     my ($path) = @_;
1117
1118     my $fh = IO::File->new("+<$path") || return undef;
1119     my $res = scsi_inquiry($fh, 1);
1120     close($fh);
1121
1122     return $res;
1123 }
1124
1125 sub machine_type_is_q35 {
1126     my ($conf) = @_;
1127
1128     return $conf->{machine} && ($conf->{machine} =~ m/q35/) ? 1 : 0;
1129 }
1130
1131 sub print_tabletdevice_full {
1132     my ($conf) = @_;
1133
1134     my $q35 = machine_type_is_q35($conf);
1135
1136     # we use uhci for old VMs because tablet driver was buggy in older qemu
1137     my $usbbus = $q35 ? "ehci" : "uhci";
1138
1139     return "usb-tablet,id=tablet,bus=$usbbus.0,port=1";
1140 }
1141
1142 sub print_drivedevice_full {
1143     my ($storecfg, $conf, $vmid, $drive, $bridges) = @_;
1144
1145     my $device = '';
1146     my $maxdev = 0;
1147
1148     if ($drive->{interface} eq 'virtio') {
1149         my $pciaddr = print_pci_addr("$drive->{interface}$drive->{index}", $bridges);
1150         $device = "virtio-blk-pci,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}$pciaddr";
1151         $device .= ",iothread=iothread0" if $conf->{iothread};
1152     } elsif ($drive->{interface} eq 'scsi') {
1153         $maxdev = ($conf->{scsihw} && ($conf->{scsihw} !~ m/^lsi/)) ? 256 : 7;
1154         my $controller = int($drive->{index} / $maxdev);
1155         my $unit = $drive->{index} % $maxdev;
1156         my $devicetype = 'hd';
1157         my $path = '';
1158         if (drive_is_cdrom($drive)) {
1159               $devicetype = 'cd';
1160         } else {
1161               if ($drive->{file} =~ m|^/|) {
1162                   $path = $drive->{file};
1163               } else {
1164                   $path = PVE::Storage::path($storecfg, $drive->{file});
1165               }
1166
1167               if($path =~ m/^iscsi\:\/\//){
1168                   $devicetype = 'generic';
1169               } else {
1170                   if (my $info = path_is_scsi($path)) {
1171                       if ($info->{type} == 0) {
1172                           $devicetype = 'block';
1173                       } elsif ($info->{type} == 1) { # tape
1174                           $devicetype = 'generic';
1175                       }
1176                   }
1177               }
1178          }
1179
1180         if (!$conf->{scsihw} || ($conf->{scsihw} =~ m/^lsi/)){
1181             $device = "scsi-$devicetype,bus=scsihw$controller.0,scsi-id=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1182         } else {
1183             $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}";
1184         }
1185
1186     } elsif ($drive->{interface} eq 'ide'){
1187         $maxdev = 2;
1188         my $controller = int($drive->{index} / $maxdev);
1189         my $unit = $drive->{index} % $maxdev;
1190         my $devicetype = ($drive->{media} && $drive->{media} eq 'cdrom') ? "cd" : "hd";
1191
1192         $device = "ide-$devicetype,bus=ide.$controller,unit=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1193     } elsif ($drive->{interface} eq 'sata'){
1194         my $controller = int($drive->{index} / $MAX_SATA_DISKS);
1195         my $unit = $drive->{index} % $MAX_SATA_DISKS;
1196         $device = "ide-drive,bus=ahci$controller.$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1197     } elsif ($drive->{interface} eq 'usb') {
1198         die "implement me";
1199         #  -device ide-drive,bus=ide.1,unit=0,drive=drive-ide0-1-0,id=ide0-1-0
1200     } else {
1201         die "unsupported interface type";
1202     }
1203
1204     $device .= ",bootindex=$drive->{bootindex}" if $drive->{bootindex};
1205
1206     return $device;
1207 }
1208
1209 sub get_initiator_name {
1210     my $initiator;
1211
1212     my $fh = IO::File->new('/etc/iscsi/initiatorname.iscsi') || return undef;
1213     while (defined(my $line = <$fh>)) {
1214         next if $line !~ m/^\s*InitiatorName\s*=\s*([\.\-:\w]+)/;
1215         $initiator = $1;
1216         last;
1217     }
1218     $fh->close();
1219
1220     return $initiator;
1221 }
1222
1223 sub print_drive_full {
1224     my ($storecfg, $vmid, $drive) = @_;
1225
1226     my $opts = '';
1227     foreach my $o (@qemu_drive_options) {
1228         next if $o eq 'bootindex';
1229         $opts .= ",$o=$drive->{$o}" if $drive->{$o};
1230     }
1231
1232     foreach my $o (qw(bps bps_rd bps_wr)) {
1233         my $v = $drive->{"m$o"};
1234         $opts .= ",$o=" . int($v*1024*1024) if $v;
1235     }
1236
1237     # use linux-aio by default (qemu default is threads)
1238     $opts .= ",aio=native" if !$drive->{aio};
1239
1240     my $path;
1241     my $volid = $drive->{file};
1242     if (drive_is_cdrom($drive)) {
1243         $path = get_iso_path($storecfg, $vmid, $volid);
1244     } else {
1245         if ($volid =~ m|^/|) {
1246             $path = $volid;
1247         } else {
1248             $path = PVE::Storage::path($storecfg, $volid);
1249         }
1250     }
1251
1252     $opts .= ",cache=none" if !$drive->{cache} && !drive_is_cdrom($drive);
1253
1254     my $detectzeroes = $drive->{discard} ? "unmap" : "on";
1255     $opts .= ",detect-zeroes=$detectzeroes" if !drive_is_cdrom($drive);
1256
1257     my $pathinfo = $path ? "file=$path," : '';
1258
1259     return "${pathinfo}if=none,id=drive-$drive->{interface}$drive->{index}$opts";
1260 }
1261
1262 sub print_netdevice_full {
1263     my ($vmid, $conf, $net, $netid, $bridges) = @_;
1264
1265     my $bootorder = $conf->{boot} || $confdesc->{boot}->{default};
1266
1267     my $device = $net->{model};
1268     if ($net->{model} eq 'virtio') {
1269          $device = 'virtio-net-pci';
1270      };
1271
1272     my $pciaddr = print_pci_addr("$netid", $bridges);
1273     my $tmpstr = "$device,mac=$net->{macaddr},netdev=$netid$pciaddr,id=$netid";
1274     if ($net->{queues} && $net->{queues} > 1 && $net->{model} eq 'virtio'){
1275         #Consider we have N queues, the number of vectors needed is 2*N + 2 (plus one config interrupt and control vq)
1276         my $vectors = $net->{queues} * 2 + 2;
1277         $tmpstr .= ",vectors=$vectors,mq=on";
1278     }
1279     $tmpstr .= ",bootindex=$net->{bootindex}" if $net->{bootindex} ;
1280     return $tmpstr;
1281 }
1282
1283 sub print_netdev_full {
1284     my ($vmid, $conf, $net, $netid) = @_;
1285
1286     my $i = '';
1287     if ($netid =~ m/^net(\d+)$/) {
1288         $i = int($1);
1289     }
1290
1291     die "got strange net id '$i'\n" if $i >= ${MAX_NETS};
1292
1293     my $ifname = "tap${vmid}i$i";
1294
1295     # kvm uses TUNSETIFF ioctl, and that limits ifname length
1296     die "interface name '$ifname' is too long (max 15 character)\n"
1297         if length($ifname) >= 16;
1298
1299     my $vhostparam = '';
1300     $vhostparam = ',vhost=on' if $kernel_has_vhost_net && $net->{model} eq 'virtio';
1301
1302     my $vmname = $conf->{name} || "vm$vmid";
1303
1304     my $netdev = "";
1305
1306     if ($net->{bridge}) {
1307         $netdev = "type=tap,id=$netid,ifname=${ifname},script=/var/lib/qemu-server/pve-bridge,downscript=/var/lib/qemu-server/pve-bridgedown$vhostparam";
1308     } else {
1309         $netdev = "type=user,id=$netid,hostname=$vmname";
1310     }
1311
1312     $netdev .= ",queues=$net->{queues}" if ($net->{queues} && $net->{model} eq 'virtio');
1313
1314     return $netdev;
1315 }
1316
1317 sub drive_is_cdrom {
1318     my ($drive) = @_;
1319
1320     return $drive && $drive->{media} && ($drive->{media} eq 'cdrom');
1321
1322 }
1323
1324 sub parse_numa {
1325     my ($data) = @_;
1326
1327     my $res = {};
1328
1329     foreach my $kvp (split(/,/, $data)) {
1330
1331         if ($kvp =~ m/^memory=(\S+)$/) {
1332             $res->{memory} = $1;
1333         } elsif ($kvp =~ m/^policy=(preferred|bind|interleave)$/) {
1334             $res->{policy} = $1;
1335         } elsif ($kvp =~ m/^cpus=(\d+)(-(\d+))?$/) {
1336             $res->{cpus}->{start} = $1;
1337             $res->{cpus}->{end} = $3;
1338         } elsif ($kvp =~ m/^hostnodes=(\d+)(-(\d+))?$/) {
1339             $res->{hostnodes}->{start} = $1;
1340             $res->{hostnodes}->{end} = $3;
1341         } else {
1342             return undef;
1343         }
1344     }
1345
1346     return $res;
1347 }
1348
1349 sub parse_hostpci {
1350     my ($value) = @_;
1351
1352     return undef if !$value;
1353
1354
1355     my @list = split(/,/, $value);
1356     my $found;
1357
1358     my $res = {};
1359     foreach my $kv (@list) {
1360
1361         if ($kv =~ m/^(host=)?([a-f0-9]{2}:[a-f0-9]{2})(\.([a-f0-9]))?$/) {
1362             $found = 1;
1363             if(defined($4)){
1364                 push @{$res->{pciid}}, { id => $2 , function => $4};
1365
1366             }else{
1367                 my $pcidevices = lspci($2);
1368                 $res->{pciid} = $pcidevices->{$2};
1369             }
1370         } elsif ($kv =~ m/^driver=(kvm|vfio)$/) {
1371             $res->{driver} = $1;
1372         } elsif ($kv =~ m/^rombar=(on|off)$/) {
1373             $res->{rombar} = $1;
1374         } elsif ($kv =~ m/^x-vga=(on|off)$/) {
1375             $res->{'x-vga'} = $1;
1376         } elsif ($kv =~ m/^pcie=(\d+)$/) {
1377             $res->{pcie} = 1 if $1 == 1;
1378         } else {
1379             warn "unknown hostpci setting '$kv'\n";
1380         }
1381     }
1382
1383     return undef if !$found;
1384
1385     return $res;
1386 }
1387
1388 # netX: e1000=XX:XX:XX:XX:XX:XX,bridge=vmbr0,rate=<mbps>
1389 sub parse_net {
1390     my ($data) = @_;
1391
1392     my $res = {};
1393
1394     foreach my $kvp (split(/,/, $data)) {
1395
1396         if ($kvp =~ m/^(ne2k_pci|e1000|e1000-82540em|e1000-82544gc|e1000-82545em|rtl8139|pcnet|virtio|ne2k_isa|i82551|i82557b|i82559er|vmxnet3)(=([0-9a-f]{2}(:[0-9a-f]{2}){5}))?$/i) {
1397             my $model = lc($1);
1398             my $mac = defined($3) ? uc($3) : PVE::Tools::random_ether_addr();
1399             $res->{model} = $model;
1400             $res->{macaddr} = $mac;
1401         } elsif ($kvp =~ m/^bridge=(\S+)$/) {
1402             $res->{bridge} = $1;
1403         } elsif ($kvp =~ m/^queues=(\d+)$/) {
1404             $res->{queues} = $1;
1405         } elsif ($kvp =~ m/^rate=(\d+(\.\d+)?)$/) {
1406             $res->{rate} = $1;
1407         } elsif ($kvp =~ m/^tag=(\d+)$/) {
1408             $res->{tag} = $1;
1409         } elsif ($kvp =~ m/^firewall=([01])$/) {
1410             $res->{firewall} = $1;
1411         } elsif ($kvp =~ m/^link_down=([01])$/) {
1412             $res->{link_down} = $1;
1413         } else {
1414             return undef;
1415         }
1416
1417     }
1418
1419     return undef if !$res->{model};
1420
1421     return $res;
1422 }
1423
1424 sub print_net {
1425     my $net = shift;
1426
1427     my $res = "$net->{model}";
1428     $res .= "=$net->{macaddr}" if $net->{macaddr};
1429     $res .= ",bridge=$net->{bridge}" if $net->{bridge};
1430     $res .= ",rate=$net->{rate}" if $net->{rate};
1431     $res .= ",tag=$net->{tag}" if $net->{tag};
1432     $res .= ",firewall=1" if $net->{firewall};
1433     $res .= ",link_down=1" if $net->{link_down};
1434     $res .= ",queues=$net->{queues}" if $net->{queues};
1435
1436     return $res;
1437 }
1438
1439 sub add_random_macs {
1440     my ($settings) = @_;
1441
1442     foreach my $opt (keys %$settings) {
1443         next if $opt !~ m/^net(\d+)$/;
1444         my $net = parse_net($settings->{$opt});
1445         next if !$net;
1446         $settings->{$opt} = print_net($net);
1447     }
1448 }
1449
1450 sub add_unused_volume {
1451     my ($config, $volid) = @_;
1452
1453     my $key;
1454     for (my $ind = $MAX_UNUSED_DISKS - 1; $ind >= 0; $ind--) {
1455         my $test = "unused$ind";
1456         if (my $vid = $config->{$test}) {
1457             return if $vid eq $volid; # do not add duplicates
1458         } else {
1459             $key = $test;
1460         }
1461     }
1462
1463     die "To many unused volume - please delete them first.\n" if !$key;
1464
1465     $config->{$key} = $volid;
1466
1467     return $key;
1468 }
1469
1470 sub vm_is_volid_owner {
1471     my ($storecfg, $vmid, $volid) = @_;
1472
1473     if ($volid !~  m|^/|) {
1474         my ($path, $owner);
1475         eval { ($path, $owner) = PVE::Storage::path($storecfg, $volid); };
1476         if ($owner && ($owner == $vmid)) {
1477             return 1;
1478         }
1479     }
1480
1481     return undef;
1482 }
1483
1484 sub vmconfig_delete_pending_option {
1485     my ($conf, $key) = @_;
1486
1487     delete $conf->{pending}->{$key};
1488     my $pending_delete_hash = { $key => 1 };
1489     foreach my $opt (PVE::Tools::split_list($conf->{pending}->{delete})) {
1490         $pending_delete_hash->{$opt} = 1;
1491     }
1492     $conf->{pending}->{delete} = join(',', keys %$pending_delete_hash);
1493 }
1494
1495 sub vmconfig_undelete_pending_option {
1496     my ($conf, $key) = @_;
1497
1498     my $pending_delete_hash = {};
1499     foreach my $opt (PVE::Tools::split_list($conf->{pending}->{delete})) {
1500         $pending_delete_hash->{$opt} = 1;
1501     }
1502     delete $pending_delete_hash->{$key};
1503
1504     my @keylist = keys %$pending_delete_hash;
1505     if (scalar(@keylist)) {
1506         $conf->{pending}->{delete} = join(',', @keylist);
1507     } else {
1508         delete $conf->{pending}->{delete};
1509     }
1510 }
1511
1512 sub vmconfig_register_unused_drive {
1513     my ($storecfg, $vmid, $conf, $drive) = @_;
1514
1515     if (!drive_is_cdrom($drive)) {
1516         my $volid = $drive->{file};
1517         if (vm_is_volid_owner($storecfg, $vmid, $volid)) {
1518             add_unused_volume($conf, $volid, $vmid);
1519         }
1520     }
1521 }
1522
1523 sub vmconfig_cleanup_pending {
1524     my ($conf) = @_;
1525
1526     # remove pending changes when nothing changed
1527     my $changes;
1528     foreach my $opt (keys %{$conf->{pending}}) {
1529         if (defined($conf->{$opt}) && ($conf->{pending}->{$opt} eq  $conf->{$opt})) {
1530             $changes = 1;
1531             delete $conf->{pending}->{$opt};
1532         }
1533     }
1534
1535     # remove delete if option is not set
1536     my $pending_delete_hash = {};
1537     foreach my $opt (PVE::Tools::split_list($conf->{pending}->{delete})) {
1538         if (defined($conf->{$opt})) {
1539             $pending_delete_hash->{$opt} = 1;
1540         } else {
1541             $changes = 1;
1542         }
1543     }
1544
1545     my @keylist = keys %$pending_delete_hash;
1546     if (scalar(@keylist)) {
1547         $conf->{pending}->{delete} = join(',', @keylist);
1548     } else {
1549         delete $conf->{pending}->{delete};
1550     }
1551
1552     return $changes;
1553 }
1554
1555 my $valid_smbios1_options = {
1556     manufacturer => '\S+',
1557     product => '\S+',
1558     version => '\S+',
1559     serial => '\S+',
1560     uuid => '[a-fA-F0-9]{8}(?:-[a-fA-F0-9]{4}){3}-[a-fA-F0-9]{12}',
1561     sku => '\S+',
1562     family => '\S+',
1563 };
1564
1565 # smbios: [manufacturer=str][,product=str][,version=str][,serial=str][,uuid=uuid][,sku=str][,family=str]
1566 sub parse_smbios1 {
1567     my ($data) = @_;
1568
1569     my $res = {};
1570
1571     foreach my $kvp (split(/,/, $data)) {
1572         return undef if $kvp !~ m/^(\S+)=(.+)$/;
1573         my ($k, $v) = split(/=/, $kvp);
1574         return undef if !defined($k) || !defined($v);
1575         return undef if !$valid_smbios1_options->{$k};
1576         return undef if $v !~ m/^$valid_smbios1_options->{$k}$/;
1577         $res->{$k} = $v;
1578     }
1579
1580     return $res;
1581 }
1582
1583 sub print_smbios1 {
1584     my ($smbios1) = @_;
1585
1586     my $data = '';
1587     foreach my $k (keys %$smbios1) {
1588         next if !defined($smbios1->{$k});
1589         next if !$valid_smbios1_options->{$k};
1590         $data .= ',' if $data;
1591         $data .= "$k=$smbios1->{$k}";
1592     }
1593     return $data;
1594 }
1595
1596 PVE::JSONSchema::register_format('pve-qm-smbios1', \&verify_smbios1);
1597 sub verify_smbios1 {
1598     my ($value, $noerr) = @_;
1599
1600     return $value if parse_smbios1($value);
1601
1602     return undef if $noerr;
1603
1604     die "unable to parse smbios (type 1) options\n";
1605 }
1606
1607 PVE::JSONSchema::register_format('pve-qm-bootdisk', \&verify_bootdisk);
1608 sub verify_bootdisk {
1609     my ($value, $noerr) = @_;
1610
1611     return $value if valid_drivename($value);
1612
1613     return undef if $noerr;
1614
1615     die "invalid boot disk '$value'\n";
1616 }
1617
1618 PVE::JSONSchema::register_format('pve-qm-numanode', \&verify_numa);
1619 sub verify_numa {
1620     my ($value, $noerr) = @_;
1621
1622     return $value if parse_numa($value);
1623
1624     return undef if $noerr;
1625
1626     die "unable to parse numa options\n";
1627 }
1628
1629 PVE::JSONSchema::register_format('pve-qm-net', \&verify_net);
1630 sub verify_net {
1631     my ($value, $noerr) = @_;
1632
1633     return $value if parse_net($value);
1634
1635     return undef if $noerr;
1636
1637     die "unable to parse network options\n";
1638 }
1639
1640 PVE::JSONSchema::register_format('pve-qm-drive', \&verify_drive);
1641 sub verify_drive {
1642     my ($value, $noerr) = @_;
1643
1644     return $value if parse_drive(undef, $value);
1645
1646     return undef if $noerr;
1647
1648     die "unable to parse drive options\n";
1649 }
1650
1651 PVE::JSONSchema::register_format('pve-qm-hostpci', \&verify_hostpci);
1652 sub verify_hostpci {
1653     my ($value, $noerr) = @_;
1654
1655     return $value if parse_hostpci($value);
1656
1657     return undef if $noerr;
1658
1659     die "unable to parse pci id\n";
1660 }
1661
1662 PVE::JSONSchema::register_format('pve-qm-watchdog', \&verify_watchdog);
1663 sub verify_watchdog {
1664     my ($value, $noerr) = @_;
1665
1666     return $value if parse_watchdog($value);
1667
1668     return undef if $noerr;
1669
1670     die "unable to parse watchdog options\n";
1671 }
1672
1673 sub parse_watchdog {
1674     my ($value) = @_;
1675
1676     return undef if !$value;
1677
1678     my $res = {};
1679
1680     foreach my $p (split(/,/, $value)) {
1681         next if $p =~ m/^\s*$/;
1682
1683         if ($p =~ m/^(model=)?(i6300esb|ib700)$/) {
1684             $res->{model} = $2;
1685         } elsif ($p =~ m/^(action=)?(reset|shutdown|poweroff|pause|debug|none)$/) {
1686             $res->{action} = $2;
1687         } else {
1688             return undef;
1689         }
1690     }
1691
1692     return $res;
1693 }
1694
1695 PVE::JSONSchema::register_format('pve-qm-startup', \&verify_startup);
1696 sub verify_startup {
1697     my ($value, $noerr) = @_;
1698
1699     return $value if parse_startup($value);
1700
1701     return undef if $noerr;
1702
1703     die "unable to parse startup options\n";
1704 }
1705
1706 sub parse_startup {
1707     my ($value) = @_;
1708
1709     return undef if !$value;
1710
1711     my $res = {};
1712
1713     foreach my $p (split(/,/, $value)) {
1714         next if $p =~ m/^\s*$/;
1715
1716         if ($p =~ m/^(order=)?(\d+)$/) {
1717             $res->{order} = $2;
1718         } elsif ($p =~ m/^up=(\d+)$/) {
1719             $res->{up} = $1;
1720         } elsif ($p =~ m/^down=(\d+)$/) {
1721             $res->{down} = $1;
1722         } else {
1723             return undef;
1724         }
1725     }
1726
1727     return $res;
1728 }
1729
1730 sub parse_usb_device {
1731     my ($value) = @_;
1732
1733     return undef if !$value;
1734
1735     my @dl = split(/,/, $value);
1736     my $found;
1737
1738     my $res = {};
1739     foreach my $v (@dl) {
1740         if ($v =~ m/^host=(0x)?([0-9A-Fa-f]{4}):(0x)?([0-9A-Fa-f]{4})$/) {
1741             $found = 1;
1742             $res->{vendorid} = $2;
1743             $res->{productid} = $4;
1744         } elsif ($v =~ m/^host=(\d+)\-(\d+(\.\d+)*)$/) {
1745             $found = 1;
1746             $res->{hostbus} = $1;
1747             $res->{hostport} = $2;
1748         } elsif ($v =~ m/^spice$/) {
1749             $found = 1;
1750             $res->{spice} = 1;
1751         } else {
1752             return undef;
1753         }
1754     }
1755     return undef if !$found;
1756
1757     return $res;
1758 }
1759
1760 PVE::JSONSchema::register_format('pve-qm-usb-device', \&verify_usb_device);
1761 sub verify_usb_device {
1762     my ($value, $noerr) = @_;
1763
1764     return $value if parse_usb_device($value);
1765
1766     return undef if $noerr;
1767
1768     die "unable to parse usb device\n";
1769 }
1770
1771 # add JSON properties for create and set function
1772 sub json_config_properties {
1773     my $prop = shift;
1774
1775     foreach my $opt (keys %$confdesc) {
1776         next if $opt eq 'parent' || $opt eq 'snaptime' || $opt eq 'vmstate';
1777         $prop->{$opt} = $confdesc->{$opt};
1778     }
1779
1780     return $prop;
1781 }
1782
1783 sub check_type {
1784     my ($key, $value) = @_;
1785
1786     die "unknown setting '$key'\n" if !$confdesc->{$key};
1787
1788     my $type = $confdesc->{$key}->{type};
1789
1790     if (!defined($value)) {
1791         die "got undefined value\n";
1792     }
1793
1794     if ($value =~ m/[\n\r]/) {
1795         die "property contains a line feed\n";
1796     }
1797
1798     if ($type eq 'boolean') {
1799         return 1 if ($value eq '1') || ($value =~ m/^(on|yes|true)$/i);
1800         return 0 if ($value eq '0') || ($value =~ m/^(off|no|false)$/i);
1801         die "type check ('boolean') failed - got '$value'\n";
1802     } elsif ($type eq 'integer') {
1803         return int($1) if $value =~ m/^(\d+)$/;
1804         die "type check ('integer') failed - got '$value'\n";
1805     } elsif ($type eq 'number') {
1806         return $value if $value =~ m/^(\d+)(\.\d+)?$/;
1807         die "type check ('number') failed - got '$value'\n";
1808     } elsif ($type eq 'string') {
1809         if (my $fmt = $confdesc->{$key}->{format}) {
1810             if ($fmt eq 'pve-qm-drive') {
1811                 # special case - we need to pass $key to parse_drive()
1812                 my $drive = parse_drive($key, $value);
1813                 return $value if $drive;
1814                 die "unable to parse drive options\n";
1815             }
1816             PVE::JSONSchema::check_format($fmt, $value);
1817             return $value;
1818         }
1819         $value =~ s/^\"(.*)\"$/$1/;
1820         return $value;
1821     } else {
1822         die "internal error"
1823     }
1824 }
1825
1826 sub lock_config_full {
1827     my ($vmid, $timeout, $code, @param) = @_;
1828
1829     my $filename = config_file_lock($vmid);
1830
1831     my $res = lock_file($filename, $timeout, $code, @param);
1832
1833     die $@ if $@;
1834
1835     return $res;
1836 }
1837
1838 sub lock_config_mode {
1839     my ($vmid, $timeout, $shared, $code, @param) = @_;
1840
1841     my $filename = config_file_lock($vmid);
1842
1843     my $res = lock_file_full($filename, $timeout, $shared, $code, @param);
1844
1845     die $@ if $@;
1846
1847     return $res;
1848 }
1849
1850 sub lock_config {
1851     my ($vmid, $code, @param) = @_;
1852
1853     return lock_config_full($vmid, 10, $code, @param);
1854 }
1855
1856 sub cfs_config_path {
1857     my ($vmid, $node) = @_;
1858
1859     $node = $nodename if !$node;
1860     return "nodes/$node/qemu-server/$vmid.conf";
1861 }
1862
1863 sub check_iommu_support{
1864     #fixme : need to check IOMMU support
1865     #http://www.linux-kvm.org/page/How_to_assign_devices_with_VT-d_in_KVM
1866
1867     my $iommu=1;
1868     return $iommu;
1869
1870 }
1871
1872 sub config_file {
1873     my ($vmid, $node) = @_;
1874
1875     my $cfspath = cfs_config_path($vmid, $node);
1876     return "/etc/pve/$cfspath";
1877 }
1878
1879 sub config_file_lock {
1880     my ($vmid) = @_;
1881
1882     return "$lock_dir/lock-$vmid.conf";
1883 }
1884
1885 sub touch_config {
1886     my ($vmid) = @_;
1887
1888     my $conf = config_file($vmid);
1889     utime undef, undef, $conf;
1890 }
1891
1892 sub destroy_vm {
1893     my ($storecfg, $vmid, $keep_empty_config) = @_;
1894
1895     my $conffile = config_file($vmid);
1896
1897     my $conf = load_config($vmid);
1898
1899     check_lock($conf);
1900
1901     # only remove disks owned by this VM
1902     foreach_drive($conf, sub {
1903         my ($ds, $drive) = @_;
1904
1905         return if drive_is_cdrom($drive);
1906
1907         my $volid = $drive->{file};
1908
1909         return if !$volid || $volid =~ m|^/|;
1910
1911         my ($path, $owner) = PVE::Storage::path($storecfg, $volid);
1912         return if !$path || !$owner || ($owner != $vmid);
1913
1914         PVE::Storage::vdisk_free($storecfg, $volid);
1915     });
1916
1917     if ($keep_empty_config) {
1918         PVE::Tools::file_set_contents($conffile, "memory: 128\n");
1919     } else {
1920         unlink $conffile;
1921     }
1922
1923     # also remove unused disk
1924     eval {
1925         my $dl = PVE::Storage::vdisk_list($storecfg, undef, $vmid);
1926
1927         eval {
1928             PVE::Storage::foreach_volid($dl, sub {
1929                 my ($volid, $sid, $volname, $d) = @_;
1930                 PVE::Storage::vdisk_free($storecfg, $volid);
1931             });
1932         };
1933         warn $@ if $@;
1934
1935     };
1936     warn $@ if $@;
1937 }
1938
1939 sub load_config {
1940     my ($vmid, $node) = @_;
1941
1942     my $cfspath = cfs_config_path($vmid, $node);
1943
1944     my $conf = PVE::Cluster::cfs_read_file($cfspath);
1945
1946     die "no such VM ('$vmid')\n" if !defined($conf);
1947
1948     return $conf;
1949 }
1950
1951 sub parse_vm_config {
1952     my ($filename, $raw) = @_;
1953
1954     return undef if !defined($raw);
1955
1956     my $res = {
1957         digest => Digest::SHA::sha1_hex($raw),
1958         snapshots => {},
1959         pending => {},
1960     };
1961
1962     $filename =~ m|/qemu-server/(\d+)\.conf$|
1963         || die "got strange filename '$filename'";
1964
1965     my $vmid = $1;
1966
1967     my $conf = $res;
1968     my $descr = '';
1969     my $section = '';
1970
1971     my @lines = split(/\n/, $raw);
1972     foreach my $line (@lines) {
1973         next if $line =~ m/^\s*$/;
1974
1975         if ($line =~ m/^\[PENDING\]\s*$/i) {
1976             $section = 'pending';
1977             $conf->{description} = $descr if $descr;
1978             $descr = '';
1979             $conf = $res->{$section} = {};
1980             next;
1981
1982         } elsif ($line =~ m/^\[([a-z][a-z0-9_\-]+)\]\s*$/i) {
1983             $section = $1;
1984             $conf->{description} = $descr if $descr;
1985             $descr = '';
1986             $conf = $res->{snapshots}->{$section} = {};
1987             next;
1988         }
1989
1990         if ($line =~ m/^\#(.*)\s*$/) {
1991             $descr .= PVE::Tools::decode_text($1) . "\n";
1992             next;
1993         }
1994
1995         if ($line =~ m/^(description):\s*(.*\S)\s*$/) {
1996             $descr .= PVE::Tools::decode_text($2);
1997         } elsif ($line =~ m/snapstate:\s*(prepare|delete)\s*$/) {
1998             $conf->{snapstate} = $1;
1999         } elsif ($line =~ m/^(args):\s*(.*\S)\s*$/) {
2000             my $key = $1;
2001             my $value = $2;
2002             $conf->{$key} = $value;
2003         } elsif ($line =~ m/^delete:\s*(.*\S)\s*$/) {
2004             my $value = $1;
2005             if ($section eq 'pending') {
2006                 $conf->{delete} = $value; # we parse this later
2007             } else {
2008                 warn "vm $vmid - propertry 'delete' is only allowed in [PENDING]\n";
2009             }
2010         } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/) {
2011             my $key = $1;
2012             my $value = $2;
2013             eval { $value = check_type($key, $value); };
2014             if ($@) {
2015                 warn "vm $vmid - unable to parse value of '$key' - $@";
2016             } else {
2017                 my $fmt = $confdesc->{$key}->{format};
2018                 if ($fmt && $fmt eq 'pve-qm-drive') {
2019                     my $v = parse_drive($key, $value);
2020                     if (my $volid = filename_to_volume_id($vmid, $v->{file}, $v->{media})) {
2021                         $v->{file} = $volid;
2022                         $value = print_drive($vmid, $v);
2023                     } else {
2024                         warn "vm $vmid - unable to parse value of '$key'\n";
2025                         next;
2026                     }
2027                 }
2028
2029                 if ($key eq 'cdrom') {
2030                     $conf->{ide2} = $value;
2031                 } else {
2032                     $conf->{$key} = $value;
2033                 }
2034             }
2035         }
2036     }
2037
2038     $conf->{description} = $descr if $descr;
2039
2040     delete $res->{snapstate}; # just to be sure
2041
2042     return $res;
2043 }
2044
2045 sub write_vm_config {
2046     my ($filename, $conf) = @_;
2047
2048     delete $conf->{snapstate}; # just to be sure
2049
2050     if ($conf->{cdrom}) {
2051         die "option ide2 conflicts with cdrom\n" if $conf->{ide2};
2052         $conf->{ide2} = $conf->{cdrom};
2053         delete $conf->{cdrom};
2054     }
2055
2056     # we do not use 'smp' any longer
2057     if ($conf->{sockets}) {
2058         delete $conf->{smp};
2059     } elsif ($conf->{smp}) {
2060         $conf->{sockets} = $conf->{smp};
2061         delete $conf->{cores};
2062         delete $conf->{smp};
2063     }
2064
2065     my $used_volids = {};
2066
2067     my $cleanup_config = sub {
2068         my ($cref, $pending, $snapname) = @_;
2069
2070         foreach my $key (keys %$cref) {
2071             next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots' ||
2072                 $key eq 'snapstate' || $key eq 'pending';
2073             my $value = $cref->{$key};
2074             if ($key eq 'delete') {
2075                 die "propertry 'delete' is only allowed in [PENDING]\n"
2076                     if !$pending;
2077                 # fixme: check syntax?
2078                 next;
2079             }
2080             eval { $value = check_type($key, $value); };
2081             die "unable to parse value of '$key' - $@" if $@;
2082
2083             $cref->{$key} = $value;
2084
2085             if (!$snapname && valid_drivename($key)) {
2086                 my $drive = parse_drive($key, $value);
2087                 $used_volids->{$drive->{file}} = 1 if $drive && $drive->{file};
2088             }
2089         }
2090     };
2091
2092     &$cleanup_config($conf);
2093
2094     &$cleanup_config($conf->{pending}, 1);
2095
2096     foreach my $snapname (keys %{$conf->{snapshots}}) {
2097         die "internal error" if $snapname eq 'pending';
2098         &$cleanup_config($conf->{snapshots}->{$snapname}, undef, $snapname);
2099     }
2100
2101     # remove 'unusedX' settings if we re-add a volume
2102     foreach my $key (keys %$conf) {
2103         my $value = $conf->{$key};
2104         if ($key =~ m/^unused/ && $used_volids->{$value}) {
2105             delete $conf->{$key};
2106         }
2107     }
2108
2109     my $generate_raw_config = sub {
2110         my ($conf) = @_;
2111
2112         my $raw = '';
2113
2114         # add description as comment to top of file
2115         my $descr = $conf->{description} || '';
2116         foreach my $cl (split(/\n/, $descr)) {
2117             $raw .= '#' .  PVE::Tools::encode_text($cl) . "\n";
2118         }
2119
2120         foreach my $key (sort keys %$conf) {
2121             next if $key eq 'digest' || $key eq 'description' || $key eq 'pending' || $key eq 'snapshots';
2122             $raw .= "$key: $conf->{$key}\n";
2123         }
2124         return $raw;
2125     };
2126
2127     my $raw = &$generate_raw_config($conf);
2128
2129     if (scalar(keys %{$conf->{pending}})){
2130         $raw .= "\n[PENDING]\n";
2131         $raw .= &$generate_raw_config($conf->{pending});
2132     }
2133
2134     foreach my $snapname (sort keys %{$conf->{snapshots}}) {
2135         $raw .= "\n[$snapname]\n";
2136         $raw .= &$generate_raw_config($conf->{snapshots}->{$snapname});
2137     }
2138
2139     return $raw;
2140 }
2141
2142 sub update_config_nolock {
2143     my ($vmid, $conf, $skiplock) = @_;
2144
2145     check_lock($conf) if !$skiplock;
2146
2147     my $cfspath = cfs_config_path($vmid);
2148
2149     PVE::Cluster::cfs_write_file($cfspath, $conf);
2150 }
2151
2152 sub update_config {
2153     my ($vmid, $conf, $skiplock) = @_;
2154
2155     lock_config($vmid, &update_config_nolock, $conf, $skiplock);
2156 }
2157
2158 sub load_defaults {
2159
2160     my $res = {};
2161
2162     # we use static defaults from our JSON schema configuration
2163     foreach my $key (keys %$confdesc) {
2164         if (defined(my $default = $confdesc->{$key}->{default})) {
2165             $res->{$key} = $default;
2166         }
2167     }
2168
2169     my $conf = PVE::Cluster::cfs_read_file('datacenter.cfg');
2170     $res->{keyboard} = $conf->{keyboard} if $conf->{keyboard};
2171
2172     return $res;
2173 }
2174
2175 sub config_list {
2176     my $vmlist = PVE::Cluster::get_vmlist();
2177     my $res = {};
2178     return $res if !$vmlist || !$vmlist->{ids};
2179     my $ids = $vmlist->{ids};
2180
2181     foreach my $vmid (keys %$ids) {
2182         my $d = $ids->{$vmid};
2183         next if !$d->{node} || $d->{node} ne $nodename;
2184         next if !$d->{type} || $d->{type} ne 'qemu';
2185         $res->{$vmid}->{exists} = 1;
2186     }
2187     return $res;
2188 }
2189
2190 # test if VM uses local resources (to prevent migration)
2191 sub check_local_resources {
2192     my ($conf, $noerr) = @_;
2193
2194     my $loc_res = 0;
2195
2196     $loc_res = 1 if $conf->{hostusb}; # old syntax
2197     $loc_res = 1 if $conf->{hostpci}; # old syntax
2198
2199     foreach my $k (keys %$conf) {
2200         next if $k =~ m/^usb/ && ($conf->{$k} eq 'spice');
2201         $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/;
2202     }
2203
2204     die "VM uses local resources\n" if $loc_res && !$noerr;
2205
2206     return $loc_res;
2207 }
2208
2209 # check if used storages are available on all nodes (use by migrate)
2210 sub check_storage_availability {
2211     my ($storecfg, $conf, $node) = @_;
2212
2213     foreach_drive($conf, sub {
2214         my ($ds, $drive) = @_;
2215
2216         my $volid = $drive->{file};
2217         return if !$volid;
2218
2219         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
2220         return if !$sid;
2221
2222         # check if storage is available on both nodes
2223         my $scfg = PVE::Storage::storage_check_node($storecfg, $sid);
2224         PVE::Storage::storage_check_node($storecfg, $sid, $node);
2225    });
2226 }
2227
2228 # list nodes where all VM images are available (used by has_feature API)
2229 sub shared_nodes {
2230     my ($conf, $storecfg) = @_;
2231
2232     my $nodelist = PVE::Cluster::get_nodelist();
2233     my $nodehash = { map { $_ => 1 } @$nodelist };
2234     my $nodename = PVE::INotify::nodename();
2235
2236     foreach_drive($conf, sub {
2237         my ($ds, $drive) = @_;
2238
2239         my $volid = $drive->{file};
2240         return if !$volid;
2241
2242         my ($storeid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
2243         if ($storeid) {
2244             my $scfg = PVE::Storage::storage_config($storecfg, $storeid);
2245             if ($scfg->{disable}) {
2246                 $nodehash = {};
2247             } elsif (my $avail = $scfg->{nodes}) {
2248                 foreach my $node (keys %$nodehash) {
2249                     delete $nodehash->{$node} if !$avail->{$node};
2250                 }
2251             } elsif (!$scfg->{shared}) {
2252                 foreach my $node (keys %$nodehash) {
2253                     delete $nodehash->{$node} if $node ne $nodename
2254                 }
2255             }
2256         }
2257     });
2258
2259     return $nodehash
2260 }
2261
2262 sub check_lock {
2263     my ($conf) = @_;
2264
2265     die "VM is locked ($conf->{lock})\n" if $conf->{lock};
2266 }
2267
2268 sub check_cmdline {
2269     my ($pidfile, $pid) = @_;
2270
2271     my $fh = IO::File->new("/proc/$pid/cmdline", "r");
2272     if (defined($fh)) {
2273         my $line = <$fh>;
2274         $fh->close;
2275         return undef if !$line;
2276         my @param = split(/\0/, $line);
2277
2278         my $cmd = $param[0];
2279         return if !$cmd || ($cmd !~ m|kvm$| && $cmd !~ m|qemu-system-x86_64$|);
2280
2281         for (my $i = 0; $i < scalar (@param); $i++) {
2282             my $p = $param[$i];
2283             next if !$p;
2284             if (($p eq '-pidfile') || ($p eq '--pidfile')) {
2285                 my $p = $param[$i+1];
2286                 return 1 if $p && ($p eq $pidfile);
2287                 return undef;
2288             }
2289         }
2290     }
2291     return undef;
2292 }
2293
2294 sub check_running {
2295     my ($vmid, $nocheck, $node) = @_;
2296
2297     my $filename = config_file($vmid, $node);
2298
2299     die "unable to find configuration file for VM $vmid - no such machine\n"
2300         if !$nocheck && ! -f $filename;
2301
2302     my $pidfile = pidfile_name($vmid);
2303
2304     if (my $fd = IO::File->new("<$pidfile")) {
2305         my $st = stat($fd);
2306         my $line = <$fd>;
2307         close($fd);
2308
2309         my $mtime = $st->mtime;
2310         if ($mtime > time()) {
2311             warn "file '$filename' modified in future\n";
2312         }
2313
2314         if ($line =~ m/^(\d+)$/) {
2315             my $pid = $1;
2316             if (check_cmdline($pidfile, $pid)) {
2317                 if (my $pinfo = PVE::ProcFSTools::check_process_running($pid)) {
2318                     return $pid;
2319                 }
2320             }
2321         }
2322     }
2323
2324     return undef;
2325 }
2326
2327 sub vzlist {
2328
2329     my $vzlist = config_list();
2330
2331     my $fd = IO::Dir->new($var_run_tmpdir) || return $vzlist;
2332
2333     while (defined(my $de = $fd->read)) {
2334         next if $de !~ m/^(\d+)\.pid$/;
2335         my $vmid = $1;
2336         next if !defined($vzlist->{$vmid});
2337         if (my $pid = check_running($vmid)) {
2338             $vzlist->{$vmid}->{pid} = $pid;
2339         }
2340     }
2341
2342     return $vzlist;
2343 }
2344
2345 sub disksize {
2346     my ($storecfg, $conf) = @_;
2347
2348     my $bootdisk = $conf->{bootdisk};
2349     return undef if !$bootdisk;
2350     return undef if !valid_drivename($bootdisk);
2351
2352     return undef if !$conf->{$bootdisk};
2353
2354     my $drive = parse_drive($bootdisk, $conf->{$bootdisk});
2355     return undef if !defined($drive);
2356
2357     return undef if drive_is_cdrom($drive);
2358
2359     my $volid = $drive->{file};
2360     return undef if !$volid;
2361
2362     return $drive->{size};
2363 }
2364
2365 my $last_proc_pid_stat;
2366
2367 # get VM status information
2368 # This must be fast and should not block ($full == false)
2369 # We only query KVM using QMP if $full == true (this can be slow)
2370 sub vmstatus {
2371     my ($opt_vmid, $full) = @_;
2372
2373     my $res = {};
2374
2375     my $storecfg = PVE::Storage::config();
2376
2377     my $list = vzlist();
2378     my ($uptime) = PVE::ProcFSTools::read_proc_uptime(1);
2379
2380     my $cpucount = $cpuinfo->{cpus} || 1;
2381
2382     foreach my $vmid (keys %$list) {
2383         next if $opt_vmid && ($vmid ne $opt_vmid);
2384
2385         my $cfspath = cfs_config_path($vmid);
2386         my $conf = PVE::Cluster::cfs_read_file($cfspath) || {};
2387
2388         my $d = {};
2389         $d->{pid} = $list->{$vmid}->{pid};
2390
2391         # fixme: better status?
2392         $d->{status} = $list->{$vmid}->{pid} ? 'running' : 'stopped';
2393
2394         my $size = disksize($storecfg, $conf);
2395         if (defined($size)) {
2396             $d->{disk} = 0; # no info available
2397             $d->{maxdisk} = $size;
2398         } else {
2399             $d->{disk} = 0;
2400             $d->{maxdisk} = 0;
2401         }
2402
2403         $d->{cpus} = ($conf->{sockets} || 1) * ($conf->{cores} || 1);
2404         $d->{cpus} = $cpucount if $d->{cpus} > $cpucount;
2405         $d->{cpus} = $conf->{vcpus} if $conf->{vcpus};
2406
2407         $d->{name} = $conf->{name} || "VM $vmid";
2408         $d->{maxmem} = $conf->{memory} ? $conf->{memory}*(1024*1024) : 0;
2409
2410         if ($conf->{balloon}) {
2411             $d->{balloon_min} = $conf->{balloon}*(1024*1024);
2412             $d->{shares} = defined($conf->{shares}) ? $conf->{shares} : 1000;
2413         }
2414
2415         $d->{uptime} = 0;
2416         $d->{cpu} = 0;
2417         $d->{mem} = 0;
2418
2419         $d->{netout} = 0;
2420         $d->{netin} = 0;
2421
2422         $d->{diskread} = 0;
2423         $d->{diskwrite} = 0;
2424
2425         $d->{template} = is_template($conf);
2426
2427         $res->{$vmid} = $d;
2428     }
2429
2430     my $netdev = PVE::ProcFSTools::read_proc_net_dev();
2431     foreach my $dev (keys %$netdev) {
2432         next if $dev !~ m/^tap([1-9]\d*)i/;
2433         my $vmid = $1;
2434         my $d = $res->{$vmid};
2435         next if !$d;
2436
2437         $d->{netout} += $netdev->{$dev}->{receive};
2438         $d->{netin} += $netdev->{$dev}->{transmit};
2439     }
2440
2441     my $ctime = gettimeofday;
2442
2443     foreach my $vmid (keys %$list) {
2444
2445         my $d = $res->{$vmid};
2446         my $pid = $d->{pid};
2447         next if !$pid;
2448
2449         my $pstat = PVE::ProcFSTools::read_proc_pid_stat($pid);
2450         next if !$pstat; # not running
2451
2452         my $used = $pstat->{utime} + $pstat->{stime};
2453
2454         $d->{uptime} = int(($uptime - $pstat->{starttime})/$cpuinfo->{user_hz});
2455
2456         if ($pstat->{vsize}) {
2457             $d->{mem} = int(($pstat->{rss}/$pstat->{vsize})*$d->{maxmem});
2458         }
2459
2460         my $old = $last_proc_pid_stat->{$pid};
2461         if (!$old) {
2462             $last_proc_pid_stat->{$pid} = {
2463                 time => $ctime,
2464                 used => $used,
2465                 cpu => 0,
2466             };
2467             next;
2468         }
2469
2470         my $dtime = ($ctime -  $old->{time}) * $cpucount * $cpuinfo->{user_hz};
2471
2472         if ($dtime > 1000) {
2473             my $dutime = $used -  $old->{used};
2474
2475             $d->{cpu} = (($dutime/$dtime)* $cpucount) / $d->{cpus};
2476             $last_proc_pid_stat->{$pid} = {
2477                 time => $ctime,
2478                 used => $used,
2479                 cpu => $d->{cpu},
2480             };
2481         } else {
2482             $d->{cpu} = $old->{cpu};
2483         }
2484     }
2485
2486     return $res if !$full;
2487
2488     my $qmpclient = PVE::QMPClient->new();
2489
2490     my $ballooncb = sub {
2491         my ($vmid, $resp) = @_;
2492
2493         my $info = $resp->{'return'};
2494         return if !$info->{max_mem};
2495
2496         my $d = $res->{$vmid};
2497
2498         # use memory assigned to VM
2499         $d->{maxmem} = $info->{max_mem};
2500         $d->{balloon} = $info->{actual};
2501
2502         if (defined($info->{total_mem}) && defined($info->{free_mem})) {
2503             $d->{mem} = $info->{total_mem} - $info->{free_mem};
2504             $d->{freemem} = $info->{free_mem};
2505         }
2506
2507     };
2508
2509     my $blockstatscb = sub {
2510         my ($vmid, $resp) = @_;
2511         my $data = $resp->{'return'} || [];
2512         my $totalrdbytes = 0;
2513         my $totalwrbytes = 0;
2514         for my $blockstat (@$data) {
2515             $totalrdbytes = $totalrdbytes + $blockstat->{stats}->{rd_bytes};
2516             $totalwrbytes = $totalwrbytes + $blockstat->{stats}->{wr_bytes};
2517         }
2518         $res->{$vmid}->{diskread} = $totalrdbytes;
2519         $res->{$vmid}->{diskwrite} = $totalwrbytes;
2520     };
2521
2522     my $statuscb = sub {
2523         my ($vmid, $resp) = @_;
2524
2525         $qmpclient->queue_cmd($vmid, $blockstatscb, 'query-blockstats');
2526         # this fails if ballon driver is not loaded, so this must be
2527         # the last commnand (following command are aborted if this fails).
2528         $qmpclient->queue_cmd($vmid, $ballooncb, 'query-balloon');
2529
2530         my $status = 'unknown';
2531         if (!defined($status = $resp->{'return'}->{status})) {
2532             warn "unable to get VM status\n";
2533             return;
2534         }
2535
2536         $res->{$vmid}->{qmpstatus} = $resp->{'return'}->{status};
2537     };
2538
2539     foreach my $vmid (keys %$list) {
2540         next if $opt_vmid && ($vmid ne $opt_vmid);
2541         next if !$res->{$vmid}->{pid}; # not running
2542         $qmpclient->queue_cmd($vmid, $statuscb, 'query-status');
2543     }
2544
2545     $qmpclient->queue_execute(undef, 1);
2546
2547     foreach my $vmid (keys %$list) {
2548         next if $opt_vmid && ($vmid ne $opt_vmid);
2549         $res->{$vmid}->{qmpstatus} = $res->{$vmid}->{status} if !$res->{$vmid}->{qmpstatus};
2550     }
2551
2552     return $res;
2553 }
2554
2555 sub foreach_dimm {
2556     my ($conf, $vmid, $memory, $sockets, $func) = @_;
2557
2558     my $dimm_id = 0;
2559     my $current_size = 1024;
2560     my $dimm_size = 512;
2561     return if $current_size == $memory;
2562
2563     for (my $j = 0; $j < 8; $j++) {
2564         for (my $i = 0; $i < 32; $i++) {
2565             my $name = "dimm${dimm_id}";
2566             $dimm_id++;
2567             my $numanode = $i % $sockets;
2568             $current_size += $dimm_size;
2569             &$func($conf, $vmid, $name, $dimm_size, $numanode, $current_size, $memory);
2570             return  $current_size if $current_size >= $memory;
2571         }
2572         $dimm_size *= 2;
2573     }
2574 }
2575
2576 sub foreach_drive {
2577     my ($conf, $func) = @_;
2578
2579     foreach my $ds (keys %$conf) {
2580         next if !valid_drivename($ds);
2581
2582         my $drive = parse_drive($ds, $conf->{$ds});
2583         next if !$drive;
2584
2585         &$func($ds, $drive);
2586     }
2587 }
2588
2589 sub foreach_volid {
2590     my ($conf, $func) = @_;
2591
2592     my $volhash = {};
2593
2594     my $test_volid = sub {
2595         my ($volid, $is_cdrom) = @_;
2596
2597         return if !$volid;
2598
2599         $volhash->{$volid} = $is_cdrom || 0;
2600     };
2601
2602     foreach_drive($conf, sub {
2603         my ($ds, $drive) = @_;
2604         &$test_volid($drive->{file}, drive_is_cdrom($drive));
2605     });
2606
2607     foreach my $snapname (keys %{$conf->{snapshots}}) {
2608         my $snap = $conf->{snapshots}->{$snapname};
2609         &$test_volid($snap->{vmstate}, 0);
2610         foreach_drive($snap, sub {
2611             my ($ds, $drive) = @_;
2612             &$test_volid($drive->{file}, drive_is_cdrom($drive));
2613         });
2614     }
2615
2616     foreach my $volid (keys %$volhash) {
2617         &$func($volid, $volhash->{$volid});
2618     }
2619 }
2620
2621 sub vga_conf_has_spice {
2622     my ($vga) = @_;
2623
2624     return 0 if !$vga || $vga !~ m/^qxl([234])?$/;
2625
2626     return $1 || 1;
2627 }
2628
2629 sub config_to_command {
2630     my ($storecfg, $vmid, $conf, $defaults, $forcemachine) = @_;
2631
2632     my $cmd = [];
2633     my $globalFlags = [];
2634     my $machineFlags = [];
2635     my $rtcFlags = [];
2636     my $cpuFlags = [];
2637     my $devices = [];
2638     my $pciaddr = '';
2639     my $bridges = {};
2640     my $kvmver = kvm_user_version();
2641     my $vernum = 0; # unknown
2642     if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
2643         $vernum = $1*1000000+$2*1000;
2644     } elsif ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
2645         $vernum = $1*1000000+$2*1000+$3;
2646     }
2647
2648     die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 15000;
2649
2650     my $have_ovz = -f '/proc/vz/vestat';
2651
2652     my $q35 = machine_type_is_q35($conf);
2653     my $hotplug_features = parse_hotplug_features(defined($conf->{hotplug}) ? $conf->{hotplug} : '1');
2654     my $machine_type = $forcemachine || $conf->{machine};
2655
2656     push @$cmd, '/usr/bin/kvm';
2657
2658     push @$cmd, '-id', $vmid;
2659
2660     my $use_virtio = 0;
2661
2662     my $qmpsocket = qmp_socket($vmid);
2663     push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
2664     push @$cmd, '-mon', "chardev=qmp,mode=control";
2665
2666     my $socket = vnc_socket($vmid);
2667     push @$cmd,  '-vnc', "unix:$socket,x509,password";
2668
2669     push @$cmd, '-pidfile' , pidfile_name($vmid);
2670
2671     push @$cmd, '-daemonize';
2672
2673     if ($conf->{smbios1}) {
2674         push @$cmd, '-smbios', "type=1,$conf->{smbios1}";
2675     }
2676
2677     push @$cmd, '-object', "iothread,id=iothread0" if $conf->{iothread};
2678
2679     if ($q35) {
2680         # the q35 chipset support native usb2, so we enable usb controller
2681         # by default for this machine type
2682         push @$devices, '-readconfig', '/usr/share/qemu-server/pve-q35.cfg';
2683     } else {
2684         $pciaddr = print_pci_addr("piix3", $bridges);
2685         push @$devices, '-device', "piix3-usb-uhci,id=uhci$pciaddr.0x2";
2686
2687         my $use_usb2 = 0;
2688         for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
2689             next if !$conf->{"usb$i"};
2690             $use_usb2 = 1;
2691         }
2692         # include usb device config
2693         push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
2694     }
2695
2696     my $vga = $conf->{vga};
2697
2698     my $qxlnum = vga_conf_has_spice($vga);
2699     $vga = 'qxl' if $qxlnum;
2700
2701     if (!$vga) {
2702         if ($conf->{ostype} && ($conf->{ostype} eq 'win8' ||
2703                                 $conf->{ostype} eq 'win7' ||
2704                                 $conf->{ostype} eq 'w2k8')) {
2705             $vga = 'std';
2706         } else {
2707             $vga = 'cirrus';
2708         }
2709     }
2710
2711     # enable absolute mouse coordinates (needed by vnc)
2712     my $tablet;
2713     if (defined($conf->{tablet})) {
2714         $tablet = $conf->{tablet};
2715     } else {
2716         $tablet = $defaults->{tablet};
2717         $tablet = 0 if $qxlnum; # disable for spice because it is not needed
2718         $tablet = 0 if $vga =~ m/^serial\d+$/; # disable if we use serial terminal (no vga card)
2719     }
2720
2721     push @$devices, '-device', print_tabletdevice_full($conf) if $tablet;
2722
2723     # host pci devices
2724     for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
2725         my $d = parse_hostpci($conf->{"hostpci$i"});
2726         next if !$d;
2727
2728         my $pcie = $d->{pcie};
2729         if($pcie){
2730             die "q35 machine model is not enabled" if !$q35;
2731             $pciaddr = print_pcie_addr("hostpci$i");
2732         }else{
2733             $pciaddr = print_pci_addr("hostpci$i", $bridges);
2734         }
2735
2736         my $rombar = $d->{rombar} && $d->{rombar} eq 'off' ? ",rombar=0" : "";
2737         my $driver = $d->{driver} && $d->{driver} eq 'vfio' ? "vfio-pci" : "pci-assign";
2738         my $xvga = $d->{'x-vga'} && $d->{'x-vga'} eq 'on' ? ",x-vga=on" : "";
2739         if ($xvga && $xvga ne '') {
2740             push @$cpuFlags, 'kvm=off';
2741             $vga = 'none';
2742         }
2743         $driver = "vfio-pci" if $xvga ne '';
2744         my $pcidevices = $d->{pciid};
2745         my $multifunction = 1 if @$pcidevices > 1;
2746
2747         my $j=0;
2748         foreach my $pcidevice (@$pcidevices) {
2749
2750             my $id = "hostpci$i";
2751             $id .= ".$j" if $multifunction;
2752             my $addr = $pciaddr;
2753             $addr .= ".$j" if $multifunction;
2754             my $devicestr = "$driver,host=$pcidevice->{id}.$pcidevice->{function},id=$id$addr";
2755
2756             if($j == 0){
2757                 $devicestr .= "$rombar$xvga";
2758                 $devicestr .= ",multifunction=on" if $multifunction;
2759             }
2760
2761             push @$devices, '-device', $devicestr;
2762             $j++;
2763         }
2764     }
2765
2766     # usb devices
2767     for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
2768         my $d = parse_usb_device($conf->{"usb$i"});
2769         next if !$d;
2770         if ($d->{vendorid} && $d->{productid}) {
2771             push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2772         } elsif (defined($d->{hostbus}) && defined($d->{hostport})) {
2773             push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2774         } elsif ($d->{spice}) {
2775             # usb redir support for spice
2776             push @$devices, '-chardev', "spicevmc,id=usbredirchardev$i,name=usbredir";
2777             push @$devices, '-device', "usb-redir,chardev=usbredirchardev$i,id=usbredirdev$i,bus=ehci.0";
2778         }
2779     }
2780
2781     # serial devices
2782     for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++)  {
2783         if (my $path = $conf->{"serial$i"}) {
2784             if ($path eq 'socket') {
2785                 my $socket = "/var/run/qemu-server/${vmid}.serial$i";
2786                 push @$devices, '-chardev', "socket,id=serial$i,path=$socket,server,nowait";
2787                 push @$devices, '-device', "isa-serial,chardev=serial$i";
2788             } else {
2789                 die "no such serial device\n" if ! -c $path;
2790                 push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2791                 push @$devices, '-device', "isa-serial,chardev=serial$i";
2792             }
2793         }
2794     }
2795
2796     # parallel devices
2797     for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++)  {
2798         if (my $path = $conf->{"parallel$i"}) {
2799             die "no such parallel device\n" if ! -c $path;
2800             my $devtype = $path =~ m!^/dev/usb/lp! ? 'tty' : 'parport';
2801             push @$devices, '-chardev', "$devtype,id=parallel$i,path=$path";
2802             push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2803         }
2804     }
2805
2806     my $vmname = $conf->{name} || "vm$vmid";
2807
2808     push @$cmd, '-name', $vmname;
2809
2810     my $sockets = 1;
2811     $sockets = $conf->{smp} if $conf->{smp}; # old style - no longer iused
2812     $sockets = $conf->{sockets} if  $conf->{sockets};
2813
2814     my $cores = $conf->{cores} || 1;
2815
2816     my $maxcpus = $sockets * $cores;
2817
2818     my $vcpus = $conf->{vcpus} ? $conf->{vcpus} : $maxcpus;
2819
2820     my $allowed_vcpus = $cpuinfo->{cpus};
2821
2822     die "MAX $maxcpus vcpus allowed per VM on this node\n"
2823         if ($allowed_vcpus < $maxcpus);
2824
2825     push @$cmd, '-smp', "$vcpus,sockets=$sockets,cores=$cores,maxcpus=$maxcpus";
2826
2827     push @$cmd, '-nodefaults';
2828
2829     my $bootorder = $conf->{boot} || $confdesc->{boot}->{default};
2830
2831     my $bootindex_hash = {};
2832     my $i = 1;
2833     foreach my $o (split(//, $bootorder)) {
2834         $bootindex_hash->{$o} = $i*100;
2835         $i++;
2836     }
2837
2838     push @$cmd, '-boot', "menu=on,strict=on,reboot-timeout=1000";
2839
2840     push @$cmd, '-no-acpi' if defined($conf->{acpi}) && $conf->{acpi} == 0;
2841
2842     push @$cmd, '-no-reboot' if  defined($conf->{reboot}) && $conf->{reboot} == 0;
2843
2844     push @$cmd, '-vga', $vga if $vga && $vga !~ m/^serial\d+$/; # for kvm 77 and later
2845
2846     # time drift fix
2847     my $tdf = defined($conf->{tdf}) ? $conf->{tdf} : $defaults->{tdf};
2848
2849     my $nokvm = defined($conf->{kvm}) && $conf->{kvm} == 0 ? 1 : 0;
2850     my $useLocaltime = $conf->{localtime};
2851
2852     if (my $ost = $conf->{ostype}) {
2853         # other, wxp, w2k, w2k3, w2k8, wvista, win7, win8, l24, l26, solaris
2854
2855         if ($ost =~ m/^w/) { # windows
2856             $useLocaltime = 1 if !defined($conf->{localtime});
2857
2858             # use time drift fix when acpi is enabled
2859             if (!(defined($conf->{acpi}) && $conf->{acpi} == 0)) {
2860                 $tdf = 1 if !defined($conf->{tdf});
2861             }
2862         }
2863
2864         if ($ost eq 'win7' || $ost eq 'win8' || $ost eq 'w2k8' ||
2865             $ost eq 'wvista') {
2866             push @$globalFlags, 'kvm-pit.lost_tick_policy=discard';
2867             push @$cmd, '-no-hpet';
2868             if (qemu_machine_feature_enabled ($machine_type, $kvmver, 2, 3)) {
2869                 push @$cpuFlags , 'hv_spinlocks=0x1fff' if !$nokvm;
2870                 push @$cpuFlags , 'hv_vapic' if !$nokvm;
2871                 push @$cpuFlags , 'hv_time' if !$nokvm;
2872
2873             } else {
2874                 push @$cpuFlags , 'hv_spinlocks=0xffff' if !$nokvm;
2875             }
2876         }
2877
2878         if ($ost eq 'win7' || $ost eq 'win8') {
2879             push @$cpuFlags , 'hv_relaxed' if !$nokvm;
2880         }
2881     }
2882
2883     push @$rtcFlags, 'driftfix=slew' if $tdf;
2884
2885     if ($nokvm) {
2886         push @$machineFlags, 'accel=tcg';
2887     } else {
2888         die "No accelerator found!\n" if !$cpuinfo->{hvm};
2889     }
2890
2891     if ($machine_type) {
2892         push @$machineFlags, "type=${machine_type}";
2893     }
2894
2895     if ($conf->{startdate}) {
2896         push @$rtcFlags, "base=$conf->{startdate}";
2897     } elsif ($useLocaltime) {
2898         push @$rtcFlags, 'base=localtime';
2899     }
2900
2901     my $cpu = $nokvm ? "qemu64" : "kvm64";
2902     $cpu = $conf->{cpu} if $conf->{cpu};
2903
2904     push @$cpuFlags , '+lahf_lm' if $cpu eq 'kvm64';
2905
2906     push @$cpuFlags , '+x2apic' if !$nokvm && $conf->{ostype} ne 'solaris';
2907
2908     push @$cpuFlags , '-x2apic' if $conf->{ostype} eq 'solaris';
2909
2910     push @$cpuFlags, '+sep' if $cpu eq 'kvm64' || $cpu eq 'kvm32';
2911
2912     $cpu .= "," . join(',', @$cpuFlags) if scalar(@$cpuFlags);
2913
2914     # Note: enforce needs kernel 3.10, so we do not use it for now
2915     # push @$cmd, '-cpu', "$cpu,enforce";
2916     push @$cmd, '-cpu', $cpu;
2917
2918     my $memory = $conf->{memory} || $defaults->{memory};
2919     my $static_memory = 0;
2920     my $dimm_memory = 0;
2921
2922     if ($hotplug_features->{memory}) {
2923         die "Numa need to be enabled for memory hotplug\n" if !$conf->{numa};
2924         die "Total memory is bigger than ${MAX_MEM}MB\n" if $memory > $MAX_MEM;
2925         $static_memory = $STATICMEM;
2926         die "minimum memory must be ${static_memory}MB\n" if($memory < $static_memory);
2927         $dimm_memory = $memory - $static_memory;
2928         push @$cmd, '-m', "size=${static_memory},slots=255,maxmem=${MAX_MEM}M";
2929
2930     } else {
2931
2932         $static_memory = $memory;
2933         push @$cmd, '-m', $static_memory;
2934     }
2935
2936     if ($conf->{numa}) {
2937
2938         my $numa_totalmemory = undef;
2939         for (my $i = 0; $i < $MAX_NUMA; $i++) {
2940             next if !$conf->{"numa$i"};
2941             my $numa = parse_numa($conf->{"numa$i"});
2942             next if !$numa;
2943             # memory
2944             die "missing numa node$i memory value\n" if !$numa->{memory};
2945             my $numa_memory = $numa->{memory};
2946             $numa_totalmemory += $numa_memory;
2947             my $numa_object = "memory-backend-ram,id=ram-node$i,size=${numa_memory}M";
2948
2949             # cpus
2950             my $cpus_start = $numa->{cpus}->{start};
2951             die "missing numa node$i cpus\n" if !defined($cpus_start);
2952             my $cpus_end = $numa->{cpus}->{end} if defined($numa->{cpus}->{end});
2953             my $cpus = $cpus_start;
2954             if (defined($cpus_end)) {
2955                 $cpus .= "-$cpus_end";
2956                 die "numa node$i :  cpu range $cpus is incorrect\n" if $cpus_end <= $cpus_start;
2957             }
2958
2959             # hostnodes
2960             my $hostnodes_start = $numa->{hostnodes}->{start};
2961             if (defined($hostnodes_start)) {
2962                 my $hostnodes_end = $numa->{hostnodes}->{end} if defined($numa->{hostnodes}->{end});
2963                 my $hostnodes = $hostnodes_start;
2964                 if (defined($hostnodes_end)) {
2965                     $hostnodes .= "-$hostnodes_end";
2966                     die "host node $hostnodes range is incorrect\n" if $hostnodes_end <= $hostnodes_start;
2967                 }
2968
2969                 my $hostnodes_end_range = defined($hostnodes_end) ? $hostnodes_end : $hostnodes_start;
2970                 for (my $i = $hostnodes_start; $i <= $hostnodes_end_range; $i++ ) {
2971                     die "host numa node$i don't exist\n" if ! -d "/sys/devices/system/node/node$i/";
2972                 }
2973
2974                 # policy
2975                 my $policy = $numa->{policy};
2976                 die "you need to define a policy for hostnode $hostnodes\n" if !$policy;
2977                 $numa_object .= ",host-nodes=$hostnodes,policy=$policy";
2978             }
2979
2980             push @$cmd, '-object', $numa_object;
2981             push @$cmd, '-numa', "node,nodeid=$i,cpus=$cpus,memdev=ram-node$i";
2982         }
2983
2984         die "total memory for NUMA nodes must be equal to vm static memory\n"
2985             if $numa_totalmemory && $numa_totalmemory != $static_memory;
2986
2987         #if no custom tology, we split memory and cores across numa nodes
2988         if(!$numa_totalmemory) {
2989
2990             my $numa_memory = ($static_memory / $sockets) . "M";
2991
2992             for (my $i = 0; $i < $sockets; $i++)  {
2993
2994                 my $cpustart = ($cores * $i);
2995                 my $cpuend = ($cpustart + $cores - 1) if $cores && $cores > 1;
2996                 my $cpus = $cpustart;
2997                 $cpus .= "-$cpuend" if $cpuend;
2998
2999                 push @$cmd, '-object', "memory-backend-ram,size=$numa_memory,id=ram-node$i";
3000                 push @$cmd, '-numa', "node,nodeid=$i,cpus=$cpus,memdev=ram-node$i";
3001             }
3002         }
3003     }
3004
3005     if ($hotplug_features->{memory}) {
3006         foreach_dimm($conf, $vmid, $memory, $sockets, sub {
3007             my ($conf, $vmid, $name, $dimm_size, $numanode, $current_size, $memory) = @_;
3008             push @$cmd, "-object" , "memory-backend-ram,id=mem-$name,size=${dimm_size}M";
3009             push @$cmd, "-device", "pc-dimm,id=$name,memdev=mem-$name,node=$numanode";
3010
3011             #if dimm_memory is not aligned to dimm map
3012             if($current_size > $memory) {
3013                  $conf->{memory} = $current_size;
3014                  update_config_nolock($vmid, $conf, 1);
3015             }
3016         });
3017     }
3018
3019     push @$cmd, '-S' if $conf->{freeze};
3020
3021     # set keyboard layout
3022     my $kb = $conf->{keyboard} || $defaults->{keyboard};
3023     push @$cmd, '-k', $kb if $kb;
3024
3025     # enable sound
3026     #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
3027     #push @$cmd, '-soundhw', 'es1370';
3028     #push @$cmd, '-soundhw', $soundhw if $soundhw;
3029
3030     if($conf->{agent}) {
3031         my $qgasocket = qmp_socket($vmid, 1);
3032         my $pciaddr = print_pci_addr("qga0", $bridges);
3033         push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
3034         push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
3035         push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
3036     }
3037
3038     my $spice_port;
3039
3040     if ($qxlnum) {
3041         if ($qxlnum > 1) {
3042             if ($conf->{ostype} && $conf->{ostype} =~ m/^w/){
3043                 for(my $i = 1; $i < $qxlnum; $i++){
3044                     my $pciaddr = print_pci_addr("vga$i", $bridges);
3045                     push @$cmd, '-device', "qxl,id=vga$i,ram_size=67108864,vram_size=33554432$pciaddr";
3046                 }
3047             } else {
3048                 # assume other OS works like Linux
3049                 push @$cmd, '-global', 'qxl-vga.ram_size=134217728';
3050                 push @$cmd, '-global', 'qxl-vga.vram_size=67108864';
3051             }
3052         }
3053
3054         my $pciaddr = print_pci_addr("spice", $bridges);
3055
3056         $spice_port = PVE::Tools::next_spice_port();
3057
3058         push @$devices, '-spice', "tls-port=${spice_port},addr=127.0.0.1,tls-ciphers=DES-CBC3-SHA,seamless-migration=on";
3059
3060         push @$devices, '-device', "virtio-serial,id=spice$pciaddr";
3061         push @$devices, '-chardev', "spicevmc,id=vdagent,name=vdagent";
3062         push @$devices, '-device', "virtserialport,chardev=vdagent,name=com.redhat.spice.0";
3063     }
3064
3065     # enable balloon by default, unless explicitly disabled
3066     if (!defined($conf->{balloon}) || $conf->{balloon}) {
3067         $pciaddr = print_pci_addr("balloon0", $bridges);
3068         push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr";
3069     }
3070
3071     if ($conf->{watchdog}) {
3072         my $wdopts = parse_watchdog($conf->{watchdog});
3073         $pciaddr = print_pci_addr("watchdog", $bridges);
3074         my $watchdog = $wdopts->{model} || 'i6300esb';
3075         push @$devices, '-device', "$watchdog$pciaddr";
3076         push @$devices, '-watchdog-action', $wdopts->{action} if $wdopts->{action};
3077     }
3078
3079     my $vollist = [];
3080     my $scsicontroller = {};
3081     my $ahcicontroller = {};
3082     my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : $defaults->{scsihw};
3083
3084     # Add iscsi initiator name if available
3085     if (my $initiator = get_initiator_name()) {
3086         push @$devices, '-iscsi', "initiator-name=$initiator";
3087     }
3088
3089     foreach_drive($conf, sub {
3090         my ($ds, $drive) = @_;
3091
3092         if (PVE::Storage::parse_volume_id($drive->{file}, 1)) {
3093             push @$vollist, $drive->{file};
3094         }
3095
3096         $use_virtio = 1 if $ds =~ m/^virtio/;
3097
3098         if (drive_is_cdrom ($drive)) {
3099             if ($bootindex_hash->{d}) {
3100                 $drive->{bootindex} = $bootindex_hash->{d};
3101                 $bootindex_hash->{d} += 1;
3102             }
3103         } else {
3104             if ($bootindex_hash->{c}) {
3105                 $drive->{bootindex} = $bootindex_hash->{c} if $conf->{bootdisk} && ($conf->{bootdisk} eq $ds);
3106                 $bootindex_hash->{c} += 1;
3107             }
3108         }
3109
3110         if ($drive->{interface} eq 'scsi') {
3111
3112             my $maxdev = ($scsihw !~ m/^lsi/) ? 256 : 7;
3113             my $controller = int($drive->{index} / $maxdev);
3114             $pciaddr = print_pci_addr("scsihw$controller", $bridges);
3115             push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
3116             $scsicontroller->{$controller}=1;
3117         }
3118
3119         if ($drive->{interface} eq 'sata') {
3120            my $controller = int($drive->{index} / $MAX_SATA_DISKS);
3121            $pciaddr = print_pci_addr("ahci$controller", $bridges);
3122            push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
3123            $ahcicontroller->{$controller}=1;
3124         }
3125
3126         my $drive_cmd = print_drive_full($storecfg, $vmid, $drive);
3127         push @$devices, '-drive',$drive_cmd;
3128         push @$devices, '-device', print_drivedevice_full($storecfg, $conf, $vmid, $drive, $bridges);
3129     });
3130
3131     for (my $i = 0; $i < $MAX_NETS; $i++) {
3132          next if !$conf->{"net$i"};
3133          my $d = parse_net($conf->{"net$i"});
3134          next if !$d;
3135
3136          $use_virtio = 1 if $d->{model} eq 'virtio';
3137
3138          if ($bootindex_hash->{n}) {
3139             $d->{bootindex} = $bootindex_hash->{n};
3140             $bootindex_hash->{n} += 1;
3141          }
3142
3143          my $netdevfull = print_netdev_full($vmid,$conf,$d,"net$i");
3144          push @$devices, '-netdev', $netdevfull;
3145
3146          my $netdevicefull = print_netdevice_full($vmid,$conf,$d,"net$i",$bridges);
3147          push @$devices, '-device', $netdevicefull;
3148     }
3149
3150     if (!$q35) {
3151         # add pci bridges
3152         while (my ($k, $v) = each %$bridges) {
3153             $pciaddr = print_pci_addr("pci.$k");
3154             unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
3155         }
3156     }
3157
3158     # hack: virtio with fairsched is unreliable, so we do not use fairsched
3159     # when the VM uses virtio devices.
3160     if (!$use_virtio && $have_ovz) {
3161
3162         my $cpuunits = defined($conf->{cpuunits}) ?
3163             $conf->{cpuunits} : $defaults->{cpuunits};
3164
3165         push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
3166
3167         # fixme: cpulimit is currently ignored
3168         #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
3169     }
3170
3171     # add custom args
3172     if ($conf->{args}) {
3173         my $aa = PVE::Tools::split_args($conf->{args});
3174         push @$cmd, @$aa;
3175     }
3176
3177     push @$cmd, @$devices;
3178     push @$cmd, '-rtc', join(',', @$rtcFlags)
3179         if scalar(@$rtcFlags);
3180     push @$cmd, '-machine', join(',', @$machineFlags)
3181         if scalar(@$machineFlags);
3182     push @$cmd, '-global', join(',', @$globalFlags)
3183         if scalar(@$globalFlags);
3184
3185     return wantarray ? ($cmd, $vollist, $spice_port) : $cmd;
3186 }
3187
3188 sub vnc_socket {
3189     my ($vmid) = @_;
3190     return "${var_run_tmpdir}/$vmid.vnc";
3191 }
3192
3193 sub spice_port {
3194     my ($vmid) = @_;
3195
3196     my $res = vm_mon_cmd($vmid, 'query-spice');
3197
3198     return $res->{'tls-port'} || $res->{'port'} || die "no spice port\n";
3199 }
3200
3201 sub qmp_socket {
3202     my ($vmid, $qga) = @_;
3203     my $sockettype = $qga ? 'qga' : 'qmp';
3204     return "${var_run_tmpdir}/$vmid.$sockettype";
3205 }
3206
3207 sub pidfile_name {
3208     my ($vmid) = @_;
3209     return "${var_run_tmpdir}/$vmid.pid";
3210 }
3211
3212 sub vm_devices_list {
3213     my ($vmid) = @_;
3214
3215     my $res = vm_mon_cmd($vmid, 'query-pci');
3216     my $devices = {};
3217     foreach my $pcibus (@$res) {
3218         foreach my $device (@{$pcibus->{devices}}) {
3219             next if !$device->{'qdev_id'};
3220             if ($device->{'pci_bridge'}) {
3221                 $devices->{$device->{'qdev_id'}} = 1;
3222                 foreach my $bridge_device (@{$device->{'pci_bridge'}->{devices}}) {
3223                     next if !$bridge_device->{'qdev_id'};
3224                     $devices->{$bridge_device->{'qdev_id'}} = 1;
3225                     $devices->{$device->{'qdev_id'}}++;
3226                 }
3227             } else {
3228                 $devices->{$device->{'qdev_id'}} = 1;
3229             }
3230         }
3231     }
3232
3233     my $resblock = vm_mon_cmd($vmid, 'query-block');
3234     foreach my $block (@$resblock) {
3235         if($block->{device} =~ m/^drive-(\S+)/){
3236                 $devices->{$1} = 1;
3237         }
3238     }
3239
3240     my $resmice = vm_mon_cmd($vmid, 'query-mice');
3241     foreach my $mice (@$resmice) {
3242         if ($mice->{name} eq 'QEMU HID Tablet') {
3243             $devices->{tablet} = 1;
3244             last;
3245         }
3246     }
3247
3248     return $devices;
3249 }
3250
3251 sub vm_deviceplug {
3252     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
3253
3254     my $q35 = machine_type_is_q35($conf);
3255
3256     my $devices_list = vm_devices_list($vmid);
3257     return 1 if defined($devices_list->{$deviceid});
3258
3259     qemu_add_pci_bridge($storecfg, $conf, $vmid, $deviceid); # add PCI bridge if we need it for the device
3260
3261     if ($deviceid eq 'tablet') {
3262
3263         qemu_deviceadd($vmid, print_tabletdevice_full($conf));
3264
3265     } elsif ($deviceid =~ m/^(virtio)(\d+)$/) {
3266
3267         qemu_driveadd($storecfg, $vmid, $device);
3268         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
3269
3270         qemu_deviceadd($vmid, $devicefull);
3271         eval { qemu_deviceaddverify($vmid, $deviceid); };
3272         if (my $err = $@) {
3273             eval { qemu_drivedel($vmid, $deviceid); };
3274             warn $@ if $@;
3275             die $err;
3276         }
3277
3278     } elsif ($deviceid =~ m/^(scsihw)(\d+)$/) {
3279
3280         my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : "lsi";
3281         my $pciaddr = print_pci_addr($deviceid);
3282         my $devicefull = "$scsihw,id=$deviceid$pciaddr";
3283
3284         qemu_deviceadd($vmid, $devicefull);
3285         qemu_deviceaddverify($vmid, $deviceid);
3286
3287     } elsif ($deviceid =~ m/^(scsi)(\d+)$/) {
3288
3289         qemu_findorcreatescsihw($storecfg,$conf, $vmid, $device);
3290         qemu_driveadd($storecfg, $vmid, $device);
3291
3292         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
3293         eval { qemu_deviceadd($vmid, $devicefull); };
3294         if (my $err = $@) {
3295             eval { qemu_drivedel($vmid, $deviceid); };
3296             warn $@ if $@;
3297             die $err;
3298         }
3299
3300     } elsif ($deviceid =~ m/^(net)(\d+)$/) {
3301
3302         return undef if !qemu_netdevadd($vmid, $conf, $device, $deviceid);
3303         my $netdevicefull = print_netdevice_full($vmid, $conf, $device, $deviceid);
3304         qemu_deviceadd($vmid, $netdevicefull);
3305         eval { qemu_deviceaddverify($vmid, $deviceid); };
3306         if (my $err = $@) {
3307             eval { qemu_netdevdel($vmid, $deviceid); };
3308             warn $@ if $@;
3309             die $err;
3310         }
3311
3312     } elsif (!$q35 && $deviceid =~ m/^(pci\.)(\d+)$/) {
3313
3314         my $bridgeid = $2;
3315         my $pciaddr = print_pci_addr($deviceid);
3316         my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
3317
3318         qemu_deviceadd($vmid, $devicefull);
3319         qemu_deviceaddverify($vmid, $deviceid);
3320
3321     } else {
3322         die "can't hotplug device '$deviceid'\n";
3323     }
3324
3325     return 1;
3326 }
3327
3328 # fixme: this should raise exceptions on error!
3329 sub vm_deviceunplug {
3330     my ($vmid, $conf, $deviceid) = @_;
3331
3332     my $devices_list = vm_devices_list($vmid);
3333     return 1 if !defined($devices_list->{$deviceid});
3334
3335     die "can't unplug bootdisk" if $conf->{bootdisk} && $conf->{bootdisk} eq $deviceid;
3336
3337     if ($deviceid eq 'tablet') {
3338
3339         qemu_devicedel($vmid, $deviceid);
3340
3341     } elsif ($deviceid =~ m/^(virtio)(\d+)$/) {
3342
3343         qemu_devicedel($vmid, $deviceid);
3344         qemu_devicedelverify($vmid, $deviceid);
3345         qemu_drivedel($vmid, $deviceid);
3346
3347     } elsif ($deviceid =~ m/^(lsi)(\d+)$/) {
3348
3349         qemu_devicedel($vmid, $deviceid);
3350
3351     } elsif ($deviceid =~ m/^(scsi)(\d+)$/) {
3352
3353         qemu_devicedel($vmid, $deviceid);
3354         qemu_drivedel($vmid, $deviceid);
3355
3356     } elsif ($deviceid =~ m/^(net)(\d+)$/) {
3357
3358         qemu_devicedel($vmid, $deviceid);
3359         qemu_devicedelverify($vmid, $deviceid);
3360         qemu_netdevdel($vmid, $deviceid);
3361
3362     } else {
3363         die "can't unplug device '$deviceid'\n";
3364     }
3365
3366     return 1;
3367 }
3368
3369 sub qemu_deviceadd {
3370     my ($vmid, $devicefull) = @_;
3371
3372     $devicefull = "driver=".$devicefull;
3373     my %options =  split(/[=,]/, $devicefull);
3374
3375     vm_mon_cmd($vmid, "device_add" , %options);
3376 }
3377
3378 sub qemu_devicedel {
3379     my ($vmid, $deviceid) = @_;
3380
3381     my $ret = vm_mon_cmd($vmid, "device_del", id => $deviceid);
3382 }
3383
3384 sub qemu_objectadd {
3385     my($vmid, $objectid, $qomtype) = @_;
3386
3387     vm_mon_cmd($vmid, "object-add", id => $objectid, "qom-type" => $qomtype);
3388
3389     return 1;
3390 }
3391
3392 sub qemu_objectdel {
3393     my($vmid, $objectid) = @_;
3394
3395     vm_mon_cmd($vmid, "object-del", id => $objectid);
3396
3397     return 1;
3398 }
3399
3400 sub qemu_driveadd {
3401     my ($storecfg, $vmid, $device) = @_;
3402
3403     my $drive = print_drive_full($storecfg, $vmid, $device);
3404     $drive =~ s/\\/\\\\/g;
3405     my $ret = vm_human_monitor_command($vmid, "drive_add auto \"$drive\"");
3406
3407     # If the command succeeds qemu prints: "OK"
3408     return 1 if $ret =~ m/OK/s;
3409
3410     die "adding drive failed: $ret\n";
3411 }
3412
3413 sub qemu_drivedel {
3414     my($vmid, $deviceid) = @_;
3415
3416     my $ret = vm_human_monitor_command($vmid, "drive_del drive-$deviceid");
3417     $ret =~ s/^\s+//;
3418
3419     return 1 if $ret eq "";
3420
3421     # NB: device not found errors mean the drive was auto-deleted and we ignore the error
3422     return 1 if $ret =~ m/Device \'.*?\' not found/s;
3423
3424     die "deleting drive $deviceid failed : $ret\n";
3425 }
3426
3427 sub qemu_deviceaddverify {
3428     my ($vmid, $deviceid) = @_;
3429
3430     for (my $i = 0; $i <= 5; $i++) {
3431          my $devices_list = vm_devices_list($vmid);
3432          return 1 if defined($devices_list->{$deviceid});
3433          sleep 1;
3434     }
3435
3436     die "error on hotplug device '$deviceid'\n";
3437 }
3438
3439
3440 sub qemu_devicedelverify {
3441     my ($vmid, $deviceid) = @_;
3442
3443     # need to verify that the device is correctly removed as device_del
3444     # is async and empty return is not reliable
3445
3446     for (my $i = 0; $i <= 5; $i++) {
3447          my $devices_list = vm_devices_list($vmid);
3448          return 1 if !defined($devices_list->{$deviceid});
3449          sleep 1;
3450     }
3451
3452     die "error on hot-unplugging device '$deviceid'\n";
3453 }
3454
3455 sub qemu_findorcreatescsihw {
3456     my ($storecfg, $conf, $vmid, $device) = @_;
3457
3458     my $maxdev = ($conf->{scsihw} && ($conf->{scsihw} !~ m/^lsi/)) ? 256 : 7;
3459     my $controller = int($device->{index} / $maxdev);
3460     my $scsihwid="scsihw$controller";
3461     my $devices_list = vm_devices_list($vmid);
3462
3463     if(!defined($devices_list->{$scsihwid})) {
3464         vm_deviceplug($storecfg, $conf, $vmid, $scsihwid);
3465     }
3466
3467     return 1;
3468 }
3469
3470 sub qemu_add_pci_bridge {
3471     my ($storecfg, $conf, $vmid, $device) = @_;
3472
3473     my $bridges = {};
3474
3475     my $bridgeid;
3476
3477     print_pci_addr($device, $bridges);
3478
3479     while (my ($k, $v) = each %$bridges) {
3480         $bridgeid = $k;
3481     }
3482     return 1 if !defined($bridgeid) || $bridgeid < 1;
3483
3484     my $bridge = "pci.$bridgeid";
3485     my $devices_list = vm_devices_list($vmid);
3486
3487     if (!defined($devices_list->{$bridge})) {
3488         vm_deviceplug($storecfg, $conf, $vmid, $bridge);
3489     }
3490
3491     return 1;
3492 }
3493
3494 sub qemu_set_link_status {
3495     my ($vmid, $device, $up) = @_;
3496
3497     vm_mon_cmd($vmid, "set_link", name => $device,
3498                up => $up ? JSON::true : JSON::false);
3499 }
3500
3501 sub qemu_netdevadd {
3502     my ($vmid, $conf, $device, $deviceid) = @_;
3503
3504     my $netdev = print_netdev_full($vmid, $conf, $device, $deviceid);
3505     my %options =  split(/[=,]/, $netdev);
3506
3507     vm_mon_cmd($vmid, "netdev_add",  %options);
3508     return 1;
3509 }
3510
3511 sub qemu_netdevdel {
3512     my ($vmid, $deviceid) = @_;
3513
3514     vm_mon_cmd($vmid, "netdev_del", id => $deviceid);
3515 }
3516
3517 sub qemu_cpu_hotplug {
3518     my ($vmid, $conf, $vcpus) = @_;
3519
3520     my $sockets = 1;
3521     $sockets = $conf->{smp} if $conf->{smp}; # old style - no longer iused
3522     $sockets = $conf->{sockets} if  $conf->{sockets};
3523     my $cores = $conf->{cores} || 1;
3524     my $maxcpus = $sockets * $cores;
3525
3526     $vcpus = $maxcpus if !$vcpus;
3527
3528     die "you can't add more vcpus than maxcpus\n"
3529         if $vcpus > $maxcpus;
3530
3531     my $currentvcpus = $conf->{vcpus} || $maxcpus;
3532     die "online cpu unplug is not yet possible\n"
3533         if $vcpus < $currentvcpus;
3534
3535     my $currentrunningvcpus = vm_mon_cmd($vmid, "query-cpus");
3536     die "vcpus in running vm is different than configuration\n"
3537         if scalar(@{$currentrunningvcpus}) != $currentvcpus;
3538
3539     for (my $i = $currentvcpus; $i < $vcpus; $i++) {
3540         vm_mon_cmd($vmid, "cpu-add", id => int($i));
3541     }
3542 }
3543
3544 sub qemu_memory_hotplug {
3545     my ($vmid, $conf, $defaults, $opt, $value) = @_;
3546
3547     return $value if !check_running($vmid);
3548
3549     my $memory = $conf->{memory} || $defaults->{memory};
3550     $value = $defaults->{memory} if !$value;
3551     return $value if $value == $memory;
3552
3553     my $static_memory = $STATICMEM;
3554     my $dimm_memory = $memory - $static_memory;
3555
3556     die "memory can't be lower than $static_memory MB" if $value < $static_memory;
3557     die "memory unplug is not yet available" if $value < $memory;
3558     die "you cannot add more memory than $MAX_MEM MB!\n" if $memory > $MAX_MEM;
3559
3560
3561     my $sockets = 1;
3562     $sockets = $conf->{sockets} if $conf->{sockets};
3563
3564     foreach_dimm($conf, $vmid, $value, $sockets, sub {
3565         my ($conf, $vmid, $name, $dimm_size, $numanode, $current_size, $memory) = @_;
3566
3567             return if $current_size <= $conf->{memory};
3568
3569             eval { vm_mon_cmd($vmid, "object-add", 'qom-type' => "memory-backend-ram", id => "mem-$name", props => { size => int($dimm_size*1024*1024) } ) };
3570             if (my $err = $@) {
3571                 eval { qemu_objectdel($vmid, "mem-$name"); };
3572                 die $err;
3573             }
3574
3575             eval { vm_mon_cmd($vmid, "device_add", driver => "pc-dimm", id => "$name", memdev => "mem-$name", node => $numanode) };
3576             if (my $err = $@) {
3577                 eval { qemu_objectdel($vmid, "mem-$name"); };
3578                 die $err;
3579             }
3580             #update conf after each succesful module hotplug
3581             $conf->{memory} = $current_size;
3582             update_config_nolock($vmid, $conf, 1);
3583     });
3584 }
3585
3586 sub qemu_block_set_io_throttle {
3587     my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
3588
3589     return if !check_running($vmid) ;
3590
3591     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));
3592
3593 }
3594
3595 # old code, only used to shutdown old VM after update
3596 sub __read_avail {
3597     my ($fh, $timeout) = @_;
3598
3599     my $sel = new IO::Select;
3600     $sel->add($fh);
3601
3602     my $res = '';
3603     my $buf;
3604
3605     my @ready;
3606     while (scalar (@ready = $sel->can_read($timeout))) {
3607         my $count;
3608         if ($count = $fh->sysread($buf, 8192)) {
3609             if ($buf =~ /^(.*)\(qemu\) $/s) {
3610                 $res .= $1;
3611                 last;
3612             } else {
3613                 $res .= $buf;
3614             }
3615         } else {
3616             if (!defined($count)) {
3617                 die "$!\n";
3618             }
3619             last;
3620         }
3621     }
3622
3623     die "monitor read timeout\n" if !scalar(@ready);
3624
3625     return $res;
3626 }
3627
3628 # old code, only used to shutdown old VM after update
3629 sub vm_monitor_command {
3630     my ($vmid, $cmdstr, $nocheck) = @_;
3631
3632     my $res;
3633
3634     eval {
3635         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
3636
3637         my $sname = "${var_run_tmpdir}/$vmid.mon";
3638
3639         my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
3640             die "unable to connect to VM $vmid socket - $!\n";
3641
3642         my $timeout = 3;
3643
3644         # hack: migrate sometime blocks the monitor (when migrate_downtime
3645         # is set)
3646         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3647             $timeout = 60*60; # 1 hour
3648         }
3649
3650         # read banner;
3651         my $data = __read_avail($sock, $timeout);
3652
3653         if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
3654             die "got unexpected qemu monitor banner\n";
3655         }
3656
3657         my $sel = new IO::Select;
3658         $sel->add($sock);
3659
3660         if (!scalar(my @ready = $sel->can_write($timeout))) {
3661             die "monitor write error - timeout";
3662         }
3663
3664         my $fullcmd = "$cmdstr\r";
3665
3666         # syslog('info', "VM $vmid monitor command: $cmdstr");
3667
3668         my $b;
3669         if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
3670             die "monitor write error - $!";
3671         }
3672
3673         return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
3674
3675         $timeout = 20;
3676
3677         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3678             $timeout = 60*60; # 1 hour
3679         } elsif ($cmdstr =~ m/^(eject|change)/) {
3680             $timeout = 60; # note: cdrom mount command is slow
3681         }
3682         if ($res = __read_avail($sock, $timeout)) {
3683
3684             my @lines = split("\r?\n", $res);
3685
3686             shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
3687
3688             $res = join("\n", @lines);
3689             $res .= "\n";
3690         }
3691     };
3692
3693     my $err = $@;
3694
3695     if ($err) {
3696         syslog("err", "VM $vmid monitor command failed - $err");
3697         die $err;
3698     }
3699
3700     return $res;
3701 }
3702
3703 sub qemu_block_resize {
3704     my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
3705
3706     my $running = check_running($vmid);
3707
3708     return if !PVE::Storage::volume_resize($storecfg, $volid, $size, $running);
3709
3710     return if !$running;
3711
3712     vm_mon_cmd($vmid, "block_resize", device => $deviceid, size => int($size));
3713
3714 }
3715
3716 sub qemu_volume_snapshot {
3717     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3718
3719     my $running = check_running($vmid);
3720
3721     return if !PVE::Storage::volume_snapshot($storecfg, $volid, $snap, $running);
3722
3723     return if !$running;
3724
3725     vm_mon_cmd($vmid, "snapshot-drive", device => $deviceid, name => $snap);
3726
3727 }
3728
3729 sub qemu_volume_snapshot_delete {
3730     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3731
3732     my $running = check_running($vmid);
3733
3734     return if !PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snap, $running);
3735
3736     return if !$running;
3737
3738     vm_mon_cmd($vmid, "delete-drive-snapshot", device => $deviceid, name => $snap);
3739 }
3740
3741 sub set_migration_caps {
3742     my ($vmid) = @_;
3743
3744     my $cap_ref = [];
3745
3746     my $enabled_cap = {
3747         "auto-converge" => 1,
3748         "xbzrle" => 0,
3749         "x-rdma-pin-all" => 0,
3750         "zero-blocks" => 0,
3751     };
3752
3753     my $supported_capabilities = vm_mon_cmd_nocheck($vmid, "query-migrate-capabilities");
3754
3755     for my $supported_capability (@$supported_capabilities) {
3756         push @$cap_ref, {
3757             capability => $supported_capability->{capability},
3758             state => $enabled_cap->{$supported_capability->{capability}} ? JSON::true : JSON::false,
3759         };
3760     }
3761
3762     vm_mon_cmd_nocheck($vmid, "migrate-set-capabilities", capabilities => $cap_ref);
3763 }
3764
3765 my $fast_plug_option = {
3766     'lock' => 1,
3767     'name' => 1,
3768     'onboot' => 1,
3769     'shares' => 1,
3770     'startup' => 1,
3771 };
3772
3773 # hotplug changes in [PENDING]
3774 # $selection hash can be used to only apply specified options, for
3775 # example: { cores => 1 } (only apply changed 'cores')
3776 # $errors ref is used to return error messages
3777 sub vmconfig_hotplug_pending {
3778     my ($vmid, $conf, $storecfg, $selection, $errors) = @_;
3779
3780     my $defaults = load_defaults();
3781
3782     # commit values which do not have any impact on running VM first
3783     # Note: those option cannot raise errors, we we do not care about
3784     # $selection and always apply them.
3785
3786     my $add_error = sub {
3787         my ($opt, $msg) = @_;
3788         $errors->{$opt} = "hotplug problem - $msg";
3789     };
3790
3791     my $changes = 0;
3792     foreach my $opt (keys %{$conf->{pending}}) { # add/change
3793         if ($fast_plug_option->{$opt}) {
3794             $conf->{$opt} = $conf->{pending}->{$opt};
3795             delete $conf->{pending}->{$opt};
3796             $changes = 1;
3797         }
3798     }
3799
3800     if ($changes) {
3801         update_config_nolock($vmid, $conf, 1);
3802         $conf = load_config($vmid); # update/reload
3803     }
3804
3805     my $hotplug_features = parse_hotplug_features(defined($conf->{hotplug}) ? $conf->{hotplug} : '1');
3806
3807     my @delete = PVE::Tools::split_list($conf->{pending}->{delete});
3808     foreach my $opt (@delete) {
3809         next if $selection && !$selection->{$opt};
3810         eval {
3811             if ($opt eq 'hotplug') {
3812                 die "skip\n" if ($conf->{hotplug} =~ /memory/);
3813             } elsif ($opt eq 'tablet') {
3814                 die "skip\n" if !$hotplug_features->{usb};
3815                 if ($defaults->{tablet}) {
3816                     vm_deviceplug($storecfg, $conf, $vmid, $opt);
3817                 } else {
3818                     vm_deviceunplug($vmid, $conf, $opt);
3819                 }
3820             } elsif ($opt eq 'vcpus') {
3821                 die "skip\n" if !$hotplug_features->{cpu};
3822                 qemu_cpu_hotplug($vmid, $conf, undef);
3823             } elsif ($opt eq 'balloon') {
3824                 # enable balloon device is not hotpluggable
3825                 die "skip\n" if !defined($conf->{balloon}) || $conf->{balloon};
3826             } elsif ($fast_plug_option->{$opt}) {
3827                 # do nothing
3828             } elsif ($opt =~ m/^net(\d+)$/) {
3829                 die "skip\n" if !$hotplug_features->{network};
3830                 vm_deviceunplug($vmid, $conf, $opt);
3831             } elsif (valid_drivename($opt)) {
3832                 die "skip\n" if !$hotplug_features->{disk} || $opt =~ m/(ide|sata)(\d+)/;
3833                 vm_deviceunplug($vmid, $conf, $opt);
3834                 vmconfig_register_unused_drive($storecfg, $vmid, $conf, parse_drive($opt, $conf->{$opt}));
3835             } elsif ($opt =~ m/^memory$/) {
3836                 die "skip\n" if !$hotplug_features->{memory};
3837                 qemu_memory_hotplug($vmid, $conf, $defaults, $opt);
3838             } else {
3839                 die "skip\n";
3840             }
3841         };
3842         if (my $err = $@) {
3843             &$add_error($opt, $err) if $err ne "skip\n";
3844         } else {
3845             # save new config if hotplug was successful
3846             delete $conf->{$opt};
3847             vmconfig_undelete_pending_option($conf, $opt);
3848             update_config_nolock($vmid, $conf, 1);
3849             $conf = load_config($vmid); # update/reload
3850         }
3851     }
3852
3853     foreach my $opt (keys %{$conf->{pending}}) {
3854         next if $selection && !$selection->{$opt};
3855         my $value = $conf->{pending}->{$opt};
3856         eval {
3857             if ($opt eq 'hotplug') {
3858                 die "skip\n" if ($value =~ /memory/) || ($value !~ /memory/ && $conf->{hotplug} =~ /memory/);
3859             } elsif ($opt eq 'tablet') {
3860                 die "skip\n" if !$hotplug_features->{usb};
3861                 if ($value == 1) {
3862                     vm_deviceplug($storecfg, $conf, $vmid, $opt);
3863                 } elsif ($value == 0) {
3864                     vm_deviceunplug($vmid, $conf, $opt);
3865                 }
3866             } elsif ($opt eq 'vcpus') {
3867                 die "skip\n" if !$hotplug_features->{cpu};
3868                 qemu_cpu_hotplug($vmid, $conf, $value);
3869             } elsif ($opt eq 'balloon') {
3870                 # enable/disable balloning device is not hotpluggable
3871                 my $old_balloon_enabled =  !!(!defined($conf->{balloon}) || $conf->{balloon});
3872                 my $new_balloon_enabled =  !!(!defined($conf->{pending}->{balloon}) || $conf->{pending}->{balloon});
3873                 die "skip\n" if $old_balloon_enabled != $new_balloon_enabled;
3874
3875                 # allow manual ballooning if shares is set to zero
3876                 if ((defined($conf->{shares}) && ($conf->{shares} == 0))) {
3877                     my $balloon = $conf->{pending}->{balloon} || $conf->{memory} || $defaults->{memory};
3878                     vm_mon_cmd($vmid, "balloon", value => $balloon*1024*1024);
3879                 }
3880             } elsif ($opt =~ m/^net(\d+)$/) {
3881                 # some changes can be done without hotplug
3882                 vmconfig_update_net($storecfg, $conf, $hotplug_features->{network},
3883                                     $vmid, $opt, $value);
3884             } elsif (valid_drivename($opt)) {
3885                 # some changes can be done without hotplug
3886                 vmconfig_update_disk($storecfg, $conf, $hotplug_features->{disk},
3887                                      $vmid, $opt, $value, 1);
3888             } elsif ($opt =~ m/^memory$/) { #dimms
3889                 die "skip\n" if !$hotplug_features->{memory};
3890                 $value = qemu_memory_hotplug($vmid, $conf, $defaults, $opt, $value);
3891             } else {
3892                 die "skip\n";  # skip non-hot-pluggable options
3893             }
3894         };
3895         if (my $err = $@) {
3896             &$add_error($opt, $err) if $err ne "skip\n";
3897         } else {
3898             # save new config if hotplug was successful
3899             $conf->{$opt} = $value;
3900             delete $conf->{pending}->{$opt};
3901             update_config_nolock($vmid, $conf, 1);
3902             $conf = load_config($vmid); # update/reload
3903         }
3904     }
3905 }
3906
3907 sub vmconfig_apply_pending {
3908     my ($vmid, $conf, $storecfg) = @_;
3909
3910     # cold plug
3911
3912     my @delete = PVE::Tools::split_list($conf->{pending}->{delete});
3913     foreach my $opt (@delete) { # delete
3914         die "internal error" if $opt =~ m/^unused/;
3915         $conf = load_config($vmid); # update/reload
3916         if (!defined($conf->{$opt})) {
3917             vmconfig_undelete_pending_option($conf, $opt);
3918             update_config_nolock($vmid, $conf, 1);
3919         } elsif (valid_drivename($opt)) {
3920             vmconfig_register_unused_drive($storecfg, $vmid, $conf, parse_drive($opt, $conf->{$opt}));
3921             vmconfig_undelete_pending_option($conf, $opt);
3922             delete $conf->{$opt};
3923             update_config_nolock($vmid, $conf, 1);
3924         } else {
3925             vmconfig_undelete_pending_option($conf, $opt);
3926             delete $conf->{$opt};
3927             update_config_nolock($vmid, $conf, 1);
3928         }
3929     }
3930
3931     $conf = load_config($vmid); # update/reload
3932
3933     foreach my $opt (keys %{$conf->{pending}}) { # add/change
3934         $conf = load_config($vmid); # update/reload
3935
3936         if (defined($conf->{$opt}) && ($conf->{$opt} eq $conf->{pending}->{$opt})) {
3937             # skip if nothing changed
3938         } elsif (valid_drivename($opt)) {
3939             vmconfig_register_unused_drive($storecfg, $vmid, $conf, parse_drive($opt, $conf->{$opt}))
3940                 if defined($conf->{$opt});
3941             $conf->{$opt} = $conf->{pending}->{$opt};
3942         } else {
3943             $conf->{$opt} = $conf->{pending}->{$opt};
3944         }
3945
3946         delete $conf->{pending}->{$opt};
3947         update_config_nolock($vmid, $conf, 1);
3948     }
3949 }
3950
3951 my $safe_num_ne = sub {
3952     my ($a, $b) = @_;
3953
3954     return 0 if !defined($a) && !defined($b);
3955     return 1 if !defined($a);
3956     return 1 if !defined($b);
3957
3958     return $a != $b;
3959 };
3960
3961 my $safe_string_ne = sub {
3962     my ($a, $b) = @_;
3963
3964     return 0 if !defined($a) && !defined($b);
3965     return 1 if !defined($a);
3966     return 1 if !defined($b);
3967
3968     return $a ne $b;
3969 };
3970
3971 sub vmconfig_update_net {
3972     my ($storecfg, $conf, $hotplug, $vmid, $opt, $value) = @_;
3973
3974     my $newnet = parse_net($value);
3975
3976     if ($conf->{$opt}) {
3977         my $oldnet = parse_net($conf->{$opt});
3978
3979         if (&$safe_string_ne($oldnet->{model}, $newnet->{model}) ||
3980             &$safe_string_ne($oldnet->{macaddr}, $newnet->{macaddr}) ||
3981             &$safe_num_ne($oldnet->{queues}, $newnet->{queues}) ||
3982             !($newnet->{bridge} && $oldnet->{bridge})) { # bridge/nat mode change
3983
3984             # for non online change, we try to hot-unplug
3985             die "skip\n" if !$hotplug;
3986             vm_deviceunplug($vmid, $conf, $opt);
3987         } else {
3988
3989             die "internal error" if $opt !~ m/net(\d+)/;
3990             my $iface = "tap${vmid}i$1";
3991
3992             if (&$safe_num_ne($oldnet->{rate}, $newnet->{rate})) {
3993                 PVE::Network::tap_rate_limit($iface, $newnet->{rate});
3994             }
3995
3996             if (&$safe_string_ne($oldnet->{bridge}, $newnet->{bridge}) ||
3997                 &$safe_num_ne($oldnet->{tag}, $newnet->{tag}) ||
3998                 &$safe_num_ne($oldnet->{firewall}, $newnet->{firewall})) {
3999                 PVE::Network::tap_unplug($iface);
4000                 PVE::Network::tap_plug($iface, $newnet->{bridge}, $newnet->{tag}, $newnet->{firewall});
4001             }
4002
4003             if (&$safe_string_ne($oldnet->{link_down}, $newnet->{link_down})) {
4004                 qemu_set_link_status($vmid, $opt, !$newnet->{link_down});
4005             }
4006
4007             return 1;
4008         }
4009     }
4010
4011     if ($hotplug) {
4012         vm_deviceplug($storecfg, $conf, $vmid, $opt, $newnet);
4013     } else {
4014         die "skip\n";
4015     }
4016 }
4017
4018 sub vmconfig_update_disk {
4019     my ($storecfg, $conf, $hotplug, $vmid, $opt, $value, $force) = @_;
4020
4021     # fixme: do we need force?
4022
4023     my $drive = parse_drive($opt, $value);
4024
4025     if ($conf->{$opt}) {
4026
4027         if (my $old_drive = parse_drive($opt, $conf->{$opt}))  {
4028
4029             my $media = $drive->{media} || 'disk';
4030             my $oldmedia = $old_drive->{media} || 'disk';
4031             die "unable to change media type\n" if $media ne $oldmedia;
4032
4033             if (!drive_is_cdrom($old_drive)) {
4034
4035                 if ($drive->{file} ne $old_drive->{file}) {
4036
4037                     die "skip\n" if !$hotplug;
4038
4039                     # unplug and register as unused
4040                     vm_deviceunplug($vmid, $conf, $opt);
4041                     vmconfig_register_unused_drive($storecfg, $vmid, $conf, $old_drive)
4042
4043                 } else {
4044                     # update existing disk
4045
4046                     # skip non hotpluggable value
4047                     if (&$safe_num_ne($drive->{discard}, $old_drive->{discard}) ||
4048                         &$safe_string_ne($drive->{cache}, $old_drive->{cache})) {
4049                         die "skip\n";
4050                     }
4051
4052                     # apply throttle
4053                     if (&$safe_num_ne($drive->{mbps}, $old_drive->{mbps}) ||
4054                         &$safe_num_ne($drive->{mbps_rd}, $old_drive->{mbps_rd}) ||
4055                         &$safe_num_ne($drive->{mbps_wr}, $old_drive->{mbps_wr}) ||
4056                         &$safe_num_ne($drive->{iops}, $old_drive->{iops}) ||
4057                         &$safe_num_ne($drive->{iops_rd}, $old_drive->{iops_rd}) ||
4058                         &$safe_num_ne($drive->{iops_wr}, $old_drive->{iops_wr}) ||
4059                         &$safe_num_ne($drive->{mbps_max}, $old_drive->{mbps_max}) ||
4060                         &$safe_num_ne($drive->{mbps_rd_max}, $old_drive->{mbps_rd_max}) ||
4061                         &$safe_num_ne($drive->{mbps_wr_max}, $old_drive->{mbps_wr_max}) ||
4062                         &$safe_num_ne($drive->{iops_max}, $old_drive->{iops_max}) ||
4063                         &$safe_num_ne($drive->{iops_rd_max}, $old_drive->{iops_rd_max}) ||
4064                         &$safe_num_ne($drive->{iops_wr_max}, $old_drive->{iops_wr_max})) {
4065
4066                         qemu_block_set_io_throttle($vmid,"drive-$opt",
4067                                                    ($drive->{mbps} || 0)*1024*1024,
4068                                                    ($drive->{mbps_rd} || 0)*1024*1024,
4069                                                    ($drive->{mbps_wr} || 0)*1024*1024,
4070                                                    $drive->{iops} || 0,
4071                                                    $drive->{iops_rd} || 0,
4072                                                    $drive->{iops_wr} || 0,
4073                                                    ($drive->{mbps_max} || 0)*1024*1024,
4074                                                    ($drive->{mbps_rd_max} || 0)*1024*1024,
4075                                                    ($drive->{mbps_wr_max} || 0)*1024*1024,
4076                                                    $drive->{iops_max} || 0,
4077                                                    $drive->{iops_rd_max} || 0,
4078                                                    $drive->{iops_wr_max} || 0);
4079
4080                     }
4081
4082                     return 1;
4083                 }
4084
4085             } else { # cdrom
4086
4087                 if ($drive->{file} eq 'none') {
4088                     vm_mon_cmd($vmid, "eject",force => JSON::true,device => "drive-$opt");
4089                 } else {
4090                     my $path = get_iso_path($storecfg, $vmid, $drive->{file});
4091                     vm_mon_cmd($vmid, "eject", force => JSON::true,device => "drive-$opt"); # force eject if locked
4092                     vm_mon_cmd($vmid, "change", device => "drive-$opt",target => "$path") if $path;
4093                 }
4094
4095                 return 1;
4096             }
4097         }
4098     }
4099
4100     die "skip\n" if !$hotplug || $opt =~ m/(ide|sata)(\d+)/;
4101     # hotplug new disks
4102     vm_deviceplug($storecfg, $conf, $vmid, $opt, $drive);
4103 }
4104
4105 sub vm_start {
4106     my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused, $forcemachine, $spice_ticket) = @_;
4107
4108     lock_config($vmid, sub {
4109         my $conf = load_config($vmid, $migratedfrom);
4110
4111         die "you can't start a vm if it's a template\n" if is_template($conf);
4112
4113         check_lock($conf) if !$skiplock;
4114
4115         die "VM $vmid already running\n" if check_running($vmid, undef, $migratedfrom);
4116
4117         if (!$statefile && scalar(keys %{$conf->{pending}})) {
4118             vmconfig_apply_pending($vmid, $conf, $storecfg);
4119             $conf = load_config($vmid); # update/reload
4120         }
4121
4122         my $defaults = load_defaults();
4123
4124         # set environment variable useful inside network script
4125         $ENV{PVE_MIGRATED_FROM} = $migratedfrom if $migratedfrom;
4126
4127         my ($cmd, $vollist, $spice_port) = config_to_command($storecfg, $vmid, $conf, $defaults, $forcemachine);
4128
4129         my $migrate_port = 0;
4130         my $migrate_uri;
4131         if ($statefile) {
4132             if ($statefile eq 'tcp') {
4133                 my $localip = "localhost";
4134                 my $datacenterconf = PVE::Cluster::cfs_read_file('datacenter.cfg');
4135                 if ($datacenterconf->{migration_unsecure}) {
4136                         my $nodename = PVE::INotify::nodename();
4137                         $localip = PVE::Cluster::remote_node_ip($nodename, 1);
4138                 }
4139                 $migrate_port = PVE::Tools::next_migrate_port();
4140                 $migrate_uri = "tcp:${localip}:${migrate_port}";
4141                 push @$cmd, '-incoming', $migrate_uri;
4142                 push @$cmd, '-S';
4143             } else {
4144                 push @$cmd, '-loadstate', $statefile;
4145             }
4146         } elsif ($paused) {
4147             push @$cmd, '-S';
4148         }
4149
4150         # host pci devices
4151         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
4152           my $d = parse_hostpci($conf->{"hostpci$i"});
4153           next if !$d;
4154           my $pcidevices = $d->{pciid};
4155           foreach my $pcidevice (@$pcidevices) {
4156                 my $pciid = $pcidevice->{id}.".".$pcidevice->{function};
4157
4158                 my $info = pci_device_info("0000:$pciid");
4159                 die "IOMMU not present\n" if !check_iommu_support();
4160                 die "no pci device info for device '$pciid'\n" if !$info;
4161
4162                 if ($d->{driver} && $d->{driver} eq "vfio") {
4163                     die "can't unbind/bind pci group to vfio '$pciid'\n" if !pci_dev_group_bind_to_vfio($pciid);
4164                 } else {
4165                     die "can't unbind/bind to stub pci device '$pciid'\n" if !pci_dev_bind_to_stub($info);
4166                 }
4167
4168                 die "can't reset pci device '$pciid'\n" if $info->{has_fl_reset} and !pci_dev_reset($info);
4169           }
4170         }
4171
4172         PVE::Storage::activate_volumes($storecfg, $vollist);
4173
4174         eval  { run_command($cmd, timeout => $statefile ? undef : 30,
4175                     umask => 0077); };
4176         my $err = $@;
4177         die "start failed: $err" if $err;
4178
4179         print "migration listens on $migrate_uri\n" if $migrate_uri;
4180
4181         if ($statefile && $statefile ne 'tcp')  {
4182             eval { vm_mon_cmd_nocheck($vmid, "cont"); };
4183             warn $@ if $@;
4184         }
4185
4186         if ($migratedfrom) {
4187
4188             eval {
4189                 set_migration_caps($vmid);
4190             };
4191             warn $@ if $@;
4192
4193             if ($spice_port) {
4194                 print "spice listens on port $spice_port\n";
4195                 if ($spice_ticket) {
4196                     vm_mon_cmd_nocheck($vmid, "set_password", protocol => 'spice', password => $spice_ticket);
4197                     vm_mon_cmd_nocheck($vmid, "expire_password", protocol => 'spice', time => "+30");
4198                 }
4199             }
4200
4201         } else {
4202
4203             if (!$statefile && (!defined($conf->{balloon}) || $conf->{balloon})) {
4204                 vm_mon_cmd_nocheck($vmid, "balloon", value => $conf->{balloon}*1024*1024)
4205                     if $conf->{balloon};
4206             }
4207
4208             foreach my $opt (keys %$conf) {
4209                 next if $opt !~  m/^net\d+$/;
4210                 my $nicconf = parse_net($conf->{$opt});
4211                 qemu_set_link_status($vmid, $opt, 0) if $nicconf->{link_down};
4212             }
4213         }
4214
4215         vm_mon_cmd_nocheck($vmid, 'qom-set',
4216                     path => "machine/peripheral/balloon0",
4217                     property => "guest-stats-polling-interval",
4218                     value => 2) if (!defined($conf->{balloon}) || $conf->{balloon});
4219
4220     });
4221 }
4222
4223 sub vm_mon_cmd {
4224     my ($vmid, $execute, %params) = @_;
4225
4226     my $cmd = { execute => $execute, arguments => \%params };
4227     vm_qmp_command($vmid, $cmd);
4228 }
4229
4230 sub vm_mon_cmd_nocheck {
4231     my ($vmid, $execute, %params) = @_;
4232
4233     my $cmd = { execute => $execute, arguments => \%params };
4234     vm_qmp_command($vmid, $cmd, 1);
4235 }
4236
4237 sub vm_qmp_command {
4238     my ($vmid, $cmd, $nocheck) = @_;
4239
4240     my $res;
4241
4242     my $timeout;
4243     if ($cmd->{arguments} && $cmd->{arguments}->{timeout}) {
4244         $timeout = $cmd->{arguments}->{timeout};
4245         delete $cmd->{arguments}->{timeout};
4246     }
4247
4248     eval {
4249         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
4250         my $sname = qmp_socket($vmid);
4251         if (-e $sname) { # test if VM is reasonambe new and supports qmp/qga
4252             my $qmpclient = PVE::QMPClient->new();
4253
4254             $res = $qmpclient->cmd($vmid, $cmd, $timeout);
4255         } elsif (-e "${var_run_tmpdir}/$vmid.mon") {
4256             die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
4257                 if scalar(%{$cmd->{arguments}});
4258             vm_monitor_command($vmid, $cmd->{execute}, $nocheck);
4259         } else {
4260             die "unable to open monitor socket\n";
4261         }
4262     };
4263     if (my $err = $@) {
4264         syslog("err", "VM $vmid qmp command failed - $err");
4265         die $err;
4266     }
4267
4268     return $res;
4269 }
4270
4271 sub vm_human_monitor_command {
4272     my ($vmid, $cmdline) = @_;
4273
4274     my $res;
4275
4276     my $cmd = {
4277         execute => 'human-monitor-command',
4278         arguments => { 'command-line' => $cmdline},
4279     };
4280
4281     return vm_qmp_command($vmid, $cmd);
4282 }
4283
4284 sub vm_commandline {
4285     my ($storecfg, $vmid) = @_;
4286
4287     my $conf = load_config($vmid);
4288
4289     my $defaults = load_defaults();
4290
4291     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
4292
4293     return join(' ', @$cmd);
4294 }
4295
4296 sub vm_reset {
4297     my ($vmid, $skiplock) = @_;
4298
4299     lock_config($vmid, sub {
4300
4301         my $conf = load_config($vmid);
4302
4303         check_lock($conf) if !$skiplock;
4304
4305         vm_mon_cmd($vmid, "system_reset");
4306     });
4307 }
4308
4309 sub get_vm_volumes {
4310     my ($conf) = @_;
4311
4312     my $vollist = [];
4313     foreach_volid($conf, sub {
4314         my ($volid, $is_cdrom) = @_;
4315
4316         return if $volid =~ m|^/|;
4317
4318         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
4319         return if !$sid;
4320
4321         push @$vollist, $volid;
4322     });
4323
4324     return $vollist;
4325 }
4326
4327 sub vm_stop_cleanup {
4328     my ($storecfg, $vmid, $conf, $keepActive, $apply_pending_changes) = @_;
4329
4330     eval {
4331         fairsched_rmnod($vmid); # try to destroy group
4332
4333         if (!$keepActive) {
4334             my $vollist = get_vm_volumes($conf);
4335             PVE::Storage::deactivate_volumes($storecfg, $vollist);
4336         }
4337
4338         foreach my $ext (qw(mon qmp pid vnc qga)) {
4339             unlink "/var/run/qemu-server/${vmid}.$ext";
4340         }
4341
4342         vmconfig_apply_pending($vmid, $conf, $storecfg) if $apply_pending_changes;
4343     };
4344     warn $@ if $@; # avoid errors - just warn
4345 }
4346
4347 # Note: use $nockeck to skip tests if VM configuration file exists.
4348 # We need that when migration VMs to other nodes (files already moved)
4349 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
4350 sub vm_stop {
4351     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
4352
4353     $force = 1 if !defined($force) && !$shutdown;
4354
4355     if ($migratedfrom){
4356         my $pid = check_running($vmid, $nocheck, $migratedfrom);
4357         kill 15, $pid if $pid;
4358         my $conf = load_config($vmid, $migratedfrom);
4359         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive, 0);
4360         return;
4361     }
4362
4363     lock_config($vmid, sub {
4364
4365         my $pid = check_running($vmid, $nocheck);
4366         return if !$pid;
4367
4368         my $conf;
4369         if (!$nocheck) {
4370             $conf = load_config($vmid);
4371             check_lock($conf) if !$skiplock;
4372             if (!defined($timeout) && $shutdown && $conf->{startup}) {
4373                 my $opts = parse_startup($conf->{startup});
4374                 $timeout = $opts->{down} if $opts->{down};
4375             }
4376         }
4377
4378         $timeout = 60 if !defined($timeout);
4379
4380         eval {
4381             if ($shutdown) {
4382                 if (defined($conf) && $conf->{agent}) {
4383                     vm_qmp_command($vmid, { execute => "guest-shutdown" }, $nocheck);
4384                 } else {
4385                     vm_qmp_command($vmid, { execute => "system_powerdown" }, $nocheck);
4386                 }
4387             } else {
4388                 vm_qmp_command($vmid, { execute => "quit" }, $nocheck);
4389             }
4390         };
4391         my $err = $@;
4392
4393         if (!$err) {
4394             my $count = 0;
4395             while (($count < $timeout) && check_running($vmid, $nocheck)) {
4396                 $count++;
4397                 sleep 1;
4398             }
4399
4400             if ($count >= $timeout) {
4401                 if ($force) {
4402                     warn "VM still running - terminating now with SIGTERM\n";
4403                     kill 15, $pid;
4404                 } else {
4405                     die "VM quit/powerdown failed - got timeout\n";
4406                 }
4407             } else {
4408                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive, 1) if $conf;
4409                 return;
4410             }
4411         } else {
4412             if ($force) {
4413                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
4414                 kill 15, $pid;
4415             } else {
4416                 die "VM quit/powerdown failed\n";
4417             }
4418         }
4419
4420         # wait again
4421         $timeout = 10;
4422
4423         my $count = 0;
4424         while (($count < $timeout) && check_running($vmid, $nocheck)) {
4425             $count++;
4426             sleep 1;
4427         }
4428
4429         if ($count >= $timeout) {
4430             warn "VM still running - terminating now with SIGKILL\n";
4431             kill 9, $pid;
4432             sleep 1;
4433         }
4434
4435         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive, 1) if $conf;
4436    });
4437 }
4438
4439 sub vm_suspend {
4440     my ($vmid, $skiplock) = @_;
4441
4442     lock_config($vmid, sub {
4443
4444         my $conf = load_config($vmid);
4445
4446         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
4447
4448         vm_mon_cmd($vmid, "stop");
4449     });
4450 }
4451
4452 sub vm_resume {
4453     my ($vmid, $skiplock) = @_;
4454
4455     lock_config($vmid, sub {
4456
4457         my $conf = load_config($vmid);
4458
4459         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
4460
4461         vm_mon_cmd($vmid, "cont");
4462     });
4463 }
4464
4465 sub vm_sendkey {
4466     my ($vmid, $skiplock, $key) = @_;
4467
4468     lock_config($vmid, sub {
4469
4470         my $conf = load_config($vmid);
4471
4472         # there is no qmp command, so we use the human monitor command
4473         vm_human_monitor_command($vmid, "sendkey $key");
4474     });
4475 }
4476
4477 sub vm_destroy {
4478     my ($storecfg, $vmid, $skiplock) = @_;
4479
4480     lock_config($vmid, sub {
4481
4482         my $conf = load_config($vmid);
4483
4484         check_lock($conf) if !$skiplock;
4485
4486         if (!check_running($vmid)) {
4487             fairsched_rmnod($vmid); # try to destroy group
4488             destroy_vm($storecfg, $vmid);
4489         } else {
4490             die "VM $vmid is running - destroy failed\n";
4491         }
4492     });
4493 }
4494
4495 # pci helpers
4496
4497 sub file_write {
4498     my ($filename, $buf) = @_;
4499
4500     my $fh = IO::File->new($filename, "w");
4501     return undef if !$fh;
4502
4503     my $res = print $fh $buf;
4504
4505     $fh->close();
4506
4507     return $res;
4508 }
4509
4510 sub pci_device_info {
4511     my ($name) = @_;
4512
4513     my $res;
4514
4515     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
4516     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
4517
4518     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
4519     return undef if !defined($irq) || $irq !~ m/^\d+$/;
4520
4521     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
4522     return undef if !defined($vendor) || $vendor !~ s/^0x//;
4523
4524     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
4525     return undef if !defined($product) || $product !~ s/^0x//;
4526
4527     $res = {
4528         name => $name,
4529         vendor => $vendor,
4530         product => $product,
4531         domain => $domain,
4532         bus => $bus,
4533         slot => $slot,
4534         func => $func,
4535         irq => $irq,
4536         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
4537     };
4538
4539     return $res;
4540 }
4541
4542 sub pci_dev_reset {
4543     my ($dev) = @_;
4544
4545     my $name = $dev->{name};
4546
4547     my $fn = "$pcisysfs/devices/$name/reset";
4548
4549     return file_write($fn, "1");
4550 }
4551
4552 sub pci_dev_bind_to_stub {
4553     my ($dev) = @_;
4554
4555     my $name = $dev->{name};
4556
4557     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
4558     return 1 if -d $testdir;
4559
4560     my $data = "$dev->{vendor} $dev->{product}";
4561     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
4562
4563     my $fn = "$pcisysfs/devices/$name/driver/unbind";
4564     if (!file_write($fn, $name)) {
4565         return undef if -f $fn;
4566     }
4567
4568     $fn = "$pcisysfs/drivers/pci-stub/bind";
4569     if (! -d $testdir) {
4570         return undef if !file_write($fn, $name);
4571     }
4572
4573     return -d $testdir;
4574 }
4575
4576 sub pci_dev_bind_to_vfio {
4577     my ($dev) = @_;
4578
4579     my $name = $dev->{name};
4580
4581     my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4582
4583     if (!-d $vfio_basedir) {
4584         system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4585     }
4586     die "Cannot find vfio-pci module!\n" if !-d $vfio_basedir;
4587
4588     my $testdir = "$vfio_basedir/$name";
4589     return 1 if -d $testdir;
4590
4591     my $data = "$dev->{vendor} $dev->{product}";
4592     return undef if !file_write("$vfio_basedir/new_id", $data);
4593
4594     my $fn = "$pcisysfs/devices/$name/driver/unbind";
4595     if (!file_write($fn, $name)) {
4596         return undef if -f $fn;
4597     }
4598
4599     $fn = "$vfio_basedir/bind";
4600     if (! -d $testdir) {
4601         return undef if !file_write($fn, $name);
4602     }
4603
4604     return -d $testdir;
4605 }
4606
4607 sub pci_dev_group_bind_to_vfio {
4608     my ($pciid) = @_;
4609
4610     my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4611
4612     if (!-d $vfio_basedir) {
4613         system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4614     }
4615     die "Cannot find vfio-pci module!\n" if !-d $vfio_basedir;
4616
4617     # get IOMMU group devices
4618     opendir(my $D, "$pcisysfs/devices/0000:$pciid/iommu_group/devices/") || die "Cannot open iommu_group: $!\n";
4619       my @devs = grep /^0000:/, readdir($D);
4620     closedir($D);
4621
4622     foreach my $pciid (@devs) {
4623         $pciid =~ m/^([:\.\da-f]+)$/ or die "PCI ID $pciid not valid!\n";
4624
4625         # pci bridges, switches or root ports are not supported
4626         # they have a pci_bus subdirectory so skip them
4627         next if (-e "$pcisysfs/devices/$pciid/pci_bus");
4628
4629         my $info = pci_device_info($1);
4630         pci_dev_bind_to_vfio($info) || die "Cannot bind $pciid to vfio\n";
4631     }
4632
4633     return 1;
4634 }
4635
4636 sub print_pci_addr {
4637     my ($id, $bridges) = @_;
4638
4639     my $res = '';
4640     my $devices = {
4641         piix3 => { bus => 0, addr => 1 },
4642         #addr2 : first videocard
4643         balloon0 => { bus => 0, addr => 3 },
4644         watchdog => { bus => 0, addr => 4 },
4645         scsihw0 => { bus => 0, addr => 5 },
4646         scsihw1 => { bus => 0, addr => 6 },
4647         ahci0 => { bus => 0, addr => 7 },
4648         qga0 => { bus => 0, addr => 8 },
4649         spice => { bus => 0, addr => 9 },
4650         virtio0 => { bus => 0, addr => 10 },
4651         virtio1 => { bus => 0, addr => 11 },
4652         virtio2 => { bus => 0, addr => 12 },
4653         virtio3 => { bus => 0, addr => 13 },
4654         virtio4 => { bus => 0, addr => 14 },
4655         virtio5 => { bus => 0, addr => 15 },
4656         hostpci0 => { bus => 0, addr => 16 },
4657         hostpci1 => { bus => 0, addr => 17 },
4658         net0 => { bus => 0, addr => 18 },
4659         net1 => { bus => 0, addr => 19 },
4660         net2 => { bus => 0, addr => 20 },
4661         net3 => { bus => 0, addr => 21 },
4662         net4 => { bus => 0, addr => 22 },
4663         net5 => { bus => 0, addr => 23 },
4664         vga1 => { bus => 0, addr => 24 },
4665         vga2 => { bus => 0, addr => 25 },
4666         vga3 => { bus => 0, addr => 26 },
4667         hostpci2 => { bus => 0, addr => 27 },
4668         hostpci3 => { bus => 0, addr => 28 },
4669         #addr29 : usb-host (pve-usb.cfg)
4670         'pci.1' => { bus => 0, addr => 30 },
4671         'pci.2' => { bus => 0, addr => 31 },
4672         'net6' => { bus => 1, addr => 1 },
4673         'net7' => { bus => 1, addr => 2 },
4674         'net8' => { bus => 1, addr => 3 },
4675         'net9' => { bus => 1, addr => 4 },
4676         'net10' => { bus => 1, addr => 5 },
4677         'net11' => { bus => 1, addr => 6 },
4678         'net12' => { bus => 1, addr => 7 },
4679         'net13' => { bus => 1, addr => 8 },
4680         'net14' => { bus => 1, addr => 9 },
4681         'net15' => { bus => 1, addr => 10 },
4682         'net16' => { bus => 1, addr => 11 },
4683         'net17' => { bus => 1, addr => 12 },
4684         'net18' => { bus => 1, addr => 13 },
4685         'net19' => { bus => 1, addr => 14 },
4686         'net20' => { bus => 1, addr => 15 },
4687         'net21' => { bus => 1, addr => 16 },
4688         'net22' => { bus => 1, addr => 17 },
4689         'net23' => { bus => 1, addr => 18 },
4690         'net24' => { bus => 1, addr => 19 },
4691         'net25' => { bus => 1, addr => 20 },
4692         'net26' => { bus => 1, addr => 21 },
4693         'net27' => { bus => 1, addr => 22 },
4694         'net28' => { bus => 1, addr => 23 },
4695         'net29' => { bus => 1, addr => 24 },
4696         'net30' => { bus => 1, addr => 25 },
4697         'net31' => { bus => 1, addr => 26 },
4698         'virtio6' => { bus => 2, addr => 1 },
4699         'virtio7' => { bus => 2, addr => 2 },
4700         'virtio8' => { bus => 2, addr => 3 },
4701         'virtio9' => { bus => 2, addr => 4 },
4702         'virtio10' => { bus => 2, addr => 5 },
4703         'virtio11' => { bus => 2, addr => 6 },
4704         'virtio12' => { bus => 2, addr => 7 },
4705         'virtio13' => { bus => 2, addr => 8 },
4706         'virtio14' => { bus => 2, addr => 9 },
4707         'virtio15' => { bus => 2, addr => 10 },
4708     };
4709
4710     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
4711            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
4712            my $bus = $devices->{$id}->{bus};
4713            $res = ",bus=pci.$bus,addr=$addr";
4714            $bridges->{$bus} = 1 if $bridges;
4715     }
4716     return $res;
4717
4718 }
4719
4720 sub print_pcie_addr {
4721     my ($id) = @_;
4722
4723     my $res = '';
4724     my $devices = {
4725         hostpci0 => { bus => "ich9-pcie-port-1", addr => 0 },
4726         hostpci1 => { bus => "ich9-pcie-port-2", addr => 0 },
4727         hostpci2 => { bus => "ich9-pcie-port-3", addr => 0 },
4728         hostpci3 => { bus => "ich9-pcie-port-4", addr => 0 },
4729     };
4730
4731     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
4732            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
4733            my $bus = $devices->{$id}->{bus};
4734            $res = ",bus=$bus,addr=$addr";
4735     }
4736     return $res;
4737
4738 }
4739
4740 # vzdump restore implementaion
4741
4742 sub tar_archive_read_firstfile {
4743     my $archive = shift;
4744
4745     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
4746
4747     # try to detect archive type first
4748     my $pid = open (TMP, "tar tf '$archive'|") ||
4749         die "unable to open file '$archive'\n";
4750     my $firstfile = <TMP>;
4751     kill 15, $pid;
4752     close TMP;
4753
4754     die "ERROR: archive contaions no data\n" if !$firstfile;
4755     chomp $firstfile;
4756
4757     return $firstfile;
4758 }
4759
4760 sub tar_restore_cleanup {
4761     my ($storecfg, $statfile) = @_;
4762
4763     print STDERR "starting cleanup\n";
4764
4765     if (my $fd = IO::File->new($statfile, "r")) {
4766         while (defined(my $line = <$fd>)) {
4767             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4768                 my $volid = $2;
4769                 eval {
4770                     if ($volid =~ m|^/|) {
4771                         unlink $volid || die 'unlink failed\n';
4772                     } else {
4773                         PVE::Storage::vdisk_free($storecfg, $volid);
4774                     }
4775                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
4776                 };
4777                 print STDERR "unable to cleanup '$volid' - $@" if $@;
4778             } else {
4779                 print STDERR "unable to parse line in statfile - $line";
4780             }
4781         }
4782         $fd->close();
4783     }
4784 }
4785
4786 sub restore_archive {
4787     my ($archive, $vmid, $user, $opts) = @_;
4788
4789     my $format = $opts->{format};
4790     my $comp;
4791
4792     if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
4793         $format = 'tar' if !$format;
4794         $comp = 'gzip';
4795     } elsif ($archive =~ m/\.tar$/) {
4796         $format = 'tar' if !$format;
4797     } elsif ($archive =~ m/.tar.lzo$/) {
4798         $format = 'tar' if !$format;
4799         $comp = 'lzop';
4800     } elsif ($archive =~ m/\.vma$/) {
4801         $format = 'vma' if !$format;
4802     } elsif ($archive =~ m/\.vma\.gz$/) {
4803         $format = 'vma' if !$format;
4804         $comp = 'gzip';
4805     } elsif ($archive =~ m/\.vma\.lzo$/) {
4806         $format = 'vma' if !$format;
4807         $comp = 'lzop';
4808     } else {
4809         $format = 'vma' if !$format; # default
4810     }
4811
4812     # try to detect archive format
4813     if ($format eq 'tar') {
4814         return restore_tar_archive($archive, $vmid, $user, $opts);
4815     } else {
4816         return restore_vma_archive($archive, $vmid, $user, $opts, $comp);
4817     }
4818 }
4819
4820 sub restore_update_config_line {
4821     my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
4822
4823     return if $line =~ m/^\#qmdump\#/;
4824     return if $line =~ m/^\#vzdump\#/;
4825     return if $line =~ m/^lock:/;
4826     return if $line =~ m/^unused\d+:/;
4827     return if $line =~ m/^parent:/;
4828     return if $line =~ m/^template:/; # restored VM is never a template
4829
4830     if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
4831         # try to convert old 1.X settings
4832         my ($id, $ind, $ethcfg) = ($1, $2, $3);
4833         foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
4834             my ($model, $macaddr) = split(/\=/, $devconfig);
4835             $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $unique;
4836             my $net = {
4837                 model => $model,
4838                 bridge => "vmbr$ind",
4839                 macaddr => $macaddr,
4840             };
4841             my $netstr = print_net($net);
4842
4843             print $outfd "net$cookie->{netcount}: $netstr\n";
4844             $cookie->{netcount}++;
4845         }
4846     } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
4847         my ($id, $netstr) = ($1, $2);
4848         my $net = parse_net($netstr);
4849         $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
4850         $netstr = print_net($net);
4851         print $outfd "$id: $netstr\n";
4852     } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
4853         my $virtdev = $1;
4854         my $value = $3;
4855         if ($line =~ m/backup=no/) {
4856             print $outfd "#$line";
4857         } elsif ($virtdev && $map->{$virtdev}) {
4858             my $di = parse_drive($virtdev, $value);
4859             delete $di->{format}; # format can change on restore
4860             $di->{file} = $map->{$virtdev};
4861             $value = print_drive($vmid, $di);
4862             print $outfd "$virtdev: $value\n";
4863         } else {
4864             print $outfd $line;
4865         }
4866     } else {
4867         print $outfd $line;
4868     }
4869 }
4870
4871 sub scan_volids {
4872     my ($cfg, $vmid) = @_;
4873
4874     my $info = PVE::Storage::vdisk_list($cfg, undef, $vmid);
4875
4876     my $volid_hash = {};
4877     foreach my $storeid (keys %$info) {
4878         foreach my $item (@{$info->{$storeid}}) {
4879             next if !($item->{volid} && $item->{size});
4880             $item->{path} = PVE::Storage::path($cfg, $item->{volid});
4881             $volid_hash->{$item->{volid}} = $item;
4882         }
4883     }
4884
4885     return $volid_hash;
4886 }
4887
4888 sub get_used_paths {
4889     my ($vmid, $storecfg, $conf, $scan_snapshots, $skip_drive) = @_;
4890
4891     my $used_path = {};
4892
4893     my $scan_config = sub {
4894         my ($cref, $snapname) = @_;
4895
4896         foreach my $key (keys %$cref) {
4897             my $value = $cref->{$key};
4898             if (valid_drivename($key)) {
4899                 next if $skip_drive && $key eq $skip_drive;
4900                 my $drive = parse_drive($key, $value);
4901                 next if !$drive || !$drive->{file} || drive_is_cdrom($drive);
4902                 if ($drive->{file} =~ m!^/!) {
4903                     $used_path->{$drive->{file}}++; # = 1;
4904                 } else {
4905                     my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file}, 1);
4906                     next if !$storeid;
4907                     my $scfg = PVE::Storage::storage_config($storecfg, $storeid, 1);
4908                     next if !$scfg;
4909                     my $path = PVE::Storage::path($storecfg, $drive->{file}, $snapname);
4910                     $used_path->{$path}++; # = 1;
4911                 }
4912             }
4913         }
4914     };
4915
4916     &$scan_config($conf);
4917
4918     undef $skip_drive;
4919
4920     if ($scan_snapshots) {
4921         foreach my $snapname (keys %{$conf->{snapshots}}) {
4922             &$scan_config($conf->{snapshots}->{$snapname}, $snapname);
4923         }
4924     }
4925
4926     return $used_path;
4927 }
4928
4929 sub update_disksize {
4930     my ($vmid, $conf, $volid_hash) = @_;
4931
4932     my $changes;
4933
4934     my $used = {};
4935
4936     # Note: it is allowed to define multiple storages with same path (alias), so
4937     # we need to check both 'volid' and real 'path' (two different volid can point
4938     # to the same path).
4939
4940     my $usedpath = {};
4941
4942     # update size info
4943     foreach my $opt (keys %$conf) {
4944         if (valid_drivename($opt)) {
4945             my $drive = parse_drive($opt, $conf->{$opt});
4946             my $volid = $drive->{file};
4947             next if !$volid;
4948
4949             $used->{$volid} = 1;
4950             if ($volid_hash->{$volid} &&
4951                 (my $path = $volid_hash->{$volid}->{path})) {
4952                 $usedpath->{$path} = 1;
4953             }
4954
4955             next if drive_is_cdrom($drive);
4956             next if !$volid_hash->{$volid};
4957
4958             $drive->{size} = $volid_hash->{$volid}->{size};
4959             my $new = print_drive($vmid, $drive);
4960             if ($new ne $conf->{$opt}) {
4961                 $changes = 1;
4962                 $conf->{$opt} = $new;
4963             }
4964         }
4965     }
4966
4967     # remove 'unusedX' entry if volume is used
4968     foreach my $opt (keys %$conf) {
4969         next if $opt !~ m/^unused\d+$/;
4970         my $volid = $conf->{$opt};
4971         my $path = $volid_hash->{$volid}->{path} if $volid_hash->{$volid};
4972         if ($used->{$volid} || ($path && $usedpath->{$path})) {
4973             $changes = 1;
4974             delete $conf->{$opt};
4975         }
4976     }
4977
4978     foreach my $volid (sort keys %$volid_hash) {
4979         next if $volid =~ m/vm-$vmid-state-/;
4980         next if $used->{$volid};
4981         my $path = $volid_hash->{$volid}->{path};
4982         next if !$path; # just to be sure
4983         next if $usedpath->{$path};
4984         $changes = 1;
4985         add_unused_volume($conf, $volid);
4986         $usedpath->{$path} = 1; # avoid to add more than once (aliases)
4987     }
4988
4989     return $changes;
4990 }
4991
4992 sub rescan {
4993     my ($vmid, $nolock) = @_;
4994
4995     my $cfg = PVE::Cluster::cfs_read_file("storage.cfg");
4996
4997     my $volid_hash = scan_volids($cfg, $vmid);
4998
4999     my $updatefn =  sub {
5000         my ($vmid) = @_;
5001
5002         my $conf = load_config($vmid);
5003
5004         check_lock($conf);
5005
5006         my $vm_volids = {};
5007         foreach my $volid (keys %$volid_hash) {
5008             my $info = $volid_hash->{$volid};
5009             $vm_volids->{$volid} = $info if $info->{vmid} && $info->{vmid} == $vmid;
5010         }
5011
5012         my $changes = update_disksize($vmid, $conf, $vm_volids);
5013
5014         update_config_nolock($vmid, $conf, 1) if $changes;
5015     };
5016
5017     if (defined($vmid)) {
5018         if ($nolock) {
5019             &$updatefn($vmid);
5020         } else {
5021             lock_config($vmid, $updatefn, $vmid);
5022         }
5023     } else {
5024         my $vmlist = config_list();
5025         foreach my $vmid (keys %$vmlist) {
5026             if ($nolock) {
5027                 &$updatefn($vmid);
5028             } else {
5029                 lock_config($vmid, $updatefn, $vmid);
5030             }
5031         }
5032     }
5033 }
5034
5035 sub restore_vma_archive {
5036     my ($archive, $vmid, $user, $opts, $comp) = @_;
5037
5038     my $input = $archive eq '-' ? "<&STDIN" : undef;
5039     my $readfrom = $archive;
5040
5041     my $uncomp = '';
5042     if ($comp) {
5043         $readfrom = '-';
5044         my $qarchive = PVE::Tools::shellquote($archive);
5045         if ($comp eq 'gzip') {
5046             $uncomp = "zcat $qarchive|";
5047         } elsif ($comp eq 'lzop') {
5048             $uncomp = "lzop -d -c $qarchive|";
5049         } else {
5050             die "unknown compression method '$comp'\n";
5051         }
5052
5053     }
5054
5055     my $tmpdir = "/var/tmp/vzdumptmp$$";
5056     rmtree $tmpdir;
5057
5058     # disable interrupts (always do cleanups)
5059     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
5060         warn "got interrupt - ignored\n";
5061     };
5062
5063     my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
5064     POSIX::mkfifo($mapfifo, 0600);
5065     my $fifofh;
5066
5067     my $openfifo = sub {
5068         open($fifofh, '>', $mapfifo) || die $!;
5069     };
5070
5071     my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
5072
5073     my $oldtimeout;
5074     my $timeout = 5;
5075
5076     my $devinfo = {};
5077
5078     my $rpcenv = PVE::RPCEnvironment::get();
5079
5080     my $conffile = config_file($vmid);
5081     my $tmpfn = "$conffile.$$.tmp";
5082
5083     # Note: $oldconf is undef if VM does not exists
5084     my $oldconf = PVE::Cluster::cfs_read_file(cfs_config_path($vmid));
5085
5086     my $print_devmap = sub {
5087         my $virtdev_hash = {};
5088
5089         my $cfgfn = "$tmpdir/qemu-server.conf";
5090
5091         # we can read the config - that is already extracted
5092         my $fh = IO::File->new($cfgfn, "r") ||
5093             "unable to read qemu-server.conf - $!\n";
5094
5095         while (defined(my $line = <$fh>)) {
5096             if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
5097                 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
5098                 die "archive does not contain data for drive '$virtdev'\n"
5099                     if !$devinfo->{$devname};
5100                 if (defined($opts->{storage})) {
5101                     $storeid = $opts->{storage} || 'local';
5102                 } elsif (!$storeid) {
5103                     $storeid = 'local';
5104                 }
5105                 $format = 'raw' if !$format;
5106                 $devinfo->{$devname}->{devname} = $devname;
5107                 $devinfo->{$devname}->{virtdev} = $virtdev;
5108                 $devinfo->{$devname}->{format} = $format;
5109                 $devinfo->{$devname}->{storeid} = $storeid;
5110
5111                 # check permission on storage
5112                 my $pool = $opts->{pool}; # todo: do we need that?
5113                 if ($user ne 'root@pam') {
5114                     $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
5115                 }
5116
5117                 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
5118             }
5119         }
5120
5121         foreach my $devname (keys %$devinfo) {
5122             die "found no device mapping information for device '$devname'\n"
5123                 if !$devinfo->{$devname}->{virtdev};
5124         }
5125
5126         my $cfg = cfs_read_file('storage.cfg');
5127
5128         # create empty/temp config
5129         if ($oldconf) {
5130             PVE::Tools::file_set_contents($conffile, "memory: 128\n");
5131             foreach_drive($oldconf, sub {
5132                 my ($ds, $drive) = @_;
5133
5134                 return if drive_is_cdrom($drive);
5135
5136                 my $volid = $drive->{file};
5137
5138                 return if !$volid || $volid =~ m|^/|;
5139
5140                 my ($path, $owner) = PVE::Storage::path($cfg, $volid);
5141                 return if !$path || !$owner || ($owner != $vmid);
5142
5143                 # Note: only delete disk we want to restore
5144                 # other volumes will become unused
5145                 if ($virtdev_hash->{$ds}) {
5146                     PVE::Storage::vdisk_free($cfg, $volid);
5147                 }
5148             });
5149         }
5150
5151         my $map = {};
5152         foreach my $virtdev (sort keys %$virtdev_hash) {
5153             my $d = $virtdev_hash->{$virtdev};
5154             my $alloc_size = int(($d->{size} + 1024 - 1)/1024);
5155             my $scfg = PVE::Storage::storage_config($cfg, $d->{storeid});
5156
5157             # test if requested format is supported
5158             my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($cfg, $d->{storeid});
5159             my $supported = grep { $_ eq $d->{format} } @$validFormats;
5160             $d->{format} = $defFormat if !$supported;
5161
5162             my $volid = PVE::Storage::vdisk_alloc($cfg, $d->{storeid}, $vmid,
5163                                                   $d->{format}, undef, $alloc_size);
5164             print STDERR "new volume ID is '$volid'\n";
5165             $d->{volid} = $volid;
5166             my $path = PVE::Storage::path($cfg, $volid);
5167
5168             my $write_zeros = 1;
5169             # fixme: what other storages types initialize volumes with zero?
5170             if ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs' || $scfg->{type} eq 'glusterfs' ||
5171                 $scfg->{type} eq 'sheepdog' || $scfg->{type} eq 'rbd') {
5172                 $write_zeros = 0;
5173             }
5174
5175             print $fifofh "${write_zeros}:$d->{devname}=$path\n";
5176
5177             print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
5178             $map->{$virtdev} = $volid;
5179         }
5180
5181         $fh->seek(0, 0) || die "seek failed - $!\n";
5182
5183         my $outfd = new IO::File ($tmpfn, "w") ||
5184             die "unable to write config for VM $vmid\n";
5185
5186         my $cookie = { netcount => 0 };
5187         while (defined(my $line = <$fh>)) {
5188             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
5189         }
5190
5191         $fh->close();
5192         $outfd->close();
5193     };
5194
5195     eval {
5196         # enable interrupts
5197         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
5198             die "interrupted by signal\n";
5199         };
5200         local $SIG{ALRM} = sub { die "got timeout\n"; };
5201
5202         $oldtimeout = alarm($timeout);
5203
5204         my $parser = sub {
5205             my $line = shift;
5206
5207             print "$line\n";
5208
5209             if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
5210                 my ($dev_id, $size, $devname) = ($1, $2, $3);
5211                 $devinfo->{$devname} = { size => $size, dev_id => $dev_id };
5212             } elsif ($line =~ m/^CTIME: /) {
5213                 # we correctly received the vma config, so we can disable
5214                 # the timeout now for disk allocation (set to 10 minutes, so
5215                 # that we always timeout if something goes wrong)
5216                 alarm(600);
5217                 &$print_devmap();
5218                 print $fifofh "done\n";
5219                 my $tmp = $oldtimeout || 0;
5220                 $oldtimeout = undef;
5221                 alarm($tmp);
5222                 close($fifofh);
5223             }
5224         };
5225
5226         print "restore vma archive: $cmd\n";
5227         run_command($cmd, input => $input, outfunc => $parser, afterfork => $openfifo);
5228     };
5229     my $err = $@;
5230
5231     alarm($oldtimeout) if $oldtimeout;
5232
5233     unlink $mapfifo;
5234
5235     if ($err) {
5236         rmtree $tmpdir;
5237         unlink $tmpfn;
5238
5239         my $cfg = cfs_read_file('storage.cfg');
5240         foreach my $devname (keys %$devinfo) {
5241             my $volid = $devinfo->{$devname}->{volid};
5242             next if !$volid;
5243             eval {
5244                 if ($volid =~ m|^/|) {
5245                     unlink $volid || die 'unlink failed\n';
5246                 } else {
5247                     PVE::Storage::vdisk_free($cfg, $volid);
5248                 }
5249                 print STDERR "temporary volume '$volid' sucessfuly removed\n";
5250             };
5251             print STDERR "unable to cleanup '$volid' - $@" if $@;
5252         }
5253         die $err;
5254     }
5255
5256     rmtree $tmpdir;
5257
5258     rename($tmpfn, $conffile) ||
5259         die "unable to commit configuration file '$conffile'\n";
5260
5261     PVE::Cluster::cfs_update(); # make sure we read new file
5262
5263     eval { rescan($vmid, 1); };
5264     warn $@ if $@;
5265 }
5266
5267 sub restore_tar_archive {
5268     my ($archive, $vmid, $user, $opts) = @_;
5269
5270     if ($archive ne '-') {
5271         my $firstfile = tar_archive_read_firstfile($archive);
5272         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
5273             if $firstfile ne 'qemu-server.conf';
5274     }
5275
5276     my $storecfg = cfs_read_file('storage.cfg');
5277
5278     # destroy existing data - keep empty config
5279     my $vmcfgfn = config_file($vmid);
5280     destroy_vm($storecfg, $vmid, 1) if -f $vmcfgfn;
5281
5282     my $tocmd = "/usr/lib/qemu-server/qmextract";
5283
5284     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
5285     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
5286     $tocmd .= ' --prealloc' if $opts->{prealloc};
5287     $tocmd .= ' --info' if $opts->{info};
5288
5289     # tar option "xf" does not autodetect compression when read from STDIN,
5290     # so we pipe to zcat
5291     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
5292         PVE::Tools::shellquote("--to-command=$tocmd");
5293
5294     my $tmpdir = "/var/tmp/vzdumptmp$$";
5295     mkpath $tmpdir;
5296
5297     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
5298     local $ENV{VZDUMP_VMID} = $vmid;
5299     local $ENV{VZDUMP_USER} = $user;
5300
5301     my $conffile = config_file($vmid);
5302     my $tmpfn = "$conffile.$$.tmp";
5303
5304     # disable interrupts (always do cleanups)
5305     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
5306         print STDERR "got interrupt - ignored\n";
5307     };
5308
5309     eval {
5310         # enable interrupts
5311         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
5312             die "interrupted by signal\n";
5313         };
5314
5315         if ($archive eq '-') {
5316             print "extracting archive from STDIN\n";
5317             run_command($cmd, input => "<&STDIN");
5318         } else {
5319             print "extracting archive '$archive'\n";
5320             run_command($cmd);
5321         }
5322
5323         return if $opts->{info};
5324
5325         # read new mapping
5326         my $map = {};
5327         my $statfile = "$tmpdir/qmrestore.stat";
5328         if (my $fd = IO::File->new($statfile, "r")) {
5329             while (defined (my $line = <$fd>)) {
5330                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
5331                     $map->{$1} = $2 if $1;
5332                 } else {
5333                     print STDERR "unable to parse line in statfile - $line\n";
5334                 }
5335             }
5336             $fd->close();
5337         }
5338
5339         my $confsrc = "$tmpdir/qemu-server.conf";
5340
5341         my $srcfd = new IO::File($confsrc, "r") ||
5342             die "unable to open file '$confsrc'\n";
5343
5344         my $outfd = new IO::File ($tmpfn, "w") ||
5345             die "unable to write config for VM $vmid\n";
5346
5347         my $cookie = { netcount => 0 };
5348         while (defined (my $line = <$srcfd>)) {
5349             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
5350         }
5351
5352         $srcfd->close();
5353         $outfd->close();
5354     };
5355     my $err = $@;
5356
5357     if ($err) {
5358
5359         unlink $tmpfn;
5360
5361         tar_restore_cleanup($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info};
5362
5363         die $err;
5364     }
5365
5366     rmtree $tmpdir;
5367
5368     rename $tmpfn, $conffile ||
5369         die "unable to commit configuration file '$conffile'\n";
5370
5371     PVE::Cluster::cfs_update(); # make sure we read new file
5372
5373     eval { rescan($vmid, 1); };
5374     warn $@ if $@;
5375 };
5376
5377
5378 # Internal snapshots
5379
5380 # NOTE: Snapshot create/delete involves several non-atomic
5381 # action, and can take a long time.
5382 # So we try to avoid locking the file and use 'lock' variable
5383 # inside the config file instead.
5384
5385 my $snapshot_copy_config = sub {
5386     my ($source, $dest) = @_;
5387
5388     foreach my $k (keys %$source) {
5389         next if $k eq 'snapshots';
5390         next if $k eq 'snapstate';
5391         next if $k eq 'snaptime';
5392         next if $k eq 'vmstate';
5393         next if $k eq 'lock';
5394         next if $k eq 'digest';
5395         next if $k eq 'description';
5396         next if $k =~ m/^unused\d+$/;
5397
5398         $dest->{$k} = $source->{$k};
5399     }
5400 };
5401
5402 my $snapshot_apply_config = sub {
5403     my ($conf, $snap) = @_;
5404
5405     # copy snapshot list
5406     my $newconf = {
5407         snapshots => $conf->{snapshots},
5408     };
5409
5410     # keep description and list of unused disks
5411     foreach my $k (keys %$conf) {
5412         next if !($k =~ m/^unused\d+$/ || $k eq 'description');
5413         $newconf->{$k} = $conf->{$k};
5414     }
5415
5416     &$snapshot_copy_config($snap, $newconf);
5417
5418     return $newconf;
5419 };
5420
5421 sub foreach_writable_storage {
5422     my ($conf, $func) = @_;
5423
5424     my $sidhash = {};
5425
5426     foreach my $ds (keys %$conf) {
5427         next if !valid_drivename($ds);
5428
5429         my $drive = parse_drive($ds, $conf->{$ds});
5430         next if !$drive;
5431         next if drive_is_cdrom($drive);
5432
5433         my $volid = $drive->{file};
5434
5435         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
5436         $sidhash->{$sid} = $sid if $sid;
5437     }
5438
5439     foreach my $sid (sort keys %$sidhash) {
5440         &$func($sid);
5441     }
5442 }
5443
5444 my $alloc_vmstate_volid = sub {
5445     my ($storecfg, $vmid, $conf, $snapname) = @_;
5446
5447     # Note: we try to be smart when selecting a $target storage
5448
5449     my $target;
5450
5451     # search shared storage first
5452     foreach_writable_storage($conf, sub {
5453         my ($sid) = @_;
5454         my $scfg = PVE::Storage::storage_config($storecfg, $sid);
5455         return if !$scfg->{shared};
5456
5457         $target = $sid if !$target || $scfg->{path}; # prefer file based storage
5458     });
5459
5460     if (!$target) {
5461         # now search local storage
5462         foreach_writable_storage($conf, sub {
5463             my ($sid) = @_;
5464             my $scfg = PVE::Storage::storage_config($storecfg, $sid);
5465             return if $scfg->{shared};
5466
5467             $target = $sid if !$target || $scfg->{path}; # prefer file based storage;
5468         });
5469     }
5470
5471     $target = 'local' if !$target;
5472
5473     my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
5474     # we abort live save after $conf->{memory}, so we need at max twice that space
5475     my $size = $conf->{memory}*2 + $driver_state_size;
5476
5477     my $name = "vm-$vmid-state-$snapname";
5478     my $scfg = PVE::Storage::storage_config($storecfg, $target);
5479     $name .= ".raw" if $scfg->{path}; # add filename extension for file base storage
5480     my $volid = PVE::Storage::vdisk_alloc($storecfg, $target, $vmid, 'raw', $name, $size*1024);
5481
5482     return $volid;
5483 };
5484
5485 my $snapshot_prepare = sub {
5486     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
5487
5488     my $snap;
5489
5490     my $updatefn =  sub {
5491
5492         my $conf = load_config($vmid);
5493
5494         die "you can't take a snapshot if it's a template\n"
5495             if is_template($conf);
5496
5497         check_lock($conf);
5498
5499         $conf->{lock} = 'snapshot';
5500
5501         die "snapshot name '$snapname' already used\n"
5502             if defined($conf->{snapshots}->{$snapname});
5503
5504         my $storecfg = PVE::Storage::config();
5505         die "snapshot feature is not available" if !has_feature('snapshot', $conf, $storecfg);
5506
5507         $snap = $conf->{snapshots}->{$snapname} = {};
5508
5509         if ($save_vmstate && check_running($vmid)) {
5510             $snap->{vmstate} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
5511         }
5512
5513         &$snapshot_copy_config($conf, $snap);
5514
5515         $snap->{snapstate} = "prepare";
5516         $snap->{snaptime} = time();
5517         $snap->{description} = $comment if $comment;
5518
5519         # always overwrite machine if we save vmstate. This makes sure we
5520         # can restore it later using correct machine type
5521         $snap->{machine} = get_current_qemu_machine($vmid) if $snap->{vmstate};
5522
5523         update_config_nolock($vmid, $conf, 1);
5524     };
5525
5526     lock_config($vmid, $updatefn);
5527
5528     return $snap;
5529 };
5530
5531 my $snapshot_commit = sub {
5532     my ($vmid, $snapname) = @_;
5533
5534     my $updatefn = sub {
5535
5536         my $conf = load_config($vmid);
5537
5538         die "missing snapshot lock\n"
5539             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
5540
5541         my $has_machine_config = defined($conf->{machine});
5542
5543         my $snap = $conf->{snapshots}->{$snapname};
5544
5545         die "snapshot '$snapname' does not exist\n" if !defined($snap);
5546
5547         die "wrong snapshot state\n"
5548             if !($snap->{snapstate} && $snap->{snapstate} eq "prepare");
5549
5550         delete $snap->{snapstate};
5551         delete $conf->{lock};
5552
5553         my $newconf = &$snapshot_apply_config($conf, $snap);
5554
5555         delete $newconf->{machine} if !$has_machine_config;
5556
5557         $newconf->{parent} = $snapname;
5558
5559         update_config_nolock($vmid, $newconf, 1);
5560     };
5561
5562     lock_config($vmid, $updatefn);
5563 };
5564
5565 sub snapshot_rollback {
5566     my ($vmid, $snapname) = @_;
5567
5568     my $prepare = 1;
5569
5570     my $storecfg = PVE::Storage::config();
5571
5572     my $conf = load_config($vmid);
5573
5574     my $get_snapshot_config = sub {
5575
5576         die "you can't rollback if vm is a template\n" if is_template($conf);
5577
5578         my $res = $conf->{snapshots}->{$snapname};
5579
5580         die "snapshot '$snapname' does not exist\n" if !defined($res);
5581
5582         return $res;
5583     };
5584
5585     my $snap = &$get_snapshot_config();
5586
5587     foreach_drive($snap, sub {
5588         my ($ds, $drive) = @_;
5589
5590         return if drive_is_cdrom($drive);
5591
5592         my $volid = $drive->{file};
5593
5594         PVE::Storage::volume_rollback_is_possible($storecfg, $volid, $snapname);
5595     });
5596
5597     my $updatefn = sub {
5598
5599         $conf = load_config($vmid);
5600
5601         $snap = &$get_snapshot_config();
5602
5603         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
5604             if $snap->{snapstate};
5605
5606         if ($prepare) {
5607             check_lock($conf);
5608             vm_stop($storecfg, $vmid, undef, undef, 5, undef, undef);
5609         }
5610
5611         die "unable to rollback vm $vmid: vm is running\n"
5612             if check_running($vmid);
5613
5614         if ($prepare) {
5615             $conf->{lock} = 'rollback';
5616         } else {
5617             die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
5618             delete $conf->{lock};
5619         }
5620
5621         my $forcemachine;
5622
5623         if (!$prepare) {
5624             my $has_machine_config = defined($conf->{machine});
5625
5626             # copy snapshot config to current config
5627             $conf = &$snapshot_apply_config($conf, $snap);
5628             $conf->{parent} = $snapname;
5629
5630             # Note: old code did not store 'machine', so we try to be smart
5631             # and guess the snapshot was generated with kvm 1.4 (pc-i440fx-1.4).
5632             $forcemachine = $conf->{machine} || 'pc-i440fx-1.4';
5633             # we remove the 'machine' configuration if not explicitly specified
5634             # in the original config.
5635             delete $conf->{machine} if $snap->{vmstate} && !$has_machine_config;
5636         }
5637
5638         update_config_nolock($vmid, $conf, 1);
5639
5640         if (!$prepare && $snap->{vmstate}) {
5641             my $statefile = PVE::Storage::path($storecfg, $snap->{vmstate});
5642             vm_start($storecfg, $vmid, $statefile, undef, undef, undef, $forcemachine);
5643         }
5644     };
5645
5646     lock_config($vmid, $updatefn);
5647
5648     foreach_drive($snap, sub {
5649         my ($ds, $drive) = @_;
5650
5651         return if drive_is_cdrom($drive);
5652
5653         my $volid = $drive->{file};
5654         my $device = "drive-$ds";
5655
5656         PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
5657     });
5658
5659     $prepare = 0;
5660     lock_config($vmid, $updatefn);
5661 }
5662
5663 my $savevm_wait = sub {
5664     my ($vmid) = @_;
5665
5666     for(;;) {
5667         my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
5668         if (!$stat->{status}) {
5669             die "savevm not active\n";
5670         } elsif ($stat->{status} eq 'active') {
5671             sleep(1);
5672             next;
5673         } elsif ($stat->{status} eq 'completed') {
5674             last;
5675         } else {
5676             die "query-savevm returned status '$stat->{status}'\n";
5677         }
5678     }
5679 };
5680
5681 sub snapshot_create {
5682     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
5683
5684     my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
5685
5686     $save_vmstate = 0 if !$snap->{vmstate}; # vm is not running
5687
5688     my $config = load_config($vmid);
5689
5690     my $running = check_running($vmid);
5691
5692     my $freezefs = $running && $config->{agent};
5693     $freezefs = 0 if $snap->{vmstate}; # not needed if we save RAM
5694
5695     my $drivehash = {};
5696
5697     if ($freezefs) {
5698         eval { vm_mon_cmd($vmid, "guest-fsfreeze-freeze"); };
5699         warn "guest-fsfreeze-freeze problems - $@" if $@;
5700     }
5701
5702     eval {
5703         # create internal snapshots of all drives
5704
5705         my $storecfg = PVE::Storage::config();
5706
5707         if ($running) {
5708             if ($snap->{vmstate}) {
5709                 my $path = PVE::Storage::path($storecfg, $snap->{vmstate});
5710                 vm_mon_cmd($vmid, "savevm-start", statefile => $path);
5711                 &$savevm_wait($vmid);
5712             } else {
5713                 vm_mon_cmd($vmid, "savevm-start");
5714             }
5715         };
5716
5717         foreach_drive($snap, sub {
5718             my ($ds, $drive) = @_;
5719
5720             return if drive_is_cdrom($drive);
5721
5722             my $volid = $drive->{file};
5723             my $device = "drive-$ds";
5724
5725             qemu_volume_snapshot($vmid, $device, $storecfg, $volid, $snapname);
5726             $drivehash->{$ds} = 1;
5727        });
5728     };
5729     my $err = $@;
5730
5731     if ($running) {
5732         eval { vm_mon_cmd($vmid, "savevm-end")  };
5733         warn $@ if $@;
5734
5735         if ($freezefs) {
5736             eval { vm_mon_cmd($vmid, "guest-fsfreeze-thaw"); };
5737             warn "guest-fsfreeze-thaw problems - $@" if $@;
5738         }
5739
5740         # savevm-end is async, we need to wait
5741         for (;;) {
5742             my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
5743             if (!$stat->{bytes}) {
5744                 last;
5745             } else {
5746                 print "savevm not yet finished\n";
5747                 sleep(1);
5748                 next;
5749             }
5750         }
5751     }
5752
5753     if ($err) {
5754         warn "snapshot create failed: starting cleanup\n";
5755         eval { snapshot_delete($vmid, $snapname, 0, $drivehash); };
5756         warn $@ if $@;
5757         die $err;
5758     }
5759
5760     &$snapshot_commit($vmid, $snapname);
5761 }
5762
5763 # Note: $drivehash is only set when called from snapshot_create.
5764 sub snapshot_delete {
5765     my ($vmid, $snapname, $force, $drivehash) = @_;
5766
5767     my $prepare = 1;
5768
5769     my $snap;
5770     my $unused = [];
5771
5772     my $unlink_parent = sub {
5773         my ($confref, $new_parent) = @_;
5774
5775         if ($confref->{parent} && $confref->{parent} eq $snapname) {
5776             if ($new_parent) {
5777                 $confref->{parent} = $new_parent;
5778             } else {
5779                 delete $confref->{parent};
5780             }
5781         }
5782     };
5783
5784     my $updatefn =  sub {
5785         my ($remove_drive) = @_;
5786
5787         my $conf = load_config($vmid);
5788
5789         if (!$drivehash) {
5790             check_lock($conf);
5791             die "you can't delete a snapshot if vm is a template\n"
5792                 if is_template($conf);
5793         }
5794
5795         $snap = $conf->{snapshots}->{$snapname};
5796
5797         die "snapshot '$snapname' does not exist\n" if !defined($snap);
5798
5799         # remove parent refs
5800         if (!$prepare) {
5801             &$unlink_parent($conf, $snap->{parent});
5802             foreach my $sn (keys %{$conf->{snapshots}}) {
5803                 next if $sn eq $snapname;
5804                 &$unlink_parent($conf->{snapshots}->{$sn}, $snap->{parent});
5805             }
5806         }
5807
5808         if ($remove_drive) {
5809             if ($remove_drive eq 'vmstate') {
5810                 delete $snap->{$remove_drive};
5811             } else {
5812                 my $drive = parse_drive($remove_drive, $snap->{$remove_drive});
5813                 my $volid = $drive->{file};
5814                 delete $snap->{$remove_drive};
5815                 add_unused_volume($conf, $volid);
5816             }
5817         }
5818
5819         if ($prepare) {
5820             $snap->{snapstate} = 'delete';
5821         } else {
5822             delete $conf->{snapshots}->{$snapname};
5823             delete $conf->{lock} if $drivehash;
5824             foreach my $volid (@$unused) {
5825                 add_unused_volume($conf, $volid);
5826             }
5827         }
5828
5829         update_config_nolock($vmid, $conf, 1);
5830     };
5831
5832     lock_config($vmid, $updatefn);
5833
5834     # now remove vmstate file
5835
5836     my $storecfg = PVE::Storage::config();
5837
5838     if ($snap->{vmstate}) {
5839         eval {  PVE::Storage::vdisk_free($storecfg, $snap->{vmstate}); };
5840         if (my $err = $@) {
5841             die $err if !$force;
5842             warn $err;
5843         }
5844         # save changes (remove vmstate from snapshot)
5845         lock_config($vmid, $updatefn, 'vmstate') if !$force;
5846     };
5847
5848     # now remove all internal snapshots
5849     foreach_drive($snap, sub {
5850         my ($ds, $drive) = @_;
5851
5852         return if drive_is_cdrom($drive);
5853
5854         my $volid = $drive->{file};
5855         my $device = "drive-$ds";
5856
5857         if (!$drivehash || $drivehash->{$ds}) {
5858             eval { qemu_volume_snapshot_delete($vmid, $device, $storecfg, $volid, $snapname); };
5859             if (my $err = $@) {
5860                 die $err if !$force;
5861                 warn $err;
5862             }
5863         }
5864
5865         # save changes (remove drive fron snapshot)
5866         lock_config($vmid, $updatefn, $ds) if !$force;
5867         push @$unused, $volid;
5868     });
5869
5870     # now cleanup config
5871     $prepare = 0;
5872     lock_config($vmid, $updatefn);
5873 }
5874
5875 sub has_feature {
5876     my ($feature, $conf, $storecfg, $snapname, $running) = @_;
5877
5878     my $err;
5879     foreach_drive($conf, sub {
5880         my ($ds, $drive) = @_;
5881
5882         return if drive_is_cdrom($drive);
5883         my $volid = $drive->{file};
5884         $err = 1 if !PVE::Storage::volume_has_feature($storecfg, $feature, $volid, $snapname, $running);
5885     });
5886
5887     return $err ? 0 : 1;
5888 }
5889
5890 sub template_create {
5891     my ($vmid, $conf, $disk) = @_;
5892
5893     my $storecfg = PVE::Storage::config();
5894
5895     foreach_drive($conf, sub {
5896         my ($ds, $drive) = @_;
5897
5898         return if drive_is_cdrom($drive);
5899         return if $disk && $ds ne $disk;
5900
5901         my $volid = $drive->{file};
5902         return if !PVE::Storage::volume_has_feature($storecfg, 'template', $volid);
5903
5904         my $voliddst = PVE::Storage::vdisk_create_base($storecfg, $volid);
5905         $drive->{file} = $voliddst;
5906         $conf->{$ds} = print_drive($vmid, $drive);
5907         update_config_nolock($vmid, $conf, 1);
5908     });
5909 }
5910
5911 sub is_template {
5912     my ($conf) = @_;
5913
5914     return 1 if defined $conf->{template} && $conf->{template} == 1;
5915 }
5916
5917 sub qemu_img_convert {
5918     my ($src_volid, $dst_volid, $size, $snapname) = @_;
5919
5920     my $storecfg = PVE::Storage::config();
5921     my ($src_storeid, $src_volname) = PVE::Storage::parse_volume_id($src_volid, 1);
5922     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
5923
5924     if ($src_storeid && $dst_storeid) {
5925         my $src_scfg = PVE::Storage::storage_config($storecfg, $src_storeid);
5926         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
5927
5928         my $src_format = qemu_img_format($src_scfg, $src_volname);
5929         my $dst_format = qemu_img_format($dst_scfg, $dst_volname);
5930
5931         my $src_path = PVE::Storage::path($storecfg, $src_volid, $snapname);
5932         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
5933
5934         my $cmd = [];
5935         push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-n';
5936         push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
5937         push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
5938
5939         my $parser = sub {
5940             my $line = shift;
5941             if($line =~ m/\((\S+)\/100\%\)/){
5942                 my $percent = $1;
5943                 my $transferred = int($size * $percent / 100);
5944                 my $remaining = $size - $transferred;
5945
5946                 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
5947             }
5948
5949         };
5950
5951         eval  { run_command($cmd, timeout => undef, outfunc => $parser); };
5952         my $err = $@;
5953         die "copy failed: $err" if $err;
5954     }
5955 }
5956
5957 sub qemu_img_format {
5958     my ($scfg, $volname) = @_;
5959
5960     if ($scfg->{path} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/) {
5961         return $1;
5962     } elsif ($scfg->{type} eq 'iscsi') {
5963         return "host_device";
5964     } else {
5965         return "raw";
5966     }
5967 }
5968
5969 sub qemu_drive_mirror {
5970     my ($vmid, $drive, $dst_volid, $vmiddst) = @_;
5971
5972     my $count = 0;
5973     my $old_len = 0;
5974     my $frozen = undef;
5975     my $maxwait = 120;
5976
5977     my $storecfg = PVE::Storage::config();
5978     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid);
5979
5980     my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
5981
5982     my $format;
5983     if ($dst_volname =~ m/\.(raw|qcow2)$/){
5984         $format = $1;
5985     }
5986
5987     my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
5988
5989     my $opts = { timeout => 10, device => "drive-$drive", mode => "existing", sync => "full", target => $dst_path };
5990     $opts->{format} = $format if $format;
5991
5992     #fixme : sometime drive-mirror timeout, but works fine after.
5993     # (I have see the problem with big volume > 200GB), so we need to eval
5994     eval { vm_mon_cmd($vmid, "drive-mirror", %$opts); };
5995     # ignore errors here
5996
5997     eval {
5998         while (1) {
5999             my $stats = vm_mon_cmd($vmid, "query-block-jobs");
6000             my $stat = @$stats[0];
6001             die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
6002             die "error job is not mirroring" if $stat->{type} ne "mirror";
6003
6004             my $busy = $stat->{busy};
6005
6006             if (my $total = $stat->{len}) {
6007                 my $transferred = $stat->{offset} || 0;
6008                 my $remaining = $total - $transferred;
6009                 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
6010
6011                 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent % busy: $busy\n";
6012             }
6013
6014             if ($stat->{len} == $stat->{offset}) {
6015                 if ($busy eq 'false') {
6016
6017                     last if $vmiddst != $vmid;
6018
6019                     # try to switch the disk if source and destination are on the same guest
6020                     eval { vm_mon_cmd($vmid, "block-job-complete", device => "drive-$drive") };
6021                     last if !$@;
6022                     die $@ if $@ !~ m/cannot be completed/;
6023                 }
6024
6025                 if ($count > $maxwait) {
6026                     # if too much writes to disk occurs at the end of migration
6027                     #the disk needs to be freezed to be able to complete the migration
6028                     vm_suspend($vmid,1);
6029                     $frozen = 1;
6030                 }
6031                 $count ++
6032             }
6033             $old_len = $stat->{offset};
6034             sleep 1;
6035         }
6036
6037         vm_resume($vmid, 1) if $frozen;
6038
6039     };
6040     my $err = $@;
6041
6042     my $cancel_job = sub {
6043         vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive");
6044         while (1) {
6045             my $stats = vm_mon_cmd($vmid, "query-block-jobs");
6046             my $stat = @$stats[0];
6047             last if !$stat;
6048             sleep 1;
6049         }
6050     };
6051
6052     if ($err) {
6053         eval { &$cancel_job(); };
6054         die "mirroring error: $err";
6055     }
6056
6057     if ($vmiddst != $vmid) {
6058         # if we clone a disk for a new target vm, we don't switch the disk
6059         &$cancel_job(); # so we call block-job-cancel
6060     }
6061 }
6062
6063 sub clone_disk {
6064     my ($storecfg, $vmid, $running, $drivename, $drive, $snapname,
6065         $newvmid, $storage, $format, $full, $newvollist) = @_;
6066
6067     my $newvolid;
6068
6069     if (!$full) {
6070         print "create linked clone of drive $drivename ($drive->{file})\n";
6071         $newvolid = PVE::Storage::vdisk_clone($storecfg,  $drive->{file}, $newvmid, $snapname);
6072         push @$newvollist, $newvolid;
6073     } else {
6074         my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file});
6075         $storeid = $storage if $storage;
6076
6077         my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($storecfg, $storeid);
6078         if (!$format) {
6079             $format = $drive->{format} || $defFormat;
6080         }
6081
6082         # test if requested format is supported - else use default
6083         my $supported = grep { $_ eq $format } @$validFormats;
6084         $format = $defFormat if !$supported;
6085
6086         my ($size) = PVE::Storage::volume_size_info($storecfg, $drive->{file}, 3);
6087
6088         print "create full clone of drive $drivename ($drive->{file})\n";
6089         $newvolid = PVE::Storage::vdisk_alloc($storecfg, $storeid, $newvmid, $format, undef, ($size/1024));
6090         push @$newvollist, $newvolid;
6091
6092         if (!$running || $snapname) {
6093             qemu_img_convert($drive->{file}, $newvolid, $size, $snapname);
6094         } else {
6095             qemu_drive_mirror($vmid, $drivename, $newvolid, $newvmid);
6096         }
6097     }
6098
6099     my ($size) = PVE::Storage::volume_size_info($storecfg, $newvolid, 3);
6100
6101     my $disk = $drive;
6102     $disk->{format} = undef;
6103     $disk->{file} = $newvolid;
6104     $disk->{size} = $size;
6105
6106     return $disk;
6107 }
6108
6109 # this only works if VM is running
6110 sub get_current_qemu_machine {
6111     my ($vmid) = @_;
6112
6113     my $cmd = { execute => 'query-machines', arguments => {} };
6114     my $res = vm_qmp_command($vmid, $cmd);
6115
6116     my ($current, $default);
6117     foreach my $e (@$res) {
6118         $default = $e->{name} if $e->{'is-default'};
6119         $current = $e->{name} if $e->{'is-current'};
6120     }
6121
6122     # fallback to the default machine if current is not supported by qemu
6123     return $current || $default || 'pc';
6124 }
6125
6126 sub qemu_machine_feature_enabled {
6127     my ($machine, $kvmver, $version_major, $version_minor) = @_;
6128
6129     my $current_major;
6130     my $current_minor;
6131
6132     if ($machine && $machine =~ m/^(pc(-i440fx|-q35)?-(\d+)\.(\d+))/) {
6133
6134         $current_major = $3;
6135         $current_minor = $4;
6136
6137     } elsif ($kvmver =~ m/^(\d+)\.(\d+)/) {
6138
6139         $current_major = $1;
6140         $current_minor = $2;
6141     }
6142
6143     return 1 if $current_major >= $version_major && $current_minor >= $version_minor;
6144
6145
6146 }
6147
6148 sub lspci {
6149
6150     my $devices = {};
6151
6152     dir_glob_foreach("$pcisysfs/devices", '[a-f0-9]{4}:([a-f0-9]{2}:[a-f0-9]{2})\.([0-9])', sub {
6153             my (undef, $id, $function) = @_;
6154             my $res = { id => $id, function => $function};
6155             push @{$devices->{$id}}, $res;
6156     });
6157
6158     return $devices;
6159 }
6160
6161 1;