PVE/QemuServer.pm

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