PVE/QemuServer.pm

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