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