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 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 PVE::JSONSchema::register_format('pve-qm-smbios1', \&verify_smbios1);
1411 sub verify_smbios1 {
1412     my ($value, $noerr) = @_;
1413
1414     return $value if parse_smbios1($value);
1415
1416     return undef if $noerr;
1417
1418     die "unable to parse smbios (type 1) options\n";
1419 }
1420
1421 PVE::JSONSchema::register_format('pve-qm-bootdisk', \&verify_bootdisk);
1422 sub verify_bootdisk {
1423     my ($value, $noerr) = @_;
1424
1425     return $value if valid_drivename($value);
1426
1427     return undef if $noerr;
1428
1429     die "invalid boot disk '$value'\n";
1430 }
1431
1432 PVE::JSONSchema::register_format('pve-qm-net', \&verify_net);
1433 sub verify_net {
1434     my ($value, $noerr) = @_;
1435
1436     return $value if parse_net($value);
1437
1438     return undef if $noerr;
1439
1440     die "unable to parse network options\n";
1441 }
1442
1443 PVE::JSONSchema::register_format('pve-qm-drive', \&verify_drive);
1444 sub verify_drive {
1445     my ($value, $noerr) = @_;
1446
1447     return $value if parse_drive(undef, $value);
1448
1449     return undef if $noerr;
1450
1451     die "unable to parse drive options\n";
1452 }
1453
1454 PVE::JSONSchema::register_format('pve-qm-hostpci', \&verify_hostpci);
1455 sub verify_hostpci {
1456     my ($value, $noerr) = @_;
1457
1458     return $value if parse_hostpci($value);
1459
1460     return undef if $noerr;
1461
1462     die "unable to parse pci id\n";
1463 }
1464
1465 PVE::JSONSchema::register_format('pve-qm-watchdog', \&verify_watchdog);
1466 sub verify_watchdog {
1467     my ($value, $noerr) = @_;
1468
1469     return $value if parse_watchdog($value);
1470
1471     return undef if $noerr;
1472
1473     die "unable to parse watchdog options\n";
1474 }
1475
1476 sub parse_watchdog {
1477     my ($value) = @_;
1478
1479     return undef if !$value;
1480
1481     my $res = {};
1482
1483     foreach my $p (split(/,/, $value)) {
1484         next if $p =~ m/^\s*$/;
1485
1486         if ($p =~ m/^(model=)?(i6300esb|ib700)$/) {
1487             $res->{model} = $2;
1488         } elsif ($p =~ m/^(action=)?(reset|shutdown|poweroff|pause|debug|none)$/) {
1489             $res->{action} = $2;
1490         } else {
1491             return undef;
1492         }
1493     }
1494
1495     return $res;
1496 }
1497
1498 PVE::JSONSchema::register_format('pve-qm-startup', \&verify_startup);
1499 sub verify_startup {
1500     my ($value, $noerr) = @_;
1501
1502     return $value if parse_startup($value);
1503
1504     return undef if $noerr;
1505
1506     die "unable to parse startup options\n";
1507 }
1508
1509 sub parse_startup {
1510     my ($value) = @_;
1511
1512     return undef if !$value;
1513
1514     my $res = {};
1515
1516     foreach my $p (split(/,/, $value)) {
1517         next if $p =~ m/^\s*$/;
1518
1519         if ($p =~ m/^(order=)?(\d+)$/) {
1520             $res->{order} = $2;
1521         } elsif ($p =~ m/^up=(\d+)$/) {
1522             $res->{up} = $1;
1523         } elsif ($p =~ m/^down=(\d+)$/) {
1524             $res->{down} = $1;
1525         } else {
1526             return undef;
1527         }
1528     }
1529
1530     return $res;
1531 }
1532
1533 sub parse_usb_device {
1534     my ($value) = @_;
1535
1536     return undef if !$value;
1537
1538     my @dl = split(/,/, $value);
1539     my $found;
1540
1541     my $res = {};
1542     foreach my $v (@dl) {
1543         if ($v =~ m/^host=(0x)?([0-9A-Fa-f]{4}):(0x)?([0-9A-Fa-f]{4})$/) {
1544             $found = 1;
1545             $res->{vendorid} = $2;
1546             $res->{productid} = $4;
1547         } elsif ($v =~ m/^host=(\d+)\-(\d+(\.\d+)*)$/) {
1548             $found = 1;
1549             $res->{hostbus} = $1;
1550             $res->{hostport} = $2;
1551         } elsif ($v =~ m/^spice$/) {
1552             $found = 1;
1553             $res->{spice} = 1;
1554         } else {
1555             return undef;
1556         }
1557     }
1558     return undef if !$found;
1559
1560     return $res;
1561 }
1562
1563 PVE::JSONSchema::register_format('pve-qm-usb-device', \&verify_usb_device);
1564 sub verify_usb_device {
1565     my ($value, $noerr) = @_;
1566
1567     return $value if parse_usb_device($value);
1568
1569     return undef if $noerr;
1570
1571     die "unable to parse usb device\n";
1572 }
1573
1574 # add JSON properties for create and set function
1575 sub json_config_properties {
1576     my $prop = shift;
1577
1578     foreach my $opt (keys %$confdesc) {
1579         next if $opt eq 'parent' || $opt eq 'snaptime' || $opt eq 'vmstate';
1580         $prop->{$opt} = $confdesc->{$opt};
1581     }
1582
1583     return $prop;
1584 }
1585
1586 sub check_type {
1587     my ($key, $value) = @_;
1588
1589     die "unknown setting '$key'\n" if !$confdesc->{$key};
1590
1591     my $type = $confdesc->{$key}->{type};
1592
1593     if (!defined($value)) {
1594         die "got undefined value\n";
1595     }
1596
1597     if ($value =~ m/[\n\r]/) {
1598         die "property contains a line feed\n";
1599     }
1600
1601     if ($type eq 'boolean') {
1602         return 1 if ($value eq '1') || ($value =~ m/^(on|yes|true)$/i);
1603         return 0 if ($value eq '0') || ($value =~ m/^(off|no|false)$/i);
1604         die "type check ('boolean') failed - got '$value'\n";
1605     } elsif ($type eq 'integer') {
1606         return int($1) if $value =~ m/^(\d+)$/;
1607         die "type check ('integer') failed - got '$value'\n";
1608     } elsif ($type eq 'number') {
1609         return $value if $value =~ m/^(\d+)(\.\d+)?$/;
1610         die "type check ('number') failed - got '$value'\n";
1611     } elsif ($type eq 'string') {
1612         if (my $fmt = $confdesc->{$key}->{format}) {
1613             if ($fmt eq 'pve-qm-drive') {
1614                 # special case - we need to pass $key to parse_drive()
1615                 my $drive = parse_drive($key, $value);
1616                 return $value if $drive;
1617                 die "unable to parse drive options\n";
1618             }
1619             PVE::JSONSchema::check_format($fmt, $value);
1620             return $value;
1621         }
1622         $value =~ s/^\"(.*)\"$/$1/;
1623         return $value;
1624     } else {
1625         die "internal error"
1626     }
1627 }
1628
1629 sub lock_config_full {
1630     my ($vmid, $timeout, $code, @param) = @_;
1631
1632     my $filename = config_file_lock($vmid);
1633
1634     my $res = lock_file($filename, $timeout, $code, @param);
1635
1636     die $@ if $@;
1637
1638     return $res;
1639 }
1640
1641 sub lock_config_mode {
1642     my ($vmid, $timeout, $shared, $code, @param) = @_;
1643
1644     my $filename = config_file_lock($vmid);
1645
1646     my $res = lock_file_full($filename, $timeout, $shared, $code, @param);
1647
1648     die $@ if $@;
1649
1650     return $res;
1651 }
1652
1653 sub lock_config {
1654     my ($vmid, $code, @param) = @_;
1655
1656     return lock_config_full($vmid, 10, $code, @param);
1657 }
1658
1659 sub cfs_config_path {
1660     my ($vmid, $node) = @_;
1661
1662     $node = $nodename if !$node;
1663     return "nodes/$node/qemu-server/$vmid.conf";
1664 }
1665
1666 sub check_iommu_support{
1667     #fixme : need to check IOMMU support
1668     #http://www.linux-kvm.org/page/How_to_assign_devices_with_VT-d_in_KVM
1669
1670     my $iommu=1;
1671     return $iommu;
1672
1673 }
1674
1675 sub config_file {
1676     my ($vmid, $node) = @_;
1677
1678     my $cfspath = cfs_config_path($vmid, $node);
1679     return "/etc/pve/$cfspath";
1680 }
1681
1682 sub config_file_lock {
1683     my ($vmid) = @_;
1684
1685     return "$lock_dir/lock-$vmid.conf";
1686 }
1687
1688 sub touch_config {
1689     my ($vmid) = @_;
1690
1691     my $conf = config_file($vmid);
1692     utime undef, undef, $conf;
1693 }
1694
1695 sub destroy_vm {
1696     my ($storecfg, $vmid, $keep_empty_config) = @_;
1697
1698     my $conffile = config_file($vmid);
1699
1700     my $conf = load_config($vmid);
1701
1702     check_lock($conf);
1703
1704     # only remove disks owned by this VM
1705     foreach_drive($conf, sub {
1706         my ($ds, $drive) = @_;
1707
1708         return if drive_is_cdrom($drive);
1709
1710         my $volid = $drive->{file};
1711
1712         return if !$volid || $volid =~ m|^/|;
1713
1714         my ($path, $owner) = PVE::Storage::path($storecfg, $volid);
1715         return if !$path || !$owner || ($owner != $vmid);
1716
1717         PVE::Storage::vdisk_free($storecfg, $volid);
1718     });
1719
1720     if ($keep_empty_config) {
1721         PVE::Tools::file_set_contents($conffile, "memory: 128\n");
1722     } else {
1723         unlink $conffile;
1724     }
1725
1726     # also remove unused disk
1727     eval {
1728         my $dl = PVE::Storage::vdisk_list($storecfg, undef, $vmid);
1729
1730         eval {
1731             PVE::Storage::foreach_volid($dl, sub {
1732                 my ($volid, $sid, $volname, $d) = @_;
1733                 PVE::Storage::vdisk_free($storecfg, $volid);
1734             });
1735         };
1736         warn $@ if $@;
1737
1738     };
1739     warn $@ if $@;
1740 }
1741
1742 sub load_config {
1743     my ($vmid, $node) = @_;
1744
1745     my $cfspath = cfs_config_path($vmid, $node);
1746
1747     my $conf = PVE::Cluster::cfs_read_file($cfspath);
1748
1749     die "no such VM ('$vmid')\n" if !defined($conf);
1750
1751     return $conf;
1752 }
1753
1754 sub parse_vm_config {
1755     my ($filename, $raw) = @_;
1756
1757     return undef if !defined($raw);
1758
1759     my $res = {
1760         digest => Digest::SHA::sha1_hex($raw),
1761         snapshots => {},
1762     };
1763
1764     $filename =~ m|/qemu-server/(\d+)\.conf$|
1765         || die "got strange filename '$filename'";
1766
1767     my $vmid = $1;
1768
1769     my $conf = $res;
1770     my $descr = '';
1771
1772     my @lines = split(/\n/, $raw);
1773     foreach my $line (@lines) {
1774         next if $line =~ m/^\s*$/;
1775
1776         if ($line =~ m/^\[([a-z][a-z0-9_\-]+)\]\s*$/i) {
1777             my $snapname = $1;
1778             $conf->{description} = $descr if $descr;
1779             $descr = '';
1780             $conf = $res->{snapshots}->{$snapname} = {};
1781             next;
1782         }
1783
1784         if ($line =~ m/^\#(.*)\s*$/) {
1785             $descr .= PVE::Tools::decode_text($1) . "\n";
1786             next;
1787         }
1788
1789         if ($line =~ m/^(description):\s*(.*\S)\s*$/) {
1790             $descr .= PVE::Tools::decode_text($2);
1791         } elsif ($line =~ m/snapstate:\s*(prepare|delete)\s*$/) {
1792             $conf->{snapstate} = $1;
1793         } elsif ($line =~ m/^(args):\s*(.*\S)\s*$/) {
1794             my $key = $1;
1795             my $value = $2;
1796             $conf->{$key} = $value;
1797         } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/) {
1798             my $key = $1;
1799             my $value = $2;
1800             eval { $value = check_type($key, $value); };
1801             if ($@) {
1802                 warn "vm $vmid - unable to parse value of '$key' - $@";
1803             } else {
1804                 my $fmt = $confdesc->{$key}->{format};
1805                 if ($fmt && $fmt eq 'pve-qm-drive') {
1806                     my $v = parse_drive($key, $value);
1807                     if (my $volid = filename_to_volume_id($vmid, $v->{file}, $v->{media})) {
1808                         $v->{file} = $volid;
1809                         $value = print_drive($vmid, $v);
1810                     } else {
1811                         warn "vm $vmid - unable to parse value of '$key'\n";
1812                         next;
1813                     }
1814                 }
1815
1816                 if ($key eq 'cdrom') {
1817                     $conf->{ide2} = $value;
1818                 } else {
1819                     $conf->{$key} = $value;
1820                 }
1821             }
1822         }
1823     }
1824
1825     $conf->{description} = $descr if $descr;
1826
1827     delete $res->{snapstate}; # just to be sure
1828
1829     return $res;
1830 }
1831
1832 sub write_vm_config {
1833     my ($filename, $conf) = @_;
1834
1835     delete $conf->{snapstate}; # just to be sure
1836
1837     if ($conf->{cdrom}) {
1838         die "option ide2 conflicts with cdrom\n" if $conf->{ide2};
1839         $conf->{ide2} = $conf->{cdrom};
1840         delete $conf->{cdrom};
1841     }
1842
1843     # we do not use 'smp' any longer
1844     if ($conf->{sockets}) {
1845         delete $conf->{smp};
1846     } elsif ($conf->{smp}) {
1847         $conf->{sockets} = $conf->{smp};
1848         delete $conf->{cores};
1849         delete $conf->{smp};
1850     }
1851
1852     if ($conf->{maxcpus} && $conf->{sockets}) {
1853         delete $conf->{sockets};
1854     }
1855
1856     my $used_volids = {};
1857
1858     my $cleanup_config = sub {
1859         my ($cref, $snapname) = @_;
1860
1861         foreach my $key (keys %$cref) {
1862             next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots' ||
1863                 $key eq 'snapstate';
1864             my $value = $cref->{$key};
1865             eval { $value = check_type($key, $value); };
1866             die "unable to parse value of '$key' - $@" if $@;
1867
1868             $cref->{$key} = $value;
1869
1870             if (!$snapname && valid_drivename($key)) {
1871                 my $drive = parse_drive($key, $value);
1872                 $used_volids->{$drive->{file}} = 1 if $drive && $drive->{file};
1873             }
1874         }
1875     };
1876
1877     &$cleanup_config($conf);
1878     foreach my $snapname (keys %{$conf->{snapshots}}) {
1879         &$cleanup_config($conf->{snapshots}->{$snapname}, $snapname);
1880     }
1881
1882     # remove 'unusedX' settings if we re-add a volume
1883     foreach my $key (keys %$conf) {
1884         my $value = $conf->{$key};
1885         if ($key =~ m/^unused/ && $used_volids->{$value}) {
1886             delete $conf->{$key};
1887         }
1888     }
1889
1890     my $generate_raw_config = sub {
1891         my ($conf) = @_;
1892
1893         my $raw = '';
1894
1895         # add description as comment to top of file
1896         my $descr = $conf->{description} || '';
1897         foreach my $cl (split(/\n/, $descr)) {
1898             $raw .= '#' .  PVE::Tools::encode_text($cl) . "\n";
1899         }
1900
1901         foreach my $key (sort keys %$conf) {
1902             next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots';
1903             $raw .= "$key: $conf->{$key}\n";
1904         }
1905         return $raw;
1906     };
1907
1908     my $raw = &$generate_raw_config($conf);
1909     foreach my $snapname (sort keys %{$conf->{snapshots}}) {
1910         $raw .= "\n[$snapname]\n";
1911         $raw .= &$generate_raw_config($conf->{snapshots}->{$snapname});
1912     }
1913
1914     return $raw;
1915 }
1916
1917 sub update_config_nolock {
1918     my ($vmid, $conf, $skiplock) = @_;
1919
1920     check_lock($conf) if !$skiplock;
1921
1922     my $cfspath = cfs_config_path($vmid);
1923
1924     PVE::Cluster::cfs_write_file($cfspath, $conf);
1925 }
1926
1927 sub update_config {
1928     my ($vmid, $conf, $skiplock) = @_;
1929
1930     lock_config($vmid, &update_config_nolock, $conf, $skiplock);
1931 }
1932
1933 sub load_defaults {
1934
1935     my $res = {};
1936
1937     # we use static defaults from our JSON schema configuration
1938     foreach my $key (keys %$confdesc) {
1939         if (defined(my $default = $confdesc->{$key}->{default})) {
1940             $res->{$key} = $default;
1941         }
1942     }
1943
1944     my $conf = PVE::Cluster::cfs_read_file('datacenter.cfg');
1945     $res->{keyboard} = $conf->{keyboard} if $conf->{keyboard};
1946
1947     return $res;
1948 }
1949
1950 sub config_list {
1951     my $vmlist = PVE::Cluster::get_vmlist();
1952     my $res = {};
1953     return $res if !$vmlist || !$vmlist->{ids};
1954     my $ids = $vmlist->{ids};
1955
1956     foreach my $vmid (keys %$ids) {
1957         my $d = $ids->{$vmid};
1958         next if !$d->{node} || $d->{node} ne $nodename;
1959         next if !$d->{type} || $d->{type} ne 'qemu';
1960         $res->{$vmid}->{exists} = 1;
1961     }
1962     return $res;
1963 }
1964
1965 # test if VM uses local resources (to prevent migration)
1966 sub check_local_resources {
1967     my ($conf, $noerr) = @_;
1968
1969     my $loc_res = 0;
1970
1971     $loc_res = 1 if $conf->{hostusb}; # old syntax
1972     $loc_res = 1 if $conf->{hostpci}; # old syntax
1973
1974     foreach my $k (keys %$conf) {
1975         next if $k =~ m/^usb/ && ($conf->{$k} eq 'spice');
1976         $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/;
1977     }
1978
1979     die "VM uses local resources\n" if $loc_res && !$noerr;
1980
1981     return $loc_res;
1982 }
1983
1984 # check if used storages are available on all nodes (use by migrate)
1985 sub check_storage_availability {
1986     my ($storecfg, $conf, $node) = @_;
1987
1988     foreach_drive($conf, sub {
1989         my ($ds, $drive) = @_;
1990
1991         my $volid = $drive->{file};
1992         return if !$volid;
1993
1994         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
1995         return if !$sid;
1996
1997         # check if storage is available on both nodes
1998         my $scfg = PVE::Storage::storage_check_node($storecfg, $sid);
1999         PVE::Storage::storage_check_node($storecfg, $sid, $node);
2000    });
2001 }
2002
2003 # list nodes where all VM images are available (used by has_feature API)
2004 sub shared_nodes {
2005     my ($conf, $storecfg) = @_;
2006
2007     my $nodelist = PVE::Cluster::get_nodelist();
2008     my $nodehash = { map { $_ => 1 } @$nodelist };
2009     my $nodename = PVE::INotify::nodename();
2010
2011     foreach_drive($conf, sub {
2012         my ($ds, $drive) = @_;
2013
2014         my $volid = $drive->{file};
2015         return if !$volid;
2016
2017         my ($storeid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
2018         if ($storeid) {
2019             my $scfg = PVE::Storage::storage_config($storecfg, $storeid);
2020             if ($scfg->{disable}) {
2021                 $nodehash = {};
2022             } elsif (my $avail = $scfg->{nodes}) {
2023                 foreach my $node (keys %$nodehash) {
2024                     delete $nodehash->{$node} if !$avail->{$node};
2025                 }
2026             } elsif (!$scfg->{shared}) {
2027                 foreach my $node (keys %$nodehash) {
2028                     delete $nodehash->{$node} if $node ne $nodename
2029                 }
2030             }
2031         }
2032     });
2033
2034     return $nodehash
2035 }
2036
2037 sub check_lock {
2038     my ($conf) = @_;
2039
2040     die "VM is locked ($conf->{lock})\n" if $conf->{lock};
2041 }
2042
2043 sub check_cmdline {
2044     my ($pidfile, $pid) = @_;
2045
2046     my $fh = IO::File->new("/proc/$pid/cmdline", "r");
2047     if (defined($fh)) {
2048         my $line = <$fh>;
2049         $fh->close;
2050         return undef if !$line;
2051         my @param = split(/\0/, $line);
2052
2053         my $cmd = $param[0];
2054         return if !$cmd || ($cmd !~ m|kvm$| && $cmd !~ m|qemu-system-x86_64$|);
2055
2056         for (my $i = 0; $i < scalar (@param); $i++) {
2057             my $p = $param[$i];
2058             next if !$p;
2059             if (($p eq '-pidfile') || ($p eq '--pidfile')) {
2060                 my $p = $param[$i+1];
2061                 return 1 if $p && ($p eq $pidfile);
2062                 return undef;
2063             }
2064         }
2065     }
2066     return undef;
2067 }
2068
2069 sub check_running {
2070     my ($vmid, $nocheck, $node) = @_;
2071
2072     my $filename = config_file($vmid, $node);
2073
2074     die "unable to find configuration file for VM $vmid - no such machine\n"
2075         if !$nocheck && ! -f $filename;
2076
2077     my $pidfile = pidfile_name($vmid);
2078
2079     if (my $fd = IO::File->new("<$pidfile")) {
2080         my $st = stat($fd);
2081         my $line = <$fd>;
2082         close($fd);
2083
2084         my $mtime = $st->mtime;
2085         if ($mtime > time()) {
2086             warn "file '$filename' modified in future\n";
2087         }
2088
2089         if ($line =~ m/^(\d+)$/) {
2090             my $pid = $1;
2091             if (check_cmdline($pidfile, $pid)) {
2092                 if (my $pinfo = PVE::ProcFSTools::check_process_running($pid)) {
2093                     return $pid;
2094                 }
2095             }
2096         }
2097     }
2098
2099     return undef;
2100 }
2101
2102 sub vzlist {
2103
2104     my $vzlist = config_list();
2105
2106     my $fd = IO::Dir->new($var_run_tmpdir) || return $vzlist;
2107
2108     while (defined(my $de = $fd->read)) {
2109         next if $de !~ m/^(\d+)\.pid$/;
2110         my $vmid = $1;
2111         next if !defined($vzlist->{$vmid});
2112         if (my $pid = check_running($vmid)) {
2113             $vzlist->{$vmid}->{pid} = $pid;
2114         }
2115     }
2116
2117     return $vzlist;
2118 }
2119
2120 sub disksize {
2121     my ($storecfg, $conf) = @_;
2122
2123     my $bootdisk = $conf->{bootdisk};
2124     return undef if !$bootdisk;
2125     return undef if !valid_drivename($bootdisk);
2126
2127     return undef if !$conf->{$bootdisk};
2128
2129     my $drive = parse_drive($bootdisk, $conf->{$bootdisk});
2130     return undef if !defined($drive);
2131
2132     return undef if drive_is_cdrom($drive);
2133
2134     my $volid = $drive->{file};
2135     return undef if !$volid;
2136
2137     return $drive->{size};
2138 }
2139
2140 my $last_proc_pid_stat;
2141
2142 # get VM status information
2143 # This must be fast and should not block ($full == false)
2144 # We only query KVM using QMP if $full == true (this can be slow)
2145 sub vmstatus {
2146     my ($opt_vmid, $full) = @_;
2147
2148     my $res = {};
2149
2150     my $storecfg = PVE::Storage::config();
2151
2152     my $list = vzlist();
2153     my ($uptime) = PVE::ProcFSTools::read_proc_uptime(1);
2154
2155     my $cpucount = $cpuinfo->{cpus} || 1;
2156
2157     foreach my $vmid (keys %$list) {
2158         next if $opt_vmid && ($vmid ne $opt_vmid);
2159
2160         my $cfspath = cfs_config_path($vmid);
2161         my $conf = PVE::Cluster::cfs_read_file($cfspath) || {};
2162
2163         my $d = {};
2164         $d->{pid} = $list->{$vmid}->{pid};
2165
2166         # fixme: better status?
2167         $d->{status} = $list->{$vmid}->{pid} ? 'running' : 'stopped';
2168
2169         my $size = disksize($storecfg, $conf);
2170         if (defined($size)) {
2171             $d->{disk} = 0; # no info available
2172             $d->{maxdisk} = $size;
2173         } else {
2174             $d->{disk} = 0;
2175             $d->{maxdisk} = 0;
2176         }
2177
2178         $d->{cpus} = ($conf->{sockets} || 1) * ($conf->{cores} || 1);
2179         $d->{cpus} = $cpucount if $d->{cpus} > $cpucount;
2180
2181         $d->{name} = $conf->{name} || "VM $vmid";
2182         $d->{maxmem} = $conf->{memory} ? $conf->{memory}*(1024*1024) : 0;
2183
2184         if ($conf->{balloon}) {
2185             $d->{balloon_min} = $conf->{balloon}*(1024*1024);
2186             $d->{shares} = defined($conf->{shares}) ? $conf->{shares} : 1000;
2187         }
2188
2189         $d->{uptime} = 0;
2190         $d->{cpu} = 0;
2191         $d->{mem} = 0;
2192
2193         $d->{netout} = 0;
2194         $d->{netin} = 0;
2195
2196         $d->{diskread} = 0;
2197         $d->{diskwrite} = 0;
2198
2199         $d->{template} = is_template($conf);
2200
2201         $res->{$vmid} = $d;
2202     }
2203
2204     my $netdev = PVE::ProcFSTools::read_proc_net_dev();
2205     foreach my $dev (keys %$netdev) {
2206         next if $dev !~ m/^tap([1-9]\d*)i/;
2207         my $vmid = $1;
2208         my $d = $res->{$vmid};
2209         next if !$d;
2210
2211         $d->{netout} += $netdev->{$dev}->{receive};
2212         $d->{netin} += $netdev->{$dev}->{transmit};
2213     }
2214
2215     my $ctime = gettimeofday;
2216
2217     foreach my $vmid (keys %$list) {
2218
2219         my $d = $res->{$vmid};
2220         my $pid = $d->{pid};
2221         next if !$pid;
2222
2223         my $pstat = PVE::ProcFSTools::read_proc_pid_stat($pid);
2224         next if !$pstat; # not running
2225
2226         my $used = $pstat->{utime} + $pstat->{stime};
2227
2228         $d->{uptime} = int(($uptime - $pstat->{starttime})/$cpuinfo->{user_hz});
2229
2230         if ($pstat->{vsize}) {
2231             $d->{mem} = int(($pstat->{rss}/$pstat->{vsize})*$d->{maxmem});
2232         }
2233
2234         my $old = $last_proc_pid_stat->{$pid};
2235         if (!$old) {
2236             $last_proc_pid_stat->{$pid} = {
2237                 time => $ctime,
2238                 used => $used,
2239                 cpu => 0,
2240             };
2241             next;
2242         }
2243
2244         my $dtime = ($ctime -  $old->{time}) * $cpucount * $cpuinfo->{user_hz};
2245
2246         if ($dtime > 1000) {
2247             my $dutime = $used -  $old->{used};
2248
2249             $d->{cpu} = (($dutime/$dtime)* $cpucount) / $d->{cpus};
2250             $last_proc_pid_stat->{$pid} = {
2251                 time => $ctime,
2252                 used => $used,
2253                 cpu => $d->{cpu},
2254             };
2255         } else {
2256             $d->{cpu} = $old->{cpu};
2257         }
2258     }
2259
2260     return $res if !$full;
2261
2262     my $qmpclient = PVE::QMPClient->new();
2263
2264     my $ballooncb = sub {
2265         my ($vmid, $resp) = @_;
2266
2267         my $info = $resp->{'return'};
2268         return if !$info->{max_mem};
2269
2270         my $d = $res->{$vmid};
2271
2272         # use memory assigned to VM
2273         $d->{maxmem} = $info->{max_mem};
2274         $d->{balloon} = $info->{actual};
2275
2276         if (defined($info->{total_mem}) && defined($info->{free_mem})) {
2277             $d->{mem} = $info->{total_mem} - $info->{free_mem};
2278             $d->{freemem} = $info->{free_mem};
2279         }
2280
2281     };
2282
2283     my $blockstatscb = sub {
2284         my ($vmid, $resp) = @_;
2285         my $data = $resp->{'return'} || [];
2286         my $totalrdbytes = 0;
2287         my $totalwrbytes = 0;
2288         for my $blockstat (@$data) {
2289             $totalrdbytes = $totalrdbytes + $blockstat->{stats}->{rd_bytes};
2290             $totalwrbytes = $totalwrbytes + $blockstat->{stats}->{wr_bytes};
2291         }
2292         $res->{$vmid}->{diskread} = $totalrdbytes;
2293         $res->{$vmid}->{diskwrite} = $totalwrbytes;
2294     };
2295
2296     my $statuscb = sub {
2297         my ($vmid, $resp) = @_;
2298
2299         $qmpclient->queue_cmd($vmid, $blockstatscb, 'query-blockstats');
2300         # this fails if ballon driver is not loaded, so this must be
2301         # the last commnand (following command are aborted if this fails).
2302         $qmpclient->queue_cmd($vmid, $ballooncb, 'query-balloon');
2303
2304         my $status = 'unknown';
2305         if (!defined($status = $resp->{'return'}->{status})) {
2306             warn "unable to get VM status\n";
2307             return;
2308         }
2309
2310         $res->{$vmid}->{qmpstatus} = $resp->{'return'}->{status};
2311     };
2312
2313     foreach my $vmid (keys %$list) {
2314         next if $opt_vmid && ($vmid ne $opt_vmid);
2315         next if !$res->{$vmid}->{pid}; # not running
2316         $qmpclient->queue_cmd($vmid, $statuscb, 'query-status');
2317     }
2318
2319     $qmpclient->queue_execute();
2320
2321     foreach my $vmid (keys %$list) {
2322         next if $opt_vmid && ($vmid ne $opt_vmid);
2323         $res->{$vmid}->{qmpstatus} = $res->{$vmid}->{status} if !$res->{$vmid}->{qmpstatus};
2324     }
2325
2326     return $res;
2327 }
2328
2329 sub foreach_drive {
2330     my ($conf, $func) = @_;
2331
2332     foreach my $ds (keys %$conf) {
2333         next if !valid_drivename($ds);
2334
2335         my $drive = parse_drive($ds, $conf->{$ds});
2336         next if !$drive;
2337
2338         &$func($ds, $drive);
2339     }
2340 }
2341
2342 sub foreach_volid {
2343     my ($conf, $func) = @_;
2344
2345     my $volhash = {};
2346
2347     my $test_volid = sub {
2348         my ($volid, $is_cdrom) = @_;
2349
2350         return if !$volid;
2351
2352         $volhash->{$volid} = $is_cdrom || 0;
2353     };
2354
2355     foreach_drive($conf, sub {
2356         my ($ds, $drive) = @_;
2357         &$test_volid($drive->{file}, drive_is_cdrom($drive));
2358     });
2359
2360     foreach my $snapname (keys %{$conf->{snapshots}}) {
2361         my $snap = $conf->{snapshots}->{$snapname};
2362         &$test_volid($snap->{vmstate}, 0);
2363         foreach_drive($snap, sub {
2364             my ($ds, $drive) = @_;
2365             &$test_volid($drive->{file}, drive_is_cdrom($drive));
2366         });
2367     }
2368
2369     foreach my $volid (keys %$volhash) {
2370         &$func($volid, $volhash->{$volid});
2371     }
2372 }
2373
2374 sub vga_conf_has_spice {
2375     my ($vga) = @_;
2376
2377     return 0 if !$vga || $vga !~ m/^qxl([234])?$/;
2378
2379     return $1 || 1;
2380 }
2381
2382 sub config_to_command {
2383     my ($storecfg, $vmid, $conf, $defaults, $forcemachine) = @_;
2384
2385     my $cmd = [];
2386     my $globalFlags = [];
2387     my $machineFlags = [];
2388     my $rtcFlags = [];
2389     my $cpuFlags = [];
2390     my $devices = [];
2391     my $pciaddr = '';
2392     my $bridges = {};
2393     my $kvmver = kvm_user_version();
2394     my $vernum = 0; # unknown
2395     if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
2396         $vernum = $1*1000000+$2*1000;
2397     } elsif ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
2398         $vernum = $1*1000000+$2*1000+$3;
2399     }
2400
2401     die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 15000;
2402
2403     my $have_ovz = -f '/proc/vz/vestat';
2404
2405     my $q35 = machine_type_is_q35($conf);
2406
2407     push @$cmd, '/usr/bin/kvm';
2408
2409     push @$cmd, '-id', $vmid;
2410
2411     my $use_virtio = 0;
2412
2413     my $qmpsocket = qmp_socket($vmid);
2414     push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
2415     push @$cmd, '-mon', "chardev=qmp,mode=control";
2416
2417     my $socket = vnc_socket($vmid);
2418     push @$cmd,  '-vnc', "unix:$socket,x509,password";
2419
2420     push @$cmd, '-pidfile' , pidfile_name($vmid);
2421
2422     push @$cmd, '-daemonize';
2423
2424     if ($conf->{smbios1}) {
2425         push @$cmd, '-smbios', "type=1,$conf->{smbios1}";
2426     }
2427
2428     if ($q35) {
2429         # the q35 chipset support native usb2, so we enable usb controller
2430         # by default for this machine type
2431         push @$devices, '-readconfig', '/usr/share/qemu-server/pve-q35.cfg';
2432     } else {
2433         $pciaddr = print_pci_addr("piix3", $bridges);
2434         push @$devices, '-device', "piix3-usb-uhci,id=uhci$pciaddr.0x2";
2435
2436         my $use_usb2 = 0;
2437         for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
2438             next if !$conf->{"usb$i"};
2439             $use_usb2 = 1;
2440         }
2441         # include usb device config
2442         push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
2443     }
2444
2445     my $vga = $conf->{vga};
2446
2447     my $qxlnum = vga_conf_has_spice($vga);
2448     $vga = 'qxl' if $qxlnum;
2449
2450     if (!$vga) {
2451         if ($conf->{ostype} && ($conf->{ostype} eq 'win8' ||
2452                                 $conf->{ostype} eq 'win7' ||
2453                                 $conf->{ostype} eq 'w2k8')) {
2454             $vga = 'std';
2455         } else {
2456             $vga = 'cirrus';
2457         }
2458     }
2459
2460     # enable absolute mouse coordinates (needed by vnc)
2461     my $tablet;
2462     if (defined($conf->{tablet})) {
2463         $tablet = $conf->{tablet};
2464     } else {
2465         $tablet = $defaults->{tablet};
2466         $tablet = 0 if $qxlnum; # disable for spice because it is not needed
2467         $tablet = 0 if $vga =~ m/^serial\d+$/; # disable if we use serial terminal (no vga card)
2468     }
2469
2470     push @$devices, '-device', print_tabletdevice_full($conf) if $tablet;
2471
2472     # host pci devices
2473     for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
2474         my $d = parse_hostpci($conf->{"hostpci$i"});
2475         next if !$d;
2476
2477         my $pcie = $d->{pcie};
2478         if($pcie){
2479             die "q35 machine model is not enabled" if !$q35;
2480             $pciaddr = print_pcie_addr("hostpci$i");
2481         }else{
2482             $pciaddr = print_pci_addr("hostpci$i", $bridges);
2483         }
2484
2485         my $rombar = $d->{rombar} && $d->{rombar} eq 'off' ? ",rombar=0" : "";
2486         my $driver = $d->{driver} && $d->{driver} eq 'vfio' ? "vfio-pci" : "pci-assign";
2487         my $xvga = $d->{'x-vga'} && $d->{'x-vga'} eq 'on' ? ",x-vga=on" : "";
2488         if ($xvga && $xvga ne '') {
2489             push @$cpuFlags, 'kvm=off';
2490             $vga = 'none';
2491         }
2492         $driver = "vfio-pci" if $xvga ne '';
2493         my $pcidevices = $d->{pciid};
2494         my $multifunction = 1 if @$pcidevices > 1;
2495
2496         my $j=0;
2497         foreach my $pcidevice (@$pcidevices) {
2498
2499             my $id = "hostpci$i";
2500             $id .= ".$j" if $multifunction;
2501             my $addr = $pciaddr;
2502             $addr .= ".$j" if $multifunction;
2503             my $devicestr = "$driver,host=$pcidevice->{id}.$pcidevice->{function},id=$id$addr";
2504
2505             if($j == 0){
2506                 $devicestr .= "$rombar$xvga";
2507                 $devicestr .= ",multifunction=on" if $multifunction;
2508             }
2509
2510             push @$devices, '-device', $devicestr;
2511             $j++;
2512         }
2513     }
2514
2515     # usb devices
2516     for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
2517         my $d = parse_usb_device($conf->{"usb$i"});
2518         next if !$d;
2519         if ($d->{vendorid} && $d->{productid}) {
2520             push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2521         } elsif (defined($d->{hostbus}) && defined($d->{hostport})) {
2522             push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2523         } elsif ($d->{spice}) {
2524             # usb redir support for spice
2525             push @$devices, '-chardev', "spicevmc,id=usbredirchardev$i,name=usbredir";
2526             push @$devices, '-device', "usb-redir,chardev=usbredirchardev$i,id=usbredirdev$i,bus=ehci.0";
2527         }
2528     }
2529
2530     # serial devices
2531     for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++)  {
2532         if (my $path = $conf->{"serial$i"}) {
2533             if ($path eq 'socket') {
2534                 my $socket = "/var/run/qemu-server/${vmid}.serial$i";
2535                 push @$devices, '-chardev', "socket,id=serial$i,path=$socket,server,nowait";
2536                 push @$devices, '-device', "isa-serial,chardev=serial$i";
2537             } else {
2538                 die "no such serial device\n" if ! -c $path;
2539                 push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2540                 push @$devices, '-device', "isa-serial,chardev=serial$i";
2541             }
2542         }
2543     }
2544
2545     # parallel devices
2546     for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++)  {
2547         if (my $path = $conf->{"parallel$i"}) {
2548             die "no such parallel device\n" if ! -c $path;
2549             my $devtype = $path =~ m!^/dev/usb/lp! ? 'tty' : 'parport';
2550             push @$devices, '-chardev', "$devtype,id=parallel$i,path=$path";
2551             push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2552         }
2553     }
2554
2555     my $vmname = $conf->{name} || "vm$vmid";
2556
2557     push @$cmd, '-name', $vmname;
2558
2559     my $sockets = 1;
2560     $sockets = $conf->{smp} if $conf->{smp}; # old style - no longer iused
2561     $sockets = $conf->{sockets} if  $conf->{sockets};
2562
2563     my $cores = $conf->{cores} || 1;
2564     my $maxcpus = $conf->{maxcpus} if $conf->{maxcpus};
2565
2566     if ($maxcpus) {
2567         push @$cmd, '-smp', "cpus=$cores,maxcpus=$maxcpus";
2568     } else {
2569         push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2570     }
2571
2572     push @$cmd, '-nodefaults';
2573
2574     my $bootorder = $conf->{boot} || $confdesc->{boot}->{default};
2575
2576     my $bootindex_hash = {};
2577     my $i = 1;
2578     foreach my $o (split(//, $bootorder)) {
2579         $bootindex_hash->{$o} = $i*100;
2580         $i++;
2581     }
2582
2583     push @$cmd, '-boot', "menu=on";
2584
2585     push @$cmd, '-no-acpi' if defined($conf->{acpi}) && $conf->{acpi} == 0;
2586
2587     push @$cmd, '-no-reboot' if  defined($conf->{reboot}) && $conf->{reboot} == 0;
2588
2589     push @$cmd, '-vga', $vga if $vga && $vga !~ m/^serial\d+$/; # for kvm 77 and later
2590
2591     # time drift fix
2592     my $tdf = defined($conf->{tdf}) ? $conf->{tdf} : $defaults->{tdf};
2593
2594     my $nokvm = defined($conf->{kvm}) && $conf->{kvm} == 0 ? 1 : 0;
2595     my $useLocaltime = $conf->{localtime};
2596
2597     if (my $ost = $conf->{ostype}) {
2598         # other, wxp, w2k, w2k3, w2k8, wvista, win7, win8, l24, l26, solaris
2599
2600         if ($ost =~ m/^w/) { # windows
2601             $useLocaltime = 1 if !defined($conf->{localtime});
2602
2603             # use time drift fix when acpi is enabled
2604             if (!(defined($conf->{acpi}) && $conf->{acpi} == 0)) {
2605                 $tdf = 1 if !defined($conf->{tdf});
2606             }
2607         }
2608
2609         if ($ost eq 'win7' || $ost eq 'win8' || $ost eq 'w2k8' ||
2610             $ost eq 'wvista') {
2611             push @$globalFlags, 'kvm-pit.lost_tick_policy=discard';
2612             push @$cmd, '-no-hpet';
2613             #push @$cpuFlags , 'hv_vapic" if !$nokvm;  #fixme, my win2008R2 hang at boot with this
2614             push @$cpuFlags , 'hv_spinlocks=0xffff' if !$nokvm;
2615         }
2616
2617         if ($ost eq 'win7' || $ost eq 'win8') {
2618             push @$cpuFlags , 'hv_relaxed' if !$nokvm;
2619         }
2620     }
2621
2622     push @$rtcFlags, 'driftfix=slew' if $tdf;
2623
2624     if ($nokvm) {
2625         push @$machineFlags, 'accel=tcg';
2626     } else {
2627         die "No accelerator found!\n" if !$cpuinfo->{hvm};
2628     }
2629
2630     my $machine_type = $forcemachine || $conf->{machine};
2631     if ($machine_type) {
2632         push @$machineFlags, "type=${machine_type}";
2633     }
2634
2635     if ($conf->{startdate}) {
2636         push @$rtcFlags, "base=$conf->{startdate}";
2637     } elsif ($useLocaltime) {
2638         push @$rtcFlags, 'base=localtime';
2639     }
2640
2641     my $cpu = $nokvm ? "qemu64" : "kvm64";
2642     $cpu = $conf->{cpu} if $conf->{cpu};
2643
2644     push @$cpuFlags , '+lahf_lm' if $cpu eq 'kvm64';
2645
2646     push @$cpuFlags , '+x2apic' if !$nokvm && $conf->{ostype} ne 'solaris';
2647
2648     push @$cpuFlags , '-x2apic' if $conf->{ostype} eq 'solaris';
2649
2650     push @$cpuFlags, '+sep' if $cpu eq 'kvm64' || $cpu eq 'kvm32';
2651
2652     $cpu .= "," . join(',', @$cpuFlags) if scalar(@$cpuFlags);
2653
2654     # Note: enforce needs kernel 3.10, so we do not use it for now
2655     # push @$cmd, '-cpu', "$cpu,enforce";
2656     push @$cmd, '-cpu', $cpu;
2657
2658     push @$cmd, '-S' if $conf->{freeze};
2659
2660     # set keyboard layout
2661     my $kb = $conf->{keyboard} || $defaults->{keyboard};
2662     push @$cmd, '-k', $kb if $kb;
2663
2664     # enable sound
2665     #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2666     #push @$cmd, '-soundhw', 'es1370';
2667     #push @$cmd, '-soundhw', $soundhw if $soundhw;
2668
2669     if($conf->{agent}) {
2670         my $qgasocket = qga_socket($vmid);
2671         my $pciaddr = print_pci_addr("qga0", $bridges);
2672         push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
2673         push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
2674         push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
2675     }
2676
2677     my $spice_port;
2678
2679     if ($qxlnum) {
2680         if ($qxlnum > 1) {
2681             if ($conf->{ostype} && $conf->{ostype} =~ m/^w/){
2682                 for(my $i = 1; $i < $qxlnum; $i++){
2683                     my $pciaddr = print_pci_addr("vga$i", $bridges);
2684                     push @$cmd, '-device', "qxl,id=vga$i,ram_size=67108864,vram_size=33554432$pciaddr";
2685                 }
2686             } else {
2687                 # assume other OS works like Linux
2688                 push @$cmd, '-global', 'qxl-vga.ram_size=134217728';
2689                 push @$cmd, '-global', 'qxl-vga.vram_size=67108864';
2690             }
2691         }
2692
2693         my $pciaddr = print_pci_addr("spice", $bridges);
2694
2695         $spice_port = PVE::Tools::next_spice_port();
2696
2697         push @$devices, '-spice', "tls-port=${spice_port},addr=127.0.0.1,tls-ciphers=DES-CBC3-SHA,seamless-migration=on";
2698
2699         push @$devices, '-device', "virtio-serial,id=spice$pciaddr";
2700         push @$devices, '-chardev', "spicevmc,id=vdagent,name=vdagent";
2701         push @$devices, '-device', "virtserialport,chardev=vdagent,name=com.redhat.spice.0";
2702     }
2703
2704     # enable balloon by default, unless explicitly disabled
2705     if (!defined($conf->{balloon}) || $conf->{balloon}) {
2706         $pciaddr = print_pci_addr("balloon0", $bridges);
2707         push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr";
2708     }
2709
2710     if ($conf->{watchdog}) {
2711         my $wdopts = parse_watchdog($conf->{watchdog});
2712         $pciaddr = print_pci_addr("watchdog", $bridges);
2713         my $watchdog = $wdopts->{model} || 'i6300esb';
2714         push @$devices, '-device', "$watchdog$pciaddr";
2715         push @$devices, '-watchdog-action', $wdopts->{action} if $wdopts->{action};
2716     }
2717
2718     my $vollist = [];
2719     my $scsicontroller = {};
2720     my $ahcicontroller = {};
2721     my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : $defaults->{scsihw};
2722
2723     # Add iscsi initiator name if available
2724     if (my $initiator = get_initiator_name()) {
2725         push @$devices, '-iscsi', "initiator-name=$initiator";
2726     }
2727
2728     foreach_drive($conf, sub {
2729         my ($ds, $drive) = @_;
2730
2731         if (PVE::Storage::parse_volume_id($drive->{file}, 1)) {
2732             push @$vollist, $drive->{file};
2733         }
2734
2735         $use_virtio = 1 if $ds =~ m/^virtio/;
2736
2737         if (drive_is_cdrom ($drive)) {
2738             if ($bootindex_hash->{d}) {
2739                 $drive->{bootindex} = $bootindex_hash->{d};
2740                 $bootindex_hash->{d} += 1;
2741             }
2742         } else {
2743             if ($bootindex_hash->{c}) {
2744                 $drive->{bootindex} = $bootindex_hash->{c} if $conf->{bootdisk} && ($conf->{bootdisk} eq $ds);
2745                 $bootindex_hash->{c} += 1;
2746             }
2747         }
2748
2749         if ($drive->{interface} eq 'scsi') {
2750
2751             my $maxdev = ($scsihw !~ m/^lsi/) ? 256 : 7;
2752             my $controller = int($drive->{index} / $maxdev);
2753             $pciaddr = print_pci_addr("scsihw$controller", $bridges);
2754             push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
2755             $scsicontroller->{$controller}=1;
2756         }
2757
2758         if ($drive->{interface} eq 'sata') {
2759            my $controller = int($drive->{index} / $MAX_SATA_DISKS);
2760            $pciaddr = print_pci_addr("ahci$controller", $bridges);
2761            push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
2762            $ahcicontroller->{$controller}=1;
2763         }
2764
2765         my $drive_cmd = print_drive_full($storecfg, $vmid, $drive);
2766         push @$devices, '-drive',$drive_cmd;
2767         push @$devices, '-device', print_drivedevice_full($storecfg, $conf, $vmid, $drive, $bridges);
2768     });
2769
2770     push @$cmd, '-m', $conf->{memory} || $defaults->{memory};
2771
2772     for (my $i = 0; $i < $MAX_NETS; $i++) {
2773          next if !$conf->{"net$i"};
2774          my $d = parse_net($conf->{"net$i"});
2775          next if !$d;
2776
2777          $use_virtio = 1 if $d->{model} eq 'virtio';
2778
2779          if ($bootindex_hash->{n}) {
2780             $d->{bootindex} = $bootindex_hash->{n};
2781             $bootindex_hash->{n} += 1;
2782          }
2783
2784          my $netdevfull = print_netdev_full($vmid,$conf,$d,"net$i");
2785          push @$devices, '-netdev', $netdevfull;
2786
2787          my $netdevicefull = print_netdevice_full($vmid,$conf,$d,"net$i",$bridges);
2788          push @$devices, '-device', $netdevicefull;
2789     }
2790
2791     if (!$q35) {
2792         # add pci bridges
2793         while (my ($k, $v) = each %$bridges) {
2794             $pciaddr = print_pci_addr("pci.$k");
2795             unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
2796         }
2797     }
2798
2799     # hack: virtio with fairsched is unreliable, so we do not use fairsched
2800     # when the VM uses virtio devices.
2801     if (!$use_virtio && $have_ovz) {
2802
2803         my $cpuunits = defined($conf->{cpuunits}) ?
2804             $conf->{cpuunits} : $defaults->{cpuunits};
2805
2806         push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
2807
2808         # fixme: cpulimit is currently ignored
2809         #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2810     }
2811
2812     # add custom args
2813     if ($conf->{args}) {
2814         my $aa = PVE::Tools::split_args($conf->{args});
2815         push @$cmd, @$aa;
2816     }
2817
2818     push @$cmd, @$devices;
2819     push @$cmd, '-rtc', join(',', @$rtcFlags)
2820         if scalar(@$rtcFlags);
2821     push @$cmd, '-machine', join(',', @$machineFlags)
2822         if scalar(@$machineFlags);
2823     push @$cmd, '-global', join(',', @$globalFlags)
2824         if scalar(@$globalFlags);
2825
2826     return wantarray ? ($cmd, $vollist, $spice_port) : $cmd;
2827 }
2828
2829 sub vnc_socket {
2830     my ($vmid) = @_;
2831     return "${var_run_tmpdir}/$vmid.vnc";
2832 }
2833
2834 sub spice_port {
2835     my ($vmid) = @_;
2836
2837     my $res = vm_mon_cmd($vmid, 'query-spice');
2838
2839     return $res->{'tls-port'} || $res->{'port'} || die "no spice port\n";
2840 }
2841
2842 sub qmp_socket {
2843     my ($vmid) = @_;
2844     return "${var_run_tmpdir}/$vmid.qmp";
2845 }
2846
2847 sub qga_socket {
2848     my ($vmid) = @_;
2849     return "${var_run_tmpdir}/$vmid.qga";
2850 }
2851
2852 sub pidfile_name {
2853     my ($vmid) = @_;
2854     return "${var_run_tmpdir}/$vmid.pid";
2855 }
2856
2857 sub vm_devices_list {
2858     my ($vmid) = @_;
2859
2860     my $res = vm_mon_cmd($vmid, 'query-pci');
2861
2862     my $devices = {};
2863     foreach my $pcibus (@$res) {
2864         foreach my $device (@{$pcibus->{devices}}) {
2865             next if !$device->{'qdev_id'};
2866             $devices->{$device->{'qdev_id'}} = $device;
2867         }
2868     }
2869
2870     return $devices;
2871 }
2872
2873 sub vm_deviceplug {
2874     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2875
2876     return 1 if !check_running($vmid);
2877
2878     my $q35 = machine_type_is_q35($conf);
2879
2880     if ($deviceid eq 'tablet') {
2881         qemu_deviceadd($vmid, print_tabletdevice_full($conf));
2882         return 1;
2883     }
2884
2885     return 1 if !$conf->{hotplug};
2886
2887     my $devices_list = vm_devices_list($vmid);
2888     return 1 if defined($devices_list->{$deviceid});
2889
2890     qemu_bridgeadd($storecfg, $conf, $vmid, $deviceid); #add bridge if we need it for the device
2891
2892     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2893         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2894         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
2895         qemu_deviceadd($vmid, $devicefull);
2896         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2897            qemu_drivedel($vmid, $deviceid);
2898            return undef;
2899         }
2900     }
2901
2902     if ($deviceid =~ m/^(scsihw)(\d+)$/) {
2903         my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : "lsi";
2904         my $pciaddr = print_pci_addr($deviceid);
2905         my $devicefull = "$scsihw,id=$deviceid$pciaddr";
2906         qemu_deviceadd($vmid, $devicefull);
2907         return undef if(!qemu_deviceaddverify($vmid, $deviceid));
2908     }
2909
2910     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2911         return 1 if ($conf->{scsihw} && ($conf->{scsihw} !~ m/^lsi/)); #virtio-scsi not yet support hotplug
2912         return undef if !qemu_findorcreatescsihw($storecfg,$conf, $vmid, $device);
2913         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2914         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
2915         if(!qemu_deviceadd($vmid, $devicefull)) {
2916            qemu_drivedel($vmid, $deviceid);
2917            return undef;
2918         }
2919     }
2920
2921     if ($deviceid =~ m/^(net)(\d+)$/) {
2922         return undef if !qemu_netdevadd($vmid, $conf, $device, $deviceid);
2923         my $netdevicefull = print_netdevice_full($vmid, $conf, $device, $deviceid);
2924         qemu_deviceadd($vmid, $netdevicefull);
2925         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2926            qemu_netdevdel($vmid, $deviceid);
2927            return undef;
2928         }
2929     }
2930
2931
2932     if (!$q35 && $deviceid =~ m/^(pci\.)(\d+)$/) {
2933         my $bridgeid = $2;
2934         my $pciaddr = print_pci_addr($deviceid);
2935         my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
2936         qemu_deviceadd($vmid, $devicefull);
2937         return undef if !qemu_deviceaddverify($vmid, $deviceid);
2938     }
2939
2940     return 1;
2941 }
2942
2943 sub vm_deviceunplug {
2944     my ($vmid, $conf, $deviceid) = @_;
2945
2946     return 1 if !check_running ($vmid);
2947
2948     if ($deviceid eq 'tablet') {
2949         qemu_devicedel($vmid, $deviceid);
2950         return 1;
2951     }
2952
2953     return 1 if !$conf->{hotplug};
2954
2955     my $devices_list = vm_devices_list($vmid);
2956     return 1 if !defined($devices_list->{$deviceid});
2957
2958     die "can't unplug bootdisk" if $conf->{bootdisk} && $conf->{bootdisk} eq $deviceid;
2959
2960     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2961         qemu_devicedel($vmid, $deviceid);
2962         return undef if !qemu_devicedelverify($vmid, $deviceid);
2963         return undef if !qemu_drivedel($vmid, $deviceid);
2964     }
2965
2966     if ($deviceid =~ m/^(lsi)(\d+)$/) {
2967         return undef if !qemu_devicedel($vmid, $deviceid);
2968     }
2969
2970     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2971         return undef if !qemu_devicedel($vmid, $deviceid);
2972         return undef if !qemu_drivedel($vmid, $deviceid);
2973     }
2974
2975     if ($deviceid =~ m/^(net)(\d+)$/) {
2976         qemu_devicedel($vmid, $deviceid);
2977         return undef if !qemu_devicedelverify($vmid, $deviceid);
2978         return undef if !qemu_netdevdel($vmid, $deviceid);
2979     }
2980
2981     return 1;
2982 }
2983
2984 sub qemu_deviceadd {
2985     my ($vmid, $devicefull) = @_;
2986
2987     $devicefull = "driver=".$devicefull;
2988     my %options =  split(/[=,]/, $devicefull);
2989
2990     vm_mon_cmd($vmid, "device_add" , %options);
2991     return 1;
2992 }
2993
2994 sub qemu_devicedel {
2995     my($vmid, $deviceid) = @_;
2996     my $ret = vm_mon_cmd($vmid, "device_del", id => $deviceid);
2997     return 1;
2998 }
2999
3000 sub qemu_driveadd {
3001     my($storecfg, $vmid, $device) = @_;
3002
3003     my $drive = print_drive_full($storecfg, $vmid, $device);
3004     my $ret = vm_human_monitor_command($vmid, "drive_add auto $drive");
3005     # If the command succeeds qemu prints: "OK"
3006     if ($ret !~ m/OK/s) {
3007         syslog("err", "adding drive failed: $ret");
3008         return undef;
3009     }
3010     return 1;
3011 }
3012
3013 sub qemu_drivedel {
3014     my($vmid, $deviceid) = @_;
3015
3016     my $ret = vm_human_monitor_command($vmid, "drive_del drive-$deviceid");
3017     $ret =~ s/^\s+//;
3018     if ($ret =~ m/Device \'.*?\' not found/s) {
3019         # NB: device not found errors mean the drive was auto-deleted and we ignore the error
3020     }
3021     elsif ($ret ne "") {
3022       syslog("err", "deleting drive $deviceid failed : $ret");
3023       return undef;
3024     }
3025     return 1;
3026 }
3027
3028 sub qemu_deviceaddverify {
3029     my ($vmid,$deviceid) = @_;
3030
3031     for (my $i = 0; $i <= 5; $i++) {
3032          my $devices_list = vm_devices_list($vmid);
3033          return 1 if defined($devices_list->{$deviceid});
3034          sleep 1;
3035     }
3036     syslog("err", "error on hotplug device $deviceid");
3037     return undef;
3038 }
3039
3040
3041 sub qemu_devicedelverify {
3042     my ($vmid,$deviceid) = @_;
3043
3044     #need to verify the device is correctly remove as device_del is async and empty return is not reliable
3045     for (my $i = 0; $i <= 5; $i++) {
3046          my $devices_list = vm_devices_list($vmid);
3047          return 1 if !defined($devices_list->{$deviceid});
3048          sleep 1;
3049     }
3050     syslog("err", "error on hot-unplugging device $deviceid");
3051     return undef;
3052 }
3053
3054 sub qemu_findorcreatescsihw {
3055     my ($storecfg, $conf, $vmid, $device) = @_;
3056
3057     my $maxdev = ($conf->{scsihw} && ($conf->{scsihw} !~ m/^lsi/)) ? 256 : 7;
3058     my $controller = int($device->{index} / $maxdev);
3059     my $scsihwid="scsihw$controller";
3060     my $devices_list = vm_devices_list($vmid);
3061
3062     if(!defined($devices_list->{$scsihwid})) {
3063        return undef if !vm_deviceplug($storecfg, $conf, $vmid, $scsihwid);
3064     }
3065     return 1;
3066 }
3067
3068 sub qemu_bridgeadd {
3069     my ($storecfg, $conf, $vmid, $device) = @_;
3070
3071     my $bridges = {};
3072     my $bridgeid = undef;
3073     print_pci_addr($device, $bridges);
3074
3075     while (my ($k, $v) = each %$bridges) {
3076         $bridgeid = $k;
3077     }
3078     return if !$bridgeid || $bridgeid < 1;
3079     my $bridge = "pci.$bridgeid";
3080     my $devices_list = vm_devices_list($vmid);
3081
3082     if(!defined($devices_list->{$bridge})) {
3083         return undef if !vm_deviceplug($storecfg, $conf, $vmid, $bridge);
3084     }
3085     return 1;
3086 }
3087
3088 sub qemu_netdevadd {
3089     my ($vmid, $conf, $device, $deviceid) = @_;
3090
3091     my $netdev = print_netdev_full($vmid, $conf, $device, $deviceid);
3092     my %options =  split(/[=,]/, $netdev);
3093
3094     vm_mon_cmd($vmid, "netdev_add",  %options);
3095     return 1;
3096 }
3097
3098 sub qemu_netdevdel {
3099     my ($vmid, $deviceid) = @_;
3100
3101     vm_mon_cmd($vmid, "netdev_del", id => $deviceid);
3102     return 1;
3103 }
3104
3105 sub qemu_cpu_hotplug {
3106     my ($vmid, $conf, $cores) = @_;
3107
3108     die "new cores config is not defined" if !$cores;
3109     die "you can't add more cores than maxcpus"
3110         if $conf->{maxcpus} && ($cores > $conf->{maxcpus});
3111     return if !check_running($vmid);
3112
3113     my $currentcores = $conf->{cores} if $conf->{cores};
3114     die "current cores is not defined" if !$currentcores;
3115     die "maxcpus is not defined" if !$conf->{maxcpus};
3116     raise_param_exc({ 'cores' => "online cpu unplug is not yet possible" })
3117         if($cores < $currentcores);
3118
3119     my $currentrunningcores = vm_mon_cmd($vmid, "query-cpus");
3120     raise_param_exc({ 'cores' => "cores number if running vm is different than configuration" })
3121         if scalar (@{$currentrunningcores}) != $currentcores;
3122
3123     for(my $i = $currentcores; $i < $cores; $i++) {
3124         vm_mon_cmd($vmid, "cpu-add", id => int($i));
3125     }
3126 }
3127
3128 sub qemu_block_set_io_throttle {
3129     my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
3130
3131     return if !check_running($vmid) ;
3132
3133     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));
3134
3135 }
3136
3137 # old code, only used to shutdown old VM after update
3138 sub __read_avail {
3139     my ($fh, $timeout) = @_;
3140
3141     my $sel = new IO::Select;
3142     $sel->add($fh);
3143
3144     my $res = '';
3145     my $buf;
3146
3147     my @ready;
3148     while (scalar (@ready = $sel->can_read($timeout))) {
3149         my $count;
3150         if ($count = $fh->sysread($buf, 8192)) {
3151             if ($buf =~ /^(.*)\(qemu\) $/s) {
3152                 $res .= $1;
3153                 last;
3154             } else {
3155                 $res .= $buf;
3156             }
3157         } else {
3158             if (!defined($count)) {
3159                 die "$!\n";
3160             }
3161             last;
3162         }
3163     }
3164
3165     die "monitor read timeout\n" if !scalar(@ready);
3166
3167     return $res;
3168 }
3169
3170 # old code, only used to shutdown old VM after update
3171 sub vm_monitor_command {
3172     my ($vmid, $cmdstr, $nocheck) = @_;
3173
3174     my $res;
3175
3176     eval {
3177         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
3178
3179         my $sname = "${var_run_tmpdir}/$vmid.mon";
3180
3181         my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
3182             die "unable to connect to VM $vmid socket - $!\n";
3183
3184         my $timeout = 3;
3185
3186         # hack: migrate sometime blocks the monitor (when migrate_downtime
3187         # is set)
3188         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3189             $timeout = 60*60; # 1 hour
3190         }
3191
3192         # read banner;
3193         my $data = __read_avail($sock, $timeout);
3194
3195         if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
3196             die "got unexpected qemu monitor banner\n";
3197         }
3198
3199         my $sel = new IO::Select;
3200         $sel->add($sock);
3201
3202         if (!scalar(my @ready = $sel->can_write($timeout))) {
3203             die "monitor write error - timeout";
3204         }
3205
3206         my $fullcmd = "$cmdstr\r";
3207
3208         # syslog('info', "VM $vmid monitor command: $cmdstr");
3209
3210         my $b;
3211         if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
3212             die "monitor write error - $!";
3213         }
3214
3215         return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
3216
3217         $timeout = 20;
3218
3219         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3220             $timeout = 60*60; # 1 hour
3221         } elsif ($cmdstr =~ m/^(eject|change)/) {
3222             $timeout = 60; # note: cdrom mount command is slow
3223         }
3224         if ($res = __read_avail($sock, $timeout)) {
3225
3226             my @lines = split("\r?\n", $res);
3227
3228             shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
3229
3230             $res = join("\n", @lines);
3231             $res .= "\n";
3232         }
3233     };
3234
3235     my $err = $@;
3236
3237     if ($err) {
3238         syslog("err", "VM $vmid monitor command failed - $err");
3239         die $err;
3240     }
3241
3242     return $res;
3243 }
3244
3245 sub qemu_block_resize {
3246     my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
3247
3248     my $running = check_running($vmid);
3249
3250     return if !PVE::Storage::volume_resize($storecfg, $volid, $size, $running);
3251
3252     return if !$running;
3253
3254     vm_mon_cmd($vmid, "block_resize", device => $deviceid, size => int($size));
3255
3256 }
3257
3258 sub qemu_volume_snapshot {
3259     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3260
3261     my $running = check_running($vmid);
3262
3263     return if !PVE::Storage::volume_snapshot($storecfg, $volid, $snap, $running);
3264
3265     return if !$running;
3266
3267     vm_mon_cmd($vmid, "snapshot-drive", device => $deviceid, name => $snap);
3268
3269 }
3270
3271 sub qemu_volume_snapshot_delete {
3272     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3273
3274     my $running = check_running($vmid);
3275
3276     return if !PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snap, $running);
3277
3278     return if !$running;
3279
3280     vm_mon_cmd($vmid, "delete-drive-snapshot", device => $deviceid, name => $snap);
3281 }
3282
3283 sub qga_freezefs {
3284     my ($vmid) = @_;
3285
3286     #need to impplement call to qemu-ga
3287 }
3288
3289 sub qga_unfreezefs {
3290     my ($vmid) = @_;
3291
3292     #need to impplement call to qemu-ga
3293 }
3294
3295 sub set_migration_caps {
3296     my ($vmid) = @_;
3297
3298     my $cap_ref = [];
3299
3300     my $enabled_cap = {
3301         "auto-converge" => 1,
3302         "xbzrle" => 0,
3303         "x-rdma-pin-all" => 0,
3304         "zero-blocks" => 0,
3305     };
3306
3307     my $supported_capabilities = vm_mon_cmd_nocheck($vmid, "query-migrate-capabilities");
3308
3309     for my $supported_capability (@$supported_capabilities) {
3310         push @$cap_ref, {
3311             capability => $supported_capability->{capability},
3312             state => $enabled_cap->{$supported_capability->{capability}} ? JSON::true : JSON::false,
3313         };
3314     }
3315
3316     vm_mon_cmd_nocheck($vmid, "migrate-set-capabilities", capabilities => $cap_ref);
3317 }
3318
3319 sub vm_start {
3320     my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused, $forcemachine, $spice_ticket) = @_;
3321
3322     lock_config($vmid, sub {
3323         my $conf = load_config($vmid, $migratedfrom);
3324
3325         die "you can't start a vm if it's a template\n" if is_template($conf);
3326
3327         check_lock($conf) if !$skiplock;
3328
3329         die "VM $vmid already running\n" if check_running($vmid, undef, $migratedfrom);
3330
3331         my $defaults = load_defaults();
3332
3333         # set environment variable useful inside network script
3334         $ENV{PVE_MIGRATED_FROM} = $migratedfrom if $migratedfrom;
3335
3336         my ($cmd, $vollist, $spice_port) = config_to_command($storecfg, $vmid, $conf, $defaults, $forcemachine);
3337
3338         my $migrate_port = 0;
3339         my $migrate_uri;
3340         if ($statefile) {
3341             if ($statefile eq 'tcp') {
3342                 my $localip = "localhost";
3343                 my $datacenterconf = PVE::Cluster::cfs_read_file('datacenter.cfg');
3344                 if ($datacenterconf->{migration_unsecure}) {
3345                         my $nodename = PVE::INotify::nodename();
3346                         $localip = PVE::Cluster::remote_node_ip($nodename, 1);
3347                 }
3348                 $migrate_port = PVE::Tools::next_migrate_port();
3349                 $migrate_uri = "tcp:${localip}:${migrate_port}";
3350                 push @$cmd, '-incoming', $migrate_uri;
3351                 push @$cmd, '-S';
3352             } else {
3353                 push @$cmd, '-loadstate', $statefile;
3354             }
3355         } elsif ($paused) {
3356             push @$cmd, '-S';
3357         }
3358
3359         # host pci devices
3360         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
3361           my $d = parse_hostpci($conf->{"hostpci$i"});
3362           next if !$d;
3363           my $pcidevices = $d->{pciid};
3364           foreach my $pcidevice (@$pcidevices) {
3365                 my $pciid = $pcidevice->{id}.".".$pcidevice->{function};
3366
3367                 my $info = pci_device_info("0000:$pciid");
3368                 die "IOMMU not present\n" if !check_iommu_support();
3369                 die "no pci device info for device '$pciid'\n" if !$info;
3370
3371                 if ($d->{driver} && $d->{driver} eq "vfio") {
3372                     die "can't unbind/bind pci group to vfio '$pciid'\n" if !pci_dev_group_bind_to_vfio($pciid);
3373                 } else {
3374                     die "can't unbind/bind to stub pci device '$pciid'\n" if !pci_dev_bind_to_stub($info);
3375                 }
3376
3377                 die "can't reset pci device '$pciid'\n" if $info->{has_fl_reset} and !pci_dev_reset($info);
3378           }
3379         }
3380
3381         PVE::Storage::activate_volumes($storecfg, $vollist);
3382
3383         eval  { run_command($cmd, timeout => $statefile ? undef : 30,
3384                     umask => 0077); };
3385         my $err = $@;
3386         die "start failed: $err" if $err;
3387
3388         print "migration listens on $migrate_uri\n" if $migrate_uri;
3389
3390         if ($statefile && $statefile ne 'tcp')  {
3391             eval { vm_mon_cmd_nocheck($vmid, "cont"); };
3392             warn $@ if $@;
3393         }
3394
3395         if ($migratedfrom) {
3396
3397             eval {
3398                 PVE::QemuServer::set_migration_caps($vmid);
3399             };
3400             warn $@ if $@;
3401
3402             if ($spice_port) {
3403                 print "spice listens on port $spice_port\n";
3404                 if ($spice_ticket) {
3405                     PVE::QemuServer::vm_mon_cmd_nocheck($vmid, "set_password", protocol => 'spice', password => $spice_ticket);
3406                     PVE::QemuServer::vm_mon_cmd_nocheck($vmid, "expire_password", protocol => 'spice', time => "+30");
3407                 }
3408             }
3409
3410         } else {
3411
3412             if (!$statefile && (!defined($conf->{balloon}) || $conf->{balloon})) {
3413                 vm_mon_cmd_nocheck($vmid, "balloon", value => $conf->{balloon}*1024*1024)
3414                     if $conf->{balloon};
3415                 vm_mon_cmd_nocheck($vmid, 'qom-set',
3416                             path => "machine/peripheral/balloon0",
3417                             property => "guest-stats-polling-interval",
3418                             value => 2);
3419             }
3420         }
3421     });
3422 }
3423
3424 sub vm_mon_cmd {
3425     my ($vmid, $execute, %params) = @_;
3426
3427     my $cmd = { execute => $execute, arguments => \%params };
3428     vm_qmp_command($vmid, $cmd);
3429 }
3430
3431 sub vm_mon_cmd_nocheck {
3432     my ($vmid, $execute, %params) = @_;
3433
3434     my $cmd = { execute => $execute, arguments => \%params };
3435     vm_qmp_command($vmid, $cmd, 1);
3436 }
3437
3438 sub vm_qmp_command {
3439     my ($vmid, $cmd, $nocheck) = @_;
3440
3441     my $res;
3442
3443     my $timeout;
3444     if ($cmd->{arguments} && $cmd->{arguments}->{timeout}) {
3445         $timeout = $cmd->{arguments}->{timeout};
3446         delete $cmd->{arguments}->{timeout};
3447     }
3448
3449     eval {
3450         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
3451         my $sname = qmp_socket($vmid);
3452         if (-e $sname) {
3453             my $qmpclient = PVE::QMPClient->new();
3454
3455             $res = $qmpclient->cmd($vmid, $cmd, $timeout);
3456         } elsif (-e "${var_run_tmpdir}/$vmid.mon") {
3457             die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
3458                 if scalar(%{$cmd->{arguments}});
3459             vm_monitor_command($vmid, $cmd->{execute}, $nocheck);
3460         } else {
3461             die "unable to open monitor socket\n";
3462         }
3463     };
3464     if (my $err = $@) {
3465         syslog("err", "VM $vmid qmp command failed - $err");
3466         die $err;
3467     }
3468
3469     return $res;
3470 }
3471
3472 sub vm_human_monitor_command {
3473     my ($vmid, $cmdline) = @_;
3474
3475     my $res;
3476
3477     my $cmd = {
3478         execute => 'human-monitor-command',
3479         arguments => { 'command-line' => $cmdline},
3480     };
3481
3482     return vm_qmp_command($vmid, $cmd);
3483 }
3484
3485 sub vm_commandline {
3486     my ($storecfg, $vmid) = @_;
3487
3488     my $conf = load_config($vmid);
3489
3490     my $defaults = load_defaults();
3491
3492     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
3493
3494     return join(' ', @$cmd);
3495 }
3496
3497 sub vm_reset {
3498     my ($vmid, $skiplock) = @_;
3499
3500     lock_config($vmid, sub {
3501
3502         my $conf = load_config($vmid);
3503
3504         check_lock($conf) if !$skiplock;
3505
3506         vm_mon_cmd($vmid, "system_reset");
3507     });
3508 }
3509
3510 sub get_vm_volumes {
3511     my ($conf) = @_;
3512
3513     my $vollist = [];
3514     foreach_volid($conf, sub {
3515         my ($volid, $is_cdrom) = @_;
3516
3517         return if $volid =~ m|^/|;
3518
3519         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
3520         return if !$sid;
3521
3522         push @$vollist, $volid;
3523     });
3524
3525     return $vollist;
3526 }
3527
3528 sub vm_stop_cleanup {
3529     my ($storecfg, $vmid, $conf, $keepActive) = @_;
3530
3531     eval {
3532         fairsched_rmnod($vmid); # try to destroy group
3533
3534         if (!$keepActive) {
3535             my $vollist = get_vm_volumes($conf);
3536             PVE::Storage::deactivate_volumes($storecfg, $vollist);
3537         }
3538
3539         foreach my $ext (qw(mon qmp pid vnc qga)) {
3540             unlink "/var/run/qemu-server/${vmid}.$ext";
3541         }
3542     };
3543     warn $@ if $@; # avoid errors - just warn
3544 }
3545
3546 # Note: use $nockeck to skip tests if VM configuration file exists.
3547 # We need that when migration VMs to other nodes (files already moved)
3548 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3549 sub vm_stop {
3550     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3551
3552     $force = 1 if !defined($force) && !$shutdown;
3553
3554     if ($migratedfrom){
3555         my $pid = check_running($vmid, $nocheck, $migratedfrom);
3556         kill 15, $pid if $pid;
3557         my $conf = load_config($vmid, $migratedfrom);
3558         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive);
3559         return;
3560     }
3561
3562     lock_config($vmid, sub {
3563
3564         my $pid = check_running($vmid, $nocheck);
3565         return if !$pid;
3566
3567         my $conf;
3568         if (!$nocheck) {
3569             $conf = load_config($vmid);
3570             check_lock($conf) if !$skiplock;
3571             if (!defined($timeout) && $shutdown && $conf->{startup}) {
3572                 my $opts = parse_startup($conf->{startup});
3573                 $timeout = $opts->{down} if $opts->{down};
3574             }
3575         }
3576
3577         $timeout = 60 if !defined($timeout);
3578
3579         eval {
3580             if ($shutdown) {
3581                 $nocheck ? vm_mon_cmd_nocheck($vmid, "system_powerdown") : vm_mon_cmd($vmid, "system_powerdown");
3582
3583             } else {
3584                 $nocheck ? vm_mon_cmd_nocheck($vmid, "quit") : vm_mon_cmd($vmid, "quit");
3585             }
3586         };
3587         my $err = $@;
3588
3589         if (!$err) {
3590             my $count = 0;
3591             while (($count < $timeout) && check_running($vmid, $nocheck)) {
3592                 $count++;
3593                 sleep 1;
3594             }
3595
3596             if ($count >= $timeout) {
3597                 if ($force) {
3598                     warn "VM still running - terminating now with SIGTERM\n";
3599                     kill 15, $pid;
3600                 } else {
3601                     die "VM quit/powerdown failed - got timeout\n";
3602                 }
3603             } else {
3604                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3605                 return;
3606             }
3607         } else {
3608             if ($force) {
3609                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3610                 kill 15, $pid;
3611             } else {
3612                 die "VM quit/powerdown failed\n";
3613             }
3614         }
3615
3616         # wait again
3617         $timeout = 10;
3618
3619         my $count = 0;
3620         while (($count < $timeout) && check_running($vmid, $nocheck)) {
3621             $count++;
3622             sleep 1;
3623         }
3624
3625         if ($count >= $timeout) {
3626             warn "VM still running - terminating now with SIGKILL\n";
3627             kill 9, $pid;
3628             sleep 1;
3629         }
3630
3631         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3632    });
3633 }
3634
3635 sub vm_suspend {
3636     my ($vmid, $skiplock) = @_;
3637
3638     lock_config($vmid, sub {
3639
3640         my $conf = load_config($vmid);
3641
3642         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3643
3644         vm_mon_cmd($vmid, "stop");
3645     });
3646 }
3647
3648 sub vm_resume {
3649     my ($vmid, $skiplock) = @_;
3650
3651     lock_config($vmid, sub {
3652
3653         my $conf = load_config($vmid);
3654
3655         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3656
3657         vm_mon_cmd($vmid, "cont");
3658     });
3659 }
3660
3661 sub vm_sendkey {
3662     my ($vmid, $skiplock, $key) = @_;
3663
3664     lock_config($vmid, sub {
3665
3666         my $conf = load_config($vmid);
3667
3668         # there is no qmp command, so we use the human monitor command
3669         vm_human_monitor_command($vmid, "sendkey $key");
3670     });
3671 }
3672
3673 sub vm_destroy {
3674     my ($storecfg, $vmid, $skiplock) = @_;
3675
3676     lock_config($vmid, sub {
3677
3678         my $conf = load_config($vmid);
3679
3680         check_lock($conf) if !$skiplock;
3681
3682         if (!check_running($vmid)) {
3683             fairsched_rmnod($vmid); # try to destroy group
3684             destroy_vm($storecfg, $vmid);
3685         } else {
3686             die "VM $vmid is running - destroy failed\n";
3687         }
3688     });
3689 }
3690
3691 # pci helpers
3692
3693 sub file_write {
3694     my ($filename, $buf) = @_;
3695
3696     my $fh = IO::File->new($filename, "w");
3697     return undef if !$fh;
3698
3699     my $res = print $fh $buf;
3700
3701     $fh->close();
3702
3703     return $res;
3704 }
3705
3706 sub pci_device_info {
3707     my ($name) = @_;
3708
3709     my $res;
3710
3711     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3712     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3713
3714     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
3715     return undef if !defined($irq) || $irq !~ m/^\d+$/;
3716
3717     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
3718     return undef if !defined($vendor) || $vendor !~ s/^0x//;
3719
3720     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
3721     return undef if !defined($product) || $product !~ s/^0x//;
3722
3723     $res = {
3724         name => $name,
3725         vendor => $vendor,
3726         product => $product,
3727         domain => $domain,
3728         bus => $bus,
3729         slot => $slot,
3730         func => $func,
3731         irq => $irq,
3732         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
3733     };
3734
3735     return $res;
3736 }
3737
3738 sub pci_dev_reset {
3739     my ($dev) = @_;
3740
3741     my $name = $dev->{name};
3742
3743     my $fn = "$pcisysfs/devices/$name/reset";
3744
3745     return file_write($fn, "1");
3746 }
3747
3748 sub pci_dev_bind_to_stub {
3749     my ($dev) = @_;
3750
3751     my $name = $dev->{name};
3752
3753     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3754     return 1 if -d $testdir;
3755
3756     my $data = "$dev->{vendor} $dev->{product}";
3757     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
3758
3759     my $fn = "$pcisysfs/devices/$name/driver/unbind";
3760     if (!file_write($fn, $name)) {
3761         return undef if -f $fn;
3762     }
3763
3764     $fn = "$pcisysfs/drivers/pci-stub/bind";
3765     if (! -d $testdir) {
3766         return undef if !file_write($fn, $name);
3767     }
3768
3769     return -d $testdir;
3770 }
3771
3772 sub pci_dev_bind_to_vfio {
3773     my ($dev) = @_;
3774
3775     my $name = $dev->{name};
3776
3777     my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
3778
3779     if (!-d $vfio_basedir) {
3780         system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
3781     }
3782     die "Cannot find vfio-pci module!\n" if !-d $vfio_basedir;
3783
3784     my $testdir = "$vfio_basedir/$name";
3785     return 1 if -d $testdir;
3786
3787     my $data = "$dev->{vendor} $dev->{product}";
3788     return undef if !file_write("$vfio_basedir/new_id", $data);
3789
3790     my $fn = "$pcisysfs/devices/$name/driver/unbind";
3791     if (!file_write($fn, $name)) {
3792         return undef if -f $fn;
3793     }
3794
3795     $fn = "$vfio_basedir/bind";
3796     if (! -d $testdir) {
3797         return undef if !file_write($fn, $name);
3798     }
3799
3800     return -d $testdir;
3801 }
3802
3803 sub pci_dev_group_bind_to_vfio {
3804     my ($pciid) = @_;
3805
3806     my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
3807
3808     if (!-d $vfio_basedir) {
3809         system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
3810     }
3811     die "Cannot find vfio-pci module!\n" if !-d $vfio_basedir;
3812
3813     # get IOMMU group devices
3814     opendir(my $D, "$pcisysfs/devices/0000:$pciid/iommu_group/devices/") || die "Cannot open iommu_group: $!\n";
3815       my @devs = grep /^0000:/, readdir($D);
3816     closedir($D);
3817
3818     foreach my $pciid (@devs) {
3819         $pciid =~ m/^([:\.\da-f]+)$/ or die "PCI ID $pciid not valid!\n";
3820         my $info = pci_device_info($1);
3821         pci_dev_bind_to_vfio($info) || die "Cannot bind $pciid to vfio\n";
3822     }
3823
3824     return 1;
3825 }
3826
3827 sub print_pci_addr {
3828     my ($id, $bridges) = @_;
3829
3830     my $res = '';
3831     my $devices = {
3832         piix3 => { bus => 0, addr => 1 },
3833         #addr2 : first videocard
3834         balloon0 => { bus => 0, addr => 3 },
3835         watchdog => { bus => 0, addr => 4 },
3836         scsihw0 => { bus => 0, addr => 5 },
3837         scsihw1 => { bus => 0, addr => 6 },
3838         ahci0 => { bus => 0, addr => 7 },
3839         qga0 => { bus => 0, addr => 8 },
3840         spice => { bus => 0, addr => 9 },
3841         virtio0 => { bus => 0, addr => 10 },
3842         virtio1 => { bus => 0, addr => 11 },
3843         virtio2 => { bus => 0, addr => 12 },
3844         virtio3 => { bus => 0, addr => 13 },
3845         virtio4 => { bus => 0, addr => 14 },
3846         virtio5 => { bus => 0, addr => 15 },
3847         hostpci0 => { bus => 0, addr => 16 },
3848         hostpci1 => { bus => 0, addr => 17 },
3849         net0 => { bus => 0, addr => 18 },
3850         net1 => { bus => 0, addr => 19 },
3851         net2 => { bus => 0, addr => 20 },
3852         net3 => { bus => 0, addr => 21 },
3853         net4 => { bus => 0, addr => 22 },
3854         net5 => { bus => 0, addr => 23 },
3855         vga1 => { bus => 0, addr => 24 },
3856         vga2 => { bus => 0, addr => 25 },
3857         vga3 => { bus => 0, addr => 26 },
3858         hostpci2 => { bus => 0, addr => 27 },
3859         hostpci3 => { bus => 0, addr => 28 },
3860         #addr29 : usb-host (pve-usb.cfg)
3861         'pci.1' => { bus => 0, addr => 30 },
3862         'pci.2' => { bus => 0, addr => 31 },
3863         'net6' => { bus => 1, addr => 1 },
3864         'net7' => { bus => 1, addr => 2 },
3865         'net8' => { bus => 1, addr => 3 },
3866         'net9' => { bus => 1, addr => 4 },
3867         'net10' => { bus => 1, addr => 5 },
3868         'net11' => { bus => 1, addr => 6 },
3869         'net12' => { bus => 1, addr => 7 },
3870         'net13' => { bus => 1, addr => 8 },
3871         'net14' => { bus => 1, addr => 9 },
3872         'net15' => { bus => 1, addr => 10 },
3873         'net16' => { bus => 1, addr => 11 },
3874         'net17' => { bus => 1, addr => 12 },
3875         'net18' => { bus => 1, addr => 13 },
3876         'net19' => { bus => 1, addr => 14 },
3877         'net20' => { bus => 1, addr => 15 },
3878         'net21' => { bus => 1, addr => 16 },
3879         'net22' => { bus => 1, addr => 17 },
3880         'net23' => { bus => 1, addr => 18 },
3881         'net24' => { bus => 1, addr => 19 },
3882         'net25' => { bus => 1, addr => 20 },
3883         'net26' => { bus => 1, addr => 21 },
3884         'net27' => { bus => 1, addr => 22 },
3885         'net28' => { bus => 1, addr => 23 },
3886         'net29' => { bus => 1, addr => 24 },
3887         'net30' => { bus => 1, addr => 25 },
3888         'net31' => { bus => 1, addr => 26 },
3889         'virtio6' => { bus => 2, addr => 1 },
3890         'virtio7' => { bus => 2, addr => 2 },
3891         'virtio8' => { bus => 2, addr => 3 },
3892         'virtio9' => { bus => 2, addr => 4 },
3893         'virtio10' => { bus => 2, addr => 5 },
3894         'virtio11' => { bus => 2, addr => 6 },
3895         'virtio12' => { bus => 2, addr => 7 },
3896         'virtio13' => { bus => 2, addr => 8 },
3897         'virtio14' => { bus => 2, addr => 9 },
3898         'virtio15' => { bus => 2, addr => 10 },
3899     };
3900
3901     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
3902            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
3903            my $bus = $devices->{$id}->{bus};
3904            $res = ",bus=pci.$bus,addr=$addr";
3905            $bridges->{$bus} = 1 if $bridges;
3906     }
3907     return $res;
3908
3909 }
3910
3911 sub print_pcie_addr {
3912     my ($id) = @_;
3913
3914     my $res = '';
3915     my $devices = {
3916         hostpci0 => { bus => "ich9-pcie-port-1", addr => 0 },
3917         hostpci1 => { bus => "ich9-pcie-port-2", addr => 0 },
3918         hostpci2 => { bus => "ich9-pcie-port-3", addr => 0 },
3919         hostpci3 => { bus => "ich9-pcie-port-4", addr => 0 },
3920     };
3921
3922     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
3923            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
3924            my $bus = $devices->{$id}->{bus};
3925            $res = ",bus=$bus,addr=$addr";
3926     }
3927     return $res;
3928
3929 }
3930
3931 # vzdump restore implementaion
3932
3933 sub tar_archive_read_firstfile {
3934     my $archive = shift;
3935
3936     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
3937
3938     # try to detect archive type first
3939     my $pid = open (TMP, "tar tf '$archive'|") ||
3940         die "unable to open file '$archive'\n";
3941     my $firstfile = <TMP>;
3942     kill 15, $pid;
3943     close TMP;
3944
3945     die "ERROR: archive contaions no data\n" if !$firstfile;
3946     chomp $firstfile;
3947
3948     return $firstfile;
3949 }
3950
3951 sub tar_restore_cleanup {
3952     my ($storecfg, $statfile) = @_;
3953
3954     print STDERR "starting cleanup\n";
3955
3956     if (my $fd = IO::File->new($statfile, "r")) {
3957         while (defined(my $line = <$fd>)) {
3958             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3959                 my $volid = $2;
3960                 eval {
3961                     if ($volid =~ m|^/|) {
3962                         unlink $volid || die 'unlink failed\n';
3963                     } else {
3964                         PVE::Storage::vdisk_free($storecfg, $volid);
3965                     }
3966                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
3967                 };
3968                 print STDERR "unable to cleanup '$volid' - $@" if $@;
3969             } else {
3970                 print STDERR "unable to parse line in statfile - $line";
3971             }
3972         }
3973         $fd->close();
3974     }
3975 }
3976
3977 sub restore_archive {
3978     my ($archive, $vmid, $user, $opts) = @_;
3979
3980     my $format = $opts->{format};
3981     my $comp;
3982
3983     if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
3984         $format = 'tar' if !$format;
3985         $comp = 'gzip';
3986     } elsif ($archive =~ m/\.tar$/) {
3987         $format = 'tar' if !$format;
3988     } elsif ($archive =~ m/.tar.lzo$/) {
3989         $format = 'tar' if !$format;
3990         $comp = 'lzop';
3991     } elsif ($archive =~ m/\.vma$/) {
3992         $format = 'vma' if !$format;
3993     } elsif ($archive =~ m/\.vma\.gz$/) {
3994         $format = 'vma' if !$format;
3995         $comp = 'gzip';
3996     } elsif ($archive =~ m/\.vma\.lzo$/) {
3997         $format = 'vma' if !$format;
3998         $comp = 'lzop';
3999     } else {
4000         $format = 'vma' if !$format; # default
4001     }
4002
4003     # try to detect archive format
4004     if ($format eq 'tar') {
4005         return restore_tar_archive($archive, $vmid, $user, $opts);
4006     } else {
4007         return restore_vma_archive($archive, $vmid, $user, $opts, $comp);
4008     }
4009 }
4010
4011 sub restore_update_config_line {
4012     my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
4013
4014     return if $line =~ m/^\#qmdump\#/;
4015     return if $line =~ m/^\#vzdump\#/;
4016     return if $line =~ m/^lock:/;
4017     return if $line =~ m/^unused\d+:/;
4018     return if $line =~ m/^parent:/;
4019     return if $line =~ m/^template:/; # restored VM is never a template
4020
4021     if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
4022         # try to convert old 1.X settings
4023         my ($id, $ind, $ethcfg) = ($1, $2, $3);
4024         foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
4025             my ($model, $macaddr) = split(/\=/, $devconfig);
4026             $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $unique;
4027             my $net = {
4028                 model => $model,
4029                 bridge => "vmbr$ind",
4030                 macaddr => $macaddr,
4031             };
4032             my $netstr = print_net($net);
4033
4034             print $outfd "net$cookie->{netcount}: $netstr\n";
4035             $cookie->{netcount}++;
4036         }
4037     } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
4038         my ($id, $netstr) = ($1, $2);
4039         my $net = parse_net($netstr);
4040         $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
4041         $netstr = print_net($net);
4042         print $outfd "$id: $netstr\n";
4043     } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
4044         my $virtdev = $1;
4045         my $value = $3;
4046         if ($line =~ m/backup=no/) {
4047             print $outfd "#$line";
4048         } elsif ($virtdev && $map->{$virtdev}) {
4049             my $di = parse_drive($virtdev, $value);
4050             delete $di->{format}; # format can change on restore
4051             $di->{file} = $map->{$virtdev};
4052             $value = print_drive($vmid, $di);
4053             print $outfd "$virtdev: $value\n";
4054         } else {
4055             print $outfd $line;
4056         }
4057     } else {
4058         print $outfd $line;
4059     }
4060 }
4061
4062 sub scan_volids {
4063     my ($cfg, $vmid) = @_;
4064
4065     my $info = PVE::Storage::vdisk_list($cfg, undef, $vmid);
4066
4067     my $volid_hash = {};
4068     foreach my $storeid (keys %$info) {
4069         foreach my $item (@{$info->{$storeid}}) {
4070             next if !($item->{volid} && $item->{size});
4071             $item->{path} = PVE::Storage::path($cfg, $item->{volid});
4072             $volid_hash->{$item->{volid}} = $item;
4073         }
4074     }
4075
4076     return $volid_hash;
4077 }
4078
4079 sub get_used_paths {
4080     my ($vmid, $storecfg, $conf, $scan_snapshots, $skip_drive) = @_;
4081
4082     my $used_path = {};
4083
4084     my $scan_config = sub {
4085         my ($cref, $snapname) = @_;
4086
4087         foreach my $key (keys %$cref) {
4088             my $value = $cref->{$key};
4089             if (valid_drivename($key)) {
4090                 next if $skip_drive && $key eq $skip_drive;
4091                 my $drive = parse_drive($key, $value);
4092                 next if !$drive || !$drive->{file} || drive_is_cdrom($drive);
4093                 if ($drive->{file} =~ m!^/!) {
4094                     $used_path->{$drive->{file}}++; # = 1;
4095                 } else {
4096                     my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file}, 1);
4097                     next if !$storeid;
4098                     my $scfg = PVE::Storage::storage_config($storecfg, $storeid, 1);
4099                     next if !$scfg;
4100                     my $path = PVE::Storage::path($storecfg, $drive->{file}, $snapname);
4101                     $used_path->{$path}++; # = 1;
4102                 }
4103             }
4104         }
4105     };
4106
4107     &$scan_config($conf);
4108
4109     undef $skip_drive;
4110
4111     if ($scan_snapshots) {
4112         foreach my $snapname (keys %{$conf->{snapshots}}) {
4113             &$scan_config($conf->{snapshots}->{$snapname}, $snapname);
4114         }
4115     }
4116
4117     return $used_path;
4118 }
4119
4120 sub update_disksize {
4121     my ($vmid, $conf, $volid_hash) = @_;
4122
4123     my $changes;
4124
4125     my $used = {};
4126
4127     # Note: it is allowed to define multiple storages with same path (alias), so
4128     # we need to check both 'volid' and real 'path' (two different volid can point
4129     # to the same path).
4130
4131     my $usedpath = {};
4132
4133     # update size info
4134     foreach my $opt (keys %$conf) {
4135         if (valid_drivename($opt)) {
4136             my $drive = parse_drive($opt, $conf->{$opt});
4137             my $volid = $drive->{file};
4138             next if !$volid;
4139
4140             $used->{$volid} = 1;
4141             if ($volid_hash->{$volid} &&
4142                 (my $path = $volid_hash->{$volid}->{path})) {
4143                 $usedpath->{$path} = 1;
4144             }
4145
4146             next if drive_is_cdrom($drive);
4147             next if !$volid_hash->{$volid};
4148
4149             $drive->{size} = $volid_hash->{$volid}->{size};
4150             my $new = print_drive($vmid, $drive);
4151             if ($new ne $conf->{$opt}) {
4152                 $changes = 1;
4153                 $conf->{$opt} = $new;
4154             }
4155         }
4156     }
4157
4158     # remove 'unusedX' entry if volume is used
4159     foreach my $opt (keys %$conf) {
4160         next if $opt !~ m/^unused\d+$/;
4161         my $volid = $conf->{$opt};
4162         my $path = $volid_hash->{$volid}->{path} if $volid_hash->{$volid};
4163         if ($used->{$volid} || ($path && $usedpath->{$path})) {
4164             $changes = 1;
4165             delete $conf->{$opt};
4166         }
4167     }
4168
4169     foreach my $volid (sort keys %$volid_hash) {
4170         next if $volid =~ m/vm-$vmid-state-/;
4171         next if $used->{$volid};
4172         my $path = $volid_hash->{$volid}->{path};
4173         next if !$path; # just to be sure
4174         next if $usedpath->{$path};
4175         $changes = 1;
4176         add_unused_volume($conf, $volid);
4177         $usedpath->{$path} = 1; # avoid to add more than once (aliases)
4178     }
4179
4180     return $changes;
4181 }
4182
4183 sub rescan {
4184     my ($vmid, $nolock) = @_;
4185
4186     my $cfg = PVE::Cluster::cfs_read_file("storage.cfg");
4187
4188     my $volid_hash = scan_volids($cfg, $vmid);
4189
4190     my $updatefn =  sub {
4191         my ($vmid) = @_;
4192
4193         my $conf = load_config($vmid);
4194
4195         check_lock($conf);
4196
4197         my $vm_volids = {};
4198         foreach my $volid (keys %$volid_hash) {
4199             my $info = $volid_hash->{$volid};
4200             $vm_volids->{$volid} = $info if $info->{vmid} && $info->{vmid} == $vmid;
4201         }
4202
4203         my $changes = update_disksize($vmid, $conf, $vm_volids);
4204
4205         update_config_nolock($vmid, $conf, 1) if $changes;
4206     };
4207
4208     if (defined($vmid)) {
4209         if ($nolock) {
4210             &$updatefn($vmid);
4211         } else {
4212             lock_config($vmid, $updatefn, $vmid);
4213         }
4214     } else {
4215         my $vmlist = config_list();
4216         foreach my $vmid (keys %$vmlist) {
4217             if ($nolock) {
4218                 &$updatefn($vmid);
4219             } else {
4220                 lock_config($vmid, $updatefn, $vmid);
4221             }
4222         }
4223     }
4224 }
4225
4226 sub restore_vma_archive {
4227     my ($archive, $vmid, $user, $opts, $comp) = @_;
4228
4229     my $input = $archive eq '-' ? "<&STDIN" : undef;
4230     my $readfrom = $archive;
4231
4232     my $uncomp = '';
4233     if ($comp) {
4234         $readfrom = '-';
4235         my $qarchive = PVE::Tools::shellquote($archive);
4236         if ($comp eq 'gzip') {
4237             $uncomp = "zcat $qarchive|";
4238         } elsif ($comp eq 'lzop') {
4239             $uncomp = "lzop -d -c $qarchive|";
4240         } else {
4241             die "unknown compression method '$comp'\n";
4242         }
4243
4244     }
4245
4246     my $tmpdir = "/var/tmp/vzdumptmp$$";
4247     rmtree $tmpdir;
4248
4249     # disable interrupts (always do cleanups)
4250     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
4251         warn "got interrupt - ignored\n";
4252     };
4253
4254     my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
4255     POSIX::mkfifo($mapfifo, 0600);
4256     my $fifofh;
4257
4258     my $openfifo = sub {
4259         open($fifofh, '>', $mapfifo) || die $!;
4260     };
4261
4262     my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
4263
4264     my $oldtimeout;
4265     my $timeout = 5;
4266
4267     my $devinfo = {};
4268
4269     my $rpcenv = PVE::RPCEnvironment::get();
4270
4271     my $conffile = config_file($vmid);
4272     my $tmpfn = "$conffile.$$.tmp";
4273
4274     # Note: $oldconf is undef if VM does not exists
4275     my $oldconf = PVE::Cluster::cfs_read_file(cfs_config_path($vmid));
4276
4277     my $print_devmap = sub {
4278         my $virtdev_hash = {};
4279
4280         my $cfgfn = "$tmpdir/qemu-server.conf";
4281
4282         # we can read the config - that is already extracted
4283         my $fh = IO::File->new($cfgfn, "r") ||
4284             "unable to read qemu-server.conf - $!\n";
4285
4286         while (defined(my $line = <$fh>)) {
4287             if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
4288                 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
4289                 die "archive does not contain data for drive '$virtdev'\n"
4290                     if !$devinfo->{$devname};
4291                 if (defined($opts->{storage})) {
4292                     $storeid = $opts->{storage} || 'local';
4293                 } elsif (!$storeid) {
4294                     $storeid = 'local';
4295                 }
4296                 $format = 'raw' if !$format;
4297                 $devinfo->{$devname}->{devname} = $devname;
4298                 $devinfo->{$devname}->{virtdev} = $virtdev;
4299                 $devinfo->{$devname}->{format} = $format;
4300                 $devinfo->{$devname}->{storeid} = $storeid;
4301
4302                 # check permission on storage
4303                 my $pool = $opts->{pool}; # todo: do we need that?
4304                 if ($user ne 'root@pam') {
4305                     $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
4306                 }
4307
4308                 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
4309             }
4310         }
4311
4312         foreach my $devname (keys %$devinfo) {
4313             die "found no device mapping information for device '$devname'\n"
4314                 if !$devinfo->{$devname}->{virtdev};
4315         }
4316
4317         my $cfg = cfs_read_file('storage.cfg');
4318
4319         # create empty/temp config
4320         if ($oldconf) {
4321             PVE::Tools::file_set_contents($conffile, "memory: 128\n");
4322             foreach_drive($oldconf, sub {
4323                 my ($ds, $drive) = @_;
4324
4325                 return if drive_is_cdrom($drive);
4326
4327                 my $volid = $drive->{file};
4328
4329                 return if !$volid || $volid =~ m|^/|;
4330
4331                 my ($path, $owner) = PVE::Storage::path($cfg, $volid);
4332                 return if !$path || !$owner || ($owner != $vmid);
4333
4334                 # Note: only delete disk we want to restore
4335                 # other volumes will become unused
4336                 if ($virtdev_hash->{$ds}) {
4337                     PVE::Storage::vdisk_free($cfg, $volid);
4338                 }
4339             });
4340         }
4341
4342         my $map = {};
4343         foreach my $virtdev (sort keys %$virtdev_hash) {
4344             my $d = $virtdev_hash->{$virtdev};
4345             my $alloc_size = int(($d->{size} + 1024 - 1)/1024);
4346             my $scfg = PVE::Storage::storage_config($cfg, $d->{storeid});
4347
4348             # test if requested format is supported
4349             my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($cfg, $d->{storeid});
4350             my $supported = grep { $_ eq $d->{format} } @$validFormats;
4351             $d->{format} = $defFormat if !$supported;
4352
4353             my $volid = PVE::Storage::vdisk_alloc($cfg, $d->{storeid}, $vmid,
4354                                                   $d->{format}, undef, $alloc_size);
4355             print STDERR "new volume ID is '$volid'\n";
4356             $d->{volid} = $volid;
4357             my $path = PVE::Storage::path($cfg, $volid);
4358
4359             my $write_zeros = 1;
4360             # fixme: what other storages types initialize volumes with zero?
4361             if ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs' || $scfg->{type} eq 'glusterfs' ||
4362                 $scfg->{type} eq 'sheepdog' || $scfg->{type} eq 'rbd') {
4363                 $write_zeros = 0;
4364             }
4365
4366             print $fifofh "${write_zeros}:$d->{devname}=$path\n";
4367
4368             print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
4369             $map->{$virtdev} = $volid;
4370         }
4371
4372         $fh->seek(0, 0) || die "seek failed - $!\n";
4373
4374         my $outfd = new IO::File ($tmpfn, "w") ||
4375             die "unable to write config for VM $vmid\n";
4376
4377         my $cookie = { netcount => 0 };
4378         while (defined(my $line = <$fh>)) {
4379             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
4380         }
4381
4382         $fh->close();
4383         $outfd->close();
4384     };
4385
4386     eval {
4387         # enable interrupts
4388         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
4389             die "interrupted by signal\n";
4390         };
4391         local $SIG{ALRM} = sub { die "got timeout\n"; };
4392
4393         $oldtimeout = alarm($timeout);
4394
4395         my $parser = sub {
4396             my $line = shift;
4397
4398             print "$line\n";
4399
4400             if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
4401                 my ($dev_id, $size, $devname) = ($1, $2, $3);
4402                 $devinfo->{$devname} = { size => $size, dev_id => $dev_id };
4403             } elsif ($line =~ m/^CTIME: /) {
4404                 # we correctly received the vma config, so we can disable
4405                 # the timeout now for disk allocation (set to 10 minutes, so
4406                 # that we always timeout if something goes wrong)
4407                 alarm(600);
4408                 &$print_devmap();
4409                 print $fifofh "done\n";
4410                 my $tmp = $oldtimeout || 0;
4411                 $oldtimeout = undef;
4412                 alarm($tmp);
4413                 close($fifofh);
4414             }
4415         };
4416
4417         print "restore vma archive: $cmd\n";
4418         run_command($cmd, input => $input, outfunc => $parser, afterfork => $openfifo);
4419     };
4420     my $err = $@;
4421
4422     alarm($oldtimeout) if $oldtimeout;
4423
4424     unlink $mapfifo;
4425
4426     if ($err) {
4427         rmtree $tmpdir;
4428         unlink $tmpfn;
4429
4430         my $cfg = cfs_read_file('storage.cfg');
4431         foreach my $devname (keys %$devinfo) {
4432             my $volid = $devinfo->{$devname}->{volid};
4433             next if !$volid;
4434             eval {
4435                 if ($volid =~ m|^/|) {
4436                     unlink $volid || die 'unlink failed\n';
4437                 } else {
4438                     PVE::Storage::vdisk_free($cfg, $volid);
4439                 }
4440                 print STDERR "temporary volume '$volid' sucessfuly removed\n";
4441             };
4442             print STDERR "unable to cleanup '$volid' - $@" if $@;
4443         }
4444         die $err;
4445     }
4446
4447     rmtree $tmpdir;
4448
4449     rename($tmpfn, $conffile) ||
4450         die "unable to commit configuration file '$conffile'\n";
4451
4452     PVE::Cluster::cfs_update(); # make sure we read new file
4453
4454     eval { rescan($vmid, 1); };
4455     warn $@ if $@;
4456 }
4457
4458 sub restore_tar_archive {
4459     my ($archive, $vmid, $user, $opts) = @_;
4460
4461     if ($archive ne '-') {
4462         my $firstfile = tar_archive_read_firstfile($archive);
4463         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
4464             if $firstfile ne 'qemu-server.conf';
4465     }
4466
4467     my $storecfg = cfs_read_file('storage.cfg');
4468
4469     # destroy existing data - keep empty config
4470     my $vmcfgfn = PVE::QemuServer::config_file($vmid);
4471     destroy_vm($storecfg, $vmid, 1) if -f $vmcfgfn;
4472
4473     my $tocmd = "/usr/lib/qemu-server/qmextract";
4474
4475     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
4476     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
4477     $tocmd .= ' --prealloc' if $opts->{prealloc};
4478     $tocmd .= ' --info' if $opts->{info};
4479
4480     # tar option "xf" does not autodetect compression when read from STDIN,
4481     # so we pipe to zcat
4482     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
4483         PVE::Tools::shellquote("--to-command=$tocmd");
4484
4485     my $tmpdir = "/var/tmp/vzdumptmp$$";
4486     mkpath $tmpdir;
4487
4488     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
4489     local $ENV{VZDUMP_VMID} = $vmid;
4490     local $ENV{VZDUMP_USER} = $user;
4491
4492     my $conffile = config_file($vmid);
4493     my $tmpfn = "$conffile.$$.tmp";
4494
4495     # disable interrupts (always do cleanups)
4496     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
4497         print STDERR "got interrupt - ignored\n";
4498     };
4499
4500     eval {
4501         # enable interrupts
4502         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
4503             die "interrupted by signal\n";
4504         };
4505
4506         if ($archive eq '-') {
4507             print "extracting archive from STDIN\n";
4508             run_command($cmd, input => "<&STDIN");
4509         } else {
4510             print "extracting archive '$archive'\n";
4511             run_command($cmd);
4512         }
4513
4514         return if $opts->{info};
4515
4516         # read new mapping
4517         my $map = {};
4518         my $statfile = "$tmpdir/qmrestore.stat";
4519         if (my $fd = IO::File->new($statfile, "r")) {
4520             while (defined (my $line = <$fd>)) {
4521                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4522                     $map->{$1} = $2 if $1;
4523                 } else {
4524                     print STDERR "unable to parse line in statfile - $line\n";
4525                 }
4526             }
4527             $fd->close();
4528         }
4529
4530         my $confsrc = "$tmpdir/qemu-server.conf";
4531
4532         my $srcfd = new IO::File($confsrc, "r") ||
4533             die "unable to open file '$confsrc'\n";
4534
4535         my $outfd = new IO::File ($tmpfn, "w") ||
4536             die "unable to write config for VM $vmid\n";
4537
4538         my $cookie = { netcount => 0 };
4539         while (defined (my $line = <$srcfd>)) {
4540             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
4541         }
4542
4543         $srcfd->close();
4544         $outfd->close();
4545     };
4546     my $err = $@;
4547
4548     if ($err) {
4549
4550         unlink $tmpfn;
4551
4552         tar_restore_cleanup($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info};
4553
4554         die $err;
4555     }
4556
4557     rmtree $tmpdir;
4558
4559     rename $tmpfn, $conffile ||
4560         die "unable to commit configuration file '$conffile'\n";
4561
4562     PVE::Cluster::cfs_update(); # make sure we read new file
4563
4564     eval { rescan($vmid, 1); };
4565     warn $@ if $@;
4566 };
4567
4568
4569 # Internal snapshots
4570
4571 # NOTE: Snapshot create/delete involves several non-atomic
4572 # action, and can take a long time.
4573 # So we try to avoid locking the file and use 'lock' variable
4574 # inside the config file instead.
4575
4576 my $snapshot_copy_config = sub {
4577     my ($source, $dest) = @_;
4578
4579     foreach my $k (keys %$source) {
4580         next if $k eq 'snapshots';
4581         next if $k eq 'snapstate';
4582         next if $k eq 'snaptime';
4583         next if $k eq 'vmstate';
4584         next if $k eq 'lock';
4585         next if $k eq 'digest';
4586         next if $k eq 'description';
4587         next if $k =~ m/^unused\d+$/;
4588
4589         $dest->{$k} = $source->{$k};
4590     }
4591 };
4592
4593 my $snapshot_apply_config = sub {
4594     my ($conf, $snap) = @_;
4595
4596     # copy snapshot list
4597     my $newconf = {
4598         snapshots => $conf->{snapshots},
4599     };
4600
4601     # keep description and list of unused disks
4602     foreach my $k (keys %$conf) {
4603         next if !($k =~ m/^unused\d+$/ || $k eq 'description');
4604         $newconf->{$k} = $conf->{$k};
4605     }
4606
4607     &$snapshot_copy_config($snap, $newconf);
4608
4609     return $newconf;
4610 };
4611
4612 sub foreach_writable_storage {
4613     my ($conf, $func) = @_;
4614
4615     my $sidhash = {};
4616
4617     foreach my $ds (keys %$conf) {
4618         next if !valid_drivename($ds);
4619
4620         my $drive = parse_drive($ds, $conf->{$ds});
4621         next if !$drive;
4622         next if drive_is_cdrom($drive);
4623
4624         my $volid = $drive->{file};
4625
4626         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
4627         $sidhash->{$sid} = $sid if $sid;
4628     }
4629
4630     foreach my $sid (sort keys %$sidhash) {
4631         &$func($sid);
4632     }
4633 }
4634
4635 my $alloc_vmstate_volid = sub {
4636     my ($storecfg, $vmid, $conf, $snapname) = @_;
4637
4638     # Note: we try to be smart when selecting a $target storage
4639
4640     my $target;
4641
4642     # search shared storage first
4643     foreach_writable_storage($conf, sub {
4644         my ($sid) = @_;
4645         my $scfg = PVE::Storage::storage_config($storecfg, $sid);
4646         return if !$scfg->{shared};
4647
4648         $target = $sid if !$target || $scfg->{path}; # prefer file based storage
4649     });
4650
4651     if (!$target) {
4652         # now search local storage
4653         foreach_writable_storage($conf, sub {
4654             my ($sid) = @_;
4655             my $scfg = PVE::Storage::storage_config($storecfg, $sid);
4656             return if $scfg->{shared};
4657
4658             $target = $sid if !$target || $scfg->{path}; # prefer file based storage;
4659         });
4660     }
4661
4662     $target = 'local' if !$target;
4663
4664     my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
4665     # we abort live save after $conf->{memory}, so we need at max twice that space
4666     my $size = $conf->{memory}*2 + $driver_state_size;
4667
4668     my $name = "vm-$vmid-state-$snapname";
4669     my $scfg = PVE::Storage::storage_config($storecfg, $target);
4670     $name .= ".raw" if $scfg->{path}; # add filename extension for file base storage
4671     my $volid = PVE::Storage::vdisk_alloc($storecfg, $target, $vmid, 'raw', $name, $size*1024);
4672
4673     return $volid;
4674 };
4675
4676 my $snapshot_prepare = sub {
4677     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
4678
4679     my $snap;
4680
4681     my $updatefn =  sub {
4682
4683         my $conf = load_config($vmid);
4684
4685         die "you can't take a snapshot if it's a template\n"
4686             if is_template($conf);
4687
4688         check_lock($conf);
4689
4690         $conf->{lock} = 'snapshot';
4691
4692         die "snapshot name '$snapname' already used\n"
4693             if defined($conf->{snapshots}->{$snapname});
4694
4695         my $storecfg = PVE::Storage::config();
4696         die "snapshot feature is not available" if !has_feature('snapshot', $conf, $storecfg);
4697
4698         $snap = $conf->{snapshots}->{$snapname} = {};
4699
4700         if ($save_vmstate && check_running($vmid)) {
4701             $snap->{vmstate} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
4702         }
4703
4704         &$snapshot_copy_config($conf, $snap);
4705
4706         $snap->{snapstate} = "prepare";
4707         $snap->{snaptime} = time();
4708         $snap->{description} = $comment if $comment;
4709
4710         # always overwrite machine if we save vmstate. This makes sure we
4711         # can restore it later using correct machine type
4712         $snap->{machine} = get_current_qemu_machine($vmid) if $snap->{vmstate};
4713
4714         update_config_nolock($vmid, $conf, 1);
4715     };
4716
4717     lock_config($vmid, $updatefn);
4718
4719     return $snap;
4720 };
4721
4722 my $snapshot_commit = sub {
4723     my ($vmid, $snapname) = @_;
4724
4725     my $updatefn = sub {
4726
4727         my $conf = load_config($vmid);
4728
4729         die "missing snapshot lock\n"
4730             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
4731
4732         my $snap = $conf->{snapshots}->{$snapname};
4733
4734         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4735
4736         die "wrong snapshot state\n"
4737             if !($snap->{snapstate} && $snap->{snapstate} eq "prepare");
4738
4739         delete $snap->{snapstate};
4740         delete $conf->{lock};
4741
4742         my $newconf = &$snapshot_apply_config($conf, $snap);
4743
4744         $newconf->{parent} = $snapname;
4745
4746         update_config_nolock($vmid, $newconf, 1);
4747     };
4748
4749     lock_config($vmid, $updatefn);
4750 };
4751
4752 sub snapshot_rollback {
4753     my ($vmid, $snapname) = @_;
4754
4755     my $snap;
4756
4757     my $prepare = 1;
4758
4759     my $storecfg = PVE::Storage::config();
4760
4761     my $updatefn = sub {
4762
4763         my $conf = load_config($vmid);
4764
4765         die "you can't rollback if vm is a template\n" if is_template($conf);
4766
4767         $snap = $conf->{snapshots}->{$snapname};
4768
4769         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4770
4771         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
4772             if $snap->{snapstate};
4773
4774         if ($prepare) {
4775             check_lock($conf);
4776             vm_stop($storecfg, $vmid, undef, undef, 5, undef, undef);
4777         }
4778
4779         die "unable to rollback vm $vmid: vm is running\n"
4780             if check_running($vmid);
4781
4782         if ($prepare) {
4783             $conf->{lock} = 'rollback';
4784         } else {
4785             die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
4786             delete $conf->{lock};
4787         }
4788
4789         my $forcemachine;
4790
4791         if (!$prepare) {
4792             my $has_machine_config = defined($conf->{machine});
4793
4794             # copy snapshot config to current config
4795             $conf = &$snapshot_apply_config($conf, $snap);
4796             $conf->{parent} = $snapname;
4797
4798             # Note: old code did not store 'machine', so we try to be smart
4799             # and guess the snapshot was generated with kvm 1.4 (pc-i440fx-1.4).
4800             $forcemachine = $conf->{machine} || 'pc-i440fx-1.4';
4801             # we remove the 'machine' configuration if not explicitly specified
4802             # in the original config.
4803             delete $conf->{machine} if $snap->{vmstate} && !$has_machine_config;
4804         }
4805
4806         update_config_nolock($vmid, $conf, 1);
4807
4808         if (!$prepare && $snap->{vmstate}) {
4809             my $statefile = PVE::Storage::path($storecfg, $snap->{vmstate});
4810             vm_start($storecfg, $vmid, $statefile, undef, undef, undef, $forcemachine);
4811         }
4812     };
4813
4814     lock_config($vmid, $updatefn);
4815
4816     foreach_drive($snap, sub {
4817         my ($ds, $drive) = @_;
4818
4819         return if drive_is_cdrom($drive);
4820
4821         my $volid = $drive->{file};
4822         my $device = "drive-$ds";
4823
4824         PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
4825     });
4826
4827     $prepare = 0;
4828     lock_config($vmid, $updatefn);
4829 }
4830
4831 my $savevm_wait = sub {
4832     my ($vmid) = @_;
4833
4834     for(;;) {
4835         my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
4836         if (!$stat->{status}) {
4837             die "savevm not active\n";
4838         } elsif ($stat->{status} eq 'active') {
4839             sleep(1);
4840             next;
4841         } elsif ($stat->{status} eq 'completed') {
4842             last;
4843         } else {
4844             die "query-savevm returned status '$stat->{status}'\n";
4845         }
4846     }
4847 };
4848
4849 sub snapshot_create {
4850     my ($vmid, $snapname, $save_vmstate, $freezefs, $comment) = @_;
4851
4852     my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
4853
4854     $freezefs = $save_vmstate = 0 if !$snap->{vmstate}; # vm is not running
4855
4856     my $drivehash = {};
4857
4858     my $running = check_running($vmid);
4859
4860     eval {
4861         # create internal snapshots of all drives
4862
4863         my $storecfg = PVE::Storage::config();
4864
4865         if ($running) {
4866             if ($snap->{vmstate}) {
4867                 my $path = PVE::Storage::path($storecfg, $snap->{vmstate});
4868                 vm_mon_cmd($vmid, "savevm-start", statefile => $path);
4869                 &$savevm_wait($vmid);
4870             } else {
4871                 vm_mon_cmd($vmid, "savevm-start");
4872             }
4873         };
4874
4875         qga_freezefs($vmid) if $running && $freezefs;
4876
4877         foreach_drive($snap, sub {
4878             my ($ds, $drive) = @_;
4879
4880             return if drive_is_cdrom($drive);
4881
4882             my $volid = $drive->{file};
4883             my $device = "drive-$ds";
4884
4885             qemu_volume_snapshot($vmid, $device, $storecfg, $volid, $snapname);
4886             $drivehash->{$ds} = 1;
4887        });
4888     };
4889     my $err = $@;
4890
4891     eval { qga_unfreezefs($vmid) if $running && $freezefs; };
4892     warn $@ if $@;
4893
4894     eval { vm_mon_cmd($vmid, "savevm-end") if $running; };
4895     warn $@ if $@;
4896
4897     if ($err) {
4898         warn "snapshot create failed: starting cleanup\n";
4899         eval { snapshot_delete($vmid, $snapname, 0, $drivehash); };
4900         warn $@ if $@;
4901         die $err;
4902     }
4903
4904     &$snapshot_commit($vmid, $snapname);
4905 }
4906
4907 # Note: $drivehash is only set when called from snapshot_create.
4908 sub snapshot_delete {
4909     my ($vmid, $snapname, $force, $drivehash) = @_;
4910
4911     my $prepare = 1;
4912
4913     my $snap;
4914     my $unused = [];
4915
4916     my $unlink_parent = sub {
4917         my ($confref, $new_parent) = @_;
4918
4919         if ($confref->{parent} && $confref->{parent} eq $snapname) {
4920             if ($new_parent) {
4921                 $confref->{parent} = $new_parent;
4922             } else {
4923                 delete $confref->{parent};
4924             }
4925         }
4926     };
4927
4928     my $updatefn =  sub {
4929         my ($remove_drive) = @_;
4930
4931         my $conf = load_config($vmid);
4932
4933         if (!$drivehash) {
4934             check_lock($conf);
4935             die "you can't delete a snapshot if vm is a template\n"
4936                 if is_template($conf);
4937         }
4938
4939         $snap = $conf->{snapshots}->{$snapname};
4940
4941         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4942
4943         # remove parent refs
4944         if (!$prepare) {
4945             &$unlink_parent($conf, $snap->{parent});
4946             foreach my $sn (keys %{$conf->{snapshots}}) {
4947                 next if $sn eq $snapname;
4948                 &$unlink_parent($conf->{snapshots}->{$sn}, $snap->{parent});
4949             }
4950         }
4951
4952         if ($remove_drive) {
4953             if ($remove_drive eq 'vmstate') {
4954                 delete $snap->{$remove_drive};
4955             } else {
4956                 my $drive = parse_drive($remove_drive, $snap->{$remove_drive});
4957                 my $volid = $drive->{file};
4958                 delete $snap->{$remove_drive};
4959                 add_unused_volume($conf, $volid);
4960             }
4961         }
4962
4963         if ($prepare) {
4964             $snap->{snapstate} = 'delete';
4965         } else {
4966             delete $conf->{snapshots}->{$snapname};
4967             delete $conf->{lock} if $drivehash;
4968             foreach my $volid (@$unused) {
4969                 add_unused_volume($conf, $volid);
4970             }
4971         }
4972
4973         update_config_nolock($vmid, $conf, 1);
4974     };
4975
4976     lock_config($vmid, $updatefn);
4977
4978     # now remove vmstate file
4979
4980     my $storecfg = PVE::Storage::config();
4981
4982     if ($snap->{vmstate}) {
4983         eval {  PVE::Storage::vdisk_free($storecfg, $snap->{vmstate}); };
4984         if (my $err = $@) {
4985             die $err if !$force;
4986             warn $err;
4987         }
4988         # save changes (remove vmstate from snapshot)
4989         lock_config($vmid, $updatefn, 'vmstate') if !$force;
4990     };
4991
4992     # now remove all internal snapshots
4993     foreach_drive($snap, sub {
4994         my ($ds, $drive) = @_;
4995
4996         return if drive_is_cdrom($drive);
4997
4998         my $volid = $drive->{file};
4999         my $device = "drive-$ds";
5000
5001         if (!$drivehash || $drivehash->{$ds}) {
5002             eval { qemu_volume_snapshot_delete($vmid, $device, $storecfg, $volid, $snapname); };
5003             if (my $err = $@) {
5004                 die $err if !$force;
5005                 warn $err;
5006             }
5007         }
5008
5009         # save changes (remove drive fron snapshot)
5010         lock_config($vmid, $updatefn, $ds) if !$force;
5011         push @$unused, $volid;
5012     });
5013
5014     # now cleanup config
5015     $prepare = 0;
5016     lock_config($vmid, $updatefn);
5017 }
5018
5019 sub has_feature {
5020     my ($feature, $conf, $storecfg, $snapname, $running) = @_;
5021
5022     my $err;
5023     foreach_drive($conf, sub {
5024         my ($ds, $drive) = @_;
5025
5026         return if drive_is_cdrom($drive);
5027         my $volid = $drive->{file};
5028         $err = 1 if !PVE::Storage::volume_has_feature($storecfg, $feature, $volid, $snapname, $running);
5029     });
5030
5031     return $err ? 0 : 1;
5032 }
5033
5034 sub template_create {
5035     my ($vmid, $conf, $disk) = @_;
5036
5037     my $storecfg = PVE::Storage::config();
5038
5039     foreach_drive($conf, sub {
5040         my ($ds, $drive) = @_;
5041
5042         return if drive_is_cdrom($drive);
5043         return if $disk && $ds ne $disk;
5044
5045         my $volid = $drive->{file};
5046         return if !PVE::Storage::volume_has_feature($storecfg, 'template', $volid);
5047
5048         my $voliddst = PVE::Storage::vdisk_create_base($storecfg, $volid);
5049         $drive->{file} = $voliddst;
5050         $conf->{$ds} = print_drive($vmid, $drive);
5051         update_config_nolock($vmid, $conf, 1);
5052     });
5053 }
5054
5055 sub is_template {
5056     my ($conf) = @_;
5057
5058     return 1 if defined $conf->{template} && $conf->{template} == 1;
5059 }
5060
5061 sub qemu_img_convert {
5062     my ($src_volid, $dst_volid, $size, $snapname) = @_;
5063
5064     my $storecfg = PVE::Storage::config();
5065     my ($src_storeid, $src_volname) = PVE::Storage::parse_volume_id($src_volid, 1);
5066     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
5067
5068     if ($src_storeid && $dst_storeid) {
5069         my $src_scfg = PVE::Storage::storage_config($storecfg, $src_storeid);
5070         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
5071
5072         my $src_format = qemu_img_format($src_scfg, $src_volname);
5073         my $dst_format = qemu_img_format($dst_scfg, $dst_volname);
5074
5075         my $src_path = PVE::Storage::path($storecfg, $src_volid, $snapname);
5076         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
5077
5078         my $cmd = [];
5079         push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-n';
5080         push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
5081         push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
5082
5083         my $parser = sub {
5084             my $line = shift;
5085             if($line =~ m/\((\S+)\/100\%\)/){
5086                 my $percent = $1;
5087                 my $transferred = int($size * $percent / 100);
5088                 my $remaining = $size - $transferred;
5089
5090                 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
5091             }
5092
5093         };
5094
5095         eval  { run_command($cmd, timeout => undef, outfunc => $parser); };
5096         my $err = $@;
5097         die "copy failed: $err" if $err;
5098     }
5099 }
5100
5101 sub qemu_img_format {
5102     my ($scfg, $volname) = @_;
5103
5104     if ($scfg->{path} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/) {
5105         return $1;
5106     } elsif ($scfg->{type} eq 'iscsi') {
5107         return "host_device";
5108     } else {
5109         return "raw";
5110     }
5111 }
5112
5113 sub qemu_drive_mirror {
5114     my ($vmid, $drive, $dst_volid, $vmiddst, $maxwait) = @_;
5115
5116     my $count = 1;
5117     my $old_len = 0;
5118     my $frozen = undef;
5119
5120     my $storecfg = PVE::Storage::config();
5121     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
5122
5123     if ($dst_storeid) {
5124         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
5125
5126         my $format;
5127         if ($dst_volname =~ m/\.(raw|qcow2)$/){
5128             $format = $1;
5129         }
5130
5131         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
5132
5133         if ($format) {
5134             #fixme : sometime drive-mirror timeout, but works fine after.
5135             # (I have see the problem with big volume > 200GB), so we need to eval
5136             eval { vm_mon_cmd($vmid, "drive-mirror", timeout => 10, device => "drive-$drive", mode => "existing",
5137                               sync => "full", target => $dst_path, format => $format); };
5138         } else {
5139             eval { vm_mon_cmd($vmid, "drive-mirror", timeout => 10, device => "drive-$drive", mode => "existing",
5140                               sync => "full", target => $dst_path); };
5141         }
5142
5143         eval {
5144             while (1) {
5145                 my $stats = vm_mon_cmd($vmid, "query-block-jobs");
5146                 my $stat = @$stats[0];
5147                 die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
5148                 die "error job is not mirroring" if $stat->{type} ne "mirror";
5149
5150                 my $transferred = $stat->{offset};
5151                 my $total = $stat->{len};
5152                 my $remaining = $total - $transferred;
5153                 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
5154
5155                 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent %\n";
5156
5157                 last if ($stat->{len} == $stat->{offset});
5158                 if ($old_len == $stat->{offset}) {
5159                     if ($maxwait && $count > $maxwait) {
5160                     # if writes to disk occurs the disk needs to be freezed
5161                     # to be able to complete the migration
5162                         vm_suspend($vmid,1);
5163                         $count = 0;
5164                         $frozen = 1;
5165                     } else {
5166                         $count++ unless $frozen;
5167                     }
5168                 } elsif ($frozen) {
5169                     vm_resume($vmid,1);
5170                     $count = 0;
5171                 }
5172                 $old_len = $stat->{offset};
5173                 sleep 1;
5174             }
5175
5176             if ($vmiddst == $vmid) {
5177                 # switch the disk if source and destination are on the same guest
5178                 vm_mon_cmd($vmid, "block-job-complete", device => "drive-$drive");
5179             }
5180         };
5181         if (my $err = $@) {
5182             eval { vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive"); };
5183             die "mirroring error: $err";
5184         }
5185
5186         if ($vmiddst != $vmid) {
5187             # if we clone a disk for a new target vm, we don't switch the disk
5188             vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive");
5189         }
5190     }
5191 }
5192
5193 sub clone_disk {
5194     my ($storecfg, $vmid, $running, $drivename, $drive, $snapname,
5195         $newvmid, $storage, $format, $full, $newvollist) = @_;
5196
5197     my $newvolid;
5198
5199     if (!$full) {
5200         print "create linked clone of drive $drivename ($drive->{file})\n";
5201         $newvolid = PVE::Storage::vdisk_clone($storecfg,  $drive->{file}, $newvmid, $snapname);
5202         push @$newvollist, $newvolid;
5203     } else {
5204         my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file});
5205         $storeid = $storage if $storage;
5206
5207         my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($storecfg, $storeid);
5208         if (!$format) {
5209             $format = $drive->{format} || $defFormat;
5210         }
5211
5212         # test if requested format is supported - else use default
5213         my $supported = grep { $_ eq $format } @$validFormats;
5214         $format = $defFormat if !$supported;
5215
5216         my ($size) = PVE::Storage::volume_size_info($storecfg, $drive->{file}, 3);
5217
5218         print "create full clone of drive $drivename ($drive->{file})\n";
5219         $newvolid = PVE::Storage::vdisk_alloc($storecfg, $storeid, $newvmid, $format, undef, ($size/1024));
5220         push @$newvollist, $newvolid;
5221
5222         if (!$running || $snapname) {
5223             qemu_img_convert($drive->{file}, $newvolid, $size, $snapname);
5224         } else {
5225             qemu_drive_mirror($vmid, $drivename, $newvolid, $newvmid);
5226         }
5227     }
5228
5229     my ($size) = PVE::Storage::volume_size_info($storecfg, $newvolid, 3);
5230
5231     my $disk = $drive;
5232     $disk->{format} = undef;
5233     $disk->{file} = $newvolid;
5234     $disk->{size} = $size;
5235
5236     return $disk;
5237 }
5238
5239 # this only works if VM is running
5240 sub get_current_qemu_machine {
5241     my ($vmid) = @_;
5242
5243     my $cmd = { execute => 'query-machines', arguments => {} };
5244     my $res = PVE::QemuServer::vm_qmp_command($vmid, $cmd);
5245
5246     my ($current, $default);
5247     foreach my $e (@$res) {
5248         $default = $e->{name} if $e->{'is-default'};
5249         $current = $e->{name} if $e->{'is-current'};
5250     }
5251
5252     # fallback to the default machine if current is not supported by qemu
5253     return $current || $default || 'pc';
5254 }
5255
5256 sub lspci {
5257
5258     my $devices = {};
5259
5260     dir_glob_foreach("$pcisysfs/devices", '[a-f0-9]{4}:([a-f0-9]{2}:[a-f0-9]{2})\.([0-9])', sub {
5261             my (undef, $id, $function) = @_;
5262             my $res = { id => $id, function => $function};
5263             push @{$devices->{$id}}, $res;
5264     });
5265
5266     return $devices;
5267 }
5268
5269 1;