PVE/QemuServer.pm

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