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