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