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