PVE/QemuServer.pm

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