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