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) = @_;
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     warn $@ if $@; # avoid errors - just warn
4191 }
4192
4193 # Note: use $nockeck to skip tests if VM configuration file exists.
4194 # We need that when migration VMs to other nodes (files already moved)
4195 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
4196 sub vm_stop {
4197     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
4198
4199     $force = 1 if !defined($force) && !$shutdown;
4200
4201     if ($migratedfrom){
4202         my $pid = check_running($vmid, $nocheck, $migratedfrom);
4203         kill 15, $pid if $pid;
4204         my $conf = load_config($vmid, $migratedfrom);
4205         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive);
4206         return;
4207     }
4208
4209     lock_config($vmid, sub {
4210
4211         my $pid = check_running($vmid, $nocheck);
4212         return if !$pid;
4213
4214         my $conf;
4215         if (!$nocheck) {
4216             $conf = load_config($vmid);
4217             check_lock($conf) if !$skiplock;
4218             if (!defined($timeout) && $shutdown && $conf->{startup}) {
4219                 my $opts = parse_startup($conf->{startup});
4220                 $timeout = $opts->{down} if $opts->{down};
4221             }
4222         }
4223
4224         $timeout = 60 if !defined($timeout);
4225
4226         eval {
4227             if ($shutdown) {
4228                 if (defined($conf) && $conf->{agent}) {
4229                     vm_qmp_command($vmid, { execute => "guest-shutdown" }, $nocheck);
4230                 } else {
4231                     vm_qmp_command($vmid, { execute => "system_powerdown" }, $nocheck);
4232                 }
4233             } else {
4234                 vm_qmp_command($vmid, { execute => "quit" }, $nocheck);
4235             }
4236         };
4237         my $err = $@;
4238
4239         if (!$err) {
4240             my $count = 0;
4241             while (($count < $timeout) && check_running($vmid, $nocheck)) {
4242                 $count++;
4243                 sleep 1;
4244             }
4245
4246             if ($count >= $timeout) {
4247                 if ($force) {
4248                     warn "VM still running - terminating now with SIGTERM\n";
4249                     kill 15, $pid;
4250                 } else {
4251                     die "VM quit/powerdown failed - got timeout\n";
4252                 }
4253             } else {
4254                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
4255                 return;
4256             }
4257         } else {
4258             if ($force) {
4259                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
4260                 kill 15, $pid;
4261             } else {
4262                 die "VM quit/powerdown failed\n";
4263             }
4264         }
4265
4266         # wait again
4267         $timeout = 10;
4268
4269         my $count = 0;
4270         while (($count < $timeout) && check_running($vmid, $nocheck)) {
4271             $count++;
4272             sleep 1;
4273         }
4274
4275         if ($count >= $timeout) {
4276             warn "VM still running - terminating now with SIGKILL\n";
4277             kill 9, $pid;
4278             sleep 1;
4279         }
4280
4281         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
4282    });
4283 }
4284
4285 sub vm_suspend {
4286     my ($vmid, $skiplock) = @_;
4287
4288     lock_config($vmid, sub {
4289
4290         my $conf = load_config($vmid);
4291
4292         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
4293
4294         vm_mon_cmd($vmid, "stop");
4295     });
4296 }
4297
4298 sub vm_resume {
4299     my ($vmid, $skiplock) = @_;
4300
4301     lock_config($vmid, sub {
4302
4303         my $conf = load_config($vmid);
4304
4305         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
4306
4307         vm_mon_cmd($vmid, "cont");
4308     });
4309 }
4310
4311 sub vm_sendkey {
4312     my ($vmid, $skiplock, $key) = @_;
4313
4314     lock_config($vmid, sub {
4315
4316         my $conf = load_config($vmid);
4317
4318         # there is no qmp command, so we use the human monitor command
4319         vm_human_monitor_command($vmid, "sendkey $key");
4320     });
4321 }
4322
4323 sub vm_destroy {
4324     my ($storecfg, $vmid, $skiplock) = @_;
4325
4326     lock_config($vmid, sub {
4327
4328         my $conf = load_config($vmid);
4329
4330         check_lock($conf) if !$skiplock;
4331
4332         if (!check_running($vmid)) {
4333             fairsched_rmnod($vmid); # try to destroy group
4334             destroy_vm($storecfg, $vmid);
4335         } else {
4336             die "VM $vmid is running - destroy failed\n";
4337         }
4338     });
4339 }
4340
4341 # pci helpers
4342
4343 sub file_write {
4344     my ($filename, $buf) = @_;
4345
4346     my $fh = IO::File->new($filename, "w");
4347     return undef if !$fh;
4348
4349     my $res = print $fh $buf;
4350
4351     $fh->close();
4352
4353     return $res;
4354 }
4355
4356 sub pci_device_info {
4357     my ($name) = @_;
4358
4359     my $res;
4360
4361     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
4362     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
4363
4364     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
4365     return undef if !defined($irq) || $irq !~ m/^\d+$/;
4366
4367     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
4368     return undef if !defined($vendor) || $vendor !~ s/^0x//;
4369
4370     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
4371     return undef if !defined($product) || $product !~ s/^0x//;
4372
4373     $res = {
4374         name => $name,
4375         vendor => $vendor,
4376         product => $product,
4377         domain => $domain,
4378         bus => $bus,
4379         slot => $slot,
4380         func => $func,
4381         irq => $irq,
4382         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
4383     };
4384
4385     return $res;
4386 }
4387
4388 sub pci_dev_reset {
4389     my ($dev) = @_;
4390
4391     my $name = $dev->{name};
4392
4393     my $fn = "$pcisysfs/devices/$name/reset";
4394
4395     return file_write($fn, "1");
4396 }
4397
4398 sub pci_dev_bind_to_stub {
4399     my ($dev) = @_;
4400
4401     my $name = $dev->{name};
4402
4403     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
4404     return 1 if -d $testdir;
4405
4406     my $data = "$dev->{vendor} $dev->{product}";
4407     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
4408
4409     my $fn = "$pcisysfs/devices/$name/driver/unbind";
4410     if (!file_write($fn, $name)) {
4411         return undef if -f $fn;
4412     }
4413
4414     $fn = "$pcisysfs/drivers/pci-stub/bind";
4415     if (! -d $testdir) {
4416         return undef if !file_write($fn, $name);
4417     }
4418
4419     return -d $testdir;
4420 }
4421
4422 sub pci_dev_bind_to_vfio {
4423     my ($dev) = @_;
4424
4425     my $name = $dev->{name};
4426
4427     my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4428
4429     if (!-d $vfio_basedir) {
4430         system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4431     }
4432     die "Cannot find vfio-pci module!\n" if !-d $vfio_basedir;
4433
4434     my $testdir = "$vfio_basedir/$name";
4435     return 1 if -d $testdir;
4436
4437     my $data = "$dev->{vendor} $dev->{product}";
4438     return undef if !file_write("$vfio_basedir/new_id", $data);
4439
4440     my $fn = "$pcisysfs/devices/$name/driver/unbind";
4441     if (!file_write($fn, $name)) {
4442         return undef if -f $fn;
4443     }
4444
4445     $fn = "$vfio_basedir/bind";
4446     if (! -d $testdir) {
4447         return undef if !file_write($fn, $name);
4448     }
4449
4450     return -d $testdir;
4451 }
4452
4453 sub pci_dev_group_bind_to_vfio {
4454     my ($pciid) = @_;
4455
4456     my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4457
4458     if (!-d $vfio_basedir) {
4459         system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4460     }
4461     die "Cannot find vfio-pci module!\n" if !-d $vfio_basedir;
4462
4463     # get IOMMU group devices
4464     opendir(my $D, "$pcisysfs/devices/0000:$pciid/iommu_group/devices/") || die "Cannot open iommu_group: $!\n";
4465       my @devs = grep /^0000:/, readdir($D);
4466     closedir($D);
4467
4468     foreach my $pciid (@devs) {
4469         $pciid =~ m/^([:\.\da-f]+)$/ or die "PCI ID $pciid not valid!\n";
4470         my $info = pci_device_info($1);
4471         pci_dev_bind_to_vfio($info) || die "Cannot bind $pciid to vfio\n";
4472     }
4473
4474     return 1;
4475 }
4476
4477 sub print_pci_addr {
4478     my ($id, $bridges) = @_;
4479
4480     my $res = '';
4481     my $devices = {
4482         piix3 => { bus => 0, addr => 1 },
4483         #addr2 : first videocard
4484         balloon0 => { bus => 0, addr => 3 },
4485         watchdog => { bus => 0, addr => 4 },
4486         scsihw0 => { bus => 0, addr => 5 },
4487         scsihw1 => { bus => 0, addr => 6 },
4488         ahci0 => { bus => 0, addr => 7 },
4489         qga0 => { bus => 0, addr => 8 },
4490         spice => { bus => 0, addr => 9 },
4491         virtio0 => { bus => 0, addr => 10 },
4492         virtio1 => { bus => 0, addr => 11 },
4493         virtio2 => { bus => 0, addr => 12 },
4494         virtio3 => { bus => 0, addr => 13 },
4495         virtio4 => { bus => 0, addr => 14 },
4496         virtio5 => { bus => 0, addr => 15 },
4497         hostpci0 => { bus => 0, addr => 16 },
4498         hostpci1 => { bus => 0, addr => 17 },
4499         net0 => { bus => 0, addr => 18 },
4500         net1 => { bus => 0, addr => 19 },
4501         net2 => { bus => 0, addr => 20 },
4502         net3 => { bus => 0, addr => 21 },
4503         net4 => { bus => 0, addr => 22 },
4504         net5 => { bus => 0, addr => 23 },
4505         vga1 => { bus => 0, addr => 24 },
4506         vga2 => { bus => 0, addr => 25 },
4507         vga3 => { bus => 0, addr => 26 },
4508         hostpci2 => { bus => 0, addr => 27 },
4509         hostpci3 => { bus => 0, addr => 28 },
4510         #addr29 : usb-host (pve-usb.cfg)
4511         'pci.1' => { bus => 0, addr => 30 },
4512         'pci.2' => { bus => 0, addr => 31 },
4513         'net6' => { bus => 1, addr => 1 },
4514         'net7' => { bus => 1, addr => 2 },
4515         'net8' => { bus => 1, addr => 3 },
4516         'net9' => { bus => 1, addr => 4 },
4517         'net10' => { bus => 1, addr => 5 },
4518         'net11' => { bus => 1, addr => 6 },
4519         'net12' => { bus => 1, addr => 7 },
4520         'net13' => { bus => 1, addr => 8 },
4521         'net14' => { bus => 1, addr => 9 },
4522         'net15' => { bus => 1, addr => 10 },
4523         'net16' => { bus => 1, addr => 11 },
4524         'net17' => { bus => 1, addr => 12 },
4525         'net18' => { bus => 1, addr => 13 },
4526         'net19' => { bus => 1, addr => 14 },
4527         'net20' => { bus => 1, addr => 15 },
4528         'net21' => { bus => 1, addr => 16 },
4529         'net22' => { bus => 1, addr => 17 },
4530         'net23' => { bus => 1, addr => 18 },
4531         'net24' => { bus => 1, addr => 19 },
4532         'net25' => { bus => 1, addr => 20 },
4533         'net26' => { bus => 1, addr => 21 },
4534         'net27' => { bus => 1, addr => 22 },
4535         'net28' => { bus => 1, addr => 23 },
4536         'net29' => { bus => 1, addr => 24 },
4537         'net30' => { bus => 1, addr => 25 },
4538         'net31' => { bus => 1, addr => 26 },
4539         'virtio6' => { bus => 2, addr => 1 },
4540         'virtio7' => { bus => 2, addr => 2 },
4541         'virtio8' => { bus => 2, addr => 3 },
4542         'virtio9' => { bus => 2, addr => 4 },
4543         'virtio10' => { bus => 2, addr => 5 },
4544         'virtio11' => { bus => 2, addr => 6 },
4545         'virtio12' => { bus => 2, addr => 7 },
4546         'virtio13' => { bus => 2, addr => 8 },
4547         'virtio14' => { bus => 2, addr => 9 },
4548         'virtio15' => { bus => 2, addr => 10 },
4549     };
4550
4551     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
4552            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
4553            my $bus = $devices->{$id}->{bus};
4554            $res = ",bus=pci.$bus,addr=$addr";
4555            $bridges->{$bus} = 1 if $bridges;
4556     }
4557     return $res;
4558
4559 }
4560
4561 sub print_pcie_addr {
4562     my ($id) = @_;
4563
4564     my $res = '';
4565     my $devices = {
4566         hostpci0 => { bus => "ich9-pcie-port-1", addr => 0 },
4567         hostpci1 => { bus => "ich9-pcie-port-2", addr => 0 },
4568         hostpci2 => { bus => "ich9-pcie-port-3", addr => 0 },
4569         hostpci3 => { bus => "ich9-pcie-port-4", addr => 0 },
4570     };
4571
4572     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
4573            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
4574            my $bus = $devices->{$id}->{bus};
4575            $res = ",bus=$bus,addr=$addr";
4576     }
4577     return $res;
4578
4579 }
4580
4581 # vzdump restore implementaion
4582
4583 sub tar_archive_read_firstfile {
4584     my $archive = shift;
4585
4586     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
4587
4588     # try to detect archive type first
4589     my $pid = open (TMP, "tar tf '$archive'|") ||
4590         die "unable to open file '$archive'\n";
4591     my $firstfile = <TMP>;
4592     kill 15, $pid;
4593     close TMP;
4594
4595     die "ERROR: archive contaions no data\n" if !$firstfile;
4596     chomp $firstfile;
4597
4598     return $firstfile;
4599 }
4600
4601 sub tar_restore_cleanup {
4602     my ($storecfg, $statfile) = @_;
4603
4604     print STDERR "starting cleanup\n";
4605
4606     if (my $fd = IO::File->new($statfile, "r")) {
4607         while (defined(my $line = <$fd>)) {
4608             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4609                 my $volid = $2;
4610                 eval {
4611                     if ($volid =~ m|^/|) {
4612                         unlink $volid || die 'unlink failed\n';
4613                     } else {
4614                         PVE::Storage::vdisk_free($storecfg, $volid);
4615                     }
4616                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
4617                 };
4618                 print STDERR "unable to cleanup '$volid' - $@" if $@;
4619             } else {
4620                 print STDERR "unable to parse line in statfile - $line";
4621             }
4622         }
4623         $fd->close();
4624     }
4625 }
4626
4627 sub restore_archive {
4628     my ($archive, $vmid, $user, $opts) = @_;
4629
4630     my $format = $opts->{format};
4631     my $comp;
4632
4633     if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
4634         $format = 'tar' if !$format;
4635         $comp = 'gzip';
4636     } elsif ($archive =~ m/\.tar$/) {
4637         $format = 'tar' if !$format;
4638     } elsif ($archive =~ m/.tar.lzo$/) {
4639         $format = 'tar' if !$format;
4640         $comp = 'lzop';
4641     } elsif ($archive =~ m/\.vma$/) {
4642         $format = 'vma' if !$format;
4643     } elsif ($archive =~ m/\.vma\.gz$/) {
4644         $format = 'vma' if !$format;
4645         $comp = 'gzip';
4646     } elsif ($archive =~ m/\.vma\.lzo$/) {
4647         $format = 'vma' if !$format;
4648         $comp = 'lzop';
4649     } else {
4650         $format = 'vma' if !$format; # default
4651     }
4652
4653     # try to detect archive format
4654     if ($format eq 'tar') {
4655         return restore_tar_archive($archive, $vmid, $user, $opts);
4656     } else {
4657         return restore_vma_archive($archive, $vmid, $user, $opts, $comp);
4658     }
4659 }
4660
4661 sub restore_update_config_line {
4662     my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
4663
4664     return if $line =~ m/^\#qmdump\#/;
4665     return if $line =~ m/^\#vzdump\#/;
4666     return if $line =~ m/^lock:/;
4667     return if $line =~ m/^unused\d+:/;
4668     return if $line =~ m/^parent:/;
4669     return if $line =~ m/^template:/; # restored VM is never a template
4670
4671     if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
4672         # try to convert old 1.X settings
4673         my ($id, $ind, $ethcfg) = ($1, $2, $3);
4674         foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
4675             my ($model, $macaddr) = split(/\=/, $devconfig);
4676             $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $unique;
4677             my $net = {
4678                 model => $model,
4679                 bridge => "vmbr$ind",
4680                 macaddr => $macaddr,
4681             };
4682             my $netstr = print_net($net);
4683
4684             print $outfd "net$cookie->{netcount}: $netstr\n";
4685             $cookie->{netcount}++;
4686         }
4687     } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
4688         my ($id, $netstr) = ($1, $2);
4689         my $net = parse_net($netstr);
4690         $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
4691         $netstr = print_net($net);
4692         print $outfd "$id: $netstr\n";
4693     } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
4694         my $virtdev = $1;
4695         my $value = $3;
4696         if ($line =~ m/backup=no/) {
4697             print $outfd "#$line";
4698         } elsif ($virtdev && $map->{$virtdev}) {
4699             my $di = parse_drive($virtdev, $value);
4700             delete $di->{format}; # format can change on restore
4701             $di->{file} = $map->{$virtdev};
4702             $value = print_drive($vmid, $di);
4703             print $outfd "$virtdev: $value\n";
4704         } else {
4705             print $outfd $line;
4706         }
4707     } else {
4708         print $outfd $line;
4709     }
4710 }
4711
4712 sub scan_volids {
4713     my ($cfg, $vmid) = @_;
4714
4715     my $info = PVE::Storage::vdisk_list($cfg, undef, $vmid);
4716
4717     my $volid_hash = {};
4718     foreach my $storeid (keys %$info) {
4719         foreach my $item (@{$info->{$storeid}}) {
4720             next if !($item->{volid} && $item->{size});
4721             $item->{path} = PVE::Storage::path($cfg, $item->{volid});
4722             $volid_hash->{$item->{volid}} = $item;
4723         }
4724     }
4725
4726     return $volid_hash;
4727 }
4728
4729 sub get_used_paths {
4730     my ($vmid, $storecfg, $conf, $scan_snapshots, $skip_drive) = @_;
4731
4732     my $used_path = {};
4733
4734     my $scan_config = sub {
4735         my ($cref, $snapname) = @_;
4736
4737         foreach my $key (keys %$cref) {
4738             my $value = $cref->{$key};
4739             if (valid_drivename($key)) {
4740                 next if $skip_drive && $key eq $skip_drive;
4741                 my $drive = parse_drive($key, $value);
4742                 next if !$drive || !$drive->{file} || drive_is_cdrom($drive);
4743                 if ($drive->{file} =~ m!^/!) {
4744                     $used_path->{$drive->{file}}++; # = 1;
4745                 } else {
4746                     my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file}, 1);
4747                     next if !$storeid;
4748                     my $scfg = PVE::Storage::storage_config($storecfg, $storeid, 1);
4749                     next if !$scfg;
4750                     my $path = PVE::Storage::path($storecfg, $drive->{file}, $snapname);
4751                     $used_path->{$path}++; # = 1;
4752                 }
4753             }
4754         }
4755     };
4756
4757     &$scan_config($conf);
4758
4759     undef $skip_drive;
4760
4761     if ($scan_snapshots) {
4762         foreach my $snapname (keys %{$conf->{snapshots}}) {
4763             &$scan_config($conf->{snapshots}->{$snapname}, $snapname);
4764         }
4765     }
4766
4767     return $used_path;
4768 }
4769
4770 sub update_disksize {
4771     my ($vmid, $conf, $volid_hash) = @_;
4772
4773     my $changes;
4774
4775     my $used = {};
4776
4777     # Note: it is allowed to define multiple storages with same path (alias), so
4778     # we need to check both 'volid' and real 'path' (two different volid can point
4779     # to the same path).
4780
4781     my $usedpath = {};
4782
4783     # update size info
4784     foreach my $opt (keys %$conf) {
4785         if (valid_drivename($opt)) {
4786             my $drive = parse_drive($opt, $conf->{$opt});
4787             my $volid = $drive->{file};
4788             next if !$volid;
4789
4790             $used->{$volid} = 1;
4791             if ($volid_hash->{$volid} &&
4792                 (my $path = $volid_hash->{$volid}->{path})) {
4793                 $usedpath->{$path} = 1;
4794             }
4795
4796             next if drive_is_cdrom($drive);
4797             next if !$volid_hash->{$volid};
4798
4799             $drive->{size} = $volid_hash->{$volid}->{size};
4800             my $new = print_drive($vmid, $drive);
4801             if ($new ne $conf->{$opt}) {
4802                 $changes = 1;
4803                 $conf->{$opt} = $new;
4804             }
4805         }
4806     }
4807
4808     # remove 'unusedX' entry if volume is used
4809     foreach my $opt (keys %$conf) {
4810         next if $opt !~ m/^unused\d+$/;
4811         my $volid = $conf->{$opt};
4812         my $path = $volid_hash->{$volid}->{path} if $volid_hash->{$volid};
4813         if ($used->{$volid} || ($path && $usedpath->{$path})) {
4814             $changes = 1;
4815             delete $conf->{$opt};
4816         }
4817     }
4818
4819     foreach my $volid (sort keys %$volid_hash) {
4820         next if $volid =~ m/vm-$vmid-state-/;
4821         next if $used->{$volid};
4822         my $path = $volid_hash->{$volid}->{path};
4823         next if !$path; # just to be sure
4824         next if $usedpath->{$path};
4825         $changes = 1;
4826         add_unused_volume($conf, $volid);
4827         $usedpath->{$path} = 1; # avoid to add more than once (aliases)
4828     }
4829
4830     return $changes;
4831 }
4832
4833 sub rescan {
4834     my ($vmid, $nolock) = @_;
4835
4836     my $cfg = PVE::Cluster::cfs_read_file("storage.cfg");
4837
4838     my $volid_hash = scan_volids($cfg, $vmid);
4839
4840     my $updatefn =  sub {
4841         my ($vmid) = @_;
4842
4843         my $conf = load_config($vmid);
4844
4845         check_lock($conf);
4846
4847         my $vm_volids = {};
4848         foreach my $volid (keys %$volid_hash) {
4849             my $info = $volid_hash->{$volid};
4850             $vm_volids->{$volid} = $info if $info->{vmid} && $info->{vmid} == $vmid;
4851         }
4852
4853         my $changes = update_disksize($vmid, $conf, $vm_volids);
4854
4855         update_config_nolock($vmid, $conf, 1) if $changes;
4856     };
4857
4858     if (defined($vmid)) {
4859         if ($nolock) {
4860             &$updatefn($vmid);
4861         } else {
4862             lock_config($vmid, $updatefn, $vmid);
4863         }
4864     } else {
4865         my $vmlist = config_list();
4866         foreach my $vmid (keys %$vmlist) {
4867             if ($nolock) {
4868                 &$updatefn($vmid);
4869             } else {
4870                 lock_config($vmid, $updatefn, $vmid);
4871             }
4872         }
4873     }
4874 }
4875
4876 sub restore_vma_archive {
4877     my ($archive, $vmid, $user, $opts, $comp) = @_;
4878
4879     my $input = $archive eq '-' ? "<&STDIN" : undef;
4880     my $readfrom = $archive;
4881
4882     my $uncomp = '';
4883     if ($comp) {
4884         $readfrom = '-';
4885         my $qarchive = PVE::Tools::shellquote($archive);
4886         if ($comp eq 'gzip') {
4887             $uncomp = "zcat $qarchive|";
4888         } elsif ($comp eq 'lzop') {
4889             $uncomp = "lzop -d -c $qarchive|";
4890         } else {
4891             die "unknown compression method '$comp'\n";
4892         }
4893
4894     }
4895
4896     my $tmpdir = "/var/tmp/vzdumptmp$$";
4897     rmtree $tmpdir;
4898
4899     # disable interrupts (always do cleanups)
4900     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
4901         warn "got interrupt - ignored\n";
4902     };
4903
4904     my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
4905     POSIX::mkfifo($mapfifo, 0600);
4906     my $fifofh;
4907
4908     my $openfifo = sub {
4909         open($fifofh, '>', $mapfifo) || die $!;
4910     };
4911
4912     my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
4913
4914     my $oldtimeout;
4915     my $timeout = 5;
4916
4917     my $devinfo = {};
4918
4919     my $rpcenv = PVE::RPCEnvironment::get();
4920
4921     my $conffile = config_file($vmid);
4922     my $tmpfn = "$conffile.$$.tmp";
4923
4924     # Note: $oldconf is undef if VM does not exists
4925     my $oldconf = PVE::Cluster::cfs_read_file(cfs_config_path($vmid));
4926
4927     my $print_devmap = sub {
4928         my $virtdev_hash = {};
4929
4930         my $cfgfn = "$tmpdir/qemu-server.conf";
4931
4932         # we can read the config - that is already extracted
4933         my $fh = IO::File->new($cfgfn, "r") ||
4934             "unable to read qemu-server.conf - $!\n";
4935
4936         while (defined(my $line = <$fh>)) {
4937             if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
4938                 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
4939                 die "archive does not contain data for drive '$virtdev'\n"
4940                     if !$devinfo->{$devname};
4941                 if (defined($opts->{storage})) {
4942                     $storeid = $opts->{storage} || 'local';
4943                 } elsif (!$storeid) {
4944                     $storeid = 'local';
4945                 }
4946                 $format = 'raw' if !$format;
4947                 $devinfo->{$devname}->{devname} = $devname;
4948                 $devinfo->{$devname}->{virtdev} = $virtdev;
4949                 $devinfo->{$devname}->{format} = $format;
4950                 $devinfo->{$devname}->{storeid} = $storeid;
4951
4952                 # check permission on storage
4953                 my $pool = $opts->{pool}; # todo: do we need that?
4954                 if ($user ne 'root@pam') {
4955                     $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
4956                 }
4957
4958                 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
4959             }
4960         }
4961
4962         foreach my $devname (keys %$devinfo) {
4963             die "found no device mapping information for device '$devname'\n"
4964                 if !$devinfo->{$devname}->{virtdev};
4965         }
4966
4967         my $cfg = cfs_read_file('storage.cfg');
4968
4969         # create empty/temp config
4970         if ($oldconf) {
4971             PVE::Tools::file_set_contents($conffile, "memory: 128\n");
4972             foreach_drive($oldconf, sub {
4973                 my ($ds, $drive) = @_;
4974
4975                 return if drive_is_cdrom($drive);
4976
4977                 my $volid = $drive->{file};
4978
4979                 return if !$volid || $volid =~ m|^/|;
4980
4981                 my ($path, $owner) = PVE::Storage::path($cfg, $volid);
4982                 return if !$path || !$owner || ($owner != $vmid);
4983
4984                 # Note: only delete disk we want to restore
4985                 # other volumes will become unused
4986                 if ($virtdev_hash->{$ds}) {
4987                     PVE::Storage::vdisk_free($cfg, $volid);
4988                 }
4989             });
4990         }
4991
4992         my $map = {};
4993         foreach my $virtdev (sort keys %$virtdev_hash) {
4994             my $d = $virtdev_hash->{$virtdev};
4995             my $alloc_size = int(($d->{size} + 1024 - 1)/1024);
4996             my $scfg = PVE::Storage::storage_config($cfg, $d->{storeid});
4997
4998             # test if requested format is supported
4999             my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($cfg, $d->{storeid});
5000             my $supported = grep { $_ eq $d->{format} } @$validFormats;
5001             $d->{format} = $defFormat if !$supported;
5002
5003             my $volid = PVE::Storage::vdisk_alloc($cfg, $d->{storeid}, $vmid,
5004                                                   $d->{format}, undef, $alloc_size);
5005             print STDERR "new volume ID is '$volid'\n";
5006             $d->{volid} = $volid;
5007             my $path = PVE::Storage::path($cfg, $volid);
5008
5009             my $write_zeros = 1;
5010             # fixme: what other storages types initialize volumes with zero?
5011             if ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs' || $scfg->{type} eq 'glusterfs' ||
5012                 $scfg->{type} eq 'sheepdog' || $scfg->{type} eq 'rbd') {
5013                 $write_zeros = 0;
5014             }
5015
5016             print $fifofh "${write_zeros}:$d->{devname}=$path\n";
5017
5018             print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
5019             $map->{$virtdev} = $volid;
5020         }
5021
5022         $fh->seek(0, 0) || die "seek failed - $!\n";
5023
5024         my $outfd = new IO::File ($tmpfn, "w") ||
5025             die "unable to write config for VM $vmid\n";
5026
5027         my $cookie = { netcount => 0 };
5028         while (defined(my $line = <$fh>)) {
5029             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
5030         }
5031
5032         $fh->close();
5033         $outfd->close();
5034     };
5035
5036     eval {
5037         # enable interrupts
5038         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
5039             die "interrupted by signal\n";
5040         };
5041         local $SIG{ALRM} = sub { die "got timeout\n"; };
5042
5043         $oldtimeout = alarm($timeout);
5044
5045         my $parser = sub {
5046             my $line = shift;
5047
5048             print "$line\n";
5049
5050             if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
5051                 my ($dev_id, $size, $devname) = ($1, $2, $3);
5052                 $devinfo->{$devname} = { size => $size, dev_id => $dev_id };
5053             } elsif ($line =~ m/^CTIME: /) {
5054                 # we correctly received the vma config, so we can disable
5055                 # the timeout now for disk allocation (set to 10 minutes, so
5056                 # that we always timeout if something goes wrong)
5057                 alarm(600);
5058                 &$print_devmap();
5059                 print $fifofh "done\n";
5060                 my $tmp = $oldtimeout || 0;
5061                 $oldtimeout = undef;
5062                 alarm($tmp);
5063                 close($fifofh);
5064             }
5065         };
5066
5067         print "restore vma archive: $cmd\n";
5068         run_command($cmd, input => $input, outfunc => $parser, afterfork => $openfifo);
5069     };
5070     my $err = $@;
5071
5072     alarm($oldtimeout) if $oldtimeout;
5073
5074     unlink $mapfifo;
5075
5076     if ($err) {
5077         rmtree $tmpdir;
5078         unlink $tmpfn;
5079
5080         my $cfg = cfs_read_file('storage.cfg');
5081         foreach my $devname (keys %$devinfo) {
5082             my $volid = $devinfo->{$devname}->{volid};
5083             next if !$volid;
5084             eval {
5085                 if ($volid =~ m|^/|) {
5086                     unlink $volid || die 'unlink failed\n';
5087                 } else {
5088                     PVE::Storage::vdisk_free($cfg, $volid);
5089                 }
5090                 print STDERR "temporary volume '$volid' sucessfuly removed\n";
5091             };
5092             print STDERR "unable to cleanup '$volid' - $@" if $@;
5093         }
5094         die $err;
5095     }
5096
5097     rmtree $tmpdir;
5098
5099     rename($tmpfn, $conffile) ||
5100         die "unable to commit configuration file '$conffile'\n";
5101
5102     PVE::Cluster::cfs_update(); # make sure we read new file
5103
5104     eval { rescan($vmid, 1); };
5105     warn $@ if $@;
5106 }
5107
5108 sub restore_tar_archive {
5109     my ($archive, $vmid, $user, $opts) = @_;
5110
5111     if ($archive ne '-') {
5112         my $firstfile = tar_archive_read_firstfile($archive);
5113         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
5114             if $firstfile ne 'qemu-server.conf';
5115     }
5116
5117     my $storecfg = cfs_read_file('storage.cfg');
5118
5119     # destroy existing data - keep empty config
5120     my $vmcfgfn = config_file($vmid);
5121     destroy_vm($storecfg, $vmid, 1) if -f $vmcfgfn;
5122
5123     my $tocmd = "/usr/lib/qemu-server/qmextract";
5124
5125     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
5126     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
5127     $tocmd .= ' --prealloc' if $opts->{prealloc};
5128     $tocmd .= ' --info' if $opts->{info};
5129
5130     # tar option "xf" does not autodetect compression when read from STDIN,
5131     # so we pipe to zcat
5132     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
5133         PVE::Tools::shellquote("--to-command=$tocmd");
5134
5135     my $tmpdir = "/var/tmp/vzdumptmp$$";
5136     mkpath $tmpdir;
5137
5138     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
5139     local $ENV{VZDUMP_VMID} = $vmid;
5140     local $ENV{VZDUMP_USER} = $user;
5141
5142     my $conffile = config_file($vmid);
5143     my $tmpfn = "$conffile.$$.tmp";
5144
5145     # disable interrupts (always do cleanups)
5146     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
5147         print STDERR "got interrupt - ignored\n";
5148     };
5149
5150     eval {
5151         # enable interrupts
5152         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
5153             die "interrupted by signal\n";
5154         };
5155
5156         if ($archive eq '-') {
5157             print "extracting archive from STDIN\n";
5158             run_command($cmd, input => "<&STDIN");
5159         } else {
5160             print "extracting archive '$archive'\n";
5161             run_command($cmd);
5162         }
5163
5164         return if $opts->{info};
5165
5166         # read new mapping
5167         my $map = {};
5168         my $statfile = "$tmpdir/qmrestore.stat";
5169         if (my $fd = IO::File->new($statfile, "r")) {
5170             while (defined (my $line = <$fd>)) {
5171                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
5172                     $map->{$1} = $2 if $1;
5173                 } else {
5174                     print STDERR "unable to parse line in statfile - $line\n";
5175                 }
5176             }
5177             $fd->close();
5178         }
5179
5180         my $confsrc = "$tmpdir/qemu-server.conf";
5181
5182         my $srcfd = new IO::File($confsrc, "r") ||
5183             die "unable to open file '$confsrc'\n";
5184
5185         my $outfd = new IO::File ($tmpfn, "w") ||
5186             die "unable to write config for VM $vmid\n";
5187
5188         my $cookie = { netcount => 0 };
5189         while (defined (my $line = <$srcfd>)) {
5190             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
5191         }
5192
5193         $srcfd->close();
5194         $outfd->close();
5195     };
5196     my $err = $@;
5197
5198     if ($err) {
5199
5200         unlink $tmpfn;
5201
5202         tar_restore_cleanup($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info};
5203
5204         die $err;
5205     }
5206
5207     rmtree $tmpdir;
5208
5209     rename $tmpfn, $conffile ||
5210         die "unable to commit configuration file '$conffile'\n";
5211
5212     PVE::Cluster::cfs_update(); # make sure we read new file
5213
5214     eval { rescan($vmid, 1); };
5215     warn $@ if $@;
5216 };
5217
5218
5219 # Internal snapshots
5220
5221 # NOTE: Snapshot create/delete involves several non-atomic
5222 # action, and can take a long time.
5223 # So we try to avoid locking the file and use 'lock' variable
5224 # inside the config file instead.
5225
5226 my $snapshot_copy_config = sub {
5227     my ($source, $dest) = @_;
5228
5229     foreach my $k (keys %$source) {
5230         next if $k eq 'snapshots';
5231         next if $k eq 'snapstate';
5232         next if $k eq 'snaptime';
5233         next if $k eq 'vmstate';
5234         next if $k eq 'lock';
5235         next if $k eq 'digest';
5236         next if $k eq 'description';
5237         next if $k =~ m/^unused\d+$/;
5238
5239         $dest->{$k} = $source->{$k};
5240     }
5241 };
5242
5243 my $snapshot_apply_config = sub {
5244     my ($conf, $snap) = @_;
5245
5246     # copy snapshot list
5247     my $newconf = {
5248         snapshots => $conf->{snapshots},
5249     };
5250
5251     # keep description and list of unused disks
5252     foreach my $k (keys %$conf) {
5253         next if !($k =~ m/^unused\d+$/ || $k eq 'description');
5254         $newconf->{$k} = $conf->{$k};
5255     }
5256
5257     &$snapshot_copy_config($snap, $newconf);
5258
5259     return $newconf;
5260 };
5261
5262 sub foreach_writable_storage {
5263     my ($conf, $func) = @_;
5264
5265     my $sidhash = {};
5266
5267     foreach my $ds (keys %$conf) {
5268         next if !valid_drivename($ds);
5269
5270         my $drive = parse_drive($ds, $conf->{$ds});
5271         next if !$drive;
5272         next if drive_is_cdrom($drive);
5273
5274         my $volid = $drive->{file};
5275
5276         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
5277         $sidhash->{$sid} = $sid if $sid;
5278     }
5279
5280     foreach my $sid (sort keys %$sidhash) {
5281         &$func($sid);
5282     }
5283 }
5284
5285 my $alloc_vmstate_volid = sub {
5286     my ($storecfg, $vmid, $conf, $snapname) = @_;
5287
5288     # Note: we try to be smart when selecting a $target storage
5289
5290     my $target;
5291
5292     # search shared storage first
5293     foreach_writable_storage($conf, sub {
5294         my ($sid) = @_;
5295         my $scfg = PVE::Storage::storage_config($storecfg, $sid);
5296         return if !$scfg->{shared};
5297
5298         $target = $sid if !$target || $scfg->{path}; # prefer file based storage
5299     });
5300
5301     if (!$target) {
5302         # now search local storage
5303         foreach_writable_storage($conf, sub {
5304             my ($sid) = @_;
5305             my $scfg = PVE::Storage::storage_config($storecfg, $sid);
5306             return if $scfg->{shared};
5307
5308             $target = $sid if !$target || $scfg->{path}; # prefer file based storage;
5309         });
5310     }
5311
5312     $target = 'local' if !$target;
5313
5314     my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
5315     # we abort live save after $conf->{memory}, so we need at max twice that space
5316     my $size = $conf->{memory}*2 + $driver_state_size;
5317
5318     my $name = "vm-$vmid-state-$snapname";
5319     my $scfg = PVE::Storage::storage_config($storecfg, $target);
5320     $name .= ".raw" if $scfg->{path}; # add filename extension for file base storage
5321     my $volid = PVE::Storage::vdisk_alloc($storecfg, $target, $vmid, 'raw', $name, $size*1024);
5322
5323     return $volid;
5324 };
5325
5326 my $snapshot_prepare = sub {
5327     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
5328
5329     my $snap;
5330
5331     my $updatefn =  sub {
5332
5333         my $conf = load_config($vmid);
5334
5335         die "you can't take a snapshot if it's a template\n"
5336             if is_template($conf);
5337
5338         check_lock($conf);
5339
5340         $conf->{lock} = 'snapshot';
5341
5342         die "snapshot name '$snapname' already used\n"
5343             if defined($conf->{snapshots}->{$snapname});
5344
5345         my $storecfg = PVE::Storage::config();
5346         die "snapshot feature is not available" if !has_feature('snapshot', $conf, $storecfg);
5347
5348         $snap = $conf->{snapshots}->{$snapname} = {};
5349
5350         if ($save_vmstate && check_running($vmid)) {
5351             $snap->{vmstate} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
5352         }
5353
5354         &$snapshot_copy_config($conf, $snap);
5355
5356         $snap->{snapstate} = "prepare";
5357         $snap->{snaptime} = time();
5358         $snap->{description} = $comment if $comment;
5359
5360         # always overwrite machine if we save vmstate. This makes sure we
5361         # can restore it later using correct machine type
5362         $snap->{machine} = get_current_qemu_machine($vmid) if $snap->{vmstate};
5363
5364         update_config_nolock($vmid, $conf, 1);
5365     };
5366
5367     lock_config($vmid, $updatefn);
5368
5369     return $snap;
5370 };
5371
5372 my $snapshot_commit = sub {
5373     my ($vmid, $snapname) = @_;
5374
5375     my $updatefn = sub {
5376
5377         my $conf = load_config($vmid);
5378
5379         die "missing snapshot lock\n"
5380             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
5381
5382         my $has_machine_config = defined($conf->{machine});
5383
5384         my $snap = $conf->{snapshots}->{$snapname};
5385
5386         die "snapshot '$snapname' does not exist\n" if !defined($snap);
5387
5388         die "wrong snapshot state\n"
5389             if !($snap->{snapstate} && $snap->{snapstate} eq "prepare");
5390
5391         delete $snap->{snapstate};
5392         delete $conf->{lock};
5393
5394         my $newconf = &$snapshot_apply_config($conf, $snap);
5395
5396         delete $newconf->{machine} if !$has_machine_config;
5397
5398         $newconf->{parent} = $snapname;
5399
5400         update_config_nolock($vmid, $newconf, 1);
5401     };
5402
5403     lock_config($vmid, $updatefn);
5404 };
5405
5406 sub snapshot_rollback {
5407     my ($vmid, $snapname) = @_;
5408
5409     my $snap;
5410
5411     my $prepare = 1;
5412
5413     my $storecfg = PVE::Storage::config();
5414
5415     my $updatefn = sub {
5416
5417         my $conf = load_config($vmid);
5418
5419         die "you can't rollback if vm is a template\n" if is_template($conf);
5420
5421         $snap = $conf->{snapshots}->{$snapname};
5422
5423         die "snapshot '$snapname' does not exist\n" if !defined($snap);
5424
5425         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
5426             if $snap->{snapstate};
5427
5428         if ($prepare) {
5429             check_lock($conf);
5430             vm_stop($storecfg, $vmid, undef, undef, 5, undef, undef);
5431         }
5432
5433         die "unable to rollback vm $vmid: vm is running\n"
5434             if check_running($vmid);
5435
5436         if ($prepare) {
5437             $conf->{lock} = 'rollback';
5438         } else {
5439             die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
5440             delete $conf->{lock};
5441         }
5442
5443         my $forcemachine;
5444
5445         if (!$prepare) {
5446             my $has_machine_config = defined($conf->{machine});
5447
5448             # copy snapshot config to current config
5449             $conf = &$snapshot_apply_config($conf, $snap);
5450             $conf->{parent} = $snapname;
5451
5452             # Note: old code did not store 'machine', so we try to be smart
5453             # and guess the snapshot was generated with kvm 1.4 (pc-i440fx-1.4).
5454             $forcemachine = $conf->{machine} || 'pc-i440fx-1.4';
5455             # we remove the 'machine' configuration if not explicitly specified
5456             # in the original config.
5457             delete $conf->{machine} if $snap->{vmstate} && !$has_machine_config;
5458         }
5459
5460         update_config_nolock($vmid, $conf, 1);
5461
5462         if (!$prepare && $snap->{vmstate}) {
5463             my $statefile = PVE::Storage::path($storecfg, $snap->{vmstate});
5464             vm_start($storecfg, $vmid, $statefile, undef, undef, undef, $forcemachine);
5465         }
5466     };
5467
5468     lock_config($vmid, $updatefn);
5469
5470     foreach_drive($snap, sub {
5471         my ($ds, $drive) = @_;
5472
5473         return if drive_is_cdrom($drive);
5474
5475         my $volid = $drive->{file};
5476         my $device = "drive-$ds";
5477
5478         PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
5479     });
5480
5481     $prepare = 0;
5482     lock_config($vmid, $updatefn);
5483 }
5484
5485 my $savevm_wait = sub {
5486     my ($vmid) = @_;
5487
5488     for(;;) {
5489         my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
5490         if (!$stat->{status}) {
5491             die "savevm not active\n";
5492         } elsif ($stat->{status} eq 'active') {
5493             sleep(1);
5494             next;
5495         } elsif ($stat->{status} eq 'completed') {
5496             last;
5497         } else {
5498             die "query-savevm returned status '$stat->{status}'\n";
5499         }
5500     }
5501 };
5502
5503 sub snapshot_create {
5504     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
5505
5506     my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
5507
5508     $save_vmstate = 0 if !$snap->{vmstate}; # vm is not running
5509
5510     my $config = load_config($vmid);
5511
5512     my $running = check_running($vmid);
5513
5514     my $freezefs = $running && $config->{agent};
5515     $freezefs = 0 if $snap->{vmstate}; # not needed if we save RAM
5516
5517     my $drivehash = {};
5518
5519     if ($freezefs) {
5520         eval { vm_mon_cmd($vmid, "guest-fsfreeze-freeze"); };
5521         warn "guest-fsfreeze-freeze problems - $@" if $@;
5522     }
5523
5524     eval {
5525         # create internal snapshots of all drives
5526
5527         my $storecfg = PVE::Storage::config();
5528
5529         if ($running) {
5530             if ($snap->{vmstate}) {
5531                 my $path = PVE::Storage::path($storecfg, $snap->{vmstate});
5532                 vm_mon_cmd($vmid, "savevm-start", statefile => $path);
5533                 &$savevm_wait($vmid);
5534             } else {
5535                 vm_mon_cmd($vmid, "savevm-start");
5536             }
5537         };
5538
5539         foreach_drive($snap, sub {
5540             my ($ds, $drive) = @_;
5541
5542             return if drive_is_cdrom($drive);
5543
5544             my $volid = $drive->{file};
5545             my $device = "drive-$ds";
5546
5547             qemu_volume_snapshot($vmid, $device, $storecfg, $volid, $snapname);
5548             $drivehash->{$ds} = 1;
5549        });
5550     };
5551     my $err = $@;
5552
5553     if ($running) {
5554         eval { vm_mon_cmd($vmid, "savevm-end")  };
5555         warn $@ if $@;
5556
5557         if ($freezefs) {
5558             eval { vm_mon_cmd($vmid, "guest-fsfreeze-thaw"); };
5559             warn "guest-fsfreeze-thaw problems - $@" if $@;
5560         }
5561
5562         # savevm-end is async, we need to wait
5563         for (;;) {
5564             my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
5565             if (!$stat->{bytes}) {
5566                 last;
5567             } else {
5568                 print "savevm not yet finished\n";
5569                 sleep(1);
5570                 next;
5571             }
5572         }
5573     }
5574
5575     if ($err) {
5576         warn "snapshot create failed: starting cleanup\n";
5577         eval { snapshot_delete($vmid, $snapname, 0, $drivehash); };
5578         warn $@ if $@;
5579         die $err;
5580     }
5581
5582     &$snapshot_commit($vmid, $snapname);
5583 }
5584
5585 # Note: $drivehash is only set when called from snapshot_create.
5586 sub snapshot_delete {
5587     my ($vmid, $snapname, $force, $drivehash) = @_;
5588
5589     my $prepare = 1;
5590
5591     my $snap;
5592     my $unused = [];
5593
5594     my $unlink_parent = sub {
5595         my ($confref, $new_parent) = @_;
5596
5597         if ($confref->{parent} && $confref->{parent} eq $snapname) {
5598             if ($new_parent) {
5599                 $confref->{parent} = $new_parent;
5600             } else {
5601                 delete $confref->{parent};
5602             }
5603         }
5604     };
5605
5606     my $updatefn =  sub {
5607         my ($remove_drive) = @_;
5608
5609         my $conf = load_config($vmid);
5610
5611         if (!$drivehash) {
5612             check_lock($conf);
5613             die "you can't delete a snapshot if vm is a template\n"
5614                 if is_template($conf);
5615         }
5616
5617         $snap = $conf->{snapshots}->{$snapname};
5618
5619         die "snapshot '$snapname' does not exist\n" if !defined($snap);
5620
5621         # remove parent refs
5622         if (!$prepare) {
5623             &$unlink_parent($conf, $snap->{parent});
5624             foreach my $sn (keys %{$conf->{snapshots}}) {
5625                 next if $sn eq $snapname;
5626                 &$unlink_parent($conf->{snapshots}->{$sn}, $snap->{parent});
5627             }
5628         }
5629
5630         if ($remove_drive) {
5631             if ($remove_drive eq 'vmstate') {
5632                 delete $snap->{$remove_drive};
5633             } else {
5634                 my $drive = parse_drive($remove_drive, $snap->{$remove_drive});
5635                 my $volid = $drive->{file};
5636                 delete $snap->{$remove_drive};
5637                 add_unused_volume($conf, $volid);
5638             }
5639         }
5640
5641         if ($prepare) {
5642             $snap->{snapstate} = 'delete';
5643         } else {
5644             delete $conf->{snapshots}->{$snapname};
5645             delete $conf->{lock} if $drivehash;
5646             foreach my $volid (@$unused) {
5647                 add_unused_volume($conf, $volid);
5648             }
5649         }
5650
5651         update_config_nolock($vmid, $conf, 1);
5652     };
5653
5654     lock_config($vmid, $updatefn);
5655
5656     # now remove vmstate file
5657
5658     my $storecfg = PVE::Storage::config();
5659
5660     if ($snap->{vmstate}) {
5661         eval {  PVE::Storage::vdisk_free($storecfg, $snap->{vmstate}); };
5662         if (my $err = $@) {
5663             die $err if !$force;
5664             warn $err;
5665         }
5666         # save changes (remove vmstate from snapshot)
5667         lock_config($vmid, $updatefn, 'vmstate') if !$force;
5668     };
5669
5670     # now remove all internal snapshots
5671     foreach_drive($snap, sub {
5672         my ($ds, $drive) = @_;
5673
5674         return if drive_is_cdrom($drive);
5675
5676         my $volid = $drive->{file};
5677         my $device = "drive-$ds";
5678
5679         if (!$drivehash || $drivehash->{$ds}) {
5680             eval { qemu_volume_snapshot_delete($vmid, $device, $storecfg, $volid, $snapname); };
5681             if (my $err = $@) {
5682                 die $err if !$force;
5683                 warn $err;
5684             }
5685         }
5686
5687         # save changes (remove drive fron snapshot)
5688         lock_config($vmid, $updatefn, $ds) if !$force;
5689         push @$unused, $volid;
5690     });
5691
5692     # now cleanup config
5693     $prepare = 0;
5694     lock_config($vmid, $updatefn);
5695 }
5696
5697 sub has_feature {
5698     my ($feature, $conf, $storecfg, $snapname, $running) = @_;
5699
5700     my $err;
5701     foreach_drive($conf, sub {
5702         my ($ds, $drive) = @_;
5703
5704         return if drive_is_cdrom($drive);
5705         my $volid = $drive->{file};
5706         $err = 1 if !PVE::Storage::volume_has_feature($storecfg, $feature, $volid, $snapname, $running);
5707     });
5708
5709     return $err ? 0 : 1;
5710 }
5711
5712 sub template_create {
5713     my ($vmid, $conf, $disk) = @_;
5714
5715     my $storecfg = PVE::Storage::config();
5716
5717     foreach_drive($conf, sub {
5718         my ($ds, $drive) = @_;
5719
5720         return if drive_is_cdrom($drive);
5721         return if $disk && $ds ne $disk;
5722
5723         my $volid = $drive->{file};
5724         return if !PVE::Storage::volume_has_feature($storecfg, 'template', $volid);
5725
5726         my $voliddst = PVE::Storage::vdisk_create_base($storecfg, $volid);
5727         $drive->{file} = $voliddst;
5728         $conf->{$ds} = print_drive($vmid, $drive);
5729         update_config_nolock($vmid, $conf, 1);
5730     });
5731 }
5732
5733 sub is_template {
5734     my ($conf) = @_;
5735
5736     return 1 if defined $conf->{template} && $conf->{template} == 1;
5737 }
5738
5739 sub qemu_img_convert {
5740     my ($src_volid, $dst_volid, $size, $snapname) = @_;
5741
5742     my $storecfg = PVE::Storage::config();
5743     my ($src_storeid, $src_volname) = PVE::Storage::parse_volume_id($src_volid, 1);
5744     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
5745
5746     if ($src_storeid && $dst_storeid) {
5747         my $src_scfg = PVE::Storage::storage_config($storecfg, $src_storeid);
5748         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
5749
5750         my $src_format = qemu_img_format($src_scfg, $src_volname);
5751         my $dst_format = qemu_img_format($dst_scfg, $dst_volname);
5752
5753         my $src_path = PVE::Storage::path($storecfg, $src_volid, $snapname);
5754         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
5755
5756         my $cmd = [];
5757         push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-n';
5758         push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
5759         push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
5760
5761         my $parser = sub {
5762             my $line = shift;
5763             if($line =~ m/\((\S+)\/100\%\)/){
5764                 my $percent = $1;
5765                 my $transferred = int($size * $percent / 100);
5766                 my $remaining = $size - $transferred;
5767
5768                 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
5769             }
5770
5771         };
5772
5773         eval  { run_command($cmd, timeout => undef, outfunc => $parser); };
5774         my $err = $@;
5775         die "copy failed: $err" if $err;
5776     }
5777 }
5778
5779 sub qemu_img_format {
5780     my ($scfg, $volname) = @_;
5781
5782     if ($scfg->{path} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/) {
5783         return $1;
5784     } elsif ($scfg->{type} eq 'iscsi') {
5785         return "host_device";
5786     } else {
5787         return "raw";
5788     }
5789 }
5790
5791 sub qemu_drive_mirror {
5792     my ($vmid, $drive, $dst_volid, $vmiddst) = @_;
5793
5794     my $count = 0;
5795     my $old_len = 0;
5796     my $frozen = undef;
5797     my $maxwait = 120;
5798
5799     my $storecfg = PVE::Storage::config();
5800     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid);
5801
5802     my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
5803
5804     my $format;
5805     if ($dst_volname =~ m/\.(raw|qcow2)$/){
5806         $format = $1;
5807     }
5808
5809     my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
5810
5811     my $opts = { timeout => 10, device => "drive-$drive", mode => "existing", sync => "full", target => $dst_path };
5812     $opts->{format} = $format if $format;
5813
5814     #fixme : sometime drive-mirror timeout, but works fine after.
5815     # (I have see the problem with big volume > 200GB), so we need to eval
5816     eval { vm_mon_cmd($vmid, "drive-mirror", %$opts); };
5817     # ignore errors here
5818
5819     eval {
5820         while (1) {
5821             my $stats = vm_mon_cmd($vmid, "query-block-jobs");
5822             my $stat = @$stats[0];
5823             die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
5824             die "error job is not mirroring" if $stat->{type} ne "mirror";
5825
5826             my $busy = $stat->{busy};
5827
5828             if (my $total = $stat->{len}) {
5829                 my $transferred = $stat->{offset} || 0;
5830                 my $remaining = $total - $transferred;
5831                 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
5832
5833                 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent % busy: $busy\n";
5834             }
5835
5836             if ($stat->{len} == $stat->{offset}) {
5837                 if ($busy eq 'false') {
5838
5839                     last if $vmiddst != $vmid;
5840
5841                     # try to switch the disk if source and destination are on the same guest
5842                     eval { vm_mon_cmd($vmid, "block-job-complete", device => "drive-$drive") };
5843                     last if !$@;
5844                     die $@ if $@ !~ m/cannot be completed/;
5845                 }
5846
5847                 if ($count > $maxwait) {
5848                     # if too much writes to disk occurs at the end of migration
5849                     #the disk needs to be freezed to be able to complete the migration
5850                     vm_suspend($vmid,1);
5851                     $frozen = 1;
5852                 }
5853                 $count ++
5854             }
5855             $old_len = $stat->{offset};
5856             sleep 1;
5857         }
5858
5859         vm_resume($vmid, 1) if $frozen;
5860
5861     };
5862     my $err = $@;
5863
5864     my $cancel_job = sub {
5865         vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive");
5866         while (1) {
5867             my $stats = vm_mon_cmd($vmid, "query-block-jobs");
5868             my $stat = @$stats[0];
5869             last if !$stat;
5870             sleep 1;
5871         }
5872     };
5873
5874     if ($err) {
5875         eval { &$cancel_job(); };
5876         die "mirroring error: $err";
5877     }
5878
5879     if ($vmiddst != $vmid) {
5880         # if we clone a disk for a new target vm, we don't switch the disk
5881         &$cancel_job(); # so we call block-job-cancel
5882     }
5883 }
5884
5885 sub clone_disk {
5886     my ($storecfg, $vmid, $running, $drivename, $drive, $snapname,
5887         $newvmid, $storage, $format, $full, $newvollist) = @_;
5888
5889     my $newvolid;
5890
5891     if (!$full) {
5892         print "create linked clone of drive $drivename ($drive->{file})\n";
5893         $newvolid = PVE::Storage::vdisk_clone($storecfg,  $drive->{file}, $newvmid, $snapname);
5894         push @$newvollist, $newvolid;
5895     } else {
5896         my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file});
5897         $storeid = $storage if $storage;
5898
5899         my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($storecfg, $storeid);
5900         if (!$format) {
5901             $format = $drive->{format} || $defFormat;
5902         }
5903
5904         # test if requested format is supported - else use default
5905         my $supported = grep { $_ eq $format } @$validFormats;
5906         $format = $defFormat if !$supported;
5907
5908         my ($size) = PVE::Storage::volume_size_info($storecfg, $drive->{file}, 3);
5909
5910         print "create full clone of drive $drivename ($drive->{file})\n";
5911         $newvolid = PVE::Storage::vdisk_alloc($storecfg, $storeid, $newvmid, $format, undef, ($size/1024));
5912         push @$newvollist, $newvolid;
5913
5914         if (!$running || $snapname) {
5915             qemu_img_convert($drive->{file}, $newvolid, $size, $snapname);
5916         } else {
5917             qemu_drive_mirror($vmid, $drivename, $newvolid, $newvmid);
5918         }
5919     }
5920
5921     my ($size) = PVE::Storage::volume_size_info($storecfg, $newvolid, 3);
5922
5923     my $disk = $drive;
5924     $disk->{format} = undef;
5925     $disk->{file} = $newvolid;
5926     $disk->{size} = $size;
5927
5928     return $disk;
5929 }
5930
5931 # this only works if VM is running
5932 sub get_current_qemu_machine {
5933     my ($vmid) = @_;
5934
5935     my $cmd = { execute => 'query-machines', arguments => {} };
5936     my $res = vm_qmp_command($vmid, $cmd);
5937
5938     my ($current, $default);
5939     foreach my $e (@$res) {
5940         $default = $e->{name} if $e->{'is-default'};
5941         $current = $e->{name} if $e->{'is-current'};
5942     }
5943
5944     # fallback to the default machine if current is not supported by qemu
5945     return $current || $default || 'pc';
5946 }
5947
5948 sub lspci {
5949
5950     my $devices = {};
5951
5952     dir_glob_foreach("$pcisysfs/devices", '[a-f0-9]{4}:([a-f0-9]{2}:[a-f0-9]{2})\.([0-9])', sub {
5953             my (undef, $id, $function) = @_;
5954             my $res = { id => $id, function => $function};
5955             push @{$devices->{$id}}, $res;
5956     });
5957
5958     return $devices;
5959 }
5960
5961 1;