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