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
3099     my $devices = {};
3100     foreach my $pcibus (@$res) {
3101         foreach my $device (@{$pcibus->{devices}}) {
3102             next if !$device->{'qdev_id'};
3103             $devices->{$device->{'qdev_id'}} = 1;
3104         }
3105     }
3106
3107     my $resblock = vm_mon_cmd($vmid, 'query-block');
3108     foreach my $block (@$resblock) {
3109         if($block->{device} =~ m/^drive-(\S+)/){
3110                 $devices->{$1} = 1;
3111         }
3112     }
3113
3114     return $devices;
3115 }
3116
3117 sub vm_deviceplug {
3118     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
3119
3120     return 1 if !check_running($vmid);
3121
3122     my $q35 = machine_type_is_q35($conf);
3123
3124     if ($deviceid eq 'tablet') {
3125         qemu_deviceadd($vmid, print_tabletdevice_full($conf));
3126         return 1;
3127     }
3128
3129     return 1 if !$conf->{hotplug};
3130
3131     my $devices_list = vm_devices_list($vmid);
3132     return 1 if defined($devices_list->{$deviceid});
3133
3134     qemu_bridgeadd($storecfg, $conf, $vmid, $deviceid); #add bridge if we need it for the device
3135
3136     if ($deviceid =~ m/^(virtio)(\d+)$/) {
3137         return undef if !qemu_driveadd($storecfg, $vmid, $device);
3138         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
3139         qemu_deviceadd($vmid, $devicefull);
3140         if(!qemu_deviceaddverify($vmid, $deviceid)) {
3141            qemu_drivedel($vmid, $deviceid);
3142            return undef;
3143         }
3144     }
3145
3146     if ($deviceid =~ m/^(scsihw)(\d+)$/) {
3147         my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : "lsi";
3148         my $pciaddr = print_pci_addr($deviceid);
3149         my $devicefull = "$scsihw,id=$deviceid$pciaddr";
3150         qemu_deviceadd($vmid, $devicefull);
3151         return undef if(!qemu_deviceaddverify($vmid, $deviceid));
3152     }
3153
3154     if ($deviceid =~ m/^(scsi)(\d+)$/) {
3155         return undef if !qemu_findorcreatescsihw($storecfg,$conf, $vmid, $device);
3156         return undef if !qemu_driveadd($storecfg, $vmid, $device);
3157         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
3158         if(!qemu_deviceadd($vmid, $devicefull)) {
3159            qemu_drivedel($vmid, $deviceid);
3160            return undef;
3161         }
3162     }
3163
3164     if ($deviceid =~ m/^(net)(\d+)$/) {
3165         return undef if !qemu_netdevadd($vmid, $conf, $device, $deviceid);
3166         my $netdevicefull = print_netdevice_full($vmid, $conf, $device, $deviceid);
3167         qemu_deviceadd($vmid, $netdevicefull);
3168         if(!qemu_deviceaddverify($vmid, $deviceid)) {
3169            qemu_netdevdel($vmid, $deviceid);
3170            return undef;
3171         }
3172     }
3173
3174
3175     if (!$q35 && $deviceid =~ m/^(pci\.)(\d+)$/) {
3176         my $bridgeid = $2;
3177         my $pciaddr = print_pci_addr($deviceid);
3178         my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
3179         qemu_deviceadd($vmid, $devicefull);
3180         return undef if !qemu_deviceaddverify($vmid, $deviceid);
3181     }
3182
3183     return 1;
3184 }
3185
3186 sub vm_deviceunplug {
3187     my ($vmid, $conf, $deviceid) = @_;
3188
3189     return 1 if !check_running ($vmid);
3190
3191     if ($deviceid eq 'tablet') {
3192         qemu_devicedel($vmid, $deviceid);
3193         return 1;
3194     }
3195
3196     return 1 if !$conf->{hotplug};
3197
3198     my $devices_list = vm_devices_list($vmid);
3199     return 1 if !defined($devices_list->{$deviceid});
3200
3201     die "can't unplug bootdisk" if $conf->{bootdisk} && $conf->{bootdisk} eq $deviceid;
3202
3203     if ($deviceid =~ m/^(virtio)(\d+)$/) {
3204         qemu_devicedel($vmid, $deviceid);
3205         return undef if !qemu_devicedelverify($vmid, $deviceid);
3206         return undef if !qemu_drivedel($vmid, $deviceid);
3207     }
3208
3209     if ($deviceid =~ m/^(lsi)(\d+)$/) {
3210         return undef if !qemu_devicedel($vmid, $deviceid);
3211     }
3212
3213     if ($deviceid =~ m/^(scsi)(\d+)$/) {
3214         return undef if !qemu_devicedel($vmid, $deviceid);
3215         return undef if !qemu_drivedel($vmid, $deviceid);
3216     }
3217
3218     if ($deviceid =~ m/^(net)(\d+)$/) {
3219         qemu_devicedel($vmid, $deviceid);
3220         return undef if !qemu_devicedelverify($vmid, $deviceid);
3221         return undef if !qemu_netdevdel($vmid, $deviceid);
3222     }
3223
3224     return 1;
3225 }
3226
3227 sub qemu_deviceadd {
3228     my ($vmid, $devicefull) = @_;
3229
3230     $devicefull = "driver=".$devicefull;
3231     my %options =  split(/[=,]/, $devicefull);
3232
3233     vm_mon_cmd($vmid, "device_add" , %options);
3234     return 1;
3235 }
3236
3237 sub qemu_devicedel {
3238     my($vmid, $deviceid) = @_;
3239     my $ret = vm_mon_cmd($vmid, "device_del", id => $deviceid);
3240     return 1;
3241 }
3242
3243 sub qemu_driveadd {
3244     my($storecfg, $vmid, $device) = @_;
3245
3246     my $drive = print_drive_full($storecfg, $vmid, $device);
3247     my $ret = vm_human_monitor_command($vmid, "drive_add auto $drive");
3248     # If the command succeeds qemu prints: "OK"
3249     if ($ret !~ m/OK/s) {
3250         syslog("err", "adding drive failed: $ret");
3251         return undef;
3252     }
3253     return 1;
3254 }
3255
3256 sub qemu_drivedel {
3257     my($vmid, $deviceid) = @_;
3258
3259     my $ret = vm_human_monitor_command($vmid, "drive_del drive-$deviceid");
3260     $ret =~ s/^\s+//;
3261     if ($ret =~ m/Device \'.*?\' not found/s) {
3262         # NB: device not found errors mean the drive was auto-deleted and we ignore the error
3263     }
3264     elsif ($ret ne "") {
3265       syslog("err", "deleting drive $deviceid failed : $ret");
3266       return undef;
3267     }
3268     return 1;
3269 }
3270
3271 sub qemu_deviceaddverify {
3272     my ($vmid,$deviceid) = @_;
3273
3274     for (my $i = 0; $i <= 5; $i++) {
3275          my $devices_list = vm_devices_list($vmid);
3276          return 1 if defined($devices_list->{$deviceid});
3277          sleep 1;
3278     }
3279     syslog("err", "error on hotplug device $deviceid");
3280     return undef;
3281 }
3282
3283
3284 sub qemu_devicedelverify {
3285     my ($vmid,$deviceid) = @_;
3286
3287     #need to verify the device is correctly remove as device_del is async and empty return is not reliable
3288     for (my $i = 0; $i <= 5; $i++) {
3289          my $devices_list = vm_devices_list($vmid);
3290          return 1 if !defined($devices_list->{$deviceid});
3291          sleep 1;
3292     }
3293     syslog("err", "error on hot-unplugging device $deviceid");
3294     return undef;
3295 }
3296
3297 sub qemu_findorcreatescsihw {
3298     my ($storecfg, $conf, $vmid, $device) = @_;
3299
3300     my $maxdev = ($conf->{scsihw} && ($conf->{scsihw} !~ m/^lsi/)) ? 256 : 7;
3301     my $controller = int($device->{index} / $maxdev);
3302     my $scsihwid="scsihw$controller";
3303     my $devices_list = vm_devices_list($vmid);
3304
3305     if(!defined($devices_list->{$scsihwid})) {
3306        return undef if !vm_deviceplug($storecfg, $conf, $vmid, $scsihwid);
3307     }
3308     return 1;
3309 }
3310
3311 sub qemu_bridgeadd {
3312     my ($storecfg, $conf, $vmid, $device) = @_;
3313
3314     my $bridges = {};
3315     my $bridgeid = undef;
3316     print_pci_addr($device, $bridges);
3317
3318     while (my ($k, $v) = each %$bridges) {
3319         $bridgeid = $k;
3320     }
3321     return if !$bridgeid || $bridgeid < 1;
3322     my $bridge = "pci.$bridgeid";
3323     my $devices_list = vm_devices_list($vmid);
3324
3325     if(!defined($devices_list->{$bridge})) {
3326         return undef if !vm_deviceplug($storecfg, $conf, $vmid, $bridge);
3327     }
3328     return 1;
3329 }
3330
3331 sub qemu_netdevadd {
3332     my ($vmid, $conf, $device, $deviceid) = @_;
3333
3334     my $netdev = print_netdev_full($vmid, $conf, $device, $deviceid);
3335     my %options =  split(/[=,]/, $netdev);
3336
3337     vm_mon_cmd($vmid, "netdev_add",  %options);
3338     return 1;
3339 }
3340
3341 sub qemu_netdevdel {
3342     my ($vmid, $deviceid) = @_;
3343
3344     vm_mon_cmd($vmid, "netdev_del", id => $deviceid);
3345     return 1;
3346 }
3347
3348 sub qemu_cpu_hotplug {
3349     my ($vmid, $conf, $cores) = @_;
3350
3351     die "new cores config is not defined" if !$cores;
3352     die "you can't add more cores than maxcpus"
3353         if $conf->{maxcpus} && ($cores > $conf->{maxcpus});
3354     return if !check_running($vmid);
3355
3356     my $currentcores = $conf->{cores} if $conf->{cores};
3357     die "current cores is not defined" if !$currentcores;
3358     die "maxcpus is not defined" if !$conf->{maxcpus};
3359     raise_param_exc({ 'cores' => "online cpu unplug is not yet possible" })
3360         if($cores < $currentcores);
3361
3362     my $currentrunningcores = vm_mon_cmd($vmid, "query-cpus");
3363     raise_param_exc({ 'cores' => "cores number if running vm is different than configuration" })
3364         if scalar (@{$currentrunningcores}) != $currentcores;
3365
3366     for(my $i = $currentcores; $i < $cores; $i++) {
3367         vm_mon_cmd($vmid, "cpu-add", id => int($i));
3368     }
3369 }
3370
3371 sub qemu_block_set_io_throttle {
3372     my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
3373
3374     return if !check_running($vmid) ;
3375
3376     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));
3377
3378 }
3379
3380 # old code, only used to shutdown old VM after update
3381 sub __read_avail {
3382     my ($fh, $timeout) = @_;
3383
3384     my $sel = new IO::Select;
3385     $sel->add($fh);
3386
3387     my $res = '';
3388     my $buf;
3389
3390     my @ready;
3391     while (scalar (@ready = $sel->can_read($timeout))) {
3392         my $count;
3393         if ($count = $fh->sysread($buf, 8192)) {
3394             if ($buf =~ /^(.*)\(qemu\) $/s) {
3395                 $res .= $1;
3396                 last;
3397             } else {
3398                 $res .= $buf;
3399             }
3400         } else {
3401             if (!defined($count)) {
3402                 die "$!\n";
3403             }
3404             last;
3405         }
3406     }
3407
3408     die "monitor read timeout\n" if !scalar(@ready);
3409
3410     return $res;
3411 }
3412
3413 # old code, only used to shutdown old VM after update
3414 sub vm_monitor_command {
3415     my ($vmid, $cmdstr, $nocheck) = @_;
3416
3417     my $res;
3418
3419     eval {
3420         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
3421
3422         my $sname = "${var_run_tmpdir}/$vmid.mon";
3423
3424         my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
3425             die "unable to connect to VM $vmid socket - $!\n";
3426
3427         my $timeout = 3;
3428
3429         # hack: migrate sometime blocks the monitor (when migrate_downtime
3430         # is set)
3431         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3432             $timeout = 60*60; # 1 hour
3433         }
3434
3435         # read banner;
3436         my $data = __read_avail($sock, $timeout);
3437
3438         if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
3439             die "got unexpected qemu monitor banner\n";
3440         }
3441
3442         my $sel = new IO::Select;
3443         $sel->add($sock);
3444
3445         if (!scalar(my @ready = $sel->can_write($timeout))) {
3446             die "monitor write error - timeout";
3447         }
3448
3449         my $fullcmd = "$cmdstr\r";
3450
3451         # syslog('info', "VM $vmid monitor command: $cmdstr");
3452
3453         my $b;
3454         if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
3455             die "monitor write error - $!";
3456         }
3457
3458         return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
3459
3460         $timeout = 20;
3461
3462         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
3463             $timeout = 60*60; # 1 hour
3464         } elsif ($cmdstr =~ m/^(eject|change)/) {
3465             $timeout = 60; # note: cdrom mount command is slow
3466         }
3467         if ($res = __read_avail($sock, $timeout)) {
3468
3469             my @lines = split("\r?\n", $res);
3470
3471             shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
3472
3473             $res = join("\n", @lines);
3474             $res .= "\n";
3475         }
3476     };
3477
3478     my $err = $@;
3479
3480     if ($err) {
3481         syslog("err", "VM $vmid monitor command failed - $err");
3482         die $err;
3483     }
3484
3485     return $res;
3486 }
3487
3488 sub qemu_block_resize {
3489     my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
3490
3491     my $running = check_running($vmid);
3492
3493     return if !PVE::Storage::volume_resize($storecfg, $volid, $size, $running);
3494
3495     return if !$running;
3496
3497     vm_mon_cmd($vmid, "block_resize", device => $deviceid, size => int($size));
3498
3499 }
3500
3501 sub qemu_volume_snapshot {
3502     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3503
3504     my $running = check_running($vmid);
3505
3506     return if !PVE::Storage::volume_snapshot($storecfg, $volid, $snap, $running);
3507
3508     return if !$running;
3509
3510     vm_mon_cmd($vmid, "snapshot-drive", device => $deviceid, name => $snap);
3511
3512 }
3513
3514 sub qemu_volume_snapshot_delete {
3515     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
3516
3517     my $running = check_running($vmid);
3518
3519     return if !PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snap, $running);
3520
3521     return if !$running;
3522
3523     vm_mon_cmd($vmid, "delete-drive-snapshot", device => $deviceid, name => $snap);
3524 }
3525
3526 sub set_migration_caps {
3527     my ($vmid) = @_;
3528
3529     my $cap_ref = [];
3530
3531     my $enabled_cap = {
3532         "auto-converge" => 1,
3533         "xbzrle" => 0,
3534         "x-rdma-pin-all" => 0,
3535         "zero-blocks" => 0,
3536     };
3537
3538     my $supported_capabilities = vm_mon_cmd_nocheck($vmid, "query-migrate-capabilities");
3539
3540     for my $supported_capability (@$supported_capabilities) {
3541         push @$cap_ref, {
3542             capability => $supported_capability->{capability},
3543             state => $enabled_cap->{$supported_capability->{capability}} ? JSON::true : JSON::false,
3544         };
3545     }
3546
3547     vm_mon_cmd_nocheck($vmid, "migrate-set-capabilities", capabilities => $cap_ref);
3548 }
3549
3550
3551 sub vmconfig_apply_pending {
3552     my ($vmid, $conf, $storecfg, $running) = @_;
3553
3554     die "implement me - vm is running" if $running; # fixme: if $conf->{hotplug};
3555
3556     my @delete = PVE::Tools::split_list($conf->{pending}->{delete});
3557     foreach my $opt (@delete) { # delete
3558         die "internal error" if $opt =~ m/^unused/;
3559         $conf = load_config($vmid); # update/reload
3560         if (!defined($conf->{$opt})) {
3561             vmconfig_undelete_pending_option($conf, $opt);
3562             update_config_nolock($vmid, $conf, 1);
3563         } elsif (valid_drivename($opt)) {
3564             vmconfig_register_unused_drive($storecfg, $vmid, $conf, parse_drive($opt, $conf->{$opt}));
3565             vmconfig_undelete_pending_option($conf, $opt);
3566             delete $conf->{$opt};
3567             update_config_nolock($vmid, $conf, 1);
3568         } else {
3569             vmconfig_undelete_pending_option($conf, $opt);
3570             delete $conf->{$opt};
3571             update_config_nolock($vmid, $conf, 1);
3572         }
3573     }
3574
3575     $conf = load_config($vmid); # update/reload
3576
3577     foreach my $opt (keys %{$conf->{pending}}) { # add/change
3578         $conf = load_config($vmid); # update/reload
3579
3580         if (defined($conf->{$opt}) && ($conf->{$opt} eq $conf->{pending}->{$opt})) {
3581             # skip if nothing changed
3582         } elsif (valid_drivename($opt)) {
3583             vmconfig_register_unused_drive($storecfg, $vmid, $conf, parse_drive($opt, $conf->{$opt}))
3584                 if defined($conf->{$opt});
3585             $conf->{$opt} = $conf->{pending}->{$opt};
3586         } else {
3587             $conf->{$opt} = $conf->{pending}->{$opt};
3588         }
3589
3590         delete $conf->{pending}->{$opt};
3591         update_config_nolock($vmid, $conf, 1);
3592     }
3593 }
3594
3595 sub vm_start {
3596     my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused, $forcemachine, $spice_ticket) = @_;
3597
3598     lock_config($vmid, sub {
3599         my $conf = load_config($vmid, $migratedfrom);
3600
3601         die "you can't start a vm if it's a template\n" if is_template($conf);
3602
3603         check_lock($conf) if !$skiplock;
3604
3605         die "VM $vmid already running\n" if check_running($vmid, undef, $migratedfrom);
3606
3607         if (!$statefile && scalar(keys %{$conf->{pending}})) {
3608             vmconfig_apply_pending($vmid, $conf, $storecfg, 0);
3609             $conf = load_config($vmid); # update/reload
3610         }
3611
3612         my $defaults = load_defaults();
3613
3614         # set environment variable useful inside network script
3615         $ENV{PVE_MIGRATED_FROM} = $migratedfrom if $migratedfrom;
3616
3617         my ($cmd, $vollist, $spice_port) = config_to_command($storecfg, $vmid, $conf, $defaults, $forcemachine);
3618
3619         my $migrate_port = 0;
3620         my $migrate_uri;
3621         if ($statefile) {
3622             if ($statefile eq 'tcp') {
3623                 my $localip = "localhost";
3624                 my $datacenterconf = PVE::Cluster::cfs_read_file('datacenter.cfg');
3625                 if ($datacenterconf->{migration_unsecure}) {
3626                         my $nodename = PVE::INotify::nodename();
3627                         $localip = PVE::Cluster::remote_node_ip($nodename, 1);
3628                 }
3629                 $migrate_port = PVE::Tools::next_migrate_port();
3630                 $migrate_uri = "tcp:${localip}:${migrate_port}";
3631                 push @$cmd, '-incoming', $migrate_uri;
3632                 push @$cmd, '-S';
3633             } else {
3634                 push @$cmd, '-loadstate', $statefile;
3635             }
3636         } elsif ($paused) {
3637             push @$cmd, '-S';
3638         }
3639
3640         # host pci devices
3641         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
3642           my $d = parse_hostpci($conf->{"hostpci$i"});
3643           next if !$d;
3644           my $pcidevices = $d->{pciid};
3645           foreach my $pcidevice (@$pcidevices) {
3646                 my $pciid = $pcidevice->{id}.".".$pcidevice->{function};
3647
3648                 my $info = pci_device_info("0000:$pciid");
3649                 die "IOMMU not present\n" if !check_iommu_support();
3650                 die "no pci device info for device '$pciid'\n" if !$info;
3651
3652                 if ($d->{driver} && $d->{driver} eq "vfio") {
3653                     die "can't unbind/bind pci group to vfio '$pciid'\n" if !pci_dev_group_bind_to_vfio($pciid);
3654                 } else {
3655                     die "can't unbind/bind to stub pci device '$pciid'\n" if !pci_dev_bind_to_stub($info);
3656                 }
3657
3658                 die "can't reset pci device '$pciid'\n" if $info->{has_fl_reset} and !pci_dev_reset($info);
3659           }
3660         }
3661
3662         PVE::Storage::activate_volumes($storecfg, $vollist);
3663
3664         eval  { run_command($cmd, timeout => $statefile ? undef : 30,
3665                     umask => 0077); };
3666         my $err = $@;
3667         die "start failed: $err" if $err;
3668
3669         print "migration listens on $migrate_uri\n" if $migrate_uri;
3670
3671         if ($statefile && $statefile ne 'tcp')  {
3672             eval { vm_mon_cmd_nocheck($vmid, "cont"); };
3673             warn $@ if $@;
3674         }
3675
3676         if ($migratedfrom) {
3677
3678             eval {
3679                 PVE::QemuServer::set_migration_caps($vmid);
3680             };
3681             warn $@ if $@;
3682
3683             if ($spice_port) {
3684                 print "spice listens on port $spice_port\n";
3685                 if ($spice_ticket) {
3686                     PVE::QemuServer::vm_mon_cmd_nocheck($vmid, "set_password", protocol => 'spice', password => $spice_ticket);
3687                     PVE::QemuServer::vm_mon_cmd_nocheck($vmid, "expire_password", protocol => 'spice', time => "+30");
3688                 }
3689             }
3690
3691         } else {
3692
3693             if (!$statefile && (!defined($conf->{balloon}) || $conf->{balloon})) {
3694                 vm_mon_cmd_nocheck($vmid, "balloon", value => $conf->{balloon}*1024*1024)
3695                     if $conf->{balloon};
3696                 vm_mon_cmd_nocheck($vmid, 'qom-set',
3697                             path => "machine/peripheral/balloon0",
3698                             property => "guest-stats-polling-interval",
3699                             value => 2);
3700             }
3701         }
3702     });
3703 }
3704
3705 sub vm_mon_cmd {
3706     my ($vmid, $execute, %params) = @_;
3707
3708     my $cmd = { execute => $execute, arguments => \%params };
3709     vm_qmp_command($vmid, $cmd);
3710 }
3711
3712 sub vm_mon_cmd_nocheck {
3713     my ($vmid, $execute, %params) = @_;
3714
3715     my $cmd = { execute => $execute, arguments => \%params };
3716     vm_qmp_command($vmid, $cmd, 1);
3717 }
3718
3719 sub vm_qmp_command {
3720     my ($vmid, $cmd, $nocheck) = @_;
3721
3722     my $res;
3723
3724     my $timeout;
3725     if ($cmd->{arguments} && $cmd->{arguments}->{timeout}) {
3726         $timeout = $cmd->{arguments}->{timeout};
3727         delete $cmd->{arguments}->{timeout};
3728     }
3729
3730     eval {
3731         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
3732         my $sname = qmp_socket($vmid);
3733         if (-e $sname) { # test if VM is reasonambe new and supports qmp/qga
3734             my $qmpclient = PVE::QMPClient->new();
3735
3736             $res = $qmpclient->cmd($vmid, $cmd, $timeout);
3737         } elsif (-e "${var_run_tmpdir}/$vmid.mon") {
3738             die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
3739                 if scalar(%{$cmd->{arguments}});
3740             vm_monitor_command($vmid, $cmd->{execute}, $nocheck);
3741         } else {
3742             die "unable to open monitor socket\n";
3743         }
3744     };
3745     if (my $err = $@) {
3746         syslog("err", "VM $vmid qmp command failed - $err");
3747         die $err;
3748     }
3749
3750     return $res;
3751 }
3752
3753 sub vm_human_monitor_command {
3754     my ($vmid, $cmdline) = @_;
3755
3756     my $res;
3757
3758     my $cmd = {
3759         execute => 'human-monitor-command',
3760         arguments => { 'command-line' => $cmdline},
3761     };
3762
3763     return vm_qmp_command($vmid, $cmd);
3764 }
3765
3766 sub vm_commandline {
3767     my ($storecfg, $vmid) = @_;
3768
3769     my $conf = load_config($vmid);
3770
3771     my $defaults = load_defaults();
3772
3773     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
3774
3775     return join(' ', @$cmd);
3776 }
3777
3778 sub vm_reset {
3779     my ($vmid, $skiplock) = @_;
3780
3781     lock_config($vmid, sub {
3782
3783         my $conf = load_config($vmid);
3784
3785         check_lock($conf) if !$skiplock;
3786
3787         vm_mon_cmd($vmid, "system_reset");
3788     });
3789 }
3790
3791 sub get_vm_volumes {
3792     my ($conf) = @_;
3793
3794     my $vollist = [];
3795     foreach_volid($conf, sub {
3796         my ($volid, $is_cdrom) = @_;
3797
3798         return if $volid =~ m|^/|;
3799
3800         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
3801         return if !$sid;
3802
3803         push @$vollist, $volid;
3804     });
3805
3806     return $vollist;
3807 }
3808
3809 sub vm_stop_cleanup {
3810     my ($storecfg, $vmid, $conf, $keepActive) = @_;
3811
3812     eval {
3813         fairsched_rmnod($vmid); # try to destroy group
3814
3815         if (!$keepActive) {
3816             my $vollist = get_vm_volumes($conf);
3817             PVE::Storage::deactivate_volumes($storecfg, $vollist);
3818         }
3819
3820         foreach my $ext (qw(mon qmp pid vnc qga)) {
3821             unlink "/var/run/qemu-server/${vmid}.$ext";
3822         }
3823     };
3824     warn $@ if $@; # avoid errors - just warn
3825 }
3826
3827 # Note: use $nockeck to skip tests if VM configuration file exists.
3828 # We need that when migration VMs to other nodes (files already moved)
3829 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3830 sub vm_stop {
3831     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3832
3833     $force = 1 if !defined($force) && !$shutdown;
3834
3835     if ($migratedfrom){
3836         my $pid = check_running($vmid, $nocheck, $migratedfrom);
3837         kill 15, $pid if $pid;
3838         my $conf = load_config($vmid, $migratedfrom);
3839         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive);
3840         return;
3841     }
3842
3843     lock_config($vmid, sub {
3844
3845         my $pid = check_running($vmid, $nocheck);
3846         return if !$pid;
3847
3848         my $conf;
3849         if (!$nocheck) {
3850             $conf = load_config($vmid);
3851             check_lock($conf) if !$skiplock;
3852             if (!defined($timeout) && $shutdown && $conf->{startup}) {
3853                 my $opts = parse_startup($conf->{startup});
3854                 $timeout = $opts->{down} if $opts->{down};
3855             }
3856         }
3857
3858         $timeout = 60 if !defined($timeout);
3859
3860         eval {
3861             if ($shutdown) {
3862                 if (!$nocheck && $conf->{agent}) {
3863                     vm_qmp_command($vmid, { execute => "guest-shutdown" }, $nocheck);
3864                 } else {
3865                     vm_qmp_command($vmid, { execute => "system_powerdown" }, $nocheck);
3866                 }
3867             } else {
3868                 vm_qmp_command($vmid, { execute => "quit" }, $nocheck);
3869             }
3870         };
3871         my $err = $@;
3872
3873         if (!$err) {
3874             my $count = 0;
3875             while (($count < $timeout) && check_running($vmid, $nocheck)) {
3876                 $count++;
3877                 sleep 1;
3878             }
3879
3880             if ($count >= $timeout) {
3881                 if ($force) {
3882                     warn "VM still running - terminating now with SIGTERM\n";
3883                     kill 15, $pid;
3884                 } else {
3885                     die "VM quit/powerdown failed - got timeout\n";
3886                 }
3887             } else {
3888                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3889                 return;
3890             }
3891         } else {
3892             if ($force) {
3893                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3894                 kill 15, $pid;
3895             } else {
3896                 die "VM quit/powerdown failed\n";
3897             }
3898         }
3899
3900         # wait again
3901         $timeout = 10;
3902
3903         my $count = 0;
3904         while (($count < $timeout) && check_running($vmid, $nocheck)) {
3905             $count++;
3906             sleep 1;
3907         }
3908
3909         if ($count >= $timeout) {
3910             warn "VM still running - terminating now with SIGKILL\n";
3911             kill 9, $pid;
3912             sleep 1;
3913         }
3914
3915         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3916    });
3917 }
3918
3919 sub vm_suspend {
3920     my ($vmid, $skiplock) = @_;
3921
3922     lock_config($vmid, sub {
3923
3924         my $conf = load_config($vmid);
3925
3926         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3927
3928         vm_mon_cmd($vmid, "stop");
3929     });
3930 }
3931
3932 sub vm_resume {
3933     my ($vmid, $skiplock) = @_;
3934
3935     lock_config($vmid, sub {
3936
3937         my $conf = load_config($vmid);
3938
3939         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3940
3941         vm_mon_cmd($vmid, "cont");
3942     });
3943 }
3944
3945 sub vm_sendkey {
3946     my ($vmid, $skiplock, $key) = @_;
3947
3948     lock_config($vmid, sub {
3949
3950         my $conf = load_config($vmid);
3951
3952         # there is no qmp command, so we use the human monitor command
3953         vm_human_monitor_command($vmid, "sendkey $key");
3954     });
3955 }
3956
3957 sub vm_destroy {
3958     my ($storecfg, $vmid, $skiplock) = @_;
3959
3960     lock_config($vmid, sub {
3961
3962         my $conf = load_config($vmid);
3963
3964         check_lock($conf) if !$skiplock;
3965
3966         if (!check_running($vmid)) {
3967             fairsched_rmnod($vmid); # try to destroy group
3968             destroy_vm($storecfg, $vmid);
3969         } else {
3970             die "VM $vmid is running - destroy failed\n";
3971         }
3972     });
3973 }
3974
3975 # pci helpers
3976
3977 sub file_write {
3978     my ($filename, $buf) = @_;
3979
3980     my $fh = IO::File->new($filename, "w");
3981     return undef if !$fh;
3982
3983     my $res = print $fh $buf;
3984
3985     $fh->close();
3986
3987     return $res;
3988 }
3989
3990 sub pci_device_info {
3991     my ($name) = @_;
3992
3993     my $res;
3994
3995     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3996     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3997
3998     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
3999     return undef if !defined($irq) || $irq !~ m/^\d+$/;
4000
4001     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
4002     return undef if !defined($vendor) || $vendor !~ s/^0x//;
4003
4004     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
4005     return undef if !defined($product) || $product !~ s/^0x//;
4006
4007     $res = {
4008         name => $name,
4009         vendor => $vendor,
4010         product => $product,
4011         domain => $domain,
4012         bus => $bus,
4013         slot => $slot,
4014         func => $func,
4015         irq => $irq,
4016         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
4017     };
4018
4019     return $res;
4020 }
4021
4022 sub pci_dev_reset {
4023     my ($dev) = @_;
4024
4025     my $name = $dev->{name};
4026
4027     my $fn = "$pcisysfs/devices/$name/reset";
4028
4029     return file_write($fn, "1");
4030 }
4031
4032 sub pci_dev_bind_to_stub {
4033     my ($dev) = @_;
4034
4035     my $name = $dev->{name};
4036
4037     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
4038     return 1 if -d $testdir;
4039
4040     my $data = "$dev->{vendor} $dev->{product}";
4041     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
4042
4043     my $fn = "$pcisysfs/devices/$name/driver/unbind";
4044     if (!file_write($fn, $name)) {
4045         return undef if -f $fn;
4046     }
4047
4048     $fn = "$pcisysfs/drivers/pci-stub/bind";
4049     if (! -d $testdir) {
4050         return undef if !file_write($fn, $name);
4051     }
4052
4053     return -d $testdir;
4054 }
4055
4056 sub pci_dev_bind_to_vfio {
4057     my ($dev) = @_;
4058
4059     my $name = $dev->{name};
4060
4061     my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4062
4063     if (!-d $vfio_basedir) {
4064         system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4065     }
4066     die "Cannot find vfio-pci module!\n" if !-d $vfio_basedir;
4067
4068     my $testdir = "$vfio_basedir/$name";
4069     return 1 if -d $testdir;
4070
4071     my $data = "$dev->{vendor} $dev->{product}";
4072     return undef if !file_write("$vfio_basedir/new_id", $data);
4073
4074     my $fn = "$pcisysfs/devices/$name/driver/unbind";
4075     if (!file_write($fn, $name)) {
4076         return undef if -f $fn;
4077     }
4078
4079     $fn = "$vfio_basedir/bind";
4080     if (! -d $testdir) {
4081         return undef if !file_write($fn, $name);
4082     }
4083
4084     return -d $testdir;
4085 }
4086
4087 sub pci_dev_group_bind_to_vfio {
4088     my ($pciid) = @_;
4089
4090     my $vfio_basedir = "$pcisysfs/drivers/vfio-pci";
4091
4092     if (!-d $vfio_basedir) {
4093         system("/sbin/modprobe vfio-pci >/dev/null 2>/dev/null");
4094     }
4095     die "Cannot find vfio-pci module!\n" if !-d $vfio_basedir;
4096
4097     # get IOMMU group devices
4098     opendir(my $D, "$pcisysfs/devices/0000:$pciid/iommu_group/devices/") || die "Cannot open iommu_group: $!\n";
4099       my @devs = grep /^0000:/, readdir($D);
4100     closedir($D);
4101
4102     foreach my $pciid (@devs) {
4103         $pciid =~ m/^([:\.\da-f]+)$/ or die "PCI ID $pciid not valid!\n";
4104         my $info = pci_device_info($1);
4105         pci_dev_bind_to_vfio($info) || die "Cannot bind $pciid to vfio\n";
4106     }
4107
4108     return 1;
4109 }
4110
4111 sub print_pci_addr {
4112     my ($id, $bridges) = @_;
4113
4114     my $res = '';
4115     my $devices = {
4116         piix3 => { bus => 0, addr => 1 },
4117         #addr2 : first videocard
4118         balloon0 => { bus => 0, addr => 3 },
4119         watchdog => { bus => 0, addr => 4 },
4120         scsihw0 => { bus => 0, addr => 5 },
4121         scsihw1 => { bus => 0, addr => 6 },
4122         ahci0 => { bus => 0, addr => 7 },
4123         qga0 => { bus => 0, addr => 8 },
4124         spice => { bus => 0, addr => 9 },
4125         virtio0 => { bus => 0, addr => 10 },
4126         virtio1 => { bus => 0, addr => 11 },
4127         virtio2 => { bus => 0, addr => 12 },
4128         virtio3 => { bus => 0, addr => 13 },
4129         virtio4 => { bus => 0, addr => 14 },
4130         virtio5 => { bus => 0, addr => 15 },
4131         hostpci0 => { bus => 0, addr => 16 },
4132         hostpci1 => { bus => 0, addr => 17 },
4133         net0 => { bus => 0, addr => 18 },
4134         net1 => { bus => 0, addr => 19 },
4135         net2 => { bus => 0, addr => 20 },
4136         net3 => { bus => 0, addr => 21 },
4137         net4 => { bus => 0, addr => 22 },
4138         net5 => { bus => 0, addr => 23 },
4139         vga1 => { bus => 0, addr => 24 },
4140         vga2 => { bus => 0, addr => 25 },
4141         vga3 => { bus => 0, addr => 26 },
4142         hostpci2 => { bus => 0, addr => 27 },
4143         hostpci3 => { bus => 0, addr => 28 },
4144         #addr29 : usb-host (pve-usb.cfg)
4145         'pci.1' => { bus => 0, addr => 30 },
4146         'pci.2' => { bus => 0, addr => 31 },
4147         'net6' => { bus => 1, addr => 1 },
4148         'net7' => { bus => 1, addr => 2 },
4149         'net8' => { bus => 1, addr => 3 },
4150         'net9' => { bus => 1, addr => 4 },
4151         'net10' => { bus => 1, addr => 5 },
4152         'net11' => { bus => 1, addr => 6 },
4153         'net12' => { bus => 1, addr => 7 },
4154         'net13' => { bus => 1, addr => 8 },
4155         'net14' => { bus => 1, addr => 9 },
4156         'net15' => { bus => 1, addr => 10 },
4157         'net16' => { bus => 1, addr => 11 },
4158         'net17' => { bus => 1, addr => 12 },
4159         'net18' => { bus => 1, addr => 13 },
4160         'net19' => { bus => 1, addr => 14 },
4161         'net20' => { bus => 1, addr => 15 },
4162         'net21' => { bus => 1, addr => 16 },
4163         'net22' => { bus => 1, addr => 17 },
4164         'net23' => { bus => 1, addr => 18 },
4165         'net24' => { bus => 1, addr => 19 },
4166         'net25' => { bus => 1, addr => 20 },
4167         'net26' => { bus => 1, addr => 21 },
4168         'net27' => { bus => 1, addr => 22 },
4169         'net28' => { bus => 1, addr => 23 },
4170         'net29' => { bus => 1, addr => 24 },
4171         'net30' => { bus => 1, addr => 25 },
4172         'net31' => { bus => 1, addr => 26 },
4173         'virtio6' => { bus => 2, addr => 1 },
4174         'virtio7' => { bus => 2, addr => 2 },
4175         'virtio8' => { bus => 2, addr => 3 },
4176         'virtio9' => { bus => 2, addr => 4 },
4177         'virtio10' => { bus => 2, addr => 5 },
4178         'virtio11' => { bus => 2, addr => 6 },
4179         'virtio12' => { bus => 2, addr => 7 },
4180         'virtio13' => { bus => 2, addr => 8 },
4181         'virtio14' => { bus => 2, addr => 9 },
4182         'virtio15' => { bus => 2, addr => 10 },
4183     };
4184
4185     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
4186            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
4187            my $bus = $devices->{$id}->{bus};
4188            $res = ",bus=pci.$bus,addr=$addr";
4189            $bridges->{$bus} = 1 if $bridges;
4190     }
4191     return $res;
4192
4193 }
4194
4195 sub print_pcie_addr {
4196     my ($id) = @_;
4197
4198     my $res = '';
4199     my $devices = {
4200         hostpci0 => { bus => "ich9-pcie-port-1", addr => 0 },
4201         hostpci1 => { bus => "ich9-pcie-port-2", addr => 0 },
4202         hostpci2 => { bus => "ich9-pcie-port-3", addr => 0 },
4203         hostpci3 => { bus => "ich9-pcie-port-4", addr => 0 },
4204     };
4205
4206     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
4207            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
4208            my $bus = $devices->{$id}->{bus};
4209            $res = ",bus=$bus,addr=$addr";
4210     }
4211     return $res;
4212
4213 }
4214
4215 # vzdump restore implementaion
4216
4217 sub tar_archive_read_firstfile {
4218     my $archive = shift;
4219
4220     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
4221
4222     # try to detect archive type first
4223     my $pid = open (TMP, "tar tf '$archive'|") ||
4224         die "unable to open file '$archive'\n";
4225     my $firstfile = <TMP>;
4226     kill 15, $pid;
4227     close TMP;
4228
4229     die "ERROR: archive contaions no data\n" if !$firstfile;
4230     chomp $firstfile;
4231
4232     return $firstfile;
4233 }
4234
4235 sub tar_restore_cleanup {
4236     my ($storecfg, $statfile) = @_;
4237
4238     print STDERR "starting cleanup\n";
4239
4240     if (my $fd = IO::File->new($statfile, "r")) {
4241         while (defined(my $line = <$fd>)) {
4242             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4243                 my $volid = $2;
4244                 eval {
4245                     if ($volid =~ m|^/|) {
4246                         unlink $volid || die 'unlink failed\n';
4247                     } else {
4248                         PVE::Storage::vdisk_free($storecfg, $volid);
4249                     }
4250                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
4251                 };
4252                 print STDERR "unable to cleanup '$volid' - $@" if $@;
4253             } else {
4254                 print STDERR "unable to parse line in statfile - $line";
4255             }
4256         }
4257         $fd->close();
4258     }
4259 }
4260
4261 sub restore_archive {
4262     my ($archive, $vmid, $user, $opts) = @_;
4263
4264     my $format = $opts->{format};
4265     my $comp;
4266
4267     if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
4268         $format = 'tar' if !$format;
4269         $comp = 'gzip';
4270     } elsif ($archive =~ m/\.tar$/) {
4271         $format = 'tar' if !$format;
4272     } elsif ($archive =~ m/.tar.lzo$/) {
4273         $format = 'tar' if !$format;
4274         $comp = 'lzop';
4275     } elsif ($archive =~ m/\.vma$/) {
4276         $format = 'vma' if !$format;
4277     } elsif ($archive =~ m/\.vma\.gz$/) {
4278         $format = 'vma' if !$format;
4279         $comp = 'gzip';
4280     } elsif ($archive =~ m/\.vma\.lzo$/) {
4281         $format = 'vma' if !$format;
4282         $comp = 'lzop';
4283     } else {
4284         $format = 'vma' if !$format; # default
4285     }
4286
4287     # try to detect archive format
4288     if ($format eq 'tar') {
4289         return restore_tar_archive($archive, $vmid, $user, $opts);
4290     } else {
4291         return restore_vma_archive($archive, $vmid, $user, $opts, $comp);
4292     }
4293 }
4294
4295 sub restore_update_config_line {
4296     my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
4297
4298     return if $line =~ m/^\#qmdump\#/;
4299     return if $line =~ m/^\#vzdump\#/;
4300     return if $line =~ m/^lock:/;
4301     return if $line =~ m/^unused\d+:/;
4302     return if $line =~ m/^parent:/;
4303     return if $line =~ m/^template:/; # restored VM is never a template
4304
4305     if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
4306         # try to convert old 1.X settings
4307         my ($id, $ind, $ethcfg) = ($1, $2, $3);
4308         foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
4309             my ($model, $macaddr) = split(/\=/, $devconfig);
4310             $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $unique;
4311             my $net = {
4312                 model => $model,
4313                 bridge => "vmbr$ind",
4314                 macaddr => $macaddr,
4315             };
4316             my $netstr = print_net($net);
4317
4318             print $outfd "net$cookie->{netcount}: $netstr\n";
4319             $cookie->{netcount}++;
4320         }
4321     } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
4322         my ($id, $netstr) = ($1, $2);
4323         my $net = parse_net($netstr);
4324         $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
4325         $netstr = print_net($net);
4326         print $outfd "$id: $netstr\n";
4327     } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
4328         my $virtdev = $1;
4329         my $value = $3;
4330         if ($line =~ m/backup=no/) {
4331             print $outfd "#$line";
4332         } elsif ($virtdev && $map->{$virtdev}) {
4333             my $di = parse_drive($virtdev, $value);
4334             delete $di->{format}; # format can change on restore
4335             $di->{file} = $map->{$virtdev};
4336             $value = print_drive($vmid, $di);
4337             print $outfd "$virtdev: $value\n";
4338         } else {
4339             print $outfd $line;
4340         }
4341     } else {
4342         print $outfd $line;
4343     }
4344 }
4345
4346 sub scan_volids {
4347     my ($cfg, $vmid) = @_;
4348
4349     my $info = PVE::Storage::vdisk_list($cfg, undef, $vmid);
4350
4351     my $volid_hash = {};
4352     foreach my $storeid (keys %$info) {
4353         foreach my $item (@{$info->{$storeid}}) {
4354             next if !($item->{volid} && $item->{size});
4355             $item->{path} = PVE::Storage::path($cfg, $item->{volid});
4356             $volid_hash->{$item->{volid}} = $item;
4357         }
4358     }
4359
4360     return $volid_hash;
4361 }
4362
4363 sub get_used_paths {
4364     my ($vmid, $storecfg, $conf, $scan_snapshots, $skip_drive) = @_;
4365
4366     my $used_path = {};
4367
4368     my $scan_config = sub {
4369         my ($cref, $snapname) = @_;
4370
4371         foreach my $key (keys %$cref) {
4372             my $value = $cref->{$key};
4373             if (valid_drivename($key)) {
4374                 next if $skip_drive && $key eq $skip_drive;
4375                 my $drive = parse_drive($key, $value);
4376                 next if !$drive || !$drive->{file} || drive_is_cdrom($drive);
4377                 if ($drive->{file} =~ m!^/!) {
4378                     $used_path->{$drive->{file}}++; # = 1;
4379                 } else {
4380                     my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file}, 1);
4381                     next if !$storeid;
4382                     my $scfg = PVE::Storage::storage_config($storecfg, $storeid, 1);
4383                     next if !$scfg;
4384                     my $path = PVE::Storage::path($storecfg, $drive->{file}, $snapname);
4385                     $used_path->{$path}++; # = 1;
4386                 }
4387             }
4388         }
4389     };
4390
4391     &$scan_config($conf);
4392
4393     undef $skip_drive;
4394
4395     if ($scan_snapshots) {
4396         foreach my $snapname (keys %{$conf->{snapshots}}) {
4397             &$scan_config($conf->{snapshots}->{$snapname}, $snapname);
4398         }
4399     }
4400
4401     return $used_path;
4402 }
4403
4404 sub update_disksize {
4405     my ($vmid, $conf, $volid_hash) = @_;
4406
4407     my $changes;
4408
4409     my $used = {};
4410
4411     # Note: it is allowed to define multiple storages with same path (alias), so
4412     # we need to check both 'volid' and real 'path' (two different volid can point
4413     # to the same path).
4414
4415     my $usedpath = {};
4416
4417     # update size info
4418     foreach my $opt (keys %$conf) {
4419         if (valid_drivename($opt)) {
4420             my $drive = parse_drive($opt, $conf->{$opt});
4421             my $volid = $drive->{file};
4422             next if !$volid;
4423
4424             $used->{$volid} = 1;
4425             if ($volid_hash->{$volid} &&
4426                 (my $path = $volid_hash->{$volid}->{path})) {
4427                 $usedpath->{$path} = 1;
4428             }
4429
4430             next if drive_is_cdrom($drive);
4431             next if !$volid_hash->{$volid};
4432
4433             $drive->{size} = $volid_hash->{$volid}->{size};
4434             my $new = print_drive($vmid, $drive);
4435             if ($new ne $conf->{$opt}) {
4436                 $changes = 1;
4437                 $conf->{$opt} = $new;
4438             }
4439         }
4440     }
4441
4442     # remove 'unusedX' entry if volume is used
4443     foreach my $opt (keys %$conf) {
4444         next if $opt !~ m/^unused\d+$/;
4445         my $volid = $conf->{$opt};
4446         my $path = $volid_hash->{$volid}->{path} if $volid_hash->{$volid};
4447         if ($used->{$volid} || ($path && $usedpath->{$path})) {
4448             $changes = 1;
4449             delete $conf->{$opt};
4450         }
4451     }
4452
4453     foreach my $volid (sort keys %$volid_hash) {
4454         next if $volid =~ m/vm-$vmid-state-/;
4455         next if $used->{$volid};
4456         my $path = $volid_hash->{$volid}->{path};
4457         next if !$path; # just to be sure
4458         next if $usedpath->{$path};
4459         $changes = 1;
4460         add_unused_volume($conf, $volid);
4461         $usedpath->{$path} = 1; # avoid to add more than once (aliases)
4462     }
4463
4464     return $changes;
4465 }
4466
4467 sub rescan {
4468     my ($vmid, $nolock) = @_;
4469
4470     my $cfg = PVE::Cluster::cfs_read_file("storage.cfg");
4471
4472     my $volid_hash = scan_volids($cfg, $vmid);
4473
4474     my $updatefn =  sub {
4475         my ($vmid) = @_;
4476
4477         my $conf = load_config($vmid);
4478
4479         check_lock($conf);
4480
4481         my $vm_volids = {};
4482         foreach my $volid (keys %$volid_hash) {
4483             my $info = $volid_hash->{$volid};
4484             $vm_volids->{$volid} = $info if $info->{vmid} && $info->{vmid} == $vmid;
4485         }
4486
4487         my $changes = update_disksize($vmid, $conf, $vm_volids);
4488
4489         update_config_nolock($vmid, $conf, 1) if $changes;
4490     };
4491
4492     if (defined($vmid)) {
4493         if ($nolock) {
4494             &$updatefn($vmid);
4495         } else {
4496             lock_config($vmid, $updatefn, $vmid);
4497         }
4498     } else {
4499         my $vmlist = config_list();
4500         foreach my $vmid (keys %$vmlist) {
4501             if ($nolock) {
4502                 &$updatefn($vmid);
4503             } else {
4504                 lock_config($vmid, $updatefn, $vmid);
4505             }
4506         }
4507     }
4508 }
4509
4510 sub restore_vma_archive {
4511     my ($archive, $vmid, $user, $opts, $comp) = @_;
4512
4513     my $input = $archive eq '-' ? "<&STDIN" : undef;
4514     my $readfrom = $archive;
4515
4516     my $uncomp = '';
4517     if ($comp) {
4518         $readfrom = '-';
4519         my $qarchive = PVE::Tools::shellquote($archive);
4520         if ($comp eq 'gzip') {
4521             $uncomp = "zcat $qarchive|";
4522         } elsif ($comp eq 'lzop') {
4523             $uncomp = "lzop -d -c $qarchive|";
4524         } else {
4525             die "unknown compression method '$comp'\n";
4526         }
4527
4528     }
4529
4530     my $tmpdir = "/var/tmp/vzdumptmp$$";
4531     rmtree $tmpdir;
4532
4533     # disable interrupts (always do cleanups)
4534     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
4535         warn "got interrupt - ignored\n";
4536     };
4537
4538     my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
4539     POSIX::mkfifo($mapfifo, 0600);
4540     my $fifofh;
4541
4542     my $openfifo = sub {
4543         open($fifofh, '>', $mapfifo) || die $!;
4544     };
4545
4546     my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
4547
4548     my $oldtimeout;
4549     my $timeout = 5;
4550
4551     my $devinfo = {};
4552
4553     my $rpcenv = PVE::RPCEnvironment::get();
4554
4555     my $conffile = config_file($vmid);
4556     my $tmpfn = "$conffile.$$.tmp";
4557
4558     # Note: $oldconf is undef if VM does not exists
4559     my $oldconf = PVE::Cluster::cfs_read_file(cfs_config_path($vmid));
4560
4561     my $print_devmap = sub {
4562         my $virtdev_hash = {};
4563
4564         my $cfgfn = "$tmpdir/qemu-server.conf";
4565
4566         # we can read the config - that is already extracted
4567         my $fh = IO::File->new($cfgfn, "r") ||
4568             "unable to read qemu-server.conf - $!\n";
4569
4570         while (defined(my $line = <$fh>)) {
4571             if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
4572                 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
4573                 die "archive does not contain data for drive '$virtdev'\n"
4574                     if !$devinfo->{$devname};
4575                 if (defined($opts->{storage})) {
4576                     $storeid = $opts->{storage} || 'local';
4577                 } elsif (!$storeid) {
4578                     $storeid = 'local';
4579                 }
4580                 $format = 'raw' if !$format;
4581                 $devinfo->{$devname}->{devname} = $devname;
4582                 $devinfo->{$devname}->{virtdev} = $virtdev;
4583                 $devinfo->{$devname}->{format} = $format;
4584                 $devinfo->{$devname}->{storeid} = $storeid;
4585
4586                 # check permission on storage
4587                 my $pool = $opts->{pool}; # todo: do we need that?
4588                 if ($user ne 'root@pam') {
4589                     $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
4590                 }
4591
4592                 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
4593             }
4594         }
4595
4596         foreach my $devname (keys %$devinfo) {
4597             die "found no device mapping information for device '$devname'\n"
4598                 if !$devinfo->{$devname}->{virtdev};
4599         }
4600
4601         my $cfg = cfs_read_file('storage.cfg');
4602
4603         # create empty/temp config
4604         if ($oldconf) {
4605             PVE::Tools::file_set_contents($conffile, "memory: 128\n");
4606             foreach_drive($oldconf, sub {
4607                 my ($ds, $drive) = @_;
4608
4609                 return if drive_is_cdrom($drive);
4610
4611                 my $volid = $drive->{file};
4612
4613                 return if !$volid || $volid =~ m|^/|;
4614
4615                 my ($path, $owner) = PVE::Storage::path($cfg, $volid);
4616                 return if !$path || !$owner || ($owner != $vmid);
4617
4618                 # Note: only delete disk we want to restore
4619                 # other volumes will become unused
4620                 if ($virtdev_hash->{$ds}) {
4621                     PVE::Storage::vdisk_free($cfg, $volid);
4622                 }
4623             });
4624         }
4625
4626         my $map = {};
4627         foreach my $virtdev (sort keys %$virtdev_hash) {
4628             my $d = $virtdev_hash->{$virtdev};
4629             my $alloc_size = int(($d->{size} + 1024 - 1)/1024);
4630             my $scfg = PVE::Storage::storage_config($cfg, $d->{storeid});
4631
4632             # test if requested format is supported
4633             my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($cfg, $d->{storeid});
4634             my $supported = grep { $_ eq $d->{format} } @$validFormats;
4635             $d->{format} = $defFormat if !$supported;
4636
4637             my $volid = PVE::Storage::vdisk_alloc($cfg, $d->{storeid}, $vmid,
4638                                                   $d->{format}, undef, $alloc_size);
4639             print STDERR "new volume ID is '$volid'\n";
4640             $d->{volid} = $volid;
4641             my $path = PVE::Storage::path($cfg, $volid);
4642
4643             my $write_zeros = 1;
4644             # fixme: what other storages types initialize volumes with zero?
4645             if ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs' || $scfg->{type} eq 'glusterfs' ||
4646                 $scfg->{type} eq 'sheepdog' || $scfg->{type} eq 'rbd') {
4647                 $write_zeros = 0;
4648             }
4649
4650             print $fifofh "${write_zeros}:$d->{devname}=$path\n";
4651
4652             print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
4653             $map->{$virtdev} = $volid;
4654         }
4655
4656         $fh->seek(0, 0) || die "seek failed - $!\n";
4657
4658         my $outfd = new IO::File ($tmpfn, "w") ||
4659             die "unable to write config for VM $vmid\n";
4660
4661         my $cookie = { netcount => 0 };
4662         while (defined(my $line = <$fh>)) {
4663             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
4664         }
4665
4666         $fh->close();
4667         $outfd->close();
4668     };
4669
4670     eval {
4671         # enable interrupts
4672         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
4673             die "interrupted by signal\n";
4674         };
4675         local $SIG{ALRM} = sub { die "got timeout\n"; };
4676
4677         $oldtimeout = alarm($timeout);
4678
4679         my $parser = sub {
4680             my $line = shift;
4681
4682             print "$line\n";
4683
4684             if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
4685                 my ($dev_id, $size, $devname) = ($1, $2, $3);
4686                 $devinfo->{$devname} = { size => $size, dev_id => $dev_id };
4687             } elsif ($line =~ m/^CTIME: /) {
4688                 # we correctly received the vma config, so we can disable
4689                 # the timeout now for disk allocation (set to 10 minutes, so
4690                 # that we always timeout if something goes wrong)
4691                 alarm(600);
4692                 &$print_devmap();
4693                 print $fifofh "done\n";
4694                 my $tmp = $oldtimeout || 0;
4695                 $oldtimeout = undef;
4696                 alarm($tmp);
4697                 close($fifofh);
4698             }
4699         };
4700
4701         print "restore vma archive: $cmd\n";
4702         run_command($cmd, input => $input, outfunc => $parser, afterfork => $openfifo);
4703     };
4704     my $err = $@;
4705
4706     alarm($oldtimeout) if $oldtimeout;
4707
4708     unlink $mapfifo;
4709
4710     if ($err) {
4711         rmtree $tmpdir;
4712         unlink $tmpfn;
4713
4714         my $cfg = cfs_read_file('storage.cfg');
4715         foreach my $devname (keys %$devinfo) {
4716             my $volid = $devinfo->{$devname}->{volid};
4717             next if !$volid;
4718             eval {
4719                 if ($volid =~ m|^/|) {
4720                     unlink $volid || die 'unlink failed\n';
4721                 } else {
4722                     PVE::Storage::vdisk_free($cfg, $volid);
4723                 }
4724                 print STDERR "temporary volume '$volid' sucessfuly removed\n";
4725             };
4726             print STDERR "unable to cleanup '$volid' - $@" if $@;
4727         }
4728         die $err;
4729     }
4730
4731     rmtree $tmpdir;
4732
4733     rename($tmpfn, $conffile) ||
4734         die "unable to commit configuration file '$conffile'\n";
4735
4736     PVE::Cluster::cfs_update(); # make sure we read new file
4737
4738     eval { rescan($vmid, 1); };
4739     warn $@ if $@;
4740 }
4741
4742 sub restore_tar_archive {
4743     my ($archive, $vmid, $user, $opts) = @_;
4744
4745     if ($archive ne '-') {
4746         my $firstfile = tar_archive_read_firstfile($archive);
4747         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
4748             if $firstfile ne 'qemu-server.conf';
4749     }
4750
4751     my $storecfg = cfs_read_file('storage.cfg');
4752
4753     # destroy existing data - keep empty config
4754     my $vmcfgfn = PVE::QemuServer::config_file($vmid);
4755     destroy_vm($storecfg, $vmid, 1) if -f $vmcfgfn;
4756
4757     my $tocmd = "/usr/lib/qemu-server/qmextract";
4758
4759     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
4760     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
4761     $tocmd .= ' --prealloc' if $opts->{prealloc};
4762     $tocmd .= ' --info' if $opts->{info};
4763
4764     # tar option "xf" does not autodetect compression when read from STDIN,
4765     # so we pipe to zcat
4766     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
4767         PVE::Tools::shellquote("--to-command=$tocmd");
4768
4769     my $tmpdir = "/var/tmp/vzdumptmp$$";
4770     mkpath $tmpdir;
4771
4772     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
4773     local $ENV{VZDUMP_VMID} = $vmid;
4774     local $ENV{VZDUMP_USER} = $user;
4775
4776     my $conffile = config_file($vmid);
4777     my $tmpfn = "$conffile.$$.tmp";
4778
4779     # disable interrupts (always do cleanups)
4780     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
4781         print STDERR "got interrupt - ignored\n";
4782     };
4783
4784     eval {
4785         # enable interrupts
4786         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
4787             die "interrupted by signal\n";
4788         };
4789
4790         if ($archive eq '-') {
4791             print "extracting archive from STDIN\n";
4792             run_command($cmd, input => "<&STDIN");
4793         } else {
4794             print "extracting archive '$archive'\n";
4795             run_command($cmd);
4796         }
4797
4798         return if $opts->{info};
4799
4800         # read new mapping
4801         my $map = {};
4802         my $statfile = "$tmpdir/qmrestore.stat";
4803         if (my $fd = IO::File->new($statfile, "r")) {
4804             while (defined (my $line = <$fd>)) {
4805                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4806                     $map->{$1} = $2 if $1;
4807                 } else {
4808                     print STDERR "unable to parse line in statfile - $line\n";
4809                 }
4810             }
4811             $fd->close();
4812         }
4813
4814         my $confsrc = "$tmpdir/qemu-server.conf";
4815
4816         my $srcfd = new IO::File($confsrc, "r") ||
4817             die "unable to open file '$confsrc'\n";
4818
4819         my $outfd = new IO::File ($tmpfn, "w") ||
4820             die "unable to write config for VM $vmid\n";
4821
4822         my $cookie = { netcount => 0 };
4823         while (defined (my $line = <$srcfd>)) {
4824             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
4825         }
4826
4827         $srcfd->close();
4828         $outfd->close();
4829     };
4830     my $err = $@;
4831
4832     if ($err) {
4833
4834         unlink $tmpfn;
4835
4836         tar_restore_cleanup($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info};
4837
4838         die $err;
4839     }
4840
4841     rmtree $tmpdir;
4842
4843     rename $tmpfn, $conffile ||
4844         die "unable to commit configuration file '$conffile'\n";
4845
4846     PVE::Cluster::cfs_update(); # make sure we read new file
4847
4848     eval { rescan($vmid, 1); };
4849     warn $@ if $@;
4850 };
4851
4852
4853 # Internal snapshots
4854
4855 # NOTE: Snapshot create/delete involves several non-atomic
4856 # action, and can take a long time.
4857 # So we try to avoid locking the file and use 'lock' variable
4858 # inside the config file instead.
4859
4860 my $snapshot_copy_config = sub {
4861     my ($source, $dest) = @_;
4862
4863     foreach my $k (keys %$source) {
4864         next if $k eq 'snapshots';
4865         next if $k eq 'snapstate';
4866         next if $k eq 'snaptime';
4867         next if $k eq 'vmstate';
4868         next if $k eq 'lock';
4869         next if $k eq 'digest';
4870         next if $k eq 'description';
4871         next if $k =~ m/^unused\d+$/;
4872
4873         $dest->{$k} = $source->{$k};
4874     }
4875 };
4876
4877 my $snapshot_apply_config = sub {
4878     my ($conf, $snap) = @_;
4879
4880     # copy snapshot list
4881     my $newconf = {
4882         snapshots => $conf->{snapshots},
4883     };
4884
4885     # keep description and list of unused disks
4886     foreach my $k (keys %$conf) {
4887         next if !($k =~ m/^unused\d+$/ || $k eq 'description');
4888         $newconf->{$k} = $conf->{$k};
4889     }
4890
4891     &$snapshot_copy_config($snap, $newconf);
4892
4893     return $newconf;
4894 };
4895
4896 sub foreach_writable_storage {
4897     my ($conf, $func) = @_;
4898
4899     my $sidhash = {};
4900
4901     foreach my $ds (keys %$conf) {
4902         next if !valid_drivename($ds);
4903
4904         my $drive = parse_drive($ds, $conf->{$ds});
4905         next if !$drive;
4906         next if drive_is_cdrom($drive);
4907
4908         my $volid = $drive->{file};
4909
4910         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
4911         $sidhash->{$sid} = $sid if $sid;
4912     }
4913
4914     foreach my $sid (sort keys %$sidhash) {
4915         &$func($sid);
4916     }
4917 }
4918
4919 my $alloc_vmstate_volid = sub {
4920     my ($storecfg, $vmid, $conf, $snapname) = @_;
4921
4922     # Note: we try to be smart when selecting a $target storage
4923
4924     my $target;
4925
4926     # search shared storage first
4927     foreach_writable_storage($conf, sub {
4928         my ($sid) = @_;
4929         my $scfg = PVE::Storage::storage_config($storecfg, $sid);
4930         return if !$scfg->{shared};
4931
4932         $target = $sid if !$target || $scfg->{path}; # prefer file based storage
4933     });
4934
4935     if (!$target) {
4936         # now search local storage
4937         foreach_writable_storage($conf, sub {
4938             my ($sid) = @_;
4939             my $scfg = PVE::Storage::storage_config($storecfg, $sid);
4940             return if $scfg->{shared};
4941
4942             $target = $sid if !$target || $scfg->{path}; # prefer file based storage;
4943         });
4944     }
4945
4946     $target = 'local' if !$target;
4947
4948     my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
4949     # we abort live save after $conf->{memory}, so we need at max twice that space
4950     my $size = $conf->{memory}*2 + $driver_state_size;
4951
4952     my $name = "vm-$vmid-state-$snapname";
4953     my $scfg = PVE::Storage::storage_config($storecfg, $target);
4954     $name .= ".raw" if $scfg->{path}; # add filename extension for file base storage
4955     my $volid = PVE::Storage::vdisk_alloc($storecfg, $target, $vmid, 'raw', $name, $size*1024);
4956
4957     return $volid;
4958 };
4959
4960 my $snapshot_prepare = sub {
4961     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
4962
4963     my $snap;
4964
4965     my $updatefn =  sub {
4966
4967         my $conf = load_config($vmid);
4968
4969         die "you can't take a snapshot if it's a template\n"
4970             if is_template($conf);
4971
4972         check_lock($conf);
4973
4974         $conf->{lock} = 'snapshot';
4975
4976         die "snapshot name '$snapname' already used\n"
4977             if defined($conf->{snapshots}->{$snapname});
4978
4979         my $storecfg = PVE::Storage::config();
4980         die "snapshot feature is not available" if !has_feature('snapshot', $conf, $storecfg);
4981
4982         $snap = $conf->{snapshots}->{$snapname} = {};
4983
4984         if ($save_vmstate && check_running($vmid)) {
4985             $snap->{vmstate} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
4986         }
4987
4988         &$snapshot_copy_config($conf, $snap);
4989
4990         $snap->{snapstate} = "prepare";
4991         $snap->{snaptime} = time();
4992         $snap->{description} = $comment if $comment;
4993
4994         # always overwrite machine if we save vmstate. This makes sure we
4995         # can restore it later using correct machine type
4996         $snap->{machine} = get_current_qemu_machine($vmid) if $snap->{vmstate};
4997
4998         update_config_nolock($vmid, $conf, 1);
4999     };
5000
5001     lock_config($vmid, $updatefn);
5002
5003     return $snap;
5004 };
5005
5006 my $snapshot_commit = sub {
5007     my ($vmid, $snapname) = @_;
5008
5009     my $updatefn = sub {
5010
5011         my $conf = load_config($vmid);
5012
5013         die "missing snapshot lock\n"
5014             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
5015
5016         my $has_machine_config = defined($conf->{machine});
5017
5018         my $snap = $conf->{snapshots}->{$snapname};
5019
5020         die "snapshot '$snapname' does not exist\n" if !defined($snap);
5021
5022         die "wrong snapshot state\n"
5023             if !($snap->{snapstate} && $snap->{snapstate} eq "prepare");
5024
5025         delete $snap->{snapstate};
5026         delete $conf->{lock};
5027
5028         my $newconf = &$snapshot_apply_config($conf, $snap);
5029
5030         delete $newconf->{machine} if !$has_machine_config;
5031
5032         $newconf->{parent} = $snapname;
5033
5034         update_config_nolock($vmid, $newconf, 1);
5035     };
5036
5037     lock_config($vmid, $updatefn);
5038 };
5039
5040 sub snapshot_rollback {
5041     my ($vmid, $snapname) = @_;
5042
5043     my $snap;
5044
5045     my $prepare = 1;
5046
5047     my $storecfg = PVE::Storage::config();
5048
5049     my $updatefn = sub {
5050
5051         my $conf = load_config($vmid);
5052
5053         die "you can't rollback if vm is a template\n" if is_template($conf);
5054
5055         $snap = $conf->{snapshots}->{$snapname};
5056
5057         die "snapshot '$snapname' does not exist\n" if !defined($snap);
5058
5059         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
5060             if $snap->{snapstate};
5061
5062         if ($prepare) {
5063             check_lock($conf);
5064             vm_stop($storecfg, $vmid, undef, undef, 5, undef, undef);
5065         }
5066
5067         die "unable to rollback vm $vmid: vm is running\n"
5068             if check_running($vmid);
5069
5070         if ($prepare) {
5071             $conf->{lock} = 'rollback';
5072         } else {
5073             die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
5074             delete $conf->{lock};
5075         }
5076
5077         my $forcemachine;
5078
5079         if (!$prepare) {
5080             my $has_machine_config = defined($conf->{machine});
5081
5082             # copy snapshot config to current config
5083             $conf = &$snapshot_apply_config($conf, $snap);
5084             $conf->{parent} = $snapname;
5085
5086             # Note: old code did not store 'machine', so we try to be smart
5087             # and guess the snapshot was generated with kvm 1.4 (pc-i440fx-1.4).
5088             $forcemachine = $conf->{machine} || 'pc-i440fx-1.4';
5089             # we remove the 'machine' configuration if not explicitly specified
5090             # in the original config.
5091             delete $conf->{machine} if $snap->{vmstate} && !$has_machine_config;
5092         }
5093
5094         update_config_nolock($vmid, $conf, 1);
5095
5096         if (!$prepare && $snap->{vmstate}) {
5097             my $statefile = PVE::Storage::path($storecfg, $snap->{vmstate});
5098             vm_start($storecfg, $vmid, $statefile, undef, undef, undef, $forcemachine);
5099         }
5100     };
5101
5102     lock_config($vmid, $updatefn);
5103
5104     foreach_drive($snap, sub {
5105         my ($ds, $drive) = @_;
5106
5107         return if drive_is_cdrom($drive);
5108
5109         my $volid = $drive->{file};
5110         my $device = "drive-$ds";
5111
5112         PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
5113     });
5114
5115     $prepare = 0;
5116     lock_config($vmid, $updatefn);
5117 }
5118
5119 my $savevm_wait = sub {
5120     my ($vmid) = @_;
5121
5122     for(;;) {
5123         my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
5124         if (!$stat->{status}) {
5125             die "savevm not active\n";
5126         } elsif ($stat->{status} eq 'active') {
5127             sleep(1);
5128             next;
5129         } elsif ($stat->{status} eq 'completed') {
5130             last;
5131         } else {
5132             die "query-savevm returned status '$stat->{status}'\n";
5133         }
5134     }
5135 };
5136
5137 sub snapshot_create {
5138     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
5139
5140     my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
5141
5142     $save_vmstate = 0 if !$snap->{vmstate}; # vm is not running
5143
5144     my $config = load_config($vmid);
5145
5146     my $running = check_running($vmid);
5147
5148     my $freezefs = $running && $config->{agent};
5149     $freezefs = 0 if $snap->{vmstate}; # not needed if we save RAM
5150
5151     my $drivehash = {};
5152
5153     if ($freezefs) {
5154         eval { vm_mon_cmd($vmid, "guest-fsfreeze-freeze"); };
5155         warn "guest-fsfreeze-freeze problems - $@" if $@;
5156     }
5157
5158     eval {
5159         # create internal snapshots of all drives
5160
5161         my $storecfg = PVE::Storage::config();
5162
5163         if ($running) {
5164             if ($snap->{vmstate}) {
5165                 my $path = PVE::Storage::path($storecfg, $snap->{vmstate});
5166                 vm_mon_cmd($vmid, "savevm-start", statefile => $path);
5167                 &$savevm_wait($vmid);
5168             } else {
5169                 vm_mon_cmd($vmid, "savevm-start");
5170             }
5171         };
5172
5173         foreach_drive($snap, sub {
5174             my ($ds, $drive) = @_;
5175
5176             return if drive_is_cdrom($drive);
5177
5178             my $volid = $drive->{file};
5179             my $device = "drive-$ds";
5180
5181             qemu_volume_snapshot($vmid, $device, $storecfg, $volid, $snapname);
5182             $drivehash->{$ds} = 1;
5183        });
5184     };
5185     my $err = $@;
5186
5187     if ($running) {
5188         eval { vm_mon_cmd($vmid, "savevm-end")  };
5189         warn $@ if $@;
5190
5191         if ($freezefs) {
5192             eval { vm_mon_cmd($vmid, "guest-fsfreeze-thaw"); };
5193             warn "guest-fsfreeze-thaw problems - $@" if $@;
5194         }
5195
5196         # savevm-end is async, we need to wait
5197         for (;;) {
5198             my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
5199             if (!$stat->{bytes}) {
5200                 last;
5201             } else {
5202                 print "savevm not yet finished\n";
5203                 sleep(1);
5204                 next;
5205             }
5206         }
5207     }
5208
5209     if ($err) {
5210         warn "snapshot create failed: starting cleanup\n";
5211         eval { snapshot_delete($vmid, $snapname, 0, $drivehash); };
5212         warn $@ if $@;
5213         die $err;
5214     }
5215
5216     &$snapshot_commit($vmid, $snapname);
5217 }
5218
5219 # Note: $drivehash is only set when called from snapshot_create.
5220 sub snapshot_delete {
5221     my ($vmid, $snapname, $force, $drivehash) = @_;
5222
5223     my $prepare = 1;
5224
5225     my $snap;
5226     my $unused = [];
5227
5228     my $unlink_parent = sub {
5229         my ($confref, $new_parent) = @_;
5230
5231         if ($confref->{parent} && $confref->{parent} eq $snapname) {
5232             if ($new_parent) {
5233                 $confref->{parent} = $new_parent;
5234             } else {
5235                 delete $confref->{parent};
5236             }
5237         }
5238     };
5239
5240     my $updatefn =  sub {
5241         my ($remove_drive) = @_;
5242
5243         my $conf = load_config($vmid);
5244
5245         if (!$drivehash) {
5246             check_lock($conf);
5247             die "you can't delete a snapshot if vm is a template\n"
5248                 if is_template($conf);
5249         }
5250
5251         $snap = $conf->{snapshots}->{$snapname};
5252
5253         die "snapshot '$snapname' does not exist\n" if !defined($snap);
5254
5255         # remove parent refs
5256         if (!$prepare) {
5257             &$unlink_parent($conf, $snap->{parent});
5258             foreach my $sn (keys %{$conf->{snapshots}}) {
5259                 next if $sn eq $snapname;
5260                 &$unlink_parent($conf->{snapshots}->{$sn}, $snap->{parent});
5261             }
5262         }
5263
5264         if ($remove_drive) {
5265             if ($remove_drive eq 'vmstate') {
5266                 delete $snap->{$remove_drive};
5267             } else {
5268                 my $drive = parse_drive($remove_drive, $snap->{$remove_drive});
5269                 my $volid = $drive->{file};
5270                 delete $snap->{$remove_drive};
5271                 add_unused_volume($conf, $volid);
5272             }
5273         }
5274
5275         if ($prepare) {
5276             $snap->{snapstate} = 'delete';
5277         } else {
5278             delete $conf->{snapshots}->{$snapname};
5279             delete $conf->{lock} if $drivehash;
5280             foreach my $volid (@$unused) {
5281                 add_unused_volume($conf, $volid);
5282             }
5283         }
5284
5285         update_config_nolock($vmid, $conf, 1);
5286     };
5287
5288     lock_config($vmid, $updatefn);
5289
5290     # now remove vmstate file
5291
5292     my $storecfg = PVE::Storage::config();
5293
5294     if ($snap->{vmstate}) {
5295         eval {  PVE::Storage::vdisk_free($storecfg, $snap->{vmstate}); };
5296         if (my $err = $@) {
5297             die $err if !$force;
5298             warn $err;
5299         }
5300         # save changes (remove vmstate from snapshot)
5301         lock_config($vmid, $updatefn, 'vmstate') if !$force;
5302     };
5303
5304     # now remove all internal snapshots
5305     foreach_drive($snap, sub {
5306         my ($ds, $drive) = @_;
5307
5308         return if drive_is_cdrom($drive);
5309
5310         my $volid = $drive->{file};
5311         my $device = "drive-$ds";
5312
5313         if (!$drivehash || $drivehash->{$ds}) {
5314             eval { qemu_volume_snapshot_delete($vmid, $device, $storecfg, $volid, $snapname); };
5315             if (my $err = $@) {
5316                 die $err if !$force;
5317                 warn $err;
5318             }
5319         }
5320
5321         # save changes (remove drive fron snapshot)
5322         lock_config($vmid, $updatefn, $ds) if !$force;
5323         push @$unused, $volid;
5324     });
5325
5326     # now cleanup config
5327     $prepare = 0;
5328     lock_config($vmid, $updatefn);
5329 }
5330
5331 sub has_feature {
5332     my ($feature, $conf, $storecfg, $snapname, $running) = @_;
5333
5334     my $err;
5335     foreach_drive($conf, sub {
5336         my ($ds, $drive) = @_;
5337
5338         return if drive_is_cdrom($drive);
5339         my $volid = $drive->{file};
5340         $err = 1 if !PVE::Storage::volume_has_feature($storecfg, $feature, $volid, $snapname, $running);
5341     });
5342
5343     return $err ? 0 : 1;
5344 }
5345
5346 sub template_create {
5347     my ($vmid, $conf, $disk) = @_;
5348
5349     my $storecfg = PVE::Storage::config();
5350
5351     foreach_drive($conf, sub {
5352         my ($ds, $drive) = @_;
5353
5354         return if drive_is_cdrom($drive);
5355         return if $disk && $ds ne $disk;
5356
5357         my $volid = $drive->{file};
5358         return if !PVE::Storage::volume_has_feature($storecfg, 'template', $volid);
5359
5360         my $voliddst = PVE::Storage::vdisk_create_base($storecfg, $volid);
5361         $drive->{file} = $voliddst;
5362         $conf->{$ds} = print_drive($vmid, $drive);
5363         update_config_nolock($vmid, $conf, 1);
5364     });
5365 }
5366
5367 sub is_template {
5368     my ($conf) = @_;
5369
5370     return 1 if defined $conf->{template} && $conf->{template} == 1;
5371 }
5372
5373 sub qemu_img_convert {
5374     my ($src_volid, $dst_volid, $size, $snapname) = @_;
5375
5376     my $storecfg = PVE::Storage::config();
5377     my ($src_storeid, $src_volname) = PVE::Storage::parse_volume_id($src_volid, 1);
5378     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
5379
5380     if ($src_storeid && $dst_storeid) {
5381         my $src_scfg = PVE::Storage::storage_config($storecfg, $src_storeid);
5382         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
5383
5384         my $src_format = qemu_img_format($src_scfg, $src_volname);
5385         my $dst_format = qemu_img_format($dst_scfg, $dst_volname);
5386
5387         my $src_path = PVE::Storage::path($storecfg, $src_volid, $snapname);
5388         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
5389
5390         my $cmd = [];
5391         push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-n';
5392         push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
5393         push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
5394
5395         my $parser = sub {
5396             my $line = shift;
5397             if($line =~ m/\((\S+)\/100\%\)/){
5398                 my $percent = $1;
5399                 my $transferred = int($size * $percent / 100);
5400                 my $remaining = $size - $transferred;
5401
5402                 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
5403             }
5404
5405         };
5406
5407         eval  { run_command($cmd, timeout => undef, outfunc => $parser); };
5408         my $err = $@;
5409         die "copy failed: $err" if $err;
5410     }
5411 }
5412
5413 sub qemu_img_format {
5414     my ($scfg, $volname) = @_;
5415
5416     if ($scfg->{path} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/) {
5417         return $1;
5418     } elsif ($scfg->{type} eq 'iscsi') {
5419         return "host_device";
5420     } else {
5421         return "raw";
5422     }
5423 }
5424
5425 sub qemu_drive_mirror {
5426     my ($vmid, $drive, $dst_volid, $vmiddst) = @_;
5427
5428     my $count = 0;
5429     my $old_len = 0;
5430     my $frozen = undef;
5431     my $maxwait = 120;
5432
5433     my $storecfg = PVE::Storage::config();
5434     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid);
5435
5436     my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
5437
5438     my $format;
5439     if ($dst_volname =~ m/\.(raw|qcow2)$/){
5440         $format = $1;
5441     }
5442
5443     my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
5444
5445     my $opts = { timeout => 10, device => "drive-$drive", mode => "existing", sync => "full", target => $dst_path };
5446     $opts->{format} = $format if $format;
5447
5448     #fixme : sometime drive-mirror timeout, but works fine after.
5449     # (I have see the problem with big volume > 200GB), so we need to eval
5450     eval { vm_mon_cmd($vmid, "drive-mirror", %$opts); };
5451     # ignore errors here
5452
5453     eval {
5454         while (1) {
5455             my $stats = vm_mon_cmd($vmid, "query-block-jobs");
5456             my $stat = @$stats[0];
5457             die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
5458             die "error job is not mirroring" if $stat->{type} ne "mirror";
5459
5460             my $busy = $stat->{busy};
5461
5462             if (my $total = $stat->{len}) {
5463                 my $transferred = $stat->{offset} || 0;
5464                 my $remaining = $total - $transferred;
5465                 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
5466
5467                 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent % busy: $busy\n";
5468             }
5469
5470             if ($stat->{len} == $stat->{offset}) {
5471                 if ($busy eq 'false') {
5472
5473                     last if $vmiddst != $vmid;
5474
5475                     # try to switch the disk if source and destination are on the same guest
5476                     eval { vm_mon_cmd($vmid, "block-job-complete", device => "drive-$drive") };
5477                     last if !$@;
5478                     die $@ if $@ !~ m/cannot be completed/;
5479                 }
5480
5481                 if ($count > $maxwait) {
5482                     # if too much writes to disk occurs at the end of migration
5483                     #the disk needs to be freezed to be able to complete the migration
5484                     vm_suspend($vmid,1);
5485                     $frozen = 1;
5486                 }
5487                 $count ++
5488             }
5489             $old_len = $stat->{offset};
5490             sleep 1;
5491         }
5492
5493         vm_resume($vmid, 1) if $frozen;
5494
5495     };
5496     my $err = $@;
5497
5498     my $cancel_job = sub {
5499         vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive");
5500         while (1) {
5501             my $stats = vm_mon_cmd($vmid, "query-block-jobs");
5502             my $stat = @$stats[0];
5503             last if !$stat;
5504             sleep 1;
5505         }
5506     };
5507
5508     if ($err) {
5509         eval { &$cancel_job(); };
5510         die "mirroring error: $err";
5511     }
5512
5513     if ($vmiddst != $vmid) {
5514         # if we clone a disk for a new target vm, we don't switch the disk
5515         &$cancel_job(); # so we call block-job-cancel
5516     }
5517 }
5518
5519 sub clone_disk {
5520     my ($storecfg, $vmid, $running, $drivename, $drive, $snapname,
5521         $newvmid, $storage, $format, $full, $newvollist) = @_;
5522
5523     my $newvolid;
5524
5525     if (!$full) {
5526         print "create linked clone of drive $drivename ($drive->{file})\n";
5527         $newvolid = PVE::Storage::vdisk_clone($storecfg,  $drive->{file}, $newvmid, $snapname);
5528         push @$newvollist, $newvolid;
5529     } else {
5530         my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file});
5531         $storeid = $storage if $storage;
5532
5533         my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($storecfg, $storeid);
5534         if (!$format) {
5535             $format = $drive->{format} || $defFormat;
5536         }
5537
5538         # test if requested format is supported - else use default
5539         my $supported = grep { $_ eq $format } @$validFormats;
5540         $format = $defFormat if !$supported;
5541
5542         my ($size) = PVE::Storage::volume_size_info($storecfg, $drive->{file}, 3);
5543
5544         print "create full clone of drive $drivename ($drive->{file})\n";
5545         $newvolid = PVE::Storage::vdisk_alloc($storecfg, $storeid, $newvmid, $format, undef, ($size/1024));
5546         push @$newvollist, $newvolid;
5547
5548         if (!$running || $snapname) {
5549             qemu_img_convert($drive->{file}, $newvolid, $size, $snapname);
5550         } else {
5551             qemu_drive_mirror($vmid, $drivename, $newvolid, $newvmid);
5552         }
5553     }
5554
5555     my ($size) = PVE::Storage::volume_size_info($storecfg, $newvolid, 3);
5556
5557     my $disk = $drive;
5558     $disk->{format} = undef;
5559     $disk->{file} = $newvolid;
5560     $disk->{size} = $size;
5561
5562     return $disk;
5563 }
5564
5565 # this only works if VM is running
5566 sub get_current_qemu_machine {
5567     my ($vmid) = @_;
5568
5569     my $cmd = { execute => 'query-machines', arguments => {} };
5570     my $res = PVE::QemuServer::vm_qmp_command($vmid, $cmd);
5571
5572     my ($current, $default);
5573     foreach my $e (@$res) {
5574         $default = $e->{name} if $e->{'is-default'};
5575         $current = $e->{name} if $e->{'is-current'};
5576     }
5577
5578     # fallback to the default machine if current is not supported by qemu
5579     return $current || $default || 'pc';
5580 }
5581
5582 sub lspci {
5583
5584     my $devices = {};
5585
5586     dir_glob_foreach("$pcisysfs/devices", '[a-f0-9]{4}:([a-f0-9]{2}:[a-f0-9]{2})\.([0-9])', sub {
5587             my (undef, $id, $function) = @_;
5588             my $res = { id => $id, function => $function};
5589             push @{$devices->{$id}}, $res;
5590     });
5591
5592     return $devices;
5593 }
5594
5595 1;