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
2872             } else {
2873                 push @$cpuFlags , 'hv_spinlocks=0xffff' if !$nokvm;
2874             }
2875         }
2876
2877         if ($ost eq 'win7' || $ost eq 'win8') {
2878             push @$cpuFlags , 'hv_relaxed' if !$nokvm;
2879         }
2880     }
2881
2882     push @$rtcFlags, 'driftfix=slew' if $tdf;
2883
2884     if ($nokvm) {
2885         push @$machineFlags, 'accel=tcg';
2886     } else {
2887         die "No accelerator found!\n" if !$cpuinfo->{hvm};
2888     }
2889
2890     if ($machine_type) {
2891         push @$machineFlags, "type=${machine_type}";
2892     }
2893
2894     if ($conf->{startdate}) {
2895         push @$rtcFlags, "base=$conf->{startdate}";
2896     } elsif ($useLocaltime) {
2897         push @$rtcFlags, 'base=localtime';
2898     }
2899
2900     my $cpu = $nokvm ? "qemu64" : "kvm64";
2901     $cpu = $conf->{cpu} if $conf->{cpu};
2902
2903     push @$cpuFlags , '+lahf_lm' if $cpu eq 'kvm64';
2904
2905     push @$cpuFlags , '+x2apic' if !$nokvm && $conf->{ostype} ne 'solaris';
2906
2907     push @$cpuFlags , '-x2apic' if $conf->{ostype} eq 'solaris';
2908
2909     push @$cpuFlags, '+sep' if $cpu eq 'kvm64' || $cpu eq 'kvm32';
2910
2911     $cpu .= "," . join(',', @$cpuFlags) if scalar(@$cpuFlags);
2912
2913     # Note: enforce needs kernel 3.10, so we do not use it for now
2914     # push @$cmd, '-cpu', "$cpu,enforce";
2915     push @$cmd, '-cpu', $cpu;
2916
2917     my $memory = $conf->{memory} || $defaults->{memory};
2918     my $static_memory = 0;
2919     my $dimm_memory = 0;
2920
2921     if ($hotplug_features->{memory}) {
2922         die "Numa need to be enabled for memory hotplug\n" if !$conf->{numa};
2923         die "Total memory is bigger than ${MAX_MEM}MB\n" if $memory > $MAX_MEM;
2924         $static_memory = $STATICMEM;
2925         die "minimum memory must be ${static_memory}MB\n" if($memory < $static_memory);
2926         $dimm_memory = $memory - $static_memory;
2927         push @$cmd, '-m', "size=${static_memory},slots=255,maxmem=${MAX_MEM}M";
2928
2929     } else {
2930
2931         $static_memory = $memory;
2932         push @$cmd, '-m', $static_memory;
2933     }
2934
2935     if ($conf->{numa}) {
2936
2937         my $numa_totalmemory = undef;
2938         for (my $i = 0; $i < $MAX_NUMA; $i++) {
2939             next if !$conf->{"numa$i"};
2940             my $numa = parse_numa($conf->{"numa$i"});
2941             next if !$numa;
2942             # memory
2943             die "missing numa node$i memory value\n" if !$numa->{memory};
2944             my $numa_memory = $numa->{memory};
2945             $numa_totalmemory += $numa_memory;
2946             my $numa_object = "memory-backend-ram,id=ram-node$i,size=${numa_memory}M";
2947
2948             # cpus
2949             my $cpus_start = $numa->{cpus}->{start};
2950             die "missing numa node$i cpus\n" if !defined($cpus_start);
2951             my $cpus_end = $numa->{cpus}->{end} if defined($numa->{cpus}->{end});
2952             my $cpus = $cpus_start;
2953             if (defined($cpus_end)) {
2954                 $cpus .= "-$cpus_end";
2955                 die "numa node$i :  cpu range $cpus is incorrect\n" if $cpus_end <= $cpus_start;
2956             }
2957
2958             # hostnodes
2959             my $hostnodes_start = $numa->{hostnodes}->{start};
2960             if (defined($hostnodes_start)) {
2961                 my $hostnodes_end = $numa->{hostnodes}->{end} if defined($numa->{hostnodes}->{end});
2962                 my $hostnodes = $hostnodes_start;
2963                 if (defined($hostnodes_end)) {
2964                     $hostnodes .= "-$hostnodes_end";
2965                     die "host node $hostnodes range is incorrect\n" if $hostnodes_end <= $hostnodes_start;
2966                 }
2967
2968                 my $hostnodes_end_range = defined($hostnodes_end) ? $hostnodes_end : $hostnodes_start;
2969                 for (my $i = $hostnodes_start; $i <= $hostnodes_end_range; $i++ ) {
2970                     die "host numa node$i don't exist\n" if ! -d "/sys/devices/system/node/node$i/";
2971                 }
2972
2973                 # policy
2974                 my $policy = $numa->{policy};
2975                 die "you need to define a policy for hostnode $hostnodes\n" if !$policy;
2976                 $numa_object .= ",host-nodes=$hostnodes,policy=$policy";
2977             }
2978
2979             push @$cmd, '-object', $numa_object;
2980             push @$cmd, '-numa', "node,nodeid=$i,cpus=$cpus,memdev=ram-node$i";
2981         }
2982
2983         die "total memory for NUMA nodes must be equal to vm static memory\n"
2984             if $numa_totalmemory && $numa_totalmemory != $static_memory;
2985
2986         #if no custom tology, we split memory and cores across numa nodes
2987         if(!$numa_totalmemory) {
2988
2989             my $numa_memory = ($static_memory / $sockets) . "M";
2990
2991             for (my $i = 0; $i < $sockets; $i++)  {
2992
2993                 my $cpustart = ($cores * $i);
2994                 my $cpuend = ($cpustart + $cores - 1) if $cores && $cores > 1;
2995                 my $cpus = $cpustart;
2996                 $cpus .= "-$cpuend" if $cpuend;
2997
2998                 push @$cmd, '-object', "memory-backend-ram,size=$numa_memory,id=ram-node$i";
2999                 push @$cmd, '-numa', "node,nodeid=$i,cpus=$cpus,memdev=ram-node$i";
3000             }
3001         }
3002     }
3003
3004     if ($hotplug_features->{memory}) {
3005         foreach_dimm($conf, $vmid, $memory, $sockets, sub {
3006             my ($conf, $vmid, $name, $dimm_size, $numanode, $current_size, $memory) = @_;
3007             push @$cmd, "-object" , "memory-backend-ram,id=mem-$name,size=${dimm_size}M";
3008             push @$cmd, "-device", "pc-dimm,id=$name,memdev=mem-$name,node=$numanode";
3009
3010             #if dimm_memory is not aligned to dimm map
3011             if($current_size > $memory) {
3012                  $conf->{memory} = $current_size;
3013                  update_config_nolock($vmid, $conf, 1);
3014             }
3015         });
3016     }
3017
3018     push @$cmd, '-S' if $conf->{freeze};
3019
3020     # set keyboard layout
3021     my $kb = $conf->{keyboard} || $defaults->{keyboard};
3022     push @$cmd, '-k', $kb if $kb;
3023
3024     # enable sound
3025     #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
3026     #push @$cmd, '-soundhw', 'es1370';
3027     #push @$cmd, '-soundhw', $soundhw if $soundhw;
3028
3029     if($conf->{agent}) {
3030         my $qgasocket = qmp_socket($vmid, 1);
3031         my $pciaddr = print_pci_addr("qga0", $bridges);
3032         push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
3033         push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
3034         push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
3035     }
3036
3037     my $spice_port;
3038
3039     if ($qxlnum) {
3040         if ($qxlnum > 1) {
3041             if ($conf->{ostype} && $conf->{ostype} =~ m/^w/){
3042                 for(my $i = 1; $i < $qxlnum; $i++){
3043                     my $pciaddr = print_pci_addr("vga$i", $bridges);
3044                     push @$cmd, '-device', "qxl,id=vga$i,ram_size=67108864,vram_size=33554432$pciaddr";
3045                 }
3046             } else {
3047                 # assume other OS works like Linux
3048                 push @$cmd, '-global', 'qxl-vga.ram_size=134217728';
3049                 push @$cmd, '-global', 'qxl-vga.vram_size=67108864';
3050             }
3051         }
3052
3053         my $pciaddr = print_pci_addr("spice", $bridges);
3054
3055         $spice_port = PVE::Tools::next_spice_port();
3056
3057         push @$devices, '-spice', "tls-port=${spice_port},addr=127.0.0.1,tls-ciphers=DES-CBC3-SHA,seamless-migration=on";
3058
3059         push @$devices, '-device', "virtio-serial,id=spice$pciaddr";
3060         push @$devices, '-chardev', "spicevmc,id=vdagent,name=vdagent";
3061         push @$devices, '-device', "virtserialport,chardev=vdagent,name=com.redhat.spice.0";
3062     }
3063
3064     # enable balloon by default, unless explicitly disabled
3065     if (!defined($conf->{balloon}) || $conf->{balloon}) {
3066         $pciaddr = print_pci_addr("balloon0", $bridges);
3067         push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr";
3068     }
3069
3070     if ($conf->{watchdog}) {
3071         my $wdopts = parse_watchdog($conf->{watchdog});
3072         $pciaddr = print_pci_addr("watchdog", $bridges);
3073         my $watchdog = $wdopts->{model} || 'i6300esb';
3074         push @$devices, '-device', "$watchdog$pciaddr";
3075         push @$devices, '-watchdog-action', $wdopts->{action} if $wdopts->{action};
3076     }
3077
3078     my $vollist = [];
3079     my $scsicontroller = {};
3080     my $ahcicontroller = {};
3081     my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : $defaults->{scsihw};
3082
3083     # Add iscsi initiator name if available
3084     if (my $initiator = get_initiator_name()) {
3085         push @$devices, '-iscsi', "initiator-name=$initiator";
3086     }
3087
3088     foreach_drive($conf, sub {
3089         my ($ds, $drive) = @_;
3090
3091         if (PVE::Storage::parse_volume_id($drive->{file}, 1)) {
3092             push @$vollist, $drive->{file};
3093         }
3094
3095         $use_virtio = 1 if $ds =~ m/^virtio/;
3096
3097         if (drive_is_cdrom ($drive)) {
3098             if ($bootindex_hash->{d}) {
3099                 $drive->{bootindex} = $bootindex_hash->{d};
3100                 $bootindex_hash->{d} += 1;
3101             }
3102         } else {
3103             if ($bootindex_hash->{c}) {
3104                 $drive->{bootindex} = $bootindex_hash->{c} if $conf->{bootdisk} && ($conf->{bootdisk} eq $ds);
3105                 $bootindex_hash->{c} += 1;
3106             }
3107         }
3108
3109         if ($drive->{interface} eq 'scsi') {
3110
3111             my $maxdev = ($scsihw !~ m/^lsi/) ? 256 : 7;
3112             my $controller = int($drive->{index} / $maxdev);
3113             $pciaddr = print_pci_addr("scsihw$controller", $bridges);
3114             push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
3115             $scsicontroller->{$controller}=1;
3116         }
3117
3118         if ($drive->{interface} eq 'sata') {
3119            my $controller = int($drive->{index} / $MAX_SATA_DISKS);
3120            $pciaddr = print_pci_addr("ahci$controller", $bridges);
3121            push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
3122            $ahcicontroller->{$controller}=1;
3123         }
3124
3125         my $drive_cmd = print_drive_full($storecfg, $vmid, $drive);
3126         push @$devices, '-drive',$drive_cmd;
3127         push @$devices, '-device', print_drivedevice_full($storecfg, $conf, $vmid, $drive, $bridges);
3128     });
3129
3130     for (my $i = 0; $i < $MAX_NETS; $i++) {
3131          next if !$conf->{"net$i"};
3132          my $d = parse_net($conf->{"net$i"});
3133          next if !$d;
3134
3135          $use_virtio = 1 if $d->{model} eq 'virtio';
3136
3137          if ($bootindex_hash->{n}) {
3138             $d->{bootindex} = $bootindex_hash->{n};
3139             $bootindex_hash->{n} += 1;
3140          }
3141
3142          my $netdevfull = print_netdev_full($vmid,$conf,$d,"net$i");
3143          push @$devices, '-netdev', $netdevfull;
3144
3145          my $netdevicefull = print_netdevice_full($vmid,$conf,$d,"net$i",$bridges);
3146          push @$devices, '-device', $netdevicefull;
3147     }
3148
3149     if (!$q35) {
3150         # add pci bridges
3151         while (my ($k, $v) = each %$bridges) {
3152             $pciaddr = print_pci_addr("pci.$k");
3153             unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
3154         }
3155     }
3156
3157     # hack: virtio with fairsched is unreliable, so we do not use fairsched
3158     # when the VM uses virtio devices.
3159     if (!$use_virtio && $have_ovz) {
3160
3161         my $cpuunits = defined($conf->{cpuunits}) ?
3162             $conf->{cpuunits} : $defaults->{cpuunits};
3163
3164         push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
3165
3166         # fixme: cpulimit is currently ignored
3167         #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
3168     }
3169
3170     # add custom args
3171     if ($conf->{args}) {
3172         my $aa = PVE::Tools::split_args($conf->{args});
3173         push @$cmd, @$aa;
3174     }
3175
3176     push @$cmd, @$devices;
3177     push @$cmd, '-rtc', join(',', @$rtcFlags)
3178         if scalar(@$rtcFlags);
3179     push @$cmd, '-machine', join(',', @$machineFlags)
3180         if scalar(@$machineFlags);
3181     push @$cmd, '-global', join(',', @$globalFlags)
3182         if scalar(@$globalFlags);
3183
3184     return wantarray ? ($cmd, $vollist, $spice_port) : $cmd;
3185 }
3186
3187 sub vnc_socket {
3188     my ($vmid) = @_;
3189     return "${var_run_tmpdir}/$vmid.vnc";
3190 }
3191
3192 sub spice_port {
3193     my ($vmid) = @_;
3194
3195     my $res = vm_mon_cmd($vmid, 'query-spice');
3196
3197     return $res->{'tls-port'} || $res->{'port'} || die "no spice port\n";
3198 }
3199
3200 sub qmp_socket {
3201     my ($vmid, $qga) = @_;
3202     my $sockettype = $qga ? 'qga' : 'qmp';
3203     return "${var_run_tmpdir}/$vmid.$sockettype";
3204 }
3205
3206 sub pidfile_name {
3207     my ($vmid) = @_;
3208     return "${var_run_tmpdir}/$vmid.pid";
3209 }
3210
3211 sub vm_devices_list {
3212     my ($vmid) = @_;
3213
3214     my $res = vm_mon_cmd($vmid, 'query-pci');
3215     my $devices = {};
3216     foreach my $pcibus (@$res) {
3217         foreach my $device (@{$pcibus->{devices}}) {
3218             next if !$device->{'qdev_id'};
3219             if ($device->{'pci_bridge'}) {
3220                 $devices->{$device->{'qdev_id'}} = 1;
3221                 foreach my $bridge_device (@{$device->{'pci_bridge'}->{devices}}) {
3222                     next if !$bridge_device->{'qdev_id'};
3223                     $devices->{$bridge_device->{'qdev_id'}} = 1;
3224                     $devices->{$device->{'qdev_id'}}++;
3225                 }
3226             } else {
3227                 $devices->{$device->{'qdev_id'}} = 1;
3228             }
3229         }
3230     }
3231
3232     my $resblock = vm_mon_cmd($vmid, 'query-block');
3233     foreach my $block (@$resblock) {
3234         if($block->{device} =~ m/^drive-(\S+)/){
3235                 $devices->{$1} = 1;
3236         }
3237     }
3238
3239     my $resmice = vm_mon_cmd($vmid, 'query-mice');
3240     foreach my $mice (@$resmice) {
3241         if ($mice->{name} eq 'QEMU HID Tablet') {
3242             $devices->{tablet} = 1;
3243             last;
3244         }
3245     }
3246
3247     return $devices;
3248 }
3249
3250 sub vm_deviceplug {
3251     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
3252
3253     my $q35 = machine_type_is_q35($conf);
3254
3255     my $devices_list = vm_devices_list($vmid);
3256     return 1 if defined($devices_list->{$deviceid});
3257
3258     qemu_add_pci_bridge($storecfg, $conf, $vmid, $deviceid); # add PCI bridge if we need it for the device
3259
3260     if ($deviceid eq 'tablet') {
3261
3262         qemu_deviceadd($vmid, print_tabletdevice_full($conf));
3263
3264     } elsif ($deviceid =~ m/^(virtio)(\d+)$/) {
3265
3266         qemu_driveadd($storecfg, $vmid, $device);
3267         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
3268
3269         qemu_deviceadd($vmid, $devicefull);
3270         eval { qemu_deviceaddverify($vmid, $deviceid); };
3271         if (my $err = $@) {
3272             eval { qemu_drivedel($vmid, $deviceid); };
3273             warn $@ if $@;
3274             die $err;
3275         }
3276
3277     } elsif ($deviceid =~ m/^(scsihw)(\d+)$/) {
3278
3279         my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : "lsi";
3280         my $pciaddr = print_pci_addr($deviceid);
3281         my $devicefull = "$scsihw,id=$deviceid$pciaddr";
3282
3283         qemu_deviceadd($vmid, $devicefull);
3284         qemu_deviceaddverify($vmid, $deviceid);
3285
3286     } elsif ($deviceid =~ m/^(scsi)(\d+)$/) {
3287
3288         qemu_findorcreatescsihw($storecfg,$conf, $vmid, $device);
3289         qemu_driveadd($storecfg, $vmid, $device);
3290
3291         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
3292         eval { qemu_deviceadd($vmid, $devicefull); };
3293         if (my $err = $@) {
3294             eval { qemu_drivedel($vmid, $deviceid); };
3295             warn $@ if $@;
3296             die $err;
3297         }
3298
3299     } elsif ($deviceid =~ m/^(net)(\d+)$/) {
3300
3301         return undef if !qemu_netdevadd($vmid, $conf, $device, $deviceid);
3302         my $netdevicefull = print_netdevice_full($vmid, $conf, $device, $deviceid);
3303         qemu_deviceadd($vmid, $netdevicefull);
3304         eval { qemu_deviceaddverify($vmid, $deviceid); };
3305         if (my $err = $@) {
3306             eval { qemu_netdevdel($vmid, $deviceid); };
3307             warn $@ if $@;
3308             die $err;
3309         }
3310
3311     } elsif (!$q35 && $deviceid =~ m/^(pci\.)(\d+)$/) {
3312
3313         my $bridgeid = $2;
3314         my $pciaddr = print_pci_addr($deviceid);
3315         my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
3316
3317         qemu_deviceadd($vmid, $devicefull);
3318         qemu_deviceaddverify($vmid, $deviceid);
3319
3320     } else {
3321         die "can't hotplug device '$deviceid'\n";
3322     }
3323
3324     return 1;
3325 }
3326
3327 # fixme: this should raise exceptions on error!
3328 sub vm_deviceunplug {
3329     my ($vmid, $conf, $deviceid) = @_;
3330
3331     my $devices_list = vm_devices_list($vmid);
3332     return 1 if !defined($devices_list->{$deviceid});
3333
3334     die "can't unplug bootdisk" if $conf->{bootdisk} && $conf->{bootdisk} eq $deviceid;
3335
3336     if ($deviceid eq 'tablet') {
3337
3338         qemu_devicedel($vmid, $deviceid);
3339
3340     } elsif ($deviceid =~ m/^(virtio)(\d+)$/) {
3341
3342         qemu_devicedel($vmid, $deviceid);
3343         qemu_devicedelverify($vmid, $deviceid);
3344         qemu_drivedel($vmid, $deviceid);
3345
3346     } elsif ($deviceid =~ m/^(lsi)(\d+)$/) {
3347
3348         qemu_devicedel($vmid, $deviceid);
3349
3350     } elsif ($deviceid =~ m/^(scsi)(\d+)$/) {
3351
3352         qemu_devicedel($vmid, $deviceid);
3353         qemu_drivedel($vmid, $deviceid);
3354
3355     } elsif ($deviceid =~ m/^(net)(\d+)$/) {
3356
3357         qemu_devicedel($vmid, $deviceid);
3358         qemu_devicedelverify($vmid, $deviceid);
3359         qemu_netdevdel($vmid, $deviceid);
3360
3361     } else {
3362         die "can't unplug device '$deviceid'\n";
3363     }
3364
3365     return 1;
3366 }
3367
3368 sub qemu_deviceadd {
3369     my ($vmid, $devicefull) = @_;
3370
3371     $devicefull = "driver=".$devicefull;
3372     my %options =  split(/[=,]/, $devicefull);
3373
3374     vm_mon_cmd($vmid, "device_add" , %options);
3375 }
3376
3377 sub qemu_devicedel {
3378     my ($vmid, $deviceid) = @_;
3379
3380     my $ret = vm_mon_cmd($vmid, "device_del", id => $deviceid);
3381 }
3382
3383 sub qemu_objectadd {
3384     my($vmid, $objectid, $qomtype) = @_;
3385
3386     vm_mon_cmd($vmid, "object-add", id => $objectid, "qom-type" => $qomtype);
3387
3388     return 1;
3389 }
3390
3391 sub qemu_objectdel {
3392     my($vmid, $objectid) = @_;
3393
3394     vm_mon_cmd($vmid, "object-del", id => $objectid);
3395
3396     return 1;
3397 }
3398
3399 sub qemu_driveadd {
3400     my ($storecfg, $vmid, $device) = @_;
3401
3402     my $drive = print_drive_full($storecfg, $vmid, $device);
3403     $drive =~ s/\\/\\\\/g;
3404     my $ret = vm_human_monitor_command($vmid, "drive_add auto \"$drive\"");
3405
3406     # If the command succeeds qemu prints: "OK"
3407     return 1 if $ret =~ m/OK/s;
3408
3409     die "adding drive failed: $ret\n";
3410 }
3411
3412 sub qemu_drivedel {
3413     my($vmid, $deviceid) = @_;
3414
3415     my $ret = vm_human_monitor_command($vmid, "drive_del drive-$deviceid");
3416     $ret =~ s/^\s+//;
3417
3418     return 1 if $ret eq "";
3419
3420     # NB: device not found errors mean the drive was auto-deleted and we ignore the error
3421     return 1 if $ret =~ m/Device \'.*?\' not found/s;
3422
3423     die "deleting drive $deviceid failed : $ret\n";
3424 }
3425
3426 sub qemu_deviceaddverify {
3427     my ($vmid, $deviceid) = @_;
3428
3429     for (my $i = 0; $i <= 5; $i++) {
3430          my $devices_list = vm_devices_list($vmid);
3431          return 1 if defined($devices_list->{$deviceid});
3432          sleep 1;
3433     }
3434
3435     die "error on hotplug device '$deviceid'\n";
3436 }
3437
3438
3439 sub qemu_devicedelverify {
3440     my ($vmid, $deviceid) = @_;
3441
3442     # need to verify that the device is correctly removed as device_del
3443     # is async and empty return is not reliable
3444
3445     for (my $i = 0; $i <= 5; $i++) {
3446          my $devices_list = vm_devices_list($vmid);
3447          return 1 if !defined($devices_list->{$deviceid});
3448          sleep 1;
3449     }
3450
3451     die "error on hot-unplugging device '$deviceid'\n";
3452 }
3453
3454 sub qemu_findorcreatescsihw {
3455     my ($storecfg, $conf, $vmid, $device) = @_;
3456
3457     my $maxdev = ($conf->{scsihw} && ($conf->{scsihw} !~ m/^lsi/)) ? 256 : 7;
3458     my $controller = int($device->{index} / $maxdev);
3459     my $scsihwid="scsihw$controller";
3460     my $devices_list = vm_devices_list($vmid);
3461
3462     if(!defined($devices_list->{$scsihwid})) {
3463         vm_deviceplug($storecfg, $conf, $vmid, $scsihwid);
3464     }
3465
3466     return 1;
3467 }
3468
3469 sub qemu_add_pci_bridge {
3470     my ($storecfg, $conf, $vmid, $device) = @_;
3471
3472     my $bridges = {};
3473
3474     my $bridgeid;
3475
3476     print_pci_addr($device, $bridges);
3477
3478     while (my ($k, $v) = each %$bridges) {
3479         $bridgeid = $k;
3480     }
3481     return 1 if !defined($bridgeid) || $bridgeid < 1;
3482
3483     my $bridge = "pci.$bridgeid";
3484     my $devices_list = vm_devices_list($vmid);
3485
3486     if (!defined($devices_list->{$bridge})) {
3487         vm_deviceplug($storecfg, $conf, $vmid, $bridge);
3488     }
3489
3490     return 1;
3491 }
3492
3493 sub qemu_set_link_status {
3494     my ($vmid, $device, $up) = @_;
3495
3496     vm_mon_cmd($vmid, "set_link", name => $device,
3497                up => $up ? JSON::true : JSON::false);
3498 }
3499
3500 sub qemu_netdevadd {
3501     my ($vmid, $conf, $device, $deviceid) = @_;
3502
3503     my $netdev = print_netdev_full($vmid, $conf, $device, $deviceid);
3504     my %options =  split(/[=,]/, $netdev);
3505
3506     vm_mon_cmd($vmid, "netdev_add",  %options);
3507     return 1;
3508 }
3509
3510 sub qemu_netdevdel {
3511     my ($vmid, $deviceid) = @_;
3512
3513     vm_mon_cmd($vmid, "netdev_del", id => $deviceid);
3514 }
3515
3516 sub qemu_cpu_hotplug {
3517     my ($vmid, $conf, $vcpus) = @_;
3518
3519     my $sockets = 1;
3520     $sockets = $conf->{smp} if $conf->{smp}; # old style - no longer iused
3521     $sockets = $conf->{sockets} if  $conf->{sockets};
3522     my $cores = $conf->{cores} || 1;
3523     my $maxcpus = $sockets * $cores;
3524
3525     $vcpus = $maxcpus if !$vcpus;
3526
3527     die "you can't add more vcpus than maxcpus\n"
3528         if $vcpus > $maxcpus;
3529
3530     my $currentvcpus = $conf->{vcpus} || $maxcpus;
3531     die "online cpu unplug is not yet possible\n"
3532         if $vcpus < $currentvcpus;
3533
3534     my $currentrunningvcpus = vm_mon_cmd($vmid, "query-cpus");
3535     die "vcpus in running vm is different than configuration\n"
3536         if scalar(@{$currentrunningvcpus}) != $currentvcpus;
3537
3538     for (my $i = $currentvcpus; $i < $vcpus; $i++) {
3539         vm_mon_cmd($vmid, "cpu-add", id => int($i));
3540     }
3541 }
3542
3543 sub qemu_memory_hotplug {
3544     my ($vmid, $conf, $defaults, $opt, $value) = @_;
3545
3546     return $value if !check_running($vmid);
3547
3548     my $memory = $conf->{memory} || $defaults->{memory};
3549     $value = $defaults->{memory} if !$value;
3550     return $value if $value == $memory;
3551
3552     my $static_memory = $STATICMEM;
3553     my $dimm_memory = $memory - $static_memory;
3554
3555     die "memory can't be lower than $static_memory MB" if $value < $static_memory;
3556     die "memory unplug is not yet available" if $value < $memory;
3557     die "you cannot add more memory than $MAX_MEM MB!\n" if $memory > $MAX_MEM;
3558
3559
3560     my $sockets = 1;
3561     $sockets = $conf->{sockets} if $conf->{sockets};
3562
3563     foreach_dimm($conf, $vmid, $value, $sockets, sub {
3564         my ($conf, $vmid, $name, $dimm_size, $numanode, $current_size, $memory) = @_;
3565
3566             return if $current_size <= $conf->{memory};
3567
3568             eval { vm_mon_cmd($vmid, "object-add", 'qom-type' => "memory-backend-ram", id => "mem-$name", props => { size => int($dimm_size*1024*1024) } ) };
3569             if (my $err = $@) {
3570                 eval { qemu_objectdel($vmid, "mem-$name"); };
3571                 die $err;
3572             }
3573
3574             eval { vm_mon_cmd($vmid, "device_add", driver => "pc-dimm", id => "$name", memdev => "mem-$name", node => $numanode) };
3575             if (my $err = $@) {
3576                 eval { qemu_objectdel($vmid, "mem-$name"); };
3577                 die $err;
3578             }
3579             #update conf after each succesful module hotplug
3580             $conf->{memory} = $current_size;
3581             update_config_nolock($vmid, $conf, 1);
3582     });
3583 }
3584
3585 sub qemu_block_set_io_throttle {
3586     my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
3587
3588     return if !check_running($vmid) ;
3589
3590     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));
3591
3592 }
3593
3594 # old code, only used to shutdown old VM after update
3595 sub __read_avail {
3596     my ($fh, $timeout) = @_;
3597
3598     my $sel = new IO::Select;
3599     $sel->add($fh);
3600
3601     my $res = '';
3602     my $buf;
3603
3604     my @ready;
3605     while (scalar (@ready = $sel->can_read($timeout))) {
3606         my $count;
3607         if ($count = $fh->sysread($buf, 8192)) {
3608             if ($buf =~ /^(.*)\(qemu\) $/s) {
3609                 $res .= $1;
3610                 last;
3611             } else {
3612                 $res .= $buf;
3613             }
3614         } else {
3615             if (!defined($count)) {
3616                 die "$!\n";
3617             }
3618             last;
3619         }
3620     }
3621
3622     die "monitor read timeout\n" if !scalar(@ready);
3623
3624     return $res;
3625 }
3626
3627 # old code, only used to shutdown old VM after update
3628 sub vm_monitor_command {
3629     my ($vmid, $cmdstr, $nocheck) = @_;
3630
3631     my $res;
3632
3633     eval {
3634         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
3635
3636         my $sname = "${var_run_tmpdir}/$vmid.mon";
3637
3638         my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
3639             die "unable to connect to VM $vmid socket - $!\n";
3640
3641         my $timeout = 3;
3642
3643         # hack: migrate sometime blocks the monitor (when migrate_downtime
3644         # is set)
3645         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3646             $timeout = 60*60; # 1 hour
3647         }
3648
3649         # read banner;
3650         my $data = __read_avail($sock, $timeout);
3651
3652         if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
3653             die "got unexpected qemu monitor banner\n";
3654         }
3655
3656         my $sel = new IO::Select;
3657         $sel->add($sock);
3658
3659         if (!scalar(my @ready = $sel->can_write($timeout))) {
3660             die "monitor write error - timeout";
3661         }
3662
3663         my $fullcmd = "$cmdstr\r";
3664
3665         # syslog('info', "VM $vmid monitor command: $cmdstr");
3666
3667         my $b;
3668         if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
3669             die "monitor write error - $!";
3670         }
3671
3672         return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
3673
3674         $timeout = 20;
3675
3676         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3677             $timeout = 60*60; # 1 hour
3678         } elsif ($cmdstr =~ m/^(eject|change)/) {
3679             $timeout = 60; # note: cdrom mount command is slow
3680         }
3681         if ($res = __read_avail($sock, $timeout)) {
3682
3683             my @lines = split("\r?\n", $res);
3684
3685             shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
3686
3687             $res = join("\n", @lines);
3688             $res .= "\n";
3689         }
3690     };
3691
3692     my $err = $@;
3693
3694     if ($err) {
3695         syslog("err", "VM $vmid monitor command failed - $err");
3696         die $err;
3697     }
3698
3699     return $res;
3700 }
3701
3702 sub qemu_block_resize {
3703     my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
3704
3705     my $running = check_running($vmid);
3706
3707     return if !PVE::Storage::volume_resize($storecfg, $volid, $size, $running);
3708
3709     return if !$running;
3710
3711     vm_mon_cmd($vmid, "block_resize", device => $deviceid, size => int($size));
3712
3713 }
3714
3715 sub qemu_volume_snapshot {
3716     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3717
3718     my $running = check_running($vmid);
3719
3720     return if !PVE::Storage::volume_snapshot($storecfg, $volid, $snap, $running);
3721
3722     return if !$running;
3723
3724     vm_mon_cmd($vmid, "snapshot-drive", device => $deviceid, name => $snap);
3725
3726 }
3727
3728 sub qemu_volume_snapshot_delete {
3729     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3730
3731     my $running = check_running($vmid);
3732
3733     return if !PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snap, $running);
3734
3735     return if !$running;
3736
3737     vm_mon_cmd($vmid, "delete-drive-snapshot", device => $deviceid, name => $snap);
3738 }
3739
3740 sub set_migration_caps {
3741     my ($vmid) = @_;
3742
3743     my $cap_ref = [];
3744
3745     my $enabled_cap = {
3746         "auto-converge" => 1,
3747         "xbzrle" => 0,
3748         "x-rdma-pin-all" => 0,
3749         "zero-blocks" => 0,
3750     };
3751
3752     my $supported_capabilities = vm_mon_cmd_nocheck($vmid, "query-migrate-capabilities");
3753
3754     for my $supported_capability (@$supported_capabilities) {
3755         push @$cap_ref, {
3756             capability => $supported_capability->{capability},
3757             state => $enabled_cap->{$supported_capability->{capability}} ? JSON::true : JSON::false,
3758         };
3759     }
3760
3761     vm_mon_cmd_nocheck($vmid, "migrate-set-capabilities", capabilities => $cap_ref);
3762 }
3763
3764 my $fast_plug_option = {
3765     'lock' => 1,
3766     'name' => 1,
3767     'onboot' => 1,
3768     'shares' => 1,
3769     'startup' => 1,
3770 };
3771
3772 # hotplug changes in [PENDING]
3773 # $selection hash can be used to only apply specified options, for
3774 # example: { cores => 1 } (only apply changed 'cores')
3775 # $errors ref is used to return error messages
3776 sub vmconfig_hotplug_pending {
3777     my ($vmid, $conf, $storecfg, $selection, $errors) = @_;
3778
3779     my $defaults = load_defaults();
3780
3781     # commit values which do not have any impact on running VM first
3782     # Note: those option cannot raise errors, we we do not care about
3783     # $selection and always apply them.
3784
3785     my $add_error = sub {
3786         my ($opt, $msg) = @_;
3787         $errors->{$opt} = "hotplug problem - $msg";
3788     };
3789
3790     my $changes = 0;
3791     foreach my $opt (keys %{$conf->{pending}}) { # add/change
3792         if ($fast_plug_option->{$opt}) {
3793             $conf->{$opt} = $conf->{pending}->{$opt};
3794             delete $conf->{pending}->{$opt};
3795             $changes = 1;
3796         }
3797     }
3798
3799     if ($changes) {
3800         update_config_nolock($vmid, $conf, 1);
3801         $conf = load_config($vmid); # update/reload
3802     }
3803
3804     my $hotplug_features = parse_hotplug_features(defined($conf->{hotplug}) ? $conf->{hotplug} : '1');
3805
3806     my @delete = PVE::Tools::split_list($conf->{pending}->{delete});
3807     foreach my $opt (@delete) {
3808         next if $selection && !$selection->{$opt};
3809         eval {
3810             if ($opt eq 'hotplug') {
3811                 die "skip\n" if ($conf->{hotplug} =~ /memory/);
3812             } elsif ($opt eq 'tablet') {
3813                 die "skip\n" if !$hotplug_features->{usb};
3814                 if ($defaults->{tablet}) {
3815                     vm_deviceplug($storecfg, $conf, $vmid, $opt);
3816                 } else {
3817                     vm_deviceunplug($vmid, $conf, $opt);
3818                 }
3819             } elsif ($opt eq 'vcpus') {
3820                 die "skip\n" if !$hotplug_features->{cpu};
3821                 qemu_cpu_hotplug($vmid, $conf, undef);
3822             } elsif ($opt eq 'balloon') {
3823                 # enable balloon device is not hotpluggable
3824                 die "skip\n" if !defined($conf->{balloon}) || $conf->{balloon};
3825             } elsif ($fast_plug_option->{$opt}) {
3826                 # do nothing
3827             } elsif ($opt =~ m/^net(\d+)$/) {
3828                 die "skip\n" if !$hotplug_features->{network};
3829                 vm_deviceunplug($vmid, $conf, $opt);
3830             } elsif (valid_drivename($opt)) {
3831                 die "skip\n" if !$hotplug_features->{disk} || $opt =~ m/(ide|sata)(\d+)/;
3832                 vm_deviceunplug($vmid, $conf, $opt);
3833                 vmconfig_register_unused_drive($storecfg, $vmid, $conf, parse_drive($opt, $conf->{$opt}));
3834             } elsif ($opt =~ m/^memory$/) {
3835                 die "skip\n" if !$hotplug_features->{memory};
3836                 qemu_memory_hotplug($vmid, $conf, $defaults, $opt);
3837             } else {
3838                 die "skip\n";
3839             }
3840         };
3841         if (my $err = $@) {
3842             &$add_error($opt, $err) if $err ne "skip\n";
3843         } else {
3844             # save new config if hotplug was successful
3845             delete $conf->{$opt};
3846             vmconfig_undelete_pending_option($conf, $opt);
3847             update_config_nolock($vmid, $conf, 1);
3848             $conf = load_config($vmid); # update/reload
3849         }
3850     }
3851
3852     foreach my $opt (keys %{$conf->{pending}}) {
3853         next if $selection && !$selection->{$opt};
3854         my $value = $conf->{pending}->{$opt};
3855         eval {
3856             if ($opt eq 'hotplug') {
3857                 die "skip\n" if ($value =~ /memory/) || ($value !~ /memory/ && $conf->{hotplug} =~ /memory/);
3858             } elsif ($opt eq 'tablet') {
3859                 die "skip\n" if !$hotplug_features->{usb};
3860                 if ($value == 1) {
3861                     vm_deviceplug($storecfg, $conf, $vmid, $opt);
3862                 } elsif ($value == 0) {
3863                     vm_deviceunplug($vmid, $conf, $opt);
3864                 }
3865             } elsif ($opt eq 'vcpus') {
3866                 die "skip\n" if !$hotplug_features->{cpu};
3867                 qemu_cpu_hotplug($vmid, $conf, $value);
3868             } elsif ($opt eq 'balloon') {
3869                 # enable/disable balloning device is not hotpluggable
3870                 my $old_balloon_enabled =  !!(!defined($conf->{balloon}) || $conf->{balloon});
3871                 my $new_balloon_enabled =  !!(!defined($conf->{pending}->{balloon}) || $conf->{pending}->{balloon});
3872                 die "skip\n" if $old_balloon_enabled != $new_balloon_enabled;
3873
3874                 # allow manual ballooning if shares is set to zero
3875                 if ((defined($conf->{shares}) && ($conf->{shares} == 0))) {
3876                     my $balloon = $conf->{pending}->{balloon} || $conf->{memory} || $defaults->{memory};
3877                     vm_mon_cmd($vmid, "balloon", value => $balloon*1024*1024);
3878                 }
3879             } elsif ($opt =~ m/^net(\d+)$/) {
3880                 # some changes can be done without hotplug
3881                 vmconfig_update_net($storecfg, $conf, $hotplug_features->{network},
3882                                     $vmid, $opt, $value);
3883             } elsif (valid_drivename($opt)) {
3884                 # some changes can be done without hotplug
3885                 vmconfig_update_disk($storecfg, $conf, $hotplug_features->{disk},
3886                                      $vmid, $opt, $value, 1);
3887             } elsif ($opt =~ m/^memory$/) { #dimms
3888                 die "skip\n" if !$hotplug_features->{memory};
3889                 $value = qemu_memory_hotplug($vmid, $conf, $defaults, $opt, $value);
3890             } else {
3891                 die "skip\n";  # skip non-hot-pluggable options
3892             }
3893         };
3894         if (my $err = $@) {
3895             &$add_error($opt, $err) if $err ne "skip\n";
3896         } else {
3897             # save new config if hotplug was successful
3898             $conf->{$opt} = $value;
3899             delete $conf->{pending}->{$opt};
3900             update_config_nolock($vmid, $conf, 1);
3901             $conf = load_config($vmid); # update/reload
3902         }
3903     }
3904 }
3905
3906 sub vmconfig_apply_pending {
3907     my ($vmid, $conf, $storecfg) = @_;
3908
3909     # cold plug
3910
3911     my @delete = PVE::Tools::split_list($conf->{pending}->{delete});
3912     foreach my $opt (@delete) { # delete
3913         die "internal error" if $opt =~ m/^unused/;
3914         $conf = load_config($vmid); # update/reload
3915         if (!defined($conf->{$opt})) {
3916             vmconfig_undelete_pending_option($conf, $opt);
3917             update_config_nolock($vmid, $conf, 1);
3918         } elsif (valid_drivename($opt)) {
3919             vmconfig_register_unused_drive($storecfg, $vmid, $conf, parse_drive($opt, $conf->{$opt}));
3920             vmconfig_undelete_pending_option($conf, $opt);
3921             delete $conf->{$opt};
3922             update_config_nolock($vmid, $conf, 1);
3923         } else {
3924             vmconfig_undelete_pending_option($conf, $opt);
3925             delete $conf->{$opt};
3926             update_config_nolock($vmid, $conf, 1);
3927         }
3928     }
3929
3930     $conf = load_config($vmid); # update/reload
3931
3932     foreach my $opt (keys %{$conf->{pending}}) { # add/change
3933         $conf = load_config($vmid); # update/reload
3934
3935         if (defined($conf->{$opt}) && ($conf->{$opt} eq $conf->{pending}->{$opt})) {
3936             # skip if nothing changed
3937         } elsif (valid_drivename($opt)) {
3938             vmconfig_register_unused_drive($storecfg, $vmid, $conf, parse_drive($opt, $conf->{$opt}))
3939                 if defined($conf->{$opt});
3940             $conf->{$opt} = $conf->{pending}->{$opt};
3941         } else {
3942             $conf->{$opt} = $conf->{pending}->{$opt};
3943         }
3944
3945         delete $conf->{pending}->{$opt};
3946         update_config_nolock($vmid, $conf, 1);
3947     }
3948 }
3949
3950 my $safe_num_ne = sub {
3951     my ($a, $b) = @_;
3952
3953     return 0 if !defined($a) && !defined($b);
3954     return 1 if !defined($a);
3955     return 1 if !defined($b);
3956
3957     return $a != $b;
3958 };
3959
3960 my $safe_string_ne = sub {
3961     my ($a, $b) = @_;
3962
3963     return 0 if !defined($a) && !defined($b);
3964     return 1 if !defined($a);
3965     return 1 if !defined($b);
3966
3967     return $a ne $b;
3968 };
3969
3970 sub vmconfig_update_net {
3971     my ($storecfg, $conf, $hotplug, $vmid, $opt, $value) = @_;
3972
3973     my $newnet = parse_net($value);
3974
3975     if ($conf->{$opt}) {
3976         my $oldnet = parse_net($conf->{$opt});
3977
3978         if (&$safe_string_ne($oldnet->{model}, $newnet->{model}) ||
3979             &$safe_string_ne($oldnet->{macaddr}, $newnet->{macaddr}) ||
3980             &$safe_num_ne($oldnet->{queues}, $newnet->{queues}) ||
3981             !($newnet->{bridge} && $oldnet->{bridge})) { # bridge/nat mode change
3982
3983             # for non online change, we try to hot-unplug
3984             die "skip\n" if !$hotplug;
3985             vm_deviceunplug($vmid, $conf, $opt);
3986         } else {
3987
3988             die "internal error" if $opt !~ m/net(\d+)/;
3989             my $iface = "tap${vmid}i$1";
3990
3991             if (&$safe_num_ne($oldnet->{rate}, $newnet->{rate})) {
3992                 PVE::Network::tap_rate_limit($iface, $newnet->{rate});
3993             }
3994
3995             if (&$safe_string_ne($oldnet->{bridge}, $newnet->{bridge}) ||
3996                 &$safe_num_ne($oldnet->{tag}, $newnet->{tag}) ||
3997                 &$safe_num_ne($oldnet->{firewall}, $newnet->{firewall})) {
3998                 PVE::Network::tap_unplug($iface);
3999                 PVE::Network::tap_plug($iface, $newnet->{bridge}, $newnet->{tag}, $newnet->{firewall});
4000             }
4001
4002             if (&$safe_string_ne($oldnet->{link_down}, $newnet->{link_down})) {
4003                 qemu_set_link_status($vmid, $opt, !$newnet->{link_down});
4004             }
4005
4006             return 1;
4007         }
4008     }
4009
4010     if ($hotplug) {
4011         vm_deviceplug($storecfg, $conf, $vmid, $opt, $newnet);
4012     } else {
4013         die "skip\n";
4014     }
4015 }
4016
4017 sub vmconfig_update_disk {
4018     my ($storecfg, $conf, $hotplug, $vmid, $opt, $value, $force) = @_;
4019
4020     # fixme: do we need force?
4021
4022     my $drive = parse_drive($opt, $value);
4023
4024     if ($conf->{$opt}) {
4025
4026         if (my $old_drive = parse_drive($opt, $conf->{$opt}))  {
4027
4028             my $media = $drive->{media} || 'disk';
4029             my $oldmedia = $old_drive->{media} || 'disk';
4030             die "unable to change media type\n" if $media ne $oldmedia;
4031
4032             if (!drive_is_cdrom($old_drive)) {
4033
4034                 if ($drive->{file} ne $old_drive->{file}) {
4035
4036                     die "skip\n" if !$hotplug;
4037
4038                     # unplug and register as unused
4039                     vm_deviceunplug($vmid, $conf, $opt);
4040                     vmconfig_register_unused_drive($storecfg, $vmid, $conf, $old_drive)
4041
4042                 } else {
4043                     # update existing disk
4044
4045                     # skip non hotpluggable value
4046                     if (&$safe_num_ne($drive->{discard}, $old_drive->{discard}) ||
4047                         &$safe_string_ne($drive->{cache}, $old_drive->{cache})) {
4048                         die "skip\n";
4049                     }
4050
4051                     # apply throttle
4052                     if (&$safe_num_ne($drive->{mbps}, $old_drive->{mbps}) ||
4053                         &$safe_num_ne($drive->{mbps_rd}, $old_drive->{mbps_rd}) ||
4054                         &$safe_num_ne($drive->{mbps_wr}, $old_drive->{mbps_wr}) ||
4055                         &$safe_num_ne($drive->{iops}, $old_drive->{iops}) ||
4056                         &$safe_num_ne($drive->{iops_rd}, $old_drive->{iops_rd}) ||
4057                         &$safe_num_ne($drive->{iops_wr}, $old_drive->{iops_wr}) ||
4058                         &$safe_num_ne($drive->{mbps_max}, $old_drive->{mbps_max}) ||
4059                         &$safe_num_ne($drive->{mbps_rd_max}, $old_drive->{mbps_rd_max}) ||
4060                         &$safe_num_ne($drive->{mbps_wr_max}, $old_drive->{mbps_wr_max}) ||
4061                         &$safe_num_ne($drive->{iops_max}, $old_drive->{iops_max}) ||
4062                         &$safe_num_ne($drive->{iops_rd_max}, $old_drive->{iops_rd_max}) ||
4063                         &$safe_num_ne($drive->{iops_wr_max}, $old_drive->{iops_wr_max})) {
4064
4065                         qemu_block_set_io_throttle($vmid,"drive-$opt",
4066                                                    ($drive->{mbps} || 0)*1024*1024,
4067                                                    ($drive->{mbps_rd} || 0)*1024*1024,
4068                                                    ($drive->{mbps_wr} || 0)*1024*1024,
4069                                                    $drive->{iops} || 0,
4070                                                    $drive->{iops_rd} || 0,
4071                                                    $drive->{iops_wr} || 0,
4072                                                    ($drive->{mbps_max} || 0)*1024*1024,
4073                                                    ($drive->{mbps_rd_max} || 0)*1024*1024,
4074                                                    ($drive->{mbps_wr_max} || 0)*1024*1024,
4075                                                    $drive->{iops_max} || 0,
4076                                                    $drive->{iops_rd_max} || 0,
4077                                                    $drive->{iops_wr_max} || 0);
4078
4079                     }
4080
4081                     return 1;
4082                 }
4083
4084             } else { # cdrom
4085
4086                 if ($drive->{file} eq 'none') {
4087                     vm_mon_cmd($vmid, "eject",force => JSON::true,device => "drive-$opt");
4088                 } else {
4089                     my $path = get_iso_path($storecfg, $vmid, $drive->{file});
4090                     vm_mon_cmd($vmid, "eject", force => JSON::true,device => "drive-$opt"); # force eject if locked
4091                     vm_mon_cmd($vmid, "change", device => "drive-$opt",target => "$path") if $path;
4092                 }
4093
4094                 return 1;
4095             }
4096         }
4097     }
4098
4099     die "skip\n" if !$hotplug || $opt =~ m/(ide|sata)(\d+)/;
4100     # hotplug new disks
4101     vm_deviceplug($storecfg, $conf, $vmid, $opt, $drive);
4102 }
4103
4104 sub vm_start {
4105     my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused, $forcemachine, $spice_ticket) = @_;
4106
4107     lock_config($vmid, sub {
4108         my $conf = load_config($vmid, $migratedfrom);
4109
4110         die "you can't start a vm if it's a template\n" if is_template($conf);
4111
4112         check_lock($conf) if !$skiplock;
4113
4114         die "VM $vmid already running\n" if check_running($vmid, undef, $migratedfrom);
4115
4116         if (!$statefile && scalar(keys %{$conf->{pending}})) {
4117             vmconfig_apply_pending($vmid, $conf, $storecfg);
4118             $conf = load_config($vmid); # update/reload
4119         }
4120
4121         my $defaults = load_defaults();
4122
4123         # set environment variable useful inside network script
4124         $ENV{PVE_MIGRATED_FROM} = $migratedfrom if $migratedfrom;
4125
4126         my ($cmd, $vollist, $spice_port) = config_to_command($storecfg, $vmid, $conf, $defaults, $forcemachine);
4127
4128         my $migrate_port = 0;
4129         my $migrate_uri;
4130         if ($statefile) {
4131             if ($statefile eq 'tcp') {
4132                 my $localip = "localhost";
4133                 my $datacenterconf = PVE::Cluster::cfs_read_file('datacenter.cfg');
4134                 if ($datacenterconf->{migration_unsecure}) {
4135                         my $nodename = PVE::INotify::nodename();
4136                         $localip = PVE::Cluster::remote_node_ip($nodename, 1);
4137                 }
4138                 $migrate_port = PVE::Tools::next_migrate_port();
4139                 $migrate_uri = "tcp:${localip}:${migrate_port}";
4140                 push @$cmd, '-incoming', $migrate_uri;
4141                 push @$cmd, '-S';
4142             } else {
4143                 push @$cmd, '-loadstate', $statefile;
4144             }
4145         } elsif ($paused) {
4146             push @$cmd, '-S';
4147         }
4148
4149         # host pci devices
4150         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
4151           my $d = parse_hostpci($conf->{"hostpci$i"});
4152           next if !$d;
4153           my $pcidevices = $d->{pciid};
4154           foreach my $pcidevice (@$pcidevices) {
4155                 my $pciid = $pcidevice->{id}.".".$pcidevice->{function};
4156
4157                 my $info = pci_device_info("0000:$pciid");
4158                 die "IOMMU not present\n" if !check_iommu_support();
4159                 die "no pci device info for device '$pciid'\n" if !$info;
4160
4161                 if ($d->{driver} && $d->{driver} eq "vfio") {
4162                     die "can't unbind/bind pci group to vfio '$pciid'\n" if !pci_dev_group_bind_to_vfio($pciid);
4163                 } else {
4164                     die "can't unbind/bind to stub pci device '$pciid'\n" if !pci_dev_bind_to_stub($info);
4165                 }
4166
4167                 die "can't reset pci device '$pciid'\n" if $info->{has_fl_reset} and !pci_dev_reset($info);
4168           }
4169         }
4170
4171         PVE::Storage::activate_volumes($storecfg, $vollist);
4172
4173         eval  { run_command($cmd, timeout => $statefile ? undef : 30,
4174                     umask => 0077); };
4175         my $err = $@;
4176         die "start failed: $err" if $err;
4177
4178         print "migration listens on $migrate_uri\n" if $migrate_uri;
4179
4180         if ($statefile && $statefile ne 'tcp')  {
4181             eval { vm_mon_cmd_nocheck($vmid, "cont"); };
4182             warn $@ if $@;
4183         }
4184
4185         if ($migratedfrom) {
4186
4187             eval {
4188                 set_migration_caps($vmid);
4189             };
4190             warn $@ if $@;
4191
4192             if ($spice_port) {
4193                 print "spice listens on port $spice_port\n";
4194                 if ($spice_ticket) {
4195                     vm_mon_cmd_nocheck($vmid, "set_password", protocol => 'spice', password => $spice_ticket);
4196                     vm_mon_cmd_nocheck($vmid, "expire_password", protocol => 'spice', time => "+30");
4197                 }
4198             }
4199
4200         } else {
4201
4202             if (!$statefile && (!defined($conf->{balloon}) || $conf->{balloon})) {
4203                 vm_mon_cmd_nocheck($vmid, "balloon", value => $conf->{balloon}*1024*1024)
4204                     if $conf->{balloon};
4205             }
4206
4207             foreach my $opt (keys %$conf) {
4208                 next if $opt !~  m/^net\d+$/;
4209                 my $nicconf = parse_net($conf->{$opt});
4210                 qemu_set_link_status($vmid, $opt, 0) if $nicconf->{link_down};
4211             }
4212         }
4213
4214         vm_mon_cmd_nocheck($vmid, 'qom-set',
4215                     path => "machine/peripheral/balloon0",
4216                     property => "guest-stats-polling-interval",
4217                     value => 2) if (!defined($conf->{balloon}) || $conf->{balloon});
4218
4219     });
4220 }
4221
4222 sub vm_mon_cmd {
4223     my ($vmid, $execute, %params) = @_;
4224
4225     my $cmd = { execute => $execute, arguments => \%params };
4226     vm_qmp_command($vmid, $cmd);
4227 }
4228
4229 sub vm_mon_cmd_nocheck {
4230     my ($vmid, $execute, %params) = @_;
4231
4232     my $cmd = { execute => $execute, arguments => \%params };
4233     vm_qmp_command($vmid, $cmd, 1);
4234 }
4235
4236 sub vm_qmp_command {
4237     my ($vmid, $cmd, $nocheck) = @_;
4238
4239     my $res;
4240
4241     my $timeout;
4242     if ($cmd->{arguments} && $cmd->{arguments}->{timeout}) {
4243         $timeout = $cmd->{arguments}->{timeout};
4244         delete $cmd->{arguments}->{timeout};
4245     }
4246
4247     eval {
4248         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
4249         my $sname = qmp_socket($vmid);
4250         if (-e $sname) { # test if VM is reasonambe new and supports qmp/qga
4251             my $qmpclient = PVE::QMPClient->new();
4252
4253             $res = $qmpclient->cmd($vmid, $cmd, $timeout);
4254         } elsif (-e "${var_run_tmpdir}/$vmid.mon") {
4255             die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
4256                 if scalar(%{$cmd->{arguments}});
4257             vm_monitor_command($vmid, $cmd->{execute}, $nocheck);
4258         } else {
4259             die "unable to open monitor socket\n";
4260         }
4261     };
4262     if (my $err = $@) {
4263         syslog("err", "VM $vmid qmp command failed - $err");
4264         die $err;
4265     }
4266
4267     return $res;
4268 }
4269
4270 sub vm_human_monitor_command {
4271     my ($vmid, $cmdline) = @_;
4272
4273     my $res;
4274
4275     my $cmd = {
4276         execute => 'human-monitor-command',
4277         arguments => { 'command-line' => $cmdline},
4278     };
4279
4280     return vm_qmp_command($vmid, $cmd);
4281 }
4282
4283 sub vm_commandline {
4284     my ($storecfg, $vmid) = @_;
4285
4286     my $conf = load_config($vmid);
4287
4288     my $defaults = load_defaults();
4289
4290     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
4291
4292     return join(' ', @$cmd);
4293 }
4294
4295 sub vm_reset {
4296     my ($vmid, $skiplock) = @_;
4297
4298     lock_config($vmid, sub {
4299
4300         my $conf = load_config($vmid);
4301
4302         check_lock($conf) if !$skiplock;
4303
4304         vm_mon_cmd($vmid, "system_reset");
4305     });
4306 }
4307
4308 sub get_vm_volumes {
4309     my ($conf) = @_;
4310
4311     my $vollist = [];
4312     foreach_volid($conf, sub {
4313         my ($volid, $is_cdrom) = @_;
4314
4315         return if $volid =~ m|^/|;
4316
4317         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
4318         return if !$sid;
4319
4320         push @$vollist, $volid;
4321     });
4322
4323     return $vollist;
4324 }
4325
4326 sub vm_stop_cleanup {
4327     my ($storecfg, $vmid, $conf, $keepActive, $apply_pending_changes) = @_;
4328
4329     eval {
4330         fairsched_rmnod($vmid); # try to destroy group
4331
4332         if (!$keepActive) {
4333             my $vollist = get_vm_volumes($conf);
4334             PVE::Storage::deactivate_volumes($storecfg, $vollist);
4335         }
4336
4337         foreach my $ext (qw(mon qmp pid vnc qga)) {
4338             unlink "/var/run/qemu-server/${vmid}.$ext";
4339         }
4340
4341         vmconfig_apply_pending($vmid, $conf, $storecfg) if $apply_pending_changes;
4342     };
4343     warn $@ if $@; # avoid errors - just warn
4344 }
4345
4346 # Note: use $nockeck to skip tests if VM configuration file exists.
4347 # We need that when migration VMs to other nodes (files already moved)
4348 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
4349 sub vm_stop {
4350     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
4351
4352     $force = 1 if !defined($force) && !$shutdown;
4353
4354     if ($migratedfrom){
4355         my $pid = check_running($vmid, $nocheck, $migratedfrom);
4356         kill 15, $pid if $pid;
4357         my $conf = load_config($vmid, $migratedfrom);
4358         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive, 0);
4359         return;
4360     }
4361
4362     lock_config($vmid, sub {
4363
4364         my $pid = check_running($vmid, $nocheck);
4365         return if !$pid;
4366
4367         my $conf;
4368         if (!$nocheck) {
4369             $conf = load_config($vmid);
4370             check_lock($conf) if !$skiplock;
4371             if (!defined($timeout) && $shutdown && $conf->{startup}) {
4372                 my $opts = parse_startup($conf->{startup});
4373                 $timeout = $opts->{down} if $opts->{down};
4374             }
4375         }
4376
4377         $timeout = 60 if !defined($timeout);
4378
4379         eval {
4380             if ($shutdown) {
4381                 if (defined($conf) && $conf->{agent}) {
4382                     vm_qmp_command($vmid, { execute => "guest-shutdown" }, $nocheck);
4383                 } else {
4384                     vm_qmp_command($vmid, { execute => "system_powerdown" }, $nocheck);
4385                 }
4386             } else {
4387                 vm_qmp_command($vmid, { execute => "quit" }, $nocheck);
4388             }
4389         };
4390         my $err = $@;
4391
4392         if (!$err) {
4393             my $count = 0;
4394             while (($count < $timeout) && check_running($vmid, $nocheck)) {
4395                 $count++;
4396                 sleep 1;
4397             }
4398
4399             if ($count >= $timeout) {
4400                 if ($force) {
4401                     warn "VM still running - terminating now with SIGTERM\n";
4402                     kill 15, $pid;
4403                 } else {
4404                     die "VM quit/powerdown failed - got timeout\n";
4405                 }
4406             } else {
4407                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive, 1) if $conf;
4408                 return;
4409             }
4410         } else {
4411             if ($force) {
4412                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
4413                 kill 15, $pid;
4414             } else {
4415                 die "VM quit/powerdown failed\n";
4416             }
4417         }
4418
4419         # wait again
4420         $timeout = 10;
4421
4422         my $count = 0;
4423         while (($count < $timeout) && check_running($vmid, $nocheck)) {
4424             $count++;
4425             sleep 1;
4426         }
4427
4428         if ($count >= $timeout) {
4429             warn "VM still running - terminating now with SIGKILL\n";
4430             kill 9, $pid;
4431             sleep 1;
4432         }
4433
4434         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive, 1) if $conf;
4435    });
4436 }
4437
4438 sub vm_suspend {
4439     my ($vmid, $skiplock) = @_;
4440
4441     lock_config($vmid, sub {
4442
4443         my $conf = load_config($vmid);
4444
4445         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
4446
4447         vm_mon_cmd($vmid, "stop");
4448     });
4449 }
4450
4451 sub vm_resume {
4452     my ($vmid, $skiplock) = @_;
4453
4454     lock_config($vmid, sub {
4455
4456         my $conf = load_config($vmid);
4457
4458         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
4459
4460         vm_mon_cmd($vmid, "cont");
4461     });
4462 }
4463
4464 sub vm_sendkey {
4465     my ($vmid, $skiplock, $key) = @_;
4466
4467     lock_config($vmid, sub {
4468
4469         my $conf = load_config($vmid);
4470
4471         # there is no qmp command, so we use the human monitor command
4472         vm_human_monitor_command($vmid, "sendkey $key");
4473     });
4474 }
4475
4476 sub vm_destroy {
4477     my ($storecfg, $vmid, $skiplock) = @_;
4478
4479     lock_config($vmid, sub {
4480
4481         my $conf = load_config($vmid);
4482
4483         check_lock($conf) if !$skiplock;
4484
4485         if (!check_running($vmid)) {
4486             fairsched_rmnod($vmid); # try to destroy group
4487             destroy_vm($storecfg, $vmid);
4488         } else {
4489             die "VM $vmid is running - destroy failed\n";
4490         }
4491     });
4492 }
4493
4494 # pci helpers
4495
4496 sub file_write {
4497     my ($filename, $buf) = @_;
4498
4499     my $fh = IO::File->new($filename, "w");
4500     return undef if !$fh;
4501
4502     my $res = print $fh $buf;
4503
4504     $fh->close();
4505
4506     return $res;
4507 }
4508
4509 sub pci_device_info {
4510     my ($name) = @_;
4511
4512     my $res;
4513
4514     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
4515     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
4516
4517     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
4518     return undef if !defined($irq) || $irq !~ m/^\d+$/;
4519
4520     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
4521     return undef if !defined($vendor) || $vendor !~ s/^0x//;
4522
4523     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
4524     return undef if !defined($product) || $product !~ s/^0x//;
4525
4526     $res = {
4527         name => $name,
4528         vendor => $vendor,
4529         product => $product,
4530         domain => $domain,
4531         bus => $bus,
4532         slot => $slot,
4533         func => $func,
4534         irq => $irq,
4535         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
4536     };
4537
4538     return $res;
4539 }
4540
4541 sub pci_dev_reset {
4542     my ($dev) = @_;
4543
4544     my $name = $dev->{name};
4545
4546     my $fn = "$pcisysfs/devices/$name/reset";
4547
4548     return file_write($fn, "1");
4549 }
4550
4551 sub pci_dev_bind_to_stub {
4552     my ($dev) = @_;
4553
4554     my $name = $dev->{name};
4555
4556     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
4557     return 1 if -d $testdir;
4558
4559     my $data = "$dev->{vendor} $dev->{product}";
4560     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
4561
4562     my $fn = "$pcisysfs/devices/$name/driver/unbind";
4563     if (!file_write($fn, $name)) {
4564         return undef if -f $fn;
4565     }
4566
4567     $fn = "$pcisysfs/drivers/pci-stub/bind";
4568     if (! -d $testdir) {
4569         return undef if !file_write($fn, $name);
4570     }
4571
4572     return -d $testdir;
4573 }
4574
4575 sub pci_dev_bind_to_vfio {
4576     my ($dev) = @_;
4577
4578     my $name = $dev->{name};
4579
4580     my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4581
4582     if (!-d $vfio_basedir) {
4583         system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4584     }
4585     die "Cannot find vfio-pci module!\n" if !-d $vfio_basedir;
4586
4587     my $testdir = "$vfio_basedir/$name";
4588     return 1 if -d $testdir;
4589
4590     my $data = "$dev->{vendor} $dev->{product}";
4591     return undef if !file_write("$vfio_basedir/new_id", $data);
4592
4593     my $fn = "$pcisysfs/devices/$name/driver/unbind";
4594     if (!file_write($fn, $name)) {
4595         return undef if -f $fn;
4596     }
4597
4598     $fn = "$vfio_basedir/bind";
4599     if (! -d $testdir) {
4600         return undef if !file_write($fn, $name);
4601     }
4602
4603     return -d $testdir;
4604 }
4605
4606 sub pci_dev_group_bind_to_vfio {
4607     my ($pciid) = @_;
4608
4609     my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4610
4611     if (!-d $vfio_basedir) {
4612         system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4613     }
4614     die "Cannot find vfio-pci module!\n" if !-d $vfio_basedir;
4615
4616     # get IOMMU group devices
4617     opendir(my $D, "$pcisysfs/devices/0000:$pciid/iommu_group/devices/") || die "Cannot open iommu_group: $!\n";
4618       my @devs = grep /^0000:/, readdir($D);
4619     closedir($D);
4620
4621     foreach my $pciid (@devs) {
4622         $pciid =~ m/^([:\.\da-f]+)$/ or die "PCI ID $pciid not valid!\n";
4623
4624         # pci bridges, switches or root ports are not supported
4625         # they have a pci_bus subdirectory so skip them
4626         next if (-e "$pcisysfs/devices/$pciid/pci_bus");
4627
4628         my $info = pci_device_info($1);
4629         pci_dev_bind_to_vfio($info) || die "Cannot bind $pciid to vfio\n";
4630     }
4631
4632     return 1;
4633 }
4634
4635 sub print_pci_addr {
4636     my ($id, $bridges) = @_;
4637
4638     my $res = '';
4639     my $devices = {
4640         piix3 => { bus => 0, addr => 1 },
4641         #addr2 : first videocard
4642         balloon0 => { bus => 0, addr => 3 },
4643         watchdog => { bus => 0, addr => 4 },
4644         scsihw0 => { bus => 0, addr => 5 },
4645         scsihw1 => { bus => 0, addr => 6 },
4646         ahci0 => { bus => 0, addr => 7 },
4647         qga0 => { bus => 0, addr => 8 },
4648         spice => { bus => 0, addr => 9 },
4649         virtio0 => { bus => 0, addr => 10 },
4650         virtio1 => { bus => 0, addr => 11 },
4651         virtio2 => { bus => 0, addr => 12 },
4652         virtio3 => { bus => 0, addr => 13 },
4653         virtio4 => { bus => 0, addr => 14 },
4654         virtio5 => { bus => 0, addr => 15 },
4655         hostpci0 => { bus => 0, addr => 16 },
4656         hostpci1 => { bus => 0, addr => 17 },
4657         net0 => { bus => 0, addr => 18 },
4658         net1 => { bus => 0, addr => 19 },
4659         net2 => { bus => 0, addr => 20 },
4660         net3 => { bus => 0, addr => 21 },
4661         net4 => { bus => 0, addr => 22 },
4662         net5 => { bus => 0, addr => 23 },
4663         vga1 => { bus => 0, addr => 24 },
4664         vga2 => { bus => 0, addr => 25 },
4665         vga3 => { bus => 0, addr => 26 },
4666         hostpci2 => { bus => 0, addr => 27 },
4667         hostpci3 => { bus => 0, addr => 28 },
4668         #addr29 : usb-host (pve-usb.cfg)
4669         'pci.1' => { bus => 0, addr => 30 },
4670         'pci.2' => { bus => 0, addr => 31 },
4671         'net6' => { bus => 1, addr => 1 },
4672         'net7' => { bus => 1, addr => 2 },
4673         'net8' => { bus => 1, addr => 3 },
4674         'net9' => { bus => 1, addr => 4 },
4675         'net10' => { bus => 1, addr => 5 },
4676         'net11' => { bus => 1, addr => 6 },
4677         'net12' => { bus => 1, addr => 7 },
4678         'net13' => { bus => 1, addr => 8 },
4679         'net14' => { bus => 1, addr => 9 },
4680         'net15' => { bus => 1, addr => 10 },
4681         'net16' => { bus => 1, addr => 11 },
4682         'net17' => { bus => 1, addr => 12 },
4683         'net18' => { bus => 1, addr => 13 },
4684         'net19' => { bus => 1, addr => 14 },
4685         'net20' => { bus => 1, addr => 15 },
4686         'net21' => { bus => 1, addr => 16 },
4687         'net22' => { bus => 1, addr => 17 },
4688         'net23' => { bus => 1, addr => 18 },
4689         'net24' => { bus => 1, addr => 19 },
4690         'net25' => { bus => 1, addr => 20 },
4691         'net26' => { bus => 1, addr => 21 },
4692         'net27' => { bus => 1, addr => 22 },
4693         'net28' => { bus => 1, addr => 23 },
4694         'net29' => { bus => 1, addr => 24 },
4695         'net30' => { bus => 1, addr => 25 },
4696         'net31' => { bus => 1, addr => 26 },
4697         'virtio6' => { bus => 2, addr => 1 },
4698         'virtio7' => { bus => 2, addr => 2 },
4699         'virtio8' => { bus => 2, addr => 3 },
4700         'virtio9' => { bus => 2, addr => 4 },
4701         'virtio10' => { bus => 2, addr => 5 },
4702         'virtio11' => { bus => 2, addr => 6 },
4703         'virtio12' => { bus => 2, addr => 7 },
4704         'virtio13' => { bus => 2, addr => 8 },
4705         'virtio14' => { bus => 2, addr => 9 },
4706         'virtio15' => { bus => 2, addr => 10 },
4707     };
4708
4709     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
4710            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
4711            my $bus = $devices->{$id}->{bus};
4712            $res = ",bus=pci.$bus,addr=$addr";
4713            $bridges->{$bus} = 1 if $bridges;
4714     }
4715     return $res;
4716
4717 }
4718
4719 sub print_pcie_addr {
4720     my ($id) = @_;
4721
4722     my $res = '';
4723     my $devices = {
4724         hostpci0 => { bus => "ich9-pcie-port-1", addr => 0 },
4725         hostpci1 => { bus => "ich9-pcie-port-2", addr => 0 },
4726         hostpci2 => { bus => "ich9-pcie-port-3", addr => 0 },
4727         hostpci3 => { bus => "ich9-pcie-port-4", addr => 0 },
4728     };
4729
4730     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
4731            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
4732            my $bus = $devices->{$id}->{bus};
4733            $res = ",bus=$bus,addr=$addr";
4734     }
4735     return $res;
4736
4737 }
4738
4739 # vzdump restore implementaion
4740
4741 sub tar_archive_read_firstfile {
4742     my $archive = shift;
4743
4744     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
4745
4746     # try to detect archive type first
4747     my $pid = open (TMP, "tar tf '$archive'|") ||
4748         die "unable to open file '$archive'\n";
4749     my $firstfile = <TMP>;
4750     kill 15, $pid;
4751     close TMP;
4752
4753     die "ERROR: archive contaions no data\n" if !$firstfile;
4754     chomp $firstfile;
4755
4756     return $firstfile;
4757 }
4758
4759 sub tar_restore_cleanup {
4760     my ($storecfg, $statfile) = @_;
4761
4762     print STDERR "starting cleanup\n";
4763
4764     if (my $fd = IO::File->new($statfile, "r")) {
4765         while (defined(my $line = <$fd>)) {
4766             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4767                 my $volid = $2;
4768                 eval {
4769                     if ($volid =~ m|^/|) {
4770                         unlink $volid || die 'unlink failed\n';
4771                     } else {
4772                         PVE::Storage::vdisk_free($storecfg, $volid);
4773                     }
4774                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
4775                 };
4776                 print STDERR "unable to cleanup '$volid' - $@" if $@;
4777             } else {
4778                 print STDERR "unable to parse line in statfile - $line";
4779             }
4780         }
4781         $fd->close();
4782     }
4783 }
4784
4785 sub restore_archive {
4786     my ($archive, $vmid, $user, $opts) = @_;
4787
4788     my $format = $opts->{format};
4789     my $comp;
4790
4791     if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
4792         $format = 'tar' if !$format;
4793         $comp = 'gzip';
4794     } elsif ($archive =~ m/\.tar$/) {
4795         $format = 'tar' if !$format;
4796     } elsif ($archive =~ m/.tar.lzo$/) {
4797         $format = 'tar' if !$format;
4798         $comp = 'lzop';
4799     } elsif ($archive =~ m/\.vma$/) {
4800         $format = 'vma' if !$format;
4801     } elsif ($archive =~ m/\.vma\.gz$/) {
4802         $format = 'vma' if !$format;
4803         $comp = 'gzip';
4804     } elsif ($archive =~ m/\.vma\.lzo$/) {
4805         $format = 'vma' if !$format;
4806         $comp = 'lzop';
4807     } else {
4808         $format = 'vma' if !$format; # default
4809     }
4810
4811     # try to detect archive format
4812     if ($format eq 'tar') {
4813         return restore_tar_archive($archive, $vmid, $user, $opts);
4814     } else {
4815         return restore_vma_archive($archive, $vmid, $user, $opts, $comp);
4816     }
4817 }
4818
4819 sub restore_update_config_line {
4820     my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
4821
4822     return if $line =~ m/^\#qmdump\#/;
4823     return if $line =~ m/^\#vzdump\#/;
4824     return if $line =~ m/^lock:/;
4825     return if $line =~ m/^unused\d+:/;
4826     return if $line =~ m/^parent:/;
4827     return if $line =~ m/^template:/; # restored VM is never a template
4828
4829     if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
4830         # try to convert old 1.X settings
4831         my ($id, $ind, $ethcfg) = ($1, $2, $3);
4832         foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
4833             my ($model, $macaddr) = split(/\=/, $devconfig);
4834             $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $unique;
4835             my $net = {
4836                 model => $model,
4837                 bridge => "vmbr$ind",
4838                 macaddr => $macaddr,
4839             };
4840             my $netstr = print_net($net);
4841
4842             print $outfd "net$cookie->{netcount}: $netstr\n";
4843             $cookie->{netcount}++;
4844         }
4845     } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
4846         my ($id, $netstr) = ($1, $2);
4847         my $net = parse_net($netstr);
4848         $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
4849         $netstr = print_net($net);
4850         print $outfd "$id: $netstr\n";
4851     } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
4852         my $virtdev = $1;
4853         my $value = $3;
4854         if ($line =~ m/backup=no/) {
4855             print $outfd "#$line";
4856         } elsif ($virtdev && $map->{$virtdev}) {
4857             my $di = parse_drive($virtdev, $value);
4858             delete $di->{format}; # format can change on restore
4859             $di->{file} = $map->{$virtdev};
4860             $value = print_drive($vmid, $di);
4861             print $outfd "$virtdev: $value\n";
4862         } else {
4863             print $outfd $line;
4864         }
4865     } else {
4866         print $outfd $line;
4867     }
4868 }
4869
4870 sub scan_volids {
4871     my ($cfg, $vmid) = @_;
4872
4873     my $info = PVE::Storage::vdisk_list($cfg, undef, $vmid);
4874
4875     my $volid_hash = {};
4876     foreach my $storeid (keys %$info) {
4877         foreach my $item (@{$info->{$storeid}}) {
4878             next if !($item->{volid} && $item->{size});
4879             $item->{path} = PVE::Storage::path($cfg, $item->{volid});
4880             $volid_hash->{$item->{volid}} = $item;
4881         }
4882     }
4883
4884     return $volid_hash;
4885 }
4886
4887 sub get_used_paths {
4888     my ($vmid, $storecfg, $conf, $scan_snapshots, $skip_drive) = @_;
4889
4890     my $used_path = {};
4891
4892     my $scan_config = sub {
4893         my ($cref, $snapname) = @_;
4894
4895         foreach my $key (keys %$cref) {
4896             my $value = $cref->{$key};
4897             if (valid_drivename($key)) {
4898                 next if $skip_drive && $key eq $skip_drive;
4899                 my $drive = parse_drive($key, $value);
4900                 next if !$drive || !$drive->{file} || drive_is_cdrom($drive);
4901                 if ($drive->{file} =~ m!^/!) {
4902                     $used_path->{$drive->{file}}++; # = 1;
4903                 } else {
4904                     my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file}, 1);
4905                     next if !$storeid;
4906                     my $scfg = PVE::Storage::storage_config($storecfg, $storeid, 1);
4907                     next if !$scfg;
4908                     my $path = PVE::Storage::path($storecfg, $drive->{file}, $snapname);
4909                     $used_path->{$path}++; # = 1;
4910                 }
4911             }
4912         }
4913     };
4914
4915     &$scan_config($conf);
4916
4917     undef $skip_drive;
4918
4919     if ($scan_snapshots) {
4920         foreach my $snapname (keys %{$conf->{snapshots}}) {
4921             &$scan_config($conf->{snapshots}->{$snapname}, $snapname);
4922         }
4923     }
4924
4925     return $used_path;
4926 }
4927
4928 sub update_disksize {
4929     my ($vmid, $conf, $volid_hash) = @_;
4930
4931     my $changes;
4932
4933     my $used = {};
4934
4935     # Note: it is allowed to define multiple storages with same path (alias), so
4936     # we need to check both 'volid' and real 'path' (two different volid can point
4937     # to the same path).
4938
4939     my $usedpath = {};
4940
4941     # update size info
4942     foreach my $opt (keys %$conf) {
4943         if (valid_drivename($opt)) {
4944             my $drive = parse_drive($opt, $conf->{$opt});
4945             my $volid = $drive->{file};
4946             next if !$volid;
4947
4948             $used->{$volid} = 1;
4949             if ($volid_hash->{$volid} &&
4950                 (my $path = $volid_hash->{$volid}->{path})) {
4951                 $usedpath->{$path} = 1;
4952             }
4953
4954             next if drive_is_cdrom($drive);
4955             next if !$volid_hash->{$volid};
4956
4957             $drive->{size} = $volid_hash->{$volid}->{size};
4958             my $new = print_drive($vmid, $drive);
4959             if ($new ne $conf->{$opt}) {
4960                 $changes = 1;
4961                 $conf->{$opt} = $new;
4962             }
4963         }
4964     }
4965
4966     # remove 'unusedX' entry if volume is used
4967     foreach my $opt (keys %$conf) {
4968         next if $opt !~ m/^unused\d+$/;
4969         my $volid = $conf->{$opt};
4970         my $path = $volid_hash->{$volid}->{path} if $volid_hash->{$volid};
4971         if ($used->{$volid} || ($path && $usedpath->{$path})) {
4972             $changes = 1;
4973             delete $conf->{$opt};
4974         }
4975     }
4976
4977     foreach my $volid (sort keys %$volid_hash) {
4978         next if $volid =~ m/vm-$vmid-state-/;
4979         next if $used->{$volid};
4980         my $path = $volid_hash->{$volid}->{path};
4981         next if !$path; # just to be sure
4982         next if $usedpath->{$path};
4983         $changes = 1;
4984         add_unused_volume($conf, $volid);
4985         $usedpath->{$path} = 1; # avoid to add more than once (aliases)
4986     }
4987
4988     return $changes;
4989 }
4990
4991 sub rescan {
4992     my ($vmid, $nolock) = @_;
4993
4994     my $cfg = PVE::Cluster::cfs_read_file("storage.cfg");
4995
4996     my $volid_hash = scan_volids($cfg, $vmid);
4997
4998     my $updatefn =  sub {
4999         my ($vmid) = @_;
5000
5001         my $conf = load_config($vmid);
5002
5003         check_lock($conf);
5004
5005         my $vm_volids = {};
5006         foreach my $volid (keys %$volid_hash) {
5007             my $info = $volid_hash->{$volid};
5008             $vm_volids->{$volid} = $info if $info->{vmid} && $info->{vmid} == $vmid;
5009         }
5010
5011         my $changes = update_disksize($vmid, $conf, $vm_volids);
5012
5013         update_config_nolock($vmid, $conf, 1) if $changes;
5014     };
5015
5016     if (defined($vmid)) {
5017         if ($nolock) {
5018             &$updatefn($vmid);
5019         } else {
5020             lock_config($vmid, $updatefn, $vmid);
5021         }
5022     } else {
5023         my $vmlist = config_list();
5024         foreach my $vmid (keys %$vmlist) {
5025             if ($nolock) {
5026                 &$updatefn($vmid);
5027             } else {
5028                 lock_config($vmid, $updatefn, $vmid);
5029             }
5030         }
5031     }
5032 }
5033
5034 sub restore_vma_archive {
5035     my ($archive, $vmid, $user, $opts, $comp) = @_;
5036
5037     my $input = $archive eq '-' ? "<&STDIN" : undef;
5038     my $readfrom = $archive;
5039
5040     my $uncomp = '';
5041     if ($comp) {
5042         $readfrom = '-';
5043         my $qarchive = PVE::Tools::shellquote($archive);
5044         if ($comp eq 'gzip') {
5045             $uncomp = "zcat $qarchive|";
5046         } elsif ($comp eq 'lzop') {
5047             $uncomp = "lzop -d -c $qarchive|";
5048         } else {
5049             die "unknown compression method '$comp'\n";
5050         }
5051
5052     }
5053
5054     my $tmpdir = "/var/tmp/vzdumptmp$$";
5055     rmtree $tmpdir;
5056
5057     # disable interrupts (always do cleanups)
5058     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
5059         warn "got interrupt - ignored\n";
5060     };
5061
5062     my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
5063     POSIX::mkfifo($mapfifo, 0600);
5064     my $fifofh;
5065
5066     my $openfifo = sub {
5067         open($fifofh, '>', $mapfifo) || die $!;
5068     };
5069
5070     my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
5071
5072     my $oldtimeout;
5073     my $timeout = 5;
5074
5075     my $devinfo = {};
5076
5077     my $rpcenv = PVE::RPCEnvironment::get();
5078
5079     my $conffile = config_file($vmid);
5080     my $tmpfn = "$conffile.$$.tmp";
5081
5082     # Note: $oldconf is undef if VM does not exists
5083     my $oldconf = PVE::Cluster::cfs_read_file(cfs_config_path($vmid));
5084
5085     my $print_devmap = sub {
5086         my $virtdev_hash = {};
5087
5088         my $cfgfn = "$tmpdir/qemu-server.conf";
5089
5090         # we can read the config - that is already extracted
5091         my $fh = IO::File->new($cfgfn, "r") ||
5092             "unable to read qemu-server.conf - $!\n";
5093
5094         while (defined(my $line = <$fh>)) {
5095             if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
5096                 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
5097                 die "archive does not contain data for drive '$virtdev'\n"
5098                     if !$devinfo->{$devname};
5099                 if (defined($opts->{storage})) {
5100                     $storeid = $opts->{storage} || 'local';
5101                 } elsif (!$storeid) {
5102                     $storeid = 'local';
5103                 }
5104                 $format = 'raw' if !$format;
5105                 $devinfo->{$devname}->{devname} = $devname;
5106                 $devinfo->{$devname}->{virtdev} = $virtdev;
5107                 $devinfo->{$devname}->{format} = $format;
5108                 $devinfo->{$devname}->{storeid} = $storeid;
5109
5110                 # check permission on storage
5111                 my $pool = $opts->{pool}; # todo: do we need that?
5112                 if ($user ne 'root@pam') {
5113                     $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
5114                 }
5115
5116                 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
5117             }
5118         }
5119
5120         foreach my $devname (keys %$devinfo) {
5121             die "found no device mapping information for device '$devname'\n"
5122                 if !$devinfo->{$devname}->{virtdev};
5123         }
5124
5125         my $cfg = cfs_read_file('storage.cfg');
5126
5127         # create empty/temp config
5128         if ($oldconf) {
5129             PVE::Tools::file_set_contents($conffile, "memory: 128\n");
5130             foreach_drive($oldconf, sub {
5131                 my ($ds, $drive) = @_;
5132
5133                 return if drive_is_cdrom($drive);
5134
5135                 my $volid = $drive->{file};
5136
5137                 return if !$volid || $volid =~ m|^/|;
5138
5139                 my ($path, $owner) = PVE::Storage::path($cfg, $volid);
5140                 return if !$path || !$owner || ($owner != $vmid);
5141
5142                 # Note: only delete disk we want to restore
5143                 # other volumes will become unused
5144                 if ($virtdev_hash->{$ds}) {
5145                     PVE::Storage::vdisk_free($cfg, $volid);
5146                 }
5147             });
5148         }
5149
5150         my $map = {};
5151         foreach my $virtdev (sort keys %$virtdev_hash) {
5152             my $d = $virtdev_hash->{$virtdev};
5153             my $alloc_size = int(($d->{size} + 1024 - 1)/1024);
5154             my $scfg = PVE::Storage::storage_config($cfg, $d->{storeid});
5155
5156             # test if requested format is supported
5157             my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($cfg, $d->{storeid});
5158             my $supported = grep { $_ eq $d->{format} } @$validFormats;
5159             $d->{format} = $defFormat if !$supported;
5160
5161             my $volid = PVE::Storage::vdisk_alloc($cfg, $d->{storeid}, $vmid,
5162                                                   $d->{format}, undef, $alloc_size);
5163             print STDERR "new volume ID is '$volid'\n";
5164             $d->{volid} = $volid;
5165             my $path = PVE::Storage::path($cfg, $volid);
5166
5167             my $write_zeros = 1;
5168             # fixme: what other storages types initialize volumes with zero?
5169             if ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs' || $scfg->{type} eq 'glusterfs' ||
5170                 $scfg->{type} eq 'sheepdog' || $scfg->{type} eq 'rbd') {
5171                 $write_zeros = 0;
5172             }
5173
5174             print $fifofh "${write_zeros}:$d->{devname}=$path\n";
5175
5176             print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
5177             $map->{$virtdev} = $volid;
5178         }
5179
5180         $fh->seek(0, 0) || die "seek failed - $!\n";
5181
5182         my $outfd = new IO::File ($tmpfn, "w") ||
5183             die "unable to write config for VM $vmid\n";
5184
5185         my $cookie = { netcount => 0 };
5186         while (defined(my $line = <$fh>)) {
5187             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
5188         }
5189
5190         $fh->close();
5191         $outfd->close();
5192     };
5193
5194     eval {
5195         # enable interrupts
5196         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
5197             die "interrupted by signal\n";
5198         };
5199         local $SIG{ALRM} = sub { die "got timeout\n"; };
5200
5201         $oldtimeout = alarm($timeout);
5202
5203         my $parser = sub {
5204             my $line = shift;
5205
5206             print "$line\n";
5207
5208             if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
5209                 my ($dev_id, $size, $devname) = ($1, $2, $3);
5210                 $devinfo->{$devname} = { size => $size, dev_id => $dev_id };
5211             } elsif ($line =~ m/^CTIME: /) {
5212                 # we correctly received the vma config, so we can disable
5213                 # the timeout now for disk allocation (set to 10 minutes, so
5214                 # that we always timeout if something goes wrong)
5215                 alarm(600);
5216                 &$print_devmap();
5217                 print $fifofh "done\n";
5218                 my $tmp = $oldtimeout || 0;
5219                 $oldtimeout = undef;
5220                 alarm($tmp);
5221                 close($fifofh);
5222             }
5223         };
5224
5225         print "restore vma archive: $cmd\n";
5226         run_command($cmd, input => $input, outfunc => $parser, afterfork => $openfifo);
5227     };
5228     my $err = $@;
5229
5230     alarm($oldtimeout) if $oldtimeout;
5231
5232     unlink $mapfifo;
5233
5234     if ($err) {
5235         rmtree $tmpdir;
5236         unlink $tmpfn;
5237
5238         my $cfg = cfs_read_file('storage.cfg');
5239         foreach my $devname (keys %$devinfo) {
5240             my $volid = $devinfo->{$devname}->{volid};
5241             next if !$volid;
5242             eval {
5243                 if ($volid =~ m|^/|) {
5244                     unlink $volid || die 'unlink failed\n';
5245                 } else {
5246                     PVE::Storage::vdisk_free($cfg, $volid);
5247                 }
5248                 print STDERR "temporary volume '$volid' sucessfuly removed\n";
5249             };
5250             print STDERR "unable to cleanup '$volid' - $@" if $@;
5251         }
5252         die $err;
5253     }
5254
5255     rmtree $tmpdir;
5256
5257     rename($tmpfn, $conffile) ||
5258         die "unable to commit configuration file '$conffile'\n";
5259
5260     PVE::Cluster::cfs_update(); # make sure we read new file
5261
5262     eval { rescan($vmid, 1); };
5263     warn $@ if $@;
5264 }
5265
5266 sub restore_tar_archive {
5267     my ($archive, $vmid, $user, $opts) = @_;
5268
5269     if ($archive ne '-') {
5270         my $firstfile = tar_archive_read_firstfile($archive);
5271         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
5272             if $firstfile ne 'qemu-server.conf';
5273     }
5274
5275     my $storecfg = cfs_read_file('storage.cfg');
5276
5277     # destroy existing data - keep empty config
5278     my $vmcfgfn = config_file($vmid);
5279     destroy_vm($storecfg, $vmid, 1) if -f $vmcfgfn;
5280
5281     my $tocmd = "/usr/lib/qemu-server/qmextract";
5282
5283     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
5284     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
5285     $tocmd .= ' --prealloc' if $opts->{prealloc};
5286     $tocmd .= ' --info' if $opts->{info};
5287
5288     # tar option "xf" does not autodetect compression when read from STDIN,
5289     # so we pipe to zcat
5290     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
5291         PVE::Tools::shellquote("--to-command=$tocmd");
5292
5293     my $tmpdir = "/var/tmp/vzdumptmp$$";
5294     mkpath $tmpdir;
5295
5296     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
5297     local $ENV{VZDUMP_VMID} = $vmid;
5298     local $ENV{VZDUMP_USER} = $user;
5299
5300     my $conffile = config_file($vmid);
5301     my $tmpfn = "$conffile.$$.tmp";
5302
5303     # disable interrupts (always do cleanups)
5304     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
5305         print STDERR "got interrupt - ignored\n";
5306     };
5307
5308     eval {
5309         # enable interrupts
5310         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
5311             die "interrupted by signal\n";
5312         };
5313
5314         if ($archive eq '-') {
5315             print "extracting archive from STDIN\n";
5316             run_command($cmd, input => "<&STDIN");
5317         } else {
5318             print "extracting archive '$archive'\n";
5319             run_command($cmd);
5320         }
5321
5322         return if $opts->{info};
5323
5324         # read new mapping
5325         my $map = {};
5326         my $statfile = "$tmpdir/qmrestore.stat";
5327         if (my $fd = IO::File->new($statfile, "r")) {
5328             while (defined (my $line = <$fd>)) {
5329                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
5330                     $map->{$1} = $2 if $1;
5331                 } else {
5332                     print STDERR "unable to parse line in statfile - $line\n";
5333                 }
5334             }
5335             $fd->close();
5336         }
5337
5338         my $confsrc = "$tmpdir/qemu-server.conf";
5339
5340         my $srcfd = new IO::File($confsrc, "r") ||
5341             die "unable to open file '$confsrc'\n";
5342
5343         my $outfd = new IO::File ($tmpfn, "w") ||
5344             die "unable to write config for VM $vmid\n";
5345
5346         my $cookie = { netcount => 0 };
5347         while (defined (my $line = <$srcfd>)) {
5348             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
5349         }
5350
5351         $srcfd->close();
5352         $outfd->close();
5353     };
5354     my $err = $@;
5355
5356     if ($err) {
5357
5358         unlink $tmpfn;
5359
5360         tar_restore_cleanup($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info};
5361
5362         die $err;
5363     }
5364
5365     rmtree $tmpdir;
5366
5367     rename $tmpfn, $conffile ||
5368         die "unable to commit configuration file '$conffile'\n";
5369
5370     PVE::Cluster::cfs_update(); # make sure we read new file
5371
5372     eval { rescan($vmid, 1); };
5373     warn $@ if $@;
5374 };
5375
5376
5377 # Internal snapshots
5378
5379 # NOTE: Snapshot create/delete involves several non-atomic
5380 # action, and can take a long time.
5381 # So we try to avoid locking the file and use 'lock' variable
5382 # inside the config file instead.
5383
5384 my $snapshot_copy_config = sub {
5385     my ($source, $dest) = @_;
5386
5387     foreach my $k (keys %$source) {
5388         next if $k eq 'snapshots';
5389         next if $k eq 'snapstate';
5390         next if $k eq 'snaptime';
5391         next if $k eq 'vmstate';
5392         next if $k eq 'lock';
5393         next if $k eq 'digest';
5394         next if $k eq 'description';
5395         next if $k =~ m/^unused\d+$/;
5396
5397         $dest->{$k} = $source->{$k};
5398     }
5399 };
5400
5401 my $snapshot_apply_config = sub {
5402     my ($conf, $snap) = @_;
5403
5404     # copy snapshot list
5405     my $newconf = {
5406         snapshots => $conf->{snapshots},
5407     };
5408
5409     # keep description and list of unused disks
5410     foreach my $k (keys %$conf) {
5411         next if !($k =~ m/^unused\d+$/ || $k eq 'description');
5412         $newconf->{$k} = $conf->{$k};
5413     }
5414
5415     &$snapshot_copy_config($snap, $newconf);
5416
5417     return $newconf;
5418 };
5419
5420 sub foreach_writable_storage {
5421     my ($conf, $func) = @_;
5422
5423     my $sidhash = {};
5424
5425     foreach my $ds (keys %$conf) {
5426         next if !valid_drivename($ds);
5427
5428         my $drive = parse_drive($ds, $conf->{$ds});
5429         next if !$drive;
5430         next if drive_is_cdrom($drive);
5431
5432         my $volid = $drive->{file};
5433
5434         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
5435         $sidhash->{$sid} = $sid if $sid;
5436     }
5437
5438     foreach my $sid (sort keys %$sidhash) {
5439         &$func($sid);
5440     }
5441 }
5442
5443 my $alloc_vmstate_volid = sub {
5444     my ($storecfg, $vmid, $conf, $snapname) = @_;
5445
5446     # Note: we try to be smart when selecting a $target storage
5447
5448     my $target;
5449
5450     # search shared storage first
5451     foreach_writable_storage($conf, sub {
5452         my ($sid) = @_;
5453         my $scfg = PVE::Storage::storage_config($storecfg, $sid);
5454         return if !$scfg->{shared};
5455
5456         $target = $sid if !$target || $scfg->{path}; # prefer file based storage
5457     });
5458
5459     if (!$target) {
5460         # now search local storage
5461         foreach_writable_storage($conf, sub {
5462             my ($sid) = @_;
5463             my $scfg = PVE::Storage::storage_config($storecfg, $sid);
5464             return if $scfg->{shared};
5465
5466             $target = $sid if !$target || $scfg->{path}; # prefer file based storage;
5467         });
5468     }
5469
5470     $target = 'local' if !$target;
5471
5472     my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
5473     # we abort live save after $conf->{memory}, so we need at max twice that space
5474     my $size = $conf->{memory}*2 + $driver_state_size;
5475
5476     my $name = "vm-$vmid-state-$snapname";
5477     my $scfg = PVE::Storage::storage_config($storecfg, $target);
5478     $name .= ".raw" if $scfg->{path}; # add filename extension for file base storage
5479     my $volid = PVE::Storage::vdisk_alloc($storecfg, $target, $vmid, 'raw', $name, $size*1024);
5480
5481     return $volid;
5482 };
5483
5484 my $snapshot_prepare = sub {
5485     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
5486
5487     my $snap;
5488
5489     my $updatefn =  sub {
5490
5491         my $conf = load_config($vmid);
5492
5493         die "you can't take a snapshot if it's a template\n"
5494             if is_template($conf);
5495
5496         check_lock($conf);
5497
5498         $conf->{lock} = 'snapshot';
5499
5500         die "snapshot name '$snapname' already used\n"
5501             if defined($conf->{snapshots}->{$snapname});
5502
5503         my $storecfg = PVE::Storage::config();
5504         die "snapshot feature is not available" if !has_feature('snapshot', $conf, $storecfg);
5505
5506         $snap = $conf->{snapshots}->{$snapname} = {};
5507
5508         if ($save_vmstate && check_running($vmid)) {
5509             $snap->{vmstate} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
5510         }
5511
5512         &$snapshot_copy_config($conf, $snap);
5513
5514         $snap->{snapstate} = "prepare";
5515         $snap->{snaptime} = time();
5516         $snap->{description} = $comment if $comment;
5517
5518         # always overwrite machine if we save vmstate. This makes sure we
5519         # can restore it later using correct machine type
5520         $snap->{machine} = get_current_qemu_machine($vmid) if $snap->{vmstate};
5521
5522         update_config_nolock($vmid, $conf, 1);
5523     };
5524
5525     lock_config($vmid, $updatefn);
5526
5527     return $snap;
5528 };
5529
5530 my $snapshot_commit = sub {
5531     my ($vmid, $snapname) = @_;
5532
5533     my $updatefn = sub {
5534
5535         my $conf = load_config($vmid);
5536
5537         die "missing snapshot lock\n"
5538             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
5539
5540         my $has_machine_config = defined($conf->{machine});
5541
5542         my $snap = $conf->{snapshots}->{$snapname};
5543
5544         die "snapshot '$snapname' does not exist\n" if !defined($snap);
5545
5546         die "wrong snapshot state\n"
5547             if !($snap->{snapstate} && $snap->{snapstate} eq "prepare");
5548
5549         delete $snap->{snapstate};
5550         delete $conf->{lock};
5551
5552         my $newconf = &$snapshot_apply_config($conf, $snap);
5553
5554         delete $newconf->{machine} if !$has_machine_config;
5555
5556         $newconf->{parent} = $snapname;
5557
5558         update_config_nolock($vmid, $newconf, 1);
5559     };
5560
5561     lock_config($vmid, $updatefn);
5562 };
5563
5564 sub snapshot_rollback {
5565     my ($vmid, $snapname) = @_;
5566
5567     my $prepare = 1;
5568
5569     my $storecfg = PVE::Storage::config();
5570
5571     my $conf = load_config($vmid);
5572
5573     my $get_snapshot_config = sub {
5574
5575         die "you can't rollback if vm is a template\n" if is_template($conf);
5576
5577         my $res = $conf->{snapshots}->{$snapname};
5578
5579         die "snapshot '$snapname' does not exist\n" if !defined($res);
5580
5581         return $res;
5582     };
5583
5584     my $snap = &$get_snapshot_config();
5585
5586     foreach_drive($snap, sub {
5587         my ($ds, $drive) = @_;
5588
5589         return if drive_is_cdrom($drive);
5590
5591         my $volid = $drive->{file};
5592
5593         PVE::Storage::volume_rollback_is_possible($storecfg, $volid, $snapname);
5594     });
5595
5596     my $updatefn = sub {
5597
5598         $conf = load_config($vmid);
5599
5600         $snap = &$get_snapshot_config();
5601
5602         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
5603             if $snap->{snapstate};
5604
5605         if ($prepare) {
5606             check_lock($conf);
5607             vm_stop($storecfg, $vmid, undef, undef, 5, undef, undef);
5608         }
5609
5610         die "unable to rollback vm $vmid: vm is running\n"
5611             if check_running($vmid);
5612
5613         if ($prepare) {
5614             $conf->{lock} = 'rollback';
5615         } else {
5616             die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
5617             delete $conf->{lock};
5618         }
5619
5620         my $forcemachine;
5621
5622         if (!$prepare) {
5623             my $has_machine_config = defined($conf->{machine});
5624
5625             # copy snapshot config to current config
5626             $conf = &$snapshot_apply_config($conf, $snap);
5627             $conf->{parent} = $snapname;
5628
5629             # Note: old code did not store 'machine', so we try to be smart
5630             # and guess the snapshot was generated with kvm 1.4 (pc-i440fx-1.4).
5631             $forcemachine = $conf->{machine} || 'pc-i440fx-1.4';
5632             # we remove the 'machine' configuration if not explicitly specified
5633             # in the original config.
5634             delete $conf->{machine} if $snap->{vmstate} && !$has_machine_config;
5635         }
5636
5637         update_config_nolock($vmid, $conf, 1);
5638
5639         if (!$prepare && $snap->{vmstate}) {
5640             my $statefile = PVE::Storage::path($storecfg, $snap->{vmstate});
5641             vm_start($storecfg, $vmid, $statefile, undef, undef, undef, $forcemachine);
5642         }
5643     };
5644
5645     lock_config($vmid, $updatefn);
5646
5647     foreach_drive($snap, sub {
5648         my ($ds, $drive) = @_;
5649
5650         return if drive_is_cdrom($drive);
5651
5652         my $volid = $drive->{file};
5653         my $device = "drive-$ds";
5654
5655         PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
5656     });
5657
5658     $prepare = 0;
5659     lock_config($vmid, $updatefn);
5660 }
5661
5662 my $savevm_wait = sub {
5663     my ($vmid) = @_;
5664
5665     for(;;) {
5666         my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
5667         if (!$stat->{status}) {
5668             die "savevm not active\n";
5669         } elsif ($stat->{status} eq 'active') {
5670             sleep(1);
5671             next;
5672         } elsif ($stat->{status} eq 'completed') {
5673             last;
5674         } else {
5675             die "query-savevm returned status '$stat->{status}'\n";
5676         }
5677     }
5678 };
5679
5680 sub snapshot_create {
5681     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
5682
5683     my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
5684
5685     $save_vmstate = 0 if !$snap->{vmstate}; # vm is not running
5686
5687     my $config = load_config($vmid);
5688
5689     my $running = check_running($vmid);
5690
5691     my $freezefs = $running && $config->{agent};
5692     $freezefs = 0 if $snap->{vmstate}; # not needed if we save RAM
5693
5694     my $drivehash = {};
5695
5696     if ($freezefs) {
5697         eval { vm_mon_cmd($vmid, "guest-fsfreeze-freeze"); };
5698         warn "guest-fsfreeze-freeze problems - $@" if $@;
5699     }
5700
5701     eval {
5702         # create internal snapshots of all drives
5703
5704         my $storecfg = PVE::Storage::config();
5705
5706         if ($running) {
5707             if ($snap->{vmstate}) {
5708                 my $path = PVE::Storage::path($storecfg, $snap->{vmstate});
5709                 vm_mon_cmd($vmid, "savevm-start", statefile => $path);
5710                 &$savevm_wait($vmid);
5711             } else {
5712                 vm_mon_cmd($vmid, "savevm-start");
5713             }
5714         };
5715
5716         foreach_drive($snap, sub {
5717             my ($ds, $drive) = @_;
5718
5719             return if drive_is_cdrom($drive);
5720
5721             my $volid = $drive->{file};
5722             my $device = "drive-$ds";
5723
5724             qemu_volume_snapshot($vmid, $device, $storecfg, $volid, $snapname);
5725             $drivehash->{$ds} = 1;
5726        });
5727     };
5728     my $err = $@;
5729
5730     if ($running) {
5731         eval { vm_mon_cmd($vmid, "savevm-end")  };
5732         warn $@ if $@;
5733
5734         if ($freezefs) {
5735             eval { vm_mon_cmd($vmid, "guest-fsfreeze-thaw"); };
5736             warn "guest-fsfreeze-thaw problems - $@" if $@;
5737         }
5738
5739         # savevm-end is async, we need to wait
5740         for (;;) {
5741             my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
5742             if (!$stat->{bytes}) {
5743                 last;
5744             } else {
5745                 print "savevm not yet finished\n";
5746                 sleep(1);
5747                 next;
5748             }
5749         }
5750     }
5751
5752     if ($err) {
5753         warn "snapshot create failed: starting cleanup\n";
5754         eval { snapshot_delete($vmid, $snapname, 0, $drivehash); };
5755         warn $@ if $@;
5756         die $err;
5757     }
5758
5759     &$snapshot_commit($vmid, $snapname);
5760 }
5761
5762 # Note: $drivehash is only set when called from snapshot_create.
5763 sub snapshot_delete {
5764     my ($vmid, $snapname, $force, $drivehash) = @_;
5765
5766     my $prepare = 1;
5767
5768     my $snap;
5769     my $unused = [];
5770
5771     my $unlink_parent = sub {
5772         my ($confref, $new_parent) = @_;
5773
5774         if ($confref->{parent} && $confref->{parent} eq $snapname) {
5775             if ($new_parent) {
5776                 $confref->{parent} = $new_parent;
5777             } else {
5778                 delete $confref->{parent};
5779             }
5780         }
5781     };
5782
5783     my $updatefn =  sub {
5784         my ($remove_drive) = @_;
5785
5786         my $conf = load_config($vmid);
5787
5788         if (!$drivehash) {
5789             check_lock($conf);
5790             die "you can't delete a snapshot if vm is a template\n"
5791                 if is_template($conf);
5792         }
5793
5794         $snap = $conf->{snapshots}->{$snapname};
5795
5796         die "snapshot '$snapname' does not exist\n" if !defined($snap);
5797
5798         # remove parent refs
5799         if (!$prepare) {
5800             &$unlink_parent($conf, $snap->{parent});
5801             foreach my $sn (keys %{$conf->{snapshots}}) {
5802                 next if $sn eq $snapname;
5803                 &$unlink_parent($conf->{snapshots}->{$sn}, $snap->{parent});
5804             }
5805         }
5806
5807         if ($remove_drive) {
5808             if ($remove_drive eq 'vmstate') {
5809                 delete $snap->{$remove_drive};
5810             } else {
5811                 my $drive = parse_drive($remove_drive, $snap->{$remove_drive});
5812                 my $volid = $drive->{file};
5813                 delete $snap->{$remove_drive};
5814                 add_unused_volume($conf, $volid);
5815             }
5816         }
5817
5818         if ($prepare) {
5819             $snap->{snapstate} = 'delete';
5820         } else {
5821             delete $conf->{snapshots}->{$snapname};
5822             delete $conf->{lock} if $drivehash;
5823             foreach my $volid (@$unused) {
5824                 add_unused_volume($conf, $volid);
5825             }
5826         }
5827
5828         update_config_nolock($vmid, $conf, 1);
5829     };
5830
5831     lock_config($vmid, $updatefn);
5832
5833     # now remove vmstate file
5834
5835     my $storecfg = PVE::Storage::config();
5836
5837     if ($snap->{vmstate}) {
5838         eval {  PVE::Storage::vdisk_free($storecfg, $snap->{vmstate}); };
5839         if (my $err = $@) {
5840             die $err if !$force;
5841             warn $err;
5842         }
5843         # save changes (remove vmstate from snapshot)
5844         lock_config($vmid, $updatefn, 'vmstate') if !$force;
5845     };
5846
5847     # now remove all internal snapshots
5848     foreach_drive($snap, sub {
5849         my ($ds, $drive) = @_;
5850
5851         return if drive_is_cdrom($drive);
5852
5853         my $volid = $drive->{file};
5854         my $device = "drive-$ds";
5855
5856         if (!$drivehash || $drivehash->{$ds}) {
5857             eval { qemu_volume_snapshot_delete($vmid, $device, $storecfg, $volid, $snapname); };
5858             if (my $err = $@) {
5859                 die $err if !$force;
5860                 warn $err;
5861             }
5862         }
5863
5864         # save changes (remove drive fron snapshot)
5865         lock_config($vmid, $updatefn, $ds) if !$force;
5866         push @$unused, $volid;
5867     });
5868
5869     # now cleanup config
5870     $prepare = 0;
5871     lock_config($vmid, $updatefn);
5872 }
5873
5874 sub has_feature {
5875     my ($feature, $conf, $storecfg, $snapname, $running) = @_;
5876
5877     my $err;
5878     foreach_drive($conf, sub {
5879         my ($ds, $drive) = @_;
5880
5881         return if drive_is_cdrom($drive);
5882         my $volid = $drive->{file};
5883         $err = 1 if !PVE::Storage::volume_has_feature($storecfg, $feature, $volid, $snapname, $running);
5884     });
5885
5886     return $err ? 0 : 1;
5887 }
5888
5889 sub template_create {
5890     my ($vmid, $conf, $disk) = @_;
5891
5892     my $storecfg = PVE::Storage::config();
5893
5894     foreach_drive($conf, sub {
5895         my ($ds, $drive) = @_;
5896
5897         return if drive_is_cdrom($drive);
5898         return if $disk && $ds ne $disk;
5899
5900         my $volid = $drive->{file};
5901         return if !PVE::Storage::volume_has_feature($storecfg, 'template', $volid);
5902
5903         my $voliddst = PVE::Storage::vdisk_create_base($storecfg, $volid);
5904         $drive->{file} = $voliddst;
5905         $conf->{$ds} = print_drive($vmid, $drive);
5906         update_config_nolock($vmid, $conf, 1);
5907     });
5908 }
5909
5910 sub is_template {
5911     my ($conf) = @_;
5912
5913     return 1 if defined $conf->{template} && $conf->{template} == 1;
5914 }
5915
5916 sub qemu_img_convert {
5917     my ($src_volid, $dst_volid, $size, $snapname) = @_;
5918
5919     my $storecfg = PVE::Storage::config();
5920     my ($src_storeid, $src_volname) = PVE::Storage::parse_volume_id($src_volid, 1);
5921     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
5922
5923     if ($src_storeid && $dst_storeid) {
5924         my $src_scfg = PVE::Storage::storage_config($storecfg, $src_storeid);
5925         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
5926
5927         my $src_format = qemu_img_format($src_scfg, $src_volname);
5928         my $dst_format = qemu_img_format($dst_scfg, $dst_volname);
5929
5930         my $src_path = PVE::Storage::path($storecfg, $src_volid, $snapname);
5931         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
5932
5933         my $cmd = [];
5934         push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-n';
5935         push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
5936         push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
5937
5938         my $parser = sub {
5939             my $line = shift;
5940             if($line =~ m/\((\S+)\/100\%\)/){
5941                 my $percent = $1;
5942                 my $transferred = int($size * $percent / 100);
5943                 my $remaining = $size - $transferred;
5944
5945                 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
5946             }
5947
5948         };
5949
5950         eval  { run_command($cmd, timeout => undef, outfunc => $parser); };
5951         my $err = $@;
5952         die "copy failed: $err" if $err;
5953     }
5954 }
5955
5956 sub qemu_img_format {
5957     my ($scfg, $volname) = @_;
5958
5959     if ($scfg->{path} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/) {
5960         return $1;
5961     } elsif ($scfg->{type} eq 'iscsi') {
5962         return "host_device";
5963     } else {
5964         return "raw";
5965     }
5966 }
5967
5968 sub qemu_drive_mirror {
5969     my ($vmid, $drive, $dst_volid, $vmiddst) = @_;
5970
5971     my $count = 0;
5972     my $old_len = 0;
5973     my $frozen = undef;
5974     my $maxwait = 120;
5975
5976     my $storecfg = PVE::Storage::config();
5977     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid);
5978
5979     my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
5980
5981     my $format;
5982     if ($dst_volname =~ m/\.(raw|qcow2)$/){
5983         $format = $1;
5984     }
5985
5986     my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
5987
5988     my $opts = { timeout => 10, device => "drive-$drive", mode => "existing", sync => "full", target => $dst_path };
5989     $opts->{format} = $format if $format;
5990
5991     #fixme : sometime drive-mirror timeout, but works fine after.
5992     # (I have see the problem with big volume > 200GB), so we need to eval
5993     eval { vm_mon_cmd($vmid, "drive-mirror", %$opts); };
5994     # ignore errors here
5995
5996     eval {
5997         while (1) {
5998             my $stats = vm_mon_cmd($vmid, "query-block-jobs");
5999             my $stat = @$stats[0];
6000             die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
6001             die "error job is not mirroring" if $stat->{type} ne "mirror";
6002
6003             my $busy = $stat->{busy};
6004
6005             if (my $total = $stat->{len}) {
6006                 my $transferred = $stat->{offset} || 0;
6007                 my $remaining = $total - $transferred;
6008                 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
6009
6010                 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent % busy: $busy\n";
6011             }
6012
6013             if ($stat->{len} == $stat->{offset}) {
6014                 if ($busy eq 'false') {
6015
6016                     last if $vmiddst != $vmid;
6017
6018                     # try to switch the disk if source and destination are on the same guest
6019                     eval { vm_mon_cmd($vmid, "block-job-complete", device => "drive-$drive") };
6020                     last if !$@;
6021                     die $@ if $@ !~ m/cannot be completed/;
6022                 }
6023
6024                 if ($count > $maxwait) {
6025                     # if too much writes to disk occurs at the end of migration
6026                     #the disk needs to be freezed to be able to complete the migration
6027                     vm_suspend($vmid,1);
6028                     $frozen = 1;
6029                 }
6030                 $count ++
6031             }
6032             $old_len = $stat->{offset};
6033             sleep 1;
6034         }
6035
6036         vm_resume($vmid, 1) if $frozen;
6037
6038     };
6039     my $err = $@;
6040
6041     my $cancel_job = sub {
6042         vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive");
6043         while (1) {
6044             my $stats = vm_mon_cmd($vmid, "query-block-jobs");
6045             my $stat = @$stats[0];
6046             last if !$stat;
6047             sleep 1;
6048         }
6049     };
6050
6051     if ($err) {
6052         eval { &$cancel_job(); };
6053         die "mirroring error: $err";
6054     }
6055
6056     if ($vmiddst != $vmid) {
6057         # if we clone a disk for a new target vm, we don't switch the disk
6058         &$cancel_job(); # so we call block-job-cancel
6059     }
6060 }
6061
6062 sub clone_disk {
6063     my ($storecfg, $vmid, $running, $drivename, $drive, $snapname,
6064         $newvmid, $storage, $format, $full, $newvollist) = @_;
6065
6066     my $newvolid;
6067
6068     if (!$full) {
6069         print "create linked clone of drive $drivename ($drive->{file})\n";
6070         $newvolid = PVE::Storage::vdisk_clone($storecfg,  $drive->{file}, $newvmid, $snapname);
6071         push @$newvollist, $newvolid;
6072     } else {
6073         my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file});
6074         $storeid = $storage if $storage;
6075
6076         my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($storecfg, $storeid);
6077         if (!$format) {
6078             $format = $drive->{format} || $defFormat;
6079         }
6080
6081         # test if requested format is supported - else use default
6082         my $supported = grep { $_ eq $format } @$validFormats;
6083         $format = $defFormat if !$supported;
6084
6085         my ($size) = PVE::Storage::volume_size_info($storecfg, $drive->{file}, 3);
6086
6087         print "create full clone of drive $drivename ($drive->{file})\n";
6088         $newvolid = PVE::Storage::vdisk_alloc($storecfg, $storeid, $newvmid, $format, undef, ($size/1024));
6089         push @$newvollist, $newvolid;
6090
6091         if (!$running || $snapname) {
6092             qemu_img_convert($drive->{file}, $newvolid, $size, $snapname);
6093         } else {
6094             qemu_drive_mirror($vmid, $drivename, $newvolid, $newvmid);
6095         }
6096     }
6097
6098     my ($size) = PVE::Storage::volume_size_info($storecfg, $newvolid, 3);
6099
6100     my $disk = $drive;
6101     $disk->{format} = undef;
6102     $disk->{file} = $newvolid;
6103     $disk->{size} = $size;
6104
6105     return $disk;
6106 }
6107
6108 # this only works if VM is running
6109 sub get_current_qemu_machine {
6110     my ($vmid) = @_;
6111
6112     my $cmd = { execute => 'query-machines', arguments => {} };
6113     my $res = vm_qmp_command($vmid, $cmd);
6114
6115     my ($current, $default);
6116     foreach my $e (@$res) {
6117         $default = $e->{name} if $e->{'is-default'};
6118         $current = $e->{name} if $e->{'is-current'};
6119     }
6120
6121     # fallback to the default machine if current is not supported by qemu
6122     return $current || $default || 'pc';
6123 }
6124
6125 sub qemu_machine_feature_enabled {
6126     my ($machine, $kvmver, $version_major, $version_minor) = @_;
6127
6128     my $current_major;
6129     my $current_minor;
6130
6131     if ($machine && $machine =~ m/^(pc(-i440fx|-q35)?-(\d+)\.(\d+))/) {
6132
6133         $current_major = $3;
6134         $current_minor = $4;
6135
6136     } elsif ($kvmver =~ m/^(\d+)\.(\d+)/) {
6137
6138         $current_major = $1;
6139         $current_minor = $2;
6140     }
6141
6142     return 1 if $current_major >= $version_major && $current_minor >= $version_minor;
6143
6144
6145 }
6146
6147 sub lspci {
6148
6149     my $devices = {};
6150
6151     dir_glob_foreach("$pcisysfs/devices", '[a-f0-9]{4}:([a-f0-9]{2}:[a-f0-9]{2})\.([0-9])', sub {
6152             my (undef, $id, $function) = @_;
6153             my $res = { id => $id, function => $function};
6154             push @{$devices->{$id}}, $res;
6155     });
6156
6157     return $devices;
6158 }
6159
6160 1;