PVE/QemuServer.pm

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