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