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 sub vm_is_volid_owner {
1437     my ($storecfg, $vmid, $volid) = @_;
1438
1439     if ($volid !~  m|^/|) {
1440         my ($path, $owner);
1441         eval { ($path, $owner) = PVE::Storage::path($storecfg, $volid); };
1442         if ($owner && ($owner == $vmid)) {
1443             return 1;
1444         }
1445     }
1446
1447     return undef;
1448 }
1449
1450 sub vmconfig_delete_pending_option {
1451     my ($conf, $key) = @_;
1452
1453     delete $conf->{pending}->{$key};
1454     my $pending_delete_hash = { $key => 1 };
1455     foreach my $opt (PVE::Tools::split_list($conf->{pending}->{delete})) {
1456         $pending_delete_hash->{$opt} = 1;
1457     }
1458     $conf->{pending}->{delete} = join(',', keys %$pending_delete_hash);
1459 }
1460
1461 sub vmconfig_undelete_pending_option {
1462     my ($conf, $key) = @_;
1463
1464     my $pending_delete_hash = {};
1465     foreach my $opt (PVE::Tools::split_list($conf->{pending}->{delete})) {
1466         $pending_delete_hash->{$opt} = 1;
1467     }
1468     delete $pending_delete_hash->{$key};
1469
1470     my @keylist = keys %$pending_delete_hash;
1471     if (scalar(@keylist)) {
1472         $conf->{pending}->{delete} = join(',', @keylist);
1473     } else {
1474         delete $conf->{pending}->{delete};
1475     }
1476 }
1477
1478 sub vmconfig_register_unused_drive {
1479     my ($storecfg, $vmid, $conf, $drive) = @_;
1480
1481     if (!drive_is_cdrom($drive)) {
1482         my $volid = $drive->{file};
1483         if (vm_is_volid_owner($storecfg, $vmid, $volid)) {
1484             add_unused_volume($conf, $volid, $vmid);
1485         }
1486     }
1487 }
1488
1489 my $valid_smbios1_options = {
1490     manufacturer => '\S+',
1491     product => '\S+',
1492     version => '\S+',
1493     serial => '\S+',
1494     uuid => '[a-fA-F0-9]{8}(?:-[a-fA-F0-9]{4}){3}-[a-fA-F0-9]{12}',
1495     sku => '\S+',
1496     family => '\S+',
1497 };
1498
1499 # smbios: [manufacturer=str][,product=str][,version=str][,serial=str][,uuid=uuid][,sku=str][,family=str]
1500 sub parse_smbios1 {
1501     my ($data) = @_;
1502
1503     my $res = {};
1504
1505     foreach my $kvp (split(/,/, $data)) {
1506         return undef if $kvp !~ m/^(\S+)=(.+)$/;
1507         my ($k, $v) = split(/=/, $kvp);
1508         return undef if !defined($k) || !defined($v);
1509         return undef if !$valid_smbios1_options->{$k};
1510         return undef if $v !~ m/^$valid_smbios1_options->{$k}$/;
1511         $res->{$k} = $v;
1512     }
1513
1514     return $res;
1515 }
1516
1517 sub print_smbios1 {
1518     my ($smbios1) = @_;
1519
1520     my $data = '';
1521     foreach my $k (keys %$smbios1) {
1522         next if !defined($smbios1->{$k});
1523         next if !$valid_smbios1_options->{$k};
1524         $data .= ',' if $data;
1525         $data .= "$k=$smbios1->{$k}";
1526     }
1527     return $data;
1528 }
1529
1530 PVE::JSONSchema::register_format('pve-qm-smbios1', \&verify_smbios1);
1531 sub verify_smbios1 {
1532     my ($value, $noerr) = @_;
1533
1534     return $value if parse_smbios1($value);
1535
1536     return undef if $noerr;
1537
1538     die "unable to parse smbios (type 1) options\n";
1539 }
1540
1541 PVE::JSONSchema::register_format('pve-qm-bootdisk', \&verify_bootdisk);
1542 sub verify_bootdisk {
1543     my ($value, $noerr) = @_;
1544
1545     return $value if valid_drivename($value);
1546
1547     return undef if $noerr;
1548
1549     die "invalid boot disk '$value'\n";
1550 }
1551
1552 PVE::JSONSchema::register_format('pve-qm-numanode', \&verify_numa);
1553 sub verify_numa {
1554     my ($value, $noerr) = @_;
1555
1556     return $value if parse_numa($value);
1557
1558     return undef if $noerr;
1559
1560     die "unable to parse numa options\n";
1561 }
1562
1563 PVE::JSONSchema::register_format('pve-qm-net', \&verify_net);
1564 sub verify_net {
1565     my ($value, $noerr) = @_;
1566
1567     return $value if parse_net($value);
1568
1569     return undef if $noerr;
1570
1571     die "unable to parse network options\n";
1572 }
1573
1574 PVE::JSONSchema::register_format('pve-qm-drive', \&verify_drive);
1575 sub verify_drive {
1576     my ($value, $noerr) = @_;
1577
1578     return $value if parse_drive(undef, $value);
1579
1580     return undef if $noerr;
1581
1582     die "unable to parse drive options\n";
1583 }
1584
1585 PVE::JSONSchema::register_format('pve-qm-hostpci', \&verify_hostpci);
1586 sub verify_hostpci {
1587     my ($value, $noerr) = @_;
1588
1589     return $value if parse_hostpci($value);
1590
1591     return undef if $noerr;
1592
1593     die "unable to parse pci id\n";
1594 }
1595
1596 PVE::JSONSchema::register_format('pve-qm-watchdog', \&verify_watchdog);
1597 sub verify_watchdog {
1598     my ($value, $noerr) = @_;
1599
1600     return $value if parse_watchdog($value);
1601
1602     return undef if $noerr;
1603
1604     die "unable to parse watchdog options\n";
1605 }
1606
1607 sub parse_watchdog {
1608     my ($value) = @_;
1609
1610     return undef if !$value;
1611
1612     my $res = {};
1613
1614     foreach my $p (split(/,/, $value)) {
1615         next if $p =~ m/^\s*$/;
1616
1617         if ($p =~ m/^(model=)?(i6300esb|ib700)$/) {
1618             $res->{model} = $2;
1619         } elsif ($p =~ m/^(action=)?(reset|shutdown|poweroff|pause|debug|none)$/) {
1620             $res->{action} = $2;
1621         } else {
1622             return undef;
1623         }
1624     }
1625
1626     return $res;
1627 }
1628
1629 PVE::JSONSchema::register_format('pve-qm-startup', \&verify_startup);
1630 sub verify_startup {
1631     my ($value, $noerr) = @_;
1632
1633     return $value if parse_startup($value);
1634
1635     return undef if $noerr;
1636
1637     die "unable to parse startup options\n";
1638 }
1639
1640 sub parse_startup {
1641     my ($value) = @_;
1642
1643     return undef if !$value;
1644
1645     my $res = {};
1646
1647     foreach my $p (split(/,/, $value)) {
1648         next if $p =~ m/^\s*$/;
1649
1650         if ($p =~ m/^(order=)?(\d+)$/) {
1651             $res->{order} = $2;
1652         } elsif ($p =~ m/^up=(\d+)$/) {
1653             $res->{up} = $1;
1654         } elsif ($p =~ m/^down=(\d+)$/) {
1655             $res->{down} = $1;
1656         } else {
1657             return undef;
1658         }
1659     }
1660
1661     return $res;
1662 }
1663
1664 sub parse_usb_device {
1665     my ($value) = @_;
1666
1667     return undef if !$value;
1668
1669     my @dl = split(/,/, $value);
1670     my $found;
1671
1672     my $res = {};
1673     foreach my $v (@dl) {
1674         if ($v =~ m/^host=(0x)?([0-9A-Fa-f]{4}):(0x)?([0-9A-Fa-f]{4})$/) {
1675             $found = 1;
1676             $res->{vendorid} = $2;
1677             $res->{productid} = $4;
1678         } elsif ($v =~ m/^host=(\d+)\-(\d+(\.\d+)*)$/) {
1679             $found = 1;
1680             $res->{hostbus} = $1;
1681             $res->{hostport} = $2;
1682         } elsif ($v =~ m/^spice$/) {
1683             $found = 1;
1684             $res->{spice} = 1;
1685         } else {
1686             return undef;
1687         }
1688     }
1689     return undef if !$found;
1690
1691     return $res;
1692 }
1693
1694 PVE::JSONSchema::register_format('pve-qm-usb-device', \&verify_usb_device);
1695 sub verify_usb_device {
1696     my ($value, $noerr) = @_;
1697
1698     return $value if parse_usb_device($value);
1699
1700     return undef if $noerr;
1701
1702     die "unable to parse usb device\n";
1703 }
1704
1705 # add JSON properties for create and set function
1706 sub json_config_properties {
1707     my $prop = shift;
1708
1709     foreach my $opt (keys %$confdesc) {
1710         next if $opt eq 'parent' || $opt eq 'snaptime' || $opt eq 'vmstate';
1711         $prop->{$opt} = $confdesc->{$opt};
1712     }
1713
1714     return $prop;
1715 }
1716
1717 sub check_type {
1718     my ($key, $value) = @_;
1719
1720     die "unknown setting '$key'\n" if !$confdesc->{$key};
1721
1722     my $type = $confdesc->{$key}->{type};
1723
1724     if (!defined($value)) {
1725         die "got undefined value\n";
1726     }
1727
1728     if ($value =~ m/[\n\r]/) {
1729         die "property contains a line feed\n";
1730     }
1731
1732     if ($type eq 'boolean') {
1733         return 1 if ($value eq '1') || ($value =~ m/^(on|yes|true)$/i);
1734         return 0 if ($value eq '0') || ($value =~ m/^(off|no|false)$/i);
1735         die "type check ('boolean') failed - got '$value'\n";
1736     } elsif ($type eq 'integer') {
1737         return int($1) if $value =~ m/^(\d+)$/;
1738         die "type check ('integer') failed - got '$value'\n";
1739     } elsif ($type eq 'number') {
1740         return $value if $value =~ m/^(\d+)(\.\d+)?$/;
1741         die "type check ('number') failed - got '$value'\n";
1742     } elsif ($type eq 'string') {
1743         if (my $fmt = $confdesc->{$key}->{format}) {
1744             if ($fmt eq 'pve-qm-drive') {
1745                 # special case - we need to pass $key to parse_drive()
1746                 my $drive = parse_drive($key, $value);
1747                 return $value if $drive;
1748                 die "unable to parse drive options\n";
1749             }
1750             PVE::JSONSchema::check_format($fmt, $value);
1751             return $value;
1752         }
1753         $value =~ s/^\"(.*)\"$/$1/;
1754         return $value;
1755     } else {
1756         die "internal error"
1757     }
1758 }
1759
1760 sub lock_config_full {
1761     my ($vmid, $timeout, $code, @param) = @_;
1762
1763     my $filename = config_file_lock($vmid);
1764
1765     my $res = lock_file($filename, $timeout, $code, @param);
1766
1767     die $@ if $@;
1768
1769     return $res;
1770 }
1771
1772 sub lock_config_mode {
1773     my ($vmid, $timeout, $shared, $code, @param) = @_;
1774
1775     my $filename = config_file_lock($vmid);
1776
1777     my $res = lock_file_full($filename, $timeout, $shared, $code, @param);
1778
1779     die $@ if $@;
1780
1781     return $res;
1782 }
1783
1784 sub lock_config {
1785     my ($vmid, $code, @param) = @_;
1786
1787     return lock_config_full($vmid, 10, $code, @param);
1788 }
1789
1790 sub cfs_config_path {
1791     my ($vmid, $node) = @_;
1792
1793     $node = $nodename if !$node;
1794     return "nodes/$node/qemu-server/$vmid.conf";
1795 }
1796
1797 sub check_iommu_support{
1798     #fixme : need to check IOMMU support
1799     #http://www.linux-kvm.org/page/How_to_assign_devices_with_VT-d_in_KVM
1800
1801     my $iommu=1;
1802     return $iommu;
1803
1804 }
1805
1806 sub config_file {
1807     my ($vmid, $node) = @_;
1808
1809     my $cfspath = cfs_config_path($vmid, $node);
1810     return "/etc/pve/$cfspath";
1811 }
1812
1813 sub config_file_lock {
1814     my ($vmid) = @_;
1815
1816     return "$lock_dir/lock-$vmid.conf";
1817 }
1818
1819 sub touch_config {
1820     my ($vmid) = @_;
1821
1822     my $conf = config_file($vmid);
1823     utime undef, undef, $conf;
1824 }
1825
1826 sub destroy_vm {
1827     my ($storecfg, $vmid, $keep_empty_config) = @_;
1828
1829     my $conffile = config_file($vmid);
1830
1831     my $conf = load_config($vmid);
1832
1833     check_lock($conf);
1834
1835     # only remove disks owned by this VM
1836     foreach_drive($conf, sub {
1837         my ($ds, $drive) = @_;
1838
1839         return if drive_is_cdrom($drive);
1840
1841         my $volid = $drive->{file};
1842
1843         return if !$volid || $volid =~ m|^/|;
1844
1845         my ($path, $owner) = PVE::Storage::path($storecfg, $volid);
1846         return if !$path || !$owner || ($owner != $vmid);
1847
1848         PVE::Storage::vdisk_free($storecfg, $volid);
1849     });
1850
1851     if ($keep_empty_config) {
1852         PVE::Tools::file_set_contents($conffile, "memory: 128\n");
1853     } else {
1854         unlink $conffile;
1855     }
1856
1857     # also remove unused disk
1858     eval {
1859         my $dl = PVE::Storage::vdisk_list($storecfg, undef, $vmid);
1860
1861         eval {
1862             PVE::Storage::foreach_volid($dl, sub {
1863                 my ($volid, $sid, $volname, $d) = @_;
1864                 PVE::Storage::vdisk_free($storecfg, $volid);
1865             });
1866         };
1867         warn $@ if $@;
1868
1869     };
1870     warn $@ if $@;
1871 }
1872
1873 sub load_config {
1874     my ($vmid, $node) = @_;
1875
1876     my $cfspath = cfs_config_path($vmid, $node);
1877
1878     my $conf = PVE::Cluster::cfs_read_file($cfspath);
1879
1880     die "no such VM ('$vmid')\n" if !defined($conf);
1881
1882     return $conf;
1883 }
1884
1885 sub parse_vm_config {
1886     my ($filename, $raw) = @_;
1887
1888     return undef if !defined($raw);
1889
1890     my $res = {
1891         digest => Digest::SHA::sha1_hex($raw),
1892         snapshots => {},
1893         pending => {},
1894     };
1895
1896     $filename =~ m|/qemu-server/(\d+)\.conf$|
1897         || die "got strange filename '$filename'";
1898
1899     my $vmid = $1;
1900
1901     my $conf = $res;
1902     my $descr = '';
1903     my $section = '';
1904
1905     my @lines = split(/\n/, $raw);
1906     foreach my $line (@lines) {
1907         next if $line =~ m/^\s*$/;
1908
1909         if ($line =~ m/^\[PENDING\]\s*$/i) {
1910             $section = 'pending';
1911             $conf->{description} = $descr if $descr;
1912             $descr = '';
1913             $conf = $res->{$section} = {};
1914             next;
1915
1916         } elsif ($line =~ m/^\[([a-z][a-z0-9_\-]+)\]\s*$/i) {
1917             $section = $1;
1918             $conf->{description} = $descr if $descr;
1919             $descr = '';
1920             $conf = $res->{snapshots}->{$section} = {};
1921             next;
1922         }
1923
1924         if ($line =~ m/^\#(.*)\s*$/) {
1925             $descr .= PVE::Tools::decode_text($1) . "\n";
1926             next;
1927         }
1928
1929         if ($line =~ m/^(description):\s*(.*\S)\s*$/) {
1930             $descr .= PVE::Tools::decode_text($2);
1931         } elsif ($line =~ m/snapstate:\s*(prepare|delete)\s*$/) {
1932             $conf->{snapstate} = $1;
1933         } elsif ($line =~ m/^(args):\s*(.*\S)\s*$/) {
1934             my $key = $1;
1935             my $value = $2;
1936             $conf->{$key} = $value;
1937         } elsif ($line =~ m/^delete:\s*(.*\S)\s*$/) {
1938             my $value = $1;
1939             if ($section eq 'pending') {
1940                 $conf->{delete} = $value; # we parse this later
1941             } else {
1942                 warn "vm $vmid - propertry 'delete' is only allowed in [PENDING]\n";
1943             }
1944         } elsif ($line =~ m/^([a-z][a-z_]*\d*):\s*(\S+)\s*$/) {
1945             my $key = $1;
1946             my $value = $2;
1947             eval { $value = check_type($key, $value); };
1948             if ($@) {
1949                 warn "vm $vmid - unable to parse value of '$key' - $@";
1950             } else {
1951                 my $fmt = $confdesc->{$key}->{format};
1952                 if ($fmt && $fmt eq 'pve-qm-drive') {
1953                     my $v = parse_drive($key, $value);
1954                     if (my $volid = filename_to_volume_id($vmid, $v->{file}, $v->{media})) {
1955                         $v->{file} = $volid;
1956                         $value = print_drive($vmid, $v);
1957                     } else {
1958                         warn "vm $vmid - unable to parse value of '$key'\n";
1959                         next;
1960                     }
1961                 }
1962
1963                 if ($key eq 'cdrom') {
1964                     $conf->{ide2} = $value;
1965                 } else {
1966                     $conf->{$key} = $value;
1967                 }
1968             }
1969         }
1970     }
1971
1972     $conf->{description} = $descr if $descr;
1973
1974     delete $res->{snapstate}; # just to be sure
1975
1976     return $res;
1977 }
1978
1979 sub write_vm_config {
1980     my ($filename, $conf) = @_;
1981
1982     delete $conf->{snapstate}; # just to be sure
1983
1984     if ($conf->{cdrom}) {
1985         die "option ide2 conflicts with cdrom\n" if $conf->{ide2};
1986         $conf->{ide2} = $conf->{cdrom};
1987         delete $conf->{cdrom};
1988     }
1989
1990     # we do not use 'smp' any longer
1991     if ($conf->{sockets}) {
1992         delete $conf->{smp};
1993     } elsif ($conf->{smp}) {
1994         $conf->{sockets} = $conf->{smp};
1995         delete $conf->{cores};
1996         delete $conf->{smp};
1997     }
1998
1999     if ($conf->{maxcpus} && $conf->{sockets}) {
2000         delete $conf->{sockets};
2001     }
2002
2003     my $used_volids = {};
2004
2005     my $cleanup_config = sub {
2006         my ($cref, $pending, $snapname) = @_;
2007
2008         foreach my $key (keys %$cref) {
2009             next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots' ||
2010                 $key eq 'snapstate' || $key eq 'pending';
2011             my $value = $cref->{$key};
2012             if ($key eq 'delete') {
2013                 die "propertry 'delete' is only allowed in [PENDING]\n"
2014                     if !$pending;
2015                 # fixme: check syntax?
2016                 next;
2017             }
2018             eval { $value = check_type($key, $value); };
2019             die "unable to parse value of '$key' - $@" if $@;
2020
2021             $cref->{$key} = $value;
2022
2023             if (!$snapname && valid_drivename($key)) {
2024                 my $drive = parse_drive($key, $value);
2025                 $used_volids->{$drive->{file}} = 1 if $drive && $drive->{file};
2026             }
2027         }
2028     };
2029
2030     &$cleanup_config($conf);
2031
2032     &$cleanup_config($conf->{pending}, 1);
2033
2034     foreach my $snapname (keys %{$conf->{snapshots}}) {
2035         die "internal error" if $snapname eq 'pending';
2036         &$cleanup_config($conf->{snapshots}->{$snapname}, undef, $snapname);
2037     }
2038
2039     # remove 'unusedX' settings if we re-add a volume
2040     foreach my $key (keys %$conf) {
2041         my $value = $conf->{$key};
2042         if ($key =~ m/^unused/ && $used_volids->{$value}) {
2043             delete $conf->{$key};
2044         }
2045     }
2046
2047     my $generate_raw_config = sub {
2048         my ($conf) = @_;
2049
2050         my $raw = '';
2051
2052         # add description as comment to top of file
2053         my $descr = $conf->{description} || '';
2054         foreach my $cl (split(/\n/, $descr)) {
2055             $raw .= '#' .  PVE::Tools::encode_text($cl) . "\n";
2056         }
2057
2058         foreach my $key (sort keys %$conf) {
2059             next if $key eq 'digest' || $key eq 'description' || $key eq 'pending' || $key eq 'snapshots';
2060             $raw .= "$key: $conf->{$key}\n";
2061         }
2062         return $raw;
2063     };
2064
2065     my $raw = &$generate_raw_config($conf);
2066
2067     if (scalar(keys %{$conf->{pending}})){
2068         $raw .= "\n[PENDING]\n";
2069         $raw .= &$generate_raw_config($conf->{pending});
2070     }
2071
2072     foreach my $snapname (sort keys %{$conf->{snapshots}}) {
2073         $raw .= "\n[$snapname]\n";
2074         $raw .= &$generate_raw_config($conf->{snapshots}->{$snapname});
2075     }
2076
2077     return $raw;
2078 }
2079
2080 sub update_config_nolock {
2081     my ($vmid, $conf, $skiplock) = @_;
2082
2083     check_lock($conf) if !$skiplock;
2084
2085     my $cfspath = cfs_config_path($vmid);
2086
2087     PVE::Cluster::cfs_write_file($cfspath, $conf);
2088 }
2089
2090 sub update_config {
2091     my ($vmid, $conf, $skiplock) = @_;
2092
2093     lock_config($vmid, &update_config_nolock, $conf, $skiplock);
2094 }
2095
2096 sub load_defaults {
2097
2098     my $res = {};
2099
2100     # we use static defaults from our JSON schema configuration
2101     foreach my $key (keys %$confdesc) {
2102         if (defined(my $default = $confdesc->{$key}->{default})) {
2103             $res->{$key} = $default;
2104         }
2105     }
2106
2107     my $conf = PVE::Cluster::cfs_read_file('datacenter.cfg');
2108     $res->{keyboard} = $conf->{keyboard} if $conf->{keyboard};
2109
2110     return $res;
2111 }
2112
2113 sub config_list {
2114     my $vmlist = PVE::Cluster::get_vmlist();
2115     my $res = {};
2116     return $res if !$vmlist || !$vmlist->{ids};
2117     my $ids = $vmlist->{ids};
2118
2119     foreach my $vmid (keys %$ids) {
2120         my $d = $ids->{$vmid};
2121         next if !$d->{node} || $d->{node} ne $nodename;
2122         next if !$d->{type} || $d->{type} ne 'qemu';
2123         $res->{$vmid}->{exists} = 1;
2124     }
2125     return $res;
2126 }
2127
2128 # test if VM uses local resources (to prevent migration)
2129 sub check_local_resources {
2130     my ($conf, $noerr) = @_;
2131
2132     my $loc_res = 0;
2133
2134     $loc_res = 1 if $conf->{hostusb}; # old syntax
2135     $loc_res = 1 if $conf->{hostpci}; # old syntax
2136
2137     foreach my $k (keys %$conf) {
2138         next if $k =~ m/^usb/ && ($conf->{$k} eq 'spice');
2139         $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/;
2140     }
2141
2142     die "VM uses local resources\n" if $loc_res && !$noerr;
2143
2144     return $loc_res;
2145 }
2146
2147 # check if used storages are available on all nodes (use by migrate)
2148 sub check_storage_availability {
2149     my ($storecfg, $conf, $node) = @_;
2150
2151     foreach_drive($conf, sub {
2152         my ($ds, $drive) = @_;
2153
2154         my $volid = $drive->{file};
2155         return if !$volid;
2156
2157         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
2158         return if !$sid;
2159
2160         # check if storage is available on both nodes
2161         my $scfg = PVE::Storage::storage_check_node($storecfg, $sid);
2162         PVE::Storage::storage_check_node($storecfg, $sid, $node);
2163    });
2164 }
2165
2166 # list nodes where all VM images are available (used by has_feature API)
2167 sub shared_nodes {
2168     my ($conf, $storecfg) = @_;
2169
2170     my $nodelist = PVE::Cluster::get_nodelist();
2171     my $nodehash = { map { $_ => 1 } @$nodelist };
2172     my $nodename = PVE::INotify::nodename();
2173
2174     foreach_drive($conf, sub {
2175         my ($ds, $drive) = @_;
2176
2177         my $volid = $drive->{file};
2178         return if !$volid;
2179
2180         my ($storeid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
2181         if ($storeid) {
2182             my $scfg = PVE::Storage::storage_config($storecfg, $storeid);
2183             if ($scfg->{disable}) {
2184                 $nodehash = {};
2185             } elsif (my $avail = $scfg->{nodes}) {
2186                 foreach my $node (keys %$nodehash) {
2187                     delete $nodehash->{$node} if !$avail->{$node};
2188                 }
2189             } elsif (!$scfg->{shared}) {
2190                 foreach my $node (keys %$nodehash) {
2191                     delete $nodehash->{$node} if $node ne $nodename
2192                 }
2193             }
2194         }
2195     });
2196
2197     return $nodehash
2198 }
2199
2200 sub check_lock {
2201     my ($conf) = @_;
2202
2203     die "VM is locked ($conf->{lock})\n" if $conf->{lock};
2204 }
2205
2206 sub check_cmdline {
2207     my ($pidfile, $pid) = @_;
2208
2209     my $fh = IO::File->new("/proc/$pid/cmdline", "r");
2210     if (defined($fh)) {
2211         my $line = <$fh>;
2212         $fh->close;
2213         return undef if !$line;
2214         my @param = split(/\0/, $line);
2215
2216         my $cmd = $param[0];
2217         return if !$cmd || ($cmd !~ m|kvm$| && $cmd !~ m|qemu-system-x86_64$|);
2218
2219         for (my $i = 0; $i < scalar (@param); $i++) {
2220             my $p = $param[$i];
2221             next if !$p;
2222             if (($p eq '-pidfile') || ($p eq '--pidfile')) {
2223                 my $p = $param[$i+1];
2224                 return 1 if $p && ($p eq $pidfile);
2225                 return undef;
2226             }
2227         }
2228     }
2229     return undef;
2230 }
2231
2232 sub check_running {
2233     my ($vmid, $nocheck, $node) = @_;
2234
2235     my $filename = config_file($vmid, $node);
2236
2237     die "unable to find configuration file for VM $vmid - no such machine\n"
2238         if !$nocheck && ! -f $filename;
2239
2240     my $pidfile = pidfile_name($vmid);
2241
2242     if (my $fd = IO::File->new("<$pidfile")) {
2243         my $st = stat($fd);
2244         my $line = <$fd>;
2245         close($fd);
2246
2247         my $mtime = $st->mtime;
2248         if ($mtime > time()) {
2249             warn "file '$filename' modified in future\n";
2250         }
2251
2252         if ($line =~ m/^(\d+)$/) {
2253             my $pid = $1;
2254             if (check_cmdline($pidfile, $pid)) {
2255                 if (my $pinfo = PVE::ProcFSTools::check_process_running($pid)) {
2256                     return $pid;
2257                 }
2258             }
2259         }
2260     }
2261
2262     return undef;
2263 }
2264
2265 sub vzlist {
2266
2267     my $vzlist = config_list();
2268
2269     my $fd = IO::Dir->new($var_run_tmpdir) || return $vzlist;
2270
2271     while (defined(my $de = $fd->read)) {
2272         next if $de !~ m/^(\d+)\.pid$/;
2273         my $vmid = $1;
2274         next if !defined($vzlist->{$vmid});
2275         if (my $pid = check_running($vmid)) {
2276             $vzlist->{$vmid}->{pid} = $pid;
2277         }
2278     }
2279
2280     return $vzlist;
2281 }
2282
2283 sub disksize {
2284     my ($storecfg, $conf) = @_;
2285
2286     my $bootdisk = $conf->{bootdisk};
2287     return undef if !$bootdisk;
2288     return undef if !valid_drivename($bootdisk);
2289
2290     return undef if !$conf->{$bootdisk};
2291
2292     my $drive = parse_drive($bootdisk, $conf->{$bootdisk});
2293     return undef if !defined($drive);
2294
2295     return undef if drive_is_cdrom($drive);
2296
2297     my $volid = $drive->{file};
2298     return undef if !$volid;
2299
2300     return $drive->{size};
2301 }
2302
2303 my $last_proc_pid_stat;
2304
2305 # get VM status information
2306 # This must be fast and should not block ($full == false)
2307 # We only query KVM using QMP if $full == true (this can be slow)
2308 sub vmstatus {
2309     my ($opt_vmid, $full) = @_;
2310
2311     my $res = {};
2312
2313     my $storecfg = PVE::Storage::config();
2314
2315     my $list = vzlist();
2316     my ($uptime) = PVE::ProcFSTools::read_proc_uptime(1);
2317
2318     my $cpucount = $cpuinfo->{cpus} || 1;
2319
2320     foreach my $vmid (keys %$list) {
2321         next if $opt_vmid && ($vmid ne $opt_vmid);
2322
2323         my $cfspath = cfs_config_path($vmid);
2324         my $conf = PVE::Cluster::cfs_read_file($cfspath) || {};
2325
2326         my $d = {};
2327         $d->{pid} = $list->{$vmid}->{pid};
2328
2329         # fixme: better status?
2330         $d->{status} = $list->{$vmid}->{pid} ? 'running' : 'stopped';
2331
2332         my $size = disksize($storecfg, $conf);
2333         if (defined($size)) {
2334             $d->{disk} = 0; # no info available
2335             $d->{maxdisk} = $size;
2336         } else {
2337             $d->{disk} = 0;
2338             $d->{maxdisk} = 0;
2339         }
2340
2341         $d->{cpus} = ($conf->{sockets} || 1) * ($conf->{cores} || 1);
2342         $d->{cpus} = $cpucount if $d->{cpus} > $cpucount;
2343
2344         $d->{name} = $conf->{name} || "VM $vmid";
2345         $d->{maxmem} = $conf->{memory} ? $conf->{memory}*(1024*1024) : 0;
2346
2347         if ($conf->{balloon}) {
2348             $d->{balloon_min} = $conf->{balloon}*(1024*1024);
2349             $d->{shares} = defined($conf->{shares}) ? $conf->{shares} : 1000;
2350         }
2351
2352         $d->{uptime} = 0;
2353         $d->{cpu} = 0;
2354         $d->{mem} = 0;
2355
2356         $d->{netout} = 0;
2357         $d->{netin} = 0;
2358
2359         $d->{diskread} = 0;
2360         $d->{diskwrite} = 0;
2361
2362         $d->{template} = is_template($conf);
2363
2364         $res->{$vmid} = $d;
2365     }
2366
2367     my $netdev = PVE::ProcFSTools::read_proc_net_dev();
2368     foreach my $dev (keys %$netdev) {
2369         next if $dev !~ m/^tap([1-9]\d*)i/;
2370         my $vmid = $1;
2371         my $d = $res->{$vmid};
2372         next if !$d;
2373
2374         $d->{netout} += $netdev->{$dev}->{receive};
2375         $d->{netin} += $netdev->{$dev}->{transmit};
2376     }
2377
2378     my $ctime = gettimeofday;
2379
2380     foreach my $vmid (keys %$list) {
2381
2382         my $d = $res->{$vmid};
2383         my $pid = $d->{pid};
2384         next if !$pid;
2385
2386         my $pstat = PVE::ProcFSTools::read_proc_pid_stat($pid);
2387         next if !$pstat; # not running
2388
2389         my $used = $pstat->{utime} + $pstat->{stime};
2390
2391         $d->{uptime} = int(($uptime - $pstat->{starttime})/$cpuinfo->{user_hz});
2392
2393         if ($pstat->{vsize}) {
2394             $d->{mem} = int(($pstat->{rss}/$pstat->{vsize})*$d->{maxmem});
2395         }
2396
2397         my $old = $last_proc_pid_stat->{$pid};
2398         if (!$old) {
2399             $last_proc_pid_stat->{$pid} = {
2400                 time => $ctime,
2401                 used => $used,
2402                 cpu => 0,
2403             };
2404             next;
2405         }
2406
2407         my $dtime = ($ctime -  $old->{time}) * $cpucount * $cpuinfo->{user_hz};
2408
2409         if ($dtime > 1000) {
2410             my $dutime = $used -  $old->{used};
2411
2412             $d->{cpu} = (($dutime/$dtime)* $cpucount) / $d->{cpus};
2413             $last_proc_pid_stat->{$pid} = {
2414                 time => $ctime,
2415                 used => $used,
2416                 cpu => $d->{cpu},
2417             };
2418         } else {
2419             $d->{cpu} = $old->{cpu};
2420         }
2421     }
2422
2423     return $res if !$full;
2424
2425     my $qmpclient = PVE::QMPClient->new();
2426
2427     my $ballooncb = sub {
2428         my ($vmid, $resp) = @_;
2429
2430         my $info = $resp->{'return'};
2431         return if !$info->{max_mem};
2432
2433         my $d = $res->{$vmid};
2434
2435         # use memory assigned to VM
2436         $d->{maxmem} = $info->{max_mem};
2437         $d->{balloon} = $info->{actual};
2438
2439         if (defined($info->{total_mem}) && defined($info->{free_mem})) {
2440             $d->{mem} = $info->{total_mem} - $info->{free_mem};
2441             $d->{freemem} = $info->{free_mem};
2442         }
2443
2444     };
2445
2446     my $blockstatscb = sub {
2447         my ($vmid, $resp) = @_;
2448         my $data = $resp->{'return'} || [];
2449         my $totalrdbytes = 0;
2450         my $totalwrbytes = 0;
2451         for my $blockstat (@$data) {
2452             $totalrdbytes = $totalrdbytes + $blockstat->{stats}->{rd_bytes};
2453             $totalwrbytes = $totalwrbytes + $blockstat->{stats}->{wr_bytes};
2454         }
2455         $res->{$vmid}->{diskread} = $totalrdbytes;
2456         $res->{$vmid}->{diskwrite} = $totalwrbytes;
2457     };
2458
2459     my $statuscb = sub {
2460         my ($vmid, $resp) = @_;
2461
2462         $qmpclient->queue_cmd($vmid, $blockstatscb, 'query-blockstats');
2463         # this fails if ballon driver is not loaded, so this must be
2464         # the last commnand (following command are aborted if this fails).
2465         $qmpclient->queue_cmd($vmid, $ballooncb, 'query-balloon');
2466
2467         my $status = 'unknown';
2468         if (!defined($status = $resp->{'return'}->{status})) {
2469             warn "unable to get VM status\n";
2470             return;
2471         }
2472
2473         $res->{$vmid}->{qmpstatus} = $resp->{'return'}->{status};
2474     };
2475
2476     foreach my $vmid (keys %$list) {
2477         next if $opt_vmid && ($vmid ne $opt_vmid);
2478         next if !$res->{$vmid}->{pid}; # not running
2479         $qmpclient->queue_cmd($vmid, $statuscb, 'query-status');
2480     }
2481
2482     $qmpclient->queue_execute(undef, 1);
2483
2484     foreach my $vmid (keys %$list) {
2485         next if $opt_vmid && ($vmid ne $opt_vmid);
2486         $res->{$vmid}->{qmpstatus} = $res->{$vmid}->{status} if !$res->{$vmid}->{qmpstatus};
2487     }
2488
2489     return $res;
2490 }
2491
2492 sub foreach_drive {
2493     my ($conf, $func) = @_;
2494
2495     foreach my $ds (keys %$conf) {
2496         next if !valid_drivename($ds);
2497
2498         my $drive = parse_drive($ds, $conf->{$ds});
2499         next if !$drive;
2500
2501         &$func($ds, $drive);
2502     }
2503 }
2504
2505 sub foreach_volid {
2506     my ($conf, $func) = @_;
2507
2508     my $volhash = {};
2509
2510     my $test_volid = sub {
2511         my ($volid, $is_cdrom) = @_;
2512
2513         return if !$volid;
2514
2515         $volhash->{$volid} = $is_cdrom || 0;
2516     };
2517
2518     foreach_drive($conf, sub {
2519         my ($ds, $drive) = @_;
2520         &$test_volid($drive->{file}, drive_is_cdrom($drive));
2521     });
2522
2523     foreach my $snapname (keys %{$conf->{snapshots}}) {
2524         my $snap = $conf->{snapshots}->{$snapname};
2525         &$test_volid($snap->{vmstate}, 0);
2526         foreach_drive($snap, sub {
2527             my ($ds, $drive) = @_;
2528             &$test_volid($drive->{file}, drive_is_cdrom($drive));
2529         });
2530     }
2531
2532     foreach my $volid (keys %$volhash) {
2533         &$func($volid, $volhash->{$volid});
2534     }
2535 }
2536
2537 sub vga_conf_has_spice {
2538     my ($vga) = @_;
2539
2540     return 0 if !$vga || $vga !~ m/^qxl([234])?$/;
2541
2542     return $1 || 1;
2543 }
2544
2545 sub config_to_command {
2546     my ($storecfg, $vmid, $conf, $defaults, $forcemachine) = @_;
2547
2548     my $cmd = [];
2549     my $globalFlags = [];
2550     my $machineFlags = [];
2551     my $rtcFlags = [];
2552     my $cpuFlags = [];
2553     my $devices = [];
2554     my $pciaddr = '';
2555     my $bridges = {};
2556     my $kvmver = kvm_user_version();
2557     my $vernum = 0; # unknown
2558     if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
2559         $vernum = $1*1000000+$2*1000;
2560     } elsif ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
2561         $vernum = $1*1000000+$2*1000+$3;
2562     }
2563
2564     die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 15000;
2565
2566     my $have_ovz = -f '/proc/vz/vestat';
2567
2568     my $q35 = machine_type_is_q35($conf);
2569
2570     push @$cmd, '/usr/bin/kvm';
2571
2572     push @$cmd, '-id', $vmid;
2573
2574     my $use_virtio = 0;
2575
2576     my $qmpsocket = qmp_socket($vmid);
2577     push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
2578     push @$cmd, '-mon', "chardev=qmp,mode=control";
2579
2580     my $socket = vnc_socket($vmid);
2581     push @$cmd,  '-vnc', "unix:$socket,x509,password";
2582
2583     push @$cmd, '-pidfile' , pidfile_name($vmid);
2584
2585     push @$cmd, '-daemonize';
2586
2587     if ($conf->{smbios1}) {
2588         push @$cmd, '-smbios', "type=1,$conf->{smbios1}";
2589     }
2590
2591     push @$cmd, '-object', "iothread,id=iothread0" if $conf->{iothread};
2592
2593     if ($q35) {
2594         # the q35 chipset support native usb2, so we enable usb controller
2595         # by default for this machine type
2596         push @$devices, '-readconfig', '/usr/share/qemu-server/pve-q35.cfg';
2597     } else {
2598         $pciaddr = print_pci_addr("piix3", $bridges);
2599         push @$devices, '-device', "piix3-usb-uhci,id=uhci$pciaddr.0x2";
2600
2601         my $use_usb2 = 0;
2602         for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
2603             next if !$conf->{"usb$i"};
2604             $use_usb2 = 1;
2605         }
2606         # include usb device config
2607         push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
2608     }
2609
2610     my $vga = $conf->{vga};
2611
2612     my $qxlnum = vga_conf_has_spice($vga);
2613     $vga = 'qxl' if $qxlnum;
2614
2615     if (!$vga) {
2616         if ($conf->{ostype} && ($conf->{ostype} eq 'win8' ||
2617                                 $conf->{ostype} eq 'win7' ||
2618                                 $conf->{ostype} eq 'w2k8')) {
2619             $vga = 'std';
2620         } else {
2621             $vga = 'cirrus';
2622         }
2623     }
2624
2625     # enable absolute mouse coordinates (needed by vnc)
2626     my $tablet;
2627     if (defined($conf->{tablet})) {
2628         $tablet = $conf->{tablet};
2629     } else {
2630         $tablet = $defaults->{tablet};
2631         $tablet = 0 if $qxlnum; # disable for spice because it is not needed
2632         $tablet = 0 if $vga =~ m/^serial\d+$/; # disable if we use serial terminal (no vga card)
2633     }
2634
2635     push @$devices, '-device', print_tabletdevice_full($conf) if $tablet;
2636
2637     # host pci devices
2638     for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
2639         my $d = parse_hostpci($conf->{"hostpci$i"});
2640         next if !$d;
2641
2642         my $pcie = $d->{pcie};
2643         if($pcie){
2644             die "q35 machine model is not enabled" if !$q35;
2645             $pciaddr = print_pcie_addr("hostpci$i");
2646         }else{
2647             $pciaddr = print_pci_addr("hostpci$i", $bridges);
2648         }
2649
2650         my $rombar = $d->{rombar} && $d->{rombar} eq 'off' ? ",rombar=0" : "";
2651         my $driver = $d->{driver} && $d->{driver} eq 'vfio' ? "vfio-pci" : "pci-assign";
2652         my $xvga = $d->{'x-vga'} && $d->{'x-vga'} eq 'on' ? ",x-vga=on" : "";
2653         if ($xvga && $xvga ne '') {
2654             push @$cpuFlags, 'kvm=off';
2655             $vga = 'none';
2656         }
2657         $driver = "vfio-pci" if $xvga ne '';
2658         my $pcidevices = $d->{pciid};
2659         my $multifunction = 1 if @$pcidevices > 1;
2660
2661         my $j=0;
2662         foreach my $pcidevice (@$pcidevices) {
2663
2664             my $id = "hostpci$i";
2665             $id .= ".$j" if $multifunction;
2666             my $addr = $pciaddr;
2667             $addr .= ".$j" if $multifunction;
2668             my $devicestr = "$driver,host=$pcidevice->{id}.$pcidevice->{function},id=$id$addr";
2669
2670             if($j == 0){
2671                 $devicestr .= "$rombar$xvga";
2672                 $devicestr .= ",multifunction=on" if $multifunction;
2673             }
2674
2675             push @$devices, '-device', $devicestr;
2676             $j++;
2677         }
2678     }
2679
2680     # usb devices
2681     for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
2682         my $d = parse_usb_device($conf->{"usb$i"});
2683         next if !$d;
2684         if ($d->{vendorid} && $d->{productid}) {
2685             push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2686         } elsif (defined($d->{hostbus}) && defined($d->{hostport})) {
2687             push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2688         } elsif ($d->{spice}) {
2689             # usb redir support for spice
2690             push @$devices, '-chardev', "spicevmc,id=usbredirchardev$i,name=usbredir";
2691             push @$devices, '-device', "usb-redir,chardev=usbredirchardev$i,id=usbredirdev$i,bus=ehci.0";
2692         }
2693     }
2694
2695     # serial devices
2696     for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++)  {
2697         if (my $path = $conf->{"serial$i"}) {
2698             if ($path eq 'socket') {
2699                 my $socket = "/var/run/qemu-server/${vmid}.serial$i";
2700                 push @$devices, '-chardev', "socket,id=serial$i,path=$socket,server,nowait";
2701                 push @$devices, '-device', "isa-serial,chardev=serial$i";
2702             } else {
2703                 die "no such serial device\n" if ! -c $path;
2704                 push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2705                 push @$devices, '-device', "isa-serial,chardev=serial$i";
2706             }
2707         }
2708     }
2709
2710     # parallel devices
2711     for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++)  {
2712         if (my $path = $conf->{"parallel$i"}) {
2713             die "no such parallel device\n" if ! -c $path;
2714             my $devtype = $path =~ m!^/dev/usb/lp! ? 'tty' : 'parport';
2715             push @$devices, '-chardev', "$devtype,id=parallel$i,path=$path";
2716             push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2717         }
2718     }
2719
2720     my $vmname = $conf->{name} || "vm$vmid";
2721
2722     push @$cmd, '-name', $vmname;
2723
2724     my $sockets = 1;
2725     $sockets = $conf->{smp} if $conf->{smp}; # old style - no longer iused
2726     $sockets = $conf->{sockets} if  $conf->{sockets};
2727
2728     my $cores = $conf->{cores} || 1;
2729     my $maxcpus = $conf->{maxcpus} if $conf->{maxcpus};
2730
2731     my $total_cores = $sockets * $cores;
2732     my $allowed_cores = $cpuinfo->{cpus};
2733
2734     die "MAX $allowed_cores cores allowed per VM on this node\n"
2735         if ($allowed_cores < $total_cores);
2736
2737     if ($maxcpus) {
2738         push @$cmd, '-smp', "cpus=$cores,maxcpus=$maxcpus";
2739     } else {
2740         push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2741     }
2742
2743     push @$cmd, '-nodefaults';
2744
2745     my $bootorder = $conf->{boot} || $confdesc->{boot}->{default};
2746
2747     my $bootindex_hash = {};
2748     my $i = 1;
2749     foreach my $o (split(//, $bootorder)) {
2750         $bootindex_hash->{$o} = $i*100;
2751         $i++;
2752     }
2753
2754     push @$cmd, '-boot', "menu=on";
2755
2756     push @$cmd, '-no-acpi' if defined($conf->{acpi}) && $conf->{acpi} == 0;
2757
2758     push @$cmd, '-no-reboot' if  defined($conf->{reboot}) && $conf->{reboot} == 0;
2759
2760     push @$cmd, '-vga', $vga if $vga && $vga !~ m/^serial\d+$/; # for kvm 77 and later
2761
2762     # time drift fix
2763     my $tdf = defined($conf->{tdf}) ? $conf->{tdf} : $defaults->{tdf};
2764
2765     my $nokvm = defined($conf->{kvm}) && $conf->{kvm} == 0 ? 1 : 0;
2766     my $useLocaltime = $conf->{localtime};
2767
2768     if (my $ost = $conf->{ostype}) {
2769         # other, wxp, w2k, w2k3, w2k8, wvista, win7, win8, l24, l26, solaris
2770
2771         if ($ost =~ m/^w/) { # windows
2772             $useLocaltime = 1 if !defined($conf->{localtime});
2773
2774             # use time drift fix when acpi is enabled
2775             if (!(defined($conf->{acpi}) && $conf->{acpi} == 0)) {
2776                 $tdf = 1 if !defined($conf->{tdf});
2777             }
2778         }
2779
2780         if ($ost eq 'win7' || $ost eq 'win8' || $ost eq 'w2k8' ||
2781             $ost eq 'wvista') {
2782             push @$globalFlags, 'kvm-pit.lost_tick_policy=discard';
2783             push @$cmd, '-no-hpet';
2784             #push @$cpuFlags , 'hv_vapic" if !$nokvm;  #fixme, my win2008R2 hang at boot with this
2785             push @$cpuFlags , 'hv_spinlocks=0xffff' if !$nokvm;
2786         }
2787
2788         if ($ost eq 'win7' || $ost eq 'win8') {
2789             push @$cpuFlags , 'hv_relaxed' if !$nokvm;
2790         }
2791     }
2792
2793     push @$rtcFlags, 'driftfix=slew' if $tdf;
2794
2795     if ($nokvm) {
2796         push @$machineFlags, 'accel=tcg';
2797     } else {
2798         die "No accelerator found!\n" if !$cpuinfo->{hvm};
2799     }
2800
2801     my $machine_type = $forcemachine || $conf->{machine};
2802     if ($machine_type) {
2803         push @$machineFlags, "type=${machine_type}";
2804     }
2805
2806     if ($conf->{startdate}) {
2807         push @$rtcFlags, "base=$conf->{startdate}";
2808     } elsif ($useLocaltime) {
2809         push @$rtcFlags, 'base=localtime';
2810     }
2811
2812     my $cpu = $nokvm ? "qemu64" : "kvm64";
2813     $cpu = $conf->{cpu} if $conf->{cpu};
2814
2815     push @$cpuFlags , '+lahf_lm' if $cpu eq 'kvm64';
2816
2817     push @$cpuFlags , '+x2apic' if !$nokvm && $conf->{ostype} ne 'solaris';
2818
2819     push @$cpuFlags , '-x2apic' if $conf->{ostype} eq 'solaris';
2820
2821     push @$cpuFlags, '+sep' if $cpu eq 'kvm64' || $cpu eq 'kvm32';
2822
2823     $cpu .= "," . join(',', @$cpuFlags) if scalar(@$cpuFlags);
2824
2825     # Note: enforce needs kernel 3.10, so we do not use it for now
2826     # push @$cmd, '-cpu', "$cpu,enforce";
2827     push @$cmd, '-cpu', $cpu;
2828
2829     my $memory =  $conf->{memory} || $defaults->{memory};
2830     push @$cmd, '-m', $memory;
2831
2832     if ($conf->{numa}) {
2833
2834         my $numa_totalmemory = undef;
2835         for (my $i = 0; $i < $MAX_NUMA; $i++) {
2836             next if !$conf->{"numa$i"};
2837             my $numa = parse_numa($conf->{"numa$i"});
2838             next if !$numa;
2839             # memory
2840             die "missing numa node$i memory value\n" if !$numa->{memory};
2841             my $numa_memory = $numa->{memory};
2842             $numa_totalmemory += $numa_memory;
2843             my $numa_object = "memory-backend-ram,id=ram-node$i,size=$numa_memory"."M";
2844
2845             # cpus
2846             my $cpus_start = $numa->{cpus}->{start};
2847             die "missing numa node$i cpus\n" if !defined($cpus_start);
2848             my $cpus_end = $numa->{cpus}->{end} if defined($numa->{cpus}->{end});
2849             my $cpus = $cpus_start;
2850             if (defined($cpus_end)) {
2851                 $cpus .= "-$cpus_end";
2852                 die "numa node$i :  cpu range $cpus is incorrect\n" if $cpus_end <= $cpus_start;
2853             }
2854
2855             # hostnodes
2856             my $hostnodes_start = $numa->{hostnodes}->{start};
2857             if (defined($hostnodes_start)) {
2858                 my $hostnodes_end = $numa->{hostnodes}->{end} if defined($numa->{hostnodes}->{end});
2859                 my $hostnodes = $hostnodes_start;
2860                 if (defined($hostnodes_end)) {
2861                     $hostnodes .= "-$hostnodes_end";
2862                     die "host node $hostnodes range is incorrect\n" if $hostnodes_end <= $hostnodes_start;
2863                 }
2864
2865                 my $hostnodes_end_range = defined($hostnodes_end) ? $hostnodes_end : $hostnodes_start;
2866                 for (my $i = $hostnodes_start; $i <= $hostnodes_end_range; $i++ ) {
2867                     die "host numa node$i don't exist\n" if ! -d "/sys/devices/system/node/node$i/";
2868                 }
2869
2870                 # policy
2871                 my $policy = $numa->{policy};
2872                 die "you need to define a policy for hostnode $hostnodes\n" if !$policy;
2873                 $numa_object .= ",host-nodes=$hostnodes,policy=$policy";
2874             }
2875
2876             push @$cmd, '-object', $numa_object;
2877             push @$cmd, '-numa', "node,nodeid=$i,cpus=$cpus,memdev=ram-node$i";
2878         }
2879
2880         die "total memory for NUMA nodes must be equal to vm memory\n"
2881             if $numa_totalmemory && $numa_totalmemory != $memory;
2882
2883         #if no custom tology, we split memory and cores across numa nodes
2884         if(!$numa_totalmemory) {
2885
2886             my $numa_memory = ($memory / $sockets) . "M";
2887
2888             for (my $i = 0; $i < $sockets; $i++)  {
2889
2890                 my $cpustart = ($cores * $i);
2891                 my $cpuend = ($cpustart + $cores - 1) if $cores && $cores > 1;
2892                 my $cpus = $cpustart;
2893                 $cpus .= "-$cpuend" if $cpuend;
2894
2895                 push @$cmd, '-object', "memory-backend-ram,size=$numa_memory,id=ram-node$i";
2896                 push @$cmd, '-numa', "node,nodeid=$i,cpus=$cpus,memdev=ram-node$i";
2897             }
2898         }
2899     }
2900
2901     push @$cmd, '-S' if $conf->{freeze};
2902
2903     # set keyboard layout
2904     my $kb = $conf->{keyboard} || $defaults->{keyboard};
2905     push @$cmd, '-k', $kb if $kb;
2906
2907     # enable sound
2908     #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2909     #push @$cmd, '-soundhw', 'es1370';
2910     #push @$cmd, '-soundhw', $soundhw if $soundhw;
2911
2912     if($conf->{agent}) {
2913         my $qgasocket = qmp_socket($vmid, 1);
2914         my $pciaddr = print_pci_addr("qga0", $bridges);
2915         push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
2916         push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
2917         push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
2918     }
2919
2920     my $spice_port;
2921
2922     if ($qxlnum) {
2923         if ($qxlnum > 1) {
2924             if ($conf->{ostype} && $conf->{ostype} =~ m/^w/){
2925                 for(my $i = 1; $i < $qxlnum; $i++){
2926                     my $pciaddr = print_pci_addr("vga$i", $bridges);
2927                     push @$cmd, '-device', "qxl,id=vga$i,ram_size=67108864,vram_size=33554432$pciaddr";
2928                 }
2929             } else {
2930                 # assume other OS works like Linux
2931                 push @$cmd, '-global', 'qxl-vga.ram_size=134217728';
2932                 push @$cmd, '-global', 'qxl-vga.vram_size=67108864';
2933             }
2934         }
2935
2936         my $pciaddr = print_pci_addr("spice", $bridges);
2937
2938         $spice_port = PVE::Tools::next_spice_port();
2939
2940         push @$devices, '-spice', "tls-port=${spice_port},addr=127.0.0.1,tls-ciphers=DES-CBC3-SHA,seamless-migration=on";
2941
2942         push @$devices, '-device', "virtio-serial,id=spice$pciaddr";
2943         push @$devices, '-chardev', "spicevmc,id=vdagent,name=vdagent";
2944         push @$devices, '-device', "virtserialport,chardev=vdagent,name=com.redhat.spice.0";
2945     }
2946
2947     # enable balloon by default, unless explicitly disabled
2948     if (!defined($conf->{balloon}) || $conf->{balloon}) {
2949         $pciaddr = print_pci_addr("balloon0", $bridges);
2950         push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr";
2951     }
2952
2953     if ($conf->{watchdog}) {
2954         my $wdopts = parse_watchdog($conf->{watchdog});
2955         $pciaddr = print_pci_addr("watchdog", $bridges);
2956         my $watchdog = $wdopts->{model} || 'i6300esb';
2957         push @$devices, '-device', "$watchdog$pciaddr";
2958         push @$devices, '-watchdog-action', $wdopts->{action} if $wdopts->{action};
2959     }
2960
2961     my $vollist = [];
2962     my $scsicontroller = {};
2963     my $ahcicontroller = {};
2964     my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : $defaults->{scsihw};
2965
2966     # Add iscsi initiator name if available
2967     if (my $initiator = get_initiator_name()) {
2968         push @$devices, '-iscsi', "initiator-name=$initiator";
2969     }
2970
2971     foreach_drive($conf, sub {
2972         my ($ds, $drive) = @_;
2973
2974         if (PVE::Storage::parse_volume_id($drive->{file}, 1)) {
2975             push @$vollist, $drive->{file};
2976         }
2977
2978         $use_virtio = 1 if $ds =~ m/^virtio/;
2979
2980         if (drive_is_cdrom ($drive)) {
2981             if ($bootindex_hash->{d}) {
2982                 $drive->{bootindex} = $bootindex_hash->{d};
2983                 $bootindex_hash->{d} += 1;
2984             }
2985         } else {
2986             if ($bootindex_hash->{c}) {
2987                 $drive->{bootindex} = $bootindex_hash->{c} if $conf->{bootdisk} && ($conf->{bootdisk} eq $ds);
2988                 $bootindex_hash->{c} += 1;
2989             }
2990         }
2991
2992         if ($drive->{interface} eq 'scsi') {
2993
2994             my $maxdev = ($scsihw !~ m/^lsi/) ? 256 : 7;
2995             my $controller = int($drive->{index} / $maxdev);
2996             $pciaddr = print_pci_addr("scsihw$controller", $bridges);
2997             push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
2998             $scsicontroller->{$controller}=1;
2999         }
3000
3001         if ($drive->{interface} eq 'sata') {
3002            my $controller = int($drive->{index} / $MAX_SATA_DISKS);
3003            $pciaddr = print_pci_addr("ahci$controller", $bridges);
3004            push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
3005            $ahcicontroller->{$controller}=1;
3006         }
3007
3008         my $drive_cmd = print_drive_full($storecfg, $vmid, $drive);
3009         push @$devices, '-drive',$drive_cmd;
3010         push @$devices, '-device', print_drivedevice_full($storecfg, $conf, $vmid, $drive, $bridges);
3011     });
3012
3013     for (my $i = 0; $i < $MAX_NETS; $i++) {
3014          next if !$conf->{"net$i"};
3015          my $d = parse_net($conf->{"net$i"});
3016          next if !$d;
3017
3018          $use_virtio = 1 if $d->{model} eq 'virtio';
3019
3020          if ($bootindex_hash->{n}) {
3021             $d->{bootindex} = $bootindex_hash->{n};
3022             $bootindex_hash->{n} += 1;
3023          }
3024
3025          my $netdevfull = print_netdev_full($vmid,$conf,$d,"net$i");
3026          push @$devices, '-netdev', $netdevfull;
3027
3028          my $netdevicefull = print_netdevice_full($vmid,$conf,$d,"net$i",$bridges);
3029          push @$devices, '-device', $netdevicefull;
3030     }
3031
3032     if (!$q35) {
3033         # add pci bridges
3034         while (my ($k, $v) = each %$bridges) {
3035             $pciaddr = print_pci_addr("pci.$k");
3036             unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
3037         }
3038     }
3039
3040     # hack: virtio with fairsched is unreliable, so we do not use fairsched
3041     # when the VM uses virtio devices.
3042     if (!$use_virtio && $have_ovz) {
3043
3044         my $cpuunits = defined($conf->{cpuunits}) ?
3045             $conf->{cpuunits} : $defaults->{cpuunits};
3046
3047         push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
3048
3049         # fixme: cpulimit is currently ignored
3050         #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
3051     }
3052
3053     # add custom args
3054     if ($conf->{args}) {
3055         my $aa = PVE::Tools::split_args($conf->{args});
3056         push @$cmd, @$aa;
3057     }
3058
3059     push @$cmd, @$devices;
3060     push @$cmd, '-rtc', join(',', @$rtcFlags)
3061         if scalar(@$rtcFlags);
3062     push @$cmd, '-machine', join(',', @$machineFlags)
3063         if scalar(@$machineFlags);
3064     push @$cmd, '-global', join(',', @$globalFlags)
3065         if scalar(@$globalFlags);
3066
3067     return wantarray ? ($cmd, $vollist, $spice_port) : $cmd;
3068 }
3069
3070 sub vnc_socket {
3071     my ($vmid) = @_;
3072     return "${var_run_tmpdir}/$vmid.vnc";
3073 }
3074
3075 sub spice_port {
3076     my ($vmid) = @_;
3077
3078     my $res = vm_mon_cmd($vmid, 'query-spice');
3079
3080     return $res->{'tls-port'} || $res->{'port'} || die "no spice port\n";
3081 }
3082
3083 sub qmp_socket {
3084     my ($vmid, $qga) = @_;
3085     my $sockettype = $qga ? 'qga' : 'qmp';
3086     return "${var_run_tmpdir}/$vmid.$sockettype";
3087 }
3088
3089 sub pidfile_name {
3090     my ($vmid) = @_;
3091     return "${var_run_tmpdir}/$vmid.pid";
3092 }
3093
3094 sub vm_devices_list {
3095     my ($vmid) = @_;
3096
3097     my $res = vm_mon_cmd($vmid, 'query-pci');
3098     my $devices = {};
3099     foreach my $pcibus (@$res) {
3100         foreach my $device (@{$pcibus->{devices}}) {
3101             next if !$device->{'qdev_id'};
3102             $devices->{$device->{'qdev_id'}} = 1;
3103         }
3104     }
3105
3106     my $resblock = vm_mon_cmd($vmid, 'query-block');
3107     foreach my $block (@$resblock) {
3108         if($block->{device} =~ m/^drive-(\S+)/){
3109                 $devices->{$1} = 1;
3110         }
3111     }
3112
3113     my $resmice = vm_mon_cmd($vmid, 'query-mice');
3114     foreach my $mice (@$resmice) {
3115         if ($mice->{name} eq 'QEMU HID Tablet') {
3116             $devices->{tablet} = 1;
3117             last;
3118         }
3119     }
3120
3121     return $devices;
3122 }
3123
3124 sub vm_deviceplug {
3125     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
3126
3127     return 1 if !check_running($vmid);
3128
3129     my $q35 = machine_type_is_q35($conf);
3130
3131     return 1 if !$conf->{hotplug};
3132
3133     my $devices_list = vm_devices_list($vmid);
3134     return 1 if defined($devices_list->{$deviceid});
3135
3136     if ($deviceid eq 'tablet') {
3137         qemu_deviceadd($vmid, print_tabletdevice_full($conf));
3138         return 1;
3139     }
3140
3141     qemu_bridgeadd($storecfg, $conf, $vmid, $deviceid); #add bridge if we need it for the device
3142
3143     if ($deviceid =~ m/^(virtio)(\d+)$/) {
3144         return undef if !qemu_driveadd($storecfg, $vmid, $device);
3145         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
3146         qemu_deviceadd($vmid, $devicefull);
3147         if(!qemu_deviceaddverify($vmid, $deviceid)) {
3148            qemu_drivedel($vmid, $deviceid);
3149            return undef;
3150         }
3151     }
3152
3153     if ($deviceid =~ m/^(scsihw)(\d+)$/) {
3154         my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : "lsi";
3155         my $pciaddr = print_pci_addr($deviceid);
3156         my $devicefull = "$scsihw,id=$deviceid$pciaddr";
3157         qemu_deviceadd($vmid, $devicefull);
3158         return undef if(!qemu_deviceaddverify($vmid, $deviceid));
3159     }
3160
3161     if ($deviceid =~ m/^(scsi)(\d+)$/) {
3162         return undef if !qemu_findorcreatescsihw($storecfg,$conf, $vmid, $device);
3163         return undef if !qemu_driveadd($storecfg, $vmid, $device);
3164         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
3165         if(!qemu_deviceadd($vmid, $devicefull)) {
3166            qemu_drivedel($vmid, $deviceid);
3167            return undef;
3168         }
3169     }
3170
3171     if ($deviceid =~ m/^(net)(\d+)$/) {
3172         return undef if !qemu_netdevadd($vmid, $conf, $device, $deviceid);
3173         my $netdevicefull = print_netdevice_full($vmid, $conf, $device, $deviceid);
3174         qemu_deviceadd($vmid, $netdevicefull);
3175         if(!qemu_deviceaddverify($vmid, $deviceid)) {
3176            qemu_netdevdel($vmid, $deviceid);
3177            return undef;
3178         }
3179     }
3180
3181
3182     if (!$q35 && $deviceid =~ m/^(pci\.)(\d+)$/) {
3183         my $bridgeid = $2;
3184         my $pciaddr = print_pci_addr($deviceid);
3185         my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
3186         qemu_deviceadd($vmid, $devicefull);
3187         return undef if !qemu_deviceaddverify($vmid, $deviceid);
3188     }
3189
3190     return 1;
3191 }
3192
3193 sub vm_deviceunplug {
3194     my ($vmid, $conf, $deviceid) = @_;
3195
3196     return 1 if !check_running ($vmid);
3197
3198     return 1 if !$conf->{hotplug};
3199
3200     my $devices_list = vm_devices_list($vmid);
3201     return 1 if !defined($devices_list->{$deviceid});
3202
3203     if ($deviceid eq 'tablet') {
3204         qemu_devicedel($vmid, $deviceid);
3205         return 1;
3206     }
3207
3208     die "can't unplug bootdisk" if $conf->{bootdisk} && $conf->{bootdisk} eq $deviceid;
3209
3210     if ($deviceid =~ m/^(virtio)(\d+)$/) {
3211         qemu_devicedel($vmid, $deviceid);
3212         return undef if !qemu_devicedelverify($vmid, $deviceid);
3213         return undef if !qemu_drivedel($vmid, $deviceid);
3214     }
3215
3216     if ($deviceid =~ m/^(lsi)(\d+)$/) {
3217         return undef if !qemu_devicedel($vmid, $deviceid);
3218     }
3219
3220     if ($deviceid =~ m/^(scsi)(\d+)$/) {
3221         return undef if !qemu_devicedel($vmid, $deviceid);
3222         return undef if !qemu_drivedel($vmid, $deviceid);
3223     }
3224
3225     if ($deviceid =~ m/^(net)(\d+)$/) {
3226         qemu_devicedel($vmid, $deviceid);
3227         return undef if !qemu_devicedelverify($vmid, $deviceid);
3228         return undef if !qemu_netdevdel($vmid, $deviceid);
3229     }
3230
3231     return 1;
3232 }
3233
3234 sub qemu_deviceadd {
3235     my ($vmid, $devicefull) = @_;
3236
3237     $devicefull = "driver=".$devicefull;
3238     my %options =  split(/[=,]/, $devicefull);
3239
3240     vm_mon_cmd($vmid, "device_add" , %options);
3241     return 1;
3242 }
3243
3244 sub qemu_devicedel {
3245     my($vmid, $deviceid) = @_;
3246     my $ret = vm_mon_cmd($vmid, "device_del", id => $deviceid);
3247     return 1;
3248 }
3249
3250 sub qemu_driveadd {
3251     my($storecfg, $vmid, $device) = @_;
3252
3253     my $drive = print_drive_full($storecfg, $vmid, $device);
3254     my $ret = vm_human_monitor_command($vmid, "drive_add auto $drive");
3255     # If the command succeeds qemu prints: "OK"
3256     if ($ret !~ m/OK/s) {
3257         syslog("err", "adding drive failed: $ret");
3258         return undef;
3259     }
3260     return 1;
3261 }
3262
3263 sub qemu_drivedel {
3264     my($vmid, $deviceid) = @_;
3265
3266     my $ret = vm_human_monitor_command($vmid, "drive_del drive-$deviceid");
3267     $ret =~ s/^\s+//;
3268     if ($ret =~ m/Device \'.*?\' not found/s) {
3269         # NB: device not found errors mean the drive was auto-deleted and we ignore the error
3270     }
3271     elsif ($ret ne "") {
3272       syslog("err", "deleting drive $deviceid failed : $ret");
3273       return undef;
3274     }
3275     return 1;
3276 }
3277
3278 sub qemu_deviceaddverify {
3279     my ($vmid,$deviceid) = @_;
3280
3281     for (my $i = 0; $i <= 5; $i++) {
3282          my $devices_list = vm_devices_list($vmid);
3283          return 1 if defined($devices_list->{$deviceid});
3284          sleep 1;
3285     }
3286     syslog("err", "error on hotplug device $deviceid");
3287     return undef;
3288 }
3289
3290
3291 sub qemu_devicedelverify {
3292     my ($vmid,$deviceid) = @_;
3293
3294     #need to verify the device is correctly remove as device_del is async and empty return is not reliable
3295     for (my $i = 0; $i <= 5; $i++) {
3296          my $devices_list = vm_devices_list($vmid);
3297          return 1 if !defined($devices_list->{$deviceid});
3298          sleep 1;
3299     }
3300     syslog("err", "error on hot-unplugging device $deviceid");
3301     return undef;
3302 }
3303
3304 sub qemu_findorcreatescsihw {
3305     my ($storecfg, $conf, $vmid, $device) = @_;
3306
3307     my $maxdev = ($conf->{scsihw} && ($conf->{scsihw} !~ m/^lsi/)) ? 256 : 7;
3308     my $controller = int($device->{index} / $maxdev);
3309     my $scsihwid="scsihw$controller";
3310     my $devices_list = vm_devices_list($vmid);
3311
3312     if(!defined($devices_list->{$scsihwid})) {
3313        return undef if !vm_deviceplug($storecfg, $conf, $vmid, $scsihwid);
3314     }
3315     return 1;
3316 }
3317
3318 sub qemu_bridgeadd {
3319     my ($storecfg, $conf, $vmid, $device) = @_;
3320
3321     my $bridges = {};
3322     my $bridgeid = undef;
3323     print_pci_addr($device, $bridges);
3324
3325     while (my ($k, $v) = each %$bridges) {
3326         $bridgeid = $k;
3327     }
3328     return if !$bridgeid || $bridgeid < 1;
3329     my $bridge = "pci.$bridgeid";
3330     my $devices_list = vm_devices_list($vmid);
3331
3332     if(!defined($devices_list->{$bridge})) {
3333         return undef if !vm_deviceplug($storecfg, $conf, $vmid, $bridge);
3334     }
3335     return 1;
3336 }
3337
3338 sub qemu_netdevadd {
3339     my ($vmid, $conf, $device, $deviceid) = @_;
3340
3341     my $netdev = print_netdev_full($vmid, $conf, $device, $deviceid);
3342     my %options =  split(/[=,]/, $netdev);
3343
3344     vm_mon_cmd($vmid, "netdev_add",  %options);
3345     return 1;
3346 }
3347
3348 sub qemu_netdevdel {
3349     my ($vmid, $deviceid) = @_;
3350
3351     vm_mon_cmd($vmid, "netdev_del", id => $deviceid);
3352     return 1;
3353 }
3354
3355 sub qemu_cpu_hotplug {
3356     my ($vmid, $conf, $cores) = @_;
3357
3358     die "new cores config is not defined" if !$cores;
3359     die "you can't add more cores than maxcpus"
3360         if $conf->{maxcpus} && ($cores > $conf->{maxcpus});
3361     return if !check_running($vmid);
3362
3363     my $currentcores = $conf->{cores} if $conf->{cores};
3364     die "current cores is not defined" if !$currentcores;
3365     die "maxcpus is not defined" if !$conf->{maxcpus};
3366     raise_param_exc({ 'cores' => "online cpu unplug is not yet possible" })
3367         if($cores < $currentcores);
3368
3369     my $currentrunningcores = vm_mon_cmd($vmid, "query-cpus");
3370     raise_param_exc({ 'cores' => "cores number if running vm is different than configuration" })
3371         if scalar (@{$currentrunningcores}) != $currentcores;
3372
3373     for(my $i = $currentcores; $i < $cores; $i++) {
3374         vm_mon_cmd($vmid, "cpu-add", id => int($i));
3375     }
3376 }
3377
3378 sub qemu_block_set_io_throttle {
3379     my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
3380
3381     return if !check_running($vmid) ;
3382
3383     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));
3384
3385 }
3386
3387 # old code, only used to shutdown old VM after update
3388 sub __read_avail {
3389     my ($fh, $timeout) = @_;
3390
3391     my $sel = new IO::Select;
3392     $sel->add($fh);
3393
3394     my $res = '';
3395     my $buf;
3396
3397     my @ready;
3398     while (scalar (@ready = $sel->can_read($timeout))) {
3399         my $count;
3400         if ($count = $fh->sysread($buf, 8192)) {
3401             if ($buf =~ /^(.*)\(qemu\) $/s) {
3402                 $res .= $1;
3403                 last;
3404             } else {
3405                 $res .= $buf;
3406             }
3407         } else {
3408             if (!defined($count)) {
3409                 die "$!\n";
3410             }
3411             last;
3412         }
3413     }
3414
3415     die "monitor read timeout\n" if !scalar(@ready);
3416
3417     return $res;
3418 }
3419
3420 # old code, only used to shutdown old VM after update
3421 sub vm_monitor_command {
3422     my ($vmid, $cmdstr, $nocheck) = @_;
3423
3424     my $res;
3425
3426     eval {
3427         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
3428
3429         my $sname = "${var_run_tmpdir}/$vmid.mon";
3430
3431         my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
3432             die "unable to connect to VM $vmid socket - $!\n";
3433
3434         my $timeout = 3;
3435
3436         # hack: migrate sometime blocks the monitor (when migrate_downtime
3437         # is set)
3438         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3439             $timeout = 60*60; # 1 hour
3440         }
3441
3442         # read banner;
3443         my $data = __read_avail($sock, $timeout);
3444
3445         if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
3446             die "got unexpected qemu monitor banner\n";
3447         }
3448
3449         my $sel = new IO::Select;
3450         $sel->add($sock);
3451
3452         if (!scalar(my @ready = $sel->can_write($timeout))) {
3453             die "monitor write error - timeout";
3454         }
3455
3456         my $fullcmd = "$cmdstr\r";
3457
3458         # syslog('info', "VM $vmid monitor command: $cmdstr");
3459
3460         my $b;
3461         if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
3462             die "monitor write error - $!";
3463         }
3464
3465         return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
3466
3467         $timeout = 20;
3468
3469         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3470             $timeout = 60*60; # 1 hour
3471         } elsif ($cmdstr =~ m/^(eject|change)/) {
3472             $timeout = 60; # note: cdrom mount command is slow
3473         }
3474         if ($res = __read_avail($sock, $timeout)) {
3475
3476             my @lines = split("\r?\n", $res);
3477
3478             shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
3479
3480             $res = join("\n", @lines);
3481             $res .= "\n";
3482         }
3483     };
3484
3485     my $err = $@;
3486
3487     if ($err) {
3488         syslog("err", "VM $vmid monitor command failed - $err");
3489         die $err;
3490     }
3491
3492     return $res;
3493 }
3494
3495 sub qemu_block_resize {
3496     my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
3497
3498     my $running = check_running($vmid);
3499
3500     return if !PVE::Storage::volume_resize($storecfg, $volid, $size, $running);
3501
3502     return if !$running;
3503
3504     vm_mon_cmd($vmid, "block_resize", device => $deviceid, size => int($size));
3505
3506 }
3507
3508 sub qemu_volume_snapshot {
3509     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3510
3511     my $running = check_running($vmid);
3512
3513     return if !PVE::Storage::volume_snapshot($storecfg, $volid, $snap, $running);
3514
3515     return if !$running;
3516
3517     vm_mon_cmd($vmid, "snapshot-drive", device => $deviceid, name => $snap);
3518
3519 }
3520
3521 sub qemu_volume_snapshot_delete {
3522     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3523
3524     my $running = check_running($vmid);
3525
3526     return if !PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snap, $running);
3527
3528     return if !$running;
3529
3530     vm_mon_cmd($vmid, "delete-drive-snapshot", device => $deviceid, name => $snap);
3531 }
3532
3533 sub set_migration_caps {
3534     my ($vmid) = @_;
3535
3536     my $cap_ref = [];
3537
3538     my $enabled_cap = {
3539         "auto-converge" => 1,
3540         "xbzrle" => 0,
3541         "x-rdma-pin-all" => 0,
3542         "zero-blocks" => 0,
3543     };
3544
3545     my $supported_capabilities = vm_mon_cmd_nocheck($vmid, "query-migrate-capabilities");
3546
3547     for my $supported_capability (@$supported_capabilities) {
3548         push @$cap_ref, {
3549             capability => $supported_capability->{capability},
3550             state => $enabled_cap->{$supported_capability->{capability}} ? JSON::true : JSON::false,
3551         };
3552     }
3553
3554     vm_mon_cmd_nocheck($vmid, "migrate-set-capabilities", capabilities => $cap_ref);
3555 }
3556
3557 sub vmconfig_hotplug_pending {
3558     my ($vmid, $conf, $storecfg) = @_;
3559
3560     my $defaults = PVE::QemuServer::load_defaults();
3561
3562     # commit values which do not have any impact on running VM first
3563
3564     my $changes = 0;
3565     foreach my $opt (keys %{$conf->{pending}}) { # add/change
3566         if ($opt eq 'name' || $opt eq 'hotplug' || $opt eq 'onboot' || $opt eq 'shares') {
3567             $conf->{$opt} = $conf->{pending}->{$opt};
3568             delete $conf->{pending}->{$opt};
3569             $changes = 1;
3570         }
3571     }
3572
3573     if ($changes) {
3574         update_config_nolock($vmid, $conf, 1);
3575         $conf = load_config($vmid); # update/reload
3576     }
3577
3578     $changes = 0;
3579
3580     # allow manual ballooning if shares is set to zero
3581
3582     if (defined($conf->{pending}->{balloon}) && defined($conf->{shares}) && ($conf->{shares} == 0)) {
3583         my $balloon = $conf->{pending}->{balloon} || $conf->{memory} || $defaults->{memory};
3584         vm_mon_cmd($vmid, "balloon", value => $balloon*1024*1024);
3585         $conf->{balloon} = $conf->{pending}->{balloon};
3586         delete $conf->{pending}->{balloon};
3587         $changes = 1;
3588     }
3589
3590     if ($changes) {
3591         update_config_nolock($vmid, $conf, 1);
3592         $conf = load_config($vmid); # update/reload
3593     }
3594
3595     return if !$conf->{hotplug};
3596
3597     my @delete = PVE::Tools::split_list($conf->{pending}->{delete});
3598     foreach my $opt (@delete) {
3599         if ($opt eq 'tablet') {
3600             if ($defaults->{tablet}) {
3601                 PVE::QemuServer::vm_deviceplug($storecfg, $conf, $vmid, $opt);
3602             } else {
3603                 PVE::QemuServer::vm_deviceunplug($vmid, $conf, $opt);
3604             }
3605         } else {
3606             # skip non-hot-pluggable options
3607             next;
3608         }
3609
3610         # save new config if hotplug was successful
3611         delete $conf->{$opt};
3612         vmconfig_undelete_pending_option($conf, $opt);
3613         update_config_nolock($vmid, $conf, 1);
3614
3615         $conf = load_config($vmid); # update/reload
3616     }
3617
3618     foreach my $opt (keys %{$conf->{pending}}) {
3619         my $value = $conf->{pending}->{$opt};
3620
3621         if ($opt eq 'tablet') {
3622             if ($value == 1) {
3623                 PVE::QemuServer::vm_deviceplug($storecfg, $conf, $vmid, $opt);
3624             } elsif ($value == 0) {
3625                 PVE::QemuServer::vm_deviceunplug($vmid, $conf, $opt);
3626             }
3627         } else {
3628             # skip non-hot-pluggable options
3629             next;
3630         }
3631
3632         # save new config if hotplug was successful
3633         $conf->{$opt} = $value;
3634         delete $conf->{pending}->{$opt};
3635         update_config_nolock($vmid, $conf, 1);
3636
3637         $conf = load_config($vmid); # update/reload
3638     }
3639 }
3640
3641 sub vmconfig_apply_pending {
3642     my ($vmid, $conf, $storecfg, $running) = @_;
3643
3644     return vmconfig_hotplug_pending($vmid, $conf, $storecfg) if $running;
3645
3646     # cold plug
3647
3648     my @delete = PVE::Tools::split_list($conf->{pending}->{delete});
3649     foreach my $opt (@delete) { # delete
3650         die "internal error" if $opt =~ m/^unused/;
3651         $conf = load_config($vmid); # update/reload
3652         if (!defined($conf->{$opt})) {
3653             vmconfig_undelete_pending_option($conf, $opt);
3654             update_config_nolock($vmid, $conf, 1);
3655         } elsif (valid_drivename($opt)) {
3656             vmconfig_register_unused_drive($storecfg, $vmid, $conf, parse_drive($opt, $conf->{$opt}));
3657             vmconfig_undelete_pending_option($conf, $opt);
3658             delete $conf->{$opt};
3659             update_config_nolock($vmid, $conf, 1);
3660         } else {
3661             vmconfig_undelete_pending_option($conf, $opt);
3662             delete $conf->{$opt};
3663             update_config_nolock($vmid, $conf, 1);
3664         }
3665     }
3666
3667     $conf = load_config($vmid); # update/reload
3668
3669     foreach my $opt (keys %{$conf->{pending}}) { # add/change
3670         $conf = load_config($vmid); # update/reload
3671
3672         if (defined($conf->{$opt}) && ($conf->{$opt} eq $conf->{pending}->{$opt})) {
3673             # skip if nothing changed
3674         } elsif (valid_drivename($opt)) {
3675             vmconfig_register_unused_drive($storecfg, $vmid, $conf, parse_drive($opt, $conf->{$opt}))
3676                 if defined($conf->{$opt});
3677             $conf->{$opt} = $conf->{pending}->{$opt};
3678         } else {
3679             $conf->{$opt} = $conf->{pending}->{$opt};
3680         }
3681
3682         delete $conf->{pending}->{$opt};
3683         update_config_nolock($vmid, $conf, 1);
3684     }
3685 }
3686
3687 sub vm_start {
3688     my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused, $forcemachine, $spice_ticket) = @_;
3689
3690     lock_config($vmid, sub {
3691         my $conf = load_config($vmid, $migratedfrom);
3692
3693         die "you can't start a vm if it's a template\n" if is_template($conf);
3694
3695         check_lock($conf) if !$skiplock;
3696
3697         die "VM $vmid already running\n" if check_running($vmid, undef, $migratedfrom);
3698
3699         if (!$statefile && scalar(keys %{$conf->{pending}})) {
3700             vmconfig_apply_pending($vmid, $conf, $storecfg, 0);
3701             $conf = load_config($vmid); # update/reload
3702         }
3703
3704         my $defaults = load_defaults();
3705
3706         # set environment variable useful inside network script
3707         $ENV{PVE_MIGRATED_FROM} = $migratedfrom if $migratedfrom;
3708
3709         my ($cmd, $vollist, $spice_port) = config_to_command($storecfg, $vmid, $conf, $defaults, $forcemachine);
3710
3711         my $migrate_port = 0;
3712         my $migrate_uri;
3713         if ($statefile) {
3714             if ($statefile eq 'tcp') {
3715                 my $localip = "localhost";
3716                 my $datacenterconf = PVE::Cluster::cfs_read_file('datacenter.cfg');
3717                 if ($datacenterconf->{migration_unsecure}) {
3718                         my $nodename = PVE::INotify::nodename();
3719                         $localip = PVE::Cluster::remote_node_ip($nodename, 1);
3720                 }
3721                 $migrate_port = PVE::Tools::next_migrate_port();
3722                 $migrate_uri = "tcp:${localip}:${migrate_port}";
3723                 push @$cmd, '-incoming', $migrate_uri;
3724                 push @$cmd, '-S';
3725             } else {
3726                 push @$cmd, '-loadstate', $statefile;
3727             }
3728         } elsif ($paused) {
3729             push @$cmd, '-S';
3730         }
3731
3732         # host pci devices
3733         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
3734           my $d = parse_hostpci($conf->{"hostpci$i"});
3735           next if !$d;
3736           my $pcidevices = $d->{pciid};
3737           foreach my $pcidevice (@$pcidevices) {
3738                 my $pciid = $pcidevice->{id}.".".$pcidevice->{function};
3739
3740                 my $info = pci_device_info("0000:$pciid");
3741                 die "IOMMU not present\n" if !check_iommu_support();
3742                 die "no pci device info for device '$pciid'\n" if !$info;
3743
3744                 if ($d->{driver} && $d->{driver} eq "vfio") {
3745                     die "can't unbind/bind pci group to vfio '$pciid'\n" if !pci_dev_group_bind_to_vfio($pciid);
3746                 } else {
3747                     die "can't unbind/bind to stub pci device '$pciid'\n" if !pci_dev_bind_to_stub($info);
3748                 }
3749
3750                 die "can't reset pci device '$pciid'\n" if $info->{has_fl_reset} and !pci_dev_reset($info);
3751           }
3752         }
3753
3754         PVE::Storage::activate_volumes($storecfg, $vollist);
3755
3756         eval  { run_command($cmd, timeout => $statefile ? undef : 30,
3757                     umask => 0077); };
3758         my $err = $@;
3759         die "start failed: $err" if $err;
3760
3761         print "migration listens on $migrate_uri\n" if $migrate_uri;
3762
3763         if ($statefile && $statefile ne 'tcp')  {
3764             eval { vm_mon_cmd_nocheck($vmid, "cont"); };
3765             warn $@ if $@;
3766         }
3767
3768         if ($migratedfrom) {
3769
3770             eval {
3771                 PVE::QemuServer::set_migration_caps($vmid);
3772             };
3773             warn $@ if $@;
3774
3775             if ($spice_port) {
3776                 print "spice listens on port $spice_port\n";
3777                 if ($spice_ticket) {
3778                     PVE::QemuServer::vm_mon_cmd_nocheck($vmid, "set_password", protocol => 'spice', password => $spice_ticket);
3779                     PVE::QemuServer::vm_mon_cmd_nocheck($vmid, "expire_password", protocol => 'spice', time => "+30");
3780                 }
3781             }
3782
3783         } else {
3784
3785             if (!$statefile && (!defined($conf->{balloon}) || $conf->{balloon})) {
3786                 vm_mon_cmd_nocheck($vmid, "balloon", value => $conf->{balloon}*1024*1024)
3787                     if $conf->{balloon};
3788                 vm_mon_cmd_nocheck($vmid, 'qom-set',
3789                             path => "machine/peripheral/balloon0",
3790                             property => "guest-stats-polling-interval",
3791                             value => 2);
3792             }
3793         }
3794     });
3795 }
3796
3797 sub vm_mon_cmd {
3798     my ($vmid, $execute, %params) = @_;
3799
3800     my $cmd = { execute => $execute, arguments => \%params };
3801     vm_qmp_command($vmid, $cmd);
3802 }
3803
3804 sub vm_mon_cmd_nocheck {
3805     my ($vmid, $execute, %params) = @_;
3806
3807     my $cmd = { execute => $execute, arguments => \%params };
3808     vm_qmp_command($vmid, $cmd, 1);
3809 }
3810
3811 sub vm_qmp_command {
3812     my ($vmid, $cmd, $nocheck) = @_;
3813
3814     my $res;
3815
3816     my $timeout;
3817     if ($cmd->{arguments} && $cmd->{arguments}->{timeout}) {
3818         $timeout = $cmd->{arguments}->{timeout};
3819         delete $cmd->{arguments}->{timeout};
3820     }
3821
3822     eval {
3823         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
3824         my $sname = qmp_socket($vmid);
3825         if (-e $sname) { # test if VM is reasonambe new and supports qmp/qga
3826             my $qmpclient = PVE::QMPClient->new();
3827
3828             $res = $qmpclient->cmd($vmid, $cmd, $timeout);
3829         } elsif (-e "${var_run_tmpdir}/$vmid.mon") {
3830             die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
3831                 if scalar(%{$cmd->{arguments}});
3832             vm_monitor_command($vmid, $cmd->{execute}, $nocheck);
3833         } else {
3834             die "unable to open monitor socket\n";
3835         }
3836     };
3837     if (my $err = $@) {
3838         syslog("err", "VM $vmid qmp command failed - $err");
3839         die $err;
3840     }
3841
3842     return $res;
3843 }
3844
3845 sub vm_human_monitor_command {
3846     my ($vmid, $cmdline) = @_;
3847
3848     my $res;
3849
3850     my $cmd = {
3851         execute => 'human-monitor-command',
3852         arguments => { 'command-line' => $cmdline},
3853     };
3854
3855     return vm_qmp_command($vmid, $cmd);
3856 }
3857
3858 sub vm_commandline {
3859     my ($storecfg, $vmid) = @_;
3860
3861     my $conf = load_config($vmid);
3862
3863     my $defaults = load_defaults();
3864
3865     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
3866
3867     return join(' ', @$cmd);
3868 }
3869
3870 sub vm_reset {
3871     my ($vmid, $skiplock) = @_;
3872
3873     lock_config($vmid, sub {
3874
3875         my $conf = load_config($vmid);
3876
3877         check_lock($conf) if !$skiplock;
3878
3879         vm_mon_cmd($vmid, "system_reset");
3880     });
3881 }
3882
3883 sub get_vm_volumes {
3884     my ($conf) = @_;
3885
3886     my $vollist = [];
3887     foreach_volid($conf, sub {
3888         my ($volid, $is_cdrom) = @_;
3889
3890         return if $volid =~ m|^/|;
3891
3892         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
3893         return if !$sid;
3894
3895         push @$vollist, $volid;
3896     });
3897
3898     return $vollist;
3899 }
3900
3901 sub vm_stop_cleanup {
3902     my ($storecfg, $vmid, $conf, $keepActive) = @_;
3903
3904     eval {
3905         fairsched_rmnod($vmid); # try to destroy group
3906
3907         if (!$keepActive) {
3908             my $vollist = get_vm_volumes($conf);
3909             PVE::Storage::deactivate_volumes($storecfg, $vollist);
3910         }
3911
3912         foreach my $ext (qw(mon qmp pid vnc qga)) {
3913             unlink "/var/run/qemu-server/${vmid}.$ext";
3914         }
3915     };
3916     warn $@ if $@; # avoid errors - just warn
3917 }
3918
3919 # Note: use $nockeck to skip tests if VM configuration file exists.
3920 # We need that when migration VMs to other nodes (files already moved)
3921 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3922 sub vm_stop {
3923     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3924
3925     $force = 1 if !defined($force) && !$shutdown;
3926
3927     if ($migratedfrom){
3928         my $pid = check_running($vmid, $nocheck, $migratedfrom);
3929         kill 15, $pid if $pid;
3930         my $conf = load_config($vmid, $migratedfrom);
3931         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive);
3932         return;
3933     }
3934
3935     lock_config($vmid, sub {
3936
3937         my $pid = check_running($vmid, $nocheck);
3938         return if !$pid;
3939
3940         my $conf;
3941         if (!$nocheck) {
3942             $conf = load_config($vmid);
3943             check_lock($conf) if !$skiplock;
3944             if (!defined($timeout) && $shutdown && $conf->{startup}) {
3945                 my $opts = parse_startup($conf->{startup});
3946                 $timeout = $opts->{down} if $opts->{down};
3947             }
3948         }
3949
3950         $timeout = 60 if !defined($timeout);
3951
3952         eval {
3953             if ($shutdown) {
3954                 if (!$nocheck && $conf->{agent}) {
3955                     vm_qmp_command($vmid, { execute => "guest-shutdown" }, $nocheck);
3956                 } else {
3957                     vm_qmp_command($vmid, { execute => "system_powerdown" }, $nocheck);
3958                 }
3959             } else {
3960                 vm_qmp_command($vmid, { execute => "quit" }, $nocheck);
3961             }
3962         };
3963         my $err = $@;
3964
3965         if (!$err) {
3966             my $count = 0;
3967             while (($count < $timeout) && check_running($vmid, $nocheck)) {
3968                 $count++;
3969                 sleep 1;
3970             }
3971
3972             if ($count >= $timeout) {
3973                 if ($force) {
3974                     warn "VM still running - terminating now with SIGTERM\n";
3975                     kill 15, $pid;
3976                 } else {
3977                     die "VM quit/powerdown failed - got timeout\n";
3978                 }
3979             } else {
3980                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3981                 return;
3982             }
3983         } else {
3984             if ($force) {
3985                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3986                 kill 15, $pid;
3987             } else {
3988                 die "VM quit/powerdown failed\n";
3989             }
3990         }
3991
3992         # wait again
3993         $timeout = 10;
3994
3995         my $count = 0;
3996         while (($count < $timeout) && check_running($vmid, $nocheck)) {
3997             $count++;
3998             sleep 1;
3999         }
4000
4001         if ($count >= $timeout) {
4002             warn "VM still running - terminating now with SIGKILL\n";
4003             kill 9, $pid;
4004             sleep 1;
4005         }
4006
4007         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
4008    });
4009 }
4010
4011 sub vm_suspend {
4012     my ($vmid, $skiplock) = @_;
4013
4014     lock_config($vmid, sub {
4015
4016         my $conf = load_config($vmid);
4017
4018         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
4019
4020         vm_mon_cmd($vmid, "stop");
4021     });
4022 }
4023
4024 sub vm_resume {
4025     my ($vmid, $skiplock) = @_;
4026
4027     lock_config($vmid, sub {
4028
4029         my $conf = load_config($vmid);
4030
4031         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
4032
4033         vm_mon_cmd($vmid, "cont");
4034     });
4035 }
4036
4037 sub vm_sendkey {
4038     my ($vmid, $skiplock, $key) = @_;
4039
4040     lock_config($vmid, sub {
4041
4042         my $conf = load_config($vmid);
4043
4044         # there is no qmp command, so we use the human monitor command
4045         vm_human_monitor_command($vmid, "sendkey $key");
4046     });
4047 }
4048
4049 sub vm_destroy {
4050     my ($storecfg, $vmid, $skiplock) = @_;
4051
4052     lock_config($vmid, sub {
4053
4054         my $conf = load_config($vmid);
4055
4056         check_lock($conf) if !$skiplock;
4057
4058         if (!check_running($vmid)) {
4059             fairsched_rmnod($vmid); # try to destroy group
4060             destroy_vm($storecfg, $vmid);
4061         } else {
4062             die "VM $vmid is running - destroy failed\n";
4063         }
4064     });
4065 }
4066
4067 # pci helpers
4068
4069 sub file_write {
4070     my ($filename, $buf) = @_;
4071
4072     my $fh = IO::File->new($filename, "w");
4073     return undef if !$fh;
4074
4075     my $res = print $fh $buf;
4076
4077     $fh->close();
4078
4079     return $res;
4080 }
4081
4082 sub pci_device_info {
4083     my ($name) = @_;
4084
4085     my $res;
4086
4087     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
4088     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
4089
4090     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
4091     return undef if !defined($irq) || $irq !~ m/^\d+$/;
4092
4093     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
4094     return undef if !defined($vendor) || $vendor !~ s/^0x//;
4095
4096     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
4097     return undef if !defined($product) || $product !~ s/^0x//;
4098
4099     $res = {
4100         name => $name,
4101         vendor => $vendor,
4102         product => $product,
4103         domain => $domain,
4104         bus => $bus,
4105         slot => $slot,
4106         func => $func,
4107         irq => $irq,
4108         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
4109     };
4110
4111     return $res;
4112 }
4113
4114 sub pci_dev_reset {
4115     my ($dev) = @_;
4116
4117     my $name = $dev->{name};
4118
4119     my $fn = "$pcisysfs/devices/$name/reset";
4120
4121     return file_write($fn, "1");
4122 }
4123
4124 sub pci_dev_bind_to_stub {
4125     my ($dev) = @_;
4126
4127     my $name = $dev->{name};
4128
4129     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
4130     return 1 if -d $testdir;
4131
4132     my $data = "$dev->{vendor} $dev->{product}";
4133     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
4134
4135     my $fn = "$pcisysfs/devices/$name/driver/unbind";
4136     if (!file_write($fn, $name)) {
4137         return undef if -f $fn;
4138     }
4139
4140     $fn = "$pcisysfs/drivers/pci-stub/bind";
4141     if (! -d $testdir) {
4142         return undef if !file_write($fn, $name);
4143     }
4144
4145     return -d $testdir;
4146 }
4147
4148 sub pci_dev_bind_to_vfio {
4149     my ($dev) = @_;
4150
4151     my $name = $dev->{name};
4152
4153     my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4154
4155     if (!-d $vfio_basedir) {
4156         system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4157     }
4158     die "Cannot find vfio-pci module!\n" if !-d $vfio_basedir;
4159
4160     my $testdir = "$vfio_basedir/$name";
4161     return 1 if -d $testdir;
4162
4163     my $data = "$dev->{vendor} $dev->{product}";
4164     return undef if !file_write("$vfio_basedir/new_id", $data);
4165
4166     my $fn = "$pcisysfs/devices/$name/driver/unbind";
4167     if (!file_write($fn, $name)) {
4168         return undef if -f $fn;
4169     }
4170
4171     $fn = "$vfio_basedir/bind";
4172     if (! -d $testdir) {
4173         return undef if !file_write($fn, $name);
4174     }
4175
4176     return -d $testdir;
4177 }
4178
4179 sub pci_dev_group_bind_to_vfio {
4180     my ($pciid) = @_;
4181
4182     my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4183
4184     if (!-d $vfio_basedir) {
4185         system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4186     }
4187     die "Cannot find vfio-pci module!\n" if !-d $vfio_basedir;
4188
4189     # get IOMMU group devices
4190     opendir(my $D, "$pcisysfs/devices/0000:$pciid/iommu_group/devices/") || die "Cannot open iommu_group: $!\n";
4191       my @devs = grep /^0000:/, readdir($D);
4192     closedir($D);
4193
4194     foreach my $pciid (@devs) {
4195         $pciid =~ m/^([:\.\da-f]+)$/ or die "PCI ID $pciid not valid!\n";
4196         my $info = pci_device_info($1);
4197         pci_dev_bind_to_vfio($info) || die "Cannot bind $pciid to vfio\n";
4198     }
4199
4200     return 1;
4201 }
4202
4203 sub print_pci_addr {
4204     my ($id, $bridges) = @_;
4205
4206     my $res = '';
4207     my $devices = {
4208         piix3 => { bus => 0, addr => 1 },
4209         #addr2 : first videocard
4210         balloon0 => { bus => 0, addr => 3 },
4211         watchdog => { bus => 0, addr => 4 },
4212         scsihw0 => { bus => 0, addr => 5 },
4213         scsihw1 => { bus => 0, addr => 6 },
4214         ahci0 => { bus => 0, addr => 7 },
4215         qga0 => { bus => 0, addr => 8 },
4216         spice => { bus => 0, addr => 9 },
4217         virtio0 => { bus => 0, addr => 10 },
4218         virtio1 => { bus => 0, addr => 11 },
4219         virtio2 => { bus => 0, addr => 12 },
4220         virtio3 => { bus => 0, addr => 13 },
4221         virtio4 => { bus => 0, addr => 14 },
4222         virtio5 => { bus => 0, addr => 15 },
4223         hostpci0 => { bus => 0, addr => 16 },
4224         hostpci1 => { bus => 0, addr => 17 },
4225         net0 => { bus => 0, addr => 18 },
4226         net1 => { bus => 0, addr => 19 },
4227         net2 => { bus => 0, addr => 20 },
4228         net3 => { bus => 0, addr => 21 },
4229         net4 => { bus => 0, addr => 22 },
4230         net5 => { bus => 0, addr => 23 },
4231         vga1 => { bus => 0, addr => 24 },
4232         vga2 => { bus => 0, addr => 25 },
4233         vga3 => { bus => 0, addr => 26 },
4234         hostpci2 => { bus => 0, addr => 27 },
4235         hostpci3 => { bus => 0, addr => 28 },
4236         #addr29 : usb-host (pve-usb.cfg)
4237         'pci.1' => { bus => 0, addr => 30 },
4238         'pci.2' => { bus => 0, addr => 31 },
4239         'net6' => { bus => 1, addr => 1 },
4240         'net7' => { bus => 1, addr => 2 },
4241         'net8' => { bus => 1, addr => 3 },
4242         'net9' => { bus => 1, addr => 4 },
4243         'net10' => { bus => 1, addr => 5 },
4244         'net11' => { bus => 1, addr => 6 },
4245         'net12' => { bus => 1, addr => 7 },
4246         'net13' => { bus => 1, addr => 8 },
4247         'net14' => { bus => 1, addr => 9 },
4248         'net15' => { bus => 1, addr => 10 },
4249         'net16' => { bus => 1, addr => 11 },
4250         'net17' => { bus => 1, addr => 12 },
4251         'net18' => { bus => 1, addr => 13 },
4252         'net19' => { bus => 1, addr => 14 },
4253         'net20' => { bus => 1, addr => 15 },
4254         'net21' => { bus => 1, addr => 16 },
4255         'net22' => { bus => 1, addr => 17 },
4256         'net23' => { bus => 1, addr => 18 },
4257         'net24' => { bus => 1, addr => 19 },
4258         'net25' => { bus => 1, addr => 20 },
4259         'net26' => { bus => 1, addr => 21 },
4260         'net27' => { bus => 1, addr => 22 },
4261         'net28' => { bus => 1, addr => 23 },
4262         'net29' => { bus => 1, addr => 24 },
4263         'net30' => { bus => 1, addr => 25 },
4264         'net31' => { bus => 1, addr => 26 },
4265         'virtio6' => { bus => 2, addr => 1 },
4266         'virtio7' => { bus => 2, addr => 2 },
4267         'virtio8' => { bus => 2, addr => 3 },
4268         'virtio9' => { bus => 2, addr => 4 },
4269         'virtio10' => { bus => 2, addr => 5 },
4270         'virtio11' => { bus => 2, addr => 6 },
4271         'virtio12' => { bus => 2, addr => 7 },
4272         'virtio13' => { bus => 2, addr => 8 },
4273         'virtio14' => { bus => 2, addr => 9 },
4274         'virtio15' => { bus => 2, addr => 10 },
4275     };
4276
4277     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
4278            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
4279            my $bus = $devices->{$id}->{bus};
4280            $res = ",bus=pci.$bus,addr=$addr";
4281            $bridges->{$bus} = 1 if $bridges;
4282     }
4283     return $res;
4284
4285 }
4286
4287 sub print_pcie_addr {
4288     my ($id) = @_;
4289
4290     my $res = '';
4291     my $devices = {
4292         hostpci0 => { bus => "ich9-pcie-port-1", addr => 0 },
4293         hostpci1 => { bus => "ich9-pcie-port-2", addr => 0 },
4294         hostpci2 => { bus => "ich9-pcie-port-3", addr => 0 },
4295         hostpci3 => { bus => "ich9-pcie-port-4", addr => 0 },
4296     };
4297
4298     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
4299            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
4300            my $bus = $devices->{$id}->{bus};
4301            $res = ",bus=$bus,addr=$addr";
4302     }
4303     return $res;
4304
4305 }
4306
4307 # vzdump restore implementaion
4308
4309 sub tar_archive_read_firstfile {
4310     my $archive = shift;
4311
4312     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
4313
4314     # try to detect archive type first
4315     my $pid = open (TMP, "tar tf '$archive'|") ||
4316         die "unable to open file '$archive'\n";
4317     my $firstfile = <TMP>;
4318     kill 15, $pid;
4319     close TMP;
4320
4321     die "ERROR: archive contaions no data\n" if !$firstfile;
4322     chomp $firstfile;
4323
4324     return $firstfile;
4325 }
4326
4327 sub tar_restore_cleanup {
4328     my ($storecfg, $statfile) = @_;
4329
4330     print STDERR "starting cleanup\n";
4331
4332     if (my $fd = IO::File->new($statfile, "r")) {
4333         while (defined(my $line = <$fd>)) {
4334             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4335                 my $volid = $2;
4336                 eval {
4337                     if ($volid =~ m|^/|) {
4338                         unlink $volid || die 'unlink failed\n';
4339                     } else {
4340                         PVE::Storage::vdisk_free($storecfg, $volid);
4341                     }
4342                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
4343                 };
4344                 print STDERR "unable to cleanup '$volid' - $@" if $@;
4345             } else {
4346                 print STDERR "unable to parse line in statfile - $line";
4347             }
4348         }
4349         $fd->close();
4350     }
4351 }
4352
4353 sub restore_archive {
4354     my ($archive, $vmid, $user, $opts) = @_;
4355
4356     my $format = $opts->{format};
4357     my $comp;
4358
4359     if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
4360         $format = 'tar' if !$format;
4361         $comp = 'gzip';
4362     } elsif ($archive =~ m/\.tar$/) {
4363         $format = 'tar' if !$format;
4364     } elsif ($archive =~ m/.tar.lzo$/) {
4365         $format = 'tar' if !$format;
4366         $comp = 'lzop';
4367     } elsif ($archive =~ m/\.vma$/) {
4368         $format = 'vma' if !$format;
4369     } elsif ($archive =~ m/\.vma\.gz$/) {
4370         $format = 'vma' if !$format;
4371         $comp = 'gzip';
4372     } elsif ($archive =~ m/\.vma\.lzo$/) {
4373         $format = 'vma' if !$format;
4374         $comp = 'lzop';
4375     } else {
4376         $format = 'vma' if !$format; # default
4377     }
4378
4379     # try to detect archive format
4380     if ($format eq 'tar') {
4381         return restore_tar_archive($archive, $vmid, $user, $opts);
4382     } else {
4383         return restore_vma_archive($archive, $vmid, $user, $opts, $comp);
4384     }
4385 }
4386
4387 sub restore_update_config_line {
4388     my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
4389
4390     return if $line =~ m/^\#qmdump\#/;
4391     return if $line =~ m/^\#vzdump\#/;
4392     return if $line =~ m/^lock:/;
4393     return if $line =~ m/^unused\d+:/;
4394     return if $line =~ m/^parent:/;
4395     return if $line =~ m/^template:/; # restored VM is never a template
4396
4397     if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
4398         # try to convert old 1.X settings
4399         my ($id, $ind, $ethcfg) = ($1, $2, $3);
4400         foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
4401             my ($model, $macaddr) = split(/\=/, $devconfig);
4402             $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $unique;
4403             my $net = {
4404                 model => $model,
4405                 bridge => "vmbr$ind",
4406                 macaddr => $macaddr,
4407             };
4408             my $netstr = print_net($net);
4409
4410             print $outfd "net$cookie->{netcount}: $netstr\n";
4411             $cookie->{netcount}++;
4412         }
4413     } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
4414         my ($id, $netstr) = ($1, $2);
4415         my $net = parse_net($netstr);
4416         $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
4417         $netstr = print_net($net);
4418         print $outfd "$id: $netstr\n";
4419     } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
4420         my $virtdev = $1;
4421         my $value = $3;
4422         if ($line =~ m/backup=no/) {
4423             print $outfd "#$line";
4424         } elsif ($virtdev && $map->{$virtdev}) {
4425             my $di = parse_drive($virtdev, $value);
4426             delete $di->{format}; # format can change on restore
4427             $di->{file} = $map->{$virtdev};
4428             $value = print_drive($vmid, $di);
4429             print $outfd "$virtdev: $value\n";
4430         } else {
4431             print $outfd $line;
4432         }
4433     } else {
4434         print $outfd $line;
4435     }
4436 }
4437
4438 sub scan_volids {
4439     my ($cfg, $vmid) = @_;
4440
4441     my $info = PVE::Storage::vdisk_list($cfg, undef, $vmid);
4442
4443     my $volid_hash = {};
4444     foreach my $storeid (keys %$info) {
4445         foreach my $item (@{$info->{$storeid}}) {
4446             next if !($item->{volid} && $item->{size});
4447             $item->{path} = PVE::Storage::path($cfg, $item->{volid});
4448             $volid_hash->{$item->{volid}} = $item;
4449         }
4450     }
4451
4452     return $volid_hash;
4453 }
4454
4455 sub get_used_paths {
4456     my ($vmid, $storecfg, $conf, $scan_snapshots, $skip_drive) = @_;
4457
4458     my $used_path = {};
4459
4460     my $scan_config = sub {
4461         my ($cref, $snapname) = @_;
4462
4463         foreach my $key (keys %$cref) {
4464             my $value = $cref->{$key};
4465             if (valid_drivename($key)) {
4466                 next if $skip_drive && $key eq $skip_drive;
4467                 my $drive = parse_drive($key, $value);
4468                 next if !$drive || !$drive->{file} || drive_is_cdrom($drive);
4469                 if ($drive->{file} =~ m!^/!) {
4470                     $used_path->{$drive->{file}}++; # = 1;
4471                 } else {
4472                     my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file}, 1);
4473                     next if !$storeid;
4474                     my $scfg = PVE::Storage::storage_config($storecfg, $storeid, 1);
4475                     next if !$scfg;
4476                     my $path = PVE::Storage::path($storecfg, $drive->{file}, $snapname);
4477                     $used_path->{$path}++; # = 1;
4478                 }
4479             }
4480         }
4481     };
4482
4483     &$scan_config($conf);
4484
4485     undef $skip_drive;
4486
4487     if ($scan_snapshots) {
4488         foreach my $snapname (keys %{$conf->{snapshots}}) {
4489             &$scan_config($conf->{snapshots}->{$snapname}, $snapname);
4490         }
4491     }
4492
4493     return $used_path;
4494 }
4495
4496 sub update_disksize {
4497     my ($vmid, $conf, $volid_hash) = @_;
4498
4499     my $changes;
4500
4501     my $used = {};
4502
4503     # Note: it is allowed to define multiple storages with same path (alias), so
4504     # we need to check both 'volid' and real 'path' (two different volid can point
4505     # to the same path).
4506
4507     my $usedpath = {};
4508
4509     # update size info
4510     foreach my $opt (keys %$conf) {
4511         if (valid_drivename($opt)) {
4512             my $drive = parse_drive($opt, $conf->{$opt});
4513             my $volid = $drive->{file};
4514             next if !$volid;
4515
4516             $used->{$volid} = 1;
4517             if ($volid_hash->{$volid} &&
4518                 (my $path = $volid_hash->{$volid}->{path})) {
4519                 $usedpath->{$path} = 1;
4520             }
4521
4522             next if drive_is_cdrom($drive);
4523             next if !$volid_hash->{$volid};
4524
4525             $drive->{size} = $volid_hash->{$volid}->{size};
4526             my $new = print_drive($vmid, $drive);
4527             if ($new ne $conf->{$opt}) {
4528                 $changes = 1;
4529                 $conf->{$opt} = $new;
4530             }
4531         }
4532     }
4533
4534     # remove 'unusedX' entry if volume is used
4535     foreach my $opt (keys %$conf) {
4536         next if $opt !~ m/^unused\d+$/;
4537         my $volid = $conf->{$opt};
4538         my $path = $volid_hash->{$volid}->{path} if $volid_hash->{$volid};
4539         if ($used->{$volid} || ($path && $usedpath->{$path})) {
4540             $changes = 1;
4541             delete $conf->{$opt};
4542         }
4543     }
4544
4545     foreach my $volid (sort keys %$volid_hash) {
4546         next if $volid =~ m/vm-$vmid-state-/;
4547         next if $used->{$volid};
4548         my $path = $volid_hash->{$volid}->{path};
4549         next if !$path; # just to be sure
4550         next if $usedpath->{$path};
4551         $changes = 1;
4552         add_unused_volume($conf, $volid);
4553         $usedpath->{$path} = 1; # avoid to add more than once (aliases)
4554     }
4555
4556     return $changes;
4557 }
4558
4559 sub rescan {
4560     my ($vmid, $nolock) = @_;
4561
4562     my $cfg = PVE::Cluster::cfs_read_file("storage.cfg");
4563
4564     my $volid_hash = scan_volids($cfg, $vmid);
4565
4566     my $updatefn =  sub {
4567         my ($vmid) = @_;
4568
4569         my $conf = load_config($vmid);
4570
4571         check_lock($conf);
4572
4573         my $vm_volids = {};
4574         foreach my $volid (keys %$volid_hash) {
4575             my $info = $volid_hash->{$volid};
4576             $vm_volids->{$volid} = $info if $info->{vmid} && $info->{vmid} == $vmid;
4577         }
4578
4579         my $changes = update_disksize($vmid, $conf, $vm_volids);
4580
4581         update_config_nolock($vmid, $conf, 1) if $changes;
4582     };
4583
4584     if (defined($vmid)) {
4585         if ($nolock) {
4586             &$updatefn($vmid);
4587         } else {
4588             lock_config($vmid, $updatefn, $vmid);
4589         }
4590     } else {
4591         my $vmlist = config_list();
4592         foreach my $vmid (keys %$vmlist) {
4593             if ($nolock) {
4594                 &$updatefn($vmid);
4595             } else {
4596                 lock_config($vmid, $updatefn, $vmid);
4597             }
4598         }
4599     }
4600 }
4601
4602 sub restore_vma_archive {
4603     my ($archive, $vmid, $user, $opts, $comp) = @_;
4604
4605     my $input = $archive eq '-' ? "<&STDIN" : undef;
4606     my $readfrom = $archive;
4607
4608     my $uncomp = '';
4609     if ($comp) {
4610         $readfrom = '-';
4611         my $qarchive = PVE::Tools::shellquote($archive);
4612         if ($comp eq 'gzip') {
4613             $uncomp = "zcat $qarchive|";
4614         } elsif ($comp eq 'lzop') {
4615             $uncomp = "lzop -d -c $qarchive|";
4616         } else {
4617             die "unknown compression method '$comp'\n";
4618         }
4619
4620     }
4621
4622     my $tmpdir = "/var/tmp/vzdumptmp$$";
4623     rmtree $tmpdir;
4624
4625     # disable interrupts (always do cleanups)
4626     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
4627         warn "got interrupt - ignored\n";
4628     };
4629
4630     my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
4631     POSIX::mkfifo($mapfifo, 0600);
4632     my $fifofh;
4633
4634     my $openfifo = sub {
4635         open($fifofh, '>', $mapfifo) || die $!;
4636     };
4637
4638     my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
4639
4640     my $oldtimeout;
4641     my $timeout = 5;
4642
4643     my $devinfo = {};
4644
4645     my $rpcenv = PVE::RPCEnvironment::get();
4646
4647     my $conffile = config_file($vmid);
4648     my $tmpfn = "$conffile.$$.tmp";
4649
4650     # Note: $oldconf is undef if VM does not exists
4651     my $oldconf = PVE::Cluster::cfs_read_file(cfs_config_path($vmid));
4652
4653     my $print_devmap = sub {
4654         my $virtdev_hash = {};
4655
4656         my $cfgfn = "$tmpdir/qemu-server.conf";
4657
4658         # we can read the config - that is already extracted
4659         my $fh = IO::File->new($cfgfn, "r") ||
4660             "unable to read qemu-server.conf - $!\n";
4661
4662         while (defined(my $line = <$fh>)) {
4663             if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
4664                 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
4665                 die "archive does not contain data for drive '$virtdev'\n"
4666                     if !$devinfo->{$devname};
4667                 if (defined($opts->{storage})) {
4668                     $storeid = $opts->{storage} || 'local';
4669                 } elsif (!$storeid) {
4670                     $storeid = 'local';
4671                 }
4672                 $format = 'raw' if !$format;
4673                 $devinfo->{$devname}->{devname} = $devname;
4674                 $devinfo->{$devname}->{virtdev} = $virtdev;
4675                 $devinfo->{$devname}->{format} = $format;
4676                 $devinfo->{$devname}->{storeid} = $storeid;
4677
4678                 # check permission on storage
4679                 my $pool = $opts->{pool}; # todo: do we need that?
4680                 if ($user ne 'root@pam') {
4681                     $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
4682                 }
4683
4684                 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
4685             }
4686         }
4687
4688         foreach my $devname (keys %$devinfo) {
4689             die "found no device mapping information for device '$devname'\n"
4690                 if !$devinfo->{$devname}->{virtdev};
4691         }
4692
4693         my $cfg = cfs_read_file('storage.cfg');
4694
4695         # create empty/temp config
4696         if ($oldconf) {
4697             PVE::Tools::file_set_contents($conffile, "memory: 128\n");
4698             foreach_drive($oldconf, sub {
4699                 my ($ds, $drive) = @_;
4700
4701                 return if drive_is_cdrom($drive);
4702
4703                 my $volid = $drive->{file};
4704
4705                 return if !$volid || $volid =~ m|^/|;
4706
4707                 my ($path, $owner) = PVE::Storage::path($cfg, $volid);
4708                 return if !$path || !$owner || ($owner != $vmid);
4709
4710                 # Note: only delete disk we want to restore
4711                 # other volumes will become unused
4712                 if ($virtdev_hash->{$ds}) {
4713                     PVE::Storage::vdisk_free($cfg, $volid);
4714                 }
4715             });
4716         }
4717
4718         my $map = {};
4719         foreach my $virtdev (sort keys %$virtdev_hash) {
4720             my $d = $virtdev_hash->{$virtdev};
4721             my $alloc_size = int(($d->{size} + 1024 - 1)/1024);
4722             my $scfg = PVE::Storage::storage_config($cfg, $d->{storeid});
4723
4724             # test if requested format is supported
4725             my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($cfg, $d->{storeid});
4726             my $supported = grep { $_ eq $d->{format} } @$validFormats;
4727             $d->{format} = $defFormat if !$supported;
4728
4729             my $volid = PVE::Storage::vdisk_alloc($cfg, $d->{storeid}, $vmid,
4730                                                   $d->{format}, undef, $alloc_size);
4731             print STDERR "new volume ID is '$volid'\n";
4732             $d->{volid} = $volid;
4733             my $path = PVE::Storage::path($cfg, $volid);
4734
4735             my $write_zeros = 1;
4736             # fixme: what other storages types initialize volumes with zero?
4737             if ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs' || $scfg->{type} eq 'glusterfs' ||
4738                 $scfg->{type} eq 'sheepdog' || $scfg->{type} eq 'rbd') {
4739                 $write_zeros = 0;
4740             }
4741
4742             print $fifofh "${write_zeros}:$d->{devname}=$path\n";
4743
4744             print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
4745             $map->{$virtdev} = $volid;
4746         }
4747
4748         $fh->seek(0, 0) || die "seek failed - $!\n";
4749
4750         my $outfd = new IO::File ($tmpfn, "w") ||
4751             die "unable to write config for VM $vmid\n";
4752
4753         my $cookie = { netcount => 0 };
4754         while (defined(my $line = <$fh>)) {
4755             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
4756         }
4757
4758         $fh->close();
4759         $outfd->close();
4760     };
4761
4762     eval {
4763         # enable interrupts
4764         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
4765             die "interrupted by signal\n";
4766         };
4767         local $SIG{ALRM} = sub { die "got timeout\n"; };
4768
4769         $oldtimeout = alarm($timeout);
4770
4771         my $parser = sub {
4772             my $line = shift;
4773
4774             print "$line\n";
4775
4776             if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
4777                 my ($dev_id, $size, $devname) = ($1, $2, $3);
4778                 $devinfo->{$devname} = { size => $size, dev_id => $dev_id };
4779             } elsif ($line =~ m/^CTIME: /) {
4780                 # we correctly received the vma config, so we can disable
4781                 # the timeout now for disk allocation (set to 10 minutes, so
4782                 # that we always timeout if something goes wrong)
4783                 alarm(600);
4784                 &$print_devmap();
4785                 print $fifofh "done\n";
4786                 my $tmp = $oldtimeout || 0;
4787                 $oldtimeout = undef;
4788                 alarm($tmp);
4789                 close($fifofh);
4790             }
4791         };
4792
4793         print "restore vma archive: $cmd\n";
4794         run_command($cmd, input => $input, outfunc => $parser, afterfork => $openfifo);
4795     };
4796     my $err = $@;
4797
4798     alarm($oldtimeout) if $oldtimeout;
4799
4800     unlink $mapfifo;
4801
4802     if ($err) {
4803         rmtree $tmpdir;
4804         unlink $tmpfn;
4805
4806         my $cfg = cfs_read_file('storage.cfg');
4807         foreach my $devname (keys %$devinfo) {
4808             my $volid = $devinfo->{$devname}->{volid};
4809             next if !$volid;
4810             eval {
4811                 if ($volid =~ m|^/|) {
4812                     unlink $volid || die 'unlink failed\n';
4813                 } else {
4814                     PVE::Storage::vdisk_free($cfg, $volid);
4815                 }
4816                 print STDERR "temporary volume '$volid' sucessfuly removed\n";
4817             };
4818             print STDERR "unable to cleanup '$volid' - $@" if $@;
4819         }
4820         die $err;
4821     }
4822
4823     rmtree $tmpdir;
4824
4825     rename($tmpfn, $conffile) ||
4826         die "unable to commit configuration file '$conffile'\n";
4827
4828     PVE::Cluster::cfs_update(); # make sure we read new file
4829
4830     eval { rescan($vmid, 1); };
4831     warn $@ if $@;
4832 }
4833
4834 sub restore_tar_archive {
4835     my ($archive, $vmid, $user, $opts) = @_;
4836
4837     if ($archive ne '-') {
4838         my $firstfile = tar_archive_read_firstfile($archive);
4839         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
4840             if $firstfile ne 'qemu-server.conf';
4841     }
4842
4843     my $storecfg = cfs_read_file('storage.cfg');
4844
4845     # destroy existing data - keep empty config
4846     my $vmcfgfn = PVE::QemuServer::config_file($vmid);
4847     destroy_vm($storecfg, $vmid, 1) if -f $vmcfgfn;
4848
4849     my $tocmd = "/usr/lib/qemu-server/qmextract";
4850
4851     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
4852     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
4853     $tocmd .= ' --prealloc' if $opts->{prealloc};
4854     $tocmd .= ' --info' if $opts->{info};
4855
4856     # tar option "xf" does not autodetect compression when read from STDIN,
4857     # so we pipe to zcat
4858     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
4859         PVE::Tools::shellquote("--to-command=$tocmd");
4860
4861     my $tmpdir = "/var/tmp/vzdumptmp$$";
4862     mkpath $tmpdir;
4863
4864     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
4865     local $ENV{VZDUMP_VMID} = $vmid;
4866     local $ENV{VZDUMP_USER} = $user;
4867
4868     my $conffile = config_file($vmid);
4869     my $tmpfn = "$conffile.$$.tmp";
4870
4871     # disable interrupts (always do cleanups)
4872     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
4873         print STDERR "got interrupt - ignored\n";
4874     };
4875
4876     eval {
4877         # enable interrupts
4878         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
4879             die "interrupted by signal\n";
4880         };
4881
4882         if ($archive eq '-') {
4883             print "extracting archive from STDIN\n";
4884             run_command($cmd, input => "<&STDIN");
4885         } else {
4886             print "extracting archive '$archive'\n";
4887             run_command($cmd);
4888         }
4889
4890         return if $opts->{info};
4891
4892         # read new mapping
4893         my $map = {};
4894         my $statfile = "$tmpdir/qmrestore.stat";
4895         if (my $fd = IO::File->new($statfile, "r")) {
4896             while (defined (my $line = <$fd>)) {
4897                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4898                     $map->{$1} = $2 if $1;
4899                 } else {
4900                     print STDERR "unable to parse line in statfile - $line\n";
4901                 }
4902             }
4903             $fd->close();
4904         }
4905
4906         my $confsrc = "$tmpdir/qemu-server.conf";
4907
4908         my $srcfd = new IO::File($confsrc, "r") ||
4909             die "unable to open file '$confsrc'\n";
4910
4911         my $outfd = new IO::File ($tmpfn, "w") ||
4912             die "unable to write config for VM $vmid\n";
4913
4914         my $cookie = { netcount => 0 };
4915         while (defined (my $line = <$srcfd>)) {
4916             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
4917         }
4918
4919         $srcfd->close();
4920         $outfd->close();
4921     };
4922     my $err = $@;
4923
4924     if ($err) {
4925
4926         unlink $tmpfn;
4927
4928         tar_restore_cleanup($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info};
4929
4930         die $err;
4931     }
4932
4933     rmtree $tmpdir;
4934
4935     rename $tmpfn, $conffile ||
4936         die "unable to commit configuration file '$conffile'\n";
4937
4938     PVE::Cluster::cfs_update(); # make sure we read new file
4939
4940     eval { rescan($vmid, 1); };
4941     warn $@ if $@;
4942 };
4943
4944
4945 # Internal snapshots
4946
4947 # NOTE: Snapshot create/delete involves several non-atomic
4948 # action, and can take a long time.
4949 # So we try to avoid locking the file and use 'lock' variable
4950 # inside the config file instead.
4951
4952 my $snapshot_copy_config = sub {
4953     my ($source, $dest) = @_;
4954
4955     foreach my $k (keys %$source) {
4956         next if $k eq 'snapshots';
4957         next if $k eq 'snapstate';
4958         next if $k eq 'snaptime';
4959         next if $k eq 'vmstate';
4960         next if $k eq 'lock';
4961         next if $k eq 'digest';
4962         next if $k eq 'description';
4963         next if $k =~ m/^unused\d+$/;
4964
4965         $dest->{$k} = $source->{$k};
4966     }
4967 };
4968
4969 my $snapshot_apply_config = sub {
4970     my ($conf, $snap) = @_;
4971
4972     # copy snapshot list
4973     my $newconf = {
4974         snapshots => $conf->{snapshots},
4975     };
4976
4977     # keep description and list of unused disks
4978     foreach my $k (keys %$conf) {
4979         next if !($k =~ m/^unused\d+$/ || $k eq 'description');
4980         $newconf->{$k} = $conf->{$k};
4981     }
4982
4983     &$snapshot_copy_config($snap, $newconf);
4984
4985     return $newconf;
4986 };
4987
4988 sub foreach_writable_storage {
4989     my ($conf, $func) = @_;
4990
4991     my $sidhash = {};
4992
4993     foreach my $ds (keys %$conf) {
4994         next if !valid_drivename($ds);
4995
4996         my $drive = parse_drive($ds, $conf->{$ds});
4997         next if !$drive;
4998         next if drive_is_cdrom($drive);
4999
5000         my $volid = $drive->{file};
5001
5002         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
5003         $sidhash->{$sid} = $sid if $sid;
5004     }
5005
5006     foreach my $sid (sort keys %$sidhash) {
5007         &$func($sid);
5008     }
5009 }
5010
5011 my $alloc_vmstate_volid = sub {
5012     my ($storecfg, $vmid, $conf, $snapname) = @_;
5013
5014     # Note: we try to be smart when selecting a $target storage
5015
5016     my $target;
5017
5018     # search shared storage first
5019     foreach_writable_storage($conf, sub {
5020         my ($sid) = @_;
5021         my $scfg = PVE::Storage::storage_config($storecfg, $sid);
5022         return if !$scfg->{shared};
5023
5024         $target = $sid if !$target || $scfg->{path}; # prefer file based storage
5025     });
5026
5027     if (!$target) {
5028         # now search local storage
5029         foreach_writable_storage($conf, sub {
5030             my ($sid) = @_;
5031             my $scfg = PVE::Storage::storage_config($storecfg, $sid);
5032             return if $scfg->{shared};
5033
5034             $target = $sid if !$target || $scfg->{path}; # prefer file based storage;
5035         });
5036     }
5037
5038     $target = 'local' if !$target;
5039
5040     my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
5041     # we abort live save after $conf->{memory}, so we need at max twice that space
5042     my $size = $conf->{memory}*2 + $driver_state_size;
5043
5044     my $name = "vm-$vmid-state-$snapname";
5045     my $scfg = PVE::Storage::storage_config($storecfg, $target);
5046     $name .= ".raw" if $scfg->{path}; # add filename extension for file base storage
5047     my $volid = PVE::Storage::vdisk_alloc($storecfg, $target, $vmid, 'raw', $name, $size*1024);
5048
5049     return $volid;
5050 };
5051
5052 my $snapshot_prepare = sub {
5053     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
5054
5055     my $snap;
5056
5057     my $updatefn =  sub {
5058
5059         my $conf = load_config($vmid);
5060
5061         die "you can't take a snapshot if it's a template\n"
5062             if is_template($conf);
5063
5064         check_lock($conf);
5065
5066         $conf->{lock} = 'snapshot';
5067
5068         die "snapshot name '$snapname' already used\n"
5069             if defined($conf->{snapshots}->{$snapname});
5070
5071         my $storecfg = PVE::Storage::config();
5072         die "snapshot feature is not available" if !has_feature('snapshot', $conf, $storecfg);
5073
5074         $snap = $conf->{snapshots}->{$snapname} = {};
5075
5076         if ($save_vmstate && check_running($vmid)) {
5077             $snap->{vmstate} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
5078         }
5079
5080         &$snapshot_copy_config($conf, $snap);
5081
5082         $snap->{snapstate} = "prepare";
5083         $snap->{snaptime} = time();
5084         $snap->{description} = $comment if $comment;
5085
5086         # always overwrite machine if we save vmstate. This makes sure we
5087         # can restore it later using correct machine type
5088         $snap->{machine} = get_current_qemu_machine($vmid) if $snap->{vmstate};
5089
5090         update_config_nolock($vmid, $conf, 1);
5091     };
5092
5093     lock_config($vmid, $updatefn);
5094
5095     return $snap;
5096 };
5097
5098 my $snapshot_commit = sub {
5099     my ($vmid, $snapname) = @_;
5100
5101     my $updatefn = sub {
5102
5103         my $conf = load_config($vmid);
5104
5105         die "missing snapshot lock\n"
5106             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
5107
5108         my $has_machine_config = defined($conf->{machine});
5109
5110         my $snap = $conf->{snapshots}->{$snapname};
5111
5112         die "snapshot '$snapname' does not exist\n" if !defined($snap);
5113
5114         die "wrong snapshot state\n"
5115             if !($snap->{snapstate} && $snap->{snapstate} eq "prepare");
5116
5117         delete $snap->{snapstate};
5118         delete $conf->{lock};
5119
5120         my $newconf = &$snapshot_apply_config($conf, $snap);
5121
5122         delete $newconf->{machine} if !$has_machine_config;
5123
5124         $newconf->{parent} = $snapname;
5125
5126         update_config_nolock($vmid, $newconf, 1);
5127     };
5128
5129     lock_config($vmid, $updatefn);
5130 };
5131
5132 sub snapshot_rollback {
5133     my ($vmid, $snapname) = @_;
5134
5135     my $snap;
5136
5137     my $prepare = 1;
5138
5139     my $storecfg = PVE::Storage::config();
5140
5141     my $updatefn = sub {
5142
5143         my $conf = load_config($vmid);
5144
5145         die "you can't rollback if vm is a template\n" if is_template($conf);
5146
5147         $snap = $conf->{snapshots}->{$snapname};
5148
5149         die "snapshot '$snapname' does not exist\n" if !defined($snap);
5150
5151         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
5152             if $snap->{snapstate};
5153
5154         if ($prepare) {
5155             check_lock($conf);
5156             vm_stop($storecfg, $vmid, undef, undef, 5, undef, undef);
5157         }
5158
5159         die "unable to rollback vm $vmid: vm is running\n"
5160             if check_running($vmid);
5161
5162         if ($prepare) {
5163             $conf->{lock} = 'rollback';
5164         } else {
5165             die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
5166             delete $conf->{lock};
5167         }
5168
5169         my $forcemachine;
5170
5171         if (!$prepare) {
5172             my $has_machine_config = defined($conf->{machine});
5173
5174             # copy snapshot config to current config
5175             $conf = &$snapshot_apply_config($conf, $snap);
5176             $conf->{parent} = $snapname;
5177
5178             # Note: old code did not store 'machine', so we try to be smart
5179             # and guess the snapshot was generated with kvm 1.4 (pc-i440fx-1.4).
5180             $forcemachine = $conf->{machine} || 'pc-i440fx-1.4';
5181             # we remove the 'machine' configuration if not explicitly specified
5182             # in the original config.
5183             delete $conf->{machine} if $snap->{vmstate} && !$has_machine_config;
5184         }
5185
5186         update_config_nolock($vmid, $conf, 1);
5187
5188         if (!$prepare && $snap->{vmstate}) {
5189             my $statefile = PVE::Storage::path($storecfg, $snap->{vmstate});
5190             vm_start($storecfg, $vmid, $statefile, undef, undef, undef, $forcemachine);
5191         }
5192     };
5193
5194     lock_config($vmid, $updatefn);
5195
5196     foreach_drive($snap, sub {
5197         my ($ds, $drive) = @_;
5198
5199         return if drive_is_cdrom($drive);
5200
5201         my $volid = $drive->{file};
5202         my $device = "drive-$ds";
5203
5204         PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
5205     });
5206
5207     $prepare = 0;
5208     lock_config($vmid, $updatefn);
5209 }
5210
5211 my $savevm_wait = sub {
5212     my ($vmid) = @_;
5213
5214     for(;;) {
5215         my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
5216         if (!$stat->{status}) {
5217             die "savevm not active\n";
5218         } elsif ($stat->{status} eq 'active') {
5219             sleep(1);
5220             next;
5221         } elsif ($stat->{status} eq 'completed') {
5222             last;
5223         } else {
5224             die "query-savevm returned status '$stat->{status}'\n";
5225         }
5226     }
5227 };
5228
5229 sub snapshot_create {
5230     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
5231
5232     my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
5233
5234     $save_vmstate = 0 if !$snap->{vmstate}; # vm is not running
5235
5236     my $config = load_config($vmid);
5237
5238     my $running = check_running($vmid);
5239
5240     my $freezefs = $running && $config->{agent};
5241     $freezefs = 0 if $snap->{vmstate}; # not needed if we save RAM
5242
5243     my $drivehash = {};
5244
5245     if ($freezefs) {
5246         eval { vm_mon_cmd($vmid, "guest-fsfreeze-freeze"); };
5247         warn "guest-fsfreeze-freeze problems - $@" if $@;
5248     }
5249
5250     eval {
5251         # create internal snapshots of all drives
5252
5253         my $storecfg = PVE::Storage::config();
5254
5255         if ($running) {
5256             if ($snap->{vmstate}) {
5257                 my $path = PVE::Storage::path($storecfg, $snap->{vmstate});
5258                 vm_mon_cmd($vmid, "savevm-start", statefile => $path);
5259                 &$savevm_wait($vmid);
5260             } else {
5261                 vm_mon_cmd($vmid, "savevm-start");
5262             }
5263         };
5264
5265         foreach_drive($snap, sub {
5266             my ($ds, $drive) = @_;
5267
5268             return if drive_is_cdrom($drive);
5269
5270             my $volid = $drive->{file};
5271             my $device = "drive-$ds";
5272
5273             qemu_volume_snapshot($vmid, $device, $storecfg, $volid, $snapname);
5274             $drivehash->{$ds} = 1;
5275        });
5276     };
5277     my $err = $@;
5278
5279     if ($running) {
5280         eval { vm_mon_cmd($vmid, "savevm-end")  };
5281         warn $@ if $@;
5282
5283         if ($freezefs) {
5284             eval { vm_mon_cmd($vmid, "guest-fsfreeze-thaw"); };
5285             warn "guest-fsfreeze-thaw problems - $@" if $@;
5286         }
5287
5288         # savevm-end is async, we need to wait
5289         for (;;) {
5290             my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
5291             if (!$stat->{bytes}) {
5292                 last;
5293             } else {
5294                 print "savevm not yet finished\n";
5295                 sleep(1);
5296                 next;
5297             }
5298         }
5299     }
5300
5301     if ($err) {
5302         warn "snapshot create failed: starting cleanup\n";
5303         eval { snapshot_delete($vmid, $snapname, 0, $drivehash); };
5304         warn $@ if $@;
5305         die $err;
5306     }
5307
5308     &$snapshot_commit($vmid, $snapname);
5309 }
5310
5311 # Note: $drivehash is only set when called from snapshot_create.
5312 sub snapshot_delete {
5313     my ($vmid, $snapname, $force, $drivehash) = @_;
5314
5315     my $prepare = 1;
5316
5317     my $snap;
5318     my $unused = [];
5319
5320     my $unlink_parent = sub {
5321         my ($confref, $new_parent) = @_;
5322
5323         if ($confref->{parent} && $confref->{parent} eq $snapname) {
5324             if ($new_parent) {
5325                 $confref->{parent} = $new_parent;
5326             } else {
5327                 delete $confref->{parent};
5328             }
5329         }
5330     };
5331
5332     my $updatefn =  sub {
5333         my ($remove_drive) = @_;
5334
5335         my $conf = load_config($vmid);
5336
5337         if (!$drivehash) {
5338             check_lock($conf);
5339             die "you can't delete a snapshot if vm is a template\n"
5340                 if is_template($conf);
5341         }
5342
5343         $snap = $conf->{snapshots}->{$snapname};
5344
5345         die "snapshot '$snapname' does not exist\n" if !defined($snap);
5346
5347         # remove parent refs
5348         if (!$prepare) {
5349             &$unlink_parent($conf, $snap->{parent});
5350             foreach my $sn (keys %{$conf->{snapshots}}) {
5351                 next if $sn eq $snapname;
5352                 &$unlink_parent($conf->{snapshots}->{$sn}, $snap->{parent});
5353             }
5354         }
5355
5356         if ($remove_drive) {
5357             if ($remove_drive eq 'vmstate') {
5358                 delete $snap->{$remove_drive};
5359             } else {
5360                 my $drive = parse_drive($remove_drive, $snap->{$remove_drive});
5361                 my $volid = $drive->{file};
5362                 delete $snap->{$remove_drive};
5363                 add_unused_volume($conf, $volid);
5364             }
5365         }
5366
5367         if ($prepare) {
5368             $snap->{snapstate} = 'delete';
5369         } else {
5370             delete $conf->{snapshots}->{$snapname};
5371             delete $conf->{lock} if $drivehash;
5372             foreach my $volid (@$unused) {
5373                 add_unused_volume($conf, $volid);
5374             }
5375         }
5376
5377         update_config_nolock($vmid, $conf, 1);
5378     };
5379
5380     lock_config($vmid, $updatefn);
5381
5382     # now remove vmstate file
5383
5384     my $storecfg = PVE::Storage::config();
5385
5386     if ($snap->{vmstate}) {
5387         eval {  PVE::Storage::vdisk_free($storecfg, $snap->{vmstate}); };
5388         if (my $err = $@) {
5389             die $err if !$force;
5390             warn $err;
5391         }
5392         # save changes (remove vmstate from snapshot)
5393         lock_config($vmid, $updatefn, 'vmstate') if !$force;
5394     };
5395
5396     # now remove all internal snapshots
5397     foreach_drive($snap, sub {
5398         my ($ds, $drive) = @_;
5399
5400         return if drive_is_cdrom($drive);
5401
5402         my $volid = $drive->{file};
5403         my $device = "drive-$ds";
5404
5405         if (!$drivehash || $drivehash->{$ds}) {
5406             eval { qemu_volume_snapshot_delete($vmid, $device, $storecfg, $volid, $snapname); };
5407             if (my $err = $@) {
5408                 die $err if !$force;
5409                 warn $err;
5410             }
5411         }
5412
5413         # save changes (remove drive fron snapshot)
5414         lock_config($vmid, $updatefn, $ds) if !$force;
5415         push @$unused, $volid;
5416     });
5417
5418     # now cleanup config
5419     $prepare = 0;
5420     lock_config($vmid, $updatefn);
5421 }
5422
5423 sub has_feature {
5424     my ($feature, $conf, $storecfg, $snapname, $running) = @_;
5425
5426     my $err;
5427     foreach_drive($conf, sub {
5428         my ($ds, $drive) = @_;
5429
5430         return if drive_is_cdrom($drive);
5431         my $volid = $drive->{file};
5432         $err = 1 if !PVE::Storage::volume_has_feature($storecfg, $feature, $volid, $snapname, $running);
5433     });
5434
5435     return $err ? 0 : 1;
5436 }
5437
5438 sub template_create {
5439     my ($vmid, $conf, $disk) = @_;
5440
5441     my $storecfg = PVE::Storage::config();
5442
5443     foreach_drive($conf, sub {
5444         my ($ds, $drive) = @_;
5445
5446         return if drive_is_cdrom($drive);
5447         return if $disk && $ds ne $disk;
5448
5449         my $volid = $drive->{file};
5450         return if !PVE::Storage::volume_has_feature($storecfg, 'template', $volid);
5451
5452         my $voliddst = PVE::Storage::vdisk_create_base($storecfg, $volid);
5453         $drive->{file} = $voliddst;
5454         $conf->{$ds} = print_drive($vmid, $drive);
5455         update_config_nolock($vmid, $conf, 1);
5456     });
5457 }
5458
5459 sub is_template {
5460     my ($conf) = @_;
5461
5462     return 1 if defined $conf->{template} && $conf->{template} == 1;
5463 }
5464
5465 sub qemu_img_convert {
5466     my ($src_volid, $dst_volid, $size, $snapname) = @_;
5467
5468     my $storecfg = PVE::Storage::config();
5469     my ($src_storeid, $src_volname) = PVE::Storage::parse_volume_id($src_volid, 1);
5470     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
5471
5472     if ($src_storeid && $dst_storeid) {
5473         my $src_scfg = PVE::Storage::storage_config($storecfg, $src_storeid);
5474         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
5475
5476         my $src_format = qemu_img_format($src_scfg, $src_volname);
5477         my $dst_format = qemu_img_format($dst_scfg, $dst_volname);
5478
5479         my $src_path = PVE::Storage::path($storecfg, $src_volid, $snapname);
5480         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
5481
5482         my $cmd = [];
5483         push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-n';
5484         push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
5485         push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
5486
5487         my $parser = sub {
5488             my $line = shift;
5489             if($line =~ m/\((\S+)\/100\%\)/){
5490                 my $percent = $1;
5491                 my $transferred = int($size * $percent / 100);
5492                 my $remaining = $size - $transferred;
5493
5494                 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
5495             }
5496
5497         };
5498
5499         eval  { run_command($cmd, timeout => undef, outfunc => $parser); };
5500         my $err = $@;
5501         die "copy failed: $err" if $err;
5502     }
5503 }
5504
5505 sub qemu_img_format {
5506     my ($scfg, $volname) = @_;
5507
5508     if ($scfg->{path} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/) {
5509         return $1;
5510     } elsif ($scfg->{type} eq 'iscsi') {
5511         return "host_device";
5512     } else {
5513         return "raw";
5514     }
5515 }
5516
5517 sub qemu_drive_mirror {
5518     my ($vmid, $drive, $dst_volid, $vmiddst) = @_;
5519
5520     my $count = 0;
5521     my $old_len = 0;
5522     my $frozen = undef;
5523     my $maxwait = 120;
5524
5525     my $storecfg = PVE::Storage::config();
5526     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid);
5527
5528     my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
5529
5530     my $format;
5531     if ($dst_volname =~ m/\.(raw|qcow2)$/){
5532         $format = $1;
5533     }
5534
5535     my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
5536
5537     my $opts = { timeout => 10, device => "drive-$drive", mode => "existing", sync => "full", target => $dst_path };
5538     $opts->{format} = $format if $format;
5539
5540     #fixme : sometime drive-mirror timeout, but works fine after.
5541     # (I have see the problem with big volume > 200GB), so we need to eval
5542     eval { vm_mon_cmd($vmid, "drive-mirror", %$opts); };
5543     # ignore errors here
5544
5545     eval {
5546         while (1) {
5547             my $stats = vm_mon_cmd($vmid, "query-block-jobs");
5548             my $stat = @$stats[0];
5549             die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
5550             die "error job is not mirroring" if $stat->{type} ne "mirror";
5551
5552             my $busy = $stat->{busy};
5553
5554             if (my $total = $stat->{len}) {
5555                 my $transferred = $stat->{offset} || 0;
5556                 my $remaining = $total - $transferred;
5557                 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
5558
5559                 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent % busy: $busy\n";
5560             }
5561
5562             if ($stat->{len} == $stat->{offset}) {
5563                 if ($busy eq 'false') {
5564
5565                     last if $vmiddst != $vmid;
5566
5567                     # try to switch the disk if source and destination are on the same guest
5568                     eval { vm_mon_cmd($vmid, "block-job-complete", device => "drive-$drive") };
5569                     last if !$@;
5570                     die $@ if $@ !~ m/cannot be completed/;
5571                 }
5572
5573                 if ($count > $maxwait) {
5574                     # if too much writes to disk occurs at the end of migration
5575                     #the disk needs to be freezed to be able to complete the migration
5576                     vm_suspend($vmid,1);
5577                     $frozen = 1;
5578                 }
5579                 $count ++
5580             }
5581             $old_len = $stat->{offset};
5582             sleep 1;
5583         }
5584
5585         vm_resume($vmid, 1) if $frozen;
5586
5587     };
5588     my $err = $@;
5589
5590     my $cancel_job = sub {
5591         vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive");
5592         while (1) {
5593             my $stats = vm_mon_cmd($vmid, "query-block-jobs");
5594             my $stat = @$stats[0];
5595             last if !$stat;
5596             sleep 1;
5597         }
5598     };
5599
5600     if ($err) {
5601         eval { &$cancel_job(); };
5602         die "mirroring error: $err";
5603     }
5604
5605     if ($vmiddst != $vmid) {
5606         # if we clone a disk for a new target vm, we don't switch the disk
5607         &$cancel_job(); # so we call block-job-cancel
5608     }
5609 }
5610
5611 sub clone_disk {
5612     my ($storecfg, $vmid, $running, $drivename, $drive, $snapname,
5613         $newvmid, $storage, $format, $full, $newvollist) = @_;
5614
5615     my $newvolid;
5616
5617     if (!$full) {
5618         print "create linked clone of drive $drivename ($drive->{file})\n";
5619         $newvolid = PVE::Storage::vdisk_clone($storecfg,  $drive->{file}, $newvmid, $snapname);
5620         push @$newvollist, $newvolid;
5621     } else {
5622         my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file});
5623         $storeid = $storage if $storage;
5624
5625         my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($storecfg, $storeid);
5626         if (!$format) {
5627             $format = $drive->{format} || $defFormat;
5628         }
5629
5630         # test if requested format is supported - else use default
5631         my $supported = grep { $_ eq $format } @$validFormats;
5632         $format = $defFormat if !$supported;
5633
5634         my ($size) = PVE::Storage::volume_size_info($storecfg, $drive->{file}, 3);
5635
5636         print "create full clone of drive $drivename ($drive->{file})\n";
5637         $newvolid = PVE::Storage::vdisk_alloc($storecfg, $storeid, $newvmid, $format, undef, ($size/1024));
5638         push @$newvollist, $newvolid;
5639
5640         if (!$running || $snapname) {
5641             qemu_img_convert($drive->{file}, $newvolid, $size, $snapname);
5642         } else {
5643             qemu_drive_mirror($vmid, $drivename, $newvolid, $newvmid);
5644         }
5645     }
5646
5647     my ($size) = PVE::Storage::volume_size_info($storecfg, $newvolid, 3);
5648
5649     my $disk = $drive;
5650     $disk->{format} = undef;
5651     $disk->{file} = $newvolid;
5652     $disk->{size} = $size;
5653
5654     return $disk;
5655 }
5656
5657 # this only works if VM is running
5658 sub get_current_qemu_machine {
5659     my ($vmid) = @_;
5660
5661     my $cmd = { execute => 'query-machines', arguments => {} };
5662     my $res = PVE::QemuServer::vm_qmp_command($vmid, $cmd);
5663
5664     my ($current, $default);
5665     foreach my $e (@$res) {
5666         $default = $e->{name} if $e->{'is-default'};
5667         $current = $e->{name} if $e->{'is-current'};
5668     }
5669
5670     # fallback to the default machine if current is not supported by qemu
5671     return $current || $default || 'pc';
5672 }
5673
5674 sub lspci {
5675
5676     my $devices = {};
5677
5678     dir_glob_foreach("$pcisysfs/devices", '[a-f0-9]{4}:([a-f0-9]{2}:[a-f0-9]{2})\.([0-9])', sub {
5679             my (undef, $id, $function) = @_;
5680             my $res = { id => $id, function => $function};
5681             push @{$devices->{$id}}, $res;
5682     });
5683
5684     return $devices;
5685 }
5686
5687 1;