PVE/QemuServer.pm

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