PVE/QemuServer.pm

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