PVE/QemuServer.pm

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