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