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 vm_devices_list {
2544     my ($vmid) = @_;
2545
2546     my $res = vm_mon_cmd($vmid, 'query-pci');
2547
2548     my $devices = {};
2549     foreach my $pcibus (@$res) {
2550         foreach my $device (@{$pcibus->{devices}}) {
2551             next if !$device->{'qdev_id'};
2552             $devices->{$device->{'qdev_id'}} = $device;
2553         }
2554     }
2555
2556     return $devices;
2557 }
2558
2559 sub vm_deviceplug {
2560     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2561
2562     return 1 if !check_running($vmid);
2563
2564     if ($deviceid eq 'tablet') {
2565         my $devicefull = "usb-tablet,id=tablet,bus=uhci.0,port=1";
2566         qemu_deviceadd($vmid, $devicefull);
2567         return 1;
2568     }
2569
2570     return 1 if !$conf->{hotplug};
2571
2572     my $devices_list = vm_devices_list($vmid);
2573     return 1 if defined($devices_list->{$deviceid});
2574
2575     qemu_bridgeadd($storecfg, $conf, $vmid, $deviceid); #add bridge if we need it for the device
2576
2577     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2578         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2579         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
2580         qemu_deviceadd($vmid, $devicefull);
2581         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2582            qemu_drivedel($vmid, $deviceid);
2583            return undef;
2584         }
2585     }
2586
2587     if ($deviceid =~ m/^(scsihw)(\d+)$/) {
2588         my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : "lsi";
2589         my $pciaddr = print_pci_addr($deviceid);
2590         my $devicefull = "$scsihw,id=$deviceid$pciaddr";
2591         qemu_deviceadd($vmid, $devicefull);
2592         return undef if(!qemu_deviceaddverify($vmid, $deviceid));
2593     }
2594
2595     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2596         return 1 if ($conf->{scsihw} && $conf->{scsihw} ne 'lsi'); #virtio-scsi not yet support hotplug
2597         return undef if !qemu_findorcreatescsihw($storecfg,$conf, $vmid, $device);
2598         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2599         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
2600         if(!qemu_deviceadd($vmid, $devicefull)) {
2601            qemu_drivedel($vmid, $deviceid);
2602            return undef;
2603         }
2604     }
2605
2606     if ($deviceid =~ m/^(net)(\d+)$/) {
2607         return undef if !qemu_netdevadd($vmid, $conf, $device, $deviceid);
2608         my $netdevicefull = print_netdevice_full($vmid, $conf, $device, $deviceid);
2609         qemu_deviceadd($vmid, $netdevicefull);
2610         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2611            qemu_netdevdel($vmid, $deviceid);
2612            return undef;
2613         }
2614     }
2615
2616     if ($deviceid =~ m/^(pci\.)(\d+)$/) {
2617         my $bridgeid = $2;
2618         my $pciaddr = print_pci_addr($deviceid);
2619         my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
2620         qemu_deviceadd($vmid, $devicefull);
2621         return undef if !qemu_deviceaddverify($vmid, $deviceid);
2622     }
2623
2624     return 1;
2625 }
2626
2627 sub vm_deviceunplug {
2628     my ($vmid, $conf, $deviceid) = @_;
2629
2630     return 1 if !check_running ($vmid);
2631
2632     if ($deviceid eq 'tablet') {
2633         qemu_devicedel($vmid, $deviceid);
2634         return 1;
2635     }
2636
2637     return 1 if !$conf->{hotplug};
2638
2639     my $devices_list = vm_devices_list($vmid);
2640     return 1 if !defined($devices_list->{$deviceid});
2641
2642     die "can't unplug bootdisk" if $conf->{bootdisk} && $conf->{bootdisk} eq $deviceid;
2643
2644     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2645         qemu_devicedel($vmid, $deviceid);
2646         return undef if !qemu_devicedelverify($vmid, $deviceid);
2647         return undef if !qemu_drivedel($vmid, $deviceid);
2648     }
2649
2650     if ($deviceid =~ m/^(lsi)(\d+)$/) {
2651         return undef if !qemu_devicedel($vmid, $deviceid);
2652     }
2653
2654     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2655         return undef if !qemu_devicedel($vmid, $deviceid);
2656         return undef if !qemu_drivedel($vmid, $deviceid);
2657     }
2658
2659     if ($deviceid =~ m/^(net)(\d+)$/) {
2660         qemu_devicedel($vmid, $deviceid);
2661         return undef if !qemu_devicedelverify($vmid, $deviceid);
2662         return undef if !qemu_netdevdel($vmid, $deviceid);
2663     }
2664
2665     return 1;
2666 }
2667
2668 sub qemu_deviceadd {
2669     my ($vmid, $devicefull) = @_;
2670
2671     $devicefull = "driver=".$devicefull;
2672     my %options =  split(/[=,]/, $devicefull);
2673
2674     vm_mon_cmd($vmid, "device_add" , %options);
2675     return 1;
2676 }
2677
2678 sub qemu_devicedel {
2679     my($vmid, $deviceid) = @_;
2680     my $ret = vm_mon_cmd($vmid, "device_del", id => $deviceid);
2681     return 1;
2682 }
2683
2684 sub qemu_driveadd {
2685     my($storecfg, $vmid, $device) = @_;
2686
2687     my $drive = print_drive_full($storecfg, $vmid, $device);
2688     my $ret = vm_human_monitor_command($vmid, "drive_add auto $drive");
2689     # If the command succeeds qemu prints: "OK"
2690     if ($ret !~ m/OK/s) {
2691         syslog("err", "adding drive failed: $ret");
2692         return undef;
2693     }
2694     return 1;
2695 }
2696
2697 sub qemu_drivedel {
2698     my($vmid, $deviceid) = @_;
2699
2700     my $ret = vm_human_monitor_command($vmid, "drive_del drive-$deviceid");
2701     $ret =~ s/^\s+//;
2702     if ($ret =~ m/Device \'.*?\' not found/s) {
2703         # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2704     }
2705     elsif ($ret ne "") {
2706       syslog("err", "deleting drive $deviceid failed : $ret");
2707       return undef;
2708     }
2709     return 1;
2710 }
2711
2712 sub qemu_deviceaddverify {
2713     my ($vmid,$deviceid) = @_;
2714
2715     for (my $i = 0; $i <= 5; $i++) {
2716          my $devices_list = vm_devices_list($vmid);
2717          return 1 if defined($devices_list->{$deviceid});
2718          sleep 1;
2719     }
2720     syslog("err", "error on hotplug device $deviceid");
2721     return undef;
2722 }
2723
2724
2725 sub qemu_devicedelverify {
2726     my ($vmid,$deviceid) = @_;
2727
2728     #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2729     for (my $i = 0; $i <= 5; $i++) {
2730          my $devices_list = vm_devices_list($vmid);
2731          return 1 if !defined($devices_list->{$deviceid});
2732          sleep 1;
2733     }
2734     syslog("err", "error on hot-unplugging device $deviceid");
2735     return undef;
2736 }
2737
2738 sub qemu_findorcreatescsihw {
2739     my ($storecfg, $conf, $vmid, $device) = @_;
2740
2741     my $maxdev = ($conf->{scsihw} && $conf->{scsihw} ne 'lsi') ? 256 : 7;
2742     my $controller = int($device->{index} / $maxdev);
2743     my $scsihwid="scsihw$controller";
2744     my $devices_list = vm_devices_list($vmid);
2745
2746     if(!defined($devices_list->{$scsihwid})) {
2747        return undef if !vm_deviceplug($storecfg, $conf, $vmid, $scsihwid);
2748     }
2749     return 1;
2750 }
2751
2752 sub qemu_bridgeadd {
2753     my ($storecfg, $conf, $vmid, $device) = @_;
2754
2755     my $bridges = {};
2756     my $bridgeid = undef;
2757     print_pci_addr($device, $bridges);
2758
2759     while (my ($k, $v) = each %$bridges) {
2760         $bridgeid = $k;
2761     }
2762     return if $bridgeid < 1;
2763     my $bridge = "pci.$bridgeid";
2764     my $devices_list = vm_devices_list($vmid);
2765
2766     if(!defined($devices_list->{$bridge})) {
2767         return undef if !vm_deviceplug($storecfg, $conf, $vmid, $bridge);
2768     }
2769     return 1;
2770 }
2771
2772 sub qemu_netdevadd {
2773     my ($vmid, $conf, $device, $deviceid) = @_;
2774
2775     my $netdev = print_netdev_full($vmid, $conf, $device, $deviceid);
2776     my %options =  split(/[=,]/, $netdev);
2777
2778     vm_mon_cmd($vmid, "netdev_add",  %options);
2779     return 1;
2780 }
2781
2782 sub qemu_netdevdel {
2783     my ($vmid, $deviceid) = @_;
2784
2785     vm_mon_cmd($vmid, "netdev_del", id => $deviceid);
2786     return 1;
2787 }
2788
2789 sub qemu_block_set_io_throttle {
2790     my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
2791
2792     return if !check_running($vmid) ;
2793
2794     $bps = 0 if !$bps;
2795     $bps_rd = 0 if !$bps_rd;
2796     $bps_wr = 0 if !$bps_wr;
2797     $iops = 0 if !$iops;
2798     $iops_rd = 0 if !$iops_rd;
2799     $iops_wr = 0 if !$iops_wr;
2800
2801     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));
2802
2803 }
2804
2805 # old code, only used to shutdown old VM after update
2806 sub __read_avail {
2807     my ($fh, $timeout) = @_;
2808
2809     my $sel = new IO::Select;
2810     $sel->add($fh);
2811
2812     my $res = '';
2813     my $buf;
2814
2815     my @ready;
2816     while (scalar (@ready = $sel->can_read($timeout))) {
2817         my $count;
2818         if ($count = $fh->sysread($buf, 8192)) {
2819             if ($buf =~ /^(.*)\(qemu\) $/s) {
2820                 $res .= $1;
2821                 last;
2822             } else {
2823                 $res .= $buf;
2824             }
2825         } else {
2826             if (!defined($count)) {
2827                 die "$!\n";
2828             }
2829             last;
2830         }
2831     }
2832
2833     die "monitor read timeout\n" if !scalar(@ready);
2834
2835     return $res;
2836 }
2837
2838 # old code, only used to shutdown old VM after update
2839 sub vm_monitor_command {
2840     my ($vmid, $cmdstr, $nocheck) = @_;
2841
2842     my $res;
2843
2844     eval {
2845         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
2846
2847         my $sname = "${var_run_tmpdir}/$vmid.mon";
2848
2849         my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
2850             die "unable to connect to VM $vmid socket - $!\n";
2851
2852         my $timeout = 3;
2853
2854         # hack: migrate sometime blocks the monitor (when migrate_downtime
2855         # is set)
2856         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2857             $timeout = 60*60; # 1 hour
2858         }
2859
2860         # read banner;
2861         my $data = __read_avail($sock, $timeout);
2862
2863         if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
2864             die "got unexpected qemu monitor banner\n";
2865         }
2866
2867         my $sel = new IO::Select;
2868         $sel->add($sock);
2869
2870         if (!scalar(my @ready = $sel->can_write($timeout))) {
2871             die "monitor write error - timeout";
2872         }
2873
2874         my $fullcmd = "$cmdstr\r";
2875
2876         # syslog('info', "VM $vmid monitor command: $cmdstr");
2877
2878         my $b;
2879         if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
2880             die "monitor write error - $!";
2881         }
2882
2883         return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
2884
2885         $timeout = 20;
2886
2887         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2888             $timeout = 60*60; # 1 hour
2889         } elsif ($cmdstr =~ m/^(eject|change)/) {
2890             $timeout = 60; # note: cdrom mount command is slow
2891         }
2892         if ($res = __read_avail($sock, $timeout)) {
2893
2894             my @lines = split("\r?\n", $res);
2895
2896             shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
2897
2898             $res = join("\n", @lines);
2899             $res .= "\n";
2900         }
2901     };
2902
2903     my $err = $@;
2904
2905     if ($err) {
2906         syslog("err", "VM $vmid monitor command failed - $err");
2907         die $err;
2908     }
2909
2910     return $res;
2911 }
2912
2913 sub qemu_block_resize {
2914     my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
2915
2916     my $running = check_running($vmid);
2917
2918     return if !PVE::Storage::volume_resize($storecfg, $volid, $size, $running);
2919
2920     return if !$running;
2921
2922     vm_mon_cmd($vmid, "block_resize", device => $deviceid, size => int($size));
2923
2924 }
2925
2926 sub qemu_volume_snapshot {
2927     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
2928
2929     my $running = check_running($vmid);
2930
2931     return if !PVE::Storage::volume_snapshot($storecfg, $volid, $snap, $running);
2932
2933     return if !$running;
2934
2935     vm_mon_cmd($vmid, "snapshot-drive", device => $deviceid, name => $snap);
2936
2937 }
2938
2939 sub qemu_volume_snapshot_delete {
2940     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
2941
2942     my $running = check_running($vmid);
2943
2944     return if !PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snap, $running);
2945
2946     return if !$running;
2947
2948     vm_mon_cmd($vmid, "delete-drive-snapshot", device => $deviceid, name => $snap);
2949 }
2950
2951 sub qga_freezefs {
2952     my ($vmid) = @_;
2953
2954     #need to impplement call to qemu-ga
2955 }
2956
2957 sub qga_unfreezefs {
2958     my ($vmid) = @_;
2959
2960     #need to impplement call to qemu-ga
2961 }
2962
2963 sub vm_start {
2964     my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused) = @_;
2965
2966     lock_config($vmid, sub {
2967         my $conf = load_config($vmid, $migratedfrom);
2968
2969         die "you can't start a vm if it's a template\n" if is_template($conf);
2970
2971         check_lock($conf) if !$skiplock;
2972
2973         die "VM $vmid already running\n" if check_running($vmid, undef, $migratedfrom);
2974
2975         my $defaults = load_defaults();
2976
2977         # set environment variable useful inside network script
2978         $ENV{PVE_MIGRATED_FROM} = $migratedfrom if $migratedfrom;
2979
2980         my ($cmd, $vollist) = config_to_command($storecfg, $vmid, $conf, $defaults);
2981
2982         my $migrate_port = 0;
2983
2984         if ($statefile) {
2985             if ($statefile eq 'tcp') {
2986                 $migrate_port = PVE::Tools::next_migrate_port();
2987                 my $migrate_uri = "tcp:localhost:${migrate_port}";
2988                 push @$cmd, '-incoming', $migrate_uri;
2989                 push @$cmd, '-S';
2990             } else {
2991                 push @$cmd, '-loadstate', $statefile;
2992             }
2993         } elsif ($paused) {
2994             push @$cmd, '-S';
2995         }
2996
2997         # host pci devices
2998         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
2999           my $d = parse_hostpci($conf->{"hostpci$i"});
3000           next if !$d;
3001           my $info = pci_device_info("0000:$d->{pciid}");
3002           die "IOMMU not present\n" if !check_iommu_support();
3003           die "no pci device info for device '$d->{pciid}'\n" if !$info;
3004           die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub($info);
3005           die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset($info);
3006         }
3007
3008         PVE::Storage::activate_volumes($storecfg, $vollist);
3009
3010         eval  { run_command($cmd, timeout => $statefile ? undef : 30,
3011                     umask => 0077); };
3012         my $err = $@;
3013         die "start failed: $err" if $err;
3014
3015         print "migration listens on port $migrate_port\n" if $migrate_port;
3016
3017         if ($statefile && $statefile ne 'tcp')  {
3018             eval { vm_mon_cmd_nocheck($vmid, "cont"); };
3019             warn $@ if $@;
3020         }
3021
3022         if($migratedfrom) {
3023             my $capabilities = {};
3024             $capabilities->{capability} =  "xbzrle";
3025             $capabilities->{state} = JSON::true;
3026             eval { vm_mon_cmd_nocheck($vmid, "migrate-set-capabilities", capabilities => [$capabilities]); };
3027         }
3028         else{
3029
3030             if (!$statefile && (!defined($conf->{balloon}) || $conf->{balloon})) {
3031                 vm_mon_cmd_nocheck($vmid, "balloon", value => $conf->{balloon}*1024*1024)
3032                     if $conf->{balloon};
3033                 vm_mon_cmd_nocheck($vmid, 'qom-set',
3034                             path => "machine/peripheral/balloon0",
3035                             property => "guest-stats-polling-interval",
3036                             value => 2);
3037             }
3038         }
3039     });
3040 }
3041
3042 sub vm_mon_cmd {
3043     my ($vmid, $execute, %params) = @_;
3044
3045     my $cmd = { execute => $execute, arguments => \%params };
3046     vm_qmp_command($vmid, $cmd);
3047 }
3048
3049 sub vm_mon_cmd_nocheck {
3050     my ($vmid, $execute, %params) = @_;
3051
3052     my $cmd = { execute => $execute, arguments => \%params };
3053     vm_qmp_command($vmid, $cmd, 1);
3054 }
3055
3056 sub vm_qmp_command {
3057     my ($vmid, $cmd, $nocheck) = @_;
3058
3059     my $res;
3060
3061     my $timeout;
3062     if ($cmd->{arguments} && $cmd->{arguments}->{timeout}) {
3063         $timeout = $cmd->{arguments}->{timeout};
3064         delete $cmd->{arguments}->{timeout};
3065     }
3066
3067     eval {
3068         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
3069         my $sname = qmp_socket($vmid);
3070         if (-e $sname) {
3071             my $qmpclient = PVE::QMPClient->new();
3072
3073             $res = $qmpclient->cmd($vmid, $cmd, $timeout);
3074         } elsif (-e "${var_run_tmpdir}/$vmid.mon") {
3075             die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
3076                 if scalar(%{$cmd->{arguments}});
3077             vm_monitor_command($vmid, $cmd->{execute}, $nocheck);
3078         } else {
3079             die "unable to open monitor socket\n";
3080         }
3081     };
3082     if (my $err = $@) {
3083         syslog("err", "VM $vmid qmp command failed - $err");
3084         die $err;
3085     }
3086
3087     return $res;
3088 }
3089
3090 sub vm_human_monitor_command {
3091     my ($vmid, $cmdline) = @_;
3092
3093     my $res;
3094
3095     my $cmd = {
3096         execute => 'human-monitor-command',
3097         arguments => { 'command-line' => $cmdline},
3098     };
3099
3100     return vm_qmp_command($vmid, $cmd);
3101 }
3102
3103 sub vm_commandline {
3104     my ($storecfg, $vmid) = @_;
3105
3106     my $conf = load_config($vmid);
3107
3108     my $defaults = load_defaults();
3109
3110     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
3111
3112     return join(' ', @$cmd);
3113 }
3114
3115 sub vm_reset {
3116     my ($vmid, $skiplock) = @_;
3117
3118     lock_config($vmid, sub {
3119
3120         my $conf = load_config($vmid);
3121
3122         check_lock($conf) if !$skiplock;
3123
3124         vm_mon_cmd($vmid, "system_reset");
3125     });
3126 }
3127
3128 sub get_vm_volumes {
3129     my ($conf) = @_;
3130
3131     my $vollist = [];
3132     foreach_volid($conf, sub {
3133         my ($volid, $is_cdrom) = @_;
3134
3135         return if $volid =~ m|^/|;
3136
3137         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
3138         return if !$sid;
3139
3140         push @$vollist, $volid;
3141     });
3142
3143     return $vollist;
3144 }
3145
3146 sub vm_stop_cleanup {
3147     my ($storecfg, $vmid, $conf, $keepActive) = @_;
3148
3149     eval {
3150         fairsched_rmnod($vmid); # try to destroy group
3151
3152         if (!$keepActive) {
3153             my $vollist = get_vm_volumes($conf);
3154             PVE::Storage::deactivate_volumes($storecfg, $vollist);
3155         }
3156
3157         foreach my $ext (qw(mon qmp pid vnc qga)) {
3158             unlink "/var/run/qemu-server/${vmid}.$ext";
3159         }
3160     };
3161     warn $@ if $@; # avoid errors - just warn
3162 }
3163
3164 # Note: use $nockeck to skip tests if VM configuration file exists.
3165 # We need that when migration VMs to other nodes (files already moved)
3166 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3167 sub vm_stop {
3168     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3169
3170     $force = 1 if !defined($force) && !$shutdown;
3171
3172     if ($migratedfrom){
3173         my $pid = check_running($vmid, $nocheck, $migratedfrom);
3174         kill 15, $pid if $pid;
3175         my $conf = load_config($vmid, $migratedfrom);
3176         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive);
3177         return;
3178     }
3179
3180     lock_config($vmid, sub {
3181
3182         my $pid = check_running($vmid, $nocheck);
3183         return if !$pid;
3184
3185         my $conf;
3186         if (!$nocheck) {
3187             $conf = load_config($vmid);
3188             check_lock($conf) if !$skiplock;
3189             if (!defined($timeout) && $shutdown && $conf->{startup}) {
3190                 my $opts = parse_startup($conf->{startup});
3191                 $timeout = $opts->{down} if $opts->{down};
3192             }
3193         }
3194
3195         $timeout = 60 if !defined($timeout);
3196
3197         eval {
3198             if ($shutdown) {
3199                 $nocheck ? vm_mon_cmd_nocheck($vmid, "system_powerdown") : vm_mon_cmd($vmid, "system_powerdown");
3200
3201             } else {
3202                 $nocheck ? vm_mon_cmd_nocheck($vmid, "quit") : vm_mon_cmd($vmid, "quit");
3203             }
3204         };
3205         my $err = $@;
3206
3207         if (!$err) {
3208             my $count = 0;
3209             while (($count < $timeout) && check_running($vmid, $nocheck)) {
3210                 $count++;
3211                 sleep 1;
3212             }
3213
3214             if ($count >= $timeout) {
3215                 if ($force) {
3216                     warn "VM still running - terminating now with SIGTERM\n";
3217                     kill 15, $pid;
3218                 } else {
3219                     die "VM quit/powerdown failed - got timeout\n";
3220                 }
3221             } else {
3222                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3223                 return;
3224             }
3225         } else {
3226             if ($force) {
3227                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3228                 kill 15, $pid;
3229             } else {
3230                 die "VM quit/powerdown failed\n";
3231             }
3232         }
3233
3234         # wait again
3235         $timeout = 10;
3236
3237         my $count = 0;
3238         while (($count < $timeout) && check_running($vmid, $nocheck)) {
3239             $count++;
3240             sleep 1;
3241         }
3242
3243         if ($count >= $timeout) {
3244             warn "VM still running - terminating now with SIGKILL\n";
3245             kill 9, $pid;
3246             sleep 1;
3247         }
3248
3249         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3250    });
3251 }
3252
3253 sub vm_suspend {
3254     my ($vmid, $skiplock) = @_;
3255
3256     lock_config($vmid, sub {
3257
3258         my $conf = load_config($vmid);
3259
3260         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3261
3262         vm_mon_cmd($vmid, "stop");
3263     });
3264 }
3265
3266 sub vm_resume {
3267     my ($vmid, $skiplock) = @_;
3268
3269     lock_config($vmid, sub {
3270
3271         my $conf = load_config($vmid);
3272
3273         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3274
3275         vm_mon_cmd($vmid, "cont");
3276     });
3277 }
3278
3279 sub vm_sendkey {
3280     my ($vmid, $skiplock, $key) = @_;
3281
3282     lock_config($vmid, sub {
3283
3284         my $conf = load_config($vmid);
3285
3286         # there is no qmp command, so we use the human monitor command
3287         vm_human_monitor_command($vmid, "sendkey $key");
3288     });
3289 }
3290
3291 sub vm_destroy {
3292     my ($storecfg, $vmid, $skiplock) = @_;
3293
3294     lock_config($vmid, sub {
3295
3296         my $conf = load_config($vmid);
3297
3298         check_lock($conf) if !$skiplock;
3299
3300         if (!check_running($vmid)) {
3301             fairsched_rmnod($vmid); # try to destroy group
3302             destroy_vm($storecfg, $vmid);
3303         } else {
3304             die "VM $vmid is running - destroy failed\n";
3305         }
3306     });
3307 }
3308
3309 # pci helpers
3310
3311 sub file_write {
3312     my ($filename, $buf) = @_;
3313
3314     my $fh = IO::File->new($filename, "w");
3315     return undef if !$fh;
3316
3317     my $res = print $fh $buf;
3318
3319     $fh->close();
3320
3321     return $res;
3322 }
3323
3324 sub pci_device_info {
3325     my ($name) = @_;
3326
3327     my $res;
3328
3329     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3330     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3331
3332     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
3333     return undef if !defined($irq) || $irq !~ m/^\d+$/;
3334
3335     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
3336     return undef if !defined($vendor) || $vendor !~ s/^0x//;
3337
3338     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
3339     return undef if !defined($product) || $product !~ s/^0x//;
3340
3341     $res = {
3342         name => $name,
3343         vendor => $vendor,
3344         product => $product,
3345         domain => $domain,
3346         bus => $bus,
3347         slot => $slot,
3348         func => $func,
3349         irq => $irq,
3350         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
3351     };
3352
3353     return $res;
3354 }
3355
3356 sub pci_dev_reset {
3357     my ($dev) = @_;
3358
3359     my $name = $dev->{name};
3360
3361     my $fn = "$pcisysfs/devices/$name/reset";
3362
3363     return file_write($fn, "1");
3364 }
3365
3366 sub pci_dev_bind_to_stub {
3367     my ($dev) = @_;
3368
3369     my $name = $dev->{name};
3370
3371     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3372     return 1 if -d $testdir;
3373
3374     my $data = "$dev->{vendor} $dev->{product}";
3375     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
3376
3377     my $fn = "$pcisysfs/devices/$name/driver/unbind";
3378     if (!file_write($fn, $name)) {
3379         return undef if -f $fn;
3380     }
3381
3382     $fn = "$pcisysfs/drivers/pci-stub/bind";
3383     if (! -d $testdir) {
3384         return undef if !file_write($fn, $name);
3385     }
3386
3387     return -d $testdir;
3388 }
3389
3390 sub print_pci_addr {
3391     my ($id, $bridges) = @_;
3392
3393     my $res = '';
3394     my $devices = {
3395         piix3 => { bus => 0, addr => 1 },
3396         #addr2 : first videocard
3397         balloon0 => { bus => 0, addr => 3 },
3398         watchdog => { bus => 0, addr => 4 },
3399         scsihw0 => { bus => 0, addr => 5 },
3400         scsihw1 => { bus => 0, addr => 6 },
3401         ahci0 => { bus => 0, addr => 7 },
3402         qga0 => { bus => 0, addr => 8 },
3403         virtio0 => { bus => 0, addr => 10 },
3404         virtio1 => { bus => 0, addr => 11 },
3405         virtio2 => { bus => 0, addr => 12 },
3406         virtio3 => { bus => 0, addr => 13 },
3407         virtio4 => { bus => 0, addr => 14 },
3408         virtio5 => { bus => 0, addr => 15 },
3409         hostpci0 => { bus => 0, addr => 16 },
3410         hostpci1 => { bus => 0, addr => 17 },
3411         net0 => { bus => 0, addr => 18 },
3412         net1 => { bus => 0, addr => 19 },
3413         net2 => { bus => 0, addr => 20 },
3414         net3 => { bus => 0, addr => 21 },
3415         net4 => { bus => 0, addr => 22 },
3416         net5 => { bus => 0, addr => 23 },
3417         #addr29 : usb-host (pve-usb.cfg)
3418         'pci.1' => { bus => 0, addr => 30 },
3419         'pci.2' => { bus => 0, addr => 31 },
3420         'net6' => { bus => 1, addr => 1 },
3421         'net7' => { bus => 1, addr => 2 },
3422         'net8' => { bus => 1, addr => 3 },
3423         'net9' => { bus => 1, addr => 4 },
3424         'net10' => { bus => 1, addr => 5 },
3425         'net11' => { bus => 1, addr => 6 },
3426         'net12' => { bus => 1, addr => 7 },
3427         'net13' => { bus => 1, addr => 8 },
3428         'net14' => { bus => 1, addr => 9 },
3429         'net15' => { bus => 1, addr => 10 },
3430         'net16' => { bus => 1, addr => 11 },
3431         'net17' => { bus => 1, addr => 12 },
3432         'net18' => { bus => 1, addr => 13 },
3433         'net19' => { bus => 1, addr => 14 },
3434         'net20' => { bus => 1, addr => 15 },
3435         'net21' => { bus => 1, addr => 16 },
3436         'net22' => { bus => 1, addr => 17 },
3437         'net23' => { bus => 1, addr => 18 },
3438         'net24' => { bus => 1, addr => 19 },
3439         'net25' => { bus => 1, addr => 20 },
3440         'net26' => { bus => 1, addr => 21 },
3441         'net27' => { bus => 1, addr => 22 },
3442         'net28' => { bus => 1, addr => 23 },
3443         'net29' => { bus => 1, addr => 24 },
3444         'net30' => { bus => 1, addr => 25 },
3445         'net31' => { bus => 1, addr => 26 },
3446         'virtio6' => { bus => 2, addr => 1 },
3447         'virtio7' => { bus => 2, addr => 2 },
3448         'virtio8' => { bus => 2, addr => 3 },
3449         'virtio9' => { bus => 2, addr => 4 },
3450         'virtio10' => { bus => 2, addr => 5 },
3451         'virtio11' => { bus => 2, addr => 6 },
3452         'virtio12' => { bus => 2, addr => 7 },
3453         'virtio13' => { bus => 2, addr => 8 },
3454         'virtio14' => { bus => 2, addr => 9 },
3455         'virtio15' => { bus => 2, addr => 10 },
3456     };
3457
3458     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
3459            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
3460            my $bus = $devices->{$id}->{bus};
3461            $res = ",bus=pci.$bus,addr=$addr";
3462            $bridges->{$bus} = 1 if $bridges;
3463     }
3464     return $res;
3465
3466 }
3467
3468 # vzdump restore implementaion
3469
3470 sub tar_archive_read_firstfile {
3471     my $archive = shift;
3472
3473     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
3474
3475     # try to detect archive type first
3476     my $pid = open (TMP, "tar tf '$archive'|") ||
3477         die "unable to open file '$archive'\n";
3478     my $firstfile = <TMP>;
3479     kill 15, $pid;
3480     close TMP;
3481
3482     die "ERROR: archive contaions no data\n" if !$firstfile;
3483     chomp $firstfile;
3484
3485     return $firstfile;
3486 }
3487
3488 sub tar_restore_cleanup {
3489     my ($storecfg, $statfile) = @_;
3490
3491     print STDERR "starting cleanup\n";
3492
3493     if (my $fd = IO::File->new($statfile, "r")) {
3494         while (defined(my $line = <$fd>)) {
3495             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3496                 my $volid = $2;
3497                 eval {
3498                     if ($volid =~ m|^/|) {
3499                         unlink $volid || die 'unlink failed\n';
3500                     } else {
3501                         PVE::Storage::vdisk_free($storecfg, $volid);
3502                     }
3503                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
3504                 };
3505                 print STDERR "unable to cleanup '$volid' - $@" if $@;
3506             } else {
3507                 print STDERR "unable to parse line in statfile - $line";
3508             }
3509         }
3510         $fd->close();
3511     }
3512 }
3513
3514 sub restore_archive {
3515     my ($archive, $vmid, $user, $opts) = @_;
3516
3517     my $format = $opts->{format};
3518     my $comp;
3519
3520     if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
3521         $format = 'tar' if !$format;
3522         $comp = 'gzip';
3523     } elsif ($archive =~ m/\.tar$/) {
3524         $format = 'tar' if !$format;
3525     } elsif ($archive =~ m/.tar.lzo$/) {
3526         $format = 'tar' if !$format;
3527         $comp = 'lzop';
3528     } elsif ($archive =~ m/\.vma$/) {
3529         $format = 'vma' if !$format;
3530     } elsif ($archive =~ m/\.vma\.gz$/) {
3531         $format = 'vma' if !$format;
3532         $comp = 'gzip';
3533     } elsif ($archive =~ m/\.vma\.lzo$/) {
3534         $format = 'vma' if !$format;
3535         $comp = 'lzop';
3536     } else {
3537         $format = 'vma' if !$format; # default
3538     }
3539
3540     # try to detect archive format
3541     if ($format eq 'tar') {
3542         return restore_tar_archive($archive, $vmid, $user, $opts);
3543     } else {
3544         return restore_vma_archive($archive, $vmid, $user, $opts, $comp);
3545     }
3546 }
3547
3548 sub restore_update_config_line {
3549     my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
3550
3551     return if $line =~ m/^\#qmdump\#/;
3552     return if $line =~ m/^\#vzdump\#/;
3553     return if $line =~ m/^lock:/;
3554     return if $line =~ m/^unused\d+:/;
3555     return if $line =~ m/^parent:/;
3556     return if $line =~ m/^template:/; # restored VM is never a template
3557
3558     if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3559         # try to convert old 1.X settings
3560         my ($id, $ind, $ethcfg) = ($1, $2, $3);
3561         foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
3562             my ($model, $macaddr) = split(/\=/, $devconfig);
3563             $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $unique;
3564             my $net = {
3565                 model => $model,
3566                 bridge => "vmbr$ind",
3567                 macaddr => $macaddr,
3568             };
3569             my $netstr = print_net($net);
3570
3571             print $outfd "net$cookie->{netcount}: $netstr\n";
3572             $cookie->{netcount}++;
3573         }
3574     } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
3575         my ($id, $netstr) = ($1, $2);
3576         my $net = parse_net($netstr);
3577         $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
3578         $netstr = print_net($net);
3579         print $outfd "$id: $netstr\n";
3580     } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
3581         my $virtdev = $1;
3582         my $value = $3;
3583         if ($line =~ m/backup=no/) {
3584             print $outfd "#$line";
3585         } elsif ($virtdev && $map->{$virtdev}) {
3586             my $di = parse_drive($virtdev, $value);
3587             delete $di->{format}; # format can change on restore
3588             $di->{file} = $map->{$virtdev};
3589             $value = print_drive($vmid, $di);
3590             print $outfd "$virtdev: $value\n";
3591         } else {
3592             print $outfd $line;
3593         }
3594     } else {
3595         print $outfd $line;
3596     }
3597 }
3598
3599 sub scan_volids {
3600     my ($cfg, $vmid) = @_;
3601
3602     my $info = PVE::Storage::vdisk_list($cfg, undef, $vmid);
3603
3604     my $volid_hash = {};
3605     foreach my $storeid (keys %$info) {
3606         foreach my $item (@{$info->{$storeid}}) {
3607             next if !($item->{volid} && $item->{size});
3608             $volid_hash->{$item->{volid}} = $item;
3609         }
3610     }
3611
3612     return $volid_hash;
3613 }
3614
3615 sub update_disksize {
3616     my ($vmid, $conf, $volid_hash) = @_;
3617
3618     my $changes;
3619
3620     my $used = {};
3621
3622     # update size info
3623     foreach my $opt (keys %$conf) {
3624         if (valid_drivename($opt)) {
3625             my $drive = parse_drive($opt, $conf->{$opt});
3626             my $volid = $drive->{file};
3627             next if !$volid;
3628
3629             $used->{$volid} = 1;
3630
3631             next if drive_is_cdrom($drive);
3632             next if !$volid_hash->{$volid};
3633
3634             $drive->{size} = $volid_hash->{$volid}->{size};
3635             $changes = 1;
3636             $conf->{$opt} = print_drive($vmid, $drive);
3637         }
3638     }
3639
3640     foreach my $volid (sort keys %$volid_hash) {
3641         next if $volid =~ m/vm-$vmid-state-/;
3642         next if $used->{$volid};
3643         $changes = 1;
3644         add_unused_volume($conf, $volid);
3645     }
3646
3647     return $changes;
3648 }
3649
3650 sub rescan {
3651     my ($vmid, $nolock) = @_;
3652
3653     my $cfg = PVE::Cluster::cfs_read_file("storage.cfg");
3654
3655     my $volid_hash = scan_volids($cfg, $vmid);
3656
3657     my $updatefn =  sub {
3658         my ($vmid) = @_;
3659
3660         my $conf = load_config($vmid);
3661
3662         check_lock($conf);
3663
3664         my $vm_volids = {};
3665         foreach my $volid (keys %$volid_hash) {
3666             my $info = $volid_hash->{$volid};
3667             $vm_volids->{$volid} = $info if $info->{vmid} && $info->{vmid} == $vmid;
3668         }
3669
3670         my $changes = update_disksize($vmid, $conf, $vm_volids);
3671
3672         update_config_nolock($vmid, $conf, 1) if $changes;
3673     };
3674
3675     if (defined($vmid)) {
3676         if ($nolock) {
3677             &$updatefn($vmid);
3678         } else {
3679             lock_config($vmid, $updatefn, $vmid);
3680         }
3681     } else {
3682         my $vmlist = config_list();
3683         foreach my $vmid (keys %$vmlist) {
3684             if ($nolock) {
3685                 &$updatefn($vmid);
3686             } else {
3687                 lock_config($vmid, $updatefn, $vmid);
3688             }
3689         }
3690     }
3691 }
3692
3693 sub restore_vma_archive {
3694     my ($archive, $vmid, $user, $opts, $comp) = @_;
3695
3696     my $input = $archive eq '-' ? "<&STDIN" : undef;
3697     my $readfrom = $archive;
3698
3699     my $uncomp = '';
3700     if ($comp) {
3701         $readfrom = '-';
3702         my $qarchive = PVE::Tools::shellquote($archive);
3703         if ($comp eq 'gzip') {
3704             $uncomp = "zcat $qarchive|";
3705         } elsif ($comp eq 'lzop') {
3706             $uncomp = "lzop -d -c $qarchive|";
3707         } else {
3708             die "unknown compression method '$comp'\n";
3709         }
3710
3711     }
3712
3713     my $tmpdir = "/var/tmp/vzdumptmp$$";
3714     rmtree $tmpdir;
3715
3716     # disable interrupts (always do cleanups)
3717     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
3718         warn "got interrupt - ignored\n";
3719     };
3720
3721     my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
3722     POSIX::mkfifo($mapfifo, 0600);
3723     my $fifofh;
3724
3725     my $openfifo = sub {
3726         open($fifofh, '>', $mapfifo) || die $!;
3727     };
3728
3729     my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
3730
3731     my $oldtimeout;
3732     my $timeout = 5;
3733
3734     my $devinfo = {};
3735
3736     my $rpcenv = PVE::RPCEnvironment::get();
3737
3738     my $conffile = config_file($vmid);
3739     my $tmpfn = "$conffile.$$.tmp";
3740
3741     # Note: $oldconf is undef if VM does not exists
3742     my $oldconf = PVE::Cluster::cfs_read_file(cfs_config_path($vmid));
3743
3744     my $print_devmap = sub {
3745         my $virtdev_hash = {};
3746
3747         my $cfgfn = "$tmpdir/qemu-server.conf";
3748
3749         # we can read the config - that is already extracted
3750         my $fh = IO::File->new($cfgfn, "r") ||
3751             "unable to read qemu-server.conf - $!\n";
3752
3753         while (defined(my $line = <$fh>)) {
3754             if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
3755                 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
3756                 die "archive does not contain data for drive '$virtdev'\n"
3757                     if !$devinfo->{$devname};
3758                 if (defined($opts->{storage})) {
3759                     $storeid = $opts->{storage} || 'local';
3760                 } elsif (!$storeid) {
3761                     $storeid = 'local';
3762                 }
3763                 $format = 'raw' if !$format;
3764                 $devinfo->{$devname}->{devname} = $devname;
3765                 $devinfo->{$devname}->{virtdev} = $virtdev;
3766                 $devinfo->{$devname}->{format} = $format;
3767                 $devinfo->{$devname}->{storeid} = $storeid;
3768
3769                 # check permission on storage
3770                 my $pool = $opts->{pool}; # todo: do we need that?
3771                 if ($user ne 'root@pam') {
3772                     $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
3773                 }
3774
3775                 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
3776             }
3777         }
3778
3779         foreach my $devname (keys %$devinfo) {
3780             die "found no device mapping information for device '$devname'\n"
3781                 if !$devinfo->{$devname}->{virtdev};
3782         }
3783
3784         my $cfg = cfs_read_file('storage.cfg');
3785
3786         # create empty/temp config
3787         if ($oldconf) {
3788             PVE::Tools::file_set_contents($conffile, "memory: 128\n");
3789             foreach_drive($oldconf, sub {
3790                 my ($ds, $drive) = @_;
3791
3792                 return if drive_is_cdrom($drive);
3793
3794                 my $volid = $drive->{file};
3795
3796                 return if !$volid || $volid =~ m|^/|;
3797
3798                 my ($path, $owner) = PVE::Storage::path($cfg, $volid);
3799                 return if !$path || !$owner || ($owner != $vmid);
3800
3801                 # Note: only delete disk we want to restore
3802                 # other volumes will become unused
3803                 if ($virtdev_hash->{$ds}) {
3804                     PVE::Storage::vdisk_free($cfg, $volid);
3805                 }
3806             });
3807         }
3808
3809         my $map = {};
3810         foreach my $virtdev (sort keys %$virtdev_hash) {
3811             my $d = $virtdev_hash->{$virtdev};
3812             my $alloc_size = int(($d->{size} + 1024 - 1)/1024);
3813             my $scfg = PVE::Storage::storage_config($cfg, $d->{storeid});
3814
3815             # test if requested format is supported
3816             my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($cfg, $d->{storeid});
3817             my $supported = grep { $_ eq $d->{format} } @$validFormats;
3818             $d->{format} = $defFormat if !$supported;
3819
3820             my $volid = PVE::Storage::vdisk_alloc($cfg, $d->{storeid}, $vmid,
3821                                                   $d->{format}, undef, $alloc_size);
3822             print STDERR "new volume ID is '$volid'\n";
3823             $d->{volid} = $volid;
3824             my $path = PVE::Storage::path($cfg, $volid);
3825
3826             my $write_zeros = 1;
3827             # fixme: what other storages types initialize volumes with zero?
3828             if ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs' ||
3829                 $scfg->{type} eq 'sheepdog' || $scfg->{type} eq 'rbd') {
3830                 $write_zeros = 0;
3831             }
3832
3833             print $fifofh "${write_zeros}:$d->{devname}=$path\n";
3834
3835             print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
3836             $map->{$virtdev} = $volid;
3837         }
3838
3839         $fh->seek(0, 0) || die "seek failed - $!\n";
3840
3841         my $outfd = new IO::File ($tmpfn, "w") ||
3842             die "unable to write config for VM $vmid\n";
3843
3844         my $cookie = { netcount => 0 };
3845         while (defined(my $line = <$fh>)) {
3846             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
3847         }
3848
3849         $fh->close();
3850         $outfd->close();
3851     };
3852
3853     eval {
3854         # enable interrupts
3855         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
3856             die "interrupted by signal\n";
3857         };
3858         local $SIG{ALRM} = sub { die "got timeout\n"; };
3859
3860         $oldtimeout = alarm($timeout);
3861
3862         my $parser = sub {
3863             my $line = shift;
3864
3865             print "$line\n";
3866
3867             if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
3868                 my ($dev_id, $size, $devname) = ($1, $2, $3);
3869                 $devinfo->{$devname} = { size => $size, dev_id => $dev_id };
3870             } elsif ($line =~ m/^CTIME: /) {
3871                 &$print_devmap();
3872                 print $fifofh "done\n";
3873                 my $tmp = $oldtimeout || 0;
3874                 $oldtimeout = undef;
3875                 alarm($tmp);
3876                 close($fifofh);
3877             }
3878         };
3879
3880         print "restore vma archive: $cmd\n";
3881         run_command($cmd, input => $input, outfunc => $parser, afterfork => $openfifo);
3882     };
3883     my $err = $@;
3884
3885     alarm($oldtimeout) if $oldtimeout;
3886
3887     unlink $mapfifo;
3888
3889     if ($err) {
3890         rmtree $tmpdir;
3891         unlink $tmpfn;
3892
3893         my $cfg = cfs_read_file('storage.cfg');
3894         foreach my $devname (keys %$devinfo) {
3895             my $volid = $devinfo->{$devname}->{volid};
3896             next if !$volid;
3897             eval {
3898                 if ($volid =~ m|^/|) {
3899                     unlink $volid || die 'unlink failed\n';
3900                 } else {
3901                     PVE::Storage::vdisk_free($cfg, $volid);
3902                 }
3903                 print STDERR "temporary volume '$volid' sucessfuly removed\n";
3904             };
3905             print STDERR "unable to cleanup '$volid' - $@" if $@;
3906         }
3907         die $err;
3908     }
3909
3910     rmtree $tmpdir;
3911
3912     rename($tmpfn, $conffile) ||
3913         die "unable to commit configuration file '$conffile'\n";
3914
3915     PVE::Cluster::cfs_update(); # make sure we read new file
3916
3917     eval { rescan($vmid, 1); };
3918     warn $@ if $@;
3919 }
3920
3921 sub restore_tar_archive {
3922     my ($archive, $vmid, $user, $opts) = @_;
3923
3924     if ($archive ne '-') {
3925         my $firstfile = tar_archive_read_firstfile($archive);
3926         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
3927             if $firstfile ne 'qemu-server.conf';
3928     }
3929
3930     my $storecfg = cfs_read_file('storage.cfg');
3931
3932     # destroy existing data - keep empty config
3933     my $vmcfgfn = PVE::QemuServer::config_file($vmid);
3934     destroy_vm($storecfg, $vmid, 1) if -f $vmcfgfn;
3935
3936     my $tocmd = "/usr/lib/qemu-server/qmextract";
3937
3938     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
3939     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
3940     $tocmd .= ' --prealloc' if $opts->{prealloc};
3941     $tocmd .= ' --info' if $opts->{info};
3942
3943     # tar option "xf" does not autodetect compression when read from STDIN,
3944     # so we pipe to zcat
3945     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
3946         PVE::Tools::shellquote("--to-command=$tocmd");
3947
3948     my $tmpdir = "/var/tmp/vzdumptmp$$";
3949     mkpath $tmpdir;
3950
3951     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
3952     local $ENV{VZDUMP_VMID} = $vmid;
3953     local $ENV{VZDUMP_USER} = $user;
3954
3955     my $conffile = config_file($vmid);
3956     my $tmpfn = "$conffile.$$.tmp";
3957
3958     # disable interrupts (always do cleanups)
3959     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
3960         print STDERR "got interrupt - ignored\n";
3961     };
3962
3963     eval {
3964         # enable interrupts
3965         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
3966             die "interrupted by signal\n";
3967         };
3968
3969         if ($archive eq '-') {
3970             print "extracting archive from STDIN\n";
3971             run_command($cmd, input => "<&STDIN");
3972         } else {
3973             print "extracting archive '$archive'\n";
3974             run_command($cmd);
3975         }
3976
3977         return if $opts->{info};
3978
3979         # read new mapping
3980         my $map = {};
3981         my $statfile = "$tmpdir/qmrestore.stat";
3982         if (my $fd = IO::File->new($statfile, "r")) {
3983             while (defined (my $line = <$fd>)) {
3984                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3985                     $map->{$1} = $2 if $1;
3986                 } else {
3987                     print STDERR "unable to parse line in statfile - $line\n";
3988                 }
3989             }
3990             $fd->close();
3991         }
3992
3993         my $confsrc = "$tmpdir/qemu-server.conf";
3994
3995         my $srcfd = new IO::File($confsrc, "r") ||
3996             die "unable to open file '$confsrc'\n";
3997
3998         my $outfd = new IO::File ($tmpfn, "w") ||
3999             die "unable to write config for VM $vmid\n";
4000
4001         my $cookie = { netcount => 0 };
4002         while (defined (my $line = <$srcfd>)) {
4003             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
4004         }
4005
4006         $srcfd->close();
4007         $outfd->close();
4008     };
4009     my $err = $@;
4010
4011     if ($err) {
4012
4013         unlink $tmpfn;
4014
4015         tar_restore_cleanup($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info};
4016
4017         die $err;
4018     }
4019
4020     rmtree $tmpdir;
4021
4022     rename $tmpfn, $conffile ||
4023         die "unable to commit configuration file '$conffile'\n";
4024
4025     PVE::Cluster::cfs_update(); # make sure we read new file
4026
4027     eval { rescan($vmid, 1); };
4028     warn $@ if $@;
4029 };
4030
4031
4032 # Internal snapshots
4033
4034 # NOTE: Snapshot create/delete involves several non-atomic
4035 # action, and can take a long time.
4036 # So we try to avoid locking the file and use 'lock' variable
4037 # inside the config file instead.
4038
4039 my $snapshot_copy_config = sub {
4040     my ($source, $dest) = @_;
4041
4042     foreach my $k (keys %$source) {
4043         next if $k eq 'snapshots';
4044         next if $k eq 'snapstate';
4045         next if $k eq 'snaptime';
4046         next if $k eq 'vmstate';
4047         next if $k eq 'lock';
4048         next if $k eq 'digest';
4049         next if $k eq 'description';
4050         next if $k =~ m/^unused\d+$/;
4051
4052         $dest->{$k} = $source->{$k};
4053     }
4054 };
4055
4056 my $snapshot_apply_config = sub {
4057     my ($conf, $snap) = @_;
4058
4059     # copy snapshot list
4060     my $newconf = {
4061         snapshots => $conf->{snapshots},
4062     };
4063
4064     # keep description and list of unused disks
4065     foreach my $k (keys %$conf) {
4066         next if !($k =~ m/^unused\d+$/ || $k eq 'description');
4067         $newconf->{$k} = $conf->{$k};
4068     }
4069
4070     &$snapshot_copy_config($snap, $newconf);
4071
4072     return $newconf;
4073 };
4074
4075 sub foreach_writable_storage {
4076     my ($conf, $func) = @_;
4077
4078     my $sidhash = {};
4079
4080     foreach my $ds (keys %$conf) {
4081         next if !valid_drivename($ds);
4082
4083         my $drive = parse_drive($ds, $conf->{$ds});
4084         next if !$drive;
4085         next if drive_is_cdrom($drive);
4086
4087         my $volid = $drive->{file};
4088
4089         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
4090         $sidhash->{$sid} = $sid if $sid;
4091     }
4092
4093     foreach my $sid (sort keys %$sidhash) {
4094         &$func($sid);
4095     }
4096 }
4097
4098 my $alloc_vmstate_volid = sub {
4099     my ($storecfg, $vmid, $conf, $snapname) = @_;
4100
4101     # Note: we try to be smart when selecting a $target storage
4102
4103     my $target;
4104
4105     # search shared storage first
4106     foreach_writable_storage($conf, sub {
4107         my ($sid) = @_;
4108         my $scfg = PVE::Storage::storage_config($storecfg, $sid);
4109         return if !$scfg->{shared};
4110
4111         $target = $sid if !$target || $scfg->{path}; # prefer file based storage
4112     });
4113
4114     if (!$target) {
4115         # now search local storage
4116         foreach_writable_storage($conf, sub {
4117             my ($sid) = @_;
4118             my $scfg = PVE::Storage::storage_config($storecfg, $sid);
4119             return if $scfg->{shared};
4120
4121             $target = $sid if !$target || $scfg->{path}; # prefer file based storage;
4122         });
4123     }
4124
4125     $target = 'local' if !$target;
4126
4127     my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
4128     # we abort live save after $conf->{memory}, so we need at max twice that space
4129     my $size = $conf->{memory}*2 + $driver_state_size;
4130
4131     my $name = "vm-$vmid-state-$snapname";
4132     my $scfg = PVE::Storage::storage_config($storecfg, $target);
4133     $name .= ".raw" if $scfg->{path}; # add filename extension for file base storage
4134     my $volid = PVE::Storage::vdisk_alloc($storecfg, $target, $vmid, 'raw', $name, $size*1024);
4135
4136     return $volid;
4137 };
4138
4139 my $snapshot_prepare = sub {
4140     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
4141
4142     my $snap;
4143
4144     my $updatefn =  sub {
4145
4146         my $conf = load_config($vmid);
4147
4148         die "you can't take a snapshot if it's a template\n"
4149             if is_template($conf);
4150
4151         check_lock($conf);
4152
4153         $conf->{lock} = 'snapshot';
4154
4155         die "snapshot name '$snapname' already used\n"
4156             if defined($conf->{snapshots}->{$snapname});
4157
4158         my $storecfg = PVE::Storage::config();
4159         die "snapshot feature is not available" if !has_feature('snapshot', $conf, $storecfg);
4160
4161         $snap = $conf->{snapshots}->{$snapname} = {};
4162
4163         if ($save_vmstate && check_running($vmid)) {
4164             $snap->{vmstate} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
4165         }
4166
4167         &$snapshot_copy_config($conf, $snap);
4168
4169         $snap->{snapstate} = "prepare";
4170         $snap->{snaptime} = time();
4171         $snap->{description} = $comment if $comment;
4172
4173         update_config_nolock($vmid, $conf, 1);
4174     };
4175
4176     lock_config($vmid, $updatefn);
4177
4178     return $snap;
4179 };
4180
4181 my $snapshot_commit = sub {
4182     my ($vmid, $snapname) = @_;
4183
4184     my $updatefn = sub {
4185
4186         my $conf = load_config($vmid);
4187
4188         die "missing snapshot lock\n"
4189             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
4190
4191         my $snap = $conf->{snapshots}->{$snapname};
4192
4193         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4194
4195         die "wrong snapshot state\n"
4196             if !($snap->{snapstate} && $snap->{snapstate} eq "prepare");
4197
4198         delete $snap->{snapstate};
4199         delete $conf->{lock};
4200
4201         my $newconf = &$snapshot_apply_config($conf, $snap);
4202
4203         $newconf->{parent} = $snapname;
4204
4205         update_config_nolock($vmid, $newconf, 1);
4206     };
4207
4208     lock_config($vmid, $updatefn);
4209 };
4210
4211 sub snapshot_rollback {
4212     my ($vmid, $snapname) = @_;
4213
4214     my $snap;
4215
4216     my $prepare = 1;
4217
4218     my $storecfg = PVE::Storage::config();
4219
4220     my $updatefn = sub {
4221
4222         my $conf = load_config($vmid);
4223
4224         die "you can't rollback if vm is a template\n" if is_template($conf);
4225
4226         $snap = $conf->{snapshots}->{$snapname};
4227
4228         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4229
4230         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
4231             if $snap->{snapstate};
4232
4233         if ($prepare) {
4234             check_lock($conf);
4235             vm_stop($storecfg, $vmid, undef, undef, 5, undef, undef);
4236         }
4237
4238         die "unable to rollback vm $vmid: vm is running\n"
4239             if check_running($vmid);
4240
4241         if ($prepare) {
4242             $conf->{lock} = 'rollback';
4243         } else {
4244             die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
4245             delete $conf->{lock};
4246         }
4247
4248         if (!$prepare) {
4249             # copy snapshot config to current config
4250             $conf = &$snapshot_apply_config($conf, $snap);
4251             $conf->{parent} = $snapname;
4252         }
4253
4254         update_config_nolock($vmid, $conf, 1);
4255
4256         if (!$prepare && $snap->{vmstate}) {
4257             my $statefile = PVE::Storage::path($storecfg, $snap->{vmstate});
4258             vm_start($storecfg, $vmid, $statefile);
4259         }
4260     };
4261
4262     lock_config($vmid, $updatefn);
4263
4264     foreach_drive($snap, sub {
4265         my ($ds, $drive) = @_;
4266
4267         return if drive_is_cdrom($drive);
4268
4269         my $volid = $drive->{file};
4270         my $device = "drive-$ds";
4271
4272         PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
4273     });
4274
4275     $prepare = 0;
4276     lock_config($vmid, $updatefn);
4277 }
4278
4279 my $savevm_wait = sub {
4280     my ($vmid) = @_;
4281
4282     for(;;) {
4283         my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
4284         if (!$stat->{status}) {
4285             die "savevm not active\n";
4286         } elsif ($stat->{status} eq 'active') {
4287             sleep(1);
4288             next;
4289         } elsif ($stat->{status} eq 'completed') {
4290             last;
4291         } else {
4292             die "query-savevm returned status '$stat->{status}'\n";
4293         }
4294     }
4295 };
4296
4297 sub snapshot_create {
4298     my ($vmid, $snapname, $save_vmstate, $freezefs, $comment) = @_;
4299
4300     my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
4301
4302     $freezefs = $save_vmstate = 0 if !$snap->{vmstate}; # vm is not running
4303
4304     my $drivehash = {};
4305
4306     my $running = check_running($vmid);
4307
4308     eval {
4309         # create internal snapshots of all drives
4310
4311         my $storecfg = PVE::Storage::config();
4312
4313         if ($running) {
4314             if ($snap->{vmstate}) {
4315                 my $path = PVE::Storage::path($storecfg, $snap->{vmstate});
4316                 vm_mon_cmd($vmid, "savevm-start", statefile => $path);
4317                 &$savevm_wait($vmid);
4318             } else {
4319                 vm_mon_cmd($vmid, "savevm-start");
4320             }
4321         };
4322
4323         qga_freezefs($vmid) if $running && $freezefs;
4324
4325         foreach_drive($snap, sub {
4326             my ($ds, $drive) = @_;
4327
4328             return if drive_is_cdrom($drive);
4329
4330             my $volid = $drive->{file};
4331             my $device = "drive-$ds";
4332
4333             qemu_volume_snapshot($vmid, $device, $storecfg, $volid, $snapname);
4334             $drivehash->{$ds} = 1;
4335        });
4336     };
4337     my $err = $@;
4338
4339     eval { gqa_unfreezefs($vmid) if $running && $freezefs; };
4340     warn $@ if $@;
4341
4342     eval { vm_mon_cmd($vmid, "savevm-end") if $running; };
4343     warn $@ if $@;
4344
4345     if ($err) {
4346         warn "snapshot create failed: starting cleanup\n";
4347         eval { snapshot_delete($vmid, $snapname, 0, $drivehash); };
4348         warn $@ if $@;
4349         die $err;
4350     }
4351
4352     &$snapshot_commit($vmid, $snapname);
4353 }
4354
4355 # Note: $drivehash is only set when called from snapshot_create.
4356 sub snapshot_delete {
4357     my ($vmid, $snapname, $force, $drivehash) = @_;
4358
4359     my $prepare = 1;
4360
4361     my $snap;
4362     my $unused = [];
4363
4364     my $unlink_parent = sub {
4365         my ($confref, $new_parent) = @_;
4366
4367         if ($confref->{parent} && $confref->{parent} eq $snapname) {
4368             if ($new_parent) {
4369                 $confref->{parent} = $new_parent;
4370             } else {
4371                 delete $confref->{parent};
4372             }
4373         }
4374     };
4375
4376     my $updatefn =  sub {
4377         my ($remove_drive) = @_;
4378
4379         my $conf = load_config($vmid);
4380
4381         if (!$drivehash) {
4382             check_lock($conf);
4383             die "you can't delete a snapshot if vm is a template\n"
4384                 if is_template($conf);
4385         }
4386
4387         $snap = $conf->{snapshots}->{$snapname};
4388
4389         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4390
4391         # remove parent refs
4392         &$unlink_parent($conf, $snap->{parent});
4393         foreach my $sn (keys %{$conf->{snapshots}}) {
4394             next if $sn eq $snapname;
4395             &$unlink_parent($conf->{snapshots}->{$sn}, $snap->{parent});
4396         }
4397
4398         if ($remove_drive) {
4399             if ($remove_drive eq 'vmstate') {
4400                 delete $snap->{$remove_drive};
4401             } else {
4402                 my $drive = parse_drive($remove_drive, $snap->{$remove_drive});
4403                 my $volid = $drive->{file};
4404                 delete $snap->{$remove_drive};
4405                 add_unused_volume($conf, $volid);
4406             }
4407         }
4408
4409         if ($prepare) {
4410             $snap->{snapstate} = 'delete';
4411         } else {
4412             delete $conf->{snapshots}->{$snapname};
4413             delete $conf->{lock} if $drivehash;
4414             foreach my $volid (@$unused) {
4415                 add_unused_volume($conf, $volid);
4416             }
4417         }
4418
4419         update_config_nolock($vmid, $conf, 1);
4420     };
4421
4422     lock_config($vmid, $updatefn);
4423
4424     # now remove vmstate file
4425
4426     my $storecfg = PVE::Storage::config();
4427
4428     if ($snap->{vmstate}) {
4429         eval {  PVE::Storage::vdisk_free($storecfg, $snap->{vmstate}); };
4430         if (my $err = $@) {
4431             die $err if !$force;
4432             warn $err;
4433         }
4434         # save changes (remove vmstate from snapshot)
4435         lock_config($vmid, $updatefn, 'vmstate') if !$force;
4436     };
4437
4438     # now remove all internal snapshots
4439     foreach_drive($snap, sub {
4440         my ($ds, $drive) = @_;
4441
4442         return if drive_is_cdrom($drive);
4443
4444         my $volid = $drive->{file};
4445         my $device = "drive-$ds";
4446
4447         if (!$drivehash || $drivehash->{$ds}) {
4448             eval { qemu_volume_snapshot_delete($vmid, $device, $storecfg, $volid, $snapname); };
4449             if (my $err = $@) {
4450                 die $err if !$force;
4451                 warn $err;
4452             }
4453         }
4454
4455         # save changes (remove drive fron snapshot)
4456         lock_config($vmid, $updatefn, $ds) if !$force;
4457         push @$unused, $volid;
4458     });
4459
4460     # now cleanup config
4461     $prepare = 0;
4462     lock_config($vmid, $updatefn);
4463 }
4464
4465 sub has_feature {
4466     my ($feature, $conf, $storecfg, $snapname, $running) = @_;
4467
4468     my $err;
4469     foreach_drive($conf, sub {
4470         my ($ds, $drive) = @_;
4471
4472         return if drive_is_cdrom($drive);
4473         my $volid = $drive->{file};
4474         $err = 1 if !PVE::Storage::volume_has_feature($storecfg, $feature, $volid, $snapname, $running);
4475     });
4476
4477     return $err ? 0 : 1;
4478 }
4479
4480 sub template_create {
4481     my ($vmid, $conf, $disk) = @_;
4482
4483     my $storecfg = PVE::Storage::config();
4484
4485     foreach_drive($conf, sub {
4486         my ($ds, $drive) = @_;
4487
4488         return if drive_is_cdrom($drive);
4489         return if $disk && $ds ne $disk;
4490
4491         my $volid = $drive->{file};
4492         return if !PVE::Storage::volume_has_feature($storecfg, 'template', $volid);
4493
4494         my $voliddst = PVE::Storage::vdisk_create_base($storecfg, $volid);
4495         $drive->{file} = $voliddst;
4496         $conf->{$ds} = PVE::QemuServer::print_drive($vmid, $drive);
4497         PVE::QemuServer::update_config_nolock($vmid, $conf, 1);
4498     });
4499 }
4500
4501 sub is_template {
4502     my ($conf) = @_;
4503
4504     return 1 if defined $conf->{template} && $conf->{template} == 1;
4505 }
4506
4507 sub qemu_img_convert {
4508     my ($src_volid, $dst_volid, $size, $snapname) = @_;
4509
4510     my $storecfg = PVE::Storage::config();
4511     my ($src_storeid, $src_volname) = PVE::Storage::parse_volume_id($src_volid, 1);
4512     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
4513
4514     if ($src_storeid && $dst_storeid) {
4515         my $src_scfg = PVE::Storage::storage_config($storecfg, $src_storeid);
4516         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
4517
4518         my $src_format = qemu_img_format($src_scfg, $src_volname);
4519         my $dst_format = qemu_img_format($dst_scfg, $dst_volname);
4520
4521         my $src_path = PVE::Storage::path($storecfg, $src_volid, $snapname);
4522         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
4523
4524         my $cmd = [];
4525         push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-C';
4526         push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
4527         push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
4528
4529         my $parser = sub {
4530             my $line = shift;
4531             if($line =~ m/\((\S+)\/100\%\)/){
4532                 my $percent = $1;
4533                 my $transferred = int($size * $percent / 100);
4534                 my $remaining = $size - $transferred;
4535
4536                 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
4537             }
4538
4539         };
4540
4541         eval  { run_command($cmd, timeout => undef, outfunc => $parser); };
4542         my $err = $@;
4543         die "copy failed: $err" if $err;
4544     }
4545 }
4546
4547 sub qemu_img_format {
4548     my ($scfg, $volname) = @_;
4549
4550     if ($scfg->{path} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/) {
4551         return $1;
4552     } elsif ($scfg->{type} eq 'iscsi') {
4553         return "host_device";
4554     } else {
4555         return "raw";
4556     }
4557 }
4558
4559 sub qemu_drive_mirror {
4560     my ($vmid, $drive, $dst_volid, $vmiddst, $maxwait) = @_;
4561
4562     my $count = 1;
4563     my $old_len = 0;
4564     my $frozen = undef;
4565
4566     my $storecfg = PVE::Storage::config();
4567     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
4568
4569     if ($dst_storeid) {
4570         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
4571
4572         my $format = undef;
4573         if ($dst_volname =~ m/\.(raw|qcow2)$/){
4574             $format = $1;
4575         }
4576
4577         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
4578
4579         if($format){
4580             #fixme : sometime drive-mirror timeout, but works fine after. (I have see the problem with big volume > 200GB), so we need to eval
4581             eval{ PVE::QemuServer::vm_mon_cmd($vmid, "drive-mirror", timeout => 10, device => "drive-$drive", mode => "existing", sync => "full", target => $dst_path, format => $format); };
4582         }else{
4583             eval{ PVE::QemuServer::vm_mon_cmd($vmid, "drive-mirror", timeout => 10, device => "drive-$drive", mode => "existing", sync => "full", target => $dst_path); };
4584         }
4585         eval{
4586             while (1) {
4587                 my $stats = PVE::QemuServer::vm_mon_cmd($vmid, "query-block-jobs");
4588                 my $stat = @$stats[0];
4589                 die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
4590                 die "error job is not mirroring" if $stat->{type} ne "mirror";
4591
4592                 my $transferred = $stat->{offset};
4593                 my $total = $stat->{len};
4594                 my $remaining = $total - $transferred;
4595                 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
4596
4597                 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent %\n";
4598
4599                 last if ($stat->{len} == $stat->{offset});
4600                 if ($old_len == $stat->{offset}) {
4601                     if ($maxwait && $count > $maxwait) {
4602                     # if writes to disk occurs the disk needs to be freezed
4603                     # to be able to complete the migration
4604                         vm_suspend($vmid,1);
4605                         $count = 0;
4606                         $frozen = 1;
4607                     }else {
4608                         $count++ unless $frozen;
4609                     }
4610                 }
4611                 elsif ($frozen) {
4612                         vm_resume($vmid,1);
4613                         $count = 0;
4614                 }
4615                 $old_len = $stat->{offset};
4616                 sleep 1;
4617             }
4618         };
4619         if (my $err = $@) {
4620             eval { PVE::QemuServer::vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive"); };
4621             die "mirroring error: $err";
4622         }
4623
4624         if($vmiddst != $vmid){
4625             #if we clone a disk for a new target vm, we don't switch the disk
4626             PVE::QemuServer::vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive");
4627         }else{
4628             #if source and destination are on the same guest
4629             PVE::QemuServer::vm_mon_cmd($vmid, "block-job-complete", device => "drive-$drive");
4630         }
4631     }
4632 }
4633
4634 1;