PVE/QemuServer.pm

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