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.",enforce";
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         push @$cap_ref, {
3153             capability => $supported_capability->{capability},
3154             state => $enabled_cap->{$supported_capability->{capability}} ? JSON::true : JSON::false,
3155         };
3156     }
3157
3158     vm_mon_cmd_nocheck($vmid, "migrate-set-capabilities", capabilities => $cap_ref);
3159 }
3160
3161 sub vm_start {
3162     my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused, $forcemachine, $spice_ticket) = @_;
3163
3164     lock_config($vmid, sub {
3165         my $conf = load_config($vmid, $migratedfrom);
3166
3167         die "you can't start a vm if it's a template\n" if is_template($conf);
3168
3169         check_lock($conf) if !$skiplock;
3170
3171         die "VM $vmid already running\n" if check_running($vmid, undef, $migratedfrom);
3172
3173         my $defaults = load_defaults();
3174
3175         # set environment variable useful inside network script
3176         $ENV{PVE_MIGRATED_FROM} = $migratedfrom if $migratedfrom;
3177
3178         my ($cmd, $vollist, $spice_port) = config_to_command($storecfg, $vmid, $conf, $defaults, $forcemachine);
3179
3180         my $migrate_port = 0;
3181         my $migrate_uri;
3182         if ($statefile) {
3183             if ($statefile eq 'tcp') {
3184                 my $localip = "localhost";
3185                 my $datacenterconf = PVE::Cluster::cfs_read_file('datacenter.cfg');
3186                 if ($datacenterconf->{migration_unsecure}) {
3187                         my $nodename = PVE::INotify::nodename();
3188                         $localip = PVE::Cluster::remote_node_ip($nodename, 1);
3189                 }
3190                 $migrate_port = PVE::Tools::next_migrate_port();
3191                 $migrate_uri = "tcp:${localip}:${migrate_port}";
3192                 push @$cmd, '-incoming', $migrate_uri;
3193                 push @$cmd, '-S';
3194             } else {
3195                 push @$cmd, '-loadstate', $statefile;
3196             }
3197         } elsif ($paused) {
3198             push @$cmd, '-S';
3199         }
3200
3201         # host pci devices
3202         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
3203           my $d = parse_hostpci($conf->{"hostpci$i"});
3204           next if !$d;
3205           my $info = pci_device_info("0000:$d->{pciid}");
3206           die "IOMMU not present\n" if !check_iommu_support();
3207           die "no pci device info for device '$d->{pciid}'\n" if !$info;
3208           die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub($info);
3209           die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset($info);
3210         }
3211
3212         PVE::Storage::activate_volumes($storecfg, $vollist);
3213
3214         eval  { run_command($cmd, timeout => $statefile ? undef : 30,
3215                     umask => 0077); };
3216         my $err = $@;
3217         die "start failed: $err" if $err;
3218
3219         print "migration listens on $migrate_uri\n" if $migrate_uri;
3220
3221         if ($statefile && $statefile ne 'tcp')  {
3222             eval { vm_mon_cmd_nocheck($vmid, "cont"); };
3223             warn $@ if $@;
3224         }
3225
3226         if ($migratedfrom) {
3227
3228             eval {
3229                 PVE::QemuServer::set_migration_caps($vmid);
3230             };
3231             warn $@ if $@;
3232
3233             if ($spice_port) {
3234                 print "spice listens on port $spice_port\n";
3235                 if ($spice_ticket) {
3236                     PVE::QemuServer::vm_mon_cmd_nocheck($vmid, "set_password", protocol => 'spice', password => $spice_ticket);
3237                     PVE::QemuServer::vm_mon_cmd_nocheck($vmid, "expire_password", protocol => 'spice', time => "+30");
3238                 }
3239             }
3240
3241         } else {
3242
3243             if (!$statefile && (!defined($conf->{balloon}) || $conf->{balloon})) {
3244                 vm_mon_cmd_nocheck($vmid, "balloon", value => $conf->{balloon}*1024*1024)
3245                     if $conf->{balloon};
3246                 vm_mon_cmd_nocheck($vmid, 'qom-set',
3247                             path => "machine/peripheral/balloon0",
3248                             property => "guest-stats-polling-interval",
3249                             value => 2);
3250             }
3251         }
3252     });
3253 }
3254
3255 sub vm_mon_cmd {
3256     my ($vmid, $execute, %params) = @_;
3257
3258     my $cmd = { execute => $execute, arguments => \%params };
3259     vm_qmp_command($vmid, $cmd);
3260 }
3261
3262 sub vm_mon_cmd_nocheck {
3263     my ($vmid, $execute, %params) = @_;
3264
3265     my $cmd = { execute => $execute, arguments => \%params };
3266     vm_qmp_command($vmid, $cmd, 1);
3267 }
3268
3269 sub vm_qmp_command {
3270     my ($vmid, $cmd, $nocheck) = @_;
3271
3272     my $res;
3273
3274     my $timeout;
3275     if ($cmd->{arguments} && $cmd->{arguments}->{timeout}) {
3276         $timeout = $cmd->{arguments}->{timeout};
3277         delete $cmd->{arguments}->{timeout};
3278     }
3279
3280     eval {
3281         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
3282         my $sname = qmp_socket($vmid);
3283         if (-e $sname) {
3284             my $qmpclient = PVE::QMPClient->new();
3285
3286             $res = $qmpclient->cmd($vmid, $cmd, $timeout);
3287         } elsif (-e "${var_run_tmpdir}/$vmid.mon") {
3288             die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
3289                 if scalar(%{$cmd->{arguments}});
3290             vm_monitor_command($vmid, $cmd->{execute}, $nocheck);
3291         } else {
3292             die "unable to open monitor socket\n";
3293         }
3294     };
3295     if (my $err = $@) {
3296         syslog("err", "VM $vmid qmp command failed - $err");
3297         die $err;
3298     }
3299
3300     return $res;
3301 }
3302
3303 sub vm_human_monitor_command {
3304     my ($vmid, $cmdline) = @_;
3305
3306     my $res;
3307
3308     my $cmd = {
3309         execute => 'human-monitor-command',
3310         arguments => { 'command-line' => $cmdline},
3311     };
3312
3313     return vm_qmp_command($vmid, $cmd);
3314 }
3315
3316 sub vm_commandline {
3317     my ($storecfg, $vmid) = @_;
3318
3319     my $conf = load_config($vmid);
3320
3321     my $defaults = load_defaults();
3322
3323     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
3324
3325     return join(' ', @$cmd);
3326 }
3327
3328 sub vm_reset {
3329     my ($vmid, $skiplock) = @_;
3330
3331     lock_config($vmid, sub {
3332
3333         my $conf = load_config($vmid);
3334
3335         check_lock($conf) if !$skiplock;
3336
3337         vm_mon_cmd($vmid, "system_reset");
3338     });
3339 }
3340
3341 sub get_vm_volumes {
3342     my ($conf) = @_;
3343
3344     my $vollist = [];
3345     foreach_volid($conf, sub {
3346         my ($volid, $is_cdrom) = @_;
3347
3348         return if $volid =~ m|^/|;
3349
3350         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
3351         return if !$sid;
3352
3353         push @$vollist, $volid;
3354     });
3355
3356     return $vollist;
3357 }
3358
3359 sub vm_stop_cleanup {
3360     my ($storecfg, $vmid, $conf, $keepActive) = @_;
3361
3362     eval {
3363         fairsched_rmnod($vmid); # try to destroy group
3364
3365         if (!$keepActive) {
3366             my $vollist = get_vm_volumes($conf);
3367             PVE::Storage::deactivate_volumes($storecfg, $vollist);
3368         }
3369
3370         foreach my $ext (qw(mon qmp pid vnc qga)) {
3371             unlink "/var/run/qemu-server/${vmid}.$ext";
3372         }
3373     };
3374     warn $@ if $@; # avoid errors - just warn
3375 }
3376
3377 # Note: use $nockeck to skip tests if VM configuration file exists.
3378 # We need that when migration VMs to other nodes (files already moved)
3379 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3380 sub vm_stop {
3381     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3382
3383     $force = 1 if !defined($force) && !$shutdown;
3384
3385     if ($migratedfrom){
3386         my $pid = check_running($vmid, $nocheck, $migratedfrom);
3387         kill 15, $pid if $pid;
3388         my $conf = load_config($vmid, $migratedfrom);
3389         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive);
3390         return;
3391     }
3392
3393     lock_config($vmid, sub {
3394
3395         my $pid = check_running($vmid, $nocheck);
3396         return if !$pid;
3397
3398         my $conf;
3399         if (!$nocheck) {
3400             $conf = load_config($vmid);
3401             check_lock($conf) if !$skiplock;
3402             if (!defined($timeout) && $shutdown && $conf->{startup}) {
3403                 my $opts = parse_startup($conf->{startup});
3404                 $timeout = $opts->{down} if $opts->{down};
3405             }
3406         }
3407
3408         $timeout = 60 if !defined($timeout);
3409
3410         eval {
3411             if ($shutdown) {
3412                 $nocheck ? vm_mon_cmd_nocheck($vmid, "system_powerdown") : vm_mon_cmd($vmid, "system_powerdown");
3413
3414             } else {
3415                 $nocheck ? vm_mon_cmd_nocheck($vmid, "quit") : vm_mon_cmd($vmid, "quit");
3416             }
3417         };
3418         my $err = $@;
3419
3420         if (!$err) {
3421             my $count = 0;
3422             while (($count < $timeout) && check_running($vmid, $nocheck)) {
3423                 $count++;
3424                 sleep 1;
3425             }
3426
3427             if ($count >= $timeout) {
3428                 if ($force) {
3429                     warn "VM still running - terminating now with SIGTERM\n";
3430                     kill 15, $pid;
3431                 } else {
3432                     die "VM quit/powerdown failed - got timeout\n";
3433                 }
3434             } else {
3435                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3436                 return;
3437             }
3438         } else {
3439             if ($force) {
3440                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3441                 kill 15, $pid;
3442             } else {
3443                 die "VM quit/powerdown failed\n";
3444             }
3445         }
3446
3447         # wait again
3448         $timeout = 10;
3449
3450         my $count = 0;
3451         while (($count < $timeout) && check_running($vmid, $nocheck)) {
3452             $count++;
3453             sleep 1;
3454         }
3455
3456         if ($count >= $timeout) {
3457             warn "VM still running - terminating now with SIGKILL\n";
3458             kill 9, $pid;
3459             sleep 1;
3460         }
3461
3462         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3463    });
3464 }
3465
3466 sub vm_suspend {
3467     my ($vmid, $skiplock) = @_;
3468
3469     lock_config($vmid, sub {
3470
3471         my $conf = load_config($vmid);
3472
3473         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3474
3475         vm_mon_cmd($vmid, "stop");
3476     });
3477 }
3478
3479 sub vm_resume {
3480     my ($vmid, $skiplock) = @_;
3481
3482     lock_config($vmid, sub {
3483
3484         my $conf = load_config($vmid);
3485
3486         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3487
3488         vm_mon_cmd($vmid, "cont");
3489     });
3490 }
3491
3492 sub vm_sendkey {
3493     my ($vmid, $skiplock, $key) = @_;
3494
3495     lock_config($vmid, sub {
3496
3497         my $conf = load_config($vmid);
3498
3499         # there is no qmp command, so we use the human monitor command
3500         vm_human_monitor_command($vmid, "sendkey $key");
3501     });
3502 }
3503
3504 sub vm_destroy {
3505     my ($storecfg, $vmid, $skiplock) = @_;
3506
3507     lock_config($vmid, sub {
3508
3509         my $conf = load_config($vmid);
3510
3511         check_lock($conf) if !$skiplock;
3512
3513         if (!check_running($vmid)) {
3514             fairsched_rmnod($vmid); # try to destroy group
3515             destroy_vm($storecfg, $vmid);
3516         } else {
3517             die "VM $vmid is running - destroy failed\n";
3518         }
3519     });
3520 }
3521
3522 # pci helpers
3523
3524 sub file_write {
3525     my ($filename, $buf) = @_;
3526
3527     my $fh = IO::File->new($filename, "w");
3528     return undef if !$fh;
3529
3530     my $res = print $fh $buf;
3531
3532     $fh->close();
3533
3534     return $res;
3535 }
3536
3537 sub pci_device_info {
3538     my ($name) = @_;
3539
3540     my $res;
3541
3542     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3543     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3544
3545     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
3546     return undef if !defined($irq) || $irq !~ m/^\d+$/;
3547
3548     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
3549     return undef if !defined($vendor) || $vendor !~ s/^0x//;
3550
3551     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
3552     return undef if !defined($product) || $product !~ s/^0x//;
3553
3554     $res = {
3555         name => $name,
3556         vendor => $vendor,
3557         product => $product,
3558         domain => $domain,
3559         bus => $bus,
3560         slot => $slot,
3561         func => $func,
3562         irq => $irq,
3563         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
3564     };
3565
3566     return $res;
3567 }
3568
3569 sub pci_dev_reset {
3570     my ($dev) = @_;
3571
3572     my $name = $dev->{name};
3573
3574     my $fn = "$pcisysfs/devices/$name/reset";
3575
3576     return file_write($fn, "1");
3577 }
3578
3579 sub pci_dev_bind_to_stub {
3580     my ($dev) = @_;
3581
3582     my $name = $dev->{name};
3583
3584     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3585     return 1 if -d $testdir;
3586
3587     my $data = "$dev->{vendor} $dev->{product}";
3588     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
3589
3590     my $fn = "$pcisysfs/devices/$name/driver/unbind";
3591     if (!file_write($fn, $name)) {
3592         return undef if -f $fn;
3593     }
3594
3595     $fn = "$pcisysfs/drivers/pci-stub/bind";
3596     if (! -d $testdir) {
3597         return undef if !file_write($fn, $name);
3598     }
3599
3600     return -d $testdir;
3601 }
3602
3603 sub print_pci_addr {
3604     my ($id, $bridges) = @_;
3605
3606     my $res = '';
3607     my $devices = {
3608         piix3 => { bus => 0, addr => 1 },
3609         #addr2 : first videocard
3610         balloon0 => { bus => 0, addr => 3 },
3611         watchdog => { bus => 0, addr => 4 },
3612         scsihw0 => { bus => 0, addr => 5 },
3613         scsihw1 => { bus => 0, addr => 6 },
3614         ahci0 => { bus => 0, addr => 7 },
3615         qga0 => { bus => 0, addr => 8 },
3616         spice => { bus => 0, addr => 9 },
3617         virtio0 => { bus => 0, addr => 10 },
3618         virtio1 => { bus => 0, addr => 11 },
3619         virtio2 => { bus => 0, addr => 12 },
3620         virtio3 => { bus => 0, addr => 13 },
3621         virtio4 => { bus => 0, addr => 14 },
3622         virtio5 => { bus => 0, addr => 15 },
3623         hostpci0 => { bus => 0, addr => 16 },
3624         hostpci1 => { bus => 0, addr => 17 },
3625         net0 => { bus => 0, addr => 18 },
3626         net1 => { bus => 0, addr => 19 },
3627         net2 => { bus => 0, addr => 20 },
3628         net3 => { bus => 0, addr => 21 },
3629         net4 => { bus => 0, addr => 22 },
3630         net5 => { bus => 0, addr => 23 },
3631         vga1 => { bus => 0, addr => 24 },
3632         vga2 => { bus => 0, addr => 25 },
3633         vga3 => { bus => 0, addr => 26 },
3634         #addr29 : usb-host (pve-usb.cfg)
3635         'pci.1' => { bus => 0, addr => 30 },
3636         'pci.2' => { bus => 0, addr => 31 },
3637         'net6' => { bus => 1, addr => 1 },
3638         'net7' => { bus => 1, addr => 2 },
3639         'net8' => { bus => 1, addr => 3 },
3640         'net9' => { bus => 1, addr => 4 },
3641         'net10' => { bus => 1, addr => 5 },
3642         'net11' => { bus => 1, addr => 6 },
3643         'net12' => { bus => 1, addr => 7 },
3644         'net13' => { bus => 1, addr => 8 },
3645         'net14' => { bus => 1, addr => 9 },
3646         'net15' => { bus => 1, addr => 10 },
3647         'net16' => { bus => 1, addr => 11 },
3648         'net17' => { bus => 1, addr => 12 },
3649         'net18' => { bus => 1, addr => 13 },
3650         'net19' => { bus => 1, addr => 14 },
3651         'net20' => { bus => 1, addr => 15 },
3652         'net21' => { bus => 1, addr => 16 },
3653         'net22' => { bus => 1, addr => 17 },
3654         'net23' => { bus => 1, addr => 18 },
3655         'net24' => { bus => 1, addr => 19 },
3656         'net25' => { bus => 1, addr => 20 },
3657         'net26' => { bus => 1, addr => 21 },
3658         'net27' => { bus => 1, addr => 22 },
3659         'net28' => { bus => 1, addr => 23 },
3660         'net29' => { bus => 1, addr => 24 },
3661         'net30' => { bus => 1, addr => 25 },
3662         'net31' => { bus => 1, addr => 26 },
3663         'virtio6' => { bus => 2, addr => 1 },
3664         'virtio7' => { bus => 2, addr => 2 },
3665         'virtio8' => { bus => 2, addr => 3 },
3666         'virtio9' => { bus => 2, addr => 4 },
3667         'virtio10' => { bus => 2, addr => 5 },
3668         'virtio11' => { bus => 2, addr => 6 },
3669         'virtio12' => { bus => 2, addr => 7 },
3670         'virtio13' => { bus => 2, addr => 8 },
3671         'virtio14' => { bus => 2, addr => 9 },
3672         'virtio15' => { bus => 2, addr => 10 },
3673     };
3674
3675     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
3676            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
3677            my $bus = $devices->{$id}->{bus};
3678            $res = ",bus=pci.$bus,addr=$addr";
3679            $bridges->{$bus} = 1 if $bridges;
3680     }
3681     return $res;
3682
3683 }
3684
3685 # vzdump restore implementaion
3686
3687 sub tar_archive_read_firstfile {
3688     my $archive = shift;
3689
3690     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
3691
3692     # try to detect archive type first
3693     my $pid = open (TMP, "tar tf '$archive'|") ||
3694         die "unable to open file '$archive'\n";
3695     my $firstfile = <TMP>;
3696     kill 15, $pid;
3697     close TMP;
3698
3699     die "ERROR: archive contaions no data\n" if !$firstfile;
3700     chomp $firstfile;
3701
3702     return $firstfile;
3703 }
3704
3705 sub tar_restore_cleanup {
3706     my ($storecfg, $statfile) = @_;
3707
3708     print STDERR "starting cleanup\n";
3709
3710     if (my $fd = IO::File->new($statfile, "r")) {
3711         while (defined(my $line = <$fd>)) {
3712             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3713                 my $volid = $2;
3714                 eval {
3715                     if ($volid =~ m|^/|) {
3716                         unlink $volid || die 'unlink failed\n';
3717                     } else {
3718                         PVE::Storage::vdisk_free($storecfg, $volid);
3719                     }
3720                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
3721                 };
3722                 print STDERR "unable to cleanup '$volid' - $@" if $@;
3723             } else {
3724                 print STDERR "unable to parse line in statfile - $line";
3725             }
3726         }
3727         $fd->close();
3728     }
3729 }
3730
3731 sub restore_archive {
3732     my ($archive, $vmid, $user, $opts) = @_;
3733
3734     my $format = $opts->{format};
3735     my $comp;
3736
3737     if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
3738         $format = 'tar' if !$format;
3739         $comp = 'gzip';
3740     } elsif ($archive =~ m/\.tar$/) {
3741         $format = 'tar' if !$format;
3742     } elsif ($archive =~ m/.tar.lzo$/) {
3743         $format = 'tar' if !$format;
3744         $comp = 'lzop';
3745     } elsif ($archive =~ m/\.vma$/) {
3746         $format = 'vma' if !$format;
3747     } elsif ($archive =~ m/\.vma\.gz$/) {
3748         $format = 'vma' if !$format;
3749         $comp = 'gzip';
3750     } elsif ($archive =~ m/\.vma\.lzo$/) {
3751         $format = 'vma' if !$format;
3752         $comp = 'lzop';
3753     } else {
3754         $format = 'vma' if !$format; # default
3755     }
3756
3757     # try to detect archive format
3758     if ($format eq 'tar') {
3759         return restore_tar_archive($archive, $vmid, $user, $opts);
3760     } else {
3761         return restore_vma_archive($archive, $vmid, $user, $opts, $comp);
3762     }
3763 }
3764
3765 sub restore_update_config_line {
3766     my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
3767
3768     return if $line =~ m/^\#qmdump\#/;
3769     return if $line =~ m/^\#vzdump\#/;
3770     return if $line =~ m/^lock:/;
3771     return if $line =~ m/^unused\d+:/;
3772     return if $line =~ m/^parent:/;
3773     return if $line =~ m/^template:/; # restored VM is never a template
3774
3775     if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3776         # try to convert old 1.X settings
3777         my ($id, $ind, $ethcfg) = ($1, $2, $3);
3778         foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
3779             my ($model, $macaddr) = split(/\=/, $devconfig);
3780             $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $unique;
3781             my $net = {
3782                 model => $model,
3783                 bridge => "vmbr$ind",
3784                 macaddr => $macaddr,
3785             };
3786             my $netstr = print_net($net);
3787
3788             print $outfd "net$cookie->{netcount}: $netstr\n";
3789             $cookie->{netcount}++;
3790         }
3791     } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
3792         my ($id, $netstr) = ($1, $2);
3793         my $net = parse_net($netstr);
3794         $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
3795         $netstr = print_net($net);
3796         print $outfd "$id: $netstr\n";
3797     } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
3798         my $virtdev = $1;
3799         my $value = $3;
3800         if ($line =~ m/backup=no/) {
3801             print $outfd "#$line";
3802         } elsif ($virtdev && $map->{$virtdev}) {
3803             my $di = parse_drive($virtdev, $value);
3804             delete $di->{format}; # format can change on restore
3805             $di->{file} = $map->{$virtdev};
3806             $value = print_drive($vmid, $di);
3807             print $outfd "$virtdev: $value\n";
3808         } else {
3809             print $outfd $line;
3810         }
3811     } else {
3812         print $outfd $line;
3813     }
3814 }
3815
3816 sub scan_volids {
3817     my ($cfg, $vmid) = @_;
3818
3819     my $info = PVE::Storage::vdisk_list($cfg, undef, $vmid);
3820
3821     my $volid_hash = {};
3822     foreach my $storeid (keys %$info) {
3823         foreach my $item (@{$info->{$storeid}}) {
3824             next if !($item->{volid} && $item->{size});
3825             $item->{path} = PVE::Storage::path($cfg, $item->{volid});
3826             $volid_hash->{$item->{volid}} = $item;
3827         }
3828     }
3829
3830     return $volid_hash;
3831 }
3832
3833 sub get_used_paths {
3834     my ($vmid, $storecfg, $conf, $scan_snapshots, $skip_drive) = @_;
3835
3836     my $used_path = {};
3837
3838     my $scan_config = sub {
3839         my ($cref, $snapname) = @_;
3840
3841         foreach my $key (keys %$cref) {
3842             my $value = $cref->{$key};
3843             if (valid_drivename($key)) {
3844                 next if $skip_drive && $key eq $skip_drive;
3845                 my $drive = parse_drive($key, $value);
3846                 next if !$drive || !$drive->{file} || drive_is_cdrom($drive);
3847                 if ($drive->{file} =~ m!^/!) {
3848                     $used_path->{$drive->{file}}++; # = 1;
3849                 } else {
3850                     my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file}, 1);
3851                     next if !$storeid;
3852                     my $scfg = PVE::Storage::storage_config($storecfg, $storeid, 1);
3853                     next if !$scfg;
3854                     my $path = PVE::Storage::path($storecfg, $drive->{file}, $snapname);
3855                     $used_path->{$path}++; # = 1;
3856                 }
3857             }
3858         }
3859     };
3860
3861     &$scan_config($conf);
3862
3863     undef $skip_drive;
3864
3865     if ($scan_snapshots) {
3866         foreach my $snapname (keys %{$conf->{snapshots}}) {
3867             &$scan_config($conf->{snapshots}->{$snapname}, $snapname);
3868         }
3869     }
3870
3871     return $used_path;
3872 }
3873
3874 sub update_disksize {
3875     my ($vmid, $conf, $volid_hash) = @_;
3876
3877     my $changes;
3878
3879     my $used = {};
3880
3881     # Note: it is allowed to define multiple storages with same path (alias), so
3882     # we need to check both 'volid' and real 'path' (two different volid can point
3883     # to the same path).
3884
3885     my $usedpath = {};
3886
3887     # update size info
3888     foreach my $opt (keys %$conf) {
3889         if (valid_drivename($opt)) {
3890             my $drive = parse_drive($opt, $conf->{$opt});
3891             my $volid = $drive->{file};
3892             next if !$volid;
3893
3894             $used->{$volid} = 1;
3895             if ($volid_hash->{$volid} &&
3896                 (my $path = $volid_hash->{$volid}->{path})) {
3897                 $usedpath->{$path} = 1;
3898             }
3899
3900             next if drive_is_cdrom($drive);
3901             next if !$volid_hash->{$volid};
3902
3903             $drive->{size} = $volid_hash->{$volid}->{size};
3904             my $new = print_drive($vmid, $drive);
3905             if ($new ne $conf->{$opt}) {
3906                 $changes = 1;
3907                 $conf->{$opt} = $new;
3908             }
3909         }
3910     }
3911
3912     # remove 'unusedX' entry if volume is used
3913     foreach my $opt (keys %$conf) {
3914         next if $opt !~ m/^unused\d+$/;
3915         my $volid = $conf->{$opt};
3916         my $path = $volid_hash->{$volid}->{path} if $volid_hash->{$volid};
3917         if ($used->{$volid} || ($path && $usedpath->{$path})) {
3918             $changes = 1;
3919             delete $conf->{$opt};
3920         }
3921     }
3922
3923     foreach my $volid (sort keys %$volid_hash) {
3924         next if $volid =~ m/vm-$vmid-state-/;
3925         next if $used->{$volid};
3926         my $path = $volid_hash->{$volid}->{path};
3927         next if !$path; # just to be sure
3928         next if $usedpath->{$path};
3929         $changes = 1;
3930         add_unused_volume($conf, $volid);
3931         $usedpath->{$path} = 1; # avoid to add more than once (aliases)
3932     }
3933
3934     return $changes;
3935 }
3936
3937 sub rescan {
3938     my ($vmid, $nolock) = @_;
3939
3940     my $cfg = PVE::Cluster::cfs_read_file("storage.cfg");
3941
3942     my $volid_hash = scan_volids($cfg, $vmid);
3943
3944     my $updatefn =  sub {
3945         my ($vmid) = @_;
3946
3947         my $conf = load_config($vmid);
3948
3949         check_lock($conf);
3950
3951         my $vm_volids = {};
3952         foreach my $volid (keys %$volid_hash) {
3953             my $info = $volid_hash->{$volid};
3954             $vm_volids->{$volid} = $info if $info->{vmid} && $info->{vmid} == $vmid;
3955         }
3956
3957         my $changes = update_disksize($vmid, $conf, $vm_volids);
3958
3959         update_config_nolock($vmid, $conf, 1) if $changes;
3960     };
3961
3962     if (defined($vmid)) {
3963         if ($nolock) {
3964             &$updatefn($vmid);
3965         } else {
3966             lock_config($vmid, $updatefn, $vmid);
3967         }
3968     } else {
3969         my $vmlist = config_list();
3970         foreach my $vmid (keys %$vmlist) {
3971             if ($nolock) {
3972                 &$updatefn($vmid);
3973             } else {
3974                 lock_config($vmid, $updatefn, $vmid);
3975             }
3976         }
3977     }
3978 }
3979
3980 sub restore_vma_archive {
3981     my ($archive, $vmid, $user, $opts, $comp) = @_;
3982
3983     my $input = $archive eq '-' ? "<&STDIN" : undef;
3984     my $readfrom = $archive;
3985
3986     my $uncomp = '';
3987     if ($comp) {
3988         $readfrom = '-';
3989         my $qarchive = PVE::Tools::shellquote($archive);
3990         if ($comp eq 'gzip') {
3991             $uncomp = "zcat $qarchive|";
3992         } elsif ($comp eq 'lzop') {
3993             $uncomp = "lzop -d -c $qarchive|";
3994         } else {
3995             die "unknown compression method '$comp'\n";
3996         }
3997
3998     }
3999
4000     my $tmpdir = "/var/tmp/vzdumptmp$$";
4001     rmtree $tmpdir;
4002
4003     # disable interrupts (always do cleanups)
4004     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
4005         warn "got interrupt - ignored\n";
4006     };
4007
4008     my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
4009     POSIX::mkfifo($mapfifo, 0600);
4010     my $fifofh;
4011
4012     my $openfifo = sub {
4013         open($fifofh, '>', $mapfifo) || die $!;
4014     };
4015
4016     my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
4017
4018     my $oldtimeout;
4019     my $timeout = 5;
4020
4021     my $devinfo = {};
4022
4023     my $rpcenv = PVE::RPCEnvironment::get();
4024
4025     my $conffile = config_file($vmid);
4026     my $tmpfn = "$conffile.$$.tmp";
4027
4028     # Note: $oldconf is undef if VM does not exists
4029     my $oldconf = PVE::Cluster::cfs_read_file(cfs_config_path($vmid));
4030
4031     my $print_devmap = sub {
4032         my $virtdev_hash = {};
4033
4034         my $cfgfn = "$tmpdir/qemu-server.conf";
4035
4036         # we can read the config - that is already extracted
4037         my $fh = IO::File->new($cfgfn, "r") ||
4038             "unable to read qemu-server.conf - $!\n";
4039
4040         while (defined(my $line = <$fh>)) {
4041             if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
4042                 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
4043                 die "archive does not contain data for drive '$virtdev'\n"
4044                     if !$devinfo->{$devname};
4045                 if (defined($opts->{storage})) {
4046                     $storeid = $opts->{storage} || 'local';
4047                 } elsif (!$storeid) {
4048                     $storeid = 'local';
4049                 }
4050                 $format = 'raw' if !$format;
4051                 $devinfo->{$devname}->{devname} = $devname;
4052                 $devinfo->{$devname}->{virtdev} = $virtdev;
4053                 $devinfo->{$devname}->{format} = $format;
4054                 $devinfo->{$devname}->{storeid} = $storeid;
4055
4056                 # check permission on storage
4057                 my $pool = $opts->{pool}; # todo: do we need that?
4058                 if ($user ne 'root@pam') {
4059                     $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
4060                 }
4061
4062                 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
4063             }
4064         }
4065
4066         foreach my $devname (keys %$devinfo) {
4067             die "found no device mapping information for device '$devname'\n"
4068                 if !$devinfo->{$devname}->{virtdev};
4069         }
4070
4071         my $cfg = cfs_read_file('storage.cfg');
4072
4073         # create empty/temp config
4074         if ($oldconf) {
4075             PVE::Tools::file_set_contents($conffile, "memory: 128\n");
4076             foreach_drive($oldconf, sub {
4077                 my ($ds, $drive) = @_;
4078
4079                 return if drive_is_cdrom($drive);
4080
4081                 my $volid = $drive->{file};
4082
4083                 return if !$volid || $volid =~ m|^/|;
4084
4085                 my ($path, $owner) = PVE::Storage::path($cfg, $volid);
4086                 return if !$path || !$owner || ($owner != $vmid);
4087
4088                 # Note: only delete disk we want to restore
4089                 # other volumes will become unused
4090                 if ($virtdev_hash->{$ds}) {
4091                     PVE::Storage::vdisk_free($cfg, $volid);
4092                 }
4093             });
4094         }
4095
4096         my $map = {};
4097         foreach my $virtdev (sort keys %$virtdev_hash) {
4098             my $d = $virtdev_hash->{$virtdev};
4099             my $alloc_size = int(($d->{size} + 1024 - 1)/1024);
4100             my $scfg = PVE::Storage::storage_config($cfg, $d->{storeid});
4101
4102             # test if requested format is supported
4103             my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($cfg, $d->{storeid});
4104             my $supported = grep { $_ eq $d->{format} } @$validFormats;
4105             $d->{format} = $defFormat if !$supported;
4106
4107             my $volid = PVE::Storage::vdisk_alloc($cfg, $d->{storeid}, $vmid,
4108                                                   $d->{format}, undef, $alloc_size);
4109             print STDERR "new volume ID is '$volid'\n";
4110             $d->{volid} = $volid;
4111             my $path = PVE::Storage::path($cfg, $volid);
4112
4113             my $write_zeros = 1;
4114             # fixme: what other storages types initialize volumes with zero?
4115             if ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs' || $scfg->{type} eq 'glusterfs' ||
4116                 $scfg->{type} eq 'sheepdog' || $scfg->{type} eq 'rbd') {
4117                 $write_zeros = 0;
4118             }
4119
4120             print $fifofh "${write_zeros}:$d->{devname}=$path\n";
4121
4122             print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
4123             $map->{$virtdev} = $volid;
4124         }
4125
4126         $fh->seek(0, 0) || die "seek failed - $!\n";
4127
4128         my $outfd = new IO::File ($tmpfn, "w") ||
4129             die "unable to write config for VM $vmid\n";
4130
4131         my $cookie = { netcount => 0 };
4132         while (defined(my $line = <$fh>)) {
4133             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
4134         }
4135
4136         $fh->close();
4137         $outfd->close();
4138     };
4139
4140     eval {
4141         # enable interrupts
4142         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
4143             die "interrupted by signal\n";
4144         };
4145         local $SIG{ALRM} = sub { die "got timeout\n"; };
4146
4147         $oldtimeout = alarm($timeout);
4148
4149         my $parser = sub {
4150             my $line = shift;
4151
4152             print "$line\n";
4153
4154             if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
4155                 my ($dev_id, $size, $devname) = ($1, $2, $3);
4156                 $devinfo->{$devname} = { size => $size, dev_id => $dev_id };
4157             } elsif ($line =~ m/^CTIME: /) {
4158                 &$print_devmap();
4159                 print $fifofh "done\n";
4160                 my $tmp = $oldtimeout || 0;
4161                 $oldtimeout = undef;
4162                 alarm($tmp);
4163                 close($fifofh);
4164             }
4165         };
4166
4167         print "restore vma archive: $cmd\n";
4168         run_command($cmd, input => $input, outfunc => $parser, afterfork => $openfifo);
4169     };
4170     my $err = $@;
4171
4172     alarm($oldtimeout) if $oldtimeout;
4173
4174     unlink $mapfifo;
4175
4176     if ($err) {
4177         rmtree $tmpdir;
4178         unlink $tmpfn;
4179
4180         my $cfg = cfs_read_file('storage.cfg');
4181         foreach my $devname (keys %$devinfo) {
4182             my $volid = $devinfo->{$devname}->{volid};
4183             next if !$volid;
4184             eval {
4185                 if ($volid =~ m|^/|) {
4186                     unlink $volid || die 'unlink failed\n';
4187                 } else {
4188                     PVE::Storage::vdisk_free($cfg, $volid);
4189                 }
4190                 print STDERR "temporary volume '$volid' sucessfuly removed\n";
4191             };
4192             print STDERR "unable to cleanup '$volid' - $@" if $@;
4193         }
4194         die $err;
4195     }
4196
4197     rmtree $tmpdir;
4198
4199     rename($tmpfn, $conffile) ||
4200         die "unable to commit configuration file '$conffile'\n";
4201
4202     PVE::Cluster::cfs_update(); # make sure we read new file
4203
4204     eval { rescan($vmid, 1); };
4205     warn $@ if $@;
4206 }
4207
4208 sub restore_tar_archive {
4209     my ($archive, $vmid, $user, $opts) = @_;
4210
4211     if ($archive ne '-') {
4212         my $firstfile = tar_archive_read_firstfile($archive);
4213         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
4214             if $firstfile ne 'qemu-server.conf';
4215     }
4216
4217     my $storecfg = cfs_read_file('storage.cfg');
4218
4219     # destroy existing data - keep empty config
4220     my $vmcfgfn = PVE::QemuServer::config_file($vmid);
4221     destroy_vm($storecfg, $vmid, 1) if -f $vmcfgfn;
4222
4223     my $tocmd = "/usr/lib/qemu-server/qmextract";
4224
4225     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
4226     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
4227     $tocmd .= ' --prealloc' if $opts->{prealloc};
4228     $tocmd .= ' --info' if $opts->{info};
4229
4230     # tar option "xf" does not autodetect compression when read from STDIN,
4231     # so we pipe to zcat
4232     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
4233         PVE::Tools::shellquote("--to-command=$tocmd");
4234
4235     my $tmpdir = "/var/tmp/vzdumptmp$$";
4236     mkpath $tmpdir;
4237
4238     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
4239     local $ENV{VZDUMP_VMID} = $vmid;
4240     local $ENV{VZDUMP_USER} = $user;
4241
4242     my $conffile = config_file($vmid);
4243     my $tmpfn = "$conffile.$$.tmp";
4244
4245     # disable interrupts (always do cleanups)
4246     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
4247         print STDERR "got interrupt - ignored\n";
4248     };
4249
4250     eval {
4251         # enable interrupts
4252         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
4253             die "interrupted by signal\n";
4254         };
4255
4256         if ($archive eq '-') {
4257             print "extracting archive from STDIN\n";
4258             run_command($cmd, input => "<&STDIN");
4259         } else {
4260             print "extracting archive '$archive'\n";
4261             run_command($cmd);
4262         }
4263
4264         return if $opts->{info};
4265
4266         # read new mapping
4267         my $map = {};
4268         my $statfile = "$tmpdir/qmrestore.stat";
4269         if (my $fd = IO::File->new($statfile, "r")) {
4270             while (defined (my $line = <$fd>)) {
4271                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4272                     $map->{$1} = $2 if $1;
4273                 } else {
4274                     print STDERR "unable to parse line in statfile - $line\n";
4275                 }
4276             }
4277             $fd->close();
4278         }
4279
4280         my $confsrc = "$tmpdir/qemu-server.conf";
4281
4282         my $srcfd = new IO::File($confsrc, "r") ||
4283             die "unable to open file '$confsrc'\n";
4284
4285         my $outfd = new IO::File ($tmpfn, "w") ||
4286             die "unable to write config for VM $vmid\n";
4287
4288         my $cookie = { netcount => 0 };
4289         while (defined (my $line = <$srcfd>)) {
4290             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
4291         }
4292
4293         $srcfd->close();
4294         $outfd->close();
4295     };
4296     my $err = $@;
4297
4298     if ($err) {
4299
4300         unlink $tmpfn;
4301
4302         tar_restore_cleanup($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info};
4303
4304         die $err;
4305     }
4306
4307     rmtree $tmpdir;
4308
4309     rename $tmpfn, $conffile ||
4310         die "unable to commit configuration file '$conffile'\n";
4311
4312     PVE::Cluster::cfs_update(); # make sure we read new file
4313
4314     eval { rescan($vmid, 1); };
4315     warn $@ if $@;
4316 };
4317
4318
4319 # Internal snapshots
4320
4321 # NOTE: Snapshot create/delete involves several non-atomic
4322 # action, and can take a long time.
4323 # So we try to avoid locking the file and use 'lock' variable
4324 # inside the config file instead.
4325
4326 my $snapshot_copy_config = sub {
4327     my ($source, $dest) = @_;
4328
4329     foreach my $k (keys %$source) {
4330         next if $k eq 'snapshots';
4331         next if $k eq 'snapstate';
4332         next if $k eq 'snaptime';
4333         next if $k eq 'vmstate';
4334         next if $k eq 'lock';
4335         next if $k eq 'digest';
4336         next if $k eq 'description';
4337         next if $k =~ m/^unused\d+$/;
4338
4339         $dest->{$k} = $source->{$k};
4340     }
4341 };
4342
4343 my $snapshot_apply_config = sub {
4344     my ($conf, $snap) = @_;
4345
4346     # copy snapshot list
4347     my $newconf = {
4348         snapshots => $conf->{snapshots},
4349     };
4350
4351     # keep description and list of unused disks
4352     foreach my $k (keys %$conf) {
4353         next if !($k =~ m/^unused\d+$/ || $k eq 'description');
4354         $newconf->{$k} = $conf->{$k};
4355     }
4356
4357     &$snapshot_copy_config($snap, $newconf);
4358
4359     return $newconf;
4360 };
4361
4362 sub foreach_writable_storage {
4363     my ($conf, $func) = @_;
4364
4365     my $sidhash = {};
4366
4367     foreach my $ds (keys %$conf) {
4368         next if !valid_drivename($ds);
4369
4370         my $drive = parse_drive($ds, $conf->{$ds});
4371         next if !$drive;
4372         next if drive_is_cdrom($drive);
4373
4374         my $volid = $drive->{file};
4375
4376         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
4377         $sidhash->{$sid} = $sid if $sid;
4378     }
4379
4380     foreach my $sid (sort keys %$sidhash) {
4381         &$func($sid);
4382     }
4383 }
4384
4385 my $alloc_vmstate_volid = sub {
4386     my ($storecfg, $vmid, $conf, $snapname) = @_;
4387
4388     # Note: we try to be smart when selecting a $target storage
4389
4390     my $target;
4391
4392     # search shared storage first
4393     foreach_writable_storage($conf, sub {
4394         my ($sid) = @_;
4395         my $scfg = PVE::Storage::storage_config($storecfg, $sid);
4396         return if !$scfg->{shared};
4397
4398         $target = $sid if !$target || $scfg->{path}; # prefer file based storage
4399     });
4400
4401     if (!$target) {
4402         # now search local storage
4403         foreach_writable_storage($conf, sub {
4404             my ($sid) = @_;
4405             my $scfg = PVE::Storage::storage_config($storecfg, $sid);
4406             return if $scfg->{shared};
4407
4408             $target = $sid if !$target || $scfg->{path}; # prefer file based storage;
4409         });
4410     }
4411
4412     $target = 'local' if !$target;
4413
4414     my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
4415     # we abort live save after $conf->{memory}, so we need at max twice that space
4416     my $size = $conf->{memory}*2 + $driver_state_size;
4417
4418     my $name = "vm-$vmid-state-$snapname";
4419     my $scfg = PVE::Storage::storage_config($storecfg, $target);
4420     $name .= ".raw" if $scfg->{path}; # add filename extension for file base storage
4421     my $volid = PVE::Storage::vdisk_alloc($storecfg, $target, $vmid, 'raw', $name, $size*1024);
4422
4423     return $volid;
4424 };
4425
4426 my $snapshot_prepare = sub {
4427     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
4428
4429     my $snap;
4430
4431     my $updatefn =  sub {
4432
4433         my $conf = load_config($vmid);
4434
4435         die "you can't take a snapshot if it's a template\n"
4436             if is_template($conf);
4437
4438         check_lock($conf);
4439
4440         $conf->{lock} = 'snapshot';
4441
4442         die "snapshot name '$snapname' already used\n"
4443             if defined($conf->{snapshots}->{$snapname});
4444
4445         my $storecfg = PVE::Storage::config();
4446         die "snapshot feature is not available" if !has_feature('snapshot', $conf, $storecfg);
4447
4448         $snap = $conf->{snapshots}->{$snapname} = {};
4449
4450         if ($save_vmstate && check_running($vmid)) {
4451             $snap->{vmstate} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
4452         }
4453
4454         &$snapshot_copy_config($conf, $snap);
4455
4456         $snap->{snapstate} = "prepare";
4457         $snap->{snaptime} = time();
4458         $snap->{description} = $comment if $comment;
4459
4460         # always overwrite machine if we save vmstate. This makes sure we
4461         # can restore it later using correct machine type
4462         $snap->{machine} = get_current_qemu_machine($vmid) if $snap->{vmstate};
4463
4464         update_config_nolock($vmid, $conf, 1);
4465     };
4466
4467     lock_config($vmid, $updatefn);
4468
4469     return $snap;
4470 };
4471
4472 my $snapshot_commit = sub {
4473     my ($vmid, $snapname) = @_;
4474
4475     my $updatefn = sub {
4476
4477         my $conf = load_config($vmid);
4478
4479         die "missing snapshot lock\n"
4480             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
4481
4482         my $snap = $conf->{snapshots}->{$snapname};
4483
4484         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4485
4486         die "wrong snapshot state\n"
4487             if !($snap->{snapstate} && $snap->{snapstate} eq "prepare");
4488
4489         delete $snap->{snapstate};
4490         delete $conf->{lock};
4491
4492         my $newconf = &$snapshot_apply_config($conf, $snap);
4493
4494         $newconf->{parent} = $snapname;
4495
4496         update_config_nolock($vmid, $newconf, 1);
4497     };
4498
4499     lock_config($vmid, $updatefn);
4500 };
4501
4502 sub snapshot_rollback {
4503     my ($vmid, $snapname) = @_;
4504
4505     my $snap;
4506
4507     my $prepare = 1;
4508
4509     my $storecfg = PVE::Storage::config();
4510
4511     my $updatefn = sub {
4512
4513         my $conf = load_config($vmid);
4514
4515         die "you can't rollback if vm is a template\n" if is_template($conf);
4516
4517         $snap = $conf->{snapshots}->{$snapname};
4518
4519         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4520
4521         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
4522             if $snap->{snapstate};
4523
4524         if ($prepare) {
4525             check_lock($conf);
4526             vm_stop($storecfg, $vmid, undef, undef, 5, undef, undef);
4527         }
4528
4529         die "unable to rollback vm $vmid: vm is running\n"
4530             if check_running($vmid);
4531
4532         if ($prepare) {
4533             $conf->{lock} = 'rollback';
4534         } else {
4535             die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
4536             delete $conf->{lock};
4537         }
4538
4539         my $forcemachine;
4540
4541         if (!$prepare) {
4542             my $has_machine_config = defined($conf->{machine});
4543
4544             # copy snapshot config to current config
4545             $conf = &$snapshot_apply_config($conf, $snap);
4546             $conf->{parent} = $snapname;
4547
4548             # Note: old code did not store 'machine', so we try to be smart
4549             # and guess the snapshot was generated with kvm 1.4 (pc-i440fx-1.4).
4550             $forcemachine = $conf->{machine} || 'pc-i440fx-1.4';
4551             # we remove the 'machine' configuration if not explicitly specified
4552             # in the original config.
4553             delete $conf->{machine} if $snap->{vmstate} && !$has_machine_config;
4554         }
4555
4556         update_config_nolock($vmid, $conf, 1);
4557
4558         if (!$prepare && $snap->{vmstate}) {
4559             my $statefile = PVE::Storage::path($storecfg, $snap->{vmstate});
4560             vm_start($storecfg, $vmid, $statefile, undef, undef, undef, $forcemachine);
4561         }
4562     };
4563
4564     lock_config($vmid, $updatefn);
4565
4566     foreach_drive($snap, sub {
4567         my ($ds, $drive) = @_;
4568
4569         return if drive_is_cdrom($drive);
4570
4571         my $volid = $drive->{file};
4572         my $device = "drive-$ds";
4573
4574         PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
4575     });
4576
4577     $prepare = 0;
4578     lock_config($vmid, $updatefn);
4579 }
4580
4581 my $savevm_wait = sub {
4582     my ($vmid) = @_;
4583
4584     for(;;) {
4585         my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
4586         if (!$stat->{status}) {
4587             die "savevm not active\n";
4588         } elsif ($stat->{status} eq 'active') {
4589             sleep(1);
4590             next;
4591         } elsif ($stat->{status} eq 'completed') {
4592             last;
4593         } else {
4594             die "query-savevm returned status '$stat->{status}'\n";
4595         }
4596     }
4597 };
4598
4599 sub snapshot_create {
4600     my ($vmid, $snapname, $save_vmstate, $freezefs, $comment) = @_;
4601
4602     my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
4603
4604     $freezefs = $save_vmstate = 0 if !$snap->{vmstate}; # vm is not running
4605
4606     my $drivehash = {};
4607
4608     my $running = check_running($vmid);
4609
4610     eval {
4611         # create internal snapshots of all drives
4612
4613         my $storecfg = PVE::Storage::config();
4614
4615         if ($running) {
4616             if ($snap->{vmstate}) {
4617                 my $path = PVE::Storage::path($storecfg, $snap->{vmstate});
4618                 vm_mon_cmd($vmid, "savevm-start", statefile => $path);
4619                 &$savevm_wait($vmid);
4620             } else {
4621                 vm_mon_cmd($vmid, "savevm-start");
4622             }
4623         };
4624
4625         qga_freezefs($vmid) if $running && $freezefs;
4626
4627         foreach_drive($snap, sub {
4628             my ($ds, $drive) = @_;
4629
4630             return if drive_is_cdrom($drive);
4631
4632             my $volid = $drive->{file};
4633             my $device = "drive-$ds";
4634
4635             qemu_volume_snapshot($vmid, $device, $storecfg, $volid, $snapname);
4636             $drivehash->{$ds} = 1;
4637        });
4638     };
4639     my $err = $@;
4640
4641     eval { qga_unfreezefs($vmid) if $running && $freezefs; };
4642     warn $@ if $@;
4643
4644     eval { vm_mon_cmd($vmid, "savevm-end") if $running; };
4645     warn $@ if $@;
4646
4647     if ($err) {
4648         warn "snapshot create failed: starting cleanup\n";
4649         eval { snapshot_delete($vmid, $snapname, 0, $drivehash); };
4650         warn $@ if $@;
4651         die $err;
4652     }
4653
4654     &$snapshot_commit($vmid, $snapname);
4655 }
4656
4657 # Note: $drivehash is only set when called from snapshot_create.
4658 sub snapshot_delete {
4659     my ($vmid, $snapname, $force, $drivehash) = @_;
4660
4661     my $prepare = 1;
4662
4663     my $snap;
4664     my $unused = [];
4665
4666     my $unlink_parent = sub {
4667         my ($confref, $new_parent) = @_;
4668
4669         if ($confref->{parent} && $confref->{parent} eq $snapname) {
4670             if ($new_parent) {
4671                 $confref->{parent} = $new_parent;
4672             } else {
4673                 delete $confref->{parent};
4674             }
4675         }
4676     };
4677
4678     my $updatefn =  sub {
4679         my ($remove_drive) = @_;
4680
4681         my $conf = load_config($vmid);
4682
4683         if (!$drivehash) {
4684             check_lock($conf);
4685             die "you can't delete a snapshot if vm is a template\n"
4686                 if is_template($conf);
4687         }
4688
4689         $snap = $conf->{snapshots}->{$snapname};
4690
4691         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4692
4693         # remove parent refs
4694         &$unlink_parent($conf, $snap->{parent});
4695         foreach my $sn (keys %{$conf->{snapshots}}) {
4696             next if $sn eq $snapname;
4697             &$unlink_parent($conf->{snapshots}->{$sn}, $snap->{parent});
4698         }
4699
4700         if ($remove_drive) {
4701             if ($remove_drive eq 'vmstate') {
4702                 delete $snap->{$remove_drive};
4703             } else {
4704                 my $drive = parse_drive($remove_drive, $snap->{$remove_drive});
4705                 my $volid = $drive->{file};
4706                 delete $snap->{$remove_drive};
4707                 add_unused_volume($conf, $volid);
4708             }
4709         }
4710
4711         if ($prepare) {
4712             $snap->{snapstate} = 'delete';
4713         } else {
4714             delete $conf->{snapshots}->{$snapname};
4715             delete $conf->{lock} if $drivehash;
4716             foreach my $volid (@$unused) {
4717                 add_unused_volume($conf, $volid);
4718             }
4719         }
4720
4721         update_config_nolock($vmid, $conf, 1);
4722     };
4723
4724     lock_config($vmid, $updatefn);
4725
4726     # now remove vmstate file
4727
4728     my $storecfg = PVE::Storage::config();
4729
4730     if ($snap->{vmstate}) {
4731         eval {  PVE::Storage::vdisk_free($storecfg, $snap->{vmstate}); };
4732         if (my $err = $@) {
4733             die $err if !$force;
4734             warn $err;
4735         }
4736         # save changes (remove vmstate from snapshot)
4737         lock_config($vmid, $updatefn, 'vmstate') if !$force;
4738     };
4739
4740     # now remove all internal snapshots
4741     foreach_drive($snap, sub {
4742         my ($ds, $drive) = @_;
4743
4744         return if drive_is_cdrom($drive);
4745
4746         my $volid = $drive->{file};
4747         my $device = "drive-$ds";
4748
4749         if (!$drivehash || $drivehash->{$ds}) {
4750             eval { qemu_volume_snapshot_delete($vmid, $device, $storecfg, $volid, $snapname); };
4751             if (my $err = $@) {
4752                 die $err if !$force;
4753                 warn $err;
4754             }
4755         }
4756
4757         # save changes (remove drive fron snapshot)
4758         lock_config($vmid, $updatefn, $ds) if !$force;
4759         push @$unused, $volid;
4760     });
4761
4762     # now cleanup config
4763     $prepare = 0;
4764     lock_config($vmid, $updatefn);
4765 }
4766
4767 sub has_feature {
4768     my ($feature, $conf, $storecfg, $snapname, $running) = @_;
4769
4770     my $err;
4771     foreach_drive($conf, sub {
4772         my ($ds, $drive) = @_;
4773
4774         return if drive_is_cdrom($drive);
4775         my $volid = $drive->{file};
4776         $err = 1 if !PVE::Storage::volume_has_feature($storecfg, $feature, $volid, $snapname, $running);
4777     });
4778
4779     return $err ? 0 : 1;
4780 }
4781
4782 sub template_create {
4783     my ($vmid, $conf, $disk) = @_;
4784
4785     my $storecfg = PVE::Storage::config();
4786
4787     foreach_drive($conf, sub {
4788         my ($ds, $drive) = @_;
4789
4790         return if drive_is_cdrom($drive);
4791         return if $disk && $ds ne $disk;
4792
4793         my $volid = $drive->{file};
4794         return if !PVE::Storage::volume_has_feature($storecfg, 'template', $volid);
4795
4796         my $voliddst = PVE::Storage::vdisk_create_base($storecfg, $volid);
4797         $drive->{file} = $voliddst;
4798         $conf->{$ds} = print_drive($vmid, $drive);
4799         update_config_nolock($vmid, $conf, 1);
4800     });
4801 }
4802
4803 sub is_template {
4804     my ($conf) = @_;
4805
4806     return 1 if defined $conf->{template} && $conf->{template} == 1;
4807 }
4808
4809 sub qemu_img_convert {
4810     my ($src_volid, $dst_volid, $size, $snapname) = @_;
4811
4812     my $storecfg = PVE::Storage::config();
4813     my ($src_storeid, $src_volname) = PVE::Storage::parse_volume_id($src_volid, 1);
4814     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
4815
4816     if ($src_storeid && $dst_storeid) {
4817         my $src_scfg = PVE::Storage::storage_config($storecfg, $src_storeid);
4818         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
4819
4820         my $src_format = qemu_img_format($src_scfg, $src_volname);
4821         my $dst_format = qemu_img_format($dst_scfg, $dst_volname);
4822
4823         my $src_path = PVE::Storage::path($storecfg, $src_volid, $snapname);
4824         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
4825
4826         my $cmd = [];
4827         push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-n';
4828         push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
4829         push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
4830
4831         my $parser = sub {
4832             my $line = shift;
4833             if($line =~ m/\((\S+)\/100\%\)/){
4834                 my $percent = $1;
4835                 my $transferred = int($size * $percent / 100);
4836                 my $remaining = $size - $transferred;
4837
4838                 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
4839             }
4840
4841         };
4842
4843         eval  { run_command($cmd, timeout => undef, outfunc => $parser); };
4844         my $err = $@;
4845         die "copy failed: $err" if $err;
4846     }
4847 }
4848
4849 sub qemu_img_format {
4850     my ($scfg, $volname) = @_;
4851
4852     if ($scfg->{path} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/) {
4853         return $1;
4854     } elsif ($scfg->{type} eq 'iscsi') {
4855         return "host_device";
4856     } else {
4857         return "raw";
4858     }
4859 }
4860
4861 sub qemu_drive_mirror {
4862     my ($vmid, $drive, $dst_volid, $vmiddst, $maxwait) = @_;
4863
4864     my $count = 1;
4865     my $old_len = 0;
4866     my $frozen = undef;
4867
4868     my $storecfg = PVE::Storage::config();
4869     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
4870
4871     if ($dst_storeid) {
4872         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
4873
4874         my $format;
4875         if ($dst_volname =~ m/\.(raw|qcow2)$/){
4876             $format = $1;
4877         }
4878
4879         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
4880
4881         if ($format) {
4882             #fixme : sometime drive-mirror timeout, but works fine after.
4883             # (I have see the problem with big volume > 200GB), so we need to eval
4884             eval { vm_mon_cmd($vmid, "drive-mirror", timeout => 10, device => "drive-$drive", mode => "existing",
4885                               sync => "full", target => $dst_path, format => $format); };
4886         } else {
4887             eval { vm_mon_cmd($vmid, "drive-mirror", timeout => 10, device => "drive-$drive", mode => "existing",
4888                               sync => "full", target => $dst_path); };
4889         }
4890
4891         eval {
4892             while (1) {
4893                 my $stats = vm_mon_cmd($vmid, "query-block-jobs");
4894                 my $stat = @$stats[0];
4895                 die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
4896                 die "error job is not mirroring" if $stat->{type} ne "mirror";
4897
4898                 my $transferred = $stat->{offset};
4899                 my $total = $stat->{len};
4900                 my $remaining = $total - $transferred;
4901                 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
4902
4903                 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent %\n";
4904
4905                 last if ($stat->{len} == $stat->{offset});
4906                 if ($old_len == $stat->{offset}) {
4907                     if ($maxwait && $count > $maxwait) {
4908                     # if writes to disk occurs the disk needs to be freezed
4909                     # to be able to complete the migration
4910                         vm_suspend($vmid,1);
4911                         $count = 0;
4912                         $frozen = 1;
4913                     } else {
4914                         $count++ unless $frozen;
4915                     }
4916                 } elsif ($frozen) {
4917                     vm_resume($vmid,1);
4918                     $count = 0;
4919                 }
4920                 $old_len = $stat->{offset};
4921                 sleep 1;
4922             }
4923
4924             if ($vmiddst == $vmid) {
4925                 # switch the disk if source and destination are on the same guest
4926                 vm_mon_cmd($vmid, "block-job-complete", device => "drive-$drive");
4927             }
4928         };
4929         if (my $err = $@) {
4930             eval { vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive"); };
4931             die "mirroring error: $err";
4932         }
4933
4934         if ($vmiddst != $vmid) {
4935             # if we clone a disk for a new target vm, we don't switch the disk
4936             vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive");
4937         }
4938     }
4939 }
4940
4941 sub clone_disk {
4942     my ($storecfg, $vmid, $running, $drivename, $drive, $snapname,
4943         $newvmid, $storage, $format, $full, $newvollist) = @_;
4944
4945     my $newvolid;
4946
4947     if (!$full) {
4948         print "create linked clone of drive $drivename ($drive->{file})\n";
4949         $newvolid = PVE::Storage::vdisk_clone($storecfg,  $drive->{file}, $newvmid);
4950         push @$newvollist, $newvolid;
4951     } else {
4952         my ($storeid, $volname) = PVE::Storage::parse_volume_id($drive->{file});
4953         $storeid = $storage if $storage;
4954
4955         my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($storecfg, $storeid);
4956         if (!$format) {
4957             $format = $drive->{format} || $defFormat;
4958         }
4959
4960         # test if requested format is supported - else use default
4961         my $supported = grep { $_ eq $format } @$validFormats;
4962         $format = $defFormat if !$supported;
4963
4964         my ($size) = PVE::Storage::volume_size_info($storecfg, $drive->{file}, 3);
4965
4966         print "create full clone of drive $drivename ($drive->{file})\n";
4967         $newvolid = PVE::Storage::vdisk_alloc($storecfg, $storeid, $newvmid, $format, undef, ($size/1024));
4968         push @$newvollist, $newvolid;
4969
4970         if (!$running || $snapname) {
4971             qemu_img_convert($drive->{file}, $newvolid, $size, $snapname);
4972         } else {
4973             qemu_drive_mirror($vmid, $drivename, $newvolid, $newvmid);
4974         }
4975     }
4976
4977     my ($size) = PVE::Storage::volume_size_info($storecfg, $newvolid, 3);
4978
4979     my $disk = $drive;
4980     $disk->{format} = undef;
4981     $disk->{file} = $newvolid;
4982     $disk->{size} = $size;
4983
4984     return $disk;
4985 }
4986
4987 # this only works if VM is running
4988 sub get_current_qemu_machine {
4989     my ($vmid) = @_;
4990
4991     my $cmd = { execute => 'query-machines', arguments => {} };
4992     my $res = PVE::QemuServer::vm_qmp_command($vmid, $cmd);
4993
4994     my ($current, $default);
4995     foreach my $e (@$res) {
4996         $default = $e->{name} if $e->{'is-default'};
4997         $current = $e->{name} if $e->{'is-current'};
4998     }
4999
5000     # fallback to the default machine if current is not supported by qemu
5001     return $current || $default || 'pc';
5002 }
5003
5004 1;