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