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
3576     if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3577         # try to convert old 1.X settings
3578         my ($id, $ind, $ethcfg) = ($1, $2, $3);
3579         foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
3580             my ($model, $macaddr) = split(/\=/, $devconfig);
3581             $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $unique;
3582             my $net = {
3583                 model => $model,
3584                 bridge => "vmbr$ind",
3585                 macaddr => $macaddr,
3586             };
3587             my $netstr = print_net($net);
3588
3589             print $outfd "net$cookie->{netcount}: $netstr\n";
3590             $cookie->{netcount}++;
3591         }
3592     } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
3593         my ($id, $netstr) = ($1, $2);
3594         my $net = parse_net($netstr);
3595         $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
3596         $netstr = print_net($net);
3597         print $outfd "$id: $netstr\n";
3598     } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
3599         my $virtdev = $1;
3600         my $value = $3;
3601         if ($line =~ m/backup=no/) {
3602             print $outfd "#$line";
3603         } elsif ($virtdev && $map->{$virtdev}) {
3604             my $di = parse_drive($virtdev, $value);
3605             $di->{file} = $map->{$virtdev};
3606             $value = print_drive($vmid, $di);
3607             print $outfd "$virtdev: $value\n";
3608         } else {
3609             print $outfd $line;
3610         }
3611     } else {
3612         print $outfd $line;
3613     }
3614 }
3615
3616 sub scan_volids {
3617     my ($cfg, $vmid) = @_;
3618
3619     my $info = PVE::Storage::vdisk_list($cfg, undef, $vmid);
3620
3621     my $volid_hash = {};
3622     foreach my $storeid (keys %$info) {
3623         foreach my $item (@{$info->{$storeid}}) {
3624             next if !($item->{volid} && $item->{size});
3625             $volid_hash->{$item->{volid}} = $item;
3626         }
3627     }
3628
3629     return $volid_hash;
3630 }
3631
3632 sub update_disksize {
3633     my ($vmid, $conf, $volid_hash) = @_;
3634
3635     my $changes;
3636
3637     my $used = {};
3638
3639     # update size info
3640     foreach my $opt (keys %$conf) {
3641         if (valid_drivename($opt)) {
3642             my $drive = parse_drive($opt, $conf->{$opt});
3643             my $volid = $drive->{file};
3644             next if !$volid;
3645
3646             $used->{$volid} = 1;
3647
3648             next if drive_is_cdrom($drive);
3649             next if !$volid_hash->{$volid};
3650
3651             $drive->{size} = $volid_hash->{$volid}->{size};
3652             $changes = 1;
3653             $conf->{$opt} = print_drive($vmid, $drive);
3654         }
3655     }
3656
3657     foreach my $volid (sort keys %$volid_hash) {
3658         next if $volid =~ m/vm-$vmid-state-/;
3659         next if $used->{$volid};
3660         $changes = 1;
3661         add_unused_volume($conf, $volid);
3662     }
3663
3664     return $changes;
3665 }
3666
3667 sub rescan {
3668     my ($vmid, $nolock) = @_;
3669
3670     my $cfg = PVE::Cluster::cfs_read_file("storage.cfg");
3671
3672     my $volid_hash = scan_volids($cfg, $vmid);
3673
3674     my $updatefn =  sub {
3675         my ($vmid) = @_;
3676
3677         my $conf = load_config($vmid);
3678
3679         check_lock($conf);
3680
3681         my $vm_volids = {};
3682         foreach my $volid (keys %$volid_hash) {
3683             my $info = $volid_hash->{$volid};
3684             $vm_volids->{$volid} = $info if $info->{vmid} && $info->{vmid} == $vmid;
3685         }
3686
3687         my $changes = update_disksize($vmid, $conf, $vm_volids);
3688
3689         update_config_nolock($vmid, $conf, 1) if $changes;
3690     };
3691
3692     if (defined($vmid)) {
3693         if ($nolock) {
3694             &$updatefn($vmid);
3695         } else {
3696             lock_config($vmid, $updatefn, $vmid);
3697         }
3698     } else {
3699         my $vmlist = config_list();
3700         foreach my $vmid (keys %$vmlist) {
3701             if ($nolock) {
3702                 &$updatefn($vmid);
3703             } else {
3704                 lock_config($vmid, $updatefn, $vmid);
3705             }
3706         }
3707     }
3708 }
3709
3710 sub restore_vma_archive {
3711     my ($archive, $vmid, $user, $opts, $comp) = @_;
3712
3713     my $input = $archive eq '-' ? "<&STDIN" : undef;
3714     my $readfrom = $archive;
3715
3716     my $uncomp = '';
3717     if ($comp) {
3718         $readfrom = '-';
3719         my $qarchive = PVE::Tools::shellquote($archive);
3720         if ($comp eq 'gzip') {
3721             $uncomp = "zcat $qarchive|";
3722         } elsif ($comp eq 'lzop') {
3723             $uncomp = "lzop -d -c $qarchive|";
3724         } else {
3725             die "unknown compression method '$comp'\n";
3726         }
3727
3728     }
3729
3730     my $tmpdir = "/var/tmp/vzdumptmp$$";
3731     rmtree $tmpdir;
3732
3733     # disable interrupts (always do cleanups)
3734     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
3735         warn "got interrupt - ignored\n";
3736     };
3737
3738     my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
3739     POSIX::mkfifo($mapfifo, 0600);
3740     my $fifofh;
3741
3742     my $openfifo = sub {
3743         open($fifofh, '>', $mapfifo) || die $!;
3744     };
3745
3746     my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
3747
3748     my $oldtimeout;
3749     my $timeout = 5;
3750
3751     my $devinfo = {};
3752
3753     my $rpcenv = PVE::RPCEnvironment::get();
3754
3755     my $conffile = config_file($vmid);
3756     my $tmpfn = "$conffile.$$.tmp";
3757
3758     # Note: $oldconf is undef if VM does not exists
3759     my $oldconf = PVE::Cluster::cfs_read_file(cfs_config_path($vmid));
3760
3761     my $print_devmap = sub {
3762         my $virtdev_hash = {};
3763
3764         my $cfgfn = "$tmpdir/qemu-server.conf";
3765
3766         # we can read the config - that is already extracted
3767         my $fh = IO::File->new($cfgfn, "r") ||
3768             "unable to read qemu-server.conf - $!\n";
3769
3770         while (defined(my $line = <$fh>)) {
3771             if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
3772                 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
3773                 die "archive does not contain data for drive '$virtdev'\n"
3774                     if !$devinfo->{$devname};
3775                 if (defined($opts->{storage})) {
3776                     $storeid = $opts->{storage} || 'local';
3777                 } elsif (!$storeid) {
3778                     $storeid = 'local';
3779                 }
3780                 $format = 'raw' if !$format;
3781                 $devinfo->{$devname}->{devname} = $devname;
3782                 $devinfo->{$devname}->{virtdev} = $virtdev;
3783                 $devinfo->{$devname}->{format} = $format;
3784                 $devinfo->{$devname}->{storeid} = $storeid;
3785
3786                 # check permission on storage
3787                 my $pool = $opts->{pool}; # todo: do we need that?
3788                 if ($user ne 'root@pam') {
3789                     $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
3790                 }
3791
3792                 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
3793             }
3794         }
3795
3796         foreach my $devname (keys %$devinfo) {
3797             die "found no device mapping information for device '$devname'\n"
3798                 if !$devinfo->{$devname}->{virtdev};
3799         }
3800
3801         my $cfg = cfs_read_file('storage.cfg');
3802
3803         # create empty/temp config
3804         if ($oldconf) {
3805             PVE::Tools::file_set_contents($conffile, "memory: 128\n");
3806             foreach_drive($oldconf, sub {
3807                 my ($ds, $drive) = @_;
3808
3809                 return if drive_is_cdrom($drive);
3810
3811                 my $volid = $drive->{file};
3812
3813                 return if !$volid || $volid =~ m|^/|;
3814
3815                 my ($path, $owner) = PVE::Storage::path($cfg, $volid);
3816                 return if !$path || !$owner || ($owner != $vmid);
3817
3818                 # Note: only delete disk we want to restore
3819                 # other volumes will become unused
3820                 if ($virtdev_hash->{$ds}) {
3821                     PVE::Storage::vdisk_free($cfg, $volid);
3822                 }
3823             });
3824         }
3825
3826         my $map = {};
3827         foreach my $virtdev (sort keys %$virtdev_hash) {
3828             my $d = $virtdev_hash->{$virtdev};
3829             my $alloc_size = int(($d->{size} + 1024 - 1)/1024);
3830             my $scfg = PVE::Storage::storage_config($cfg, $d->{storeid});
3831             my $volid = PVE::Storage::vdisk_alloc($cfg, $d->{storeid}, $vmid,
3832                                                   $d->{format}, undef, $alloc_size);
3833             print STDERR "new volume ID is '$volid'\n";
3834             $d->{volid} = $volid;
3835             my $path = PVE::Storage::path($cfg, $volid);
3836
3837             my $write_zeros = 1;
3838             # fixme: what other storages types initialize volumes with zero?
3839             if ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs' ||
3840                 $scfg->{type} eq 'sheepdog' || $scfg->{type} eq 'rbd') {
3841                 $write_zeros = 0;
3842             }
3843
3844             print $fifofh "${write_zeros}:$d->{devname}=$path\n";
3845
3846             print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
3847             $map->{$virtdev} = $volid;
3848         }
3849
3850         $fh->seek(0, 0) || die "seek failed - $!\n";
3851
3852         my $outfd = new IO::File ($tmpfn, "w") ||
3853             die "unable to write config for VM $vmid\n";
3854
3855         my $cookie = { netcount => 0 };
3856         while (defined(my $line = <$fh>)) {
3857             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
3858         }
3859
3860         $fh->close();
3861         $outfd->close();
3862     };
3863
3864     eval {
3865         # enable interrupts
3866         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
3867             die "interrupted by signal\n";
3868         };
3869         local $SIG{ALRM} = sub { die "got timeout\n"; };
3870
3871         $oldtimeout = alarm($timeout);
3872
3873         my $parser = sub {
3874             my $line = shift;
3875
3876             print "$line\n";
3877
3878             if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
3879                 my ($dev_id, $size, $devname) = ($1, $2, $3);
3880                 $devinfo->{$devname} = { size => $size, dev_id => $dev_id };
3881             } elsif ($line =~ m/^CTIME: /) {
3882                 &$print_devmap();
3883                 print $fifofh "done\n";
3884                 my $tmp = $oldtimeout || 0;
3885                 $oldtimeout = undef;
3886                 alarm($tmp);
3887                 close($fifofh);
3888             }
3889         };
3890
3891         print "restore vma archive: $cmd\n";
3892         run_command($cmd, input => $input, outfunc => $parser, afterfork => $openfifo);
3893     };
3894     my $err = $@;
3895
3896     alarm($oldtimeout) if $oldtimeout;
3897
3898     unlink $mapfifo;
3899
3900     if ($err) {
3901         rmtree $tmpdir;
3902         unlink $tmpfn;
3903
3904         my $cfg = cfs_read_file('storage.cfg');
3905         foreach my $devname (keys %$devinfo) {
3906             my $volid = $devinfo->{$devname}->{volid};
3907             next if !$volid;
3908             eval {
3909                 if ($volid =~ m|^/|) {
3910                     unlink $volid || die 'unlink failed\n';
3911                 } else {
3912                     PVE::Storage::vdisk_free($cfg, $volid);
3913                 }
3914                 print STDERR "temporary volume '$volid' sucessfuly removed\n";
3915             };
3916             print STDERR "unable to cleanup '$volid' - $@" if $@;
3917         }
3918         die $err;
3919     }
3920
3921     rmtree $tmpdir;
3922
3923     rename($tmpfn, $conffile) ||
3924         die "unable to commit configuration file '$conffile'\n";
3925
3926     PVE::Cluster::cfs_update(); # make sure we read new file
3927
3928     eval { rescan($vmid, 1); };
3929     warn $@ if $@;
3930 }
3931
3932 sub restore_tar_archive {
3933     my ($archive, $vmid, $user, $opts) = @_;
3934
3935     if ($archive ne '-') {
3936         my $firstfile = tar_archive_read_firstfile($archive);
3937         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
3938             if $firstfile ne 'qemu-server.conf';
3939     }
3940
3941     my $storecfg = cfs_read_file('storage.cfg');
3942
3943     # destroy existing data - keep empty config
3944     my $vmcfgfn = PVE::QemuServer::config_file($vmid);
3945     destroy_vm($storecfg, $vmid, 1) if -f $vmcfgfn;
3946
3947     my $tocmd = "/usr/lib/qemu-server/qmextract";
3948
3949     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
3950     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
3951     $tocmd .= ' --prealloc' if $opts->{prealloc};
3952     $tocmd .= ' --info' if $opts->{info};
3953
3954     # tar option "xf" does not autodetect compression when read from STDIN,
3955     # so we pipe to zcat
3956     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
3957         PVE::Tools::shellquote("--to-command=$tocmd");
3958
3959     my $tmpdir = "/var/tmp/vzdumptmp$$";
3960     mkpath $tmpdir;
3961
3962     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
3963     local $ENV{VZDUMP_VMID} = $vmid;
3964     local $ENV{VZDUMP_USER} = $user;
3965
3966     my $conffile = config_file($vmid);
3967     my $tmpfn = "$conffile.$$.tmp";
3968
3969     # disable interrupts (always do cleanups)
3970     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
3971         print STDERR "got interrupt - ignored\n";
3972     };
3973
3974     eval {
3975         # enable interrupts
3976         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
3977             die "interrupted by signal\n";
3978         };
3979
3980         if ($archive eq '-') {
3981             print "extracting archive from STDIN\n";
3982             run_command($cmd, input => "<&STDIN");
3983         } else {
3984             print "extracting archive '$archive'\n";
3985             run_command($cmd);
3986         }
3987
3988         return if $opts->{info};
3989
3990         # read new mapping
3991         my $map = {};
3992         my $statfile = "$tmpdir/qmrestore.stat";
3993         if (my $fd = IO::File->new($statfile, "r")) {
3994             while (defined (my $line = <$fd>)) {
3995                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3996                     $map->{$1} = $2 if $1;
3997                 } else {
3998                     print STDERR "unable to parse line in statfile - $line\n";
3999                 }
4000             }
4001             $fd->close();
4002         }
4003
4004         my $confsrc = "$tmpdir/qemu-server.conf";
4005
4006         my $srcfd = new IO::File($confsrc, "r") ||
4007             die "unable to open file '$confsrc'\n";
4008
4009         my $outfd = new IO::File ($tmpfn, "w") ||
4010             die "unable to write config for VM $vmid\n";
4011
4012         my $cookie = { netcount => 0 };
4013         while (defined (my $line = <$srcfd>)) {
4014             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
4015         }
4016
4017         $srcfd->close();
4018         $outfd->close();
4019     };
4020     my $err = $@;
4021
4022     if ($err) {
4023
4024         unlink $tmpfn;
4025
4026         tar_restore_cleanup($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info};
4027
4028         die $err;
4029     }
4030
4031     rmtree $tmpdir;
4032
4033     rename $tmpfn, $conffile ||
4034         die "unable to commit configuration file '$conffile'\n";
4035
4036     PVE::Cluster::cfs_update(); # make sure we read new file
4037
4038     eval { rescan($vmid, 1); };
4039     warn $@ if $@;
4040 };
4041
4042
4043 # Internal snapshots
4044
4045 # NOTE: Snapshot create/delete involves several non-atomic
4046 # action, and can take a long time.
4047 # So we try to avoid locking the file and use 'lock' variable
4048 # inside the config file instead.
4049
4050 my $snapshot_copy_config = sub {
4051     my ($source, $dest) = @_;
4052
4053     foreach my $k (keys %$source) {
4054         next if $k eq 'snapshots';
4055         next if $k eq 'snapstate';
4056         next if $k eq 'snaptime';
4057         next if $k eq 'vmstate';
4058         next if $k eq 'lock';
4059         next if $k eq 'digest';
4060         next if $k eq 'description';
4061         next if $k =~ m/^unused\d+$/;
4062
4063         $dest->{$k} = $source->{$k};
4064     }
4065 };
4066
4067 my $snapshot_apply_config = sub {
4068     my ($conf, $snap) = @_;
4069
4070     # copy snapshot list
4071     my $newconf = {
4072         snapshots => $conf->{snapshots},
4073     };
4074
4075     # keep description and list of unused disks
4076     foreach my $k (keys %$conf) {
4077         next if !($k =~ m/^unused\d+$/ || $k eq 'description');
4078         $newconf->{$k} = $conf->{$k};
4079     }
4080
4081     &$snapshot_copy_config($snap, $newconf);
4082
4083     return $newconf;
4084 };
4085
4086 sub foreach_writable_storage {
4087     my ($conf, $func) = @_;
4088
4089     my $sidhash = {};
4090
4091     foreach my $ds (keys %$conf) {
4092         next if !valid_drivename($ds);
4093
4094         my $drive = parse_drive($ds, $conf->{$ds});
4095         next if !$drive;
4096         next if drive_is_cdrom($drive);
4097
4098         my $volid = $drive->{file};
4099
4100         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
4101         $sidhash->{$sid} = $sid if $sid;
4102     }
4103
4104     foreach my $sid (sort keys %$sidhash) {
4105         &$func($sid);
4106     }
4107 }
4108
4109 my $alloc_vmstate_volid = sub {
4110     my ($storecfg, $vmid, $conf, $snapname) = @_;
4111
4112     # Note: we try to be smart when selecting a $target storage
4113
4114     my $target;
4115
4116     # search shared storage first
4117     foreach_writable_storage($conf, sub {
4118         my ($sid) = @_;
4119         my $scfg = PVE::Storage::storage_config($storecfg, $sid);
4120         return if !$scfg->{shared};
4121
4122         $target = $sid if !$target || $scfg->{path}; # prefer file based storage
4123     });
4124
4125     if (!$target) {
4126         # now search local storage
4127         foreach_writable_storage($conf, sub {
4128             my ($sid) = @_;
4129             my $scfg = PVE::Storage::storage_config($storecfg, $sid);
4130             return if $scfg->{shared};
4131
4132             $target = $sid if !$target || $scfg->{path}; # prefer file based storage;
4133         });
4134     }
4135
4136     $target = 'local' if !$target;
4137
4138     my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
4139     # we abort live save after $conf->{memory}, so we need at max twice that space
4140     my $size = $conf->{memory}*2 + $driver_state_size;
4141
4142     my $name = "vm-$vmid-state-$snapname";
4143     my $scfg = PVE::Storage::storage_config($storecfg, $target);
4144     $name .= ".raw" if $scfg->{path}; # add filename extension for file base storage
4145     my $volid = PVE::Storage::vdisk_alloc($storecfg, $target, $vmid, 'raw', $name, $size*1024);
4146
4147     return $volid;
4148 };
4149
4150 my $snapshot_prepare = sub {
4151     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
4152
4153     my $snap;
4154
4155     my $updatefn =  sub {
4156
4157         my $conf = load_config($vmid);
4158
4159         die "you can't take a snapshot if it's a template\n"
4160             if is_template($conf);
4161
4162         check_lock($conf);
4163
4164         $conf->{lock} = 'snapshot';
4165
4166         die "snapshot name '$snapname' already used\n"
4167             if defined($conf->{snapshots}->{$snapname});
4168
4169         my $storecfg = PVE::Storage::config();
4170         die "snapshot feature is not available" if !has_feature('snapshot', $conf, $storecfg);
4171
4172         $snap = $conf->{snapshots}->{$snapname} = {};
4173
4174         if ($save_vmstate && check_running($vmid)) {
4175             $snap->{vmstate} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
4176         }
4177
4178         &$snapshot_copy_config($conf, $snap);
4179
4180         $snap->{snapstate} = "prepare";
4181         $snap->{snaptime} = time();
4182         $snap->{description} = $comment if $comment;
4183
4184         update_config_nolock($vmid, $conf, 1);
4185     };
4186
4187     lock_config($vmid, $updatefn);
4188
4189     return $snap;
4190 };
4191
4192 my $snapshot_commit = sub {
4193     my ($vmid, $snapname) = @_;
4194
4195     my $updatefn = sub {
4196
4197         my $conf = load_config($vmid);
4198
4199         die "missing snapshot lock\n"
4200             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
4201
4202         my $snap = $conf->{snapshots}->{$snapname};
4203
4204         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4205
4206         die "wrong snapshot state\n"
4207             if !($snap->{snapstate} && $snap->{snapstate} eq "prepare");
4208
4209         delete $snap->{snapstate};
4210         delete $conf->{lock};
4211
4212         my $newconf = &$snapshot_apply_config($conf, $snap);
4213
4214         $newconf->{parent} = $snapname;
4215
4216         update_config_nolock($vmid, $newconf, 1);
4217     };
4218
4219     lock_config($vmid, $updatefn);
4220 };
4221
4222 sub snapshot_rollback {
4223     my ($vmid, $snapname) = @_;
4224
4225     my $snap;
4226
4227     my $prepare = 1;
4228
4229     my $storecfg = PVE::Storage::config();
4230
4231     my $updatefn = sub {
4232
4233         my $conf = load_config($vmid);
4234
4235         die "you can't rollback if vm is a template\n" if is_template($conf);
4236
4237         $snap = $conf->{snapshots}->{$snapname};
4238
4239         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4240
4241         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
4242             if $snap->{snapstate};
4243
4244         if ($prepare) {
4245             check_lock($conf);
4246             vm_stop($storecfg, $vmid, undef, undef, 5, undef, undef);
4247         }
4248
4249         die "unable to rollback vm $vmid: vm is running\n"
4250             if check_running($vmid);
4251
4252         if ($prepare) {
4253             $conf->{lock} = 'rollback';
4254         } else {
4255             die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
4256             delete $conf->{lock};
4257         }
4258
4259         if (!$prepare) {
4260             # copy snapshot config to current config
4261             $conf = &$snapshot_apply_config($conf, $snap);
4262             $conf->{parent} = $snapname;
4263         }
4264
4265         update_config_nolock($vmid, $conf, 1);
4266
4267         if (!$prepare && $snap->{vmstate}) {
4268             my $statefile = PVE::Storage::path($storecfg, $snap->{vmstate});
4269             vm_start($storecfg, $vmid, $statefile);
4270         }
4271     };
4272
4273     lock_config($vmid, $updatefn);
4274
4275     foreach_drive($snap, sub {
4276         my ($ds, $drive) = @_;
4277
4278         return if drive_is_cdrom($drive);
4279
4280         my $volid = $drive->{file};
4281         my $device = "drive-$ds";
4282
4283         PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
4284     });
4285
4286     $prepare = 0;
4287     lock_config($vmid, $updatefn);
4288 }
4289
4290 my $savevm_wait = sub {
4291     my ($vmid) = @_;
4292
4293     for(;;) {
4294         my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
4295         if (!$stat->{status}) {
4296             die "savevm not active\n";
4297         } elsif ($stat->{status} eq 'active') {
4298             sleep(1);
4299             next;
4300         } elsif ($stat->{status} eq 'completed') {
4301             last;
4302         } else {
4303             die "query-savevm returned status '$stat->{status}'\n";
4304         }
4305     }
4306 };
4307
4308 sub snapshot_create {
4309     my ($vmid, $snapname, $save_vmstate, $freezefs, $comment) = @_;
4310
4311     my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
4312
4313     $freezefs = $save_vmstate = 0 if !$snap->{vmstate}; # vm is not running
4314
4315     my $drivehash = {};
4316
4317     my $running = check_running($vmid);
4318
4319     eval {
4320         # create internal snapshots of all drives
4321
4322         my $storecfg = PVE::Storage::config();
4323
4324         if ($running) {
4325             if ($snap->{vmstate}) {
4326                 my $path = PVE::Storage::path($storecfg, $snap->{vmstate});
4327                 vm_mon_cmd($vmid, "savevm-start", statefile => $path);
4328                 &$savevm_wait($vmid);
4329             } else {
4330                 vm_mon_cmd($vmid, "savevm-start");
4331             }
4332         };
4333
4334         qga_freezefs($vmid) if $running && $freezefs;
4335
4336         foreach_drive($snap, sub {
4337             my ($ds, $drive) = @_;
4338
4339             return if drive_is_cdrom($drive);
4340
4341             my $volid = $drive->{file};
4342             my $device = "drive-$ds";
4343
4344             qemu_volume_snapshot($vmid, $device, $storecfg, $volid, $snapname);
4345             $drivehash->{$ds} = 1;
4346        });
4347     };
4348     my $err = $@;
4349
4350     eval { gqa_unfreezefs($vmid) if $running && $freezefs; };
4351     warn $@ if $@;
4352
4353     eval { vm_mon_cmd($vmid, "savevm-end") if $running; };
4354     warn $@ if $@;
4355
4356     if ($err) {
4357         warn "snapshot create failed: starting cleanup\n";
4358         eval { snapshot_delete($vmid, $snapname, 0, $drivehash); };
4359         warn $@ if $@;
4360         die $err;
4361     }
4362
4363     &$snapshot_commit($vmid, $snapname);
4364 }
4365
4366 # Note: $drivehash is only set when called from snapshot_create.
4367 sub snapshot_delete {
4368     my ($vmid, $snapname, $force, $drivehash) = @_;
4369
4370     my $prepare = 1;
4371
4372     my $snap;
4373     my $unused = [];
4374
4375     my $unlink_parent = sub {
4376         my ($confref, $new_parent) = @_;
4377
4378         if ($confref->{parent} && $confref->{parent} eq $snapname) {
4379             if ($new_parent) {
4380                 $confref->{parent} = $new_parent;
4381             } else {
4382                 delete $confref->{parent};
4383             }
4384         }
4385     };
4386
4387     my $updatefn =  sub {
4388         my ($remove_drive) = @_;
4389
4390         my $conf = load_config($vmid);
4391
4392         if (!$drivehash) {
4393             check_lock($conf);
4394             die "you can't delete a snapshot if vm is a template\n"
4395                 if is_template($conf);
4396         }
4397
4398         $snap = $conf->{snapshots}->{$snapname};
4399
4400         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4401
4402         # remove parent refs
4403         &$unlink_parent($conf, $snap->{parent});
4404         foreach my $sn (keys %{$conf->{snapshots}}) {
4405             next if $sn eq $snapname;
4406             &$unlink_parent($conf->{snapshots}->{$sn}, $snap->{parent});
4407         }
4408
4409         if ($remove_drive) {
4410             if ($remove_drive eq 'vmstate') {
4411                 delete $snap->{$remove_drive};
4412             } else {
4413                 my $drive = parse_drive($remove_drive, $snap->{$remove_drive});
4414                 my $volid = $drive->{file};
4415                 delete $snap->{$remove_drive};
4416                 add_unused_volume($conf, $volid);
4417             }
4418         }
4419
4420         if ($prepare) {
4421             $snap->{snapstate} = 'delete';
4422         } else {
4423             delete $conf->{snapshots}->{$snapname};
4424             delete $conf->{lock} if $drivehash;
4425             foreach my $volid (@$unused) {
4426                 add_unused_volume($conf, $volid);
4427             }
4428         }
4429
4430         update_config_nolock($vmid, $conf, 1);
4431     };
4432
4433     lock_config($vmid, $updatefn);
4434
4435     # now remove vmstate file
4436
4437     my $storecfg = PVE::Storage::config();
4438
4439     if ($snap->{vmstate}) {
4440         eval {  PVE::Storage::vdisk_free($storecfg, $snap->{vmstate}); };
4441         if (my $err = $@) {
4442             die $err if !$force;
4443             warn $err;
4444         }
4445         # save changes (remove vmstate from snapshot)
4446         lock_config($vmid, $updatefn, 'vmstate') if !$force;
4447     };
4448
4449     # now remove all internal snapshots
4450     foreach_drive($snap, sub {
4451         my ($ds, $drive) = @_;
4452
4453         return if drive_is_cdrom($drive);
4454
4455         my $volid = $drive->{file};
4456         my $device = "drive-$ds";
4457
4458         if (!$drivehash || $drivehash->{$ds}) {
4459             eval { qemu_volume_snapshot_delete($vmid, $device, $storecfg, $volid, $snapname); };
4460             if (my $err = $@) {
4461                 die $err if !$force;
4462                 warn $err;
4463             }
4464         }
4465
4466         # save changes (remove drive fron snapshot)
4467         lock_config($vmid, $updatefn, $ds) if !$force;
4468         push @$unused, $volid;
4469     });
4470
4471     # now cleanup config
4472     $prepare = 0;
4473     lock_config($vmid, $updatefn);
4474 }
4475
4476 sub has_feature {
4477     my ($feature, $conf, $storecfg, $snapname, $running) = @_;
4478
4479     my $err;
4480     foreach_drive($conf, sub {
4481         my ($ds, $drive) = @_;
4482
4483         return if drive_is_cdrom($drive);
4484         my $volid = $drive->{file};
4485         $err = 1 if !PVE::Storage::volume_has_feature($storecfg, $feature, $volid, $snapname, $running);
4486     });
4487
4488     return $err ? 0 : 1;
4489 }
4490
4491 sub template_create {
4492     my ($vmid, $conf, $disk) = @_;
4493
4494     my $storecfg = PVE::Storage::config();
4495
4496     foreach_drive($conf, sub {
4497         my ($ds, $drive) = @_;
4498
4499         return if drive_is_cdrom($drive);
4500         return if $disk && $ds ne $disk;
4501
4502         my $volid = $drive->{file};
4503         return if !PVE::Storage::volume_has_feature($storecfg, 'template', $volid);
4504
4505         my $voliddst = PVE::Storage::vdisk_create_base($storecfg, $volid);
4506         $drive->{file} = $voliddst;
4507         $conf->{$ds} = PVE::QemuServer::print_drive($vmid, $drive);
4508         PVE::QemuServer::update_config_nolock($vmid, $conf, 1);
4509     });
4510 }
4511
4512 sub is_template {
4513     my ($conf) = @_;
4514
4515     return 1 if defined $conf->{template} && $conf->{template} == 1;
4516 }
4517
4518 sub qemu_img_convert {
4519     my ($src_volid, $dst_volid, $size, $snapname) = @_;
4520
4521     my $storecfg = PVE::Storage::config();
4522     my ($src_storeid, $src_volname) = PVE::Storage::parse_volume_id($src_volid, 1);
4523     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
4524
4525     if ($src_storeid && $dst_storeid) {
4526         my $src_scfg = PVE::Storage::storage_config($storecfg, $src_storeid);
4527         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
4528
4529         my $src_format = qemu_img_format($src_scfg, $src_volname);
4530         my $dst_format = qemu_img_format($dst_scfg, $dst_volname);
4531
4532         my $src_path = PVE::Storage::path($storecfg, $src_volid, $snapname);
4533         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
4534
4535         my $cmd = [];
4536         push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-C';
4537         push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
4538         push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
4539
4540         my $parser = sub {
4541             my $line = shift;
4542             if($line =~ m/\((\S+)\/100\%\)/){
4543                 my $percent = $1;
4544                 my $transferred = int($size * $percent / 100);
4545                 my $remaining = $size - $transferred;
4546
4547                 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
4548             }
4549
4550         };
4551
4552         eval  { run_command($cmd, timeout => undef, outfunc => $parser); };
4553         my $err = $@;
4554         die "copy failed: $err" if $err;
4555     }
4556 }
4557
4558 sub qemu_img_format {
4559     my ($scfg, $volname) = @_;
4560
4561     if ($scfg->{path} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/){
4562         return $1;
4563     }
4564     elsif ($scfg->{type} eq 'nexenta' || $scfg->{type} eq 'iscsidirect'){
4565         return "iscsi";
4566     }
4567     elsif ($scfg->{type} eq 'lvm' || $scfg->{type} eq 'iscsi'){
4568         return "host_device";
4569     }
4570     elsif ($scfg->{type} eq 'rbd'){
4571         return "raw";
4572     }
4573     #sheepdog other qemu block driver
4574     else{
4575         return $scfg->{type};
4576     }
4577 }
4578
4579 sub qemu_drive_mirror {
4580     my ($vmid, $drive, $dst_volid, $vmiddst, $maxwait) = @_;
4581
4582     my $count = 1;
4583     my $old_len = 0;
4584     my $frozen = undef;
4585
4586     my $storecfg = PVE::Storage::config();
4587     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
4588
4589     if ($dst_storeid) {
4590         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
4591
4592         my $format = undef;
4593         if ($dst_volname =~ m/\.(raw|qcow2)$/){
4594             $format = $1;
4595         }
4596
4597         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
4598
4599         if($format){
4600             #fixme : sometime drive-mirror timeout, but works fine after. (I have see the problem with big volume > 200GB), so we need to eval
4601             eval{ PVE::QemuServer::vm_mon_cmd($vmid, "drive-mirror", timeout => 10, device => "drive-$drive", mode => "existing", sync => "full", target => $dst_path, format => $format); };
4602         }else{
4603             eval{ PVE::QemuServer::vm_mon_cmd($vmid, "drive-mirror", timeout => 10, device => "drive-$drive", mode => "existing", sync => "full", target => $dst_path); };
4604         }
4605         eval{
4606             while (1) {
4607                 my $stats = PVE::QemuServer::vm_mon_cmd($vmid, "query-block-jobs");
4608                 my $stat = @$stats[0];
4609                 die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
4610                 die "error job is not mirroring" if $stat->{type} ne "mirror";
4611
4612                 my $transferred = $stat->{offset};
4613                 my $total = $stat->{len};
4614                 my $remaining = $total - $transferred;
4615                 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
4616
4617                 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent %\n";
4618
4619                 last if ($stat->{len} == $stat->{offset});
4620                 if ($old_len == $stat->{offset}) {
4621                     if ($maxwait && $count > $maxwait) {
4622                     # if writes to disk occurs the disk needs to be freezed
4623                     # to be able to complete the migration
4624                         vm_suspend($vmid,1);
4625                         $count = 0;
4626                         $frozen = 1;
4627                     }else {
4628                         $count++ unless $frozen;
4629                     }
4630                 }
4631                 elsif ($frozen) {
4632                         vm_resume($vmid,1);
4633                         $count = 0;
4634                 }
4635                 $old_len = $stat->{offset};
4636                 sleep 1;
4637             }
4638         };
4639         if (my $err = $@) {
4640             eval { PVE::QemuServer::vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive"); };
4641             die "mirroring error: $err";
4642         }
4643
4644         if($vmiddst != $vmid){
4645             #if we clone a disk for a new target vm, we don't switch the disk
4646             PVE::QemuServer::vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive");
4647         }else{
4648             #if source and destination are on the same guest
4649             PVE::QemuServer::vm_mon_cmd($vmid, "block-job-complete", device => "drive-$drive");
4650         }
4651     }
4652 }
4653
4654 1;