PVE/QemuServer.pm

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