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