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