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