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 = 2;
 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         push @$cpuFlags, 'kvm=off' if $xvga && $xvga ne '';
2489
2490         $driver = "vfio-pci" if $xvga ne '';
2491         my $pcidevices = $d->{pciid};
2492         my $multifunction = 1 if @$pcidevices > 1;
2493
2494         my $j=0;
2495         foreach my $pcidevice (@$pcidevices) {
2496
2497             my $id = "hostpci$i";
2498             $id .= ".$j" if $multifunction;
2499             my $addr = $pciaddr;
2500             $addr .= ".$j" if $multifunction;
2501             my $devicestr = "$driver,host=$pcidevice->{id}.$pcidevice->{function},id=$id$addr";
2502
2503             if($j == 0){
2504                 $devicestr .= "$rombar$xvga";
2505                 $devicestr .= ",multifunction=on" if $multifunction;
2506             }
2507
2508             push @$devices, '-device', $devicestr;
2509             $j++;
2510         }
2511     }
2512
2513     # usb devices
2514     for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
2515         my $d = parse_usb_device($conf->{"usb$i"});
2516         next if !$d;
2517         if ($d->{vendorid} && $d->{productid}) {
2518             push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2519         } elsif (defined($d->{hostbus}) && defined($d->{hostport})) {
2520             push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2521         } elsif ($d->{spice}) {
2522             # usb redir support for spice
2523             push @$devices, '-chardev', "spicevmc,id=usbredirchardev$i,name=usbredir";
2524             push @$devices, '-device', "usb-redir,chardev=usbredirchardev$i,id=usbredirdev$i,bus=ehci.0";
2525         }
2526     }
2527
2528     # serial devices
2529     for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++)  {
2530         if (my $path = $conf->{"serial$i"}) {
2531             if ($path eq 'socket') {
2532                 my $socket = "/var/run/qemu-server/${vmid}.serial$i";
2533                 push @$devices, '-chardev', "socket,id=serial$i,path=$socket,server,nowait";
2534                 push @$devices, '-device', "isa-serial,chardev=serial$i";
2535             } else {
2536                 die "no such serial device\n" if ! -c $path;
2537                 push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2538                 push @$devices, '-device', "isa-serial,chardev=serial$i";
2539             }
2540         }
2541     }
2542
2543     # parallel devices
2544     for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++)  {
2545         if (my $path = $conf->{"parallel$i"}) {
2546             die "no such parallel device\n" if ! -c $path;
2547             my $devtype = $path =~ m!^/dev/usb/lp! ? 'tty' : 'parport';
2548             push @$devices, '-chardev', "$devtype,id=parallel$i,path=$path";
2549             push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2550         }
2551     }
2552
2553     my $vmname = $conf->{name} || "vm$vmid";
2554
2555     push @$cmd, '-name', $vmname;
2556
2557     my $sockets = 1;
2558     $sockets = $conf->{smp} if $conf->{smp}; # old style - no longer iused
2559     $sockets = $conf->{sockets} if  $conf->{sockets};
2560
2561     my $cores = $conf->{cores} || 1;
2562     my $maxcpus = $conf->{maxcpus} if $conf->{maxcpus};
2563
2564     if ($maxcpus) {
2565         push @$cmd, '-smp', "cpus=$cores,maxcpus=$maxcpus";
2566     } else {
2567         push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2568     }
2569
2570     push @$cmd, '-nodefaults';
2571
2572     my $bootorder = $conf->{boot} || $confdesc->{boot}->{default};
2573
2574     my $bootindex_hash = {};
2575     my $i = 1;
2576     foreach my $o (split(//, $bootorder)) {
2577         $bootindex_hash->{$o} = $i*100;
2578         $i++;
2579     }
2580
2581     push @$cmd, '-boot', "menu=on";
2582
2583     push @$cmd, '-no-acpi' if defined($conf->{acpi}) && $conf->{acpi} == 0;
2584
2585     push @$cmd, '-no-reboot' if  defined($conf->{reboot}) && $conf->{reboot} == 0;
2586
2587     push @$cmd, '-vga', $vga if $vga && $vga !~ m/^serial\d+$/; # for kvm 77 and later
2588
2589     # time drift fix
2590     my $tdf = defined($conf->{tdf}) ? $conf->{tdf} : $defaults->{tdf};
2591
2592     my $nokvm = defined($conf->{kvm}) && $conf->{kvm} == 0 ? 1 : 0;
2593     my $useLocaltime = $conf->{localtime};
2594
2595     if (my $ost = $conf->{ostype}) {
2596         # other, wxp, w2k, w2k3, w2k8, wvista, win7, win8, l24, l26, solaris
2597
2598         if ($ost =~ m/^w/) { # windows
2599             $useLocaltime = 1 if !defined($conf->{localtime});
2600
2601             # use time drift fix when acpi is enabled
2602             if (!(defined($conf->{acpi}) && $conf->{acpi} == 0)) {
2603                 $tdf = 1 if !defined($conf->{tdf});
2604             }
2605         }
2606
2607         if ($ost eq 'win7' || $ost eq 'win8' || $ost eq 'w2k8' ||
2608             $ost eq 'wvista') {
2609             push @$globalFlags, 'kvm-pit.lost_tick_policy=discard';
2610             push @$cmd, '-no-hpet';
2611             #push @$cpuFlags , 'hv_vapic" if !$nokvm;  #fixme, my win2008R2 hang at boot with this
2612             push @$cpuFlags , 'hv_spinlocks=0xffff' if !$nokvm;
2613         }
2614
2615         if ($ost eq 'win7' || $ost eq 'win8') {
2616             push @$cpuFlags , 'hv_relaxed' if !$nokvm;
2617         }
2618     }
2619
2620     push @$rtcFlags, 'driftfix=slew' if $tdf;
2621
2622     if ($nokvm) {
2623         push @$machineFlags, 'accel=tcg';
2624     } else {
2625         die "No accelerator found!\n" if !$cpuinfo->{hvm};
2626     }
2627
2628     my $machine_type = $forcemachine || $conf->{machine};
2629     if ($machine_type) {
2630         push @$machineFlags, "type=${machine_type}";
2631     }
2632
2633     if ($conf->{startdate}) {
2634         push @$rtcFlags, "base=$conf->{startdate}";
2635     } elsif ($useLocaltime) {
2636         push @$rtcFlags, 'base=localtime';
2637     }
2638
2639     my $cpu = $nokvm ? "qemu64" : "kvm64";
2640     $cpu = $conf->{cpu} if $conf->{cpu};
2641
2642     push @$cpuFlags , '+lahf_lm' if $cpu eq 'kvm64';
2643
2644     push @$cpuFlags , '+x2apic' if !$nokvm && $conf->{ostype} ne 'solaris';
2645
2646     push @$cpuFlags , '-x2apic' if $conf->{ostype} eq 'solaris';
2647
2648     push @$cpuFlags, '+sep' if $cpu eq 'kvm64' || $cpu eq 'kvm32';
2649
2650     $cpu .= "," . join(',', @$cpuFlags) if scalar(@$cpuFlags);
2651
2652     # Note: enforce needs kernel 3.10, so we do not use it for now
2653     # push @$cmd, '-cpu', "$cpu,enforce";
2654     push @$cmd, '-cpu', $cpu;
2655
2656     push @$cmd, '-S' if $conf->{freeze};
2657
2658     # set keyboard layout
2659     my $kb = $conf->{keyboard} || $defaults->{keyboard};
2660     push @$cmd, '-k', $kb if $kb;
2661
2662     # enable sound
2663     #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2664     #push @$cmd, '-soundhw', 'es1370';
2665     #push @$cmd, '-soundhw', $soundhw if $soundhw;
2666
2667     if($conf->{agent}) {
2668         my $qgasocket = qga_socket($vmid);
2669         my $pciaddr = print_pci_addr("qga0", $bridges);
2670         push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
2671         push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
2672         push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
2673     }
2674
2675     my $spice_port;
2676
2677     if ($qxlnum) {
2678         if ($qxlnum > 1) {
2679             if ($conf->{ostype} && $conf->{ostype} =~ m/^w/){
2680                 for(my $i = 1; $i < $qxlnum; $i++){
2681                     my $pciaddr = print_pci_addr("vga$i", $bridges);
2682                     push @$cmd, '-device', "qxl,id=vga$i,ram_size=67108864,vram_size=33554432$pciaddr";
2683                 }
2684             } else {
2685                 # assume other OS works like Linux
2686                 push @$cmd, '-global', 'qxl-vga.ram_size=134217728';
2687                 push @$cmd, '-global', 'qxl-vga.vram_size=67108864';
2688             }
2689         }
2690
2691         my $pciaddr = print_pci_addr("spice", $bridges);
2692
2693         $spice_port = PVE::Tools::next_spice_port();
2694
2695         push @$cmd, '-spice', "tls-port=${spice_port},addr=127.0.0.1,tls-ciphers=DES-CBC3-SHA,seamless-migration=on";
2696
2697         push @$cmd, '-device', "virtio-serial,id=spice$pciaddr";
2698         push @$cmd, '-chardev', "spicevmc,id=vdagent,name=vdagent";
2699         push @$cmd, '-device', "virtserialport,chardev=vdagent,name=com.redhat.spice.0";
2700     }
2701
2702     # enable balloon by default, unless explicitly disabled
2703     if (!defined($conf->{balloon}) || $conf->{balloon}) {
2704         $pciaddr = print_pci_addr("balloon0", $bridges);
2705         push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr";
2706     }
2707
2708     if ($conf->{watchdog}) {
2709         my $wdopts = parse_watchdog($conf->{watchdog});
2710         $pciaddr = print_pci_addr("watchdog", $bridges);
2711         my $watchdog = $wdopts->{model} || 'i6300esb';
2712         push @$devices, '-device', "$watchdog$pciaddr";
2713         push @$devices, '-watchdog-action', $wdopts->{action} if $wdopts->{action};
2714     }
2715
2716     my $vollist = [];
2717     my $scsicontroller = {};
2718     my $ahcicontroller = {};
2719     my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : $defaults->{scsihw};
2720
2721     # Add iscsi initiator name if available
2722     if (my $initiator = get_initiator_name()) {
2723         push @$devices, '-iscsi', "initiator-name=$initiator";
2724     }
2725
2726     foreach_drive($conf, sub {
2727         my ($ds, $drive) = @_;
2728
2729         if (PVE::Storage::parse_volume_id($drive->{file}, 1)) {
2730             push @$vollist, $drive->{file};
2731         }
2732
2733         $use_virtio = 1 if $ds =~ m/^virtio/;
2734
2735         if (drive_is_cdrom ($drive)) {
2736             if ($bootindex_hash->{d}) {
2737                 $drive->{bootindex} = $bootindex_hash->{d};
2738                 $bootindex_hash->{d} += 1;
2739             }
2740         } else {
2741             if ($bootindex_hash->{c}) {
2742                 $drive->{bootindex} = $bootindex_hash->{c} if $conf->{bootdisk} && ($conf->{bootdisk} eq $ds);
2743                 $bootindex_hash->{c} += 1;
2744             }
2745         }
2746
2747         if ($drive->{interface} eq 'scsi') {
2748
2749             my $maxdev = ($scsihw !~ m/^lsi/) ? 256 : 7;
2750             my $controller = int($drive->{index} / $maxdev);
2751             $pciaddr = print_pci_addr("scsihw$controller", $bridges);
2752             push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
2753             $scsicontroller->{$controller}=1;
2754         }
2755
2756         if ($drive->{interface} eq 'sata') {
2757            my $controller = int($drive->{index} / $MAX_SATA_DISKS);
2758            $pciaddr = print_pci_addr("ahci$controller", $bridges);
2759            push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
2760            $ahcicontroller->{$controller}=1;
2761         }
2762
2763         my $drive_cmd = print_drive_full($storecfg, $vmid, $drive);
2764         push @$devices, '-drive',$drive_cmd;
2765         push @$devices, '-device', print_drivedevice_full($storecfg, $conf, $vmid, $drive, $bridges);
2766     });
2767
2768     push @$cmd, '-m', $conf->{memory} || $defaults->{memory};
2769
2770     for (my $i = 0; $i < $MAX_NETS; $i++) {
2771          next if !$conf->{"net$i"};
2772          my $d = parse_net($conf->{"net$i"});
2773          next if !$d;
2774
2775          $use_virtio = 1 if $d->{model} eq 'virtio';
2776
2777          if ($bootindex_hash->{n}) {
2778             $d->{bootindex} = $bootindex_hash->{n};
2779             $bootindex_hash->{n} += 1;
2780          }
2781
2782          my $netdevfull = print_netdev_full($vmid,$conf,$d,"net$i");
2783          push @$devices, '-netdev', $netdevfull;
2784
2785          my $netdevicefull = print_netdevice_full($vmid,$conf,$d,"net$i",$bridges);
2786          push @$devices, '-device', $netdevicefull;
2787     }
2788
2789     if (!$q35) {
2790         # add pci bridges
2791         while (my ($k, $v) = each %$bridges) {
2792             $pciaddr = print_pci_addr("pci.$k");
2793             unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
2794         }
2795     }
2796
2797     # hack: virtio with fairsched is unreliable, so we do not use fairsched
2798     # when the VM uses virtio devices.
2799     if (!$use_virtio && $have_ovz) {
2800
2801         my $cpuunits = defined($conf->{cpuunits}) ?
2802             $conf->{cpuunits} : $defaults->{cpuunits};
2803
2804         push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
2805
2806         # fixme: cpulimit is currently ignored
2807         #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2808     }
2809
2810     # add custom args
2811     if ($conf->{args}) {
2812         my $aa = PVE::Tools::split_args($conf->{args});
2813         push @$cmd, @$aa;
2814     }
2815
2816     push @$cmd, @$devices;
2817     push @$cmd, '-rtc', join(',', @$rtcFlags)
2818         if scalar(@$rtcFlags);
2819     push @$cmd, '-machine', join(',', @$machineFlags)
2820         if scalar(@$machineFlags);
2821     push @$cmd, '-global', join(',', @$globalFlags)
2822         if scalar(@$globalFlags);
2823
2824     return wantarray ? ($cmd, $vollist, $spice_port) : $cmd;
2825 }
2826
2827 sub vnc_socket {
2828     my ($vmid) = @_;
2829     return "${var_run_tmpdir}/$vmid.vnc";
2830 }
2831
2832 sub spice_port {
2833     my ($vmid) = @_;
2834
2835     my $res = vm_mon_cmd($vmid, 'query-spice');
2836
2837     return $res->{'tls-port'} || $res->{'port'} || die "no spice port\n";
2838 }
2839
2840 sub qmp_socket {
2841     my ($vmid) = @_;
2842     return "${var_run_tmpdir}/$vmid.qmp";
2843 }
2844
2845 sub qga_socket {
2846     my ($vmid) = @_;
2847     return "${var_run_tmpdir}/$vmid.qga";
2848 }
2849
2850 sub pidfile_name {
2851     my ($vmid) = @_;
2852     return "${var_run_tmpdir}/$vmid.pid";
2853 }
2854
2855 sub vm_devices_list {
2856     my ($vmid) = @_;
2857
2858     my $res = vm_mon_cmd($vmid, 'query-pci');
2859
2860     my $devices = {};
2861     foreach my $pcibus (@$res) {
2862         foreach my $device (@{$pcibus->{devices}}) {
2863             next if !$device->{'qdev_id'};
2864             $devices->{$device->{'qdev_id'}} = $device;
2865         }
2866     }
2867
2868     return $devices;
2869 }
2870
2871 sub vm_deviceplug {
2872     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2873
2874     return 1 if !check_running($vmid);
2875
2876     my $q35 = machine_type_is_q35($conf);
2877
2878     if ($deviceid eq 'tablet') {
2879         qemu_deviceadd($vmid, print_tabletdevice_full($conf));
2880         return 1;
2881     }
2882
2883     return 1 if !$conf->{hotplug};
2884
2885     my $devices_list = vm_devices_list($vmid);
2886     return 1 if defined($devices_list->{$deviceid});
2887
2888     qemu_bridgeadd($storecfg, $conf, $vmid, $deviceid); #add bridge if we need it for the device
2889
2890     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2891         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2892         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
2893         qemu_deviceadd($vmid, $devicefull);
2894         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2895            qemu_drivedel($vmid, $deviceid);
2896            return undef;
2897         }
2898     }
2899
2900     if ($deviceid =~ m/^(scsihw)(\d+)$/) {
2901         my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : "lsi";
2902         my $pciaddr = print_pci_addr($deviceid);
2903         my $devicefull = "$scsihw,id=$deviceid$pciaddr";
2904         qemu_deviceadd($vmid, $devicefull);
2905         return undef if(!qemu_deviceaddverify($vmid, $deviceid));
2906     }
2907
2908     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2909         return 1 if ($conf->{scsihw} && ($conf->{scsihw} !~ m/^lsi/)); #virtio-scsi not yet support hotplug
2910         return undef if !qemu_findorcreatescsihw($storecfg,$conf, $vmid, $device);
2911         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2912         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
2913         if(!qemu_deviceadd($vmid, $devicefull)) {
2914            qemu_drivedel($vmid, $deviceid);
2915            return undef;
2916         }
2917     }
2918
2919     if ($deviceid =~ m/^(net)(\d+)$/) {
2920         return undef if !qemu_netdevadd($vmid, $conf, $device, $deviceid);
2921         my $netdevicefull = print_netdevice_full($vmid, $conf, $device, $deviceid);
2922         qemu_deviceadd($vmid, $netdevicefull);
2923         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2924            qemu_netdevdel($vmid, $deviceid);
2925            return undef;
2926         }
2927     }
2928
2929
2930     if (!$q35 && $deviceid =~ m/^(pci\.)(\d+)$/) {
2931         my $bridgeid = $2;
2932         my $pciaddr = print_pci_addr($deviceid);
2933         my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
2934         qemu_deviceadd($vmid, $devicefull);
2935         return undef if !qemu_deviceaddverify($vmid, $deviceid);
2936     }
2937
2938     return 1;
2939 }
2940
2941 sub vm_deviceunplug {
2942     my ($vmid, $conf, $deviceid) = @_;
2943
2944     return 1 if !check_running ($vmid);
2945
2946     if ($deviceid eq 'tablet') {
2947         qemu_devicedel($vmid, $deviceid);
2948         return 1;
2949     }
2950
2951     return 1 if !$conf->{hotplug};
2952
2953     my $devices_list = vm_devices_list($vmid);
2954     return 1 if !defined($devices_list->{$deviceid});
2955
2956     die "can't unplug bootdisk" if $conf->{bootdisk} && $conf->{bootdisk} eq $deviceid;
2957
2958     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2959         qemu_devicedel($vmid, $deviceid);
2960         return undef if !qemu_devicedelverify($vmid, $deviceid);
2961         return undef if !qemu_drivedel($vmid, $deviceid);
2962     }
2963
2964     if ($deviceid =~ m/^(lsi)(\d+)$/) {
2965         return undef if !qemu_devicedel($vmid, $deviceid);
2966     }
2967
2968     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2969         return undef if !qemu_devicedel($vmid, $deviceid);
2970         return undef if !qemu_drivedel($vmid, $deviceid);
2971     }
2972
2973     if ($deviceid =~ m/^(net)(\d+)$/) {
2974         qemu_devicedel($vmid, $deviceid);
2975         return undef if !qemu_devicedelverify($vmid, $deviceid);
2976         return undef if !qemu_netdevdel($vmid, $deviceid);
2977     }
2978
2979     return 1;
2980 }
2981
2982 sub qemu_deviceadd {
2983     my ($vmid, $devicefull) = @_;
2984
2985     $devicefull = "driver=".$devicefull;
2986     my %options =  split(/[=,]/, $devicefull);
2987
2988     vm_mon_cmd($vmid, "device_add" , %options);
2989     return 1;
2990 }
2991
2992 sub qemu_devicedel {
2993     my($vmid, $deviceid) = @_;
2994     my $ret = vm_mon_cmd($vmid, "device_del", id => $deviceid);
2995     return 1;
2996 }
2997
2998 sub qemu_driveadd {
2999     my($storecfg, $vmid, $device) = @_;
3000
3001     my $drive = print_drive_full($storecfg, $vmid, $device);
3002     my $ret = vm_human_monitor_command($vmid, "drive_add auto $drive");
3003     # If the command succeeds qemu prints: "OK"
3004     if ($ret !~ m/OK/s) {
3005         syslog("err", "adding drive failed: $ret");
3006         return undef;
3007     }
3008     return 1;
3009 }
3010
3011 sub qemu_drivedel {
3012     my($vmid, $deviceid) = @_;
3013
3014     my $ret = vm_human_monitor_command($vmid, "drive_del drive-$deviceid");
3015     $ret =~ s/^\s+//;
3016     if ($ret =~ m/Device \'.*?\' not found/s) {
3017         # NB: device not found errors mean the drive was auto-deleted and we ignore the error
3018     }
3019     elsif ($ret ne "") {
3020       syslog("err", "deleting drive $deviceid failed : $ret");
3021       return undef;
3022     }
3023     return 1;
3024 }
3025
3026 sub qemu_deviceaddverify {
3027     my ($vmid,$deviceid) = @_;
3028
3029     for (my $i = 0; $i <= 5; $i++) {
3030          my $devices_list = vm_devices_list($vmid);
3031          return 1 if defined($devices_list->{$deviceid});
3032          sleep 1;
3033     }
3034     syslog("err", "error on hotplug device $deviceid");
3035     return undef;
3036 }
3037
3038
3039 sub qemu_devicedelverify {
3040     my ($vmid,$deviceid) = @_;
3041
3042     #need to verify the device is correctly remove as device_del is async and empty return is not reliable
3043     for (my $i = 0; $i <= 5; $i++) {
3044          my $devices_list = vm_devices_list($vmid);
3045          return 1 if !defined($devices_list->{$deviceid});
3046          sleep 1;
3047     }
3048     syslog("err", "error on hot-unplugging device $deviceid");
3049     return undef;
3050 }
3051
3052 sub qemu_findorcreatescsihw {
3053     my ($storecfg, $conf, $vmid, $device) = @_;
3054
3055     my $maxdev = ($conf->{scsihw} && ($conf->{scsihw} !~ m/^lsi/)) ? 256 : 7;
3056     my $controller = int($device->{index} / $maxdev);
3057     my $scsihwid="scsihw$controller";
3058     my $devices_list = vm_devices_list($vmid);
3059
3060     if(!defined($devices_list->{$scsihwid})) {
3061        return undef if !vm_deviceplug($storecfg, $conf, $vmid, $scsihwid);
3062     }
3063     return 1;
3064 }
3065
3066 sub qemu_bridgeadd {
3067     my ($storecfg, $conf, $vmid, $device) = @_;
3068
3069     my $bridges = {};
3070     my $bridgeid = undef;
3071     print_pci_addr($device, $bridges);
3072
3073     while (my ($k, $v) = each %$bridges) {
3074         $bridgeid = $k;
3075     }
3076     return if !$bridgeid || $bridgeid < 1;
3077     my $bridge = "pci.$bridgeid";
3078     my $devices_list = vm_devices_list($vmid);
3079
3080     if(!defined($devices_list->{$bridge})) {
3081         return undef if !vm_deviceplug($storecfg, $conf, $vmid, $bridge);
3082     }
3083     return 1;
3084 }
3085
3086 sub qemu_netdevadd {
3087     my ($vmid, $conf, $device, $deviceid) = @_;
3088
3089     my $netdev = print_netdev_full($vmid, $conf, $device, $deviceid);
3090     my %options =  split(/[=,]/, $netdev);
3091
3092     vm_mon_cmd($vmid, "netdev_add",  %options);
3093     return 1;
3094 }
3095
3096 sub qemu_netdevdel {
3097     my ($vmid, $deviceid) = @_;
3098
3099     vm_mon_cmd($vmid, "netdev_del", id => $deviceid);
3100     return 1;
3101 }
3102
3103 sub qemu_cpu_hotplug {
3104     my ($vmid, $conf, $cores) = @_;
3105
3106     die "new cores config is not defined" if !$cores;
3107     die "you can't add more cores than maxcpus"
3108         if $conf->{maxcpus} && ($cores > $conf->{maxcpus});
3109     return if !check_running($vmid);
3110
3111     my $currentcores = $conf->{cores} if $conf->{cores};
3112     die "current cores is not defined" if !$currentcores;
3113     die "maxcpus is not defined" if !$conf->{maxcpus};
3114     raise_param_exc({ 'cores' => "online cpu unplug is not yet possible" })
3115         if($cores < $currentcores);
3116
3117     my $currentrunningcores = vm_mon_cmd($vmid, "query-cpus");
3118     raise_param_exc({ 'cores' => "cores number if running vm is different than configuration" })
3119         if scalar (@{$currentrunningcores}) != $currentcores;
3120
3121     for(my $i = $currentcores; $i < $cores; $i++) {
3122         vm_mon_cmd($vmid, "cpu-add", id => int($i));
3123     }
3124 }
3125
3126 sub qemu_block_set_io_throttle {
3127     my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
3128
3129     return if !check_running($vmid) ;
3130
3131     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));
3132
3133 }
3134
3135 # old code, only used to shutdown old VM after update
3136 sub __read_avail {
3137     my ($fh, $timeout) = @_;
3138
3139     my $sel = new IO::Select;
3140     $sel->add($fh);
3141
3142     my $res = '';
3143     my $buf;
3144
3145     my @ready;
3146     while (scalar (@ready = $sel->can_read($timeout))) {
3147         my $count;
3148         if ($count = $fh->sysread($buf, 8192)) {
3149             if ($buf =~ /^(.*)\(qemu\) $/s) {
3150                 $res .= $1;
3151                 last;
3152             } else {
3153                 $res .= $buf;
3154             }
3155         } else {
3156             if (!defined($count)) {
3157                 die "$!\n";
3158             }
3159             last;
3160         }
3161     }
3162
3163     die "monitor read timeout\n" if !scalar(@ready);
3164
3165     return $res;
3166 }
3167
3168 # old code, only used to shutdown old VM after update
3169 sub vm_monitor_command {
3170     my ($vmid, $cmdstr, $nocheck) = @_;
3171
3172     my $res;
3173
3174     eval {
3175         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
3176
3177         my $sname = "${var_run_tmpdir}/$vmid.mon";
3178
3179         my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
3180             die "unable to connect to VM $vmid socket - $!\n";
3181
3182         my $timeout = 3;
3183
3184         # hack: migrate sometime blocks the monitor (when migrate_downtime
3185         # is set)
3186         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3187             $timeout = 60*60; # 1 hour
3188         }
3189
3190         # read banner;
3191         my $data = __read_avail($sock, $timeout);
3192
3193         if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
3194             die "got unexpected qemu monitor banner\n";
3195         }
3196
3197         my $sel = new IO::Select;
3198         $sel->add($sock);
3199
3200         if (!scalar(my @ready = $sel->can_write($timeout))) {
3201             die "monitor write error - timeout";
3202         }
3203
3204         my $fullcmd = "$cmdstr\r";
3205
3206         # syslog('info', "VM $vmid monitor command: $cmdstr");
3207
3208         my $b;
3209         if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
3210             die "monitor write error - $!";
3211         }
3212
3213         return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
3214
3215         $timeout = 20;
3216
3217         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3218             $timeout = 60*60; # 1 hour
3219         } elsif ($cmdstr =~ m/^(eject|change)/) {
3220             $timeout = 60; # note: cdrom mount command is slow
3221         }
3222         if ($res = __read_avail($sock, $timeout)) {
3223
3224             my @lines = split("\r?\n", $res);
3225
3226             shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
3227
3228             $res = join("\n", @lines);
3229             $res .= "\n";
3230         }
3231     };
3232
3233     my $err = $@;
3234
3235     if ($err) {
3236         syslog("err", "VM $vmid monitor command failed - $err");
3237         die $err;
3238     }
3239
3240     return $res;
3241 }
3242
3243 sub qemu_block_resize {
3244     my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
3245
3246     my $running = check_running($vmid);
3247
3248     return if !PVE::Storage::volume_resize($storecfg, $volid, $size, $running);
3249
3250     return if !$running;
3251
3252     vm_mon_cmd($vmid, "block_resize", device => $deviceid, size => int($size));
3253
3254 }
3255
3256 sub qemu_volume_snapshot {
3257     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3258
3259     my $running = check_running($vmid);
3260
3261     return if !PVE::Storage::volume_snapshot($storecfg, $volid, $snap, $running);
3262
3263     return if !$running;
3264
3265     vm_mon_cmd($vmid, "snapshot-drive", device => $deviceid, name => $snap);
3266
3267 }
3268
3269 sub qemu_volume_snapshot_delete {
3270     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3271
3272     my $running = check_running($vmid);
3273
3274     return if !PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snap, $running);
3275
3276     return if !$running;
3277
3278     vm_mon_cmd($vmid, "delete-drive-snapshot", device => $deviceid, name => $snap);
3279 }
3280
3281 sub qga_freezefs {
3282     my ($vmid) = @_;
3283
3284     #need to impplement call to qemu-ga
3285 }
3286
3287 sub qga_unfreezefs {
3288     my ($vmid) = @_;
3289
3290     #need to impplement call to qemu-ga
3291 }
3292
3293 sub set_migration_caps {
3294     my ($vmid) = @_;
3295
3296     my $cap_ref = [];
3297
3298     my $enabled_cap = {
3299         "auto-converge" => 1,
3300         "xbzrle" => 0,
3301         "x-rdma-pin-all" => 0,
3302         "zero-blocks" => 0,
3303     };
3304
3305     my $supported_capabilities = vm_mon_cmd_nocheck($vmid, "query-migrate-capabilities");
3306
3307     for my $supported_capability (@$supported_capabilities) {
3308         push @$cap_ref, {
3309             capability => $supported_capability->{capability},
3310             state => $enabled_cap->{$supported_capability->{capability}} ? JSON::true : JSON::false,
3311         };
3312     }
3313
3314     vm_mon_cmd_nocheck($vmid, "migrate-set-capabilities", capabilities => $cap_ref);
3315 }
3316
3317 sub vm_start {
3318     my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused, $forcemachine, $spice_ticket) = @_;
3319
3320     lock_config($vmid, sub {
3321         my $conf = load_config($vmid, $migratedfrom);
3322
3323         die "you can't start a vm if it's a template\n" if is_template($conf);
3324
3325         check_lock($conf) if !$skiplock;
3326
3327         die "VM $vmid already running\n" if check_running($vmid, undef, $migratedfrom);
3328
3329         my $defaults = load_defaults();
3330
3331         # set environment variable useful inside network script
3332         $ENV{PVE_MIGRATED_FROM} = $migratedfrom if $migratedfrom;
3333
3334         my ($cmd, $vollist, $spice_port) = config_to_command($storecfg, $vmid, $conf, $defaults, $forcemachine);
3335
3336         my $migrate_port = 0;
3337         my $migrate_uri;
3338         if ($statefile) {
3339             if ($statefile eq 'tcp') {
3340                 my $localip = "localhost";
3341                 my $datacenterconf = PVE::Cluster::cfs_read_file('datacenter.cfg');
3342                 if ($datacenterconf->{migration_unsecure}) {
3343                         my $nodename = PVE::INotify::nodename();
3344                         $localip = PVE::Cluster::remote_node_ip($nodename, 1);
3345                 }
3346                 $migrate_port = PVE::Tools::next_migrate_port();
3347                 $migrate_uri = "tcp:${localip}:${migrate_port}";
3348                 push @$cmd, '-incoming', $migrate_uri;
3349                 push @$cmd, '-S';
3350             } else {
3351                 push @$cmd, '-loadstate', $statefile;
3352             }
3353         } elsif ($paused) {
3354             push @$cmd, '-S';
3355         }
3356
3357         # host pci devices
3358         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
3359           my $d = parse_hostpci($conf->{"hostpci$i"});
3360           next if !$d;
3361           my $pcidevices = $d->{pciid};
3362           foreach my $pcidevice (@$pcidevices) {
3363                 my $pciid = $pcidevice->{id}.".".$pcidevice->{function};
3364
3365                 my $info = pci_device_info("0000:$pciid");
3366                 die "IOMMU not present\n" if !check_iommu_support();
3367                 die "no pci device info for device '$pciid'\n" if !$info;
3368
3369                 if ($d->{driver} && $d->{driver} eq "vfio") {
3370                     die "can't unbind/bind pci group to vfio '$pciid'\n" if !pci_dev_group_bind_to_vfio($pciid);
3371                 } else {
3372                     die "can't unbind/bind to stub pci device '$pciid'\n" if !pci_dev_bind_to_stub($info);
3373                 }
3374
3375                 die "can't reset pci device '$pciid'\n" if $info->{has_fl_reset} and !pci_dev_reset($info);
3376           }
3377         }
3378
3379         PVE::Storage::activate_volumes($storecfg, $vollist);
3380
3381         eval  { run_command($cmd, timeout => $statefile ? undef : 30,
3382                     umask => 0077); };
3383         my $err = $@;
3384         die "start failed: $err" if $err;
3385
3386         print "migration listens on $migrate_uri\n" if $migrate_uri;
3387
3388         if ($statefile && $statefile ne 'tcp')  {
3389             eval { vm_mon_cmd_nocheck($vmid, "cont"); };
3390             warn $@ if $@;
3391         }
3392
3393         if ($migratedfrom) {
3394
3395             eval {
3396                 PVE::QemuServer::set_migration_caps($vmid);
3397             };
3398             warn $@ if $@;
3399
3400             if ($spice_port) {
3401                 print "spice listens on port $spice_port\n";
3402                 if ($spice_ticket) {
3403                     PVE::QemuServer::vm_mon_cmd_nocheck($vmid, "set_password", protocol => 'spice', password => $spice_ticket);
3404                     PVE::QemuServer::vm_mon_cmd_nocheck($vmid, "expire_password", protocol => 'spice', time => "+30");
3405                 }
3406             }
3407
3408         } else {
3409
3410             if (!$statefile && (!defined($conf->{balloon}) || $conf->{balloon})) {
3411                 vm_mon_cmd_nocheck($vmid, "balloon", value => $conf->{balloon}*1024*1024)
3412                     if $conf->{balloon};
3413                 vm_mon_cmd_nocheck($vmid, 'qom-set',
3414                             path => "machine/peripheral/balloon0",
3415                             property => "guest-stats-polling-interval",
3416                             value => 2);
3417             }
3418         }
3419     });
3420 }
3421
3422 sub vm_mon_cmd {
3423     my ($vmid, $execute, %params) = @_;
3424
3425     my $cmd = { execute => $execute, arguments => \%params };
3426     vm_qmp_command($vmid, $cmd);
3427 }
3428
3429 sub vm_mon_cmd_nocheck {
3430     my ($vmid, $execute, %params) = @_;
3431
3432     my $cmd = { execute => $execute, arguments => \%params };
3433     vm_qmp_command($vmid, $cmd, 1);
3434 }
3435
3436 sub vm_qmp_command {
3437     my ($vmid, $cmd, $nocheck) = @_;
3438
3439     my $res;
3440
3441     my $timeout;
3442     if ($cmd->{arguments} && $cmd->{arguments}->{timeout}) {
3443         $timeout = $cmd->{arguments}->{timeout};
3444         delete $cmd->{arguments}->{timeout};
3445     }
3446
3447     eval {
3448         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
3449         my $sname = qmp_socket($vmid);
3450         if (-e $sname) {
3451             my $qmpclient = PVE::QMPClient->new();
3452
3453             $res = $qmpclient->cmd($vmid, $cmd, $timeout);
3454         } elsif (-e "${var_run_tmpdir}/$vmid.mon") {
3455             die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
3456                 if scalar(%{$cmd->{arguments}});
3457             vm_monitor_command($vmid, $cmd->{execute}, $nocheck);
3458         } else {
3459             die "unable to open monitor socket\n";
3460         }
3461     };
3462     if (my $err = $@) {
3463         syslog("err", "VM $vmid qmp command failed - $err");
3464         die $err;
3465     }
3466
3467     return $res;
3468 }
3469
3470 sub vm_human_monitor_command {
3471     my ($vmid, $cmdline) = @_;
3472
3473     my $res;
3474
3475     my $cmd = {
3476         execute => 'human-monitor-command',
3477         arguments => { 'command-line' => $cmdline},
3478     };
3479
3480     return vm_qmp_command($vmid, $cmd);
3481 }
3482
3483 sub vm_commandline {
3484     my ($storecfg, $vmid) = @_;
3485
3486     my $conf = load_config($vmid);
3487
3488     my $defaults = load_defaults();
3489
3490     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
3491
3492     return join(' ', @$cmd);
3493 }
3494
3495 sub vm_reset {
3496     my ($vmid, $skiplock) = @_;
3497
3498     lock_config($vmid, sub {
3499
3500         my $conf = load_config($vmid);
3501
3502         check_lock($conf) if !$skiplock;
3503
3504         vm_mon_cmd($vmid, "system_reset");
3505     });
3506 }
3507
3508 sub get_vm_volumes {
3509     my ($conf) = @_;
3510
3511     my $vollist = [];
3512     foreach_volid($conf, sub {
3513         my ($volid, $is_cdrom) = @_;
3514
3515         return if $volid =~ m|^/|;
3516
3517         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
3518         return if !$sid;
3519
3520         push @$vollist, $volid;
3521     });
3522
3523     return $vollist;
3524 }
3525
3526 sub vm_stop_cleanup {
3527     my ($storecfg, $vmid, $conf, $keepActive) = @_;
3528
3529     eval {
3530         fairsched_rmnod($vmid); # try to destroy group
3531
3532         if (!$keepActive) {
3533             my $vollist = get_vm_volumes($conf);
3534             PVE::Storage::deactivate_volumes($storecfg, $vollist);
3535         }
3536
3537         foreach my $ext (qw(mon qmp pid vnc qga)) {
3538             unlink "/var/run/qemu-server/${vmid}.$ext";
3539         }
3540     };
3541     warn $@ if $@; # avoid errors - just warn
3542 }
3543
3544 # Note: use $nockeck to skip tests if VM configuration file exists.
3545 # We need that when migration VMs to other nodes (files already moved)
3546 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3547 sub vm_stop {
3548     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3549
3550     $force = 1 if !defined($force) && !$shutdown;
3551
3552     if ($migratedfrom){
3553         my $pid = check_running($vmid, $nocheck, $migratedfrom);
3554         kill 15, $pid if $pid;
3555         my $conf = load_config($vmid, $migratedfrom);
3556         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive);
3557         return;
3558     }
3559
3560     lock_config($vmid, sub {
3561
3562         my $pid = check_running($vmid, $nocheck);
3563         return if !$pid;
3564
3565         my $conf;
3566         if (!$nocheck) {
3567             $conf = load_config($vmid);
3568             check_lock($conf) if !$skiplock;
3569             if (!defined($timeout) && $shutdown && $conf->{startup}) {
3570                 my $opts = parse_startup($conf->{startup});
3571                 $timeout = $opts->{down} if $opts->{down};
3572             }
3573         }
3574
3575         $timeout = 60 if !defined($timeout);
3576
3577         eval {
3578             if ($shutdown) {
3579                 $nocheck ? vm_mon_cmd_nocheck($vmid, "system_powerdown") : vm_mon_cmd($vmid, "system_powerdown");
3580
3581             } else {
3582                 $nocheck ? vm_mon_cmd_nocheck($vmid, "quit") : vm_mon_cmd($vmid, "quit");
3583             }
3584         };
3585         my $err = $@;
3586
3587         if (!$err) {
3588             my $count = 0;
3589             while (($count < $timeout) && check_running($vmid, $nocheck)) {
3590                 $count++;
3591                 sleep 1;
3592             }
3593
3594             if ($count >= $timeout) {
3595                 if ($force) {
3596                     warn "VM still running - terminating now with SIGTERM\n";
3597                     kill 15, $pid;
3598                 } else {
3599                     die "VM quit/powerdown failed - got timeout\n";
3600                 }
3601             } else {
3602                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3603                 return;
3604             }
3605         } else {
3606             if ($force) {
3607                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3608                 kill 15, $pid;
3609             } else {
3610                 die "VM quit/powerdown failed\n";
3611             }
3612         }
3613
3614         # wait again
3615         $timeout = 10;
3616
3617         my $count = 0;
3618         while (($count < $timeout) && check_running($vmid, $nocheck)) {
3619             $count++;
3620             sleep 1;
3621         }
3622
3623         if ($count >= $timeout) {
3624             warn "VM still running - terminating now with SIGKILL\n";
3625             kill 9, $pid;
3626             sleep 1;
3627         }
3628
3629         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3630    });
3631 }
3632
3633 sub vm_suspend {
3634     my ($vmid, $skiplock) = @_;
3635
3636     lock_config($vmid, sub {
3637
3638         my $conf = load_config($vmid);
3639
3640         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3641
3642         vm_mon_cmd($vmid, "stop");
3643     });
3644 }
3645
3646 sub vm_resume {
3647     my ($vmid, $skiplock) = @_;
3648
3649     lock_config($vmid, sub {
3650
3651         my $conf = load_config($vmid);
3652
3653         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3654
3655         vm_mon_cmd($vmid, "cont");
3656     });
3657 }
3658
3659 sub vm_sendkey {
3660     my ($vmid, $skiplock, $key) = @_;
3661
3662     lock_config($vmid, sub {
3663
3664         my $conf = load_config($vmid);
3665
3666         # there is no qmp command, so we use the human monitor command
3667         vm_human_monitor_command($vmid, "sendkey $key");
3668     });
3669 }
3670
3671 sub vm_destroy {
3672     my ($storecfg, $vmid, $skiplock) = @_;
3673
3674     lock_config($vmid, sub {
3675
3676         my $conf = load_config($vmid);
3677
3678         check_lock($conf) if !$skiplock;
3679
3680         if (!check_running($vmid)) {
3681             fairsched_rmnod($vmid); # try to destroy group
3682             destroy_vm($storecfg, $vmid);
3683         } else {
3684             die "VM $vmid is running - destroy failed\n";
3685         }
3686     });
3687 }
3688
3689 # pci helpers
3690
3691 sub file_write {
3692     my ($filename, $buf) = @_;
3693
3694     my $fh = IO::File->new($filename, "w");
3695     return undef if !$fh;
3696
3697     my $res = print $fh $buf;
3698
3699     $fh->close();
3700
3701     return $res;
3702 }
3703
3704 sub pci_device_info {
3705     my ($name) = @_;
3706
3707     my $res;
3708
3709     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3710     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3711
3712     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
3713     return undef if !defined($irq) || $irq !~ m/^\d+$/;
3714
3715     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
3716     return undef if !defined($vendor) || $vendor !~ s/^0x//;
3717
3718     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
3719     return undef if !defined($product) || $product !~ s/^0x//;
3720
3721     $res = {
3722         name => $name,
3723         vendor => $vendor,
3724         product => $product,
3725         domain => $domain,
3726         bus => $bus,
3727         slot => $slot,
3728         func => $func,
3729         irq => $irq,
3730         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
3731     };
3732
3733     return $res;
3734 }
3735
3736 sub pci_dev_reset {
3737     my ($dev) = @_;
3738
3739     my $name = $dev->{name};
3740
3741     my $fn = "$pcisysfs/devices/$name/reset";
3742
3743     return file_write($fn, "1");
3744 }
3745
3746 sub pci_dev_bind_to_stub {
3747     my ($dev) = @_;
3748
3749     my $name = $dev->{name};
3750
3751     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3752     return 1 if -d $testdir;
3753
3754     my $data = "$dev->{vendor} $dev->{product}";
3755     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
3756
3757     my $fn = "$pcisysfs/devices/$name/driver/unbind";
3758     if (!file_write($fn, $name)) {
3759         return undef if -f $fn;
3760     }
3761
3762     $fn = "$pcisysfs/drivers/pci-stub/bind";
3763     if (! -d $testdir) {
3764         return undef if !file_write($fn, $name);
3765     }
3766
3767     return -d $testdir;
3768 }
3769
3770 sub pci_dev_bind_to_vfio {
3771     my ($dev) = @_;
3772
3773     my $name = $dev->{name};
3774
3775     my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
3776
3777     if (!-d $vfio_basedir) {
3778         system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
3779     }
3780     die "Cannot find vfio-pci module!\n" if !-d $vfio_basedir;
3781
3782     my $testdir = "$vfio_basedir/$name";
3783     return 1 if -d $testdir;
3784
3785     my $data = "$dev->{vendor} $dev->{product}";
3786     return undef if !file_write("$vfio_basedir/new_id", $data);
3787
3788     my $fn = "$pcisysfs/devices/$name/driver/unbind";
3789     if (!file_write($fn, $name)) {
3790         return undef if -f $fn;
3791     }
3792
3793     $fn = "$vfio_basedir/bind";
3794     if (! -d $testdir) {
3795         return undef if !file_write($fn, $name);
3796     }
3797
3798     return -d $testdir;
3799 }
3800
3801 sub pci_dev_group_bind_to_vfio {
3802     my ($pciid) = @_;
3803
3804     my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
3805
3806     if (!-d $vfio_basedir) {
3807         system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
3808     }
3809     die "Cannot find vfio-pci module!\n" if !-d $vfio_basedir;
3810
3811     # get IOMMU group devices
3812     opendir(my $D, "$pcisysfs/devices/0000:$pciid/iommu_group/devices/") || die "Cannot open iommu_group: $!\n";
3813       my @devs = grep /^0000:/, readdir($D);
3814     closedir($D);
3815
3816     foreach my $pciid (@devs) {
3817         $pciid =~ m/^([:\.\da-f]+)$/ or die "PCI ID $pciid not valid!\n";
3818         my $info = pci_device_info($1);
3819         pci_dev_bind_to_vfio($info) || die "Cannot bind $pciid to vfio\n";
3820     }
3821
3822     return 1;
3823 }
3824
3825 sub print_pci_addr {
3826     my ($id, $bridges) = @_;
3827
3828     my $res = '';
3829     my $devices = {
3830         piix3 => { bus => 0, addr => 1 },
3831         #addr2 : first videocard
3832         balloon0 => { bus => 0, addr => 3 },
3833         watchdog => { bus => 0, addr => 4 },
3834         scsihw0 => { bus => 0, addr => 5 },
3835         scsihw1 => { bus => 0, addr => 6 },
3836         ahci0 => { bus => 0, addr => 7 },
3837         qga0 => { bus => 0, addr => 8 },
3838         spice => { bus => 0, addr => 9 },
3839         virtio0 => { bus => 0, addr => 10 },
3840         virtio1 => { bus => 0, addr => 11 },
3841         virtio2 => { bus => 0, addr => 12 },
3842         virtio3 => { bus => 0, addr => 13 },
3843         virtio4 => { bus => 0, addr => 14 },
3844         virtio5 => { bus => 0, addr => 15 },
3845         hostpci0 => { bus => 0, addr => 16 },
3846         hostpci1 => { bus => 0, addr => 17 },
3847         net0 => { bus => 0, addr => 18 },
3848         net1 => { bus => 0, addr => 19 },
3849         net2 => { bus => 0, addr => 20 },
3850         net3 => { bus => 0, addr => 21 },
3851         net4 => { bus => 0, addr => 22 },
3852         net5 => { bus => 0, addr => 23 },
3853         vga1 => { bus => 0, addr => 24 },
3854         vga2 => { bus => 0, addr => 25 },
3855         vga3 => { bus => 0, addr => 26 },
3856         #addr29 : usb-host (pve-usb.cfg)
3857         'pci.1' => { bus => 0, addr => 30 },
3858         'pci.2' => { bus => 0, addr => 31 },
3859         'net6' => { bus => 1, addr => 1 },
3860         'net7' => { bus => 1, addr => 2 },
3861         'net8' => { bus => 1, addr => 3 },
3862         'net9' => { bus => 1, addr => 4 },
3863         'net10' => { bus => 1, addr => 5 },
3864         'net11' => { bus => 1, addr => 6 },
3865         'net12' => { bus => 1, addr => 7 },
3866         'net13' => { bus => 1, addr => 8 },
3867         'net14' => { bus => 1, addr => 9 },
3868         'net15' => { bus => 1, addr => 10 },
3869         'net16' => { bus => 1, addr => 11 },
3870         'net17' => { bus => 1, addr => 12 },
3871         'net18' => { bus => 1, addr => 13 },
3872         'net19' => { bus => 1, addr => 14 },
3873         'net20' => { bus => 1, addr => 15 },
3874         'net21' => { bus => 1, addr => 16 },
3875         'net22' => { bus => 1, addr => 17 },
3876         'net23' => { bus => 1, addr => 18 },
3877         'net24' => { bus => 1, addr => 19 },
3878         'net25' => { bus => 1, addr => 20 },
3879         'net26' => { bus => 1, addr => 21 },
3880         'net27' => { bus => 1, addr => 22 },
3881         'net28' => { bus => 1, addr => 23 },
3882         'net29' => { bus => 1, addr => 24 },
3883         'net30' => { bus => 1, addr => 25 },
3884         'net31' => { bus => 1, addr => 26 },
3885         'virtio6' => { bus => 2, addr => 1 },
3886         'virtio7' => { bus => 2, addr => 2 },
3887         'virtio8' => { bus => 2, addr => 3 },
3888         'virtio9' => { bus => 2, addr => 4 },
3889         'virtio10' => { bus => 2, addr => 5 },
3890         'virtio11' => { bus => 2, addr => 6 },
3891         'virtio12' => { bus => 2, addr => 7 },
3892         'virtio13' => { bus => 2, addr => 8 },
3893         'virtio14' => { bus => 2, addr => 9 },
3894         'virtio15' => { bus => 2, addr => 10 },
3895     };
3896
3897     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
3898            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
3899            my $bus = $devices->{$id}->{bus};
3900            $res = ",bus=pci.$bus,addr=$addr";
3901            $bridges->{$bus} = 1 if $bridges;
3902     }
3903     return $res;
3904
3905 }
3906
3907 sub print_pcie_addr {
3908     my ($id) = @_;
3909
3910     my $res = '';
3911     my $devices = {
3912         hostpci0 => { bus => "ich9-pcie-port-1", addr => 0 },
3913         hostpci1 => { bus => "ich9-pcie-port-2", addr => 0 },
3914         hostpci2 => { bus => "ich9-pcie-port-3", addr => 0 },
3915         hostpci3 => { bus => "ich9-pcie-port-4", addr => 0 },
3916     };
3917
3918     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
3919            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
3920            my $bus = $devices->{$id}->{bus};
3921            $res = ",bus=$bus,addr=$addr";
3922     }
3923     return $res;
3924
3925 }
3926
3927 # vzdump restore implementaion
3928
3929 sub tar_archive_read_firstfile {
3930     my $archive = shift;
3931
3932     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
3933
3934     # try to detect archive type first
3935     my $pid = open (TMP, "tar tf '$archive'|") ||
3936         die "unable to open file '$archive'\n";
3937     my $firstfile = <TMP>;
3938     kill 15, $pid;
3939     close TMP;
3940
3941     die "ERROR: archive contaions no data\n" if !$firstfile;
3942     chomp $firstfile;
3943
3944     return $firstfile;
3945 }
3946
3947 sub tar_restore_cleanup {
3948     my ($storecfg, $statfile) = @_;
3949
3950     print STDERR "starting cleanup\n";
3951
3952     if (my $fd = IO::File->new($statfile, "r")) {
3953         while (defined(my $line = <$fd>)) {
3954             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3955                 my $volid = $2;
3956                 eval {
3957                     if ($volid =~ m|^/|) {
3958                         unlink $volid || die 'unlink failed\n';
3959                     } else {
3960                         PVE::Storage::vdisk_free($storecfg, $volid);
3961                     }
3962                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
3963                 };
3964                 print STDERR "unable to cleanup '$volid' - $@" if $@;
3965             } else {
3966                 print STDERR "unable to parse line in statfile - $line";
3967             }
3968         }
3969         $fd->close();
3970     }
3971 }
3972
3973 sub restore_archive {
3974     my ($archive, $vmid, $user, $opts) = @_;
3975
3976     my $format = $opts->{format};
3977     my $comp;
3978
3979     if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
3980         $format = 'tar' if !$format;
3981         $comp = 'gzip';
3982     } elsif ($archive =~ m/\.tar$/) {
3983         $format = 'tar' if !$format;
3984     } elsif ($archive =~ m/.tar.lzo$/) {
3985         $format = 'tar' if !$format;
3986         $comp = 'lzop';
3987     } elsif ($archive =~ m/\.vma$/) {
3988         $format = 'vma' if !$format;
3989     } elsif ($archive =~ m/\.vma\.gz$/) {
3990         $format = 'vma' if !$format;
3991         $comp = 'gzip';
3992     } elsif ($archive =~ m/\.vma\.lzo$/) {
3993         $format = 'vma' if !$format;
3994         $comp = 'lzop';
3995     } else {
3996         $format = 'vma' if !$format; # default
3997     }
3998
3999     # try to detect archive format
4000     if ($format eq 'tar') {
4001         return restore_tar_archive($archive, $vmid, $user, $opts);
4002     } else {
4003         return restore_vma_archive($archive, $vmid, $user, $opts, $comp);
4004     }
4005 }
4006
4007 sub restore_update_config_line {
4008     my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
4009
4010     return if $line =~ m/^\#qmdump\#/;
4011     return if $line =~ m/^\#vzdump\#/;
4012     return if $line =~ m/^lock:/;
4013     return if $line =~ m/^unused\d+:/;
4014     return if $line =~ m/^parent:/;
4015     return if $line =~ m/^template:/; # restored VM is never a template
4016
4017     if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
4018         # try to convert old 1.X settings
4019         my ($id, $ind, $ethcfg) = ($1, $2, $3);
4020         foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
4021             my ($model, $macaddr) = split(/\=/, $devconfig);
4022             $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $unique;
4023             my $net = {
4024                 model => $model,
4025                 bridge => "vmbr$ind",
4026                 macaddr => $macaddr,
4027             };
4028             my $netstr = print_net($net);
4029
4030             print $outfd "net$cookie->{netcount}: $netstr\n";
4031             $cookie->{netcount}++;
4032         }
4033     } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
4034         my ($id, $netstr) = ($1, $2);
4035         my $net = parse_net($netstr);
4036         $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
4037         $netstr = print_net($net);
4038         print $outfd "$id: $netstr\n";
4039     } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
4040         my $virtdev = $1;
4041         my $value = $3;
4042         if ($line =~ m/backup=no/) {
4043             print $outfd "#$line";
4044         } elsif ($virtdev && $map->{$virtdev}) {
4045             my $di = parse_drive($virtdev, $value);
4046             delete $di->{format}; # format can change on restore
4047             $di->{file} = $map->{$virtdev};
4048             $value = print_drive($vmid, $di);
4049             print $outfd "$virtdev: $value\n";
4050         } else {
4051             print $outfd $line;
4052         }
4053     } else {
4054         print $outfd $line;
4055     }
4056 }
4057
4058 sub scan_volids {
4059     my ($cfg, $vmid) = @_;
4060
4061     my $info = PVE::Storage::vdisk_list($cfg, undef, $vmid);
4062
4063     my $volid_hash = {};
4064     foreach my $storeid (keys %$info) {
4065         foreach my $item (@{$info->{$storeid}}) {
4066             next if !($item->{volid} && $item->{size});
4067             $item->{path} = PVE::Storage::path($cfg, $item->{volid});
4068             $volid_hash->{$item->{volid}} = $item;
4069         }
4070     }
4071
4072     return $volid_hash;
4073 }
4074
4075 sub get_used_paths {
4076     my ($vmid, $storecfg, $conf, $scan_snapshots, $skip_drive) = @_;
4077
4078     my $used_path = {};
4079
4080     my $scan_config = sub {
4081         my ($cref, $snapname) = @_;
4082
4083         foreach my $key (keys %$cref) {
4084             my $value = $cref->{$key};
4085             if (valid_drivename($key)) {
4086                 next if $skip_drive && $key eq $skip_drive;
4087                 my $drive = parse_drive($key, $value);
4088                 next if !$drive || !$drive->{file} || drive_is_cdrom($drive);
4089                 if ($drive->{file} =~ m!^/!) {
4090                     $used_path->{$drive->{file}}++; # = 1;
4091                 } else {
4092                     my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file}, 1);
4093                     next if !$storeid;
4094                     my $scfg = PVE::Storage::storage_config($storecfg, $storeid, 1);
4095                     next if !$scfg;
4096                     my $path = PVE::Storage::path($storecfg, $drive->{file}, $snapname);
4097                     $used_path->{$path}++; # = 1;
4098                 }
4099             }
4100         }
4101     };
4102
4103     &$scan_config($conf);
4104
4105     undef $skip_drive;
4106
4107     if ($scan_snapshots) {
4108         foreach my $snapname (keys %{$conf->{snapshots}}) {
4109             &$scan_config($conf->{snapshots}->{$snapname}, $snapname);
4110         }
4111     }
4112
4113     return $used_path;
4114 }
4115
4116 sub update_disksize {
4117     my ($vmid, $conf, $volid_hash) = @_;
4118
4119     my $changes;
4120
4121     my $used = {};
4122
4123     # Note: it is allowed to define multiple storages with same path (alias), so
4124     # we need to check both 'volid' and real 'path' (two different volid can point
4125     # to the same path).
4126
4127     my $usedpath = {};
4128
4129     # update size info
4130     foreach my $opt (keys %$conf) {
4131         if (valid_drivename($opt)) {
4132             my $drive = parse_drive($opt, $conf->{$opt});
4133             my $volid = $drive->{file};
4134             next if !$volid;
4135
4136             $used->{$volid} = 1;
4137             if ($volid_hash->{$volid} &&
4138                 (my $path = $volid_hash->{$volid}->{path})) {
4139                 $usedpath->{$path} = 1;
4140             }
4141
4142             next if drive_is_cdrom($drive);
4143             next if !$volid_hash->{$volid};
4144
4145             $drive->{size} = $volid_hash->{$volid}->{size};
4146             my $new = print_drive($vmid, $drive);
4147             if ($new ne $conf->{$opt}) {
4148                 $changes = 1;
4149                 $conf->{$opt} = $new;
4150             }
4151         }
4152     }
4153
4154     # remove 'unusedX' entry if volume is used
4155     foreach my $opt (keys %$conf) {
4156         next if $opt !~ m/^unused\d+$/;
4157         my $volid = $conf->{$opt};
4158         my $path = $volid_hash->{$volid}->{path} if $volid_hash->{$volid};
4159         if ($used->{$volid} || ($path && $usedpath->{$path})) {
4160             $changes = 1;
4161             delete $conf->{$opt};
4162         }
4163     }
4164
4165     foreach my $volid (sort keys %$volid_hash) {
4166         next if $volid =~ m/vm-$vmid-state-/;
4167         next if $used->{$volid};
4168         my $path = $volid_hash->{$volid}->{path};
4169         next if !$path; # just to be sure
4170         next if $usedpath->{$path};
4171         $changes = 1;
4172         add_unused_volume($conf, $volid);
4173         $usedpath->{$path} = 1; # avoid to add more than once (aliases)
4174     }
4175
4176     return $changes;
4177 }
4178
4179 sub rescan {
4180     my ($vmid, $nolock) = @_;
4181
4182     my $cfg = PVE::Cluster::cfs_read_file("storage.cfg");
4183
4184     my $volid_hash = scan_volids($cfg, $vmid);
4185
4186     my $updatefn =  sub {
4187         my ($vmid) = @_;
4188
4189         my $conf = load_config($vmid);
4190
4191         check_lock($conf);
4192
4193         my $vm_volids = {};
4194         foreach my $volid (keys %$volid_hash) {
4195             my $info = $volid_hash->{$volid};
4196             $vm_volids->{$volid} = $info if $info->{vmid} && $info->{vmid} == $vmid;
4197         }
4198
4199         my $changes = update_disksize($vmid, $conf, $vm_volids);
4200
4201         update_config_nolock($vmid, $conf, 1) if $changes;
4202     };
4203
4204     if (defined($vmid)) {
4205         if ($nolock) {
4206             &$updatefn($vmid);
4207         } else {
4208             lock_config($vmid, $updatefn, $vmid);
4209         }
4210     } else {
4211         my $vmlist = config_list();
4212         foreach my $vmid (keys %$vmlist) {
4213             if ($nolock) {
4214                 &$updatefn($vmid);
4215             } else {
4216                 lock_config($vmid, $updatefn, $vmid);
4217             }
4218         }
4219     }
4220 }
4221
4222 sub restore_vma_archive {
4223     my ($archive, $vmid, $user, $opts, $comp) = @_;
4224
4225     my $input = $archive eq '-' ? "<&STDIN" : undef;
4226     my $readfrom = $archive;
4227
4228     my $uncomp = '';
4229     if ($comp) {
4230         $readfrom = '-';
4231         my $qarchive = PVE::Tools::shellquote($archive);
4232         if ($comp eq 'gzip') {
4233             $uncomp = "zcat $qarchive|";
4234         } elsif ($comp eq 'lzop') {
4235             $uncomp = "lzop -d -c $qarchive|";
4236         } else {
4237             die "unknown compression method '$comp'\n";
4238         }
4239
4240     }
4241
4242     my $tmpdir = "/var/tmp/vzdumptmp$$";
4243     rmtree $tmpdir;
4244
4245     # disable interrupts (always do cleanups)
4246     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
4247         warn "got interrupt - ignored\n";
4248     };
4249
4250     my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
4251     POSIX::mkfifo($mapfifo, 0600);
4252     my $fifofh;
4253
4254     my $openfifo = sub {
4255         open($fifofh, '>', $mapfifo) || die $!;
4256     };
4257
4258     my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
4259
4260     my $oldtimeout;
4261     my $timeout = 5;
4262
4263     my $devinfo = {};
4264
4265     my $rpcenv = PVE::RPCEnvironment::get();
4266
4267     my $conffile = config_file($vmid);
4268     my $tmpfn = "$conffile.$$.tmp";
4269
4270     # Note: $oldconf is undef if VM does not exists
4271     my $oldconf = PVE::Cluster::cfs_read_file(cfs_config_path($vmid));
4272
4273     my $print_devmap = sub {
4274         my $virtdev_hash = {};
4275
4276         my $cfgfn = "$tmpdir/qemu-server.conf";
4277
4278         # we can read the config - that is already extracted
4279         my $fh = IO::File->new($cfgfn, "r") ||
4280             "unable to read qemu-server.conf - $!\n";
4281
4282         while (defined(my $line = <$fh>)) {
4283             if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
4284                 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
4285                 die "archive does not contain data for drive '$virtdev'\n"
4286                     if !$devinfo->{$devname};
4287                 if (defined($opts->{storage})) {
4288                     $storeid = $opts->{storage} || 'local';
4289                 } elsif (!$storeid) {
4290                     $storeid = 'local';
4291                 }
4292                 $format = 'raw' if !$format;
4293                 $devinfo->{$devname}->{devname} = $devname;
4294                 $devinfo->{$devname}->{virtdev} = $virtdev;
4295                 $devinfo->{$devname}->{format} = $format;
4296                 $devinfo->{$devname}->{storeid} = $storeid;
4297
4298                 # check permission on storage
4299                 my $pool = $opts->{pool}; # todo: do we need that?
4300                 if ($user ne 'root@pam') {
4301                     $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
4302                 }
4303
4304                 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
4305             }
4306         }
4307
4308         foreach my $devname (keys %$devinfo) {
4309             die "found no device mapping information for device '$devname'\n"
4310                 if !$devinfo->{$devname}->{virtdev};
4311         }
4312
4313         my $cfg = cfs_read_file('storage.cfg');
4314
4315         # create empty/temp config
4316         if ($oldconf) {
4317             PVE::Tools::file_set_contents($conffile, "memory: 128\n");
4318             foreach_drive($oldconf, sub {
4319                 my ($ds, $drive) = @_;
4320
4321                 return if drive_is_cdrom($drive);
4322
4323                 my $volid = $drive->{file};
4324
4325                 return if !$volid || $volid =~ m|^/|;
4326
4327                 my ($path, $owner) = PVE::Storage::path($cfg, $volid);
4328                 return if !$path || !$owner || ($owner != $vmid);
4329
4330                 # Note: only delete disk we want to restore
4331                 # other volumes will become unused
4332                 if ($virtdev_hash->{$ds}) {
4333                     PVE::Storage::vdisk_free($cfg, $volid);
4334                 }
4335             });
4336         }
4337
4338         my $map = {};
4339         foreach my $virtdev (sort keys %$virtdev_hash) {
4340             my $d = $virtdev_hash->{$virtdev};
4341             my $alloc_size = int(($d->{size} + 1024 - 1)/1024);
4342             my $scfg = PVE::Storage::storage_config($cfg, $d->{storeid});
4343
4344             # test if requested format is supported
4345             my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($cfg, $d->{storeid});
4346             my $supported = grep { $_ eq $d->{format} } @$validFormats;
4347             $d->{format} = $defFormat if !$supported;
4348
4349             my $volid = PVE::Storage::vdisk_alloc($cfg, $d->{storeid}, $vmid,
4350                                                   $d->{format}, undef, $alloc_size);
4351             print STDERR "new volume ID is '$volid'\n";
4352             $d->{volid} = $volid;
4353             my $path = PVE::Storage::path($cfg, $volid);
4354
4355             my $write_zeros = 1;
4356             # fixme: what other storages types initialize volumes with zero?
4357             if ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs' || $scfg->{type} eq 'glusterfs' ||
4358                 $scfg->{type} eq 'sheepdog' || $scfg->{type} eq 'rbd') {
4359                 $write_zeros = 0;
4360             }
4361
4362             print $fifofh "${write_zeros}:$d->{devname}=$path\n";
4363
4364             print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
4365             $map->{$virtdev} = $volid;
4366         }
4367
4368         $fh->seek(0, 0) || die "seek failed - $!\n";
4369
4370         my $outfd = new IO::File ($tmpfn, "w") ||
4371             die "unable to write config for VM $vmid\n";
4372
4373         my $cookie = { netcount => 0 };
4374         while (defined(my $line = <$fh>)) {
4375             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
4376         }
4377
4378         $fh->close();
4379         $outfd->close();
4380     };
4381
4382     eval {
4383         # enable interrupts
4384         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
4385             die "interrupted by signal\n";
4386         };
4387         local $SIG{ALRM} = sub { die "got timeout\n"; };
4388
4389         $oldtimeout = alarm($timeout);
4390
4391         my $parser = sub {
4392             my $line = shift;
4393
4394             print "$line\n";
4395
4396             if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
4397                 my ($dev_id, $size, $devname) = ($1, $2, $3);
4398                 $devinfo->{$devname} = { size => $size, dev_id => $dev_id };
4399             } elsif ($line =~ m/^CTIME: /) {
4400                 # we correctly received the vma config, so we can disable
4401                 # the timeout now for disk allocation (set to 10 minutes, so
4402                 # that we always timeout if something goes wrong)
4403                 alarm(600);
4404                 &$print_devmap();
4405                 print $fifofh "done\n";
4406                 my $tmp = $oldtimeout || 0;
4407                 $oldtimeout = undef;
4408                 alarm($tmp);
4409                 close($fifofh);
4410             }
4411         };
4412
4413         print "restore vma archive: $cmd\n";
4414         run_command($cmd, input => $input, outfunc => $parser, afterfork => $openfifo);
4415     };
4416     my $err = $@;
4417
4418     alarm($oldtimeout) if $oldtimeout;
4419
4420     unlink $mapfifo;
4421
4422     if ($err) {
4423         rmtree $tmpdir;
4424         unlink $tmpfn;
4425
4426         my $cfg = cfs_read_file('storage.cfg');
4427         foreach my $devname (keys %$devinfo) {
4428             my $volid = $devinfo->{$devname}->{volid};
4429             next if !$volid;
4430             eval {
4431                 if ($volid =~ m|^/|) {
4432                     unlink $volid || die 'unlink failed\n';
4433                 } else {
4434                     PVE::Storage::vdisk_free($cfg, $volid);
4435                 }
4436                 print STDERR "temporary volume '$volid' sucessfuly removed\n";
4437             };
4438             print STDERR "unable to cleanup '$volid' - $@" if $@;
4439         }
4440         die $err;
4441     }
4442
4443     rmtree $tmpdir;
4444
4445     rename($tmpfn, $conffile) ||
4446         die "unable to commit configuration file '$conffile'\n";
4447
4448     PVE::Cluster::cfs_update(); # make sure we read new file
4449
4450     eval { rescan($vmid, 1); };
4451     warn $@ if $@;
4452 }
4453
4454 sub restore_tar_archive {
4455     my ($archive, $vmid, $user, $opts) = @_;
4456
4457     if ($archive ne '-') {
4458         my $firstfile = tar_archive_read_firstfile($archive);
4459         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
4460             if $firstfile ne 'qemu-server.conf';
4461     }
4462
4463     my $storecfg = cfs_read_file('storage.cfg');
4464
4465     # destroy existing data - keep empty config
4466     my $vmcfgfn = PVE::QemuServer::config_file($vmid);
4467     destroy_vm($storecfg, $vmid, 1) if -f $vmcfgfn;
4468
4469     my $tocmd = "/usr/lib/qemu-server/qmextract";
4470
4471     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
4472     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
4473     $tocmd .= ' --prealloc' if $opts->{prealloc};
4474     $tocmd .= ' --info' if $opts->{info};
4475
4476     # tar option "xf" does not autodetect compression when read from STDIN,
4477     # so we pipe to zcat
4478     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
4479         PVE::Tools::shellquote("--to-command=$tocmd");
4480
4481     my $tmpdir = "/var/tmp/vzdumptmp$$";
4482     mkpath $tmpdir;
4483
4484     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
4485     local $ENV{VZDUMP_VMID} = $vmid;
4486     local $ENV{VZDUMP_USER} = $user;
4487
4488     my $conffile = config_file($vmid);
4489     my $tmpfn = "$conffile.$$.tmp";
4490
4491     # disable interrupts (always do cleanups)
4492     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
4493         print STDERR "got interrupt - ignored\n";
4494     };
4495
4496     eval {
4497         # enable interrupts
4498         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
4499             die "interrupted by signal\n";
4500         };
4501
4502         if ($archive eq '-') {
4503             print "extracting archive from STDIN\n";
4504             run_command($cmd, input => "<&STDIN");
4505         } else {
4506             print "extracting archive '$archive'\n";
4507             run_command($cmd);
4508         }
4509
4510         return if $opts->{info};
4511
4512         # read new mapping
4513         my $map = {};
4514         my $statfile = "$tmpdir/qmrestore.stat";
4515         if (my $fd = IO::File->new($statfile, "r")) {
4516             while (defined (my $line = <$fd>)) {
4517                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4518                     $map->{$1} = $2 if $1;
4519                 } else {
4520                     print STDERR "unable to parse line in statfile - $line\n";
4521                 }
4522             }
4523             $fd->close();
4524         }
4525
4526         my $confsrc = "$tmpdir/qemu-server.conf";
4527
4528         my $srcfd = new IO::File($confsrc, "r") ||
4529             die "unable to open file '$confsrc'\n";
4530
4531         my $outfd = new IO::File ($tmpfn, "w") ||
4532             die "unable to write config for VM $vmid\n";
4533
4534         my $cookie = { netcount => 0 };
4535         while (defined (my $line = <$srcfd>)) {
4536             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
4537         }
4538
4539         $srcfd->close();
4540         $outfd->close();
4541     };
4542     my $err = $@;
4543
4544     if ($err) {
4545
4546         unlink $tmpfn;
4547
4548         tar_restore_cleanup($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info};
4549
4550         die $err;
4551     }
4552
4553     rmtree $tmpdir;
4554
4555     rename $tmpfn, $conffile ||
4556         die "unable to commit configuration file '$conffile'\n";
4557
4558     PVE::Cluster::cfs_update(); # make sure we read new file
4559
4560     eval { rescan($vmid, 1); };
4561     warn $@ if $@;
4562 };
4563
4564
4565 # Internal snapshots
4566
4567 # NOTE: Snapshot create/delete involves several non-atomic
4568 # action, and can take a long time.
4569 # So we try to avoid locking the file and use 'lock' variable
4570 # inside the config file instead.
4571
4572 my $snapshot_copy_config = sub {
4573     my ($source, $dest) = @_;
4574
4575     foreach my $k (keys %$source) {
4576         next if $k eq 'snapshots';
4577         next if $k eq 'snapstate';
4578         next if $k eq 'snaptime';
4579         next if $k eq 'vmstate';
4580         next if $k eq 'lock';
4581         next if $k eq 'digest';
4582         next if $k eq 'description';
4583         next if $k =~ m/^unused\d+$/;
4584
4585         $dest->{$k} = $source->{$k};
4586     }
4587 };
4588
4589 my $snapshot_apply_config = sub {
4590     my ($conf, $snap) = @_;
4591
4592     # copy snapshot list
4593     my $newconf = {
4594         snapshots => $conf->{snapshots},
4595     };
4596
4597     # keep description and list of unused disks
4598     foreach my $k (keys %$conf) {
4599         next if !($k =~ m/^unused\d+$/ || $k eq 'description');
4600         $newconf->{$k} = $conf->{$k};
4601     }
4602
4603     &$snapshot_copy_config($snap, $newconf);
4604
4605     return $newconf;
4606 };
4607
4608 sub foreach_writable_storage {
4609     my ($conf, $func) = @_;
4610
4611     my $sidhash = {};
4612
4613     foreach my $ds (keys %$conf) {
4614         next if !valid_drivename($ds);
4615
4616         my $drive = parse_drive($ds, $conf->{$ds});
4617         next if !$drive;
4618         next if drive_is_cdrom($drive);
4619
4620         my $volid = $drive->{file};
4621
4622         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
4623         $sidhash->{$sid} = $sid if $sid;
4624     }
4625
4626     foreach my $sid (sort keys %$sidhash) {
4627         &$func($sid);
4628     }
4629 }
4630
4631 my $alloc_vmstate_volid = sub {
4632     my ($storecfg, $vmid, $conf, $snapname) = @_;
4633
4634     # Note: we try to be smart when selecting a $target storage
4635
4636     my $target;
4637
4638     # search shared storage first
4639     foreach_writable_storage($conf, sub {
4640         my ($sid) = @_;
4641         my $scfg = PVE::Storage::storage_config($storecfg, $sid);
4642         return if !$scfg->{shared};
4643
4644         $target = $sid if !$target || $scfg->{path}; # prefer file based storage
4645     });
4646
4647     if (!$target) {
4648         # now search local storage
4649         foreach_writable_storage($conf, sub {
4650             my ($sid) = @_;
4651             my $scfg = PVE::Storage::storage_config($storecfg, $sid);
4652             return if $scfg->{shared};
4653
4654             $target = $sid if !$target || $scfg->{path}; # prefer file based storage;
4655         });
4656     }
4657
4658     $target = 'local' if !$target;
4659
4660     my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
4661     # we abort live save after $conf->{memory}, so we need at max twice that space
4662     my $size = $conf->{memory}*2 + $driver_state_size;
4663
4664     my $name = "vm-$vmid-state-$snapname";
4665     my $scfg = PVE::Storage::storage_config($storecfg, $target);
4666     $name .= ".raw" if $scfg->{path}; # add filename extension for file base storage
4667     my $volid = PVE::Storage::vdisk_alloc($storecfg, $target, $vmid, 'raw', $name, $size*1024);
4668
4669     return $volid;
4670 };
4671
4672 my $snapshot_prepare = sub {
4673     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
4674
4675     my $snap;
4676
4677     my $updatefn =  sub {
4678
4679         my $conf = load_config($vmid);
4680
4681         die "you can't take a snapshot if it's a template\n"
4682             if is_template($conf);
4683
4684         check_lock($conf);
4685
4686         $conf->{lock} = 'snapshot';
4687
4688         die "snapshot name '$snapname' already used\n"
4689             if defined($conf->{snapshots}->{$snapname});
4690
4691         my $storecfg = PVE::Storage::config();
4692         die "snapshot feature is not available" if !has_feature('snapshot', $conf, $storecfg);
4693
4694         $snap = $conf->{snapshots}->{$snapname} = {};
4695
4696         if ($save_vmstate && check_running($vmid)) {
4697             $snap->{vmstate} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
4698         }
4699
4700         &$snapshot_copy_config($conf, $snap);
4701
4702         $snap->{snapstate} = "prepare";
4703         $snap->{snaptime} = time();
4704         $snap->{description} = $comment if $comment;
4705
4706         # always overwrite machine if we save vmstate. This makes sure we
4707         # can restore it later using correct machine type
4708         $snap->{machine} = get_current_qemu_machine($vmid) if $snap->{vmstate};
4709
4710         update_config_nolock($vmid, $conf, 1);
4711     };
4712
4713     lock_config($vmid, $updatefn);
4714
4715     return $snap;
4716 };
4717
4718 my $snapshot_commit = sub {
4719     my ($vmid, $snapname) = @_;
4720
4721     my $updatefn = sub {
4722
4723         my $conf = load_config($vmid);
4724
4725         die "missing snapshot lock\n"
4726             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
4727
4728         my $snap = $conf->{snapshots}->{$snapname};
4729
4730         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4731
4732         die "wrong snapshot state\n"
4733             if !($snap->{snapstate} && $snap->{snapstate} eq "prepare");
4734
4735         delete $snap->{snapstate};
4736         delete $conf->{lock};
4737
4738         my $newconf = &$snapshot_apply_config($conf, $snap);
4739
4740         $newconf->{parent} = $snapname;
4741
4742         update_config_nolock($vmid, $newconf, 1);
4743     };
4744
4745     lock_config($vmid, $updatefn);
4746 };
4747
4748 sub snapshot_rollback {
4749     my ($vmid, $snapname) = @_;
4750
4751     my $snap;
4752
4753     my $prepare = 1;
4754
4755     my $storecfg = PVE::Storage::config();
4756
4757     my $updatefn = sub {
4758
4759         my $conf = load_config($vmid);
4760
4761         die "you can't rollback if vm is a template\n" if is_template($conf);
4762
4763         $snap = $conf->{snapshots}->{$snapname};
4764
4765         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4766
4767         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
4768             if $snap->{snapstate};
4769
4770         if ($prepare) {
4771             check_lock($conf);
4772             vm_stop($storecfg, $vmid, undef, undef, 5, undef, undef);
4773         }
4774
4775         die "unable to rollback vm $vmid: vm is running\n"
4776             if check_running($vmid);
4777
4778         if ($prepare) {
4779             $conf->{lock} = 'rollback';
4780         } else {
4781             die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
4782             delete $conf->{lock};
4783         }
4784
4785         my $forcemachine;
4786
4787         if (!$prepare) {
4788             my $has_machine_config = defined($conf->{machine});
4789
4790             # copy snapshot config to current config
4791             $conf = &$snapshot_apply_config($conf, $snap);
4792             $conf->{parent} = $snapname;
4793
4794             # Note: old code did not store 'machine', so we try to be smart
4795             # and guess the snapshot was generated with kvm 1.4 (pc-i440fx-1.4).
4796             $forcemachine = $conf->{machine} || 'pc-i440fx-1.4';
4797             # we remove the 'machine' configuration if not explicitly specified
4798             # in the original config.
4799             delete $conf->{machine} if $snap->{vmstate} && !$has_machine_config;
4800         }
4801
4802         update_config_nolock($vmid, $conf, 1);
4803
4804         if (!$prepare && $snap->{vmstate}) {
4805             my $statefile = PVE::Storage::path($storecfg, $snap->{vmstate});
4806             vm_start($storecfg, $vmid, $statefile, undef, undef, undef, $forcemachine);
4807         }
4808     };
4809
4810     lock_config($vmid, $updatefn);
4811
4812     foreach_drive($snap, sub {
4813         my ($ds, $drive) = @_;
4814
4815         return if drive_is_cdrom($drive);
4816
4817         my $volid = $drive->{file};
4818         my $device = "drive-$ds";
4819
4820         PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
4821     });
4822
4823     $prepare = 0;
4824     lock_config($vmid, $updatefn);
4825 }
4826
4827 my $savevm_wait = sub {
4828     my ($vmid) = @_;
4829
4830     for(;;) {
4831         my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
4832         if (!$stat->{status}) {
4833             die "savevm not active\n";
4834         } elsif ($stat->{status} eq 'active') {
4835             sleep(1);
4836             next;
4837         } elsif ($stat->{status} eq 'completed') {
4838             last;
4839         } else {
4840             die "query-savevm returned status '$stat->{status}'\n";
4841         }
4842     }
4843 };
4844
4845 sub snapshot_create {
4846     my ($vmid, $snapname, $save_vmstate, $freezefs, $comment) = @_;
4847
4848     my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
4849
4850     $freezefs = $save_vmstate = 0 if !$snap->{vmstate}; # vm is not running
4851
4852     my $drivehash = {};
4853
4854     my $running = check_running($vmid);
4855
4856     eval {
4857         # create internal snapshots of all drives
4858
4859         my $storecfg = PVE::Storage::config();
4860
4861         if ($running) {
4862             if ($snap->{vmstate}) {
4863                 my $path = PVE::Storage::path($storecfg, $snap->{vmstate});
4864                 vm_mon_cmd($vmid, "savevm-start", statefile => $path);
4865                 &$savevm_wait($vmid);
4866             } else {
4867                 vm_mon_cmd($vmid, "savevm-start");
4868             }
4869         };
4870
4871         qga_freezefs($vmid) if $running && $freezefs;
4872
4873         foreach_drive($snap, sub {
4874             my ($ds, $drive) = @_;
4875
4876             return if drive_is_cdrom($drive);
4877
4878             my $volid = $drive->{file};
4879             my $device = "drive-$ds";
4880
4881             qemu_volume_snapshot($vmid, $device, $storecfg, $volid, $snapname);
4882             $drivehash->{$ds} = 1;
4883        });
4884     };
4885     my $err = $@;
4886
4887     eval { qga_unfreezefs($vmid) if $running && $freezefs; };
4888     warn $@ if $@;
4889
4890     eval { vm_mon_cmd($vmid, "savevm-end") if $running; };
4891     warn $@ if $@;
4892
4893     if ($err) {
4894         warn "snapshot create failed: starting cleanup\n";
4895         eval { snapshot_delete($vmid, $snapname, 0, $drivehash); };
4896         warn $@ if $@;
4897         die $err;
4898     }
4899
4900     &$snapshot_commit($vmid, $snapname);
4901 }
4902
4903 # Note: $drivehash is only set when called from snapshot_create.
4904 sub snapshot_delete {
4905     my ($vmid, $snapname, $force, $drivehash) = @_;
4906
4907     my $prepare = 1;
4908
4909     my $snap;
4910     my $unused = [];
4911
4912     my $unlink_parent = sub {
4913         my ($confref, $new_parent) = @_;
4914
4915         if ($confref->{parent} && $confref->{parent} eq $snapname) {
4916             if ($new_parent) {
4917                 $confref->{parent} = $new_parent;
4918             } else {
4919                 delete $confref->{parent};
4920             }
4921         }
4922     };
4923
4924     my $updatefn =  sub {
4925         my ($remove_drive) = @_;
4926
4927         my $conf = load_config($vmid);
4928
4929         if (!$drivehash) {
4930             check_lock($conf);
4931             die "you can't delete a snapshot if vm is a template\n"
4932                 if is_template($conf);
4933         }
4934
4935         $snap = $conf->{snapshots}->{$snapname};
4936
4937         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4938
4939         # remove parent refs
4940         if (!$prepare) {
4941             &$unlink_parent($conf, $snap->{parent});
4942             foreach my $sn (keys %{$conf->{snapshots}}) {
4943                 next if $sn eq $snapname;
4944                 &$unlink_parent($conf->{snapshots}->{$sn}, $snap->{parent});
4945             }
4946         }
4947
4948         if ($remove_drive) {
4949             if ($remove_drive eq 'vmstate') {
4950                 delete $snap->{$remove_drive};
4951             } else {
4952                 my $drive = parse_drive($remove_drive, $snap->{$remove_drive});
4953                 my $volid = $drive->{file};
4954                 delete $snap->{$remove_drive};
4955                 add_unused_volume($conf, $volid);
4956             }
4957         }
4958
4959         if ($prepare) {
4960             $snap->{snapstate} = 'delete';
4961         } else {
4962             delete $conf->{snapshots}->{$snapname};
4963             delete $conf->{lock} if $drivehash;
4964             foreach my $volid (@$unused) {
4965                 add_unused_volume($conf, $volid);
4966             }
4967         }
4968
4969         update_config_nolock($vmid, $conf, 1);
4970     };
4971
4972     lock_config($vmid, $updatefn);
4973
4974     # now remove vmstate file
4975
4976     my $storecfg = PVE::Storage::config();
4977
4978     if ($snap->{vmstate}) {
4979         eval {  PVE::Storage::vdisk_free($storecfg, $snap->{vmstate}); };
4980         if (my $err = $@) {
4981             die $err if !$force;
4982             warn $err;
4983         }
4984         # save changes (remove vmstate from snapshot)
4985         lock_config($vmid, $updatefn, 'vmstate') if !$force;
4986     };
4987
4988     # now remove all internal snapshots
4989     foreach_drive($snap, sub {
4990         my ($ds, $drive) = @_;
4991
4992         return if drive_is_cdrom($drive);
4993
4994         my $volid = $drive->{file};
4995         my $device = "drive-$ds";
4996
4997         if (!$drivehash || $drivehash->{$ds}) {
4998             eval { qemu_volume_snapshot_delete($vmid, $device, $storecfg, $volid, $snapname); };
4999             if (my $err = $@) {
5000                 die $err if !$force;
5001                 warn $err;
5002             }
5003         }
5004
5005         # save changes (remove drive fron snapshot)
5006         lock_config($vmid, $updatefn, $ds) if !$force;
5007         push @$unused, $volid;
5008     });
5009
5010     # now cleanup config
5011     $prepare = 0;
5012     lock_config($vmid, $updatefn);
5013 }
5014
5015 sub has_feature {
5016     my ($feature, $conf, $storecfg, $snapname, $running) = @_;
5017
5018     my $err;
5019     foreach_drive($conf, sub {
5020         my ($ds, $drive) = @_;
5021
5022         return if drive_is_cdrom($drive);
5023         my $volid = $drive->{file};
5024         $err = 1 if !PVE::Storage::volume_has_feature($storecfg, $feature, $volid, $snapname, $running);
5025     });
5026
5027     return $err ? 0 : 1;
5028 }
5029
5030 sub template_create {
5031     my ($vmid, $conf, $disk) = @_;
5032
5033     my $storecfg = PVE::Storage::config();
5034
5035     foreach_drive($conf, sub {
5036         my ($ds, $drive) = @_;
5037
5038         return if drive_is_cdrom($drive);
5039         return if $disk && $ds ne $disk;
5040
5041         my $volid = $drive->{file};
5042         return if !PVE::Storage::volume_has_feature($storecfg, 'template', $volid);
5043
5044         my $voliddst = PVE::Storage::vdisk_create_base($storecfg, $volid);
5045         $drive->{file} = $voliddst;
5046         $conf->{$ds} = print_drive($vmid, $drive);
5047         update_config_nolock($vmid, $conf, 1);
5048     });
5049 }
5050
5051 sub is_template {
5052     my ($conf) = @_;
5053
5054     return 1 if defined $conf->{template} && $conf->{template} == 1;
5055 }
5056
5057 sub qemu_img_convert {
5058     my ($src_volid, $dst_volid, $size, $snapname) = @_;
5059
5060     my $storecfg = PVE::Storage::config();
5061     my ($src_storeid, $src_volname) = PVE::Storage::parse_volume_id($src_volid, 1);
5062     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
5063
5064     if ($src_storeid && $dst_storeid) {
5065         my $src_scfg = PVE::Storage::storage_config($storecfg, $src_storeid);
5066         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
5067
5068         my $src_format = qemu_img_format($src_scfg, $src_volname);
5069         my $dst_format = qemu_img_format($dst_scfg, $dst_volname);
5070
5071         my $src_path = PVE::Storage::path($storecfg, $src_volid, $snapname);
5072         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
5073
5074         my $cmd = [];
5075         push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-n';
5076         push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
5077         push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
5078
5079         my $parser = sub {
5080             my $line = shift;
5081             if($line =~ m/\((\S+)\/100\%\)/){
5082                 my $percent = $1;
5083                 my $transferred = int($size * $percent / 100);
5084                 my $remaining = $size - $transferred;
5085
5086                 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
5087             }
5088
5089         };
5090
5091         eval  { run_command($cmd, timeout => undef, outfunc => $parser); };
5092         my $err = $@;
5093         die "copy failed: $err" if $err;
5094     }
5095 }
5096
5097 sub qemu_img_format {
5098     my ($scfg, $volname) = @_;
5099
5100     if ($scfg->{path} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/) {
5101         return $1;
5102     } elsif ($scfg->{type} eq 'iscsi') {
5103         return "host_device";
5104     } else {
5105         return "raw";
5106     }
5107 }
5108
5109 sub qemu_drive_mirror {
5110     my ($vmid, $drive, $dst_volid, $vmiddst, $maxwait) = @_;
5111
5112     my $count = 1;
5113     my $old_len = 0;
5114     my $frozen = undef;
5115
5116     my $storecfg = PVE::Storage::config();
5117     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
5118
5119     if ($dst_storeid) {
5120         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
5121
5122         my $format;
5123         if ($dst_volname =~ m/\.(raw|qcow2)$/){
5124             $format = $1;
5125         }
5126
5127         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
5128
5129         if ($format) {
5130             #fixme : sometime drive-mirror timeout, but works fine after.
5131             # (I have see the problem with big volume > 200GB), so we need to eval
5132             eval { vm_mon_cmd($vmid, "drive-mirror", timeout => 10, device => "drive-$drive", mode => "existing",
5133                               sync => "full", target => $dst_path, format => $format); };
5134         } else {
5135             eval { vm_mon_cmd($vmid, "drive-mirror", timeout => 10, device => "drive-$drive", mode => "existing",
5136                               sync => "full", target => $dst_path); };
5137         }
5138
5139         eval {
5140             while (1) {
5141                 my $stats = vm_mon_cmd($vmid, "query-block-jobs");
5142                 my $stat = @$stats[0];
5143                 die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
5144                 die "error job is not mirroring" if $stat->{type} ne "mirror";
5145
5146                 my $transferred = $stat->{offset};
5147                 my $total = $stat->{len};
5148                 my $remaining = $total - $transferred;
5149                 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
5150
5151                 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent %\n";
5152
5153                 last if ($stat->{len} == $stat->{offset});
5154                 if ($old_len == $stat->{offset}) {
5155                     if ($maxwait && $count > $maxwait) {
5156                     # if writes to disk occurs the disk needs to be freezed
5157                     # to be able to complete the migration
5158                         vm_suspend($vmid,1);
5159                         $count = 0;
5160                         $frozen = 1;
5161                     } else {
5162                         $count++ unless $frozen;
5163                     }
5164                 } elsif ($frozen) {
5165                     vm_resume($vmid,1);
5166                     $count = 0;
5167                 }
5168                 $old_len = $stat->{offset};
5169                 sleep 1;
5170             }
5171
5172             if ($vmiddst == $vmid) {
5173                 # switch the disk if source and destination are on the same guest
5174                 vm_mon_cmd($vmid, "block-job-complete", device => "drive-$drive");
5175             }
5176         };
5177         if (my $err = $@) {
5178             eval { vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive"); };
5179             die "mirroring error: $err";
5180         }
5181
5182         if ($vmiddst != $vmid) {
5183             # if we clone a disk for a new target vm, we don't switch the disk
5184             vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive");
5185         }
5186     }
5187 }
5188
5189 sub clone_disk {
5190     my ($storecfg, $vmid, $running, $drivename, $drive, $snapname,
5191         $newvmid, $storage, $format, $full, $newvollist) = @_;
5192
5193     my $newvolid;
5194
5195     if (!$full) {
5196         print "create linked clone of drive $drivename ($drive->{file})\n";
5197         $newvolid = PVE::Storage::vdisk_clone($storecfg,  $drive->{file}, $newvmid, $snapname);
5198         push @$newvollist, $newvolid;
5199     } else {
5200         my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file});
5201         $storeid = $storage if $storage;
5202
5203         my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($storecfg, $storeid);
5204         if (!$format) {
5205             $format = $drive->{format} || $defFormat;
5206         }
5207
5208         # test if requested format is supported - else use default
5209         my $supported = grep { $_ eq $format } @$validFormats;
5210         $format = $defFormat if !$supported;
5211
5212         my ($size) = PVE::Storage::volume_size_info($storecfg, $drive->{file}, 3);
5213
5214         print "create full clone of drive $drivename ($drive->{file})\n";
5215         $newvolid = PVE::Storage::vdisk_alloc($storecfg, $storeid, $newvmid, $format, undef, ($size/1024));
5216         push @$newvollist, $newvolid;
5217
5218         if (!$running || $snapname) {
5219             qemu_img_convert($drive->{file}, $newvolid, $size, $snapname);
5220         } else {
5221             qemu_drive_mirror($vmid, $drivename, $newvolid, $newvmid);
5222         }
5223     }
5224
5225     my ($size) = PVE::Storage::volume_size_info($storecfg, $newvolid, 3);
5226
5227     my $disk = $drive;
5228     $disk->{format} = undef;
5229     $disk->{file} = $newvolid;
5230     $disk->{size} = $size;
5231
5232     return $disk;
5233 }
5234
5235 # this only works if VM is running
5236 sub get_current_qemu_machine {
5237     my ($vmid) = @_;
5238
5239     my $cmd = { execute => 'query-machines', arguments => {} };
5240     my $res = PVE::QemuServer::vm_qmp_command($vmid, $cmd);
5241
5242     my ($current, $default);
5243     foreach my $e (@$res) {
5244         $default = $e->{name} if $e->{'is-default'};
5245         $current = $e->{name} if $e->{'is-current'};
5246     }
5247
5248     # fallback to the default machine if current is not supported by qemu
5249     return $current || $default || 'pc';
5250 }
5251
5252 sub lspci {
5253
5254     my $devices = {};
5255
5256     dir_glob_foreach("$pcisysfs/devices", '[a-f0-9]{4}:([a-f0-9]{2}:[a-f0-9]{2})\.([0-9])', sub {
5257             my (undef, $id, $function) = @_;
5258             my $res = { id => $id, function => $function};
5259             push @{$devices->{$id}}, $res;
5260     });
5261
5262     return $devices;
5263 }
5264
5265 1;