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