PVE/QemuServer.pm

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