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