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