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
2406         $d->{name} = $conf->{name} || "VM $vmid";
2407         $d->{maxmem} = $conf->{memory} ? $conf->{memory}*(1024*1024) : 0;
2408
2409         if ($conf->{balloon}) {
2410             $d->{balloon_min} = $conf->{balloon}*(1024*1024);
2411             $d->{shares} = defined($conf->{shares}) ? $conf->{shares} : 1000;
2412         }
2413
2414         $d->{uptime} = 0;
2415         $d->{cpu} = 0;
2416         $d->{mem} = 0;
2417
2418         $d->{netout} = 0;
2419         $d->{netin} = 0;
2420
2421         $d->{diskread} = 0;
2422         $d->{diskwrite} = 0;
2423
2424         $d->{template} = is_template($conf);
2425
2426         $res->{$vmid} = $d;
2427     }
2428
2429     my $netdev = PVE::ProcFSTools::read_proc_net_dev();
2430     foreach my $dev (keys %$netdev) {
2431         next if $dev !~ m/^tap([1-9]\d*)i/;
2432         my $vmid = $1;
2433         my $d = $res->{$vmid};
2434         next if !$d;
2435
2436         $d->{netout} += $netdev->{$dev}->{receive};
2437         $d->{netin} += $netdev->{$dev}->{transmit};
2438     }
2439
2440     my $ctime = gettimeofday;
2441
2442     foreach my $vmid (keys %$list) {
2443
2444         my $d = $res->{$vmid};
2445         my $pid = $d->{pid};
2446         next if !$pid;
2447
2448         my $pstat = PVE::ProcFSTools::read_proc_pid_stat($pid);
2449         next if !$pstat; # not running
2450
2451         my $used = $pstat->{utime} + $pstat->{stime};
2452
2453         $d->{uptime} = int(($uptime - $pstat->{starttime})/$cpuinfo->{user_hz});
2454
2455         if ($pstat->{vsize}) {
2456             $d->{mem} = int(($pstat->{rss}/$pstat->{vsize})*$d->{maxmem});
2457         }
2458
2459         my $old = $last_proc_pid_stat->{$pid};
2460         if (!$old) {
2461             $last_proc_pid_stat->{$pid} = {
2462                 time => $ctime,
2463                 used => $used,
2464                 cpu => 0,
2465             };
2466             next;
2467         }
2468
2469         my $dtime = ($ctime -  $old->{time}) * $cpucount * $cpuinfo->{user_hz};
2470
2471         if ($dtime > 1000) {
2472             my $dutime = $used -  $old->{used};
2473
2474             $d->{cpu} = (($dutime/$dtime)* $cpucount) / $d->{cpus};
2475             $last_proc_pid_stat->{$pid} = {
2476                 time => $ctime,
2477                 used => $used,
2478                 cpu => $d->{cpu},
2479             };
2480         } else {
2481             $d->{cpu} = $old->{cpu};
2482         }
2483     }
2484
2485     return $res if !$full;
2486
2487     my $qmpclient = PVE::QMPClient->new();
2488
2489     my $ballooncb = sub {
2490         my ($vmid, $resp) = @_;
2491
2492         my $info = $resp->{'return'};
2493         my $d = $res->{$vmid};
2494
2495         if (defined($info->{stats}->{"stat-total-memory"}) && defined($info->{stats}->{"stat-free-memory"})) {
2496             $d->{balloon} = int($info->{stats}->{"stat-total-memory"}/1024/1024);
2497             $d->{freemem} = int($info->{stats}->{"stat-free-memory"}/1024/1024);
2498             $d->{mem} = $d->{maxmem} - $d->{freemem};
2499         }
2500
2501     };
2502
2503     my $blockstatscb = sub {
2504         my ($vmid, $resp) = @_;
2505         my $data = $resp->{'return'} || [];
2506         my $totalrdbytes = 0;
2507         my $totalwrbytes = 0;
2508         for my $blockstat (@$data) {
2509             $totalrdbytes = $totalrdbytes + $blockstat->{stats}->{rd_bytes};
2510             $totalwrbytes = $totalwrbytes + $blockstat->{stats}->{wr_bytes};
2511         }
2512         $res->{$vmid}->{diskread} = $totalrdbytes;
2513         $res->{$vmid}->{diskwrite} = $totalwrbytes;
2514     };
2515
2516     my $statuscb = sub {
2517         my ($vmid, $resp) = @_;
2518
2519         $qmpclient->queue_cmd($vmid, $blockstatscb, 'query-blockstats');
2520         # this fails if ballon driver is not loaded, so this must be
2521         # the last commnand (following command are aborted if this fails).
2522         # maybe is it fixed by
2523         #http://git.qemu.org/?p=qemu.git;a=commit;h=38dbd48b247ebe05bdc6ef52ccdc60cc21274877
2524
2525         $qmpclient->queue_cmd($vmid, $ballooncb, 'qom-get',
2526                               path => "machine/peripheral/balloon0",
2527                               property => "guest-stats");
2528
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
2655     push @$cmd, '/usr/bin/kvm';
2656
2657     push @$cmd, '-id', $vmid;
2658
2659     my $use_virtio = 0;
2660
2661     my $qmpsocket = qmp_socket($vmid);
2662     push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
2663     push @$cmd, '-mon', "chardev=qmp,mode=control";
2664
2665     my $socket = vnc_socket($vmid);
2666     push @$cmd,  '-vnc', "unix:$socket,x509,password";
2667
2668     push @$cmd, '-pidfile' , pidfile_name($vmid);
2669
2670     push @$cmd, '-daemonize';
2671
2672     if ($conf->{smbios1}) {
2673         push @$cmd, '-smbios', "type=1,$conf->{smbios1}";
2674     }
2675
2676     push @$cmd, '-object', "iothread,id=iothread0" if $conf->{iothread};
2677
2678     if ($q35) {
2679         # the q35 chipset support native usb2, so we enable usb controller
2680         # by default for this machine type
2681         push @$devices, '-readconfig', '/usr/share/qemu-server/pve-q35.cfg';
2682     } else {
2683         $pciaddr = print_pci_addr("piix3", $bridges);
2684         push @$devices, '-device', "piix3-usb-uhci,id=uhci$pciaddr.0x2";
2685
2686         my $use_usb2 = 0;
2687         for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
2688             next if !$conf->{"usb$i"};
2689             $use_usb2 = 1;
2690         }
2691         # include usb device config
2692         push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
2693     }
2694
2695     my $vga = $conf->{vga};
2696
2697     my $qxlnum = vga_conf_has_spice($vga);
2698     $vga = 'qxl' if $qxlnum;
2699
2700     if (!$vga) {
2701         if ($conf->{ostype} && ($conf->{ostype} eq 'win8' ||
2702                                 $conf->{ostype} eq 'win7' ||
2703                                 $conf->{ostype} eq 'w2k8')) {
2704             $vga = 'std';
2705         } else {
2706             $vga = 'cirrus';
2707         }
2708     }
2709
2710     # enable absolute mouse coordinates (needed by vnc)
2711     my $tablet;
2712     if (defined($conf->{tablet})) {
2713         $tablet = $conf->{tablet};
2714     } else {
2715         $tablet = $defaults->{tablet};
2716         $tablet = 0 if $qxlnum; # disable for spice because it is not needed
2717         $tablet = 0 if $vga =~ m/^serial\d+$/; # disable if we use serial terminal (no vga card)
2718     }
2719
2720     push @$devices, '-device', print_tabletdevice_full($conf) if $tablet;
2721
2722     # host pci devices
2723     for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
2724         my $d = parse_hostpci($conf->{"hostpci$i"});
2725         next if !$d;
2726
2727         my $pcie = $d->{pcie};
2728         if($pcie){
2729             die "q35 machine model is not enabled" if !$q35;
2730             $pciaddr = print_pcie_addr("hostpci$i");
2731         }else{
2732             $pciaddr = print_pci_addr("hostpci$i", $bridges);
2733         }
2734
2735         my $rombar = $d->{rombar} && $d->{rombar} eq 'off' ? ",rombar=0" : "";
2736         my $driver = $d->{driver} && $d->{driver} eq 'vfio' ? "vfio-pci" : "pci-assign";
2737         my $xvga = $d->{'x-vga'} && $d->{'x-vga'} eq 'on' ? ",x-vga=on" : "";
2738         if ($xvga && $xvga ne '') {
2739             push @$cpuFlags, 'kvm=off';
2740             $vga = 'none';
2741         }
2742         $driver = "vfio-pci" if $xvga ne '';
2743         my $pcidevices = $d->{pciid};
2744         my $multifunction = 1 if @$pcidevices > 1;
2745
2746         my $j=0;
2747         foreach my $pcidevice (@$pcidevices) {
2748
2749             my $id = "hostpci$i";
2750             $id .= ".$j" if $multifunction;
2751             my $addr = $pciaddr;
2752             $addr .= ".$j" if $multifunction;
2753             my $devicestr = "$driver,host=$pcidevice->{id}.$pcidevice->{function},id=$id$addr";
2754
2755             if($j == 0){
2756                 $devicestr .= "$rombar$xvga";
2757                 $devicestr .= ",multifunction=on" if $multifunction;
2758             }
2759
2760             push @$devices, '-device', $devicestr;
2761             $j++;
2762         }
2763     }
2764
2765     # usb devices
2766     for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
2767         my $d = parse_usb_device($conf->{"usb$i"});
2768         next if !$d;
2769         if ($d->{vendorid} && $d->{productid}) {
2770             push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2771         } elsif (defined($d->{hostbus}) && defined($d->{hostport})) {
2772             push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2773         } elsif ($d->{spice}) {
2774             # usb redir support for spice
2775             push @$devices, '-chardev', "spicevmc,id=usbredirchardev$i,name=usbredir";
2776             push @$devices, '-device', "usb-redir,chardev=usbredirchardev$i,id=usbredirdev$i,bus=ehci.0";
2777         }
2778     }
2779
2780     # serial devices
2781     for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++)  {
2782         if (my $path = $conf->{"serial$i"}) {
2783             if ($path eq 'socket') {
2784                 my $socket = "/var/run/qemu-server/${vmid}.serial$i";
2785                 push @$devices, '-chardev', "socket,id=serial$i,path=$socket,server,nowait";
2786                 push @$devices, '-device', "isa-serial,chardev=serial$i";
2787             } else {
2788                 die "no such serial device\n" if ! -c $path;
2789                 push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2790                 push @$devices, '-device', "isa-serial,chardev=serial$i";
2791             }
2792         }
2793     }
2794
2795     # parallel devices
2796     for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++)  {
2797         if (my $path = $conf->{"parallel$i"}) {
2798             die "no such parallel device\n" if ! -c $path;
2799             my $devtype = $path =~ m!^/dev/usb/lp! ? 'tty' : 'parport';
2800             push @$devices, '-chardev', "$devtype,id=parallel$i,path=$path";
2801             push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2802         }
2803     }
2804
2805     my $vmname = $conf->{name} || "vm$vmid";
2806
2807     push @$cmd, '-name', $vmname;
2808
2809     my $sockets = 1;
2810     $sockets = $conf->{smp} if $conf->{smp}; # old style - no longer iused
2811     $sockets = $conf->{sockets} if  $conf->{sockets};
2812
2813     my $cores = $conf->{cores} || 1;
2814
2815     my $maxcpus = $sockets * $cores;
2816
2817     my $vcpus = $conf->{vcpus} ? $conf->{vcpus} : $maxcpus;
2818
2819     my $allowed_vcpus = $cpuinfo->{cpus};
2820
2821     die "MAX $maxcpus vcpus allowed per VM on this node\n"
2822         if ($allowed_vcpus < $maxcpus);
2823
2824     push @$cmd, '-smp', "$vcpus,sockets=$sockets,cores=$cores,maxcpus=$maxcpus";
2825
2826     push @$cmd, '-nodefaults';
2827
2828     my $bootorder = $conf->{boot} || $confdesc->{boot}->{default};
2829
2830     my $bootindex_hash = {};
2831     my $i = 1;
2832     foreach my $o (split(//, $bootorder)) {
2833         $bootindex_hash->{$o} = $i*100;
2834         $i++;
2835     }
2836
2837     push @$cmd, '-boot', "menu=on,strict=on,reboot-timeout=1000";
2838
2839     push @$cmd, '-no-acpi' if defined($conf->{acpi}) && $conf->{acpi} == 0;
2840
2841     push @$cmd, '-no-reboot' if  defined($conf->{reboot}) && $conf->{reboot} == 0;
2842
2843     push @$cmd, '-vga', $vga if $vga && $vga !~ m/^serial\d+$/; # for kvm 77 and later
2844
2845     # time drift fix
2846     my $tdf = defined($conf->{tdf}) ? $conf->{tdf} : $defaults->{tdf};
2847
2848     my $nokvm = defined($conf->{kvm}) && $conf->{kvm} == 0 ? 1 : 0;
2849     my $useLocaltime = $conf->{localtime};
2850
2851     if (my $ost = $conf->{ostype}) {
2852         # other, wxp, w2k, w2k3, w2k8, wvista, win7, win8, l24, l26, solaris
2853
2854         if ($ost =~ m/^w/) { # windows
2855             $useLocaltime = 1 if !defined($conf->{localtime});
2856
2857             # use time drift fix when acpi is enabled
2858             if (!(defined($conf->{acpi}) && $conf->{acpi} == 0)) {
2859                 $tdf = 1 if !defined($conf->{tdf});
2860             }
2861         }
2862
2863         if ($ost eq 'win7' || $ost eq 'win8' || $ost eq 'w2k8' ||
2864             $ost eq 'wvista') {
2865             push @$globalFlags, 'kvm-pit.lost_tick_policy=discard';
2866             push @$cmd, '-no-hpet';
2867             #push @$cpuFlags , 'hv_vapic" if !$nokvm;  #fixme, my win2008R2 hang at boot with this
2868             push @$cpuFlags , 'hv_spinlocks=0xffff' if !$nokvm;
2869         }
2870
2871         if ($ost eq 'win7' || $ost eq 'win8') {
2872             push @$cpuFlags , 'hv_relaxed' if !$nokvm;
2873         }
2874     }
2875
2876     push @$rtcFlags, 'driftfix=slew' if $tdf;
2877
2878     if ($nokvm) {
2879         push @$machineFlags, 'accel=tcg';
2880     } else {
2881         die "No accelerator found!\n" if !$cpuinfo->{hvm};
2882     }
2883
2884     my $machine_type = $forcemachine || $conf->{machine};
2885     if ($machine_type) {
2886         push @$machineFlags, "type=${machine_type}";
2887     }
2888
2889     if ($conf->{startdate}) {
2890         push @$rtcFlags, "base=$conf->{startdate}";
2891     } elsif ($useLocaltime) {
2892         push @$rtcFlags, 'base=localtime';
2893     }
2894
2895     my $cpu = $nokvm ? "qemu64" : "kvm64";
2896     $cpu = $conf->{cpu} if $conf->{cpu};
2897
2898     push @$cpuFlags , '+lahf_lm' if $cpu eq 'kvm64';
2899
2900     push @$cpuFlags , '+x2apic' if !$nokvm && $conf->{ostype} ne 'solaris';
2901
2902     push @$cpuFlags , '-x2apic' if $conf->{ostype} eq 'solaris';
2903
2904     push @$cpuFlags, '+sep' if $cpu eq 'kvm64' || $cpu eq 'kvm32';
2905
2906     $cpu .= "," . join(',', @$cpuFlags) if scalar(@$cpuFlags);
2907
2908     # Note: enforce needs kernel 3.10, so we do not use it for now
2909     # push @$cmd, '-cpu', "$cpu,enforce";
2910     push @$cmd, '-cpu', $cpu;
2911
2912     my $memory = $conf->{memory} || $defaults->{memory};
2913     my $static_memory = 0;
2914     my $dimm_memory = 0;
2915
2916     if ($hotplug_features->{memory}) {
2917         die "Numa need to be enabled for memory hotplug\n" if !$conf->{numa};
2918         die "Total memory is bigger than ${MAX_MEM}MB\n" if $memory > $MAX_MEM;
2919         $static_memory = $STATICMEM;
2920         die "minimum memory must be ${static_memory}MB\n" if($memory < $static_memory);
2921         $dimm_memory = $memory - $static_memory;
2922         push @$cmd, '-m', "size=${static_memory},slots=255,maxmem=${MAX_MEM}M";
2923
2924     } else {
2925
2926         $static_memory = $memory;
2927         push @$cmd, '-m', $static_memory;
2928     }
2929
2930     if ($conf->{numa}) {
2931
2932         my $numa_totalmemory = undef;
2933         for (my $i = 0; $i < $MAX_NUMA; $i++) {
2934             next if !$conf->{"numa$i"};
2935             my $numa = parse_numa($conf->{"numa$i"});
2936             next if !$numa;
2937             # memory
2938             die "missing numa node$i memory value\n" if !$numa->{memory};
2939             my $numa_memory = $numa->{memory};
2940             $numa_totalmemory += $numa_memory;
2941             my $numa_object = "memory-backend-ram,id=ram-node$i,size=${numa_memory}M";
2942
2943             # cpus
2944             my $cpus_start = $numa->{cpus}->{start};
2945             die "missing numa node$i cpus\n" if !defined($cpus_start);
2946             my $cpus_end = $numa->{cpus}->{end} if defined($numa->{cpus}->{end});
2947             my $cpus = $cpus_start;
2948             if (defined($cpus_end)) {
2949                 $cpus .= "-$cpus_end";
2950                 die "numa node$i :  cpu range $cpus is incorrect\n" if $cpus_end <= $cpus_start;
2951             }
2952
2953             # hostnodes
2954             my $hostnodes_start = $numa->{hostnodes}->{start};
2955             if (defined($hostnodes_start)) {
2956                 my $hostnodes_end = $numa->{hostnodes}->{end} if defined($numa->{hostnodes}->{end});
2957                 my $hostnodes = $hostnodes_start;
2958                 if (defined($hostnodes_end)) {
2959                     $hostnodes .= "-$hostnodes_end";
2960                     die "host node $hostnodes range is incorrect\n" if $hostnodes_end <= $hostnodes_start;
2961                 }
2962
2963                 my $hostnodes_end_range = defined($hostnodes_end) ? $hostnodes_end : $hostnodes_start;
2964                 for (my $i = $hostnodes_start; $i <= $hostnodes_end_range; $i++ ) {
2965                     die "host numa node$i don't exist\n" if ! -d "/sys/devices/system/node/node$i/";
2966                 }
2967
2968                 # policy
2969                 my $policy = $numa->{policy};
2970                 die "you need to define a policy for hostnode $hostnodes\n" if !$policy;
2971                 $numa_object .= ",host-nodes=$hostnodes,policy=$policy";
2972             }
2973
2974             push @$cmd, '-object', $numa_object;
2975             push @$cmd, '-numa', "node,nodeid=$i,cpus=$cpus,memdev=ram-node$i";
2976         }
2977
2978         die "total memory for NUMA nodes must be equal to vm static memory\n"
2979             if $numa_totalmemory && $numa_totalmemory != $static_memory;
2980
2981         #if no custom tology, we split memory and cores across numa nodes
2982         if(!$numa_totalmemory) {
2983
2984             my $numa_memory = ($static_memory / $sockets) . "M";
2985
2986             for (my $i = 0; $i < $sockets; $i++)  {
2987
2988                 my $cpustart = ($cores * $i);
2989                 my $cpuend = ($cpustart + $cores - 1) if $cores && $cores > 1;
2990                 my $cpus = $cpustart;
2991                 $cpus .= "-$cpuend" if $cpuend;
2992
2993                 push @$cmd, '-object', "memory-backend-ram,size=$numa_memory,id=ram-node$i";
2994                 push @$cmd, '-numa', "node,nodeid=$i,cpus=$cpus,memdev=ram-node$i";
2995             }
2996         }
2997     }
2998
2999     if ($hotplug_features->{memory}) {
3000         foreach_dimm($conf, $vmid, $memory, $sockets, sub {
3001             my ($conf, $vmid, $name, $dimm_size, $numanode, $current_size, $memory) = @_;
3002             push @$cmd, "-object" , "memory-backend-ram,id=mem-$name,size=${dimm_size}M";
3003             push @$cmd, "-device", "pc-dimm,id=$name,memdev=mem-$name,node=$numanode";
3004
3005             #if dimm_memory is not aligned to dimm map
3006             if($current_size > $memory) {
3007                  $conf->{memory} = $current_size;
3008                  update_config_nolock($vmid, $conf, 1);
3009             }
3010         });
3011     }
3012
3013     push @$cmd, '-S' if $conf->{freeze};
3014
3015     # set keyboard layout
3016     my $kb = $conf->{keyboard} || $defaults->{keyboard};
3017     push @$cmd, '-k', $kb if $kb;
3018
3019     # enable sound
3020     #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
3021     #push @$cmd, '-soundhw', 'es1370';
3022     #push @$cmd, '-soundhw', $soundhw if $soundhw;
3023
3024     if($conf->{agent}) {
3025         my $qgasocket = qmp_socket($vmid, 1);
3026         my $pciaddr = print_pci_addr("qga0", $bridges);
3027         push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
3028         push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
3029         push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
3030     }
3031
3032     my $spice_port;
3033
3034     if ($qxlnum) {
3035         if ($qxlnum > 1) {
3036             if ($conf->{ostype} && $conf->{ostype} =~ m/^w/){
3037                 for(my $i = 1; $i < $qxlnum; $i++){
3038                     my $pciaddr = print_pci_addr("vga$i", $bridges);
3039                     push @$cmd, '-device', "qxl,id=vga$i,ram_size=67108864,vram_size=33554432$pciaddr";
3040                 }
3041             } else {
3042                 # assume other OS works like Linux
3043                 push @$cmd, '-global', 'qxl-vga.ram_size=134217728';
3044                 push @$cmd, '-global', 'qxl-vga.vram_size=67108864';
3045             }
3046         }
3047
3048         my $pciaddr = print_pci_addr("spice", $bridges);
3049
3050         $spice_port = PVE::Tools::next_spice_port();
3051
3052         push @$devices, '-spice', "tls-port=${spice_port},addr=127.0.0.1,tls-ciphers=DES-CBC3-SHA,seamless-migration=on";
3053
3054         push @$devices, '-device', "virtio-serial,id=spice$pciaddr";
3055         push @$devices, '-chardev', "spicevmc,id=vdagent,name=vdagent";
3056         push @$devices, '-device', "virtserialport,chardev=vdagent,name=com.redhat.spice.0";
3057     }
3058
3059     # enable balloon by default, unless explicitly disabled
3060     if (!defined($conf->{balloon}) || $conf->{balloon}) {
3061         $pciaddr = print_pci_addr("balloon0", $bridges);
3062         push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr";
3063     }
3064
3065     if ($conf->{watchdog}) {
3066         my $wdopts = parse_watchdog($conf->{watchdog});
3067         $pciaddr = print_pci_addr("watchdog", $bridges);
3068         my $watchdog = $wdopts->{model} || 'i6300esb';
3069         push @$devices, '-device', "$watchdog$pciaddr";
3070         push @$devices, '-watchdog-action', $wdopts->{action} if $wdopts->{action};
3071     }
3072
3073     my $vollist = [];
3074     my $scsicontroller = {};
3075     my $ahcicontroller = {};
3076     my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : $defaults->{scsihw};
3077
3078     # Add iscsi initiator name if available
3079     if (my $initiator = get_initiator_name()) {
3080         push @$devices, '-iscsi', "initiator-name=$initiator";
3081     }
3082
3083     foreach_drive($conf, sub {
3084         my ($ds, $drive) = @_;
3085
3086         if (PVE::Storage::parse_volume_id($drive->{file}, 1)) {
3087             push @$vollist, $drive->{file};
3088         }
3089
3090         $use_virtio = 1 if $ds =~ m/^virtio/;
3091
3092         if (drive_is_cdrom ($drive)) {
3093             if ($bootindex_hash->{d}) {
3094                 $drive->{bootindex} = $bootindex_hash->{d};
3095                 $bootindex_hash->{d} += 1;
3096             }
3097         } else {
3098             if ($bootindex_hash->{c}) {
3099                 $drive->{bootindex} = $bootindex_hash->{c} if $conf->{bootdisk} && ($conf->{bootdisk} eq $ds);
3100                 $bootindex_hash->{c} += 1;
3101             }
3102         }
3103
3104         if ($drive->{interface} eq 'scsi') {
3105
3106             my $maxdev = ($scsihw !~ m/^lsi/) ? 256 : 7;
3107             my $controller = int($drive->{index} / $maxdev);
3108             $pciaddr = print_pci_addr("scsihw$controller", $bridges);
3109             push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
3110             $scsicontroller->{$controller}=1;
3111         }
3112
3113         if ($drive->{interface} eq 'sata') {
3114            my $controller = int($drive->{index} / $MAX_SATA_DISKS);
3115            $pciaddr = print_pci_addr("ahci$controller", $bridges);
3116            push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
3117            $ahcicontroller->{$controller}=1;
3118         }
3119
3120         my $drive_cmd = print_drive_full($storecfg, $vmid, $drive);
3121         push @$devices, '-drive',$drive_cmd;
3122         push @$devices, '-device', print_drivedevice_full($storecfg, $conf, $vmid, $drive, $bridges);
3123     });
3124
3125     for (my $i = 0; $i < $MAX_NETS; $i++) {
3126          next if !$conf->{"net$i"};
3127          my $d = parse_net($conf->{"net$i"});
3128          next if !$d;
3129
3130          $use_virtio = 1 if $d->{model} eq 'virtio';
3131
3132          if ($bootindex_hash->{n}) {
3133             $d->{bootindex} = $bootindex_hash->{n};
3134             $bootindex_hash->{n} += 1;
3135          }
3136
3137          my $netdevfull = print_netdev_full($vmid,$conf,$d,"net$i");
3138          push @$devices, '-netdev', $netdevfull;
3139
3140          my $netdevicefull = print_netdevice_full($vmid,$conf,$d,"net$i",$bridges);
3141          push @$devices, '-device', $netdevicefull;
3142     }
3143
3144     if (!$q35) {
3145         # add pci bridges
3146         while (my ($k, $v) = each %$bridges) {
3147             $pciaddr = print_pci_addr("pci.$k");
3148             unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
3149         }
3150     }
3151
3152     # hack: virtio with fairsched is unreliable, so we do not use fairsched
3153     # when the VM uses virtio devices.
3154     if (!$use_virtio && $have_ovz) {
3155
3156         my $cpuunits = defined($conf->{cpuunits}) ?
3157             $conf->{cpuunits} : $defaults->{cpuunits};
3158
3159         push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
3160
3161         # fixme: cpulimit is currently ignored
3162         #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
3163     }
3164
3165     # add custom args
3166     if ($conf->{args}) {
3167         my $aa = PVE::Tools::split_args($conf->{args});
3168         push @$cmd, @$aa;
3169     }
3170
3171     push @$cmd, @$devices;
3172     push @$cmd, '-rtc', join(',', @$rtcFlags)
3173         if scalar(@$rtcFlags);
3174     push @$cmd, '-machine', join(',', @$machineFlags)
3175         if scalar(@$machineFlags);
3176     push @$cmd, '-global', join(',', @$globalFlags)
3177         if scalar(@$globalFlags);
3178
3179     return wantarray ? ($cmd, $vollist, $spice_port) : $cmd;
3180 }
3181
3182 sub vnc_socket {
3183     my ($vmid) = @_;
3184     return "${var_run_tmpdir}/$vmid.vnc";
3185 }
3186
3187 sub spice_port {
3188     my ($vmid) = @_;
3189
3190     my $res = vm_mon_cmd($vmid, 'query-spice');
3191
3192     return $res->{'tls-port'} || $res->{'port'} || die "no spice port\n";
3193 }
3194
3195 sub qmp_socket {
3196     my ($vmid, $qga) = @_;
3197     my $sockettype = $qga ? 'qga' : 'qmp';
3198     return "${var_run_tmpdir}/$vmid.$sockettype";
3199 }
3200
3201 sub pidfile_name {
3202     my ($vmid) = @_;
3203     return "${var_run_tmpdir}/$vmid.pid";
3204 }
3205
3206 sub vm_devices_list {
3207     my ($vmid) = @_;
3208
3209     my $res = vm_mon_cmd($vmid, 'query-pci');
3210     my $devices = {};
3211     foreach my $pcibus (@$res) {
3212         foreach my $device (@{$pcibus->{devices}}) {
3213             next if !$device->{'qdev_id'};
3214             if ($device->{'pci_bridge'}) {
3215                 $devices->{$device->{'qdev_id'}} = 1;
3216                 foreach my $bridge_device (@{$device->{'pci_bridge'}->{devices}}) {
3217                     next if !$bridge_device->{'qdev_id'};
3218                     $devices->{$bridge_device->{'qdev_id'}} = 1;
3219                     $devices->{$device->{'qdev_id'}}++;
3220                 }
3221             } else {
3222                 $devices->{$device->{'qdev_id'}} = 1;
3223             }
3224         }
3225     }
3226
3227     my $resblock = vm_mon_cmd($vmid, 'query-block');
3228     foreach my $block (@$resblock) {
3229         if($block->{device} =~ m/^drive-(\S+)/){
3230                 $devices->{$1} = 1;
3231         }
3232     }
3233
3234     my $resmice = vm_mon_cmd($vmid, 'query-mice');
3235     foreach my $mice (@$resmice) {
3236         if ($mice->{name} eq 'QEMU HID Tablet') {
3237             $devices->{tablet} = 1;
3238             last;
3239         }
3240     }
3241
3242     return $devices;
3243 }
3244
3245 sub vm_deviceplug {
3246     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
3247
3248     my $q35 = machine_type_is_q35($conf);
3249
3250     my $devices_list = vm_devices_list($vmid);
3251     return 1 if defined($devices_list->{$deviceid});
3252
3253     qemu_add_pci_bridge($storecfg, $conf, $vmid, $deviceid); # add PCI bridge if we need it for the device
3254
3255     if ($deviceid eq 'tablet') {
3256
3257         qemu_deviceadd($vmid, print_tabletdevice_full($conf));
3258
3259     } elsif ($deviceid =~ m/^(virtio)(\d+)$/) {
3260
3261         qemu_driveadd($storecfg, $vmid, $device);
3262         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
3263
3264         qemu_deviceadd($vmid, $devicefull);
3265         eval { qemu_deviceaddverify($vmid, $deviceid); };
3266         if (my $err = $@) {
3267             eval { qemu_drivedel($vmid, $deviceid); };
3268             warn $@ if $@;
3269             die $err;
3270         }
3271
3272     } elsif ($deviceid =~ m/^(scsihw)(\d+)$/) {
3273
3274         my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : "lsi";
3275         my $pciaddr = print_pci_addr($deviceid);
3276         my $devicefull = "$scsihw,id=$deviceid$pciaddr";
3277
3278         qemu_deviceadd($vmid, $devicefull);
3279         qemu_deviceaddverify($vmid, $deviceid);
3280
3281     } elsif ($deviceid =~ m/^(scsi)(\d+)$/) {
3282
3283         qemu_findorcreatescsihw($storecfg,$conf, $vmid, $device);
3284         qemu_driveadd($storecfg, $vmid, $device);
3285
3286         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
3287         eval { qemu_deviceadd($vmid, $devicefull); };
3288         if (my $err = $@) {
3289             eval { qemu_drivedel($vmid, $deviceid); };
3290             warn $@ if $@;
3291             die $err;
3292         }
3293
3294     } elsif ($deviceid =~ m/^(net)(\d+)$/) {
3295
3296         return undef if !qemu_netdevadd($vmid, $conf, $device, $deviceid);
3297         my $netdevicefull = print_netdevice_full($vmid, $conf, $device, $deviceid);
3298         qemu_deviceadd($vmid, $netdevicefull);
3299         eval { qemu_deviceaddverify($vmid, $deviceid); };
3300         if (my $err = $@) {
3301             eval { qemu_netdevdel($vmid, $deviceid); };
3302             warn $@ if $@;
3303             die $err;
3304         }
3305
3306     } elsif (!$q35 && $deviceid =~ m/^(pci\.)(\d+)$/) {
3307
3308         my $bridgeid = $2;
3309         my $pciaddr = print_pci_addr($deviceid);
3310         my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
3311
3312         qemu_deviceadd($vmid, $devicefull);
3313         qemu_deviceaddverify($vmid, $deviceid);
3314
3315     } else {
3316         die "can't hotplug device '$deviceid'\n";
3317     }
3318
3319     return 1;
3320 }
3321
3322 # fixme: this should raise exceptions on error!
3323 sub vm_deviceunplug {
3324     my ($vmid, $conf, $deviceid) = @_;
3325
3326     my $devices_list = vm_devices_list($vmid);
3327     return 1 if !defined($devices_list->{$deviceid});
3328
3329     die "can't unplug bootdisk" if $conf->{bootdisk} && $conf->{bootdisk} eq $deviceid;
3330
3331     if ($deviceid eq 'tablet') {
3332
3333         qemu_devicedel($vmid, $deviceid);
3334
3335     } elsif ($deviceid =~ m/^(virtio)(\d+)$/) {
3336
3337         qemu_devicedel($vmid, $deviceid);
3338         qemu_devicedelverify($vmid, $deviceid);
3339         qemu_drivedel($vmid, $deviceid);
3340
3341     } elsif ($deviceid =~ m/^(lsi)(\d+)$/) {
3342
3343         qemu_devicedel($vmid, $deviceid);
3344
3345     } elsif ($deviceid =~ m/^(scsi)(\d+)$/) {
3346
3347         qemu_devicedel($vmid, $deviceid);
3348         qemu_drivedel($vmid, $deviceid);
3349
3350     } elsif ($deviceid =~ m/^(net)(\d+)$/) {
3351
3352         qemu_devicedel($vmid, $deviceid);
3353         qemu_devicedelverify($vmid, $deviceid);
3354         qemu_netdevdel($vmid, $deviceid);
3355
3356     } else {
3357         die "can't unplug device '$deviceid'\n";
3358     }
3359
3360     return 1;
3361 }
3362
3363 sub qemu_deviceadd {
3364     my ($vmid, $devicefull) = @_;
3365
3366     $devicefull = "driver=".$devicefull;
3367     my %options =  split(/[=,]/, $devicefull);
3368
3369     vm_mon_cmd($vmid, "device_add" , %options);
3370 }
3371
3372 sub qemu_devicedel {
3373     my ($vmid, $deviceid) = @_;
3374
3375     my $ret = vm_mon_cmd($vmid, "device_del", id => $deviceid);
3376 }
3377
3378 sub qemu_objectadd {
3379     my($vmid, $objectid, $qomtype) = @_;
3380
3381     vm_mon_cmd($vmid, "object-add", id => $objectid, "qom-type" => $qomtype);
3382
3383     return 1;
3384 }
3385
3386 sub qemu_objectdel {
3387     my($vmid, $objectid) = @_;
3388
3389     vm_mon_cmd($vmid, "object-del", id => $objectid);
3390
3391     return 1;
3392 }
3393
3394 sub qemu_driveadd {
3395     my ($storecfg, $vmid, $device) = @_;
3396
3397     my $drive = print_drive_full($storecfg, $vmid, $device);
3398     $drive =~ s/\\/\\\\/g;
3399     my $ret = vm_human_monitor_command($vmid, "drive_add auto \"$drive\"");
3400
3401     # If the command succeeds qemu prints: "OK"
3402     return 1 if $ret =~ m/OK/s;
3403
3404     die "adding drive failed: $ret\n";
3405 }
3406
3407 sub qemu_drivedel {
3408     my($vmid, $deviceid) = @_;
3409
3410     my $ret = vm_human_monitor_command($vmid, "drive_del drive-$deviceid");
3411     $ret =~ s/^\s+//;
3412
3413     return 1 if $ret eq "";
3414
3415     # NB: device not found errors mean the drive was auto-deleted and we ignore the error
3416     return 1 if $ret =~ m/Device \'.*?\' not found/s;
3417
3418     die "deleting drive $deviceid failed : $ret\n";
3419 }
3420
3421 sub qemu_deviceaddverify {
3422     my ($vmid, $deviceid) = @_;
3423
3424     for (my $i = 0; $i <= 5; $i++) {
3425          my $devices_list = vm_devices_list($vmid);
3426          return 1 if defined($devices_list->{$deviceid});
3427          sleep 1;
3428     }
3429
3430     die "error on hotplug device '$deviceid'\n";
3431 }
3432
3433
3434 sub qemu_devicedelverify {
3435     my ($vmid, $deviceid) = @_;
3436
3437     # need to verify that the device is correctly removed as device_del
3438     # is async and empty return is not reliable
3439
3440     for (my $i = 0; $i <= 5; $i++) {
3441          my $devices_list = vm_devices_list($vmid);
3442          return 1 if !defined($devices_list->{$deviceid});
3443          sleep 1;
3444     }
3445
3446     die "error on hot-unplugging device '$deviceid'\n";
3447 }
3448
3449 sub qemu_findorcreatescsihw {
3450     my ($storecfg, $conf, $vmid, $device) = @_;
3451
3452     my $maxdev = ($conf->{scsihw} && ($conf->{scsihw} !~ m/^lsi/)) ? 256 : 7;
3453     my $controller = int($device->{index} / $maxdev);
3454     my $scsihwid="scsihw$controller";
3455     my $devices_list = vm_devices_list($vmid);
3456
3457     if(!defined($devices_list->{$scsihwid})) {
3458         vm_deviceplug($storecfg, $conf, $vmid, $scsihwid);
3459     }
3460
3461     return 1;
3462 }
3463
3464 sub qemu_add_pci_bridge {
3465     my ($storecfg, $conf, $vmid, $device) = @_;
3466
3467     my $bridges = {};
3468
3469     my $bridgeid;
3470
3471     print_pci_addr($device, $bridges);
3472
3473     while (my ($k, $v) = each %$bridges) {
3474         $bridgeid = $k;
3475     }
3476     return 1 if !defined($bridgeid) || $bridgeid < 1;
3477
3478     my $bridge = "pci.$bridgeid";
3479     my $devices_list = vm_devices_list($vmid);
3480
3481     if (!defined($devices_list->{$bridge})) {
3482         vm_deviceplug($storecfg, $conf, $vmid, $bridge);
3483     }
3484
3485     return 1;
3486 }
3487
3488 sub qemu_set_link_status {
3489     my ($vmid, $device, $up) = @_;
3490
3491     vm_mon_cmd($vmid, "set_link", name => $device,
3492                up => $up ? JSON::true : JSON::false);
3493 }
3494
3495 sub qemu_netdevadd {
3496     my ($vmid, $conf, $device, $deviceid) = @_;
3497
3498     my $netdev = print_netdev_full($vmid, $conf, $device, $deviceid);
3499     my %options =  split(/[=,]/, $netdev);
3500
3501     vm_mon_cmd($vmid, "netdev_add",  %options);
3502     return 1;
3503 }
3504
3505 sub qemu_netdevdel {
3506     my ($vmid, $deviceid) = @_;
3507
3508     vm_mon_cmd($vmid, "netdev_del", id => $deviceid);
3509 }
3510
3511 sub qemu_cpu_hotplug {
3512     my ($vmid, $conf, $vcpus) = @_;
3513
3514     my $sockets = 1;
3515     $sockets = $conf->{smp} if $conf->{smp}; # old style - no longer iused
3516     $sockets = $conf->{sockets} if  $conf->{sockets};
3517     my $cores = $conf->{cores} || 1;
3518     my $maxcpus = $sockets * $cores;
3519
3520     $vcpus = $maxcpus if !$vcpus;
3521
3522     die "you can't add more vcpus than maxcpus\n"
3523         if $vcpus > $maxcpus;
3524
3525     my $currentvcpus = $conf->{vcpus} || $maxcpus;
3526     die "online cpu unplug is not yet possible\n"
3527         if $vcpus < $currentvcpus;
3528
3529     my $currentrunningvcpus = vm_mon_cmd($vmid, "query-cpus");
3530     die "vcpus in running vm is different than configuration\n"
3531         if scalar(@{$currentrunningvcpus}) != $currentvcpus;
3532
3533     for (my $i = $currentvcpus; $i < $vcpus; $i++) {
3534         vm_mon_cmd($vmid, "cpu-add", id => int($i));
3535     }
3536 }
3537
3538 sub qemu_memory_hotplug {
3539     my ($vmid, $conf, $defaults, $opt, $value) = @_;
3540
3541     return $value if !check_running($vmid);
3542
3543     my $memory = $conf->{memory} || $defaults->{memory};
3544     $value = $defaults->{memory} if !$value;
3545     return $value if $value == $memory;
3546
3547     my $static_memory = $STATICMEM;
3548     my $dimm_memory = $memory - $static_memory;
3549
3550     die "memory can't be lower than $static_memory MB" if $value < $static_memory;
3551     die "memory unplug is not yet available" if $value < $memory;
3552     die "you cannot add more memory than $MAX_MEM MB!\n" if $memory > $MAX_MEM;
3553
3554
3555     my $sockets = 1;
3556     $sockets = $conf->{sockets} if $conf->{sockets};
3557
3558     foreach_dimm($conf, $vmid, $value, $sockets, sub {
3559         my ($conf, $vmid, $name, $dimm_size, $numanode, $current_size, $memory) = @_;
3560
3561             return if $current_size <= $conf->{memory};
3562
3563             eval { vm_mon_cmd($vmid, "object-add", 'qom-type' => "memory-backend-ram", id => "mem-$name", props => { size => int($dimm_size*1024*1024) } ) };
3564             if (my $err = $@) {
3565                 eval { qemu_objectdel($vmid, "mem-$name"); };
3566                 die $err;
3567             }
3568
3569             eval { vm_mon_cmd($vmid, "device_add", driver => "pc-dimm", id => "$name", memdev => "mem-$name", node => $numanode) };
3570             if (my $err = $@) {
3571                 eval { qemu_objectdel($vmid, "mem-$name"); };
3572                 die $err;
3573             }
3574             #update conf after each succesful module hotplug
3575             $conf->{memory} = $current_size;
3576             update_config_nolock($vmid, $conf, 1);
3577     });
3578 }
3579
3580 sub qemu_block_set_io_throttle {
3581     my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
3582
3583     return if !check_running($vmid) ;
3584
3585     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));
3586
3587 }
3588
3589 # old code, only used to shutdown old VM after update
3590 sub __read_avail {
3591     my ($fh, $timeout) = @_;
3592
3593     my $sel = new IO::Select;
3594     $sel->add($fh);
3595
3596     my $res = '';
3597     my $buf;
3598
3599     my @ready;
3600     while (scalar (@ready = $sel->can_read($timeout))) {
3601         my $count;
3602         if ($count = $fh->sysread($buf, 8192)) {
3603             if ($buf =~ /^(.*)\(qemu\) $/s) {
3604                 $res .= $1;
3605                 last;
3606             } else {
3607                 $res .= $buf;
3608             }
3609         } else {
3610             if (!defined($count)) {
3611                 die "$!\n";
3612             }
3613             last;
3614         }
3615     }
3616
3617     die "monitor read timeout\n" if !scalar(@ready);
3618
3619     return $res;
3620 }
3621
3622 # old code, only used to shutdown old VM after update
3623 sub vm_monitor_command {
3624     my ($vmid, $cmdstr, $nocheck) = @_;
3625
3626     my $res;
3627
3628     eval {
3629         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
3630
3631         my $sname = "${var_run_tmpdir}/$vmid.mon";
3632
3633         my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
3634             die "unable to connect to VM $vmid socket - $!\n";
3635
3636         my $timeout = 3;
3637
3638         # hack: migrate sometime blocks the monitor (when migrate_downtime
3639         # is set)
3640         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3641             $timeout = 60*60; # 1 hour
3642         }
3643
3644         # read banner;
3645         my $data = __read_avail($sock, $timeout);
3646
3647         if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
3648             die "got unexpected qemu monitor banner\n";
3649         }
3650
3651         my $sel = new IO::Select;
3652         $sel->add($sock);
3653
3654         if (!scalar(my @ready = $sel->can_write($timeout))) {
3655             die "monitor write error - timeout";
3656         }
3657
3658         my $fullcmd = "$cmdstr\r";
3659
3660         # syslog('info', "VM $vmid monitor command: $cmdstr");
3661
3662         my $b;
3663         if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
3664             die "monitor write error - $!";
3665         }
3666
3667         return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
3668
3669         $timeout = 20;
3670
3671         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3672             $timeout = 60*60; # 1 hour
3673         } elsif ($cmdstr =~ m/^(eject|change)/) {
3674             $timeout = 60; # note: cdrom mount command is slow
3675         }
3676         if ($res = __read_avail($sock, $timeout)) {
3677
3678             my @lines = split("\r?\n", $res);
3679
3680             shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
3681
3682             $res = join("\n", @lines);
3683             $res .= "\n";
3684         }
3685     };
3686
3687     my $err = $@;
3688
3689     if ($err) {
3690         syslog("err", "VM $vmid monitor command failed - $err");
3691         die $err;
3692     }
3693
3694     return $res;
3695 }
3696
3697 sub qemu_block_resize {
3698     my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
3699
3700     my $running = check_running($vmid);
3701
3702     return if !PVE::Storage::volume_resize($storecfg, $volid, $size, $running);
3703
3704     return if !$running;
3705
3706     vm_mon_cmd($vmid, "block_resize", device => $deviceid, size => int($size));
3707
3708 }
3709
3710 sub qemu_volume_snapshot {
3711     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3712
3713     my $running = check_running($vmid);
3714
3715     return if !PVE::Storage::volume_snapshot($storecfg, $volid, $snap, $running);
3716
3717     return if !$running;
3718
3719     vm_mon_cmd($vmid, "snapshot-drive", device => $deviceid, name => $snap);
3720
3721 }
3722
3723 sub qemu_volume_snapshot_delete {
3724     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3725
3726     my $running = check_running($vmid);
3727
3728     return if !PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snap, $running);
3729
3730     return if !$running;
3731
3732     vm_mon_cmd($vmid, "delete-drive-snapshot", device => $deviceid, name => $snap);
3733 }
3734
3735 sub set_migration_caps {
3736     my ($vmid) = @_;
3737
3738     my $cap_ref = [];
3739
3740     my $enabled_cap = {
3741         "auto-converge" => 1,
3742         "xbzrle" => 0,
3743         "x-rdma-pin-all" => 0,
3744         "zero-blocks" => 0,
3745     };
3746
3747     my $supported_capabilities = vm_mon_cmd_nocheck($vmid, "query-migrate-capabilities");
3748
3749     for my $supported_capability (@$supported_capabilities) {
3750         push @$cap_ref, {
3751             capability => $supported_capability->{capability},
3752             state => $enabled_cap->{$supported_capability->{capability}} ? JSON::true : JSON::false,
3753         };
3754     }
3755
3756     vm_mon_cmd_nocheck($vmid, "migrate-set-capabilities", capabilities => $cap_ref);
3757 }
3758
3759 my $fast_plug_option = {
3760     'lock' => 1,
3761     'name' => 1,
3762     'onboot' => 1,
3763     'shares' => 1,
3764     'startup' => 1,
3765 };
3766
3767 # hotplug changes in [PENDING]
3768 # $selection hash can be used to only apply specified options, for
3769 # example: { cores => 1 } (only apply changed 'cores')
3770 # $errors ref is used to return error messages
3771 sub vmconfig_hotplug_pending {
3772     my ($vmid, $conf, $storecfg, $selection, $errors) = @_;
3773
3774     my $defaults = load_defaults();
3775
3776     # commit values which do not have any impact on running VM first
3777     # Note: those option cannot raise errors, we we do not care about
3778     # $selection and always apply them.
3779
3780     my $add_error = sub {
3781         my ($opt, $msg) = @_;
3782         $errors->{$opt} = "hotplug problem - $msg";
3783     };
3784
3785     my $changes = 0;
3786     foreach my $opt (keys %{$conf->{pending}}) { # add/change
3787         if ($fast_plug_option->{$opt}) {
3788             $conf->{$opt} = $conf->{pending}->{$opt};
3789             delete $conf->{pending}->{$opt};
3790             $changes = 1;
3791         }
3792     }
3793
3794     if ($changes) {
3795         update_config_nolock($vmid, $conf, 1);
3796         $conf = load_config($vmid); # update/reload
3797     }
3798
3799     my $hotplug_features = parse_hotplug_features(defined($conf->{hotplug}) ? $conf->{hotplug} : '1');
3800
3801     my @delete = PVE::Tools::split_list($conf->{pending}->{delete});
3802     foreach my $opt (@delete) {
3803         next if $selection && !$selection->{$opt};
3804         eval {
3805             if ($opt eq 'hotplug') {
3806                 die "skip\n" if ($conf->{hotplug} =~ /memory/);
3807             } elsif ($opt eq 'tablet') {
3808                 die "skip\n" if !$hotplug_features->{usb};
3809                 if ($defaults->{tablet}) {
3810                     vm_deviceplug($storecfg, $conf, $vmid, $opt);
3811                 } else {
3812                     vm_deviceunplug($vmid, $conf, $opt);
3813                 }
3814             } elsif ($opt eq 'vcpus') {
3815                 die "skip\n" if !$hotplug_features->{cpu};
3816                 qemu_cpu_hotplug($vmid, $conf, undef);
3817             } elsif ($opt eq 'balloon') {
3818                 # enable balloon device is not hotpluggable
3819                 die "skip\n" if !defined($conf->{balloon}) || $conf->{balloon};
3820             } elsif ($fast_plug_option->{$opt}) {
3821                 # do nothing
3822             } elsif ($opt =~ m/^net(\d+)$/) {
3823                 die "skip\n" if !$hotplug_features->{network};
3824                 vm_deviceunplug($vmid, $conf, $opt);
3825             } elsif (valid_drivename($opt)) {
3826                 die "skip\n" if !$hotplug_features->{disk} || $opt =~ m/(ide|sata)(\d+)/;
3827                 vm_deviceunplug($vmid, $conf, $opt);
3828                 vmconfig_register_unused_drive($storecfg, $vmid, $conf, parse_drive($opt, $conf->{$opt}));
3829             } elsif ($opt =~ m/^memory$/) {
3830                 die "skip\n" if !$hotplug_features->{memory};
3831                 qemu_memory_hotplug($vmid, $conf, $defaults, $opt);
3832             } else {
3833                 die "skip\n";
3834             }
3835         };
3836         if (my $err = $@) {
3837             &$add_error($opt, $err) if $err ne "skip\n";
3838         } else {
3839             # save new config if hotplug was successful
3840             delete $conf->{$opt};
3841             vmconfig_undelete_pending_option($conf, $opt);
3842             update_config_nolock($vmid, $conf, 1);
3843             $conf = load_config($vmid); # update/reload
3844         }
3845     }
3846
3847     foreach my $opt (keys %{$conf->{pending}}) {
3848         next if $selection && !$selection->{$opt};
3849         my $value = $conf->{pending}->{$opt};
3850         eval {
3851             if ($opt eq 'hotplug') {
3852                 die "skip\n" if ($value =~ /memory/) || ($value !~ /memory/ && $conf->{hotplug} =~ /memory/);
3853             } elsif ($opt eq 'tablet') {
3854                 die "skip\n" if !$hotplug_features->{usb};
3855                 if ($value == 1) {
3856                     vm_deviceplug($storecfg, $conf, $vmid, $opt);
3857                 } elsif ($value == 0) {
3858                     vm_deviceunplug($vmid, $conf, $opt);
3859                 }
3860             } elsif ($opt eq 'vcpus') {
3861                 die "skip\n" if !$hotplug_features->{cpu};
3862                 qemu_cpu_hotplug($vmid, $conf, $value);
3863             } elsif ($opt eq 'balloon') {
3864                 # enable/disable balloning device is not hotpluggable
3865                 my $old_balloon_enabled =  !!(!defined($conf->{balloon}) || $conf->{balloon});
3866                 my $new_balloon_enabled =  !!(!defined($conf->{pending}->{balloon}) || $conf->{pending}->{balloon});
3867                 die "skip\n" if $old_balloon_enabled != $new_balloon_enabled;
3868
3869                 # allow manual ballooning if shares is set to zero
3870                 if ((defined($conf->{shares}) && ($conf->{shares} == 0))) {
3871                     my $balloon = $conf->{pending}->{balloon} || $conf->{memory} || $defaults->{memory};
3872                     vm_mon_cmd($vmid, "balloon", value => $balloon*1024*1024);
3873                 }
3874             } elsif ($opt =~ m/^net(\d+)$/) {
3875                 # some changes can be done without hotplug
3876                 vmconfig_update_net($storecfg, $conf, $hotplug_features->{network},
3877                                     $vmid, $opt, $value);
3878             } elsif (valid_drivename($opt)) {
3879                 # some changes can be done without hotplug
3880                 vmconfig_update_disk($storecfg, $conf, $hotplug_features->{disk},
3881                                      $vmid, $opt, $value, 1);
3882             } elsif ($opt =~ m/^memory$/) { #dimms
3883                 die "skip\n" if !$hotplug_features->{memory};
3884                 $value = qemu_memory_hotplug($vmid, $conf, $defaults, $opt, $value);
3885             } else {
3886                 die "skip\n";  # skip non-hot-pluggable options
3887             }
3888         };
3889         if (my $err = $@) {
3890             &$add_error($opt, $err) if $err ne "skip\n";
3891         } else {
3892             # save new config if hotplug was successful
3893             $conf->{$opt} = $value;
3894             delete $conf->{pending}->{$opt};
3895             update_config_nolock($vmid, $conf, 1);
3896             $conf = load_config($vmid); # update/reload
3897         }
3898     }
3899 }
3900
3901 sub vmconfig_apply_pending {
3902     my ($vmid, $conf, $storecfg) = @_;
3903
3904     # cold plug
3905
3906     my @delete = PVE::Tools::split_list($conf->{pending}->{delete});
3907     foreach my $opt (@delete) { # delete
3908         die "internal error" if $opt =~ m/^unused/;
3909         $conf = load_config($vmid); # update/reload
3910         if (!defined($conf->{$opt})) {
3911             vmconfig_undelete_pending_option($conf, $opt);
3912             update_config_nolock($vmid, $conf, 1);
3913         } elsif (valid_drivename($opt)) {
3914             vmconfig_register_unused_drive($storecfg, $vmid, $conf, parse_drive($opt, $conf->{$opt}));
3915             vmconfig_undelete_pending_option($conf, $opt);
3916             delete $conf->{$opt};
3917             update_config_nolock($vmid, $conf, 1);
3918         } else {
3919             vmconfig_undelete_pending_option($conf, $opt);
3920             delete $conf->{$opt};
3921             update_config_nolock($vmid, $conf, 1);
3922         }
3923     }
3924
3925     $conf = load_config($vmid); # update/reload
3926
3927     foreach my $opt (keys %{$conf->{pending}}) { # add/change
3928         $conf = load_config($vmid); # update/reload
3929
3930         if (defined($conf->{$opt}) && ($conf->{$opt} eq $conf->{pending}->{$opt})) {
3931             # skip if nothing changed
3932         } elsif (valid_drivename($opt)) {
3933             vmconfig_register_unused_drive($storecfg, $vmid, $conf, parse_drive($opt, $conf->{$opt}))
3934                 if defined($conf->{$opt});
3935             $conf->{$opt} = $conf->{pending}->{$opt};
3936         } else {
3937             $conf->{$opt} = $conf->{pending}->{$opt};
3938         }
3939
3940         delete $conf->{pending}->{$opt};
3941         update_config_nolock($vmid, $conf, 1);
3942     }
3943 }
3944
3945 my $safe_num_ne = sub {
3946     my ($a, $b) = @_;
3947
3948     return 0 if !defined($a) && !defined($b);
3949     return 1 if !defined($a);
3950     return 1 if !defined($b);
3951
3952     return $a != $b;
3953 };
3954
3955 my $safe_string_ne = sub {
3956     my ($a, $b) = @_;
3957
3958     return 0 if !defined($a) && !defined($b);
3959     return 1 if !defined($a);
3960     return 1 if !defined($b);
3961
3962     return $a ne $b;
3963 };
3964
3965 sub vmconfig_update_net {
3966     my ($storecfg, $conf, $hotplug, $vmid, $opt, $value) = @_;
3967
3968     my $newnet = parse_net($value);
3969
3970     if ($conf->{$opt}) {
3971         my $oldnet = parse_net($conf->{$opt});
3972
3973         if (&$safe_string_ne($oldnet->{model}, $newnet->{model}) ||
3974             &$safe_string_ne($oldnet->{macaddr}, $newnet->{macaddr}) ||
3975             &$safe_num_ne($oldnet->{queues}, $newnet->{queues}) ||
3976             !($newnet->{bridge} && $oldnet->{bridge})) { # bridge/nat mode change
3977
3978             # for non online change, we try to hot-unplug
3979             die "skip\n" if !$hotplug;
3980             vm_deviceunplug($vmid, $conf, $opt);
3981         } else {
3982
3983             die "internal error" if $opt !~ m/net(\d+)/;
3984             my $iface = "tap${vmid}i$1";
3985
3986             if (&$safe_num_ne($oldnet->{rate}, $newnet->{rate})) {
3987                 PVE::Network::tap_rate_limit($iface, $newnet->{rate});
3988             }
3989
3990             if (&$safe_string_ne($oldnet->{bridge}, $newnet->{bridge}) ||
3991                 &$safe_num_ne($oldnet->{tag}, $newnet->{tag}) ||
3992                 &$safe_num_ne($oldnet->{firewall}, $newnet->{firewall})) {
3993                 PVE::Network::tap_unplug($iface);
3994                 PVE::Network::tap_plug($iface, $newnet->{bridge}, $newnet->{tag}, $newnet->{firewall});
3995             }
3996
3997             if (&$safe_string_ne($oldnet->{link_down}, $newnet->{link_down})) {
3998                 qemu_set_link_status($vmid, $opt, !$newnet->{link_down});
3999             }
4000
4001             return 1;
4002         }
4003     }
4004
4005     if ($hotplug) {
4006         vm_deviceplug($storecfg, $conf, $vmid, $opt, $newnet);
4007     } else {
4008         die "skip\n";
4009     }
4010 }
4011
4012 sub vmconfig_update_disk {
4013     my ($storecfg, $conf, $hotplug, $vmid, $opt, $value, $force) = @_;
4014
4015     # fixme: do we need force?
4016
4017     my $drive = parse_drive($opt, $value);
4018
4019     if ($conf->{$opt}) {
4020
4021         if (my $old_drive = parse_drive($opt, $conf->{$opt}))  {
4022
4023             my $media = $drive->{media} || 'disk';
4024             my $oldmedia = $old_drive->{media} || 'disk';
4025             die "unable to change media type\n" if $media ne $oldmedia;
4026
4027             if (!drive_is_cdrom($old_drive)) {
4028
4029                 if ($drive->{file} ne $old_drive->{file}) {
4030
4031                     die "skip\n" if !$hotplug;
4032
4033                     # unplug and register as unused
4034                     vm_deviceunplug($vmid, $conf, $opt);
4035                     vmconfig_register_unused_drive($storecfg, $vmid, $conf, $old_drive)
4036
4037                 } else {
4038                     # update existing disk
4039
4040                     # skip non hotpluggable value
4041                     if (&$safe_num_ne($drive->{discard}, $old_drive->{discard}) ||
4042                         &$safe_string_ne($drive->{cache}, $old_drive->{cache})) {
4043                         die "skip\n";
4044                     }
4045
4046                     # apply throttle
4047                     if (&$safe_num_ne($drive->{mbps}, $old_drive->{mbps}) ||
4048                         &$safe_num_ne($drive->{mbps_rd}, $old_drive->{mbps_rd}) ||
4049                         &$safe_num_ne($drive->{mbps_wr}, $old_drive->{mbps_wr}) ||
4050                         &$safe_num_ne($drive->{iops}, $old_drive->{iops}) ||
4051                         &$safe_num_ne($drive->{iops_rd}, $old_drive->{iops_rd}) ||
4052                         &$safe_num_ne($drive->{iops_wr}, $old_drive->{iops_wr}) ||
4053                         &$safe_num_ne($drive->{mbps_max}, $old_drive->{mbps_max}) ||
4054                         &$safe_num_ne($drive->{mbps_rd_max}, $old_drive->{mbps_rd_max}) ||
4055                         &$safe_num_ne($drive->{mbps_wr_max}, $old_drive->{mbps_wr_max}) ||
4056                         &$safe_num_ne($drive->{iops_max}, $old_drive->{iops_max}) ||
4057                         &$safe_num_ne($drive->{iops_rd_max}, $old_drive->{iops_rd_max}) ||
4058                         &$safe_num_ne($drive->{iops_wr_max}, $old_drive->{iops_wr_max})) {
4059
4060                         qemu_block_set_io_throttle($vmid,"drive-$opt",
4061                                                    ($drive->{mbps} || 0)*1024*1024,
4062                                                    ($drive->{mbps_rd} || 0)*1024*1024,
4063                                                    ($drive->{mbps_wr} || 0)*1024*1024,
4064                                                    $drive->{iops} || 0,
4065                                                    $drive->{iops_rd} || 0,
4066                                                    $drive->{iops_wr} || 0,
4067                                                    ($drive->{mbps_max} || 0)*1024*1024,
4068                                                    ($drive->{mbps_rd_max} || 0)*1024*1024,
4069                                                    ($drive->{mbps_wr_max} || 0)*1024*1024,
4070                                                    $drive->{iops_max} || 0,
4071                                                    $drive->{iops_rd_max} || 0,
4072                                                    $drive->{iops_wr_max} || 0);
4073
4074                     }
4075
4076                     return 1;
4077                 }
4078
4079             } else { # cdrom
4080
4081                 if ($drive->{file} eq 'none') {
4082                     vm_mon_cmd($vmid, "eject",force => JSON::true,device => "drive-$opt");
4083                 } else {
4084                     my $path = get_iso_path($storecfg, $vmid, $drive->{file});
4085                     vm_mon_cmd($vmid, "eject", force => JSON::true,device => "drive-$opt"); # force eject if locked
4086                     vm_mon_cmd($vmid, "change", device => "drive-$opt",target => "$path") if $path;
4087                 }
4088
4089                 return 1;
4090             }
4091         }
4092     }
4093
4094     die "skip\n" if !$hotplug || $opt =~ m/(ide|sata)(\d+)/;
4095     # hotplug new disks
4096     vm_deviceplug($storecfg, $conf, $vmid, $opt, $drive);
4097 }
4098
4099 sub vm_start {
4100     my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused, $forcemachine, $spice_ticket) = @_;
4101
4102     lock_config($vmid, sub {
4103         my $conf = load_config($vmid, $migratedfrom);
4104
4105         die "you can't start a vm if it's a template\n" if is_template($conf);
4106
4107         check_lock($conf) if !$skiplock;
4108
4109         die "VM $vmid already running\n" if check_running($vmid, undef, $migratedfrom);
4110
4111         if (!$statefile && scalar(keys %{$conf->{pending}})) {
4112             vmconfig_apply_pending($vmid, $conf, $storecfg);
4113             $conf = load_config($vmid); # update/reload
4114         }
4115
4116         my $defaults = load_defaults();
4117
4118         # set environment variable useful inside network script
4119         $ENV{PVE_MIGRATED_FROM} = $migratedfrom if $migratedfrom;
4120
4121         my ($cmd, $vollist, $spice_port) = config_to_command($storecfg, $vmid, $conf, $defaults, $forcemachine);
4122
4123         my $migrate_port = 0;
4124         my $migrate_uri;
4125         if ($statefile) {
4126             if ($statefile eq 'tcp') {
4127                 my $localip = "localhost";
4128                 my $datacenterconf = PVE::Cluster::cfs_read_file('datacenter.cfg');
4129                 if ($datacenterconf->{migration_unsecure}) {
4130                         my $nodename = PVE::INotify::nodename();
4131                         $localip = PVE::Cluster::remote_node_ip($nodename, 1);
4132                 }
4133                 $migrate_port = PVE::Tools::next_migrate_port();
4134                 $migrate_uri = "tcp:${localip}:${migrate_port}";
4135                 push @$cmd, '-incoming', $migrate_uri;
4136                 push @$cmd, '-S';
4137             } else {
4138                 push @$cmd, '-loadstate', $statefile;
4139             }
4140         } elsif ($paused) {
4141             push @$cmd, '-S';
4142         }
4143
4144         # host pci devices
4145         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
4146           my $d = parse_hostpci($conf->{"hostpci$i"});
4147           next if !$d;
4148           my $pcidevices = $d->{pciid};
4149           foreach my $pcidevice (@$pcidevices) {
4150                 my $pciid = $pcidevice->{id}.".".$pcidevice->{function};
4151
4152                 my $info = pci_device_info("0000:$pciid");
4153                 die "IOMMU not present\n" if !check_iommu_support();
4154                 die "no pci device info for device '$pciid'\n" if !$info;
4155
4156                 if ($d->{driver} && $d->{driver} eq "vfio") {
4157                     die "can't unbind/bind pci group to vfio '$pciid'\n" if !pci_dev_group_bind_to_vfio($pciid);
4158                 } else {
4159                     die "can't unbind/bind to stub pci device '$pciid'\n" if !pci_dev_bind_to_stub($info);
4160                 }
4161
4162                 die "can't reset pci device '$pciid'\n" if $info->{has_fl_reset} and !pci_dev_reset($info);
4163           }
4164         }
4165
4166         PVE::Storage::activate_volumes($storecfg, $vollist);
4167
4168         eval  { run_command($cmd, timeout => $statefile ? undef : 30,
4169                     umask => 0077); };
4170         my $err = $@;
4171         die "start failed: $err" if $err;
4172
4173         print "migration listens on $migrate_uri\n" if $migrate_uri;
4174
4175         if ($statefile && $statefile ne 'tcp')  {
4176             eval { vm_mon_cmd_nocheck($vmid, "cont"); };
4177             warn $@ if $@;
4178         }
4179
4180         if ($migratedfrom) {
4181
4182             eval {
4183                 set_migration_caps($vmid);
4184             };
4185             warn $@ if $@;
4186
4187             if ($spice_port) {
4188                 print "spice listens on port $spice_port\n";
4189                 if ($spice_ticket) {
4190                     vm_mon_cmd_nocheck($vmid, "set_password", protocol => 'spice', password => $spice_ticket);
4191                     vm_mon_cmd_nocheck($vmid, "expire_password", protocol => 'spice', time => "+30");
4192                 }
4193             }
4194
4195         } else {
4196
4197             if (!$statefile && (!defined($conf->{balloon}) || $conf->{balloon})) {
4198                 vm_mon_cmd_nocheck($vmid, "balloon", value => $conf->{balloon}*1024*1024)
4199                     if $conf->{balloon};
4200                 vm_mon_cmd_nocheck($vmid, 'qom-set',
4201                             path => "machine/peripheral/balloon0",
4202                             property => "guest-stats-polling-interval",
4203                             value => 2);
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 }
4214
4215 sub vm_mon_cmd {
4216     my ($vmid, $execute, %params) = @_;
4217
4218     my $cmd = { execute => $execute, arguments => \%params };
4219     vm_qmp_command($vmid, $cmd);
4220 }
4221
4222 sub vm_mon_cmd_nocheck {
4223     my ($vmid, $execute, %params) = @_;
4224
4225     my $cmd = { execute => $execute, arguments => \%params };
4226     vm_qmp_command($vmid, $cmd, 1);
4227 }
4228
4229 sub vm_qmp_command {
4230     my ($vmid, $cmd, $nocheck) = @_;
4231
4232     my $res;
4233
4234     my $timeout;
4235     if ($cmd->{arguments} && $cmd->{arguments}->{timeout}) {
4236         $timeout = $cmd->{arguments}->{timeout};
4237         delete $cmd->{arguments}->{timeout};
4238     }
4239
4240     eval {
4241         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
4242         my $sname = qmp_socket($vmid);
4243         if (-e $sname) { # test if VM is reasonambe new and supports qmp/qga
4244             my $qmpclient = PVE::QMPClient->new();
4245
4246             $res = $qmpclient->cmd($vmid, $cmd, $timeout);
4247         } elsif (-e "${var_run_tmpdir}/$vmid.mon") {
4248             die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
4249                 if scalar(%{$cmd->{arguments}});
4250             vm_monitor_command($vmid, $cmd->{execute}, $nocheck);
4251         } else {
4252             die "unable to open monitor socket\n";
4253         }
4254     };
4255     if (my $err = $@) {
4256         syslog("err", "VM $vmid qmp command failed - $err");
4257         die $err;
4258     }
4259
4260     return $res;
4261 }
4262
4263 sub vm_human_monitor_command {
4264     my ($vmid, $cmdline) = @_;
4265
4266     my $res;
4267
4268     my $cmd = {
4269         execute => 'human-monitor-command',
4270         arguments => { 'command-line' => $cmdline},
4271     };
4272
4273     return vm_qmp_command($vmid, $cmd);
4274 }
4275
4276 sub vm_commandline {
4277     my ($storecfg, $vmid) = @_;
4278
4279     my $conf = load_config($vmid);
4280
4281     my $defaults = load_defaults();
4282
4283     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
4284
4285     return join(' ', @$cmd);
4286 }
4287
4288 sub vm_reset {
4289     my ($vmid, $skiplock) = @_;
4290
4291     lock_config($vmid, sub {
4292
4293         my $conf = load_config($vmid);
4294
4295         check_lock($conf) if !$skiplock;
4296
4297         vm_mon_cmd($vmid, "system_reset");
4298     });
4299 }
4300
4301 sub get_vm_volumes {
4302     my ($conf) = @_;
4303
4304     my $vollist = [];
4305     foreach_volid($conf, sub {
4306         my ($volid, $is_cdrom) = @_;
4307
4308         return if $volid =~ m|^/|;
4309
4310         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
4311         return if !$sid;
4312
4313         push @$vollist, $volid;
4314     });
4315
4316     return $vollist;
4317 }
4318
4319 sub vm_stop_cleanup {
4320     my ($storecfg, $vmid, $conf, $keepActive, $apply_pending_changes) = @_;
4321
4322     eval {
4323         fairsched_rmnod($vmid); # try to destroy group
4324
4325         if (!$keepActive) {
4326             my $vollist = get_vm_volumes($conf);
4327             PVE::Storage::deactivate_volumes($storecfg, $vollist);
4328         }
4329
4330         foreach my $ext (qw(mon qmp pid vnc qga)) {
4331             unlink "/var/run/qemu-server/${vmid}.$ext";
4332         }
4333
4334         vmconfig_apply_pending($vmid, $conf, $storecfg) if $apply_pending_changes;
4335     };
4336     warn $@ if $@; # avoid errors - just warn
4337 }
4338
4339 # Note: use $nockeck to skip tests if VM configuration file exists.
4340 # We need that when migration VMs to other nodes (files already moved)
4341 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
4342 sub vm_stop {
4343     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
4344
4345     $force = 1 if !defined($force) && !$shutdown;
4346
4347     if ($migratedfrom){
4348         my $pid = check_running($vmid, $nocheck, $migratedfrom);
4349         kill 15, $pid if $pid;
4350         my $conf = load_config($vmid, $migratedfrom);
4351         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive, 0);
4352         return;
4353     }
4354
4355     lock_config($vmid, sub {
4356
4357         my $pid = check_running($vmid, $nocheck);
4358         return if !$pid;
4359
4360         my $conf;
4361         if (!$nocheck) {
4362             $conf = load_config($vmid);
4363             check_lock($conf) if !$skiplock;
4364             if (!defined($timeout) && $shutdown && $conf->{startup}) {
4365                 my $opts = parse_startup($conf->{startup});
4366                 $timeout = $opts->{down} if $opts->{down};
4367             }
4368         }
4369
4370         $timeout = 60 if !defined($timeout);
4371
4372         eval {
4373             if ($shutdown) {
4374                 if (defined($conf) && $conf->{agent}) {
4375                     vm_qmp_command($vmid, { execute => "guest-shutdown" }, $nocheck);
4376                 } else {
4377                     vm_qmp_command($vmid, { execute => "system_powerdown" }, $nocheck);
4378                 }
4379             } else {
4380                 vm_qmp_command($vmid, { execute => "quit" }, $nocheck);
4381             }
4382         };
4383         my $err = $@;
4384
4385         if (!$err) {
4386             my $count = 0;
4387             while (($count < $timeout) && check_running($vmid, $nocheck)) {
4388                 $count++;
4389                 sleep 1;
4390             }
4391
4392             if ($count >= $timeout) {
4393                 if ($force) {
4394                     warn "VM still running - terminating now with SIGTERM\n";
4395                     kill 15, $pid;
4396                 } else {
4397                     die "VM quit/powerdown failed - got timeout\n";
4398                 }
4399             } else {
4400                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive, 1) if $conf;
4401                 return;
4402             }
4403         } else {
4404             if ($force) {
4405                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
4406                 kill 15, $pid;
4407             } else {
4408                 die "VM quit/powerdown failed\n";
4409             }
4410         }
4411
4412         # wait again
4413         $timeout = 10;
4414
4415         my $count = 0;
4416         while (($count < $timeout) && check_running($vmid, $nocheck)) {
4417             $count++;
4418             sleep 1;
4419         }
4420
4421         if ($count >= $timeout) {
4422             warn "VM still running - terminating now with SIGKILL\n";
4423             kill 9, $pid;
4424             sleep 1;
4425         }
4426
4427         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive, 1) if $conf;
4428    });
4429 }
4430
4431 sub vm_suspend {
4432     my ($vmid, $skiplock) = @_;
4433
4434     lock_config($vmid, sub {
4435
4436         my $conf = load_config($vmid);
4437
4438         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
4439
4440         vm_mon_cmd($vmid, "stop");
4441     });
4442 }
4443
4444 sub vm_resume {
4445     my ($vmid, $skiplock) = @_;
4446
4447     lock_config($vmid, sub {
4448
4449         my $conf = load_config($vmid);
4450
4451         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
4452
4453         vm_mon_cmd($vmid, "cont");
4454     });
4455 }
4456
4457 sub vm_sendkey {
4458     my ($vmid, $skiplock, $key) = @_;
4459
4460     lock_config($vmid, sub {
4461
4462         my $conf = load_config($vmid);
4463
4464         # there is no qmp command, so we use the human monitor command
4465         vm_human_monitor_command($vmid, "sendkey $key");
4466     });
4467 }
4468
4469 sub vm_destroy {
4470     my ($storecfg, $vmid, $skiplock) = @_;
4471
4472     lock_config($vmid, sub {
4473
4474         my $conf = load_config($vmid);
4475
4476         check_lock($conf) if !$skiplock;
4477
4478         if (!check_running($vmid)) {
4479             fairsched_rmnod($vmid); # try to destroy group
4480             destroy_vm($storecfg, $vmid);
4481         } else {
4482             die "VM $vmid is running - destroy failed\n";
4483         }
4484     });
4485 }
4486
4487 # pci helpers
4488
4489 sub file_write {
4490     my ($filename, $buf) = @_;
4491
4492     my $fh = IO::File->new($filename, "w");
4493     return undef if !$fh;
4494
4495     my $res = print $fh $buf;
4496
4497     $fh->close();
4498
4499     return $res;
4500 }
4501
4502 sub pci_device_info {
4503     my ($name) = @_;
4504
4505     my $res;
4506
4507     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
4508     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
4509
4510     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
4511     return undef if !defined($irq) || $irq !~ m/^\d+$/;
4512
4513     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
4514     return undef if !defined($vendor) || $vendor !~ s/^0x//;
4515
4516     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
4517     return undef if !defined($product) || $product !~ s/^0x//;
4518
4519     $res = {
4520         name => $name,
4521         vendor => $vendor,
4522         product => $product,
4523         domain => $domain,
4524         bus => $bus,
4525         slot => $slot,
4526         func => $func,
4527         irq => $irq,
4528         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
4529     };
4530
4531     return $res;
4532 }
4533
4534 sub pci_dev_reset {
4535     my ($dev) = @_;
4536
4537     my $name = $dev->{name};
4538
4539     my $fn = "$pcisysfs/devices/$name/reset";
4540
4541     return file_write($fn, "1");
4542 }
4543
4544 sub pci_dev_bind_to_stub {
4545     my ($dev) = @_;
4546
4547     my $name = $dev->{name};
4548
4549     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
4550     return 1 if -d $testdir;
4551
4552     my $data = "$dev->{vendor} $dev->{product}";
4553     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
4554
4555     my $fn = "$pcisysfs/devices/$name/driver/unbind";
4556     if (!file_write($fn, $name)) {
4557         return undef if -f $fn;
4558     }
4559
4560     $fn = "$pcisysfs/drivers/pci-stub/bind";
4561     if (! -d $testdir) {
4562         return undef if !file_write($fn, $name);
4563     }
4564
4565     return -d $testdir;
4566 }
4567
4568 sub pci_dev_bind_to_vfio {
4569     my ($dev) = @_;
4570
4571     my $name = $dev->{name};
4572
4573     my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4574
4575     if (!-d $vfio_basedir) {
4576         system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4577     }
4578     die "Cannot find vfio-pci module!\n" if !-d $vfio_basedir;
4579
4580     my $testdir = "$vfio_basedir/$name";
4581     return 1 if -d $testdir;
4582
4583     my $data = "$dev->{vendor} $dev->{product}";
4584     return undef if !file_write("$vfio_basedir/new_id", $data);
4585
4586     my $fn = "$pcisysfs/devices/$name/driver/unbind";
4587     if (!file_write($fn, $name)) {
4588         return undef if -f $fn;
4589     }
4590
4591     $fn = "$vfio_basedir/bind";
4592     if (! -d $testdir) {
4593         return undef if !file_write($fn, $name);
4594     }
4595
4596     return -d $testdir;
4597 }
4598
4599 sub pci_dev_group_bind_to_vfio {
4600     my ($pciid) = @_;
4601
4602     my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4603
4604     if (!-d $vfio_basedir) {
4605         system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4606     }
4607     die "Cannot find vfio-pci module!\n" if !-d $vfio_basedir;
4608
4609     # get IOMMU group devices
4610     opendir(my $D, "$pcisysfs/devices/0000:$pciid/iommu_group/devices/") || die "Cannot open iommu_group: $!\n";
4611       my @devs = grep /^0000:/, readdir($D);
4612     closedir($D);
4613
4614     foreach my $pciid (@devs) {
4615         $pciid =~ m/^([:\.\da-f]+)$/ or die "PCI ID $pciid not valid!\n";
4616
4617         # pci bridges, switches or root ports are not supported
4618         # they have a pci_bus subdirectory so skip them
4619         next if (-e "$pcisysfs/devices/$pciid/pci_bus");
4620
4621         my $info = pci_device_info($1);
4622         pci_dev_bind_to_vfio($info) || die "Cannot bind $pciid to vfio\n";
4623     }
4624
4625     return 1;
4626 }
4627
4628 sub print_pci_addr {
4629     my ($id, $bridges) = @_;
4630
4631     my $res = '';
4632     my $devices = {
4633         piix3 => { bus => 0, addr => 1 },
4634         #addr2 : first videocard
4635         balloon0 => { bus => 0, addr => 3 },
4636         watchdog => { bus => 0, addr => 4 },
4637         scsihw0 => { bus => 0, addr => 5 },
4638         scsihw1 => { bus => 0, addr => 6 },
4639         ahci0 => { bus => 0, addr => 7 },
4640         qga0 => { bus => 0, addr => 8 },
4641         spice => { bus => 0, addr => 9 },
4642         virtio0 => { bus => 0, addr => 10 },
4643         virtio1 => { bus => 0, addr => 11 },
4644         virtio2 => { bus => 0, addr => 12 },
4645         virtio3 => { bus => 0, addr => 13 },
4646         virtio4 => { bus => 0, addr => 14 },
4647         virtio5 => { bus => 0, addr => 15 },
4648         hostpci0 => { bus => 0, addr => 16 },
4649         hostpci1 => { bus => 0, addr => 17 },
4650         net0 => { bus => 0, addr => 18 },
4651         net1 => { bus => 0, addr => 19 },
4652         net2 => { bus => 0, addr => 20 },
4653         net3 => { bus => 0, addr => 21 },
4654         net4 => { bus => 0, addr => 22 },
4655         net5 => { bus => 0, addr => 23 },
4656         vga1 => { bus => 0, addr => 24 },
4657         vga2 => { bus => 0, addr => 25 },
4658         vga3 => { bus => 0, addr => 26 },
4659         hostpci2 => { bus => 0, addr => 27 },
4660         hostpci3 => { bus => 0, addr => 28 },
4661         #addr29 : usb-host (pve-usb.cfg)
4662         'pci.1' => { bus => 0, addr => 30 },
4663         'pci.2' => { bus => 0, addr => 31 },
4664         'net6' => { bus => 1, addr => 1 },
4665         'net7' => { bus => 1, addr => 2 },
4666         'net8' => { bus => 1, addr => 3 },
4667         'net9' => { bus => 1, addr => 4 },
4668         'net10' => { bus => 1, addr => 5 },
4669         'net11' => { bus => 1, addr => 6 },
4670         'net12' => { bus => 1, addr => 7 },
4671         'net13' => { bus => 1, addr => 8 },
4672         'net14' => { bus => 1, addr => 9 },
4673         'net15' => { bus => 1, addr => 10 },
4674         'net16' => { bus => 1, addr => 11 },
4675         'net17' => { bus => 1, addr => 12 },
4676         'net18' => { bus => 1, addr => 13 },
4677         'net19' => { bus => 1, addr => 14 },
4678         'net20' => { bus => 1, addr => 15 },
4679         'net21' => { bus => 1, addr => 16 },
4680         'net22' => { bus => 1, addr => 17 },
4681         'net23' => { bus => 1, addr => 18 },
4682         'net24' => { bus => 1, addr => 19 },
4683         'net25' => { bus => 1, addr => 20 },
4684         'net26' => { bus => 1, addr => 21 },
4685         'net27' => { bus => 1, addr => 22 },
4686         'net28' => { bus => 1, addr => 23 },
4687         'net29' => { bus => 1, addr => 24 },
4688         'net30' => { bus => 1, addr => 25 },
4689         'net31' => { bus => 1, addr => 26 },
4690         'virtio6' => { bus => 2, addr => 1 },
4691         'virtio7' => { bus => 2, addr => 2 },
4692         'virtio8' => { bus => 2, addr => 3 },
4693         'virtio9' => { bus => 2, addr => 4 },
4694         'virtio10' => { bus => 2, addr => 5 },
4695         'virtio11' => { bus => 2, addr => 6 },
4696         'virtio12' => { bus => 2, addr => 7 },
4697         'virtio13' => { bus => 2, addr => 8 },
4698         'virtio14' => { bus => 2, addr => 9 },
4699         'virtio15' => { bus => 2, addr => 10 },
4700     };
4701
4702     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
4703            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
4704            my $bus = $devices->{$id}->{bus};
4705            $res = ",bus=pci.$bus,addr=$addr";
4706            $bridges->{$bus} = 1 if $bridges;
4707     }
4708     return $res;
4709
4710 }
4711
4712 sub print_pcie_addr {
4713     my ($id) = @_;
4714
4715     my $res = '';
4716     my $devices = {
4717         hostpci0 => { bus => "ich9-pcie-port-1", addr => 0 },
4718         hostpci1 => { bus => "ich9-pcie-port-2", addr => 0 },
4719         hostpci2 => { bus => "ich9-pcie-port-3", addr => 0 },
4720         hostpci3 => { bus => "ich9-pcie-port-4", addr => 0 },
4721     };
4722
4723     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
4724            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
4725            my $bus = $devices->{$id}->{bus};
4726            $res = ",bus=$bus,addr=$addr";
4727     }
4728     return $res;
4729
4730 }
4731
4732 # vzdump restore implementaion
4733
4734 sub tar_archive_read_firstfile {
4735     my $archive = shift;
4736
4737     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
4738
4739     # try to detect archive type first
4740     my $pid = open (TMP, "tar tf '$archive'|") ||
4741         die "unable to open file '$archive'\n";
4742     my $firstfile = <TMP>;
4743     kill 15, $pid;
4744     close TMP;
4745
4746     die "ERROR: archive contaions no data\n" if !$firstfile;
4747     chomp $firstfile;
4748
4749     return $firstfile;
4750 }
4751
4752 sub tar_restore_cleanup {
4753     my ($storecfg, $statfile) = @_;
4754
4755     print STDERR "starting cleanup\n";
4756
4757     if (my $fd = IO::File->new($statfile, "r")) {
4758         while (defined(my $line = <$fd>)) {
4759             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4760                 my $volid = $2;
4761                 eval {
4762                     if ($volid =~ m|^/|) {
4763                         unlink $volid || die 'unlink failed\n';
4764                     } else {
4765                         PVE::Storage::vdisk_free($storecfg, $volid);
4766                     }
4767                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
4768                 };
4769                 print STDERR "unable to cleanup '$volid' - $@" if $@;
4770             } else {
4771                 print STDERR "unable to parse line in statfile - $line";
4772             }
4773         }
4774         $fd->close();
4775     }
4776 }
4777
4778 sub restore_archive {
4779     my ($archive, $vmid, $user, $opts) = @_;
4780
4781     my $format = $opts->{format};
4782     my $comp;
4783
4784     if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
4785         $format = 'tar' if !$format;
4786         $comp = 'gzip';
4787     } elsif ($archive =~ m/\.tar$/) {
4788         $format = 'tar' if !$format;
4789     } elsif ($archive =~ m/.tar.lzo$/) {
4790         $format = 'tar' if !$format;
4791         $comp = 'lzop';
4792     } elsif ($archive =~ m/\.vma$/) {
4793         $format = 'vma' if !$format;
4794     } elsif ($archive =~ m/\.vma\.gz$/) {
4795         $format = 'vma' if !$format;
4796         $comp = 'gzip';
4797     } elsif ($archive =~ m/\.vma\.lzo$/) {
4798         $format = 'vma' if !$format;
4799         $comp = 'lzop';
4800     } else {
4801         $format = 'vma' if !$format; # default
4802     }
4803
4804     # try to detect archive format
4805     if ($format eq 'tar') {
4806         return restore_tar_archive($archive, $vmid, $user, $opts);
4807     } else {
4808         return restore_vma_archive($archive, $vmid, $user, $opts, $comp);
4809     }
4810 }
4811
4812 sub restore_update_config_line {
4813     my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
4814
4815     return if $line =~ m/^\#qmdump\#/;
4816     return if $line =~ m/^\#vzdump\#/;
4817     return if $line =~ m/^lock:/;
4818     return if $line =~ m/^unused\d+:/;
4819     return if $line =~ m/^parent:/;
4820     return if $line =~ m/^template:/; # restored VM is never a template
4821
4822     if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
4823         # try to convert old 1.X settings
4824         my ($id, $ind, $ethcfg) = ($1, $2, $3);
4825         foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
4826             my ($model, $macaddr) = split(/\=/, $devconfig);
4827             $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $unique;
4828             my $net = {
4829                 model => $model,
4830                 bridge => "vmbr$ind",
4831                 macaddr => $macaddr,
4832             };
4833             my $netstr = print_net($net);
4834
4835             print $outfd "net$cookie->{netcount}: $netstr\n";
4836             $cookie->{netcount}++;
4837         }
4838     } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
4839         my ($id, $netstr) = ($1, $2);
4840         my $net = parse_net($netstr);
4841         $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
4842         $netstr = print_net($net);
4843         print $outfd "$id: $netstr\n";
4844     } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
4845         my $virtdev = $1;
4846         my $value = $3;
4847         if ($line =~ m/backup=no/) {
4848             print $outfd "#$line";
4849         } elsif ($virtdev && $map->{$virtdev}) {
4850             my $di = parse_drive($virtdev, $value);
4851             delete $di->{format}; # format can change on restore
4852             $di->{file} = $map->{$virtdev};
4853             $value = print_drive($vmid, $di);
4854             print $outfd "$virtdev: $value\n";
4855         } else {
4856             print $outfd $line;
4857         }
4858     } else {
4859         print $outfd $line;
4860     }
4861 }
4862
4863 sub scan_volids {
4864     my ($cfg, $vmid) = @_;
4865
4866     my $info = PVE::Storage::vdisk_list($cfg, undef, $vmid);
4867
4868     my $volid_hash = {};
4869     foreach my $storeid (keys %$info) {
4870         foreach my $item (@{$info->{$storeid}}) {
4871             next if !($item->{volid} && $item->{size});
4872             $item->{path} = PVE::Storage::path($cfg, $item->{volid});
4873             $volid_hash->{$item->{volid}} = $item;
4874         }
4875     }
4876
4877     return $volid_hash;
4878 }
4879
4880 sub get_used_paths {
4881     my ($vmid, $storecfg, $conf, $scan_snapshots, $skip_drive) = @_;
4882
4883     my $used_path = {};
4884
4885     my $scan_config = sub {
4886         my ($cref, $snapname) = @_;
4887
4888         foreach my $key (keys %$cref) {
4889             my $value = $cref->{$key};
4890             if (valid_drivename($key)) {
4891                 next if $skip_drive && $key eq $skip_drive;
4892                 my $drive = parse_drive($key, $value);
4893                 next if !$drive || !$drive->{file} || drive_is_cdrom($drive);
4894                 if ($drive->{file} =~ m!^/!) {
4895                     $used_path->{$drive->{file}}++; # = 1;
4896                 } else {
4897                     my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file}, 1);
4898                     next if !$storeid;
4899                     my $scfg = PVE::Storage::storage_config($storecfg, $storeid, 1);
4900                     next if !$scfg;
4901                     my $path = PVE::Storage::path($storecfg, $drive->{file}, $snapname);
4902                     $used_path->{$path}++; # = 1;
4903                 }
4904             }
4905         }
4906     };
4907
4908     &$scan_config($conf);
4909
4910     undef $skip_drive;
4911
4912     if ($scan_snapshots) {
4913         foreach my $snapname (keys %{$conf->{snapshots}}) {
4914             &$scan_config($conf->{snapshots}->{$snapname}, $snapname);
4915         }
4916     }
4917
4918     return $used_path;
4919 }
4920
4921 sub update_disksize {
4922     my ($vmid, $conf, $volid_hash) = @_;
4923
4924     my $changes;
4925
4926     my $used = {};
4927
4928     # Note: it is allowed to define multiple storages with same path (alias), so
4929     # we need to check both 'volid' and real 'path' (two different volid can point
4930     # to the same path).
4931
4932     my $usedpath = {};
4933
4934     # update size info
4935     foreach my $opt (keys %$conf) {
4936         if (valid_drivename($opt)) {
4937             my $drive = parse_drive($opt, $conf->{$opt});
4938             my $volid = $drive->{file};
4939             next if !$volid;
4940
4941             $used->{$volid} = 1;
4942             if ($volid_hash->{$volid} &&
4943                 (my $path = $volid_hash->{$volid}->{path})) {
4944                 $usedpath->{$path} = 1;
4945             }
4946
4947             next if drive_is_cdrom($drive);
4948             next if !$volid_hash->{$volid};
4949
4950             $drive->{size} = $volid_hash->{$volid}->{size};
4951             my $new = print_drive($vmid, $drive);
4952             if ($new ne $conf->{$opt}) {
4953                 $changes = 1;
4954                 $conf->{$opt} = $new;
4955             }
4956         }
4957     }
4958
4959     # remove 'unusedX' entry if volume is used
4960     foreach my $opt (keys %$conf) {
4961         next if $opt !~ m/^unused\d+$/;
4962         my $volid = $conf->{$opt};
4963         my $path = $volid_hash->{$volid}->{path} if $volid_hash->{$volid};
4964         if ($used->{$volid} || ($path && $usedpath->{$path})) {
4965             $changes = 1;
4966             delete $conf->{$opt};
4967         }
4968     }
4969
4970     foreach my $volid (sort keys %$volid_hash) {
4971         next if $volid =~ m/vm-$vmid-state-/;
4972         next if $used->{$volid};
4973         my $path = $volid_hash->{$volid}->{path};
4974         next if !$path; # just to be sure
4975         next if $usedpath->{$path};
4976         $changes = 1;
4977         add_unused_volume($conf, $volid);
4978         $usedpath->{$path} = 1; # avoid to add more than once (aliases)
4979     }
4980
4981     return $changes;
4982 }
4983
4984 sub rescan {
4985     my ($vmid, $nolock) = @_;
4986
4987     my $cfg = PVE::Cluster::cfs_read_file("storage.cfg");
4988
4989     my $volid_hash = scan_volids($cfg, $vmid);
4990
4991     my $updatefn =  sub {
4992         my ($vmid) = @_;
4993
4994         my $conf = load_config($vmid);
4995
4996         check_lock($conf);
4997
4998         my $vm_volids = {};
4999         foreach my $volid (keys %$volid_hash) {
5000             my $info = $volid_hash->{$volid};
5001             $vm_volids->{$volid} = $info if $info->{vmid} && $info->{vmid} == $vmid;
5002         }
5003
5004         my $changes = update_disksize($vmid, $conf, $vm_volids);
5005
5006         update_config_nolock($vmid, $conf, 1) if $changes;
5007     };
5008
5009     if (defined($vmid)) {
5010         if ($nolock) {
5011             &$updatefn($vmid);
5012         } else {
5013             lock_config($vmid, $updatefn, $vmid);
5014         }
5015     } else {
5016         my $vmlist = config_list();
5017         foreach my $vmid (keys %$vmlist) {
5018             if ($nolock) {
5019                 &$updatefn($vmid);
5020             } else {
5021                 lock_config($vmid, $updatefn, $vmid);
5022             }
5023         }
5024     }
5025 }
5026
5027 sub restore_vma_archive {
5028     my ($archive, $vmid, $user, $opts, $comp) = @_;
5029
5030     my $input = $archive eq '-' ? "<&STDIN" : undef;
5031     my $readfrom = $archive;
5032
5033     my $uncomp = '';
5034     if ($comp) {
5035         $readfrom = '-';
5036         my $qarchive = PVE::Tools::shellquote($archive);
5037         if ($comp eq 'gzip') {
5038             $uncomp = "zcat $qarchive|";
5039         } elsif ($comp eq 'lzop') {
5040             $uncomp = "lzop -d -c $qarchive|";
5041         } else {
5042             die "unknown compression method '$comp'\n";
5043         }
5044
5045     }
5046
5047     my $tmpdir = "/var/tmp/vzdumptmp$$";
5048     rmtree $tmpdir;
5049
5050     # disable interrupts (always do cleanups)
5051     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
5052         warn "got interrupt - ignored\n";
5053     };
5054
5055     my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
5056     POSIX::mkfifo($mapfifo, 0600);
5057     my $fifofh;
5058
5059     my $openfifo = sub {
5060         open($fifofh, '>', $mapfifo) || die $!;
5061     };
5062
5063     my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
5064
5065     my $oldtimeout;
5066     my $timeout = 5;
5067
5068     my $devinfo = {};
5069
5070     my $rpcenv = PVE::RPCEnvironment::get();
5071
5072     my $conffile = config_file($vmid);
5073     my $tmpfn = "$conffile.$$.tmp";
5074
5075     # Note: $oldconf is undef if VM does not exists
5076     my $oldconf = PVE::Cluster::cfs_read_file(cfs_config_path($vmid));
5077
5078     my $print_devmap = sub {
5079         my $virtdev_hash = {};
5080
5081         my $cfgfn = "$tmpdir/qemu-server.conf";
5082
5083         # we can read the config - that is already extracted
5084         my $fh = IO::File->new($cfgfn, "r") ||
5085             "unable to read qemu-server.conf - $!\n";
5086
5087         while (defined(my $line = <$fh>)) {
5088             if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
5089                 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
5090                 die "archive does not contain data for drive '$virtdev'\n"
5091                     if !$devinfo->{$devname};
5092                 if (defined($opts->{storage})) {
5093                     $storeid = $opts->{storage} || 'local';
5094                 } elsif (!$storeid) {
5095                     $storeid = 'local';
5096                 }
5097                 $format = 'raw' if !$format;
5098                 $devinfo->{$devname}->{devname} = $devname;
5099                 $devinfo->{$devname}->{virtdev} = $virtdev;
5100                 $devinfo->{$devname}->{format} = $format;
5101                 $devinfo->{$devname}->{storeid} = $storeid;
5102
5103                 # check permission on storage
5104                 my $pool = $opts->{pool}; # todo: do we need that?
5105                 if ($user ne 'root@pam') {
5106                     $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
5107                 }
5108
5109                 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
5110             }
5111         }
5112
5113         foreach my $devname (keys %$devinfo) {
5114             die "found no device mapping information for device '$devname'\n"
5115                 if !$devinfo->{$devname}->{virtdev};
5116         }
5117
5118         my $cfg = cfs_read_file('storage.cfg');
5119
5120         # create empty/temp config
5121         if ($oldconf) {
5122             PVE::Tools::file_set_contents($conffile, "memory: 128\n");
5123             foreach_drive($oldconf, sub {
5124                 my ($ds, $drive) = @_;
5125
5126                 return if drive_is_cdrom($drive);
5127
5128                 my $volid = $drive->{file};
5129
5130                 return if !$volid || $volid =~ m|^/|;
5131
5132                 my ($path, $owner) = PVE::Storage::path($cfg, $volid);
5133                 return if !$path || !$owner || ($owner != $vmid);
5134
5135                 # Note: only delete disk we want to restore
5136                 # other volumes will become unused
5137                 if ($virtdev_hash->{$ds}) {
5138                     PVE::Storage::vdisk_free($cfg, $volid);
5139                 }
5140             });
5141         }
5142
5143         my $map = {};
5144         foreach my $virtdev (sort keys %$virtdev_hash) {
5145             my $d = $virtdev_hash->{$virtdev};
5146             my $alloc_size = int(($d->{size} + 1024 - 1)/1024);
5147             my $scfg = PVE::Storage::storage_config($cfg, $d->{storeid});
5148
5149             # test if requested format is supported
5150             my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($cfg, $d->{storeid});
5151             my $supported = grep { $_ eq $d->{format} } @$validFormats;
5152             $d->{format} = $defFormat if !$supported;
5153
5154             my $volid = PVE::Storage::vdisk_alloc($cfg, $d->{storeid}, $vmid,
5155                                                   $d->{format}, undef, $alloc_size);
5156             print STDERR "new volume ID is '$volid'\n";
5157             $d->{volid} = $volid;
5158             my $path = PVE::Storage::path($cfg, $volid);
5159
5160             my $write_zeros = 1;
5161             # fixme: what other storages types initialize volumes with zero?
5162             if ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs' || $scfg->{type} eq 'glusterfs' ||
5163                 $scfg->{type} eq 'sheepdog' || $scfg->{type} eq 'rbd') {
5164                 $write_zeros = 0;
5165             }
5166
5167             print $fifofh "${write_zeros}:$d->{devname}=$path\n";
5168
5169             print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
5170             $map->{$virtdev} = $volid;
5171         }
5172
5173         $fh->seek(0, 0) || die "seek failed - $!\n";
5174
5175         my $outfd = new IO::File ($tmpfn, "w") ||
5176             die "unable to write config for VM $vmid\n";
5177
5178         my $cookie = { netcount => 0 };
5179         while (defined(my $line = <$fh>)) {
5180             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
5181         }
5182
5183         $fh->close();
5184         $outfd->close();
5185     };
5186
5187     eval {
5188         # enable interrupts
5189         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
5190             die "interrupted by signal\n";
5191         };
5192         local $SIG{ALRM} = sub { die "got timeout\n"; };
5193
5194         $oldtimeout = alarm($timeout);
5195
5196         my $parser = sub {
5197             my $line = shift;
5198
5199             print "$line\n";
5200
5201             if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
5202                 my ($dev_id, $size, $devname) = ($1, $2, $3);
5203                 $devinfo->{$devname} = { size => $size, dev_id => $dev_id };
5204             } elsif ($line =~ m/^CTIME: /) {
5205                 # we correctly received the vma config, so we can disable
5206                 # the timeout now for disk allocation (set to 10 minutes, so
5207                 # that we always timeout if something goes wrong)
5208                 alarm(600);
5209                 &$print_devmap();
5210                 print $fifofh "done\n";
5211                 my $tmp = $oldtimeout || 0;
5212                 $oldtimeout = undef;
5213                 alarm($tmp);
5214                 close($fifofh);
5215             }
5216         };
5217
5218         print "restore vma archive: $cmd\n";
5219         run_command($cmd, input => $input, outfunc => $parser, afterfork => $openfifo);
5220     };
5221     my $err = $@;
5222
5223     alarm($oldtimeout) if $oldtimeout;
5224
5225     unlink $mapfifo;
5226
5227     if ($err) {
5228         rmtree $tmpdir;
5229         unlink $tmpfn;
5230
5231         my $cfg = cfs_read_file('storage.cfg');
5232         foreach my $devname (keys %$devinfo) {
5233             my $volid = $devinfo->{$devname}->{volid};
5234             next if !$volid;
5235             eval {
5236                 if ($volid =~ m|^/|) {
5237                     unlink $volid || die 'unlink failed\n';
5238                 } else {
5239                     PVE::Storage::vdisk_free($cfg, $volid);
5240                 }
5241                 print STDERR "temporary volume '$volid' sucessfuly removed\n";
5242             };
5243             print STDERR "unable to cleanup '$volid' - $@" if $@;
5244         }
5245         die $err;
5246     }
5247
5248     rmtree $tmpdir;
5249
5250     rename($tmpfn, $conffile) ||
5251         die "unable to commit configuration file '$conffile'\n";
5252
5253     PVE::Cluster::cfs_update(); # make sure we read new file
5254
5255     eval { rescan($vmid, 1); };
5256     warn $@ if $@;
5257 }
5258
5259 sub restore_tar_archive {
5260     my ($archive, $vmid, $user, $opts) = @_;
5261
5262     if ($archive ne '-') {
5263         my $firstfile = tar_archive_read_firstfile($archive);
5264         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
5265             if $firstfile ne 'qemu-server.conf';
5266     }
5267
5268     my $storecfg = cfs_read_file('storage.cfg');
5269
5270     # destroy existing data - keep empty config
5271     my $vmcfgfn = config_file($vmid);
5272     destroy_vm($storecfg, $vmid, 1) if -f $vmcfgfn;
5273
5274     my $tocmd = "/usr/lib/qemu-server/qmextract";
5275
5276     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
5277     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
5278     $tocmd .= ' --prealloc' if $opts->{prealloc};
5279     $tocmd .= ' --info' if $opts->{info};
5280
5281     # tar option "xf" does not autodetect compression when read from STDIN,
5282     # so we pipe to zcat
5283     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
5284         PVE::Tools::shellquote("--to-command=$tocmd");
5285
5286     my $tmpdir = "/var/tmp/vzdumptmp$$";
5287     mkpath $tmpdir;
5288
5289     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
5290     local $ENV{VZDUMP_VMID} = $vmid;
5291     local $ENV{VZDUMP_USER} = $user;
5292
5293     my $conffile = config_file($vmid);
5294     my $tmpfn = "$conffile.$$.tmp";
5295
5296     # disable interrupts (always do cleanups)
5297     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
5298         print STDERR "got interrupt - ignored\n";
5299     };
5300
5301     eval {
5302         # enable interrupts
5303         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
5304             die "interrupted by signal\n";
5305         };
5306
5307         if ($archive eq '-') {
5308             print "extracting archive from STDIN\n";
5309             run_command($cmd, input => "<&STDIN");
5310         } else {
5311             print "extracting archive '$archive'\n";
5312             run_command($cmd);
5313         }
5314
5315         return if $opts->{info};
5316
5317         # read new mapping
5318         my $map = {};
5319         my $statfile = "$tmpdir/qmrestore.stat";
5320         if (my $fd = IO::File->new($statfile, "r")) {
5321             while (defined (my $line = <$fd>)) {
5322                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
5323                     $map->{$1} = $2 if $1;
5324                 } else {
5325                     print STDERR "unable to parse line in statfile - $line\n";
5326                 }
5327             }
5328             $fd->close();
5329         }
5330
5331         my $confsrc = "$tmpdir/qemu-server.conf";
5332
5333         my $srcfd = new IO::File($confsrc, "r") ||
5334             die "unable to open file '$confsrc'\n";
5335
5336         my $outfd = new IO::File ($tmpfn, "w") ||
5337             die "unable to write config for VM $vmid\n";
5338
5339         my $cookie = { netcount => 0 };
5340         while (defined (my $line = <$srcfd>)) {
5341             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
5342         }
5343
5344         $srcfd->close();
5345         $outfd->close();
5346     };
5347     my $err = $@;
5348
5349     if ($err) {
5350
5351         unlink $tmpfn;
5352
5353         tar_restore_cleanup($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info};
5354
5355         die $err;
5356     }
5357
5358     rmtree $tmpdir;
5359
5360     rename $tmpfn, $conffile ||
5361         die "unable to commit configuration file '$conffile'\n";
5362
5363     PVE::Cluster::cfs_update(); # make sure we read new file
5364
5365     eval { rescan($vmid, 1); };
5366     warn $@ if $@;
5367 };
5368
5369
5370 # Internal snapshots
5371
5372 # NOTE: Snapshot create/delete involves several non-atomic
5373 # action, and can take a long time.
5374 # So we try to avoid locking the file and use 'lock' variable
5375 # inside the config file instead.
5376
5377 my $snapshot_copy_config = sub {
5378     my ($source, $dest) = @_;
5379
5380     foreach my $k (keys %$source) {
5381         next if $k eq 'snapshots';
5382         next if $k eq 'snapstate';
5383         next if $k eq 'snaptime';
5384         next if $k eq 'vmstate';
5385         next if $k eq 'lock';
5386         next if $k eq 'digest';
5387         next if $k eq 'description';
5388         next if $k =~ m/^unused\d+$/;
5389
5390         $dest->{$k} = $source->{$k};
5391     }
5392 };
5393
5394 my $snapshot_apply_config = sub {
5395     my ($conf, $snap) = @_;
5396
5397     # copy snapshot list
5398     my $newconf = {
5399         snapshots => $conf->{snapshots},
5400     };
5401
5402     # keep description and list of unused disks
5403     foreach my $k (keys %$conf) {
5404         next if !($k =~ m/^unused\d+$/ || $k eq 'description');
5405         $newconf->{$k} = $conf->{$k};
5406     }
5407
5408     &$snapshot_copy_config($snap, $newconf);
5409
5410     return $newconf;
5411 };
5412
5413 sub foreach_writable_storage {
5414     my ($conf, $func) = @_;
5415
5416     my $sidhash = {};
5417
5418     foreach my $ds (keys %$conf) {
5419         next if !valid_drivename($ds);
5420
5421         my $drive = parse_drive($ds, $conf->{$ds});
5422         next if !$drive;
5423         next if drive_is_cdrom($drive);
5424
5425         my $volid = $drive->{file};
5426
5427         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
5428         $sidhash->{$sid} = $sid if $sid;
5429     }
5430
5431     foreach my $sid (sort keys %$sidhash) {
5432         &$func($sid);
5433     }
5434 }
5435
5436 my $alloc_vmstate_volid = sub {
5437     my ($storecfg, $vmid, $conf, $snapname) = @_;
5438
5439     # Note: we try to be smart when selecting a $target storage
5440
5441     my $target;
5442
5443     # search shared storage first
5444     foreach_writable_storage($conf, sub {
5445         my ($sid) = @_;
5446         my $scfg = PVE::Storage::storage_config($storecfg, $sid);
5447         return if !$scfg->{shared};
5448
5449         $target = $sid if !$target || $scfg->{path}; # prefer file based storage
5450     });
5451
5452     if (!$target) {
5453         # now search local storage
5454         foreach_writable_storage($conf, sub {
5455             my ($sid) = @_;
5456             my $scfg = PVE::Storage::storage_config($storecfg, $sid);
5457             return if $scfg->{shared};
5458
5459             $target = $sid if !$target || $scfg->{path}; # prefer file based storage;
5460         });
5461     }
5462
5463     $target = 'local' if !$target;
5464
5465     my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
5466     # we abort live save after $conf->{memory}, so we need at max twice that space
5467     my $size = $conf->{memory}*2 + $driver_state_size;
5468
5469     my $name = "vm-$vmid-state-$snapname";
5470     my $scfg = PVE::Storage::storage_config($storecfg, $target);
5471     $name .= ".raw" if $scfg->{path}; # add filename extension for file base storage
5472     my $volid = PVE::Storage::vdisk_alloc($storecfg, $target, $vmid, 'raw', $name, $size*1024);
5473
5474     return $volid;
5475 };
5476
5477 my $snapshot_prepare = sub {
5478     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
5479
5480     my $snap;
5481
5482     my $updatefn =  sub {
5483
5484         my $conf = load_config($vmid);
5485
5486         die "you can't take a snapshot if it's a template\n"
5487             if is_template($conf);
5488
5489         check_lock($conf);
5490
5491         $conf->{lock} = 'snapshot';
5492
5493         die "snapshot name '$snapname' already used\n"
5494             if defined($conf->{snapshots}->{$snapname});
5495
5496         my $storecfg = PVE::Storage::config();
5497         die "snapshot feature is not available" if !has_feature('snapshot', $conf, $storecfg);
5498
5499         $snap = $conf->{snapshots}->{$snapname} = {};
5500
5501         if ($save_vmstate && check_running($vmid)) {
5502             $snap->{vmstate} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
5503         }
5504
5505         &$snapshot_copy_config($conf, $snap);
5506
5507         $snap->{snapstate} = "prepare";
5508         $snap->{snaptime} = time();
5509         $snap->{description} = $comment if $comment;
5510
5511         # always overwrite machine if we save vmstate. This makes sure we
5512         # can restore it later using correct machine type
5513         $snap->{machine} = get_current_qemu_machine($vmid) if $snap->{vmstate};
5514
5515         update_config_nolock($vmid, $conf, 1);
5516     };
5517
5518     lock_config($vmid, $updatefn);
5519
5520     return $snap;
5521 };
5522
5523 my $snapshot_commit = sub {
5524     my ($vmid, $snapname) = @_;
5525
5526     my $updatefn = sub {
5527
5528         my $conf = load_config($vmid);
5529
5530         die "missing snapshot lock\n"
5531             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
5532
5533         my $has_machine_config = defined($conf->{machine});
5534
5535         my $snap = $conf->{snapshots}->{$snapname};
5536
5537         die "snapshot '$snapname' does not exist\n" if !defined($snap);
5538
5539         die "wrong snapshot state\n"
5540             if !($snap->{snapstate} && $snap->{snapstate} eq "prepare");
5541
5542         delete $snap->{snapstate};
5543         delete $conf->{lock};
5544
5545         my $newconf = &$snapshot_apply_config($conf, $snap);
5546
5547         delete $newconf->{machine} if !$has_machine_config;
5548
5549         $newconf->{parent} = $snapname;
5550
5551         update_config_nolock($vmid, $newconf, 1);
5552     };
5553
5554     lock_config($vmid, $updatefn);
5555 };
5556
5557 sub snapshot_rollback {
5558     my ($vmid, $snapname) = @_;
5559
5560     my $prepare = 1;
5561
5562     my $storecfg = PVE::Storage::config();
5563
5564     my $conf = load_config($vmid);
5565
5566     my $get_snapshot_config = sub {
5567
5568         die "you can't rollback if vm is a template\n" if is_template($conf);
5569
5570         my $res = $conf->{snapshots}->{$snapname};
5571
5572         die "snapshot '$snapname' does not exist\n" if !defined($res);
5573
5574         return $res;
5575     };
5576
5577     my $snap = &$get_snapshot_config();
5578
5579     foreach_drive($snap, sub {
5580         my ($ds, $drive) = @_;
5581
5582         return if drive_is_cdrom($drive);
5583
5584         my $volid = $drive->{file};
5585
5586         PVE::Storage::volume_rollback_is_possible($storecfg, $volid, $snapname);
5587     });
5588
5589     my $updatefn = sub {
5590
5591         $conf = load_config($vmid);
5592
5593         $snap = &$get_snapshot_config();
5594
5595         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
5596             if $snap->{snapstate};
5597
5598         if ($prepare) {
5599             check_lock($conf);
5600             vm_stop($storecfg, $vmid, undef, undef, 5, undef, undef);
5601         }
5602
5603         die "unable to rollback vm $vmid: vm is running\n"
5604             if check_running($vmid);
5605
5606         if ($prepare) {
5607             $conf->{lock} = 'rollback';
5608         } else {
5609             die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
5610             delete $conf->{lock};
5611         }
5612
5613         my $forcemachine;
5614
5615         if (!$prepare) {
5616             my $has_machine_config = defined($conf->{machine});
5617
5618             # copy snapshot config to current config
5619             $conf = &$snapshot_apply_config($conf, $snap);
5620             $conf->{parent} = $snapname;
5621
5622             # Note: old code did not store 'machine', so we try to be smart
5623             # and guess the snapshot was generated with kvm 1.4 (pc-i440fx-1.4).
5624             $forcemachine = $conf->{machine} || 'pc-i440fx-1.4';
5625             # we remove the 'machine' configuration if not explicitly specified
5626             # in the original config.
5627             delete $conf->{machine} if $snap->{vmstate} && !$has_machine_config;
5628         }
5629
5630         update_config_nolock($vmid, $conf, 1);
5631
5632         if (!$prepare && $snap->{vmstate}) {
5633             my $statefile = PVE::Storage::path($storecfg, $snap->{vmstate});
5634             vm_start($storecfg, $vmid, $statefile, undef, undef, undef, $forcemachine);
5635         }
5636     };
5637
5638     lock_config($vmid, $updatefn);
5639
5640     foreach_drive($snap, sub {
5641         my ($ds, $drive) = @_;
5642
5643         return if drive_is_cdrom($drive);
5644
5645         my $volid = $drive->{file};
5646         my $device = "drive-$ds";
5647
5648         PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
5649     });
5650
5651     $prepare = 0;
5652     lock_config($vmid, $updatefn);
5653 }
5654
5655 my $savevm_wait = sub {
5656     my ($vmid) = @_;
5657
5658     for(;;) {
5659         my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
5660         if (!$stat->{status}) {
5661             die "savevm not active\n";
5662         } elsif ($stat->{status} eq 'active') {
5663             sleep(1);
5664             next;
5665         } elsif ($stat->{status} eq 'completed') {
5666             last;
5667         } else {
5668             die "query-savevm returned status '$stat->{status}'\n";
5669         }
5670     }
5671 };
5672
5673 sub snapshot_create {
5674     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
5675
5676     my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
5677
5678     $save_vmstate = 0 if !$snap->{vmstate}; # vm is not running
5679
5680     my $config = load_config($vmid);
5681
5682     my $running = check_running($vmid);
5683
5684     my $freezefs = $running && $config->{agent};
5685     $freezefs = 0 if $snap->{vmstate}; # not needed if we save RAM
5686
5687     my $drivehash = {};
5688
5689     if ($freezefs) {
5690         eval { vm_mon_cmd($vmid, "guest-fsfreeze-freeze"); };
5691         warn "guest-fsfreeze-freeze problems - $@" if $@;
5692     }
5693
5694     eval {
5695         # create internal snapshots of all drives
5696
5697         my $storecfg = PVE::Storage::config();
5698
5699         if ($running) {
5700             if ($snap->{vmstate}) {
5701                 my $path = PVE::Storage::path($storecfg, $snap->{vmstate});
5702                 vm_mon_cmd($vmid, "savevm-start", statefile => $path);
5703                 &$savevm_wait($vmid);
5704             } else {
5705                 vm_mon_cmd($vmid, "savevm-start");
5706             }
5707         };
5708
5709         foreach_drive($snap, sub {
5710             my ($ds, $drive) = @_;
5711
5712             return if drive_is_cdrom($drive);
5713
5714             my $volid = $drive->{file};
5715             my $device = "drive-$ds";
5716
5717             qemu_volume_snapshot($vmid, $device, $storecfg, $volid, $snapname);
5718             $drivehash->{$ds} = 1;
5719        });
5720     };
5721     my $err = $@;
5722
5723     if ($running) {
5724         eval { vm_mon_cmd($vmid, "savevm-end")  };
5725         warn $@ if $@;
5726
5727         if ($freezefs) {
5728             eval { vm_mon_cmd($vmid, "guest-fsfreeze-thaw"); };
5729             warn "guest-fsfreeze-thaw problems - $@" if $@;
5730         }
5731
5732         # savevm-end is async, we need to wait
5733         for (;;) {
5734             my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
5735             if (!$stat->{bytes}) {
5736                 last;
5737             } else {
5738                 print "savevm not yet finished\n";
5739                 sleep(1);
5740                 next;
5741             }
5742         }
5743     }
5744
5745     if ($err) {
5746         warn "snapshot create failed: starting cleanup\n";
5747         eval { snapshot_delete($vmid, $snapname, 0, $drivehash); };
5748         warn $@ if $@;
5749         die $err;
5750     }
5751
5752     &$snapshot_commit($vmid, $snapname);
5753 }
5754
5755 # Note: $drivehash is only set when called from snapshot_create.
5756 sub snapshot_delete {
5757     my ($vmid, $snapname, $force, $drivehash) = @_;
5758
5759     my $prepare = 1;
5760
5761     my $snap;
5762     my $unused = [];
5763
5764     my $unlink_parent = sub {
5765         my ($confref, $new_parent) = @_;
5766
5767         if ($confref->{parent} && $confref->{parent} eq $snapname) {
5768             if ($new_parent) {
5769                 $confref->{parent} = $new_parent;
5770             } else {
5771                 delete $confref->{parent};
5772             }
5773         }
5774     };
5775
5776     my $updatefn =  sub {
5777         my ($remove_drive) = @_;
5778
5779         my $conf = load_config($vmid);
5780
5781         if (!$drivehash) {
5782             check_lock($conf);
5783             die "you can't delete a snapshot if vm is a template\n"
5784                 if is_template($conf);
5785         }
5786
5787         $snap = $conf->{snapshots}->{$snapname};
5788
5789         die "snapshot '$snapname' does not exist\n" if !defined($snap);
5790
5791         # remove parent refs
5792         if (!$prepare) {
5793             &$unlink_parent($conf, $snap->{parent});
5794             foreach my $sn (keys %{$conf->{snapshots}}) {
5795                 next if $sn eq $snapname;
5796                 &$unlink_parent($conf->{snapshots}->{$sn}, $snap->{parent});
5797             }
5798         }
5799
5800         if ($remove_drive) {
5801             if ($remove_drive eq 'vmstate') {
5802                 delete $snap->{$remove_drive};
5803             } else {
5804                 my $drive = parse_drive($remove_drive, $snap->{$remove_drive});
5805                 my $volid = $drive->{file};
5806                 delete $snap->{$remove_drive};
5807                 add_unused_volume($conf, $volid);
5808             }
5809         }
5810
5811         if ($prepare) {
5812             $snap->{snapstate} = 'delete';
5813         } else {
5814             delete $conf->{snapshots}->{$snapname};
5815             delete $conf->{lock} if $drivehash;
5816             foreach my $volid (@$unused) {
5817                 add_unused_volume($conf, $volid);
5818             }
5819         }
5820
5821         update_config_nolock($vmid, $conf, 1);
5822     };
5823
5824     lock_config($vmid, $updatefn);
5825
5826     # now remove vmstate file
5827
5828     my $storecfg = PVE::Storage::config();
5829
5830     if ($snap->{vmstate}) {
5831         eval {  PVE::Storage::vdisk_free($storecfg, $snap->{vmstate}); };
5832         if (my $err = $@) {
5833             die $err if !$force;
5834             warn $err;
5835         }
5836         # save changes (remove vmstate from snapshot)
5837         lock_config($vmid, $updatefn, 'vmstate') if !$force;
5838     };
5839
5840     # now remove all internal snapshots
5841     foreach_drive($snap, sub {
5842         my ($ds, $drive) = @_;
5843
5844         return if drive_is_cdrom($drive);
5845
5846         my $volid = $drive->{file};
5847         my $device = "drive-$ds";
5848
5849         if (!$drivehash || $drivehash->{$ds}) {
5850             eval { qemu_volume_snapshot_delete($vmid, $device, $storecfg, $volid, $snapname); };
5851             if (my $err = $@) {
5852                 die $err if !$force;
5853                 warn $err;
5854             }
5855         }
5856
5857         # save changes (remove drive fron snapshot)
5858         lock_config($vmid, $updatefn, $ds) if !$force;
5859         push @$unused, $volid;
5860     });
5861
5862     # now cleanup config
5863     $prepare = 0;
5864     lock_config($vmid, $updatefn);
5865 }
5866
5867 sub has_feature {
5868     my ($feature, $conf, $storecfg, $snapname, $running) = @_;
5869
5870     my $err;
5871     foreach_drive($conf, sub {
5872         my ($ds, $drive) = @_;
5873
5874         return if drive_is_cdrom($drive);
5875         my $volid = $drive->{file};
5876         $err = 1 if !PVE::Storage::volume_has_feature($storecfg, $feature, $volid, $snapname, $running);
5877     });
5878
5879     return $err ? 0 : 1;
5880 }
5881
5882 sub template_create {
5883     my ($vmid, $conf, $disk) = @_;
5884
5885     my $storecfg = PVE::Storage::config();
5886
5887     foreach_drive($conf, sub {
5888         my ($ds, $drive) = @_;
5889
5890         return if drive_is_cdrom($drive);
5891         return if $disk && $ds ne $disk;
5892
5893         my $volid = $drive->{file};
5894         return if !PVE::Storage::volume_has_feature($storecfg, 'template', $volid);
5895
5896         my $voliddst = PVE::Storage::vdisk_create_base($storecfg, $volid);
5897         $drive->{file} = $voliddst;
5898         $conf->{$ds} = print_drive($vmid, $drive);
5899         update_config_nolock($vmid, $conf, 1);
5900     });
5901 }
5902
5903 sub is_template {
5904     my ($conf) = @_;
5905
5906     return 1 if defined $conf->{template} && $conf->{template} == 1;
5907 }
5908
5909 sub qemu_img_convert {
5910     my ($src_volid, $dst_volid, $size, $snapname) = @_;
5911
5912     my $storecfg = PVE::Storage::config();
5913     my ($src_storeid, $src_volname) = PVE::Storage::parse_volume_id($src_volid, 1);
5914     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
5915
5916     if ($src_storeid && $dst_storeid) {
5917         my $src_scfg = PVE::Storage::storage_config($storecfg, $src_storeid);
5918         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
5919
5920         my $src_format = qemu_img_format($src_scfg, $src_volname);
5921         my $dst_format = qemu_img_format($dst_scfg, $dst_volname);
5922
5923         my $src_path = PVE::Storage::path($storecfg, $src_volid, $snapname);
5924         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
5925
5926         my $cmd = [];
5927         push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-n';
5928         push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
5929         push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
5930
5931         my $parser = sub {
5932             my $line = shift;
5933             if($line =~ m/\((\S+)\/100\%\)/){
5934                 my $percent = $1;
5935                 my $transferred = int($size * $percent / 100);
5936                 my $remaining = $size - $transferred;
5937
5938                 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
5939             }
5940
5941         };
5942
5943         eval  { run_command($cmd, timeout => undef, outfunc => $parser); };
5944         my $err = $@;
5945         die "copy failed: $err" if $err;
5946     }
5947 }
5948
5949 sub qemu_img_format {
5950     my ($scfg, $volname) = @_;
5951
5952     if ($scfg->{path} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/) {
5953         return $1;
5954     } elsif ($scfg->{type} eq 'iscsi') {
5955         return "host_device";
5956     } else {
5957         return "raw";
5958     }
5959 }
5960
5961 sub qemu_drive_mirror {
5962     my ($vmid, $drive, $dst_volid, $vmiddst) = @_;
5963
5964     my $count = 0;
5965     my $old_len = 0;
5966     my $frozen = undef;
5967     my $maxwait = 120;
5968
5969     my $storecfg = PVE::Storage::config();
5970     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid);
5971
5972     my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
5973
5974     my $format;
5975     if ($dst_volname =~ m/\.(raw|qcow2)$/){
5976         $format = $1;
5977     }
5978
5979     my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
5980
5981     my $opts = { timeout => 10, device => "drive-$drive", mode => "existing", sync => "full", target => $dst_path };
5982     $opts->{format} = $format if $format;
5983
5984     #fixme : sometime drive-mirror timeout, but works fine after.
5985     # (I have see the problem with big volume > 200GB), so we need to eval
5986     eval { vm_mon_cmd($vmid, "drive-mirror", %$opts); };
5987     # ignore errors here
5988
5989     eval {
5990         while (1) {
5991             my $stats = vm_mon_cmd($vmid, "query-block-jobs");
5992             my $stat = @$stats[0];
5993             die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
5994             die "error job is not mirroring" if $stat->{type} ne "mirror";
5995
5996             my $busy = $stat->{busy};
5997
5998             if (my $total = $stat->{len}) {
5999                 my $transferred = $stat->{offset} || 0;
6000                 my $remaining = $total - $transferred;
6001                 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
6002
6003                 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent % busy: $busy\n";
6004             }
6005
6006             if ($stat->{len} == $stat->{offset}) {
6007                 if ($busy eq 'false') {
6008
6009                     last if $vmiddst != $vmid;
6010
6011                     # try to switch the disk if source and destination are on the same guest
6012                     eval { vm_mon_cmd($vmid, "block-job-complete", device => "drive-$drive") };
6013                     last if !$@;
6014                     die $@ if $@ !~ m/cannot be completed/;
6015                 }
6016
6017                 if ($count > $maxwait) {
6018                     # if too much writes to disk occurs at the end of migration
6019                     #the disk needs to be freezed to be able to complete the migration
6020                     vm_suspend($vmid,1);
6021                     $frozen = 1;
6022                 }
6023                 $count ++
6024             }
6025             $old_len = $stat->{offset};
6026             sleep 1;
6027         }
6028
6029         vm_resume($vmid, 1) if $frozen;
6030
6031     };
6032     my $err = $@;
6033
6034     my $cancel_job = sub {
6035         vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive");
6036         while (1) {
6037             my $stats = vm_mon_cmd($vmid, "query-block-jobs");
6038             my $stat = @$stats[0];
6039             last if !$stat;
6040             sleep 1;
6041         }
6042     };
6043
6044     if ($err) {
6045         eval { &$cancel_job(); };
6046         die "mirroring error: $err";
6047     }
6048
6049     if ($vmiddst != $vmid) {
6050         # if we clone a disk for a new target vm, we don't switch the disk
6051         &$cancel_job(); # so we call block-job-cancel
6052     }
6053 }
6054
6055 sub clone_disk {
6056     my ($storecfg, $vmid, $running, $drivename, $drive, $snapname,
6057         $newvmid, $storage, $format, $full, $newvollist) = @_;
6058
6059     my $newvolid;
6060
6061     if (!$full) {
6062         print "create linked clone of drive $drivename ($drive->{file})\n";
6063         $newvolid = PVE::Storage::vdisk_clone($storecfg,  $drive->{file}, $newvmid, $snapname);
6064         push @$newvollist, $newvolid;
6065     } else {
6066         my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file});
6067         $storeid = $storage if $storage;
6068
6069         my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($storecfg, $storeid);
6070         if (!$format) {
6071             $format = $drive->{format} || $defFormat;
6072         }
6073
6074         # test if requested format is supported - else use default
6075         my $supported = grep { $_ eq $format } @$validFormats;
6076         $format = $defFormat if !$supported;
6077
6078         my ($size) = PVE::Storage::volume_size_info($storecfg, $drive->{file}, 3);
6079
6080         print "create full clone of drive $drivename ($drive->{file})\n";
6081         $newvolid = PVE::Storage::vdisk_alloc($storecfg, $storeid, $newvmid, $format, undef, ($size/1024));
6082         push @$newvollist, $newvolid;
6083
6084         if (!$running || $snapname) {
6085             qemu_img_convert($drive->{file}, $newvolid, $size, $snapname);
6086         } else {
6087             qemu_drive_mirror($vmid, $drivename, $newvolid, $newvmid);
6088         }
6089     }
6090
6091     my ($size) = PVE::Storage::volume_size_info($storecfg, $newvolid, 3);
6092
6093     my $disk = $drive;
6094     $disk->{format} = undef;
6095     $disk->{file} = $newvolid;
6096     $disk->{size} = $size;
6097
6098     return $disk;
6099 }
6100
6101 # this only works if VM is running
6102 sub get_current_qemu_machine {
6103     my ($vmid) = @_;
6104
6105     my $cmd = { execute => 'query-machines', arguments => {} };
6106     my $res = vm_qmp_command($vmid, $cmd);
6107
6108     my ($current, $default);
6109     foreach my $e (@$res) {
6110         $default = $e->{name} if $e->{'is-default'};
6111         $current = $e->{name} if $e->{'is-current'};
6112     }
6113
6114     # fallback to the default machine if current is not supported by qemu
6115     return $current || $default || 'pc';
6116 }
6117
6118 sub lspci {
6119
6120     my $devices = {};
6121
6122     dir_glob_foreach("$pcisysfs/devices", '[a-f0-9]{4}:([a-f0-9]{2}:[a-f0-9]{2})\.([0-9])', sub {
6123             my (undef, $id, $function) = @_;
6124             my $res = { id => $id, function => $function};
6125             push @{$devices->{$id}}, $res;
6126     });
6127
6128     return $devices;
6129 }
6130
6131 1;