PVE/QemuServer.pm

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