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