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