PVE/QemuServer.pm

   1 package PVE::QemuServer;
   2
   3 use strict;
   4 use warnings;
   5 use POSIX;
   6 use IO::Handle;
   7 use IO::Select;
   8 use IO::File;
   9 use IO::Dir;
  10 use IO::Socket::UNIX;
  11 use File::Basename;
  12 use File::Path;
  13 use File::stat;
  14 use Getopt::Long;
  15 use Digest::SHA;
  16 use Fcntl ':flock';
  17 use Cwd 'abs_path';
  18 use IPC::Open3;
  19 use JSON;
  20 use Fcntl;
  21 use PVE::SafeSyslog;
  22 use Storable qw(dclone);
  23 use PVE::Exception qw(raise raise_param_exc);
  24 use PVE::Storage;
  25 use PVE::Tools qw(run_command lock_file lock_file_full file_read_firstline dir_glob_foreach);
  26 use PVE::JSONSchema qw(get_standard_option);
  27 use PVE::Cluster qw(cfs_register_file cfs_read_file cfs_write_file cfs_lock_file);
  28 use PVE::INotify;
  29 use PVE::ProcFSTools;
  30 use PVE::QMPClient;
  31 use PVE::RPCEnvironment;
  32 use Time::HiRes qw(gettimeofday);
  33
  34 my $cpuinfo = PVE::ProcFSTools::read_cpuinfo();
  35
  36 # Note about locking: we use flock on the config file protect
  37 # against concurent actions.
  38 # Aditionaly, we have a 'lock' setting in the config file. This
  39 # can be set to 'migrate', 'backup', 'snapshot' or 'rollback'. Most actions are not
  40 # allowed when such lock is set. But you can ignore this kind of
  41 # lock with the --skiplock flag.
  42
  43 cfs_register_file('/qemu-server/',
  44                   \&parse_vm_config,
  45                   \&write_vm_config);
  46
  47 PVE::JSONSchema::register_standard_option('skiplock', {
  48     description => "Ignore locks - only root is allowed to use this option.",
  49     type => 'boolean',
  50     optional => 1,
  51 });
  52
  53 PVE::JSONSchema::register_standard_option('pve-qm-stateuri', {
  54     description => "Some command save/restore state from this location.",
  55     type => 'string',
  56     maxLength => 128,
  57     optional => 1,
  58 });
  59
  60 PVE::JSONSchema::register_standard_option('pve-snapshot-name', {
  61     description => "The name of the snapshot.",
  62     type => 'string', format => 'pve-configid',
  63     maxLength => 40,
  64 });
  65
  66 #no warnings 'redefine';
  67
  68 unless(defined(&_VZSYSCALLS_H_)) {
  69     eval 'sub _VZSYSCALLS_H_ () {1;}' unless defined(&_VZSYSCALLS_H_);
  70     require 'sys/syscall.ph';
  71     if(defined(&__x86_64__)) {
  72         eval 'sub __NR_fairsched_vcpus () {499;}' unless defined(&__NR_fairsched_vcpus);
  73         eval 'sub __NR_fairsched_mknod () {504;}' unless defined(&__NR_fairsched_mknod);
  74         eval 'sub __NR_fairsched_rmnod () {505;}' unless defined(&__NR_fairsched_rmnod);
  75         eval 'sub __NR_fairsched_chwt () {506;}' unless defined(&__NR_fairsched_chwt);
  76         eval 'sub __NR_fairsched_mvpr () {507;}' unless defined(&__NR_fairsched_mvpr);
  77         eval 'sub __NR_fairsched_rate () {508;}' unless defined(&__NR_fairsched_rate);
  78         eval 'sub __NR_setluid () {501;}' unless defined(&__NR_setluid);
  79         eval 'sub __NR_setublimit () {502;}' unless defined(&__NR_setublimit);
  80     }
  81     elsif(defined( &__i386__) ) {
  82         eval 'sub __NR_fairsched_mknod () {500;}' unless defined(&__NR_fairsched_mknod);
  83         eval 'sub __NR_fairsched_rmnod () {501;}' unless defined(&__NR_fairsched_rmnod);
  84         eval 'sub __NR_fairsched_chwt () {502;}' unless defined(&__NR_fairsched_chwt);
  85         eval 'sub __NR_fairsched_mvpr () {503;}' unless defined(&__NR_fairsched_mvpr);
  86         eval 'sub __NR_fairsched_rate () {504;}' unless defined(&__NR_fairsched_rate);
  87         eval 'sub __NR_fairsched_vcpus () {505;}' unless defined(&__NR_fairsched_vcpus);
  88         eval 'sub __NR_setluid () {511;}' unless defined(&__NR_setluid);
  89         eval 'sub __NR_setublimit () {512;}' unless defined(&__NR_setublimit);
  90     } else {
  91         die("no fairsched syscall for this arch");
  92     }
  93     require 'asm/ioctl.ph';
  94     eval 'sub KVM_GET_API_VERSION () { &_IO(0xAE, 0x);}' unless defined(&KVM_GET_API_VERSION);
  95 }
  96
  97 sub fairsched_mknod {
  98     my ($parent, $weight, $desired) = @_;
  99
 100     return syscall(&__NR_fairsched_mknod, int($parent), int($weight), int($desired));
 101 }
 102
 103 sub fairsched_rmnod {
 104     my ($id) = @_;
 105
 106     return syscall(&__NR_fairsched_rmnod, int($id));
 107 }
 108
 109 sub fairsched_mvpr {
 110     my ($pid, $newid) = @_;
 111
 112     return syscall(&__NR_fairsched_mvpr, int($pid), int($newid));
 113 }
 114
 115 sub fairsched_vcpus {
 116     my ($id, $vcpus) = @_;
 117
 118     return syscall(&__NR_fairsched_vcpus, int($id), int($vcpus));
 119 }
 120
 121 sub fairsched_rate {
 122     my ($id, $op, $rate) = @_;
 123
 124     return syscall(&__NR_fairsched_rate, int($id), int($op), int($rate));
 125 }
 126
 127 use constant FAIRSCHED_SET_RATE  => 0;
 128 use constant FAIRSCHED_DROP_RATE => 1;
 129 use constant FAIRSCHED_GET_RATE  => 2;
 130
 131 sub fairsched_cpulimit {
 132     my ($id, $limit) = @_;
 133
 134     my $cpulim1024 = int($limit * 1024 / 100);
 135     my $op = $cpulim1024 ? FAIRSCHED_SET_RATE : FAIRSCHED_DROP_RATE;
 136
 137     return fairsched_rate($id, $op, $cpulim1024);
 138 }
 139
 140 my $nodename = PVE::INotify::nodename();
 141
 142 mkdir "/etc/pve/nodes/$nodename";
 143 my $confdir = "/etc/pve/nodes/$nodename/qemu-server";
 144 mkdir $confdir;
 145
 146 my $var_run_tmpdir = "/var/run/qemu-server";
 147 mkdir $var_run_tmpdir;
 148
 149 my $lock_dir = "/var/lock/qemu-server";
 150 mkdir $lock_dir;
 151
 152 my $pcisysfs = "/sys/bus/pci";
 153
 154 my $confdesc = {
 155     iothread => {
 156         optional => 1,
 157         type => 'boolean',
 158         description => "Enable iothread dataplane.",
 159         default => 0,
 160     },
 161     onboot => {
 162         optional => 1,
 163         type => 'boolean',
 164         description => "Specifies whether a VM will be started during system bootup.",
 165         default => 0,
 166     },
 167     autostart => {
 168         optional => 1,
 169         type => 'boolean',
 170         description => "Automatic restart after crash (currently ignored).",
 171         default => 0,
 172     },
 173     hotplug => {
 174         optional => 1,
 175         type => 'boolean',
 176         description => "Allow hotplug for disk and network device",
 177         default => 0,
 178     },
 179     reboot => {
 180         optional => 1,
 181         type => 'boolean',
 182         description => "Allow reboot. If set to '0' the VM exit on reboot.",
 183         default => 1,
 184     },
 185     lock => {
 186         optional => 1,
 187         type => 'string',
 188         description => "Lock/unlock the VM.",
 189         enum => [qw(migrate backup snapshot rollback)],
 190     },
 191     cpulimit => {
 192         optional => 1,
 193         type => 'integer',
 194         description => "Limit of CPU usage in per cent. Note if the computer has 2 CPUs, it has total of 200% CPU time. Value '0' indicates no CPU limit.\n\nNOTE: This option is currently ignored.",
 195         minimum => 0,
 196         default => 0,
 197     },
 198     cpuunits => {
 199         optional => 1,
 200         type => 'integer',
 201         description => "CPU weight for a VM. Argument is used in the kernel fair scheduler. The larger the number is, the more CPU time this VM gets. Number is relative to weights of all the other running VMs.\n\nNOTE: You can disable fair-scheduler configuration by setting this to 0.",
 202         minimum => 0,
 203         maximum => 500000,
 204         default => 1000,
 205     },
 206     memory => {
 207         optional => 1,
 208         type => 'integer',
 209         description => "Amount of RAM for the VM in MB. This is the maximum available memory when you use the balloon device.",
 210         minimum => 16,
 211         default => 512,
 212     },
 213     balloon => {
 214         optional => 1,
 215         type => 'integer',
 216         description => "Amount of target RAM for the VM in MB. Using zero disables the ballon driver.",
 217         minimum => 0,
 218     },
 219     shares => {
 220         optional => 1,
 221         type => 'integer',
 222         description => "Amount of memory shares for auto-ballooning. The larger the number is, the more memory this VM gets. Number is relative to weights of all other running VMs. Using zero disables auto-ballooning",
 223         minimum => 0,
 224         maximum => 50000,
 225         default => 1000,
 226     },
 227     keyboard => {
 228         optional => 1,
 229         type => 'string',
 230         description => "Keybord layout for vnc server. Default is read from the datacenter configuration file.",
 231         enum => PVE::Tools::kvmkeymaplist(),
 232         default => 'en-us',
 233     },
 234     name => {
 235         optional => 1,
 236         type => 'string', format => 'dns-name',
 237         description => "Set a name for the VM. Only used on the configuration web interface.",
 238     },
 239     scsihw => {
 240         optional => 1,
 241         type => 'string',
 242         description => "scsi controller model",
 243         enum => [qw(lsi lsi53c810 virtio-scsi-pci megasas pvscsi)],
 244         default => 'lsi',
 245     },
 246     description => {
 247         optional => 1,
 248         type => 'string',
 249         description => "Description for the VM. Only used on the configuration web interface. This is saved as comment inside the configuration file.",
 250     },
 251     ostype => {
 252         optional => 1,
 253         type => 'string',
 254         enum => [qw(other wxp w2k w2k3 w2k8 wvista win7 win8 l24 l26 solaris)],
 255         description => <<EODESC,
 256 Used to enable special optimization/features for specific
 257 operating systems:
 258
 259 other  => unspecified OS
 260 wxp    => Microsoft Windows XP
 261 w2k    => Microsoft Windows 2000
 262 w2k3   => Microsoft Windows 2003
 263 w2k8   => Microsoft Windows 2008
 264 wvista => Microsoft Windows Vista
 265 win7   => Microsoft Windows 7
 266 win8   => Microsoft Windows 8/2012
 267 l24    => Linux 2.4 Kernel
 268 l26    => Linux 2.6/3.X Kernel
 269 solaris => solaris/opensolaris/openindiania kernel
 270
 271 other|l24|l26|solaris                       ... no special behaviour
 272 wxp|w2k|w2k3|w2k8|wvista|win7|win8  ... use --localtime switch
 273 EODESC
 274     },
 275     boot => {
 276         optional => 1,
 277         type => 'string',
 278         description => "Boot on floppy (a), hard disk (c), CD-ROM (d), or network (n).",
 279         pattern => '[acdn]{1,4}',
 280         default => 'cdn',
 281     },
 282     bootdisk => {
 283         optional => 1,
 284         type => 'string', format => 'pve-qm-bootdisk',
 285         description => "Enable booting from specified disk.",
 286         pattern => '(ide|sata|scsi|virtio)\d+',
 287     },
 288     smp => {
 289         optional => 1,
 290         type => 'integer',
 291         description => "The number of CPUs. Please use option -sockets instead.",
 292         minimum => 1,
 293         default => 1,
 294     },
 295     sockets => {
 296         optional => 1,
 297         type => 'integer',
 298         description => "The number of CPU sockets.",
 299         minimum => 1,
 300         default => 1,
 301     },
 302     cores => {
 303         optional => 1,
 304         type => 'integer',
 305         description => "The number of cores per socket.",
 306         minimum => 1,
 307         default => 1,
 308     },
 309     numa => {
 310         optional => 1,
 311         type => 'boolean',
 312         description => "Enable/disable Numa.",
 313         default => 0,
 314     },
 315     maxcpus => {
 316         optional => 1,
 317         type => 'integer',
 318         description => "Maximum cpus for hotplug.",
 319         minimum => 1,
 320         default => 1,
 321     },
 322     acpi => {
 323         optional => 1,
 324         type => 'boolean',
 325         description => "Enable/disable ACPI.",
 326         default => 1,
 327     },
 328     agent => {
 329         optional => 1,
 330         type => 'boolean',
 331         description => "Enable/disable Qemu GuestAgent.",
 332         default => 0,
 333     },
 334     kvm => {
 335         optional => 1,
 336         type => 'boolean',
 337         description => "Enable/disable KVM hardware virtualization.",
 338         default => 1,
 339     },
 340     tdf => {
 341         optional => 1,
 342         type => 'boolean',
 343         description => "Enable/disable time drift fix.",
 344         default => 0,
 345     },
 346     localtime => {
 347         optional => 1,
 348         type => 'boolean',
 349         description => "Set the real time clock to local time. This is enabled by default if ostype indicates a Microsoft OS.",
 350     },
 351     freeze => {
 352         optional => 1,
 353         type => 'boolean',
 354         description => "Freeze CPU at startup (use 'c' monitor command to start execution).",
 355     },
 356     vga => {
 357         optional => 1,
 358         type => 'string',
 359         description => "Select VGA type. If you want to use high resolution modes (>= 1280x1024x16) then you should use option 'std' or 'vmware'. Default is 'std' for win8/win7/w2k8, and 'cirrur' for other OS types. Option 'qxl' enables the SPICE display sever. You can also run without any graphic card using a serial devive as terminal.",
 360         enum => [qw(std cirrus vmware qxl serial0 serial1 serial2 serial3 qxl2 qxl3 qxl4)],
 361     },
 362     watchdog => {
 363         optional => 1,
 364         type => 'string', format => 'pve-qm-watchdog',
 365         typetext => '[[model=]i6300esb|ib700] [,[action=]reset|shutdown|poweroff|pause|debug|none]',
 366         description => "Create a virtual hardware watchdog device.  Once enabled (by a guest action), the watchdog must be periodically polled by an agent inside the guest or else the guest will be restarted (or execute the action specified)",
 367     },
 368     startdate => {
 369         optional => 1,
 370         type => 'string',
 371         typetext => "(now | YYYY-MM-DD | YYYY-MM-DDTHH:MM:SS)",
 372         description => "Set the initial date of the real time clock. Valid format for date are: 'now' or '2006-06-17T16:01:21' or '2006-06-17'.",
 373         pattern => '(now|\d{4}-\d{1,2}-\d{1,2}(T\d{1,2}:\d{1,2}:\d{1,2})?)',
 374         default => 'now',
 375     },
 376     startup => {
 377         optional => 1,
 378         type => 'string', format => 'pve-qm-startup',
 379         typetext => '[[order=]\d+] [,up=\d+] [,down=\d+] ',
 380         description => "Startup and shutdown behavior. Order is a non-negative number defining the general startup order. Shutdown in done with reverse ordering. Additionally you can set the 'up' or 'down' delay in seconds, which specifies a delay to wait before the next VM is started or stopped.",
 381     },
 382     template => {
 383         optional => 1,
 384         type => 'boolean',
 385         description => "Enable/disable Template.",
 386         default => 0,
 387     },
 388     args => {
 389         optional => 1,
 390         type => 'string',
 391         description => <<EODESCR,
 392 Note: this option is for experts only. It allows you to pass arbitrary arguments to kvm, for example:
 393
 394 args: -no-reboot -no-hpet
 395 EODESCR
 396     },
 397     tablet => {
 398         optional => 1,
 399         type => 'boolean',
 400         default => 1,
 401         description => "Enable/disable the usb tablet device. This device is usually needed to allow absolute mouse positioning with VNC. Else the mouse runs out of sync with normal VNC clients. If you're running lots of console-only guests on one host, you may consider disabling this to save some context switches. This is turned of by default if you use spice (vga=qxl).",
 402     },
 403     migrate_speed => {
 404         optional => 1,
 405         type => 'integer',
 406         description => "Set maximum speed (in MB/s) for migrations. Value 0 is no limit.",
 407         minimum => 0,
 408         default => 0,
 409     },
 410     migrate_downtime => {
 411         optional => 1,
 412         type => 'number',
 413         description => "Set maximum tolerated downtime (in seconds) for migrations.",
 414         minimum => 0,
 415         default => 0.1,
 416     },
 417     cdrom => {
 418         optional => 1,
 419         type => 'string', format => 'pve-qm-drive',
 420         typetext => 'volume',
 421         description => "This is an alias for option -ide2",
 422     },
 423     cpu => {
 424         optional => 1,
 425         description => "Emulated CPU type.",
 426         type => 'string',
 427         enum => [ qw(486 athlon pentium pentium2 pentium3 coreduo core2duo kvm32 kvm64 qemu32 qemu64 phenom Conroe Penryn Nehalem Westmere SandyBridge Haswell Broadwell Opteron_G1 Opteron_G2 Opteron_G3 Opteron_G4 Opteron_G5 host) ],
 428         default => 'kvm64',
 429     },
 430     parent => get_standard_option('pve-snapshot-name', {
 431         optional => 1,
 432         description => "Parent snapshot name. This is used internally, and should not be modified.",
 433     }),
 434     snaptime => {
 435         optional => 1,
 436         description => "Timestamp for snapshots.",
 437         type => 'integer',
 438         minimum => 0,
 439     },
 440     vmstate => {
 441         optional => 1,
 442         type => 'string', format => 'pve-volume-id',
 443         description => "Reference to a volume which stores the VM state. This is used internally for snapshots.",
 444     },
 445     machine => {
 446         description => "Specific the Qemu machine type.",
 447         type => 'string',
 448         pattern => '(pc|pc(-i440fx)?-\d+\.\d+|q35|pc-q35-\d+\.\d+)',
 449         maxLength => 40,
 450         optional => 1,
 451     },
 452     smbios1 => {
 453         description => "Specify SMBIOS type 1 fields.",
 454         type => 'string', format => 'pve-qm-smbios1',
 455         typetext => "[manufacturer=str][,product=str][,version=str][,serial=str] [,uuid=uuid][,sku=str][,family=str]",
 456         maxLength => 256,
 457         optional => 1,
 458     },
 459 };
 460
 461 # what about other qemu settings ?
 462 #cpu => 'string',
 463 #machine => 'string',
 464 #fda => 'file',
 465 #fdb => 'file',
 466 #mtdblock => 'file',
 467 #sd => 'file',
 468 #pflash => 'file',
 469 #snapshot => 'bool',
 470 #bootp => 'file',
 471 ##tftp => 'dir',
 472 ##smb => 'dir',
 473 #kernel => 'file',
 474 #append => 'string',
 475 #initrd => 'file',
 476 ##soundhw => 'string',
 477
 478 while (my ($k, $v) = each %$confdesc) {
 479     PVE::JSONSchema::register_standard_option("pve-qm-$k", $v);
 480 }
 481
 482 my $MAX_IDE_DISKS = 4;
 483 my $MAX_SCSI_DISKS = 14;
 484 my $MAX_VIRTIO_DISKS = 16;
 485 my $MAX_SATA_DISKS = 6;
 486 my $MAX_USB_DEVICES = 5;
 487 my $MAX_NETS = 32;
 488 my $MAX_UNUSED_DISKS = 8;
 489 my $MAX_HOSTPCI_DEVICES = 4;
 490 my $MAX_SERIAL_PORTS = 4;
 491 my $MAX_PARALLEL_PORTS = 3;
 492 my $MAX_NUMA = 8;
 493
 494 my $numadesc = {
 495     optional => 1,
 496     type => 'string', format => 'pve-qm-numanode',
 497     typetext => "cpus=<id[-id],memory=<mb>[[,hostnodes=<id[-id]>] [,policy=<preferred|bind|interleave>]]",
 498     description => "numa topology",
 499 };
 500 PVE::JSONSchema::register_standard_option("pve-qm-numanode", $numadesc);
 501
 502 for (my $i = 0; $i < $MAX_NUMA; $i++)  {
 503     $confdesc->{"numa$i"} = $numadesc;
 504 }
 505
 506 my $nic_model_list = ['rtl8139', 'ne2k_pci', 'e1000',  'pcnet',  'virtio',
 507                       'ne2k_isa', 'i82551', 'i82557b', 'i82559er', 'vmxnet3',
 508                       'e1000-82540em', 'e1000-82544gc', 'e1000-82545em'];
 509 my $nic_model_list_txt = join(' ', sort @$nic_model_list);
 510
 511 my $netdesc = {
 512     optional => 1,
 513     type => 'string', format => 'pve-qm-net',
 514     typetext => "MODEL=XX:XX:XX:XX:XX:XX [,bridge=<dev>][,queues=<nbqueues>][,rate=<mbps>] [,tag=<vlanid>][,firewall=0|1],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 vm_deviceplug {
3158     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
3159
3160     die "internal error" if !$conf->{hotplug};
3161
3162     my $q35 = machine_type_is_q35($conf);
3163
3164     my $devices_list = vm_devices_list($vmid);
3165     return 1 if defined($devices_list->{$deviceid});
3166
3167     qemu_add_pci_bridge($storecfg, $conf, $vmid, $deviceid); # add PCI bridge if we need it for the device
3168
3169     if ($deviceid eq 'tablet') {
3170
3171         qemu_deviceadd($vmid, print_tabletdevice_full($conf));
3172
3173     } elsif ($deviceid =~ m/^(virtio)(\d+)$/) {
3174
3175         qemu_driveadd($storecfg, $vmid, $device);
3176         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
3177
3178         qemu_deviceadd($vmid, $devicefull);
3179         eval { qemu_deviceaddverify($vmid, $deviceid); };
3180         if (my $err = $@) {
3181             eval { qemu_drivedel($vmid, $deviceid); };
3182             warn $@ if $@;
3183             die $err;
3184         }
3185
3186     } elsif ($deviceid =~ m/^(scsihw)(\d+)$/) {
3187
3188         my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : "lsi";
3189         my $pciaddr = print_pci_addr($deviceid);
3190         my $devicefull = "$scsihw,id=$deviceid$pciaddr";
3191
3192         qemu_deviceadd($vmid, $devicefull);
3193         qemu_deviceaddverify($vmid, $deviceid);
3194
3195     } elsif ($deviceid =~ m/^(scsi)(\d+)$/) {
3196
3197         qemu_findorcreatescsihw($storecfg,$conf, $vmid, $device);
3198         qemu_driveadd($storecfg, $vmid, $device);
3199
3200         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
3201         eval { qemu_deviceadd($vmid, $devicefull); };
3202         if (my $err = $@) {
3203             eval { qemu_drivedel($vmid, $deviceid); };
3204             warn $@ if $@;
3205             die $err;
3206         }
3207
3208     } elsif ($deviceid =~ m/^(net)(\d+)$/) {
3209
3210         return undef if !qemu_netdevadd($vmid, $conf, $device, $deviceid);
3211         my $netdevicefull = print_netdevice_full($vmid, $conf, $device, $deviceid);
3212         qemu_deviceadd($vmid, $netdevicefull);
3213         eval { qemu_deviceaddverify($vmid, $deviceid); };
3214         if (my $err = $@) {
3215             eval { qemu_netdevdel($vmid, $deviceid); };
3216             warn $@ if $@;
3217             die $err;
3218         }
3219
3220     } elsif (!$q35 && $deviceid =~ m/^(pci\.)(\d+)$/) {
3221
3222         my $bridgeid = $2;
3223         my $pciaddr = print_pci_addr($deviceid);
3224         my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
3225
3226         qemu_deviceadd($vmid, $devicefull);
3227         qemu_deviceaddverify($vmid, $deviceid);
3228
3229     } else {
3230         die "can't hotplug device '$deviceid'\n";
3231     }
3232
3233     return 1;
3234 }
3235
3236 # fixme: this should raise exceptions on error!
3237 sub vm_deviceunplug {
3238     my ($vmid, $conf, $deviceid) = @_;
3239
3240     die "internal error" if !$conf->{hotplug};
3241
3242     my $devices_list = vm_devices_list($vmid);
3243     return 1 if !defined($devices_list->{$deviceid});
3244
3245     die "can't unplug bootdisk" if $conf->{bootdisk} && $conf->{bootdisk} eq $deviceid;
3246
3247     if ($deviceid eq 'tablet') {
3248
3249         qemu_devicedel($vmid, $deviceid);
3250
3251     } elsif ($deviceid =~ m/^(virtio)(\d+)$/) {
3252
3253         qemu_devicedel($vmid, $deviceid);
3254         qemu_devicedelverify($vmid, $deviceid);
3255         qemu_drivedel($vmid, $deviceid);
3256
3257     } elsif ($deviceid =~ m/^(lsi)(\d+)$/) {
3258
3259         qemu_devicedel($vmid, $deviceid);
3260
3261     } elsif ($deviceid =~ m/^(scsi)(\d+)$/) {
3262
3263         qemu_devicedel($vmid, $deviceid);
3264         qemu_drivedel($vmid, $deviceid);
3265
3266     } elsif ($deviceid =~ m/^(net)(\d+)$/) {
3267
3268         qemu_devicedel($vmid, $deviceid);
3269         qemu_devicedelverify($vmid, $deviceid);
3270         qemu_netdevdel($vmid, $deviceid);
3271
3272     } else {
3273         die "can't unplug device '$deviceid'\n";
3274     }
3275
3276     return 1;
3277 }
3278
3279 sub qemu_deviceadd {
3280     my ($vmid, $devicefull) = @_;
3281
3282     $devicefull = "driver=".$devicefull;
3283     my %options =  split(/[=,]/, $devicefull);
3284
3285     vm_mon_cmd($vmid, "device_add" , %options);
3286 }
3287
3288 sub qemu_devicedel {
3289     my ($vmid, $deviceid) = @_;
3290
3291     my $ret = vm_mon_cmd($vmid, "device_del", id => $deviceid);
3292 }
3293
3294 sub qemu_driveadd {
3295     my ($storecfg, $vmid, $device) = @_;
3296
3297     my $drive = print_drive_full($storecfg, $vmid, $device);
3298     my $ret = vm_human_monitor_command($vmid, "drive_add auto $drive");
3299
3300     # If the command succeeds qemu prints: "OK"
3301     return 1 if $ret =~ m/OK/s;
3302
3303     die "adding drive failed: $ret\n";
3304 }
3305
3306 sub qemu_drivedel {
3307     my($vmid, $deviceid) = @_;
3308
3309     my $ret = vm_human_monitor_command($vmid, "drive_del drive-$deviceid");
3310     $ret =~ s/^\s+//;
3311
3312     return 1 if $ret eq "";
3313
3314     # NB: device not found errors mean the drive was auto-deleted and we ignore the error
3315     return 1 if $ret =~ m/Device \'.*?\' not found/s;
3316
3317     die "deleting drive $deviceid failed : $ret\n";
3318 }
3319
3320 sub qemu_deviceaddverify {
3321     my ($vmid, $deviceid) = @_;
3322
3323     for (my $i = 0; $i <= 5; $i++) {
3324          my $devices_list = vm_devices_list($vmid);
3325          return 1 if defined($devices_list->{$deviceid});
3326          sleep 1;
3327     }
3328
3329     die "error on hotplug device '$deviceid'\n";
3330 }
3331
3332
3333 sub qemu_devicedelverify {
3334     my ($vmid, $deviceid) = @_;
3335
3336     # need to verify that the device is correctly removed as device_del
3337     # is async and empty return is not reliable
3338
3339     for (my $i = 0; $i <= 5; $i++) {
3340          my $devices_list = vm_devices_list($vmid);
3341          return 1 if !defined($devices_list->{$deviceid});
3342          sleep 1;
3343     }
3344
3345     die "error on hot-unplugging device '$deviceid'\n";
3346 }
3347
3348 sub qemu_findorcreatescsihw {
3349     my ($storecfg, $conf, $vmid, $device) = @_;
3350
3351     my $maxdev = ($conf->{scsihw} && ($conf->{scsihw} !~ m/^lsi/)) ? 256 : 7;
3352     my $controller = int($device->{index} / $maxdev);
3353     my $scsihwid="scsihw$controller";
3354     my $devices_list = vm_devices_list($vmid);
3355
3356     if(!defined($devices_list->{$scsihwid})) {
3357         vm_deviceplug($storecfg, $conf, $vmid, $scsihwid);
3358     }
3359
3360     return 1;
3361 }
3362
3363 sub qemu_add_pci_bridge {
3364     my ($storecfg, $conf, $vmid, $device) = @_;
3365
3366     my $bridges = {};
3367
3368     my $bridgeid;
3369
3370     print_pci_addr($device, $bridges);
3371
3372     while (my ($k, $v) = each %$bridges) {
3373         $bridgeid = $k;
3374     }
3375     return 1 if !defined($bridgeid) || $bridgeid < 1;
3376
3377     my $bridge = "pci.$bridgeid";
3378     my $devices_list = vm_devices_list($vmid);
3379
3380     if (!defined($devices_list->{$bridge})) {
3381         vm_deviceplug($storecfg, $conf, $vmid, $bridge);
3382     }
3383
3384     return 1;
3385 }
3386
3387 sub qemu_set_link_status {
3388     my ($vmid, $device, $up) = @_;
3389
3390     vm_mon_cmd($vmid, "set_link", name => $device,
3391                up => $up ? JSON::true : JSON::false);
3392 }
3393
3394 sub qemu_netdevadd {
3395     my ($vmid, $conf, $device, $deviceid) = @_;
3396
3397     my $netdev = print_netdev_full($vmid, $conf, $device, $deviceid);
3398     my %options =  split(/[=,]/, $netdev);
3399
3400     vm_mon_cmd($vmid, "netdev_add",  %options);
3401     return 1;
3402 }
3403
3404 sub qemu_netdevdel {
3405     my ($vmid, $deviceid) = @_;
3406
3407     vm_mon_cmd($vmid, "netdev_del", id => $deviceid);
3408 }
3409
3410 sub qemu_cpu_hotplug {
3411     my ($vmid, $conf, $cores) = @_;
3412
3413     my $sockets = $conf->{sockets} || 1;
3414     die "cpu hotplug only works with one socket\n"
3415         if $sockets > 1;
3416
3417     die "maxcpus is not defined\n"
3418         if !$conf->{maxcpus};
3419
3420     die "you can't add more cores than maxcpus\n"
3421         if $cores > $conf->{maxcpus};
3422
3423     my $currentcores = $conf->{cores} || 1;
3424     die "online cpu unplug is not yet possible\n"
3425         if $cores < $currentcores;
3426
3427     my $currentrunningcores = vm_mon_cmd($vmid, "query-cpus");
3428     die "cores number if running vm is different than configuration\n"
3429         if scalar(@{$currentrunningcores}) != $currentcores;
3430
3431     for (my $i = $currentcores; $i < $cores; $i++) {
3432         vm_mon_cmd($vmid, "cpu-add", id => int($i));
3433     }
3434 }
3435
3436 sub qemu_block_set_io_throttle {
3437     my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
3438
3439     return if !check_running($vmid) ;
3440
3441     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));
3442
3443 }
3444
3445 # old code, only used to shutdown old VM after update
3446 sub __read_avail {
3447     my ($fh, $timeout) = @_;
3448
3449     my $sel = new IO::Select;
3450     $sel->add($fh);
3451
3452     my $res = '';
3453     my $buf;
3454
3455     my @ready;
3456     while (scalar (@ready = $sel->can_read($timeout))) {
3457         my $count;
3458         if ($count = $fh->sysread($buf, 8192)) {
3459             if ($buf =~ /^(.*)\(qemu\) $/s) {
3460                 $res .= $1;
3461                 last;
3462             } else {
3463                 $res .= $buf;
3464             }
3465         } else {
3466             if (!defined($count)) {
3467                 die "$!\n";
3468             }
3469             last;
3470         }
3471     }
3472
3473     die "monitor read timeout\n" if !scalar(@ready);
3474
3475     return $res;
3476 }
3477
3478 # old code, only used to shutdown old VM after update
3479 sub vm_monitor_command {
3480     my ($vmid, $cmdstr, $nocheck) = @_;
3481
3482     my $res;
3483
3484     eval {
3485         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
3486
3487         my $sname = "${var_run_tmpdir}/$vmid.mon";
3488
3489         my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
3490             die "unable to connect to VM $vmid socket - $!\n";
3491
3492         my $timeout = 3;
3493
3494         # hack: migrate sometime blocks the monitor (when migrate_downtime
3495         # is set)
3496         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3497             $timeout = 60*60; # 1 hour
3498         }
3499
3500         # read banner;
3501         my $data = __read_avail($sock, $timeout);
3502
3503         if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
3504             die "got unexpected qemu monitor banner\n";
3505         }
3506
3507         my $sel = new IO::Select;
3508         $sel->add($sock);
3509
3510         if (!scalar(my @ready = $sel->can_write($timeout))) {
3511             die "monitor write error - timeout";
3512         }
3513
3514         my $fullcmd = "$cmdstr\r";
3515
3516         # syslog('info', "VM $vmid monitor command: $cmdstr");
3517
3518         my $b;
3519         if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
3520             die "monitor write error - $!";
3521         }
3522
3523         return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
3524
3525         $timeout = 20;
3526
3527         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3528             $timeout = 60*60; # 1 hour
3529         } elsif ($cmdstr =~ m/^(eject|change)/) {
3530             $timeout = 60; # note: cdrom mount command is slow
3531         }
3532         if ($res = __read_avail($sock, $timeout)) {
3533
3534             my @lines = split("\r?\n", $res);
3535
3536             shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
3537
3538             $res = join("\n", @lines);
3539             $res .= "\n";
3540         }
3541     };
3542
3543     my $err = $@;
3544
3545     if ($err) {
3546         syslog("err", "VM $vmid monitor command failed - $err");
3547         die $err;
3548     }
3549
3550     return $res;
3551 }
3552
3553 sub qemu_block_resize {
3554     my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
3555
3556     my $running = check_running($vmid);
3557
3558     return if !PVE::Storage::volume_resize($storecfg, $volid, $size, $running);
3559
3560     return if !$running;
3561
3562     vm_mon_cmd($vmid, "block_resize", device => $deviceid, size => int($size));
3563
3564 }
3565
3566 sub qemu_volume_snapshot {
3567     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3568
3569     my $running = check_running($vmid);
3570
3571     return if !PVE::Storage::volume_snapshot($storecfg, $volid, $snap, $running);
3572
3573     return if !$running;
3574
3575     vm_mon_cmd($vmid, "snapshot-drive", device => $deviceid, name => $snap);
3576
3577 }
3578
3579 sub qemu_volume_snapshot_delete {
3580     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3581
3582     my $running = check_running($vmid);
3583
3584     return if !PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snap, $running);
3585
3586     return if !$running;
3587
3588     vm_mon_cmd($vmid, "delete-drive-snapshot", device => $deviceid, name => $snap);
3589 }
3590
3591 sub set_migration_caps {
3592     my ($vmid) = @_;
3593
3594     my $cap_ref = [];
3595
3596     my $enabled_cap = {
3597         "auto-converge" => 1,
3598         "xbzrle" => 0,
3599         "x-rdma-pin-all" => 0,
3600         "zero-blocks" => 0,
3601     };
3602
3603     my $supported_capabilities = vm_mon_cmd_nocheck($vmid, "query-migrate-capabilities");
3604
3605     for my $supported_capability (@$supported_capabilities) {
3606         push @$cap_ref, {
3607             capability => $supported_capability->{capability},
3608             state => $enabled_cap->{$supported_capability->{capability}} ? JSON::true : JSON::false,
3609         };
3610     }
3611
3612     vm_mon_cmd_nocheck($vmid, "migrate-set-capabilities", capabilities => $cap_ref);
3613 }
3614
3615 my $fast_plug_option = {
3616     'name' => 1,
3617     'hotplug' => 1,
3618     'onboot' => 1,
3619     'shares' => 1,
3620     'startup' => 1,
3621 };
3622
3623 # hotplug changes in [PENDING]
3624 # $selection hash can be used to only apply specified options, for
3625 # example: { cores => 1 } (only apply changed 'cores')
3626 # $errors ref is used to return error messages
3627 sub vmconfig_hotplug_pending {
3628     my ($vmid, $conf, $storecfg, $selection, $errors) = @_;
3629
3630     my $defaults = load_defaults();
3631
3632     # commit values which do not have any impact on running VM first
3633     # Note: those option cannot raise errors, we we do not care about
3634     # $selection and always apply them.
3635
3636     my $add_error = sub {
3637         my ($opt, $msg) = @_;
3638         $errors->{$opt} = "hotplug problem - $msg";
3639     };
3640
3641     my $changes = 0;
3642     foreach my $opt (keys %{$conf->{pending}}) { # add/change
3643         if ($fast_plug_option->{$opt}) {
3644             $conf->{$opt} = $conf->{pending}->{$opt};
3645             delete $conf->{pending}->{$opt};
3646             $changes = 1;
3647         }
3648     }
3649
3650     if ($changes) {
3651         update_config_nolock($vmid, $conf, 1);
3652         $conf = load_config($vmid); # update/reload
3653     }
3654
3655     my $hotplug = defined($conf->{hotplug}) ? $conf->{hotplug} : $defaults->{hotplug};
3656
3657     my @delete = PVE::Tools::split_list($conf->{pending}->{delete});
3658     foreach my $opt (@delete) {
3659         next if $selection && !$selection->{$opt};
3660         eval {
3661             if ($opt eq 'tablet') {
3662                 die "skip\n" if !$hotplug;
3663                 if ($defaults->{tablet}) {
3664                     vm_deviceplug($storecfg, $conf, $vmid, $opt);
3665                 } else {
3666                     vm_deviceunplug($vmid, $conf, $opt);
3667                 }
3668             } elsif ($opt eq 'cores') {
3669                 die "skip\n" if !$hotplug;
3670                 qemu_cpu_hotplug($vmid, $conf, 1);
3671             } elsif ($opt eq 'balloon') {
3672                 # enable balloon device is not hotpluggable
3673                 die "skip\n" if !defined($conf->{balloon}) || $conf->{balloon};
3674             } elsif ($fast_plug_option->{$opt}) {
3675                 # do nothing
3676             } elsif ($opt =~ m/^net(\d+)$/) {
3677                 die "skip\n" if !$hotplug;
3678                 vm_deviceunplug($vmid, $conf, $opt);
3679             } elsif (valid_drivename($opt)) {
3680                 die "skip\n" if !$hotplug || $opt =~ m/(ide|sata)(\d+)/;
3681                 vm_deviceunplug($vmid, $conf, $opt);
3682                 vmconfig_register_unused_drive($storecfg, $vmid, $conf, parse_drive($opt, $conf->{$opt}));
3683             } else {
3684                 die "skip\n";
3685             }
3686         };
3687         if (my $err = $@) {
3688             &$add_error($opt, $err) if $err ne "skip\n";
3689         } else {
3690             # save new config if hotplug was successful
3691             delete $conf->{$opt};
3692             vmconfig_undelete_pending_option($conf, $opt);
3693             update_config_nolock($vmid, $conf, 1);
3694             $conf = load_config($vmid); # update/reload
3695         }
3696     }
3697
3698     foreach my $opt (keys %{$conf->{pending}}) {
3699         next if $selection && !$selection->{$opt};
3700         my $value = $conf->{pending}->{$opt};
3701         eval {
3702             if ($opt eq 'tablet') {
3703                 die "skip\n" if !$hotplug;
3704                 if ($value == 1) {
3705                     vm_deviceplug($storecfg, $conf, $vmid, $opt);
3706                 } elsif ($value == 0) {
3707                     vm_deviceunplug($vmid, $conf, $opt);
3708                 }
3709             } elsif ($opt eq 'cores') {
3710                 die "skip\n" if !$hotplug;
3711                 qemu_cpu_hotplug($vmid, $conf, $value);
3712             } elsif ($opt eq 'balloon') {
3713                 # enable/disable balloning device is not hotpluggable
3714                 my $old_balloon_enabled =  !!(!defined($conf->{balloon}) || $conf->{balloon});
3715                 my $new_balloon_enabled =  !!(!defined($conf->{pending}->{balloon}) || $conf->{pending}->{balloon});
3716                 die "skip\n" if $old_balloon_enabled != $new_balloon_enabled;
3717
3718                 # allow manual ballooning if shares is set to zero
3719                 if (!(defined($conf->{shares}) && ($conf->{shares} == 0))) {
3720                     my $balloon = $conf->{pending}->{balloon} || $conf->{memory} || $defaults->{memory};
3721                     vm_mon_cmd($vmid, "balloon", value => $balloon*1024*1024);
3722                 }
3723             } elsif ($opt =~ m/^net(\d+)$/) {
3724                 # some changes can be done without hotplug
3725                 vmconfig_update_net($storecfg, $conf, $vmid, $opt, $value);
3726             } elsif (valid_drivename($opt)) {
3727                 # some changes can be done without hotplug
3728                 vmconfig_update_disk($storecfg, $conf, $vmid, $opt, $value, 1);
3729             } else {
3730                 die "skip\n";  # skip non-hot-pluggable options
3731             }
3732         };
3733         if (my $err = $@) {
3734             &$add_error($opt, $err) if $err ne "skip\n";
3735         } else {
3736             # save new config if hotplug was successful
3737             $conf->{$opt} = $value;
3738             delete $conf->{pending}->{$opt};
3739             update_config_nolock($vmid, $conf, 1);
3740             $conf = load_config($vmid); # update/reload
3741         }
3742     }
3743 }
3744
3745 sub vmconfig_apply_pending {
3746     my ($vmid, $conf, $storecfg) = @_;
3747
3748     # cold plug
3749
3750     my @delete = PVE::Tools::split_list($conf->{pending}->{delete});
3751     foreach my $opt (@delete) { # delete
3752         die "internal error" if $opt =~ m/^unused/;
3753         $conf = load_config($vmid); # update/reload
3754         if (!defined($conf->{$opt})) {
3755             vmconfig_undelete_pending_option($conf, $opt);
3756             update_config_nolock($vmid, $conf, 1);
3757         } elsif (valid_drivename($opt)) {
3758             vmconfig_register_unused_drive($storecfg, $vmid, $conf, parse_drive($opt, $conf->{$opt}));
3759             vmconfig_undelete_pending_option($conf, $opt);
3760             delete $conf->{$opt};
3761             update_config_nolock($vmid, $conf, 1);
3762         } else {
3763             vmconfig_undelete_pending_option($conf, $opt);
3764             delete $conf->{$opt};
3765             update_config_nolock($vmid, $conf, 1);
3766         }
3767     }
3768
3769     $conf = load_config($vmid); # update/reload
3770
3771     foreach my $opt (keys %{$conf->{pending}}) { # add/change
3772         $conf = load_config($vmid); # update/reload
3773
3774         if (defined($conf->{$opt}) && ($conf->{$opt} eq $conf->{pending}->{$opt})) {
3775             # skip if nothing changed
3776         } elsif (valid_drivename($opt)) {
3777             vmconfig_register_unused_drive($storecfg, $vmid, $conf, parse_drive($opt, $conf->{$opt}))
3778                 if defined($conf->{$opt});
3779             $conf->{$opt} = $conf->{pending}->{$opt};
3780         } else {
3781             $conf->{$opt} = $conf->{pending}->{$opt};
3782         }
3783
3784         delete $conf->{pending}->{$opt};
3785         update_config_nolock($vmid, $conf, 1);
3786     }
3787 }
3788
3789 my $safe_num_ne = sub {
3790     my ($a, $b) = @_;
3791
3792     return 0 if !defined($a) && !defined($b);
3793     return 1 if !defined($a);
3794     return 1 if !defined($b);
3795
3796     return $a != $b;
3797 };
3798
3799 my $safe_string_ne = sub {
3800     my ($a, $b) = @_;
3801
3802     return 0 if !defined($a) && !defined($b);
3803     return 1 if !defined($a);
3804     return 1 if !defined($b);
3805
3806     return $a ne $b;
3807 };
3808
3809 sub vmconfig_update_net {
3810     my ($storecfg, $conf, $vmid, $opt, $value) = @_;
3811
3812     my $newnet = parse_net($value);
3813
3814     if ($conf->{$opt}) {
3815         my $oldnet = parse_net($conf->{$opt});
3816
3817         if (&$safe_string_ne($oldnet->{model}, $newnet->{model}) ||
3818             &$safe_string_ne($oldnet->{macaddr}, $newnet->{macaddr}) ||
3819             &$safe_num_ne($oldnet->{queues}, $newnet->{queues}) ||
3820             !($newnet->{bridge} && $oldnet->{bridge})) { # bridge/nat mode change
3821
3822             # for non online change, we try to hot-unplug
3823             die "skip\n" if !$conf->{hotplug};
3824             vm_deviceunplug($vmid, $conf, $opt);
3825         } else {
3826
3827             die "internal error" if $opt !~ m/net(\d+)/;
3828             my $iface = "tap${vmid}i$1";
3829
3830             if (&$safe_num_ne($oldnet->{rate}, $newnet->{rate})) {
3831                 PVE::Network::tap_rate_limit($iface, $newnet->{rate});
3832             }
3833
3834             if (&$safe_string_ne($oldnet->{bridge}, $newnet->{bridge}) ||
3835                 &$safe_num_ne($oldnet->{tag}, $newnet->{tag}) ||
3836                 &$safe_num_ne($oldnet->{firewall}, $newnet->{firewall})) {
3837                 PVE::Network::tap_unplug($iface);
3838                 PVE::Network::tap_plug($iface, $newnet->{bridge}, $newnet->{tag}, $newnet->{firewall});
3839             }
3840
3841             if (&$safe_string_ne($oldnet->{link_down}, $newnet->{link_down})) {
3842                 qemu_set_link_status($vmid, $opt, !$newnet->{link_down});
3843             }
3844
3845             return 1;
3846         }
3847     }
3848
3849     if ($conf->{hotplug}) {
3850         vm_deviceplug($storecfg, $conf, $vmid, $opt, $newnet);
3851     } else {
3852         die "skip\n";
3853     }
3854 }
3855
3856 sub vmconfig_update_disk {
3857     my ($storecfg, $conf, $vmid, $opt, $value, $force) = @_;
3858
3859     # fixme: do we need force?
3860
3861     my $drive = parse_drive($opt, $value);
3862
3863     if ($conf->{$opt}) {
3864
3865         if (my $old_drive = parse_drive($opt, $conf->{$opt}))  {
3866
3867             my $media = $drive->{media} || 'disk';
3868             my $oldmedia = $old_drive->{media} || 'disk';
3869             die "unable to change media type\n" if $media ne $oldmedia;
3870
3871             if (!drive_is_cdrom($old_drive)) {
3872
3873                 if ($drive->{file} ne $old_drive->{file}) {
3874
3875                     die "skip\n" if !$conf->{hotplug};
3876
3877                     # unplug and register as unused
3878                     vm_deviceunplug($vmid, $conf, $opt);
3879                     vmconfig_register_unused_drive($storecfg, $vmid, $conf, $old_drive)
3880
3881                 } else {
3882                     # update existing disk
3883
3884                     # skip non hotpluggable value
3885                     if (&$safe_num_ne($drive->{discard}, $old_drive->{discard}) ||
3886                         &$safe_string_ne($drive->{cache}, $old_drive->{cache})) {
3887                         die "skip\n";
3888                     }
3889
3890                     # apply throttle
3891                     if (&$safe_num_ne($drive->{mbps}, $old_drive->{mbps}) ||
3892                         &$safe_num_ne($drive->{mbps_rd}, $old_drive->{mbps_rd}) ||
3893                         &$safe_num_ne($drive->{mbps_wr}, $old_drive->{mbps_wr}) ||
3894                         &$safe_num_ne($drive->{iops}, $old_drive->{iops}) ||
3895                         &$safe_num_ne($drive->{iops_rd}, $old_drive->{iops_rd}) ||
3896                         &$safe_num_ne($drive->{iops_wr}, $old_drive->{iops_wr}) ||
3897                         &$safe_num_ne($drive->{mbps_max}, $old_drive->{mbps_max}) ||
3898                         &$safe_num_ne($drive->{mbps_rd_max}, $old_drive->{mbps_rd_max}) ||
3899                         &$safe_num_ne($drive->{mbps_wr_max}, $old_drive->{mbps_wr_max}) ||
3900                         &$safe_num_ne($drive->{iops_max}, $old_drive->{iops_max}) ||
3901                         &$safe_num_ne($drive->{iops_rd_max}, $old_drive->{iops_rd_max}) ||
3902                         &$safe_num_ne($drive->{iops_wr_max}, $old_drive->{iops_wr_max})) {
3903
3904                         qemu_block_set_io_throttle($vmid,"drive-$opt",
3905                                                    ($drive->{mbps} || 0)*1024*1024,
3906                                                    ($drive->{mbps_rd} || 0)*1024*1024,
3907                                                    ($drive->{mbps_wr} || 0)*1024*1024,
3908                                                    $drive->{iops} || 0,
3909                                                    $drive->{iops_rd} || 0,
3910                                                    $drive->{iops_wr} || 0,
3911                                                    ($drive->{mbps_max} || 0)*1024*1024,
3912                                                    ($drive->{mbps_rd_max} || 0)*1024*1024,
3913                                                    ($drive->{mbps_wr_max} || 0)*1024*1024,
3914                                                    $drive->{iops_max} || 0,
3915                                                    $drive->{iops_rd_max} || 0,
3916                                                    $drive->{iops_wr_max} || 0);
3917
3918                     }
3919
3920                     return 1;
3921                 }
3922             }
3923         }
3924     }
3925
3926     if (drive_is_cdrom($drive)) { # cdrom
3927
3928         if ($drive->{file} eq 'none') {
3929             vm_mon_cmd($vmid, "eject",force => JSON::true,device => "drive-$opt");
3930         } else {
3931             my $path = get_iso_path($storecfg, $vmid, $drive->{file});
3932             vm_mon_cmd($vmid, "eject", force => JSON::true,device => "drive-$opt"); # force eject if locked
3933             vm_mon_cmd($vmid, "change", device => "drive-$opt",target => "$path") if $path;
3934         }
3935
3936     } else {
3937         die "skip\n" if !$conf->{hotplug} || $opt =~ m/(ide|sata)(\d+)/;
3938         # hotplug new disks
3939         vm_deviceplug($storecfg, $conf, $vmid, $opt, $drive);
3940     }
3941 }
3942
3943 sub vm_start {
3944     my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused, $forcemachine, $spice_ticket) = @_;
3945
3946     lock_config($vmid, sub {
3947         my $conf = load_config($vmid, $migratedfrom);
3948
3949         die "you can't start a vm if it's a template\n" if is_template($conf);
3950
3951         check_lock($conf) if !$skiplock;
3952
3953         die "VM $vmid already running\n" if check_running($vmid, undef, $migratedfrom);
3954
3955         if (!$statefile && scalar(keys %{$conf->{pending}})) {
3956             vmconfig_apply_pending($vmid, $conf, $storecfg);
3957             $conf = load_config($vmid); # update/reload
3958         }
3959
3960         my $defaults = load_defaults();
3961
3962         # set environment variable useful inside network script
3963         $ENV{PVE_MIGRATED_FROM} = $migratedfrom if $migratedfrom;
3964
3965         my ($cmd, $vollist, $spice_port) = config_to_command($storecfg, $vmid, $conf, $defaults, $forcemachine);
3966
3967         my $migrate_port = 0;
3968         my $migrate_uri;
3969         if ($statefile) {
3970             if ($statefile eq 'tcp') {
3971                 my $localip = "localhost";
3972                 my $datacenterconf = PVE::Cluster::cfs_read_file('datacenter.cfg');
3973                 if ($datacenterconf->{migration_unsecure}) {
3974                         my $nodename = PVE::INotify::nodename();
3975                         $localip = PVE::Cluster::remote_node_ip($nodename, 1);
3976                 }
3977                 $migrate_port = PVE::Tools::next_migrate_port();
3978                 $migrate_uri = "tcp:${localip}:${migrate_port}";
3979                 push @$cmd, '-incoming', $migrate_uri;
3980                 push @$cmd, '-S';
3981             } else {
3982                 push @$cmd, '-loadstate', $statefile;
3983             }
3984         } elsif ($paused) {
3985             push @$cmd, '-S';
3986         }
3987
3988         # host pci devices
3989         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
3990           my $d = parse_hostpci($conf->{"hostpci$i"});
3991           next if !$d;
3992           my $pcidevices = $d->{pciid};
3993           foreach my $pcidevice (@$pcidevices) {
3994                 my $pciid = $pcidevice->{id}.".".$pcidevice->{function};
3995
3996                 my $info = pci_device_info("0000:$pciid");
3997                 die "IOMMU not present\n" if !check_iommu_support();
3998                 die "no pci device info for device '$pciid'\n" if !$info;
3999
4000                 if ($d->{driver} && $d->{driver} eq "vfio") {
4001                     die "can't unbind/bind pci group to vfio '$pciid'\n" if !pci_dev_group_bind_to_vfio($pciid);
4002                 } else {
4003                     die "can't unbind/bind to stub pci device '$pciid'\n" if !pci_dev_bind_to_stub($info);
4004                 }
4005
4006                 die "can't reset pci device '$pciid'\n" if $info->{has_fl_reset} and !pci_dev_reset($info);
4007           }
4008         }
4009
4010         PVE::Storage::activate_volumes($storecfg, $vollist);
4011
4012         eval  { run_command($cmd, timeout => $statefile ? undef : 30,
4013                     umask => 0077); };
4014         my $err = $@;
4015         die "start failed: $err" if $err;
4016
4017         print "migration listens on $migrate_uri\n" if $migrate_uri;
4018
4019         if ($statefile && $statefile ne 'tcp')  {
4020             eval { vm_mon_cmd_nocheck($vmid, "cont"); };
4021             warn $@ if $@;
4022         }
4023
4024         if ($migratedfrom) {
4025
4026             eval {
4027                 set_migration_caps($vmid);
4028             };
4029             warn $@ if $@;
4030
4031             if ($spice_port) {
4032                 print "spice listens on port $spice_port\n";
4033                 if ($spice_ticket) {
4034                     vm_mon_cmd_nocheck($vmid, "set_password", protocol => 'spice', password => $spice_ticket);
4035                     vm_mon_cmd_nocheck($vmid, "expire_password", protocol => 'spice', time => "+30");
4036                 }
4037             }
4038
4039         } else {
4040
4041             if (!$statefile && (!defined($conf->{balloon}) || $conf->{balloon})) {
4042                 vm_mon_cmd_nocheck($vmid, "balloon", value => $conf->{balloon}*1024*1024)
4043                     if $conf->{balloon};
4044                 vm_mon_cmd_nocheck($vmid, 'qom-set',
4045                             path => "machine/peripheral/balloon0",
4046                             property => "guest-stats-polling-interval",
4047                             value => 2);
4048             }
4049
4050             foreach my $opt (keys %$conf) {
4051                 next if $opt !~  m/^net\d+$/;
4052                 my $nicconf = parse_net($conf->{$opt});
4053                 qemu_set_link_status($vmid, $opt, 0) if $nicconf->{link_down};
4054             }
4055         }
4056     });
4057 }
4058
4059 sub vm_mon_cmd {
4060     my ($vmid, $execute, %params) = @_;
4061
4062     my $cmd = { execute => $execute, arguments => \%params };
4063     vm_qmp_command($vmid, $cmd);
4064 }
4065
4066 sub vm_mon_cmd_nocheck {
4067     my ($vmid, $execute, %params) = @_;
4068
4069     my $cmd = { execute => $execute, arguments => \%params };
4070     vm_qmp_command($vmid, $cmd, 1);
4071 }
4072
4073 sub vm_qmp_command {
4074     my ($vmid, $cmd, $nocheck) = @_;
4075
4076     my $res;
4077
4078     my $timeout;
4079     if ($cmd->{arguments} && $cmd->{arguments}->{timeout}) {
4080         $timeout = $cmd->{arguments}->{timeout};
4081         delete $cmd->{arguments}->{timeout};
4082     }
4083
4084     eval {
4085         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
4086         my $sname = qmp_socket($vmid);
4087         if (-e $sname) { # test if VM is reasonambe new and supports qmp/qga
4088             my $qmpclient = PVE::QMPClient->new();
4089
4090             $res = $qmpclient->cmd($vmid, $cmd, $timeout);
4091         } elsif (-e "${var_run_tmpdir}/$vmid.mon") {
4092             die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
4093                 if scalar(%{$cmd->{arguments}});
4094             vm_monitor_command($vmid, $cmd->{execute}, $nocheck);
4095         } else {
4096             die "unable to open monitor socket\n";
4097         }
4098     };
4099     if (my $err = $@) {
4100         syslog("err", "VM $vmid qmp command failed - $err");
4101         die $err;
4102     }
4103
4104     return $res;
4105 }
4106
4107 sub vm_human_monitor_command {
4108     my ($vmid, $cmdline) = @_;
4109
4110     my $res;
4111
4112     my $cmd = {
4113         execute => 'human-monitor-command',
4114         arguments => { 'command-line' => $cmdline},
4115     };
4116
4117     return vm_qmp_command($vmid, $cmd);
4118 }
4119
4120 sub vm_commandline {
4121     my ($storecfg, $vmid) = @_;
4122
4123     my $conf = load_config($vmid);
4124
4125     my $defaults = load_defaults();
4126
4127     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
4128
4129     return join(' ', @$cmd);
4130 }
4131
4132 sub vm_reset {
4133     my ($vmid, $skiplock) = @_;
4134
4135     lock_config($vmid, sub {
4136
4137         my $conf = load_config($vmid);
4138
4139         check_lock($conf) if !$skiplock;
4140
4141         vm_mon_cmd($vmid, "system_reset");
4142     });
4143 }
4144
4145 sub get_vm_volumes {
4146     my ($conf) = @_;
4147
4148     my $vollist = [];
4149     foreach_volid($conf, sub {
4150         my ($volid, $is_cdrom) = @_;
4151
4152         return if $volid =~ m|^/|;
4153
4154         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
4155         return if !$sid;
4156
4157         push @$vollist, $volid;
4158     });
4159
4160     return $vollist;
4161 }
4162
4163 sub vm_stop_cleanup {
4164     my ($storecfg, $vmid, $conf, $keepActive) = @_;
4165
4166     eval {
4167         fairsched_rmnod($vmid); # try to destroy group
4168
4169         if (!$keepActive) {
4170             my $vollist = get_vm_volumes($conf);
4171             PVE::Storage::deactivate_volumes($storecfg, $vollist);
4172         }
4173
4174         foreach my $ext (qw(mon qmp pid vnc qga)) {
4175             unlink "/var/run/qemu-server/${vmid}.$ext";
4176         }
4177     };
4178     warn $@ if $@; # avoid errors - just warn
4179 }
4180
4181 # Note: use $nockeck to skip tests if VM configuration file exists.
4182 # We need that when migration VMs to other nodes (files already moved)
4183 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
4184 sub vm_stop {
4185     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
4186
4187     $force = 1 if !defined($force) && !$shutdown;
4188
4189     if ($migratedfrom){
4190         my $pid = check_running($vmid, $nocheck, $migratedfrom);
4191         kill 15, $pid if $pid;
4192         my $conf = load_config($vmid, $migratedfrom);
4193         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive);
4194         return;
4195     }
4196
4197     lock_config($vmid, sub {
4198
4199         my $pid = check_running($vmid, $nocheck);
4200         return if !$pid;
4201
4202         my $conf;
4203         if (!$nocheck) {
4204             $conf = load_config($vmid);
4205             check_lock($conf) if !$skiplock;
4206             if (!defined($timeout) && $shutdown && $conf->{startup}) {
4207                 my $opts = parse_startup($conf->{startup});
4208                 $timeout = $opts->{down} if $opts->{down};
4209             }
4210         }
4211
4212         $timeout = 60 if !defined($timeout);
4213
4214         eval {
4215             if ($shutdown) {
4216                 if (defined($conf) && $conf->{agent}) {
4217                     vm_qmp_command($vmid, { execute => "guest-shutdown" }, $nocheck);
4218                 } else {
4219                     vm_qmp_command($vmid, { execute => "system_powerdown" }, $nocheck);
4220                 }
4221             } else {
4222                 vm_qmp_command($vmid, { execute => "quit" }, $nocheck);
4223             }
4224         };
4225         my $err = $@;
4226
4227         if (!$err) {
4228             my $count = 0;
4229             while (($count < $timeout) && check_running($vmid, $nocheck)) {
4230                 $count++;
4231                 sleep 1;
4232             }
4233
4234             if ($count >= $timeout) {
4235                 if ($force) {
4236                     warn "VM still running - terminating now with SIGTERM\n";
4237                     kill 15, $pid;
4238                 } else {
4239                     die "VM quit/powerdown failed - got timeout\n";
4240                 }
4241             } else {
4242                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
4243                 return;
4244             }
4245         } else {
4246             if ($force) {
4247                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
4248                 kill 15, $pid;
4249             } else {
4250                 die "VM quit/powerdown failed\n";
4251             }
4252         }
4253
4254         # wait again
4255         $timeout = 10;
4256
4257         my $count = 0;
4258         while (($count < $timeout) && check_running($vmid, $nocheck)) {
4259             $count++;
4260             sleep 1;
4261         }
4262
4263         if ($count >= $timeout) {
4264             warn "VM still running - terminating now with SIGKILL\n";
4265             kill 9, $pid;
4266             sleep 1;
4267         }
4268
4269         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
4270    });
4271 }
4272
4273 sub vm_suspend {
4274     my ($vmid, $skiplock) = @_;
4275
4276     lock_config($vmid, sub {
4277
4278         my $conf = load_config($vmid);
4279
4280         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
4281
4282         vm_mon_cmd($vmid, "stop");
4283     });
4284 }
4285
4286 sub vm_resume {
4287     my ($vmid, $skiplock) = @_;
4288
4289     lock_config($vmid, sub {
4290
4291         my $conf = load_config($vmid);
4292
4293         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
4294
4295         vm_mon_cmd($vmid, "cont");
4296     });
4297 }
4298
4299 sub vm_sendkey {
4300     my ($vmid, $skiplock, $key) = @_;
4301
4302     lock_config($vmid, sub {
4303
4304         my $conf = load_config($vmid);
4305
4306         # there is no qmp command, so we use the human monitor command
4307         vm_human_monitor_command($vmid, "sendkey $key");
4308     });
4309 }
4310
4311 sub vm_destroy {
4312     my ($storecfg, $vmid, $skiplock) = @_;
4313
4314     lock_config($vmid, sub {
4315
4316         my $conf = load_config($vmid);
4317
4318         check_lock($conf) if !$skiplock;
4319
4320         if (!check_running($vmid)) {
4321             fairsched_rmnod($vmid); # try to destroy group
4322             destroy_vm($storecfg, $vmid);
4323         } else {
4324             die "VM $vmid is running - destroy failed\n";
4325         }
4326     });
4327 }
4328
4329 # pci helpers
4330
4331 sub file_write {
4332     my ($filename, $buf) = @_;
4333
4334     my $fh = IO::File->new($filename, "w");
4335     return undef if !$fh;
4336
4337     my $res = print $fh $buf;
4338
4339     $fh->close();
4340
4341     return $res;
4342 }
4343
4344 sub pci_device_info {
4345     my ($name) = @_;
4346
4347     my $res;
4348
4349     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
4350     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
4351
4352     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
4353     return undef if !defined($irq) || $irq !~ m/^\d+$/;
4354
4355     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
4356     return undef if !defined($vendor) || $vendor !~ s/^0x//;
4357
4358     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
4359     return undef if !defined($product) || $product !~ s/^0x//;
4360
4361     $res = {
4362         name => $name,
4363         vendor => $vendor,
4364         product => $product,
4365         domain => $domain,
4366         bus => $bus,
4367         slot => $slot,
4368         func => $func,
4369         irq => $irq,
4370         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
4371     };
4372
4373     return $res;
4374 }
4375
4376 sub pci_dev_reset {
4377     my ($dev) = @_;
4378
4379     my $name = $dev->{name};
4380
4381     my $fn = "$pcisysfs/devices/$name/reset";
4382
4383     return file_write($fn, "1");
4384 }
4385
4386 sub pci_dev_bind_to_stub {
4387     my ($dev) = @_;
4388
4389     my $name = $dev->{name};
4390
4391     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
4392     return 1 if -d $testdir;
4393
4394     my $data = "$dev->{vendor} $dev->{product}";
4395     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
4396
4397     my $fn = "$pcisysfs/devices/$name/driver/unbind";
4398     if (!file_write($fn, $name)) {
4399         return undef if -f $fn;
4400     }
4401
4402     $fn = "$pcisysfs/drivers/pci-stub/bind";
4403     if (! -d $testdir) {
4404         return undef if !file_write($fn, $name);
4405     }
4406
4407     return -d $testdir;
4408 }
4409
4410 sub pci_dev_bind_to_vfio {
4411     my ($dev) = @_;
4412
4413     my $name = $dev->{name};
4414
4415     my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4416
4417     if (!-d $vfio_basedir) {
4418         system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4419     }
4420     die "Cannot find vfio-pci module!\n" if !-d $vfio_basedir;
4421
4422     my $testdir = "$vfio_basedir/$name";
4423     return 1 if -d $testdir;
4424
4425     my $data = "$dev->{vendor} $dev->{product}";
4426     return undef if !file_write("$vfio_basedir/new_id", $data);
4427
4428     my $fn = "$pcisysfs/devices/$name/driver/unbind";
4429     if (!file_write($fn, $name)) {
4430         return undef if -f $fn;
4431     }
4432
4433     $fn = "$vfio_basedir/bind";
4434     if (! -d $testdir) {
4435         return undef if !file_write($fn, $name);
4436     }
4437
4438     return -d $testdir;
4439 }
4440
4441 sub pci_dev_group_bind_to_vfio {
4442     my ($pciid) = @_;
4443
4444     my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4445
4446     if (!-d $vfio_basedir) {
4447         system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4448     }
4449     die "Cannot find vfio-pci module!\n" if !-d $vfio_basedir;
4450
4451     # get IOMMU group devices
4452     opendir(my $D, "$pcisysfs/devices/0000:$pciid/iommu_group/devices/") || die "Cannot open iommu_group: $!\n";
4453       my @devs = grep /^0000:/, readdir($D);
4454     closedir($D);
4455
4456     foreach my $pciid (@devs) {
4457         $pciid =~ m/^([:\.\da-f]+)$/ or die "PCI ID $pciid not valid!\n";
4458         my $info = pci_device_info($1);
4459         pci_dev_bind_to_vfio($info) || die "Cannot bind $pciid to vfio\n";
4460     }
4461
4462     return 1;
4463 }
4464
4465 sub print_pci_addr {
4466     my ($id, $bridges) = @_;
4467
4468     my $res = '';
4469     my $devices = {
4470         piix3 => { bus => 0, addr => 1 },
4471         #addr2 : first videocard
4472         balloon0 => { bus => 0, addr => 3 },
4473         watchdog => { bus => 0, addr => 4 },
4474         scsihw0 => { bus => 0, addr => 5 },
4475         scsihw1 => { bus => 0, addr => 6 },
4476         ahci0 => { bus => 0, addr => 7 },
4477         qga0 => { bus => 0, addr => 8 },
4478         spice => { bus => 0, addr => 9 },
4479         virtio0 => { bus => 0, addr => 10 },
4480         virtio1 => { bus => 0, addr => 11 },
4481         virtio2 => { bus => 0, addr => 12 },
4482         virtio3 => { bus => 0, addr => 13 },
4483         virtio4 => { bus => 0, addr => 14 },
4484         virtio5 => { bus => 0, addr => 15 },
4485         hostpci0 => { bus => 0, addr => 16 },
4486         hostpci1 => { bus => 0, addr => 17 },
4487         net0 => { bus => 0, addr => 18 },
4488         net1 => { bus => 0, addr => 19 },
4489         net2 => { bus => 0, addr => 20 },
4490         net3 => { bus => 0, addr => 21 },
4491         net4 => { bus => 0, addr => 22 },
4492         net5 => { bus => 0, addr => 23 },
4493         vga1 => { bus => 0, addr => 24 },
4494         vga2 => { bus => 0, addr => 25 },
4495         vga3 => { bus => 0, addr => 26 },
4496         hostpci2 => { bus => 0, addr => 27 },
4497         hostpci3 => { bus => 0, addr => 28 },
4498         #addr29 : usb-host (pve-usb.cfg)
4499         'pci.1' => { bus => 0, addr => 30 },
4500         'pci.2' => { bus => 0, addr => 31 },
4501         'net6' => { bus => 1, addr => 1 },
4502         'net7' => { bus => 1, addr => 2 },
4503         'net8' => { bus => 1, addr => 3 },
4504         'net9' => { bus => 1, addr => 4 },
4505         'net10' => { bus => 1, addr => 5 },
4506         'net11' => { bus => 1, addr => 6 },
4507         'net12' => { bus => 1, addr => 7 },
4508         'net13' => { bus => 1, addr => 8 },
4509         'net14' => { bus => 1, addr => 9 },
4510         'net15' => { bus => 1, addr => 10 },
4511         'net16' => { bus => 1, addr => 11 },
4512         'net17' => { bus => 1, addr => 12 },
4513         'net18' => { bus => 1, addr => 13 },
4514         'net19' => { bus => 1, addr => 14 },
4515         'net20' => { bus => 1, addr => 15 },
4516         'net21' => { bus => 1, addr => 16 },
4517         'net22' => { bus => 1, addr => 17 },
4518         'net23' => { bus => 1, addr => 18 },
4519         'net24' => { bus => 1, addr => 19 },
4520         'net25' => { bus => 1, addr => 20 },
4521         'net26' => { bus => 1, addr => 21 },
4522         'net27' => { bus => 1, addr => 22 },
4523         'net28' => { bus => 1, addr => 23 },
4524         'net29' => { bus => 1, addr => 24 },
4525         'net30' => { bus => 1, addr => 25 },
4526         'net31' => { bus => 1, addr => 26 },
4527         'virtio6' => { bus => 2, addr => 1 },
4528         'virtio7' => { bus => 2, addr => 2 },
4529         'virtio8' => { bus => 2, addr => 3 },
4530         'virtio9' => { bus => 2, addr => 4 },
4531         'virtio10' => { bus => 2, addr => 5 },
4532         'virtio11' => { bus => 2, addr => 6 },
4533         'virtio12' => { bus => 2, addr => 7 },
4534         'virtio13' => { bus => 2, addr => 8 },
4535         'virtio14' => { bus => 2, addr => 9 },
4536         'virtio15' => { bus => 2, addr => 10 },
4537     };
4538
4539     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
4540            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
4541            my $bus = $devices->{$id}->{bus};
4542            $res = ",bus=pci.$bus,addr=$addr";
4543            $bridges->{$bus} = 1 if $bridges;
4544     }
4545     return $res;
4546
4547 }
4548
4549 sub print_pcie_addr {
4550     my ($id) = @_;
4551
4552     my $res = '';
4553     my $devices = {
4554         hostpci0 => { bus => "ich9-pcie-port-1", addr => 0 },
4555         hostpci1 => { bus => "ich9-pcie-port-2", addr => 0 },
4556         hostpci2 => { bus => "ich9-pcie-port-3", addr => 0 },
4557         hostpci3 => { bus => "ich9-pcie-port-4", addr => 0 },
4558     };
4559
4560     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
4561            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
4562            my $bus = $devices->{$id}->{bus};
4563            $res = ",bus=$bus,addr=$addr";
4564     }
4565     return $res;
4566
4567 }
4568
4569 # vzdump restore implementaion
4570
4571 sub tar_archive_read_firstfile {
4572     my $archive = shift;
4573
4574     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
4575
4576     # try to detect archive type first
4577     my $pid = open (TMP, "tar tf '$archive'|") ||
4578         die "unable to open file '$archive'\n";
4579     my $firstfile = <TMP>;
4580     kill 15, $pid;
4581     close TMP;
4582
4583     die "ERROR: archive contaions no data\n" if !$firstfile;
4584     chomp $firstfile;
4585
4586     return $firstfile;
4587 }
4588
4589 sub tar_restore_cleanup {
4590     my ($storecfg, $statfile) = @_;
4591
4592     print STDERR "starting cleanup\n";
4593
4594     if (my $fd = IO::File->new($statfile, "r")) {
4595         while (defined(my $line = <$fd>)) {
4596             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4597                 my $volid = $2;
4598                 eval {
4599                     if ($volid =~ m|^/|) {
4600                         unlink $volid || die 'unlink failed\n';
4601                     } else {
4602                         PVE::Storage::vdisk_free($storecfg, $volid);
4603                     }
4604                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
4605                 };
4606                 print STDERR "unable to cleanup '$volid' - $@" if $@;
4607             } else {
4608                 print STDERR "unable to parse line in statfile - $line";
4609             }
4610         }
4611         $fd->close();
4612     }
4613 }
4614
4615 sub restore_archive {
4616     my ($archive, $vmid, $user, $opts) = @_;
4617
4618     my $format = $opts->{format};
4619     my $comp;
4620
4621     if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
4622         $format = 'tar' if !$format;
4623         $comp = 'gzip';
4624     } elsif ($archive =~ m/\.tar$/) {
4625         $format = 'tar' if !$format;
4626     } elsif ($archive =~ m/.tar.lzo$/) {
4627         $format = 'tar' if !$format;
4628         $comp = 'lzop';
4629     } elsif ($archive =~ m/\.vma$/) {
4630         $format = 'vma' if !$format;
4631     } elsif ($archive =~ m/\.vma\.gz$/) {
4632         $format = 'vma' if !$format;
4633         $comp = 'gzip';
4634     } elsif ($archive =~ m/\.vma\.lzo$/) {
4635         $format = 'vma' if !$format;
4636         $comp = 'lzop';
4637     } else {
4638         $format = 'vma' if !$format; # default
4639     }
4640
4641     # try to detect archive format
4642     if ($format eq 'tar') {
4643         return restore_tar_archive($archive, $vmid, $user, $opts);
4644     } else {
4645         return restore_vma_archive($archive, $vmid, $user, $opts, $comp);
4646     }
4647 }
4648
4649 sub restore_update_config_line {
4650     my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
4651
4652     return if $line =~ m/^\#qmdump\#/;
4653     return if $line =~ m/^\#vzdump\#/;
4654     return if $line =~ m/^lock:/;
4655     return if $line =~ m/^unused\d+:/;
4656     return if $line =~ m/^parent:/;
4657     return if $line =~ m/^template:/; # restored VM is never a template
4658
4659     if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
4660         # try to convert old 1.X settings
4661         my ($id, $ind, $ethcfg) = ($1, $2, $3);
4662         foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
4663             my ($model, $macaddr) = split(/\=/, $devconfig);
4664             $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $unique;
4665             my $net = {
4666                 model => $model,
4667                 bridge => "vmbr$ind",
4668                 macaddr => $macaddr,
4669             };
4670             my $netstr = print_net($net);
4671
4672             print $outfd "net$cookie->{netcount}: $netstr\n";
4673             $cookie->{netcount}++;
4674         }
4675     } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
4676         my ($id, $netstr) = ($1, $2);
4677         my $net = parse_net($netstr);
4678         $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
4679         $netstr = print_net($net);
4680         print $outfd "$id: $netstr\n";
4681     } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
4682         my $virtdev = $1;
4683         my $value = $3;
4684         if ($line =~ m/backup=no/) {
4685             print $outfd "#$line";
4686         } elsif ($virtdev && $map->{$virtdev}) {
4687             my $di = parse_drive($virtdev, $value);
4688             delete $di->{format}; # format can change on restore
4689             $di->{file} = $map->{$virtdev};
4690             $value = print_drive($vmid, $di);
4691             print $outfd "$virtdev: $value\n";
4692         } else {
4693             print $outfd $line;
4694         }
4695     } else {
4696         print $outfd $line;
4697     }
4698 }
4699
4700 sub scan_volids {
4701     my ($cfg, $vmid) = @_;
4702
4703     my $info = PVE::Storage::vdisk_list($cfg, undef, $vmid);
4704
4705     my $volid_hash = {};
4706     foreach my $storeid (keys %$info) {
4707         foreach my $item (@{$info->{$storeid}}) {
4708             next if !($item->{volid} && $item->{size});
4709             $item->{path} = PVE::Storage::path($cfg, $item->{volid});
4710             $volid_hash->{$item->{volid}} = $item;
4711         }
4712     }
4713
4714     return $volid_hash;
4715 }
4716
4717 sub get_used_paths {
4718     my ($vmid, $storecfg, $conf, $scan_snapshots, $skip_drive) = @_;
4719
4720     my $used_path = {};
4721
4722     my $scan_config = sub {
4723         my ($cref, $snapname) = @_;
4724
4725         foreach my $key (keys %$cref) {
4726             my $value = $cref->{$key};
4727             if (valid_drivename($key)) {
4728                 next if $skip_drive && $key eq $skip_drive;
4729                 my $drive = parse_drive($key, $value);
4730                 next if !$drive || !$drive->{file} || drive_is_cdrom($drive);
4731                 if ($drive->{file} =~ m!^/!) {
4732                     $used_path->{$drive->{file}}++; # = 1;
4733                 } else {
4734                     my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file}, 1);
4735                     next if !$storeid;
4736                     my $scfg = PVE::Storage::storage_config($storecfg, $storeid, 1);
4737                     next if !$scfg;
4738                     my $path = PVE::Storage::path($storecfg, $drive->{file}, $snapname);
4739                     $used_path->{$path}++; # = 1;
4740                 }
4741             }
4742         }
4743     };
4744
4745     &$scan_config($conf);
4746
4747     undef $skip_drive;
4748
4749     if ($scan_snapshots) {
4750         foreach my $snapname (keys %{$conf->{snapshots}}) {
4751             &$scan_config($conf->{snapshots}->{$snapname}, $snapname);
4752         }
4753     }
4754
4755     return $used_path;
4756 }
4757
4758 sub update_disksize {
4759     my ($vmid, $conf, $volid_hash) = @_;
4760
4761     my $changes;
4762
4763     my $used = {};
4764
4765     # Note: it is allowed to define multiple storages with same path (alias), so
4766     # we need to check both 'volid' and real 'path' (two different volid can point
4767     # to the same path).
4768
4769     my $usedpath = {};
4770
4771     # update size info
4772     foreach my $opt (keys %$conf) {
4773         if (valid_drivename($opt)) {
4774             my $drive = parse_drive($opt, $conf->{$opt});
4775             my $volid = $drive->{file};
4776             next if !$volid;
4777
4778             $used->{$volid} = 1;
4779             if ($volid_hash->{$volid} &&
4780                 (my $path = $volid_hash->{$volid}->{path})) {
4781                 $usedpath->{$path} = 1;
4782             }
4783
4784             next if drive_is_cdrom($drive);
4785             next if !$volid_hash->{$volid};
4786
4787             $drive->{size} = $volid_hash->{$volid}->{size};
4788             my $new = print_drive($vmid, $drive);
4789             if ($new ne $conf->{$opt}) {
4790                 $changes = 1;
4791                 $conf->{$opt} = $new;
4792             }
4793         }
4794     }
4795
4796     # remove 'unusedX' entry if volume is used
4797     foreach my $opt (keys %$conf) {
4798         next if $opt !~ m/^unused\d+$/;
4799         my $volid = $conf->{$opt};
4800         my $path = $volid_hash->{$volid}->{path} if $volid_hash->{$volid};
4801         if ($used->{$volid} || ($path && $usedpath->{$path})) {
4802             $changes = 1;
4803             delete $conf->{$opt};
4804         }
4805     }
4806
4807     foreach my $volid (sort keys %$volid_hash) {
4808         next if $volid =~ m/vm-$vmid-state-/;
4809         next if $used->{$volid};
4810         my $path = $volid_hash->{$volid}->{path};
4811         next if !$path; # just to be sure
4812         next if $usedpath->{$path};
4813         $changes = 1;
4814         add_unused_volume($conf, $volid);
4815         $usedpath->{$path} = 1; # avoid to add more than once (aliases)
4816     }
4817
4818     return $changes;
4819 }
4820
4821 sub rescan {
4822     my ($vmid, $nolock) = @_;
4823
4824     my $cfg = PVE::Cluster::cfs_read_file("storage.cfg");
4825
4826     my $volid_hash = scan_volids($cfg, $vmid);
4827
4828     my $updatefn =  sub {
4829         my ($vmid) = @_;
4830
4831         my $conf = load_config($vmid);
4832
4833         check_lock($conf);
4834
4835         my $vm_volids = {};
4836         foreach my $volid (keys %$volid_hash) {
4837             my $info = $volid_hash->{$volid};
4838             $vm_volids->{$volid} = $info if $info->{vmid} && $info->{vmid} == $vmid;
4839         }
4840
4841         my $changes = update_disksize($vmid, $conf, $vm_volids);
4842
4843         update_config_nolock($vmid, $conf, 1) if $changes;
4844     };
4845
4846     if (defined($vmid)) {
4847         if ($nolock) {
4848             &$updatefn($vmid);
4849         } else {
4850             lock_config($vmid, $updatefn, $vmid);
4851         }
4852     } else {
4853         my $vmlist = config_list();
4854         foreach my $vmid (keys %$vmlist) {
4855             if ($nolock) {
4856                 &$updatefn($vmid);
4857             } else {
4858                 lock_config($vmid, $updatefn, $vmid);
4859             }
4860         }
4861     }
4862 }
4863
4864 sub restore_vma_archive {
4865     my ($archive, $vmid, $user, $opts, $comp) = @_;
4866
4867     my $input = $archive eq '-' ? "<&STDIN" : undef;
4868     my $readfrom = $archive;
4869
4870     my $uncomp = '';
4871     if ($comp) {
4872         $readfrom = '-';
4873         my $qarchive = PVE::Tools::shellquote($archive);
4874         if ($comp eq 'gzip') {
4875             $uncomp = "zcat $qarchive|";
4876         } elsif ($comp eq 'lzop') {
4877             $uncomp = "lzop -d -c $qarchive|";
4878         } else {
4879             die "unknown compression method '$comp'\n";
4880         }
4881
4882     }
4883
4884     my $tmpdir = "/var/tmp/vzdumptmp$$";
4885     rmtree $tmpdir;
4886
4887     # disable interrupts (always do cleanups)
4888     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
4889         warn "got interrupt - ignored\n";
4890     };
4891
4892     my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
4893     POSIX::mkfifo($mapfifo, 0600);
4894     my $fifofh;
4895
4896     my $openfifo = sub {
4897         open($fifofh, '>', $mapfifo) || die $!;
4898     };
4899
4900     my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
4901
4902     my $oldtimeout;
4903     my $timeout = 5;
4904
4905     my $devinfo = {};
4906
4907     my $rpcenv = PVE::RPCEnvironment::get();
4908
4909     my $conffile = config_file($vmid);
4910     my $tmpfn = "$conffile.$$.tmp";
4911
4912     # Note: $oldconf is undef if VM does not exists
4913     my $oldconf = PVE::Cluster::cfs_read_file(cfs_config_path($vmid));
4914
4915     my $print_devmap = sub {
4916         my $virtdev_hash = {};
4917
4918         my $cfgfn = "$tmpdir/qemu-server.conf";
4919
4920         # we can read the config - that is already extracted
4921         my $fh = IO::File->new($cfgfn, "r") ||
4922             "unable to read qemu-server.conf - $!\n";
4923
4924         while (defined(my $line = <$fh>)) {
4925             if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
4926                 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
4927                 die "archive does not contain data for drive '$virtdev'\n"
4928                     if !$devinfo->{$devname};
4929                 if (defined($opts->{storage})) {
4930                     $storeid = $opts->{storage} || 'local';
4931                 } elsif (!$storeid) {
4932                     $storeid = 'local';
4933                 }
4934                 $format = 'raw' if !$format;
4935                 $devinfo->{$devname}->{devname} = $devname;
4936                 $devinfo->{$devname}->{virtdev} = $virtdev;
4937                 $devinfo->{$devname}->{format} = $format;
4938                 $devinfo->{$devname}->{storeid} = $storeid;
4939
4940                 # check permission on storage
4941                 my $pool = $opts->{pool}; # todo: do we need that?
4942                 if ($user ne 'root@pam') {
4943                     $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
4944                 }
4945
4946                 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
4947             }
4948         }
4949
4950         foreach my $devname (keys %$devinfo) {
4951             die "found no device mapping information for device '$devname'\n"
4952                 if !$devinfo->{$devname}->{virtdev};
4953         }
4954
4955         my $cfg = cfs_read_file('storage.cfg');
4956
4957         # create empty/temp config
4958         if ($oldconf) {
4959             PVE::Tools::file_set_contents($conffile, "memory: 128\n");
4960             foreach_drive($oldconf, sub {
4961                 my ($ds, $drive) = @_;
4962
4963                 return if drive_is_cdrom($drive);
4964
4965                 my $volid = $drive->{file};
4966
4967                 return if !$volid || $volid =~ m|^/|;
4968
4969                 my ($path, $owner) = PVE::Storage::path($cfg, $volid);
4970                 return if !$path || !$owner || ($owner != $vmid);
4971
4972                 # Note: only delete disk we want to restore
4973                 # other volumes will become unused
4974                 if ($virtdev_hash->{$ds}) {
4975                     PVE::Storage::vdisk_free($cfg, $volid);
4976                 }
4977             });
4978         }
4979
4980         my $map = {};
4981         foreach my $virtdev (sort keys %$virtdev_hash) {
4982             my $d = $virtdev_hash->{$virtdev};
4983             my $alloc_size = int(($d->{size} + 1024 - 1)/1024);
4984             my $scfg = PVE::Storage::storage_config($cfg, $d->{storeid});
4985
4986             # test if requested format is supported
4987             my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($cfg, $d->{storeid});
4988             my $supported = grep { $_ eq $d->{format} } @$validFormats;
4989             $d->{format} = $defFormat if !$supported;
4990
4991             my $volid = PVE::Storage::vdisk_alloc($cfg, $d->{storeid}, $vmid,
4992                                                   $d->{format}, undef, $alloc_size);
4993             print STDERR "new volume ID is '$volid'\n";
4994             $d->{volid} = $volid;
4995             my $path = PVE::Storage::path($cfg, $volid);
4996
4997             my $write_zeros = 1;
4998             # fixme: what other storages types initialize volumes with zero?
4999             if ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs' || $scfg->{type} eq 'glusterfs' ||
5000                 $scfg->{type} eq 'sheepdog' || $scfg->{type} eq 'rbd') {
5001                 $write_zeros = 0;
5002             }
5003
5004             print $fifofh "${write_zeros}:$d->{devname}=$path\n";
5005
5006             print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
5007             $map->{$virtdev} = $volid;
5008         }
5009
5010         $fh->seek(0, 0) || die "seek failed - $!\n";
5011
5012         my $outfd = new IO::File ($tmpfn, "w") ||
5013             die "unable to write config for VM $vmid\n";
5014
5015         my $cookie = { netcount => 0 };
5016         while (defined(my $line = <$fh>)) {
5017             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
5018         }
5019
5020         $fh->close();
5021         $outfd->close();
5022     };
5023
5024     eval {
5025         # enable interrupts
5026         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
5027             die "interrupted by signal\n";
5028         };
5029         local $SIG{ALRM} = sub { die "got timeout\n"; };
5030
5031         $oldtimeout = alarm($timeout);
5032
5033         my $parser = sub {
5034             my $line = shift;
5035
5036             print "$line\n";
5037
5038             if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
5039                 my ($dev_id, $size, $devname) = ($1, $2, $3);
5040                 $devinfo->{$devname} = { size => $size, dev_id => $dev_id };
5041             } elsif ($line =~ m/^CTIME: /) {
5042                 # we correctly received the vma config, so we can disable
5043                 # the timeout now for disk allocation (set to 10 minutes, so
5044                 # that we always timeout if something goes wrong)
5045                 alarm(600);
5046                 &$print_devmap();
5047                 print $fifofh "done\n";
5048                 my $tmp = $oldtimeout || 0;
5049                 $oldtimeout = undef;
5050                 alarm($tmp);
5051                 close($fifofh);
5052             }
5053         };
5054
5055         print "restore vma archive: $cmd\n";
5056         run_command($cmd, input => $input, outfunc => $parser, afterfork => $openfifo);
5057     };
5058     my $err = $@;
5059
5060     alarm($oldtimeout) if $oldtimeout;
5061
5062     unlink $mapfifo;
5063
5064     if ($err) {
5065         rmtree $tmpdir;
5066         unlink $tmpfn;
5067
5068         my $cfg = cfs_read_file('storage.cfg');
5069         foreach my $devname (keys %$devinfo) {
5070             my $volid = $devinfo->{$devname}->{volid};
5071             next if !$volid;
5072             eval {
5073                 if ($volid =~ m|^/|) {
5074                     unlink $volid || die 'unlink failed\n';
5075                 } else {
5076                     PVE::Storage::vdisk_free($cfg, $volid);
5077                 }
5078                 print STDERR "temporary volume '$volid' sucessfuly removed\n";
5079             };
5080             print STDERR "unable to cleanup '$volid' - $@" if $@;
5081         }
5082         die $err;
5083     }
5084
5085     rmtree $tmpdir;
5086
5087     rename($tmpfn, $conffile) ||
5088         die "unable to commit configuration file '$conffile'\n";
5089
5090     PVE::Cluster::cfs_update(); # make sure we read new file
5091
5092     eval { rescan($vmid, 1); };
5093     warn $@ if $@;
5094 }
5095
5096 sub restore_tar_archive {
5097     my ($archive, $vmid, $user, $opts) = @_;
5098
5099     if ($archive ne '-') {
5100         my $firstfile = tar_archive_read_firstfile($archive);
5101         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
5102             if $firstfile ne 'qemu-server.conf';
5103     }
5104
5105     my $storecfg = cfs_read_file('storage.cfg');
5106
5107     # destroy existing data - keep empty config
5108     my $vmcfgfn = config_file($vmid);
5109     destroy_vm($storecfg, $vmid, 1) if -f $vmcfgfn;
5110
5111     my $tocmd = "/usr/lib/qemu-server/qmextract";
5112
5113     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
5114     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
5115     $tocmd .= ' --prealloc' if $opts->{prealloc};
5116     $tocmd .= ' --info' if $opts->{info};
5117
5118     # tar option "xf" does not autodetect compression when read from STDIN,
5119     # so we pipe to zcat
5120     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
5121         PVE::Tools::shellquote("--to-command=$tocmd");
5122
5123     my $tmpdir = "/var/tmp/vzdumptmp$$";
5124     mkpath $tmpdir;
5125
5126     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
5127     local $ENV{VZDUMP_VMID} = $vmid;
5128     local $ENV{VZDUMP_USER} = $user;
5129
5130     my $conffile = config_file($vmid);
5131     my $tmpfn = "$conffile.$$.tmp";
5132
5133     # disable interrupts (always do cleanups)
5134     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
5135         print STDERR "got interrupt - ignored\n";
5136     };
5137
5138     eval {
5139         # enable interrupts
5140         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
5141             die "interrupted by signal\n";
5142         };
5143
5144         if ($archive eq '-') {
5145             print "extracting archive from STDIN\n";
5146             run_command($cmd, input => "<&STDIN");
5147         } else {
5148             print "extracting archive '$archive'\n";
5149             run_command($cmd);
5150         }
5151
5152         return if $opts->{info};
5153
5154         # read new mapping
5155         my $map = {};
5156         my $statfile = "$tmpdir/qmrestore.stat";
5157         if (my $fd = IO::File->new($statfile, "r")) {
5158             while (defined (my $line = <$fd>)) {
5159                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
5160                     $map->{$1} = $2 if $1;
5161                 } else {
5162                     print STDERR "unable to parse line in statfile - $line\n";
5163                 }
5164             }
5165             $fd->close();
5166         }
5167
5168         my $confsrc = "$tmpdir/qemu-server.conf";
5169
5170         my $srcfd = new IO::File($confsrc, "r") ||
5171             die "unable to open file '$confsrc'\n";
5172
5173         my $outfd = new IO::File ($tmpfn, "w") ||
5174             die "unable to write config for VM $vmid\n";
5175
5176         my $cookie = { netcount => 0 };
5177         while (defined (my $line = <$srcfd>)) {
5178             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
5179         }
5180
5181         $srcfd->close();
5182         $outfd->close();
5183     };
5184     my $err = $@;
5185
5186     if ($err) {
5187
5188         unlink $tmpfn;
5189
5190         tar_restore_cleanup($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info};
5191
5192         die $err;
5193     }
5194
5195     rmtree $tmpdir;
5196
5197     rename $tmpfn, $conffile ||
5198         die "unable to commit configuration file '$conffile'\n";
5199
5200     PVE::Cluster::cfs_update(); # make sure we read new file
5201
5202     eval { rescan($vmid, 1); };
5203     warn $@ if $@;
5204 };
5205
5206
5207 # Internal snapshots
5208
5209 # NOTE: Snapshot create/delete involves several non-atomic
5210 # action, and can take a long time.
5211 # So we try to avoid locking the file and use 'lock' variable
5212 # inside the config file instead.
5213
5214 my $snapshot_copy_config = sub {
5215     my ($source, $dest) = @_;
5216
5217     foreach my $k (keys %$source) {
5218         next if $k eq 'snapshots';
5219         next if $k eq 'snapstate';
5220         next if $k eq 'snaptime';
5221         next if $k eq 'vmstate';
5222         next if $k eq 'lock';
5223         next if $k eq 'digest';
5224         next if $k eq 'description';
5225         next if $k =~ m/^unused\d+$/;
5226
5227         $dest->{$k} = $source->{$k};
5228     }
5229 };
5230
5231 my $snapshot_apply_config = sub {
5232     my ($conf, $snap) = @_;
5233
5234     # copy snapshot list
5235     my $newconf = {
5236         snapshots => $conf->{snapshots},
5237     };
5238
5239     # keep description and list of unused disks
5240     foreach my $k (keys %$conf) {
5241         next if !($k =~ m/^unused\d+$/ || $k eq 'description');
5242         $newconf->{$k} = $conf->{$k};
5243     }
5244
5245     &$snapshot_copy_config($snap, $newconf);
5246
5247     return $newconf;
5248 };
5249
5250 sub foreach_writable_storage {
5251     my ($conf, $func) = @_;
5252
5253     my $sidhash = {};
5254
5255     foreach my $ds (keys %$conf) {
5256         next if !valid_drivename($ds);
5257
5258         my $drive = parse_drive($ds, $conf->{$ds});
5259         next if !$drive;
5260         next if drive_is_cdrom($drive);
5261
5262         my $volid = $drive->{file};
5263
5264         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
5265         $sidhash->{$sid} = $sid if $sid;
5266     }
5267
5268     foreach my $sid (sort keys %$sidhash) {
5269         &$func($sid);
5270     }
5271 }
5272
5273 my $alloc_vmstate_volid = sub {
5274     my ($storecfg, $vmid, $conf, $snapname) = @_;
5275
5276     # Note: we try to be smart when selecting a $target storage
5277
5278     my $target;
5279
5280     # search shared storage first
5281     foreach_writable_storage($conf, sub {
5282         my ($sid) = @_;
5283         my $scfg = PVE::Storage::storage_config($storecfg, $sid);
5284         return if !$scfg->{shared};
5285
5286         $target = $sid if !$target || $scfg->{path}; # prefer file based storage
5287     });
5288
5289     if (!$target) {
5290         # now search local storage
5291         foreach_writable_storage($conf, sub {
5292             my ($sid) = @_;
5293             my $scfg = PVE::Storage::storage_config($storecfg, $sid);
5294             return if $scfg->{shared};
5295
5296             $target = $sid if !$target || $scfg->{path}; # prefer file based storage;
5297         });
5298     }
5299
5300     $target = 'local' if !$target;
5301
5302     my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
5303     # we abort live save after $conf->{memory}, so we need at max twice that space
5304     my $size = $conf->{memory}*2 + $driver_state_size;
5305
5306     my $name = "vm-$vmid-state-$snapname";
5307     my $scfg = PVE::Storage::storage_config($storecfg, $target);
5308     $name .= ".raw" if $scfg->{path}; # add filename extension for file base storage
5309     my $volid = PVE::Storage::vdisk_alloc($storecfg, $target, $vmid, 'raw', $name, $size*1024);
5310
5311     return $volid;
5312 };
5313
5314 my $snapshot_prepare = sub {
5315     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
5316
5317     my $snap;
5318
5319     my $updatefn =  sub {
5320
5321         my $conf = load_config($vmid);
5322
5323         die "you can't take a snapshot if it's a template\n"
5324             if is_template($conf);
5325
5326         check_lock($conf);
5327
5328         $conf->{lock} = 'snapshot';
5329
5330         die "snapshot name '$snapname' already used\n"
5331             if defined($conf->{snapshots}->{$snapname});
5332
5333         my $storecfg = PVE::Storage::config();
5334         die "snapshot feature is not available" if !has_feature('snapshot', $conf, $storecfg);
5335
5336         $snap = $conf->{snapshots}->{$snapname} = {};
5337
5338         if ($save_vmstate && check_running($vmid)) {
5339             $snap->{vmstate} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
5340         }
5341
5342         &$snapshot_copy_config($conf, $snap);
5343
5344         $snap->{snapstate} = "prepare";
5345         $snap->{snaptime} = time();
5346         $snap->{description} = $comment if $comment;
5347
5348         # always overwrite machine if we save vmstate. This makes sure we
5349         # can restore it later using correct machine type
5350         $snap->{machine} = get_current_qemu_machine($vmid) if $snap->{vmstate};
5351
5352         update_config_nolock($vmid, $conf, 1);
5353     };
5354
5355     lock_config($vmid, $updatefn);
5356
5357     return $snap;
5358 };
5359
5360 my $snapshot_commit = sub {
5361     my ($vmid, $snapname) = @_;
5362
5363     my $updatefn = sub {
5364
5365         my $conf = load_config($vmid);
5366
5367         die "missing snapshot lock\n"
5368             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
5369
5370         my $has_machine_config = defined($conf->{machine});
5371
5372         my $snap = $conf->{snapshots}->{$snapname};
5373
5374         die "snapshot '$snapname' does not exist\n" if !defined($snap);
5375
5376         die "wrong snapshot state\n"
5377             if !($snap->{snapstate} && $snap->{snapstate} eq "prepare");
5378
5379         delete $snap->{snapstate};
5380         delete $conf->{lock};
5381
5382         my $newconf = &$snapshot_apply_config($conf, $snap);
5383
5384         delete $newconf->{machine} if !$has_machine_config;
5385
5386         $newconf->{parent} = $snapname;
5387
5388         update_config_nolock($vmid, $newconf, 1);
5389     };
5390
5391     lock_config($vmid, $updatefn);
5392 };
5393
5394 sub snapshot_rollback {
5395     my ($vmid, $snapname) = @_;
5396
5397     my $snap;
5398
5399     my $prepare = 1;
5400
5401     my $storecfg = PVE::Storage::config();
5402
5403     my $updatefn = sub {
5404
5405         my $conf = load_config($vmid);
5406
5407         die "you can't rollback if vm is a template\n" if is_template($conf);
5408
5409         $snap = $conf->{snapshots}->{$snapname};
5410
5411         die "snapshot '$snapname' does not exist\n" if !defined($snap);
5412
5413         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
5414             if $snap->{snapstate};
5415
5416         if ($prepare) {
5417             check_lock($conf);
5418             vm_stop($storecfg, $vmid, undef, undef, 5, undef, undef);
5419         }
5420
5421         die "unable to rollback vm $vmid: vm is running\n"
5422             if check_running($vmid);
5423
5424         if ($prepare) {
5425             $conf->{lock} = 'rollback';
5426         } else {
5427             die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
5428             delete $conf->{lock};
5429         }
5430
5431         my $forcemachine;
5432
5433         if (!$prepare) {
5434             my $has_machine_config = defined($conf->{machine});
5435
5436             # copy snapshot config to current config
5437             $conf = &$snapshot_apply_config($conf, $snap);
5438             $conf->{parent} = $snapname;
5439
5440             # Note: old code did not store 'machine', so we try to be smart
5441             # and guess the snapshot was generated with kvm 1.4 (pc-i440fx-1.4).
5442             $forcemachine = $conf->{machine} || 'pc-i440fx-1.4';
5443             # we remove the 'machine' configuration if not explicitly specified
5444             # in the original config.
5445             delete $conf->{machine} if $snap->{vmstate} && !$has_machine_config;
5446         }
5447
5448         update_config_nolock($vmid, $conf, 1);
5449
5450         if (!$prepare && $snap->{vmstate}) {
5451             my $statefile = PVE::Storage::path($storecfg, $snap->{vmstate});
5452             vm_start($storecfg, $vmid, $statefile, undef, undef, undef, $forcemachine);
5453         }
5454     };
5455
5456     lock_config($vmid, $updatefn);
5457
5458     foreach_drive($snap, sub {
5459         my ($ds, $drive) = @_;
5460
5461         return if drive_is_cdrom($drive);
5462
5463         my $volid = $drive->{file};
5464         my $device = "drive-$ds";
5465
5466         PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
5467     });
5468
5469     $prepare = 0;
5470     lock_config($vmid, $updatefn);
5471 }
5472
5473 my $savevm_wait = sub {
5474     my ($vmid) = @_;
5475
5476     for(;;) {
5477         my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
5478         if (!$stat->{status}) {
5479             die "savevm not active\n";
5480         } elsif ($stat->{status} eq 'active') {
5481             sleep(1);
5482             next;
5483         } elsif ($stat->{status} eq 'completed') {
5484             last;
5485         } else {
5486             die "query-savevm returned status '$stat->{status}'\n";
5487         }
5488     }
5489 };
5490
5491 sub snapshot_create {
5492     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
5493
5494     my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
5495
5496     $save_vmstate = 0 if !$snap->{vmstate}; # vm is not running
5497
5498     my $config = load_config($vmid);
5499
5500     my $running = check_running($vmid);
5501
5502     my $freezefs = $running && $config->{agent};
5503     $freezefs = 0 if $snap->{vmstate}; # not needed if we save RAM
5504
5505     my $drivehash = {};
5506
5507     if ($freezefs) {
5508         eval { vm_mon_cmd($vmid, "guest-fsfreeze-freeze"); };
5509         warn "guest-fsfreeze-freeze problems - $@" if $@;
5510     }
5511
5512     eval {
5513         # create internal snapshots of all drives
5514
5515         my $storecfg = PVE::Storage::config();
5516
5517         if ($running) {
5518             if ($snap->{vmstate}) {
5519                 my $path = PVE::Storage::path($storecfg, $snap->{vmstate});
5520                 vm_mon_cmd($vmid, "savevm-start", statefile => $path);
5521                 &$savevm_wait($vmid);
5522             } else {
5523                 vm_mon_cmd($vmid, "savevm-start");
5524             }
5525         };
5526
5527         foreach_drive($snap, sub {
5528             my ($ds, $drive) = @_;
5529
5530             return if drive_is_cdrom($drive);
5531
5532             my $volid = $drive->{file};
5533             my $device = "drive-$ds";
5534
5535             qemu_volume_snapshot($vmid, $device, $storecfg, $volid, $snapname);
5536             $drivehash->{$ds} = 1;
5537        });
5538     };
5539     my $err = $@;
5540
5541     if ($running) {
5542         eval { vm_mon_cmd($vmid, "savevm-end")  };
5543         warn $@ if $@;
5544
5545         if ($freezefs) {
5546             eval { vm_mon_cmd($vmid, "guest-fsfreeze-thaw"); };
5547             warn "guest-fsfreeze-thaw problems - $@" if $@;
5548         }
5549
5550         # savevm-end is async, we need to wait
5551         for (;;) {
5552             my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
5553             if (!$stat->{bytes}) {
5554                 last;
5555             } else {
5556                 print "savevm not yet finished\n";
5557                 sleep(1);
5558                 next;
5559             }
5560         }
5561     }
5562
5563     if ($err) {
5564         warn "snapshot create failed: starting cleanup\n";
5565         eval { snapshot_delete($vmid, $snapname, 0, $drivehash); };
5566         warn $@ if $@;
5567         die $err;
5568     }
5569
5570     &$snapshot_commit($vmid, $snapname);
5571 }
5572
5573 # Note: $drivehash is only set when called from snapshot_create.
5574 sub snapshot_delete {
5575     my ($vmid, $snapname, $force, $drivehash) = @_;
5576
5577     my $prepare = 1;
5578
5579     my $snap;
5580     my $unused = [];
5581
5582     my $unlink_parent = sub {
5583         my ($confref, $new_parent) = @_;
5584
5585         if ($confref->{parent} && $confref->{parent} eq $snapname) {
5586             if ($new_parent) {
5587                 $confref->{parent} = $new_parent;
5588             } else {
5589                 delete $confref->{parent};
5590             }
5591         }
5592     };
5593
5594     my $updatefn =  sub {
5595         my ($remove_drive) = @_;
5596
5597         my $conf = load_config($vmid);
5598
5599         if (!$drivehash) {
5600             check_lock($conf);
5601             die "you can't delete a snapshot if vm is a template\n"
5602                 if is_template($conf);
5603         }
5604
5605         $snap = $conf->{snapshots}->{$snapname};
5606
5607         die "snapshot '$snapname' does not exist\n" if !defined($snap);
5608
5609         # remove parent refs
5610         if (!$prepare) {
5611             &$unlink_parent($conf, $snap->{parent});
5612             foreach my $sn (keys %{$conf->{snapshots}}) {
5613                 next if $sn eq $snapname;
5614                 &$unlink_parent($conf->{snapshots}->{$sn}, $snap->{parent});
5615             }
5616         }
5617
5618         if ($remove_drive) {
5619             if ($remove_drive eq 'vmstate') {
5620                 delete $snap->{$remove_drive};
5621             } else {
5622                 my $drive = parse_drive($remove_drive, $snap->{$remove_drive});
5623                 my $volid = $drive->{file};
5624                 delete $snap->{$remove_drive};
5625                 add_unused_volume($conf, $volid);
5626             }
5627         }
5628
5629         if ($prepare) {
5630             $snap->{snapstate} = 'delete';
5631         } else {
5632             delete $conf->{snapshots}->{$snapname};
5633             delete $conf->{lock} if $drivehash;
5634             foreach my $volid (@$unused) {
5635                 add_unused_volume($conf, $volid);
5636             }
5637         }
5638
5639         update_config_nolock($vmid, $conf, 1);
5640     };
5641
5642     lock_config($vmid, $updatefn);
5643
5644     # now remove vmstate file
5645
5646     my $storecfg = PVE::Storage::config();
5647
5648     if ($snap->{vmstate}) {
5649         eval {  PVE::Storage::vdisk_free($storecfg, $snap->{vmstate}); };
5650         if (my $err = $@) {
5651             die $err if !$force;
5652             warn $err;
5653         }
5654         # save changes (remove vmstate from snapshot)
5655         lock_config($vmid, $updatefn, 'vmstate') if !$force;
5656     };
5657
5658     # now remove all internal snapshots
5659     foreach_drive($snap, sub {
5660         my ($ds, $drive) = @_;
5661
5662         return if drive_is_cdrom($drive);
5663
5664         my $volid = $drive->{file};
5665         my $device = "drive-$ds";
5666
5667         if (!$drivehash || $drivehash->{$ds}) {
5668             eval { qemu_volume_snapshot_delete($vmid, $device, $storecfg, $volid, $snapname); };
5669             if (my $err = $@) {
5670                 die $err if !$force;
5671                 warn $err;
5672             }
5673         }
5674
5675         # save changes (remove drive fron snapshot)
5676         lock_config($vmid, $updatefn, $ds) if !$force;
5677         push @$unused, $volid;
5678     });
5679
5680     # now cleanup config
5681     $prepare = 0;
5682     lock_config($vmid, $updatefn);
5683 }
5684
5685 sub has_feature {
5686     my ($feature, $conf, $storecfg, $snapname, $running) = @_;
5687
5688     my $err;
5689     foreach_drive($conf, sub {
5690         my ($ds, $drive) = @_;
5691
5692         return if drive_is_cdrom($drive);
5693         my $volid = $drive->{file};
5694         $err = 1 if !PVE::Storage::volume_has_feature($storecfg, $feature, $volid, $snapname, $running);
5695     });
5696
5697     return $err ? 0 : 1;
5698 }
5699
5700 sub template_create {
5701     my ($vmid, $conf, $disk) = @_;
5702
5703     my $storecfg = PVE::Storage::config();
5704
5705     foreach_drive($conf, sub {
5706         my ($ds, $drive) = @_;
5707
5708         return if drive_is_cdrom($drive);
5709         return if $disk && $ds ne $disk;
5710
5711         my $volid = $drive->{file};
5712         return if !PVE::Storage::volume_has_feature($storecfg, 'template', $volid);
5713
5714         my $voliddst = PVE::Storage::vdisk_create_base($storecfg, $volid);
5715         $drive->{file} = $voliddst;
5716         $conf->{$ds} = print_drive($vmid, $drive);
5717         update_config_nolock($vmid, $conf, 1);
5718     });
5719 }
5720
5721 sub is_template {
5722     my ($conf) = @_;
5723
5724     return 1 if defined $conf->{template} && $conf->{template} == 1;
5725 }
5726
5727 sub qemu_img_convert {
5728     my ($src_volid, $dst_volid, $size, $snapname) = @_;
5729
5730     my $storecfg = PVE::Storage::config();
5731     my ($src_storeid, $src_volname) = PVE::Storage::parse_volume_id($src_volid, 1);
5732     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
5733
5734     if ($src_storeid && $dst_storeid) {
5735         my $src_scfg = PVE::Storage::storage_config($storecfg, $src_storeid);
5736         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
5737
5738         my $src_format = qemu_img_format($src_scfg, $src_volname);
5739         my $dst_format = qemu_img_format($dst_scfg, $dst_volname);
5740
5741         my $src_path = PVE::Storage::path($storecfg, $src_volid, $snapname);
5742         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
5743
5744         my $cmd = [];
5745         push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-n';
5746         push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
5747         push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
5748
5749         my $parser = sub {
5750             my $line = shift;
5751             if($line =~ m/\((\S+)\/100\%\)/){
5752                 my $percent = $1;
5753                 my $transferred = int($size * $percent / 100);
5754                 my $remaining = $size - $transferred;
5755
5756                 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
5757             }
5758
5759         };
5760
5761         eval  { run_command($cmd, timeout => undef, outfunc => $parser); };
5762         my $err = $@;
5763         die "copy failed: $err" if $err;
5764     }
5765 }
5766
5767 sub qemu_img_format {
5768     my ($scfg, $volname) = @_;
5769
5770     if ($scfg->{path} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/) {
5771         return $1;
5772     } elsif ($scfg->{type} eq 'iscsi') {
5773         return "host_device";
5774     } else {
5775         return "raw";
5776     }
5777 }
5778
5779 sub qemu_drive_mirror {
5780     my ($vmid, $drive, $dst_volid, $vmiddst) = @_;
5781
5782     my $count = 0;
5783     my $old_len = 0;
5784     my $frozen = undef;
5785     my $maxwait = 120;
5786
5787     my $storecfg = PVE::Storage::config();
5788     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid);
5789
5790     my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
5791
5792     my $format;
5793     if ($dst_volname =~ m/\.(raw|qcow2)$/){
5794         $format = $1;
5795     }
5796
5797     my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
5798
5799     my $opts = { timeout => 10, device => "drive-$drive", mode => "existing", sync => "full", target => $dst_path };
5800     $opts->{format} = $format if $format;
5801
5802     #fixme : sometime drive-mirror timeout, but works fine after.
5803     # (I have see the problem with big volume > 200GB), so we need to eval
5804     eval { vm_mon_cmd($vmid, "drive-mirror", %$opts); };
5805     # ignore errors here
5806
5807     eval {
5808         while (1) {
5809             my $stats = vm_mon_cmd($vmid, "query-block-jobs");
5810             my $stat = @$stats[0];
5811             die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
5812             die "error job is not mirroring" if $stat->{type} ne "mirror";
5813
5814             my $busy = $stat->{busy};
5815
5816             if (my $total = $stat->{len}) {
5817                 my $transferred = $stat->{offset} || 0;
5818                 my $remaining = $total - $transferred;
5819                 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
5820
5821                 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent % busy: $busy\n";
5822             }
5823
5824             if ($stat->{len} == $stat->{offset}) {
5825                 if ($busy eq 'false') {
5826
5827                     last if $vmiddst != $vmid;
5828
5829                     # try to switch the disk if source and destination are on the same guest
5830                     eval { vm_mon_cmd($vmid, "block-job-complete", device => "drive-$drive") };
5831                     last if !$@;
5832                     die $@ if $@ !~ m/cannot be completed/;
5833                 }
5834
5835                 if ($count > $maxwait) {
5836                     # if too much writes to disk occurs at the end of migration
5837                     #the disk needs to be freezed to be able to complete the migration
5838                     vm_suspend($vmid,1);
5839                     $frozen = 1;
5840                 }
5841                 $count ++
5842             }
5843             $old_len = $stat->{offset};
5844             sleep 1;
5845         }
5846
5847         vm_resume($vmid, 1) if $frozen;
5848
5849     };
5850     my $err = $@;
5851
5852     my $cancel_job = sub {
5853         vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive");
5854         while (1) {
5855             my $stats = vm_mon_cmd($vmid, "query-block-jobs");
5856             my $stat = @$stats[0];
5857             last if !$stat;
5858             sleep 1;
5859         }
5860     };
5861
5862     if ($err) {
5863         eval { &$cancel_job(); };
5864         die "mirroring error: $err";
5865     }
5866
5867     if ($vmiddst != $vmid) {
5868         # if we clone a disk for a new target vm, we don't switch the disk
5869         &$cancel_job(); # so we call block-job-cancel
5870     }
5871 }
5872
5873 sub clone_disk {
5874     my ($storecfg, $vmid, $running, $drivename, $drive, $snapname,
5875         $newvmid, $storage, $format, $full, $newvollist) = @_;
5876
5877     my $newvolid;
5878
5879     if (!$full) {
5880         print "create linked clone of drive $drivename ($drive->{file})\n";
5881         $newvolid = PVE::Storage::vdisk_clone($storecfg,  $drive->{file}, $newvmid, $snapname);
5882         push @$newvollist, $newvolid;
5883     } else {
5884         my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file});
5885         $storeid = $storage if $storage;
5886
5887         my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($storecfg, $storeid);
5888         if (!$format) {
5889             $format = $drive->{format} || $defFormat;
5890         }
5891
5892         # test if requested format is supported - else use default
5893         my $supported = grep { $_ eq $format } @$validFormats;
5894         $format = $defFormat if !$supported;
5895
5896         my ($size) = PVE::Storage::volume_size_info($storecfg, $drive->{file}, 3);
5897
5898         print "create full clone of drive $drivename ($drive->{file})\n";
5899         $newvolid = PVE::Storage::vdisk_alloc($storecfg, $storeid, $newvmid, $format, undef, ($size/1024));
5900         push @$newvollist, $newvolid;
5901
5902         if (!$running || $snapname) {
5903             qemu_img_convert($drive->{file}, $newvolid, $size, $snapname);
5904         } else {
5905             qemu_drive_mirror($vmid, $drivename, $newvolid, $newvmid);
5906         }
5907     }
5908
5909     my ($size) = PVE::Storage::volume_size_info($storecfg, $newvolid, 3);
5910
5911     my $disk = $drive;
5912     $disk->{format} = undef;
5913     $disk->{file} = $newvolid;
5914     $disk->{size} = $size;
5915
5916     return $disk;
5917 }
5918
5919 # this only works if VM is running
5920 sub get_current_qemu_machine {
5921     my ($vmid) = @_;
5922
5923     my $cmd = { execute => 'query-machines', arguments => {} };
5924     my $res = vm_qmp_command($vmid, $cmd);
5925
5926     my ($current, $default);
5927     foreach my $e (@$res) {
5928         $default = $e->{name} if $e->{'is-default'};
5929         $current = $e->{name} if $e->{'is-current'};
5930     }
5931
5932     # fallback to the default machine if current is not supported by qemu
5933     return $current || $default || 'pc';
5934 }
5935
5936 sub lspci {
5937
5938     my $devices = {};
5939
5940     dir_glob_foreach("$pcisysfs/devices", '[a-f0-9]{4}:([a-f0-9]{2}:[a-f0-9]{2})\.([0-9])', sub {
5941             my (undef, $id, $function) = @_;
5942             my $res = { id => $id, function => $function};
5943             push @{$devices->{$id}}, $res;
5944     });
5945
5946     return $devices;
5947 }
5948
5949 1;