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     # fixme: allow to add unused disk even if disk is used inside snapshot
1700     my $cleanup_config = sub {
1701         my ($cref) = @_;
1702
1703         foreach my $key (keys %$cref) {
1704             next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots' ||
1705                 $key eq 'snapstate';
1706             my $value = $cref->{$key};
1707             eval { $value = check_type($key, $value); };
1708             die "unable to parse value of '$key' - $@" if $@;
1709
1710             $cref->{$key} = $value;
1711
1712             if (valid_drivename($key)) {
1713                 my $drive = parse_drive($key, $value);
1714                 $used_volids->{$drive->{file}} = 1 if $drive && $drive->{file};
1715             }
1716         }
1717     };
1718
1719     &$cleanup_config($conf);
1720     foreach my $snapname (keys %{$conf->{snapshots}}) {
1721         &$cleanup_config($conf->{snapshots}->{$snapname});
1722     }
1723
1724     # remove 'unusedX' settings if we re-add a volume
1725     foreach my $key (keys %$conf) {
1726         my $value = $conf->{$key};
1727         if ($key =~ m/^unused/ && $used_volids->{$value}) {
1728             delete $conf->{$key};
1729         }
1730     }
1731
1732     my $generate_raw_config = sub {
1733         my ($conf) = @_;
1734
1735         my $raw = '';
1736
1737         # add description as comment to top of file
1738         my $descr = $conf->{description} || '';
1739         foreach my $cl (split(/\n/, $descr)) {
1740             $raw .= '#' .  PVE::Tools::encode_text($cl) . "\n";
1741         }
1742
1743         foreach my $key (sort keys %$conf) {
1744             next if $key eq 'digest' || $key eq 'description' || $key eq 'snapshots';
1745             $raw .= "$key: $conf->{$key}\n";
1746         }
1747         return $raw;
1748     };
1749
1750     my $raw = &$generate_raw_config($conf);
1751     foreach my $snapname (sort keys %{$conf->{snapshots}}) {
1752         $raw .= "\n[$snapname]\n";
1753         $raw .= &$generate_raw_config($conf->{snapshots}->{$snapname});
1754     }
1755
1756     return $raw;
1757 }
1758
1759 sub update_config_nolock {
1760     my ($vmid, $conf, $skiplock) = @_;
1761
1762     check_lock($conf) if !$skiplock;
1763
1764     my $cfspath = cfs_config_path($vmid);
1765
1766     PVE::Cluster::cfs_write_file($cfspath, $conf);
1767 }
1768
1769 sub update_config {
1770     my ($vmid, $conf, $skiplock) = @_;
1771
1772     lock_config($vmid, &update_config_nolock, $conf, $skiplock);
1773 }
1774
1775 sub load_defaults {
1776
1777     my $res = {};
1778
1779     # we use static defaults from our JSON schema configuration
1780     foreach my $key (keys %$confdesc) {
1781         if (defined(my $default = $confdesc->{$key}->{default})) {
1782             $res->{$key} = $default;
1783         }
1784     }
1785
1786     my $conf = PVE::Cluster::cfs_read_file('datacenter.cfg');
1787     $res->{keyboard} = $conf->{keyboard} if $conf->{keyboard};
1788
1789     return $res;
1790 }
1791
1792 sub config_list {
1793     my $vmlist = PVE::Cluster::get_vmlist();
1794     my $res = {};
1795     return $res if !$vmlist || !$vmlist->{ids};
1796     my $ids = $vmlist->{ids};
1797
1798     foreach my $vmid (keys %$ids) {
1799         my $d = $ids->{$vmid};
1800         next if !$d->{node} || $d->{node} ne $nodename;
1801         next if !$d->{type} || $d->{type} ne 'qemu';
1802         $res->{$vmid}->{exists} = 1;
1803     }
1804     return $res;
1805 }
1806
1807 # test if VM uses local resources (to prevent migration)
1808 sub check_local_resources {
1809     my ($conf, $noerr) = @_;
1810
1811     my $loc_res = 0;
1812
1813     $loc_res = 1 if $conf->{hostusb}; # old syntax
1814     $loc_res = 1 if $conf->{hostpci}; # old syntax
1815
1816     foreach my $k (keys %$conf) {
1817         $loc_res = 1 if $k =~ m/^(usb|hostpci|serial|parallel)\d+$/;
1818     }
1819
1820     die "VM uses local resources\n" if $loc_res && !$noerr;
1821
1822     return $loc_res;
1823 }
1824
1825 # check if used storages are available on all nodes (use by migrate)
1826 sub check_storage_availability {
1827     my ($storecfg, $conf, $node) = @_;
1828
1829     foreach_drive($conf, sub {
1830         my ($ds, $drive) = @_;
1831
1832         my $volid = $drive->{file};
1833         return if !$volid;
1834
1835         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
1836         return if !$sid;
1837
1838         # check if storage is available on both nodes
1839         my $scfg = PVE::Storage::storage_check_node($storecfg, $sid);
1840         PVE::Storage::storage_check_node($storecfg, $sid, $node);
1841    });
1842 }
1843
1844 # list nodes where all VM images are available (used by has_feature API)
1845 sub shared_nodes {
1846     my ($conf, $storecfg) = @_;
1847
1848     my $nodelist = PVE::Cluster::get_nodelist();
1849     my $nodehash = { map { $_ => 1 } @$nodelist };
1850     my $nodename = PVE::INotify::nodename();
1851
1852     foreach_drive($conf, sub {
1853         my ($ds, $drive) = @_;
1854
1855         my $volid = $drive->{file};
1856         return if !$volid;
1857
1858         my ($storeid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
1859         if ($storeid) {
1860             my $scfg = PVE::Storage::storage_config($storecfg, $storeid);
1861             if ($scfg->{disable}) {
1862                 $nodehash = {};
1863             } elsif (my $avail = $scfg->{nodes}) {
1864                 foreach my $node (keys %$nodehash) {
1865                     delete $nodehash->{$node} if !$avail->{$node};
1866                 }
1867             } elsif (!$scfg->{shared}) {
1868                 foreach my $node (keys %$nodehash) {
1869                     delete $nodehash->{$node} if $node ne $nodename
1870                 }
1871             }
1872         }
1873     });
1874
1875     return $nodehash
1876 }
1877
1878 sub check_lock {
1879     my ($conf) = @_;
1880
1881     die "VM is locked ($conf->{lock})\n" if $conf->{lock};
1882 }
1883
1884 sub check_cmdline {
1885     my ($pidfile, $pid) = @_;
1886
1887     my $fh = IO::File->new("/proc/$pid/cmdline", "r");
1888     if (defined($fh)) {
1889         my $line = <$fh>;
1890         $fh->close;
1891         return undef if !$line;
1892         my @param = split(/\0/, $line);
1893
1894         my $cmd = $param[0];
1895         return if !$cmd || ($cmd !~ m|kvm$| && $cmd !~ m|qemu-system-x86_64$|);
1896
1897         for (my $i = 0; $i < scalar (@param); $i++) {
1898             my $p = $param[$i];
1899             next if !$p;
1900             if (($p eq '-pidfile') || ($p eq '--pidfile')) {
1901                 my $p = $param[$i+1];
1902                 return 1 if $p && ($p eq $pidfile);
1903                 return undef;
1904             }
1905         }
1906     }
1907     return undef;
1908 }
1909
1910 sub check_running {
1911     my ($vmid, $nocheck, $node) = @_;
1912
1913     my $filename = config_file($vmid, $node);
1914
1915     die "unable to find configuration file for VM $vmid - no such machine\n"
1916         if !$nocheck && ! -f $filename;
1917
1918     my $pidfile = pidfile_name($vmid);
1919
1920     if (my $fd = IO::File->new("<$pidfile")) {
1921         my $st = stat($fd);
1922         my $line = <$fd>;
1923         close($fd);
1924
1925         my $mtime = $st->mtime;
1926         if ($mtime > time()) {
1927             warn "file '$filename' modified in future\n";
1928         }
1929
1930         if ($line =~ m/^(\d+)$/) {
1931             my $pid = $1;
1932             if (check_cmdline($pidfile, $pid)) {
1933                 if (my $pinfo = PVE::ProcFSTools::check_process_running($pid)) {
1934                     return $pid;
1935                 }
1936             }
1937         }
1938     }
1939
1940     return undef;
1941 }
1942
1943 sub vzlist {
1944
1945     my $vzlist = config_list();
1946
1947     my $fd = IO::Dir->new($var_run_tmpdir) || return $vzlist;
1948
1949     while (defined(my $de = $fd->read)) {
1950         next if $de !~ m/^(\d+)\.pid$/;
1951         my $vmid = $1;
1952         next if !defined($vzlist->{$vmid});
1953         if (my $pid = check_running($vmid)) {
1954             $vzlist->{$vmid}->{pid} = $pid;
1955         }
1956     }
1957
1958     return $vzlist;
1959 }
1960
1961 sub disksize {
1962     my ($storecfg, $conf) = @_;
1963
1964     my $bootdisk = $conf->{bootdisk};
1965     return undef if !$bootdisk;
1966     return undef if !valid_drivename($bootdisk);
1967
1968     return undef if !$conf->{$bootdisk};
1969
1970     my $drive = parse_drive($bootdisk, $conf->{$bootdisk});
1971     return undef if !defined($drive);
1972
1973     return undef if drive_is_cdrom($drive);
1974
1975     my $volid = $drive->{file};
1976     return undef if !$volid;
1977
1978     return $drive->{size};
1979 }
1980
1981 my $last_proc_pid_stat;
1982
1983 # get VM status information
1984 # This must be fast and should not block ($full == false)
1985 # We only query KVM using QMP if $full == true (this can be slow)
1986 sub vmstatus {
1987     my ($opt_vmid, $full) = @_;
1988
1989     my $res = {};
1990
1991     my $storecfg = PVE::Storage::config();
1992
1993     my $list = vzlist();
1994     my ($uptime) = PVE::ProcFSTools::read_proc_uptime(1);
1995
1996     my $cpucount = $cpuinfo->{cpus} || 1;
1997
1998     foreach my $vmid (keys %$list) {
1999         next if $opt_vmid && ($vmid ne $opt_vmid);
2000
2001         my $cfspath = cfs_config_path($vmid);
2002         my $conf = PVE::Cluster::cfs_read_file($cfspath) || {};
2003
2004         my $d = {};
2005         $d->{pid} = $list->{$vmid}->{pid};
2006
2007         # fixme: better status?
2008         $d->{status} = $list->{$vmid}->{pid} ? 'running' : 'stopped';
2009
2010         my $size = disksize($storecfg, $conf);
2011         if (defined($size)) {
2012             $d->{disk} = 0; # no info available
2013             $d->{maxdisk} = $size;
2014         } else {
2015             $d->{disk} = 0;
2016             $d->{maxdisk} = 0;
2017         }
2018
2019         $d->{cpus} = ($conf->{sockets} || 1) * ($conf->{cores} || 1);
2020         $d->{cpus} = $cpucount if $d->{cpus} > $cpucount;
2021
2022         $d->{name} = $conf->{name} || "VM $vmid";
2023         $d->{maxmem} = $conf->{memory} ? $conf->{memory}*(1024*1024) : 0;
2024
2025         if ($conf->{balloon}) {
2026             $d->{balloon_min} = $conf->{balloon}*(1024*1024);
2027             $d->{shares} = defined($conf->{shares}) ? $conf->{shares} : 1000;
2028         }
2029
2030         $d->{uptime} = 0;
2031         $d->{cpu} = 0;
2032         $d->{mem} = 0;
2033
2034         $d->{netout} = 0;
2035         $d->{netin} = 0;
2036
2037         $d->{diskread} = 0;
2038         $d->{diskwrite} = 0;
2039
2040         $d->{template} = is_template($conf);
2041
2042         $res->{$vmid} = $d;
2043     }
2044
2045     my $netdev = PVE::ProcFSTools::read_proc_net_dev();
2046     foreach my $dev (keys %$netdev) {
2047         next if $dev !~ m/^tap([1-9]\d*)i/;
2048         my $vmid = $1;
2049         my $d = $res->{$vmid};
2050         next if !$d;
2051
2052         $d->{netout} += $netdev->{$dev}->{receive};
2053         $d->{netin} += $netdev->{$dev}->{transmit};
2054     }
2055
2056     my $ctime = gettimeofday;
2057
2058     foreach my $vmid (keys %$list) {
2059
2060         my $d = $res->{$vmid};
2061         my $pid = $d->{pid};
2062         next if !$pid;
2063
2064         my $pstat = PVE::ProcFSTools::read_proc_pid_stat($pid);
2065         next if !$pstat; # not running
2066
2067         my $used = $pstat->{utime} + $pstat->{stime};
2068
2069         $d->{uptime} = int(($uptime - $pstat->{starttime})/$cpuinfo->{user_hz});
2070
2071         if ($pstat->{vsize}) {
2072             $d->{mem} = int(($pstat->{rss}/$pstat->{vsize})*$d->{maxmem});
2073         }
2074
2075         my $old = $last_proc_pid_stat->{$pid};
2076         if (!$old) {
2077             $last_proc_pid_stat->{$pid} = {
2078                 time => $ctime,
2079                 used => $used,
2080                 cpu => 0,
2081             };
2082             next;
2083         }
2084
2085         my $dtime = ($ctime -  $old->{time}) * $cpucount * $cpuinfo->{user_hz};
2086
2087         if ($dtime > 1000) {
2088             my $dutime = $used -  $old->{used};
2089
2090             $d->{cpu} = (($dutime/$dtime)* $cpucount) / $d->{cpus};
2091             $last_proc_pid_stat->{$pid} = {
2092                 time => $ctime,
2093                 used => $used,
2094                 cpu => $d->{cpu},
2095             };
2096         } else {
2097             $d->{cpu} = $old->{cpu};
2098         }
2099     }
2100
2101     return $res if !$full;
2102
2103     my $qmpclient = PVE::QMPClient->new();
2104
2105     my $ballooncb = sub {
2106         my ($vmid, $resp) = @_;
2107
2108         my $info = $resp->{'return'};
2109         return if !$info->{max_mem};
2110
2111         my $d = $res->{$vmid};
2112
2113         # use memory assigned to VM
2114         $d->{maxmem} = $info->{max_mem};
2115         $d->{balloon} = $info->{actual};
2116
2117         if (defined($info->{total_mem}) && defined($info->{free_mem})) {
2118             $d->{mem} = $info->{total_mem} - $info->{free_mem};
2119             $d->{freemem} = $info->{free_mem};
2120         }
2121
2122     };
2123
2124     my $blockstatscb = sub {
2125         my ($vmid, $resp) = @_;
2126         my $data = $resp->{'return'} || [];
2127         my $totalrdbytes = 0;
2128         my $totalwrbytes = 0;
2129         for my $blockstat (@$data) {
2130             $totalrdbytes = $totalrdbytes + $blockstat->{stats}->{rd_bytes};
2131             $totalwrbytes = $totalwrbytes + $blockstat->{stats}->{wr_bytes};
2132         }
2133         $res->{$vmid}->{diskread} = $totalrdbytes;
2134         $res->{$vmid}->{diskwrite} = $totalwrbytes;
2135     };
2136
2137     my $statuscb = sub {
2138         my ($vmid, $resp) = @_;
2139
2140         $qmpclient->queue_cmd($vmid, $blockstatscb, 'query-blockstats');
2141         # this fails if ballon driver is not loaded, so this must be
2142         # the last commnand (following command are aborted if this fails).
2143         $qmpclient->queue_cmd($vmid, $ballooncb, 'query-balloon');
2144
2145         my $status = 'unknown';
2146         if (!defined($status = $resp->{'return'}->{status})) {
2147             warn "unable to get VM status\n";
2148             return;
2149         }
2150
2151         $res->{$vmid}->{qmpstatus} = $resp->{'return'}->{status};
2152     };
2153
2154     foreach my $vmid (keys %$list) {
2155         next if $opt_vmid && ($vmid ne $opt_vmid);
2156         next if !$res->{$vmid}->{pid}; # not running
2157         $qmpclient->queue_cmd($vmid, $statuscb, 'query-status');
2158     }
2159
2160     $qmpclient->queue_execute();
2161
2162     foreach my $vmid (keys %$list) {
2163         next if $opt_vmid && ($vmid ne $opt_vmid);
2164         $res->{$vmid}->{qmpstatus} = $res->{$vmid}->{status} if !$res->{$vmid}->{qmpstatus};
2165     }
2166
2167     return $res;
2168 }
2169
2170 sub foreach_drive {
2171     my ($conf, $func) = @_;
2172
2173     foreach my $ds (keys %$conf) {
2174         next if !valid_drivename($ds);
2175
2176         my $drive = parse_drive($ds, $conf->{$ds});
2177         next if !$drive;
2178
2179         &$func($ds, $drive);
2180     }
2181 }
2182
2183 sub foreach_volid {
2184     my ($conf, $func) = @_;
2185
2186     my $volhash = {};
2187
2188     my $test_volid = sub {
2189         my ($volid, $is_cdrom) = @_;
2190
2191         return if !$volid;
2192
2193         $volhash->{$volid} = $is_cdrom || 0;
2194     };
2195
2196     foreach_drive($conf, sub {
2197         my ($ds, $drive) = @_;
2198         &$test_volid($drive->{file}, drive_is_cdrom($drive));
2199     });
2200
2201     foreach my $snapname (keys %{$conf->{snapshots}}) {
2202         my $snap = $conf->{snapshots}->{$snapname};
2203         &$test_volid($snap->{vmstate}, 0);
2204         foreach_drive($snap, sub {
2205             my ($ds, $drive) = @_;
2206             &$test_volid($drive->{file}, drive_is_cdrom($drive));
2207         });
2208     }
2209
2210     foreach my $volid (keys %$volhash) {
2211         &$func($volid, $volhash->{$volid});
2212     }
2213 }
2214
2215 sub config_to_command {
2216     my ($storecfg, $vmid, $conf, $defaults) = @_;
2217
2218     my $cmd = [];
2219     my $globalFlags = [];
2220     my $machineFlags = [];
2221     my $rtcFlags = [];
2222     my $devices = [];
2223     my $pciaddr = '';
2224     my $bridges = {};
2225     my $kvmver = kvm_user_version();
2226     my $vernum = 0; # unknown
2227     if ($kvmver =~ m/^(\d+)\.(\d+)$/) {
2228         $vernum = $1*1000000+$2*1000;
2229     } elsif ($kvmver =~ m/^(\d+)\.(\d+)\.(\d+)$/) {
2230         $vernum = $1*1000000+$2*1000+$3;
2231     }
2232
2233     die "detected old qemu-kvm binary ($kvmver)\n" if $vernum < 15000;
2234
2235     my $have_ovz = -f '/proc/vz/vestat';
2236
2237     push @$cmd, '/usr/bin/kvm';
2238
2239     push @$cmd, '-id', $vmid;
2240
2241     my $use_virtio = 0;
2242
2243     my $qmpsocket = qmp_socket($vmid);
2244     push @$cmd, '-chardev', "socket,id=qmp,path=$qmpsocket,server,nowait";
2245     push @$cmd, '-mon', "chardev=qmp,mode=control";
2246
2247     my $socket = vnc_socket($vmid);
2248     push @$cmd,  '-vnc', "unix:$socket,x509,password";
2249
2250     push @$cmd, '-pidfile' , pidfile_name($vmid);
2251
2252     push @$cmd, '-daemonize';
2253
2254     $pciaddr = print_pci_addr("piix3", $bridges);
2255     push @$devices, '-device', "piix3-usb-uhci,id=uhci$pciaddr.0x2";
2256
2257     my $use_usb2 = 0;
2258     for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
2259         next if !$conf->{"usb$i"};
2260         $use_usb2 = 1;
2261     }
2262     # include usb device config
2263     push @$devices, '-readconfig', '/usr/share/qemu-server/pve-usb.cfg' if $use_usb2;
2264
2265     # enable absolute mouse coordinates (needed by vnc)
2266     my $tablet = defined($conf->{tablet}) ? $conf->{tablet} : $defaults->{tablet};
2267     push @$devices, '-device', 'usb-tablet,id=tablet,bus=uhci.0,port=1' if $tablet;
2268
2269     # host pci devices
2270     for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
2271           my $d = parse_hostpci($conf->{"hostpci$i"});
2272           next if !$d;
2273           $pciaddr = print_pci_addr("hostpci$i", $bridges);
2274           push @$devices, '-device', "pci-assign,host=$d->{pciid},id=hostpci$i$pciaddr";
2275     }
2276
2277     # usb devices
2278     for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
2279         my $d = parse_usb_device($conf->{"usb$i"});
2280         next if !$d;
2281         if ($d->{vendorid} && $d->{productid}) {
2282             push @$devices, '-device', "usb-host,vendorid=0x$d->{vendorid},productid=0x$d->{productid}";
2283         } elsif (defined($d->{hostbus}) && defined($d->{hostport})) {
2284             push @$devices, '-device', "usb-host,hostbus=$d->{hostbus},hostport=$d->{hostport}";
2285         }
2286     }
2287
2288     # serial devices
2289     for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++)  {
2290         if (my $path = $conf->{"serial$i"}) {
2291             die "no such serial device\n" if ! -c $path;
2292             push @$devices, '-chardev', "tty,id=serial$i,path=$path";
2293             push @$devices, '-device', "isa-serial,chardev=serial$i";
2294         }
2295     }
2296
2297     # parallel devices
2298     for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++)  {
2299         if (my $path = $conf->{"parallel$i"}) {
2300             die "no such parallel device\n" if ! -c $path;
2301             push @$devices, '-chardev', "parport,id=parallel$i,path=$path";
2302             push @$devices, '-device', "isa-parallel,chardev=parallel$i";
2303         }
2304     }
2305
2306     my $vmname = $conf->{name} || "vm$vmid";
2307
2308     push @$cmd, '-name', $vmname;
2309
2310     my $sockets = 1;
2311     $sockets = $conf->{smp} if $conf->{smp}; # old style - no longer iused
2312     $sockets = $conf->{sockets} if  $conf->{sockets};
2313
2314     my $cores = $conf->{cores} || 1;
2315
2316     push @$cmd, '-smp', "sockets=$sockets,cores=$cores";
2317
2318     push @$cmd, '-cpu', $conf->{cpu} if $conf->{cpu};
2319
2320     push @$cmd, '-nodefaults';
2321
2322     my $bootorder = $conf->{boot} || $confdesc->{boot}->{default};
2323
2324     my $bootindex_hash = {};
2325     my $i = 1;
2326     foreach my $o (split(//, $bootorder)) {
2327         $bootindex_hash->{$o} = $i*100;
2328         $i++;
2329     }
2330
2331     push @$cmd, '-boot', "menu=on";
2332
2333     push @$cmd, '-no-acpi' if defined($conf->{acpi}) && $conf->{acpi} == 0;
2334
2335     push @$cmd, '-no-reboot' if  defined($conf->{reboot}) && $conf->{reboot} == 0;
2336
2337     my $vga = $conf->{vga};
2338     if (!$vga) {
2339         if ($conf->{ostype} && ($conf->{ostype} eq 'win8' || $conf->{ostype} eq 'win7' || $conf->{ostype} eq 'w2k8')) {
2340             $vga = 'std';
2341         } else {
2342             $vga = 'cirrus';
2343         }
2344     }
2345
2346     push @$cmd, '-vga', $vga if $vga; # for kvm 77 and later
2347
2348     # time drift fix
2349     my $tdf = defined($conf->{tdf}) ? $conf->{tdf} : $defaults->{tdf};
2350
2351     my $nokvm = defined($conf->{kvm}) && $conf->{kvm} == 0 ? 1 : 0;
2352     my $useLocaltime = $conf->{localtime};
2353
2354     if (my $ost = $conf->{ostype}) {
2355         # other, wxp, w2k, w2k3, w2k8, wvista, win7, win8, l24, l26
2356
2357         if ($ost =~ m/^w/) { # windows
2358             $useLocaltime = 1 if !defined($conf->{localtime});
2359
2360             # use time drift fix when acpi is enabled
2361             if (!(defined($conf->{acpi}) && $conf->{acpi} == 0)) {
2362                 $tdf = 1 if !defined($conf->{tdf});
2363             }
2364         }
2365
2366         if ($ost eq 'win7' || $ost eq 'win8' || $ost eq 'w2k8' ||
2367             $ost eq 'wvista') {
2368             push @$globalFlags, 'kvm-pit.lost_tick_policy=discard';
2369             push @$cmd, '-no-hpet';
2370         }
2371     }
2372
2373     push @$rtcFlags, 'driftfix=slew' if $tdf;
2374
2375     if ($nokvm) {
2376         push @$machineFlags, 'accel=tcg';
2377     } else {
2378         die "No accelerator found!\n" if !$cpuinfo->{hvm};
2379     }
2380
2381     if ($conf->{startdate}) {
2382         push @$rtcFlags, "base=$conf->{startdate}";
2383     } elsif ($useLocaltime) {
2384         push @$rtcFlags, 'base=localtime';
2385     }
2386
2387     push @$cmd, '-S' if $conf->{freeze};
2388
2389     # set keyboard layout
2390     my $kb = $conf->{keyboard} || $defaults->{keyboard};
2391     push @$cmd, '-k', $kb if $kb;
2392
2393     # enable sound
2394     #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2395     #push @$cmd, '-soundhw', 'es1370';
2396     #push @$cmd, '-soundhw', $soundhw if $soundhw;
2397
2398     if($conf->{agent}) {
2399         my $qgasocket = qga_socket($vmid);
2400         my $pciaddr = print_pci_addr("qga0", $bridges);
2401         push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
2402         push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
2403         push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
2404     }
2405
2406     # enable balloon by default, unless explicitly disabled
2407     if (!defined($conf->{balloon}) || $conf->{balloon}) {
2408         $pciaddr = print_pci_addr("balloon0", $bridges);
2409         push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr";
2410     }
2411
2412     if ($conf->{watchdog}) {
2413         my $wdopts = parse_watchdog($conf->{watchdog});
2414         $pciaddr = print_pci_addr("watchdog", $bridges);
2415         my $watchdog = $wdopts->{model} || 'i6300esb';
2416         push @$devices, '-device', "$watchdog$pciaddr";
2417         push @$devices, '-watchdog-action', $wdopts->{action} if $wdopts->{action};
2418     }
2419
2420     my $vollist = [];
2421     my $scsicontroller = {};
2422     my $ahcicontroller = {};
2423     my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : $defaults->{scsihw};
2424
2425     foreach_drive($conf, sub {
2426         my ($ds, $drive) = @_;
2427
2428         if (PVE::Storage::parse_volume_id($drive->{file}, 1)) {
2429             push @$vollist, $drive->{file};
2430         }
2431
2432         $use_virtio = 1 if $ds =~ m/^virtio/;
2433
2434         if (drive_is_cdrom ($drive)) {
2435             if ($bootindex_hash->{d}) {
2436                 $drive->{bootindex} = $bootindex_hash->{d};
2437                 $bootindex_hash->{d} += 1;
2438             }
2439         } else {
2440             if ($bootindex_hash->{c}) {
2441                 $drive->{bootindex} = $bootindex_hash->{c} if $conf->{bootdisk} && ($conf->{bootdisk} eq $ds);
2442                 $bootindex_hash->{c} += 1;
2443             }
2444         }
2445
2446         if ($drive->{interface} eq 'scsi') {
2447
2448             my $maxdev = ($scsihw ne 'lsi') ? 256 : 7;
2449             my $controller = int($drive->{index} / $maxdev);
2450             $pciaddr = print_pci_addr("scsihw$controller", $bridges);
2451             push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
2452             $scsicontroller->{$controller}=1;
2453         }
2454
2455         if ($drive->{interface} eq 'sata') {
2456            my $controller = int($drive->{index} / $MAX_SATA_DISKS);
2457            $pciaddr = print_pci_addr("ahci$controller", $bridges);
2458            push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
2459            $ahcicontroller->{$controller}=1;
2460         }
2461
2462         push @$devices, '-drive',print_drive_full($storecfg, $vmid, $drive);
2463         push @$devices, '-device',print_drivedevice_full($storecfg, $conf, $vmid, $drive, $bridges);
2464     });
2465
2466     push @$cmd, '-m', $conf->{memory} || $defaults->{memory};
2467
2468     for (my $i = 0; $i < $MAX_NETS; $i++) {
2469          next if !$conf->{"net$i"};
2470          my $d = parse_net($conf->{"net$i"});
2471          next if !$d;
2472
2473          $use_virtio = 1 if $d->{model} eq 'virtio';
2474
2475          if ($bootindex_hash->{n}) {
2476             $d->{bootindex} = $bootindex_hash->{n};
2477             $bootindex_hash->{n} += 1;
2478          }
2479
2480          my $netdevfull = print_netdev_full($vmid,$conf,$d,"net$i");
2481          push @$devices, '-netdev', $netdevfull;
2482
2483          my $netdevicefull = print_netdevice_full($vmid,$conf,$d,"net$i",$bridges);
2484          push @$devices, '-device', $netdevicefull;
2485     }
2486
2487     #bridges
2488     while (my ($k, $v) = each %$bridges) {
2489         $pciaddr = print_pci_addr("pci.$k");
2490         unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
2491     }
2492
2493
2494     # hack: virtio with fairsched is unreliable, so we do not use fairsched
2495     # when the VM uses virtio devices.
2496     if (!$use_virtio && $have_ovz) {
2497
2498         my $cpuunits = defined($conf->{cpuunits}) ?
2499             $conf->{cpuunits} : $defaults->{cpuunits};
2500
2501         push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
2502
2503         # fixme: cpulimit is currently ignored
2504         #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2505     }
2506
2507     # add custom args
2508     if ($conf->{args}) {
2509         my $aa = PVE::Tools::split_args($conf->{args});
2510         push @$cmd, @$aa;
2511     }
2512
2513     push @$cmd, @$devices;
2514     push @$cmd, '-rtc', join(',', @$rtcFlags)
2515         if scalar(@$rtcFlags);
2516     push @$cmd, '-machine', join(',', @$machineFlags)
2517         if scalar(@$machineFlags);
2518     push @$cmd, '-global', join(',', @$globalFlags)
2519         if scalar(@$globalFlags);
2520
2521     return wantarray ? ($cmd, $vollist) : $cmd;
2522 }
2523
2524 sub vnc_socket {
2525     my ($vmid) = @_;
2526     return "${var_run_tmpdir}/$vmid.vnc";
2527 }
2528
2529 sub qmp_socket {
2530     my ($vmid) = @_;
2531     return "${var_run_tmpdir}/$vmid.qmp";
2532 }
2533
2534 sub qga_socket {
2535     my ($vmid) = @_;
2536     return "${var_run_tmpdir}/$vmid.qga";
2537 }
2538
2539 sub pidfile_name {
2540     my ($vmid) = @_;
2541     return "${var_run_tmpdir}/$vmid.pid";
2542 }
2543
2544 sub vm_devices_list {
2545     my ($vmid) = @_;
2546
2547     my $res = vm_mon_cmd($vmid, 'query-pci');
2548
2549     my $devices = {};
2550     foreach my $pcibus (@$res) {
2551         foreach my $device (@{$pcibus->{devices}}) {
2552             next if !$device->{'qdev_id'};
2553             $devices->{$device->{'qdev_id'}} = $device;
2554         }
2555     }
2556
2557     return $devices;
2558 }
2559
2560 sub vm_deviceplug {
2561     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2562
2563     return 1 if !check_running($vmid);
2564
2565     if ($deviceid eq 'tablet') {
2566         my $devicefull = "usb-tablet,id=tablet,bus=uhci.0,port=1";
2567         qemu_deviceadd($vmid, $devicefull);
2568         return 1;
2569     }
2570
2571     return 1 if !$conf->{hotplug};
2572
2573     my $devices_list = vm_devices_list($vmid);
2574     return 1 if defined($devices_list->{$deviceid});
2575
2576     qemu_bridgeadd($storecfg, $conf, $vmid, $deviceid); #add bridge if we need it for the device
2577
2578     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2579         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2580         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
2581         qemu_deviceadd($vmid, $devicefull);
2582         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2583            qemu_drivedel($vmid, $deviceid);
2584            return undef;
2585         }
2586     }
2587
2588     if ($deviceid =~ m/^(scsihw)(\d+)$/) {
2589         my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : "lsi";
2590         my $pciaddr = print_pci_addr($deviceid);
2591         my $devicefull = "$scsihw,id=$deviceid$pciaddr";
2592         qemu_deviceadd($vmid, $devicefull);
2593         return undef if(!qemu_deviceaddverify($vmid, $deviceid));
2594     }
2595
2596     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2597         return 1 if ($conf->{scsihw} && $conf->{scsihw} ne 'lsi'); #virtio-scsi not yet support hotplug
2598         return undef if !qemu_findorcreatescsihw($storecfg,$conf, $vmid, $device);
2599         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2600         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
2601         if(!qemu_deviceadd($vmid, $devicefull)) {
2602            qemu_drivedel($vmid, $deviceid);
2603            return undef;
2604         }
2605     }
2606
2607     if ($deviceid =~ m/^(net)(\d+)$/) {
2608         return undef if !qemu_netdevadd($vmid, $conf, $device, $deviceid);
2609         my $netdevicefull = print_netdevice_full($vmid, $conf, $device, $deviceid);
2610         qemu_deviceadd($vmid, $netdevicefull);
2611         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2612            qemu_netdevdel($vmid, $deviceid);
2613            return undef;
2614         }
2615     }
2616
2617     if ($deviceid =~ m/^(pci\.)(\d+)$/) {
2618         my $bridgeid = $2;
2619         my $pciaddr = print_pci_addr($deviceid);
2620         my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
2621         qemu_deviceadd($vmid, $devicefull);
2622         return undef if !qemu_deviceaddverify($vmid, $deviceid);
2623     }
2624
2625     return 1;
2626 }
2627
2628 sub vm_deviceunplug {
2629     my ($vmid, $conf, $deviceid) = @_;
2630
2631     return 1 if !check_running ($vmid);
2632
2633     if ($deviceid eq 'tablet') {
2634         qemu_devicedel($vmid, $deviceid);
2635         return 1;
2636     }
2637
2638     return 1 if !$conf->{hotplug};
2639
2640     my $devices_list = vm_devices_list($vmid);
2641     return 1 if !defined($devices_list->{$deviceid});
2642
2643     die "can't unplug bootdisk" if $conf->{bootdisk} && $conf->{bootdisk} eq $deviceid;
2644
2645     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2646         qemu_devicedel($vmid, $deviceid);
2647         return undef if !qemu_devicedelverify($vmid, $deviceid);
2648         return undef if !qemu_drivedel($vmid, $deviceid);
2649     }
2650
2651     if ($deviceid =~ m/^(lsi)(\d+)$/) {
2652         return undef if !qemu_devicedel($vmid, $deviceid);
2653     }
2654
2655     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2656         return undef if !qemu_devicedel($vmid, $deviceid);
2657         return undef if !qemu_drivedel($vmid, $deviceid);
2658     }
2659
2660     if ($deviceid =~ m/^(net)(\d+)$/) {
2661         qemu_devicedel($vmid, $deviceid);
2662         return undef if !qemu_devicedelverify($vmid, $deviceid);
2663         return undef if !qemu_netdevdel($vmid, $deviceid);
2664     }
2665
2666     return 1;
2667 }
2668
2669 sub qemu_deviceadd {
2670     my ($vmid, $devicefull) = @_;
2671
2672     $devicefull = "driver=".$devicefull;
2673     my %options =  split(/[=,]/, $devicefull);
2674
2675     vm_mon_cmd($vmid, "device_add" , %options);
2676     return 1;
2677 }
2678
2679 sub qemu_devicedel {
2680     my($vmid, $deviceid) = @_;
2681     my $ret = vm_mon_cmd($vmid, "device_del", id => $deviceid);
2682     return 1;
2683 }
2684
2685 sub qemu_driveadd {
2686     my($storecfg, $vmid, $device) = @_;
2687
2688     my $drive = print_drive_full($storecfg, $vmid, $device);
2689     my $ret = vm_human_monitor_command($vmid, "drive_add auto $drive");
2690     # If the command succeeds qemu prints: "OK"
2691     if ($ret !~ m/OK/s) {
2692         syslog("err", "adding drive failed: $ret");
2693         return undef;
2694     }
2695     return 1;
2696 }
2697
2698 sub qemu_drivedel {
2699     my($vmid, $deviceid) = @_;
2700
2701     my $ret = vm_human_monitor_command($vmid, "drive_del drive-$deviceid");
2702     $ret =~ s/^\s+//;
2703     if ($ret =~ m/Device \'.*?\' not found/s) {
2704         # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2705     }
2706     elsif ($ret ne "") {
2707       syslog("err", "deleting drive $deviceid failed : $ret");
2708       return undef;
2709     }
2710     return 1;
2711 }
2712
2713 sub qemu_deviceaddverify {
2714     my ($vmid,$deviceid) = @_;
2715
2716     for (my $i = 0; $i <= 5; $i++) {
2717          my $devices_list = vm_devices_list($vmid);
2718          return 1 if defined($devices_list->{$deviceid});
2719          sleep 1;
2720     }
2721     syslog("err", "error on hotplug device $deviceid");
2722     return undef;
2723 }
2724
2725
2726 sub qemu_devicedelverify {
2727     my ($vmid,$deviceid) = @_;
2728
2729     #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2730     for (my $i = 0; $i <= 5; $i++) {
2731          my $devices_list = vm_devices_list($vmid);
2732          return 1 if !defined($devices_list->{$deviceid});
2733          sleep 1;
2734     }
2735     syslog("err", "error on hot-unplugging device $deviceid");
2736     return undef;
2737 }
2738
2739 sub qemu_findorcreatescsihw {
2740     my ($storecfg, $conf, $vmid, $device) = @_;
2741
2742     my $maxdev = ($conf->{scsihw} && $conf->{scsihw} ne 'lsi') ? 256 : 7;
2743     my $controller = int($device->{index} / $maxdev);
2744     my $scsihwid="scsihw$controller";
2745     my $devices_list = vm_devices_list($vmid);
2746
2747     if(!defined($devices_list->{$scsihwid})) {
2748        return undef if !vm_deviceplug($storecfg, $conf, $vmid, $scsihwid);
2749     }
2750     return 1;
2751 }
2752
2753 sub qemu_bridgeadd {
2754     my ($storecfg, $conf, $vmid, $device) = @_;
2755
2756     my $bridges = {};
2757     my $bridgeid = undef;
2758     print_pci_addr($device, $bridges);
2759
2760     while (my ($k, $v) = each %$bridges) {
2761         $bridgeid = $k;
2762     }
2763     return if $bridgeid < 1;
2764     my $bridge = "pci.$bridgeid";
2765     my $devices_list = vm_devices_list($vmid);
2766
2767     if(!defined($devices_list->{$bridge})) {
2768         return undef if !vm_deviceplug($storecfg, $conf, $vmid, $bridge);
2769     }
2770     return 1;
2771 }
2772
2773 sub qemu_netdevadd {
2774     my ($vmid, $conf, $device, $deviceid) = @_;
2775
2776     my $netdev = print_netdev_full($vmid, $conf, $device, $deviceid);
2777     my %options =  split(/[=,]/, $netdev);
2778
2779     vm_mon_cmd($vmid, "netdev_add",  %options);
2780     return 1;
2781 }
2782
2783 sub qemu_netdevdel {
2784     my ($vmid, $deviceid) = @_;
2785
2786     vm_mon_cmd($vmid, "netdev_del", id => $deviceid);
2787     return 1;
2788 }
2789
2790 sub qemu_block_set_io_throttle {
2791     my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
2792
2793     return if !check_running($vmid) ;
2794
2795     $bps = 0 if !$bps;
2796     $bps_rd = 0 if !$bps_rd;
2797     $bps_wr = 0 if !$bps_wr;
2798     $iops = 0 if !$iops;
2799     $iops_rd = 0 if !$iops_rd;
2800     $iops_wr = 0 if !$iops_wr;
2801
2802     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));
2803
2804 }
2805
2806 # old code, only used to shutdown old VM after update
2807 sub __read_avail {
2808     my ($fh, $timeout) = @_;
2809
2810     my $sel = new IO::Select;
2811     $sel->add($fh);
2812
2813     my $res = '';
2814     my $buf;
2815
2816     my @ready;
2817     while (scalar (@ready = $sel->can_read($timeout))) {
2818         my $count;
2819         if ($count = $fh->sysread($buf, 8192)) {
2820             if ($buf =~ /^(.*)\(qemu\) $/s) {
2821                 $res .= $1;
2822                 last;
2823             } else {
2824                 $res .= $buf;
2825             }
2826         } else {
2827             if (!defined($count)) {
2828                 die "$!\n";
2829             }
2830             last;
2831         }
2832     }
2833
2834     die "monitor read timeout\n" if !scalar(@ready);
2835
2836     return $res;
2837 }
2838
2839 # old code, only used to shutdown old VM after update
2840 sub vm_monitor_command {
2841     my ($vmid, $cmdstr, $nocheck) = @_;
2842
2843     my $res;
2844
2845     eval {
2846         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
2847
2848         my $sname = "${var_run_tmpdir}/$vmid.mon";
2849
2850         my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
2851             die "unable to connect to VM $vmid socket - $!\n";
2852
2853         my $timeout = 3;
2854
2855         # hack: migrate sometime blocks the monitor (when migrate_downtime
2856         # is set)
2857         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2858             $timeout = 60*60; # 1 hour
2859         }
2860
2861         # read banner;
2862         my $data = __read_avail($sock, $timeout);
2863
2864         if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
2865             die "got unexpected qemu monitor banner\n";
2866         }
2867
2868         my $sel = new IO::Select;
2869         $sel->add($sock);
2870
2871         if (!scalar(my @ready = $sel->can_write($timeout))) {
2872             die "monitor write error - timeout";
2873         }
2874
2875         my $fullcmd = "$cmdstr\r";
2876
2877         # syslog('info', "VM $vmid monitor command: $cmdstr");
2878
2879         my $b;
2880         if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
2881             die "monitor write error - $!";
2882         }
2883
2884         return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
2885
2886         $timeout = 20;
2887
2888         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2889             $timeout = 60*60; # 1 hour
2890         } elsif ($cmdstr =~ m/^(eject|change)/) {
2891             $timeout = 60; # note: cdrom mount command is slow
2892         }
2893         if ($res = __read_avail($sock, $timeout)) {
2894
2895             my @lines = split("\r?\n", $res);
2896
2897             shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
2898
2899             $res = join("\n", @lines);
2900             $res .= "\n";
2901         }
2902     };
2903
2904     my $err = $@;
2905
2906     if ($err) {
2907         syslog("err", "VM $vmid monitor command failed - $err");
2908         die $err;
2909     }
2910
2911     return $res;
2912 }
2913
2914 sub qemu_block_resize {
2915     my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
2916
2917     my $running = check_running($vmid);
2918
2919     return if !PVE::Storage::volume_resize($storecfg, $volid, $size, $running);
2920
2921     return if !$running;
2922
2923     vm_mon_cmd($vmid, "block_resize", device => $deviceid, size => int($size));
2924
2925 }
2926
2927 sub qemu_volume_snapshot {
2928     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
2929
2930     my $running = check_running($vmid);
2931
2932     return if !PVE::Storage::volume_snapshot($storecfg, $volid, $snap, $running);
2933
2934     return if !$running;
2935
2936     vm_mon_cmd($vmid, "snapshot-drive", device => $deviceid, name => $snap);
2937
2938 }
2939
2940 sub qemu_volume_snapshot_delete {
2941     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
2942
2943     my $running = check_running($vmid);
2944
2945     return if !PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snap, $running);
2946
2947     return if !$running;
2948
2949     vm_mon_cmd($vmid, "delete-drive-snapshot", device => $deviceid, name => $snap);
2950 }
2951
2952 sub qga_freezefs {
2953     my ($vmid) = @_;
2954
2955     #need to impplement call to qemu-ga
2956 }
2957
2958 sub qga_unfreezefs {
2959     my ($vmid) = @_;
2960
2961     #need to impplement call to qemu-ga
2962 }
2963
2964 sub vm_start {
2965     my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused) = @_;
2966
2967     lock_config($vmid, sub {
2968         my $conf = load_config($vmid, $migratedfrom);
2969
2970         die "you can't start a vm if it's a template\n" if is_template($conf);
2971
2972         check_lock($conf) if !$skiplock;
2973
2974         die "VM $vmid already running\n" if check_running($vmid, undef, $migratedfrom);
2975
2976         my $defaults = load_defaults();
2977
2978         # set environment variable useful inside network script
2979         $ENV{PVE_MIGRATED_FROM} = $migratedfrom if $migratedfrom;
2980
2981         my ($cmd, $vollist) = config_to_command($storecfg, $vmid, $conf, $defaults);
2982
2983         my $migrate_port = 0;
2984
2985         if ($statefile) {
2986             if ($statefile eq 'tcp') {
2987                 $migrate_port = PVE::Tools::next_migrate_port();
2988                 my $migrate_uri = "tcp:localhost:${migrate_port}";
2989                 push @$cmd, '-incoming', $migrate_uri;
2990                 push @$cmd, '-S';
2991             } else {
2992                 push @$cmd, '-loadstate', $statefile;
2993             }
2994         } elsif ($paused) {
2995             push @$cmd, '-S';
2996         }
2997
2998         # host pci devices
2999         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
3000           my $d = parse_hostpci($conf->{"hostpci$i"});
3001           next if !$d;
3002           my $info = pci_device_info("0000:$d->{pciid}");
3003           die "IOMMU not present\n" if !check_iommu_support();
3004           die "no pci device info for device '$d->{pciid}'\n" if !$info;
3005           die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub($info);
3006           die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset($info);
3007         }
3008
3009         PVE::Storage::activate_volumes($storecfg, $vollist);
3010
3011         eval  { run_command($cmd, timeout => $statefile ? undef : 30,
3012                     umask => 0077); };
3013         my $err = $@;
3014         die "start failed: $err" if $err;
3015
3016         print "migration listens on port $migrate_port\n" if $migrate_port;
3017
3018         if ($statefile && $statefile ne 'tcp')  {
3019             eval { vm_mon_cmd_nocheck($vmid, "cont"); };
3020             warn $@ if $@;
3021         }
3022
3023         if($migratedfrom) {
3024             my $capabilities = {};
3025             $capabilities->{capability} =  "xbzrle";
3026             $capabilities->{state} = JSON::true;
3027             eval { vm_mon_cmd_nocheck($vmid, "migrate-set-capabilities", capabilities => [$capabilities]); };
3028         }
3029         else{
3030
3031             if (!$statefile && (!defined($conf->{balloon}) || $conf->{balloon})) {
3032                 vm_mon_cmd_nocheck($vmid, "balloon", value => $conf->{balloon}*1024*1024)
3033                     if $conf->{balloon};
3034                 vm_mon_cmd_nocheck($vmid, 'qom-set',
3035                             path => "machine/peripheral/balloon0",
3036                             property => "guest-stats-polling-interval",
3037                             value => 2);
3038             }
3039         }
3040     });
3041 }
3042
3043 sub vm_mon_cmd {
3044     my ($vmid, $execute, %params) = @_;
3045
3046     my $cmd = { execute => $execute, arguments => \%params };
3047     vm_qmp_command($vmid, $cmd);
3048 }
3049
3050 sub vm_mon_cmd_nocheck {
3051     my ($vmid, $execute, %params) = @_;
3052
3053     my $cmd = { execute => $execute, arguments => \%params };
3054     vm_qmp_command($vmid, $cmd, 1);
3055 }
3056
3057 sub vm_qmp_command {
3058     my ($vmid, $cmd, $nocheck) = @_;
3059
3060     my $res;
3061
3062     my $timeout;
3063     if ($cmd->{arguments} && $cmd->{arguments}->{timeout}) {
3064         $timeout = $cmd->{arguments}->{timeout};
3065         delete $cmd->{arguments}->{timeout};
3066     }
3067
3068     eval {
3069         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
3070         my $sname = qmp_socket($vmid);
3071         if (-e $sname) {
3072             my $qmpclient = PVE::QMPClient->new();
3073
3074             $res = $qmpclient->cmd($vmid, $cmd, $timeout);
3075         } elsif (-e "${var_run_tmpdir}/$vmid.mon") {
3076             die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
3077                 if scalar(%{$cmd->{arguments}});
3078             vm_monitor_command($vmid, $cmd->{execute}, $nocheck);
3079         } else {
3080             die "unable to open monitor socket\n";
3081         }
3082     };
3083     if (my $err = $@) {
3084         syslog("err", "VM $vmid qmp command failed - $err");
3085         die $err;
3086     }
3087
3088     return $res;
3089 }
3090
3091 sub vm_human_monitor_command {
3092     my ($vmid, $cmdline) = @_;
3093
3094     my $res;
3095
3096     my $cmd = {
3097         execute => 'human-monitor-command',
3098         arguments => { 'command-line' => $cmdline},
3099     };
3100
3101     return vm_qmp_command($vmid, $cmd);
3102 }
3103
3104 sub vm_commandline {
3105     my ($storecfg, $vmid) = @_;
3106
3107     my $conf = load_config($vmid);
3108
3109     my $defaults = load_defaults();
3110
3111     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
3112
3113     return join(' ', @$cmd);
3114 }
3115
3116 sub vm_reset {
3117     my ($vmid, $skiplock) = @_;
3118
3119     lock_config($vmid, sub {
3120
3121         my $conf = load_config($vmid);
3122
3123         check_lock($conf) if !$skiplock;
3124
3125         vm_mon_cmd($vmid, "system_reset");
3126     });
3127 }
3128
3129 sub get_vm_volumes {
3130     my ($conf) = @_;
3131
3132     my $vollist = [];
3133     foreach_volid($conf, sub {
3134         my ($volid, $is_cdrom) = @_;
3135
3136         return if $volid =~ m|^/|;
3137
3138         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
3139         return if !$sid;
3140
3141         push @$vollist, $volid;
3142     });
3143
3144     return $vollist;
3145 }
3146
3147 sub vm_stop_cleanup {
3148     my ($storecfg, $vmid, $conf, $keepActive) = @_;
3149
3150     eval {
3151         fairsched_rmnod($vmid); # try to destroy group
3152
3153         if (!$keepActive) {
3154             my $vollist = get_vm_volumes($conf);
3155             PVE::Storage::deactivate_volumes($storecfg, $vollist);
3156         }
3157
3158         foreach my $ext (qw(mon qmp pid vnc qga)) {
3159             unlink "/var/run/qemu-server/${vmid}.$ext";
3160         }
3161     };
3162     warn $@ if $@; # avoid errors - just warn
3163 }
3164
3165 # Note: use $nockeck to skip tests if VM configuration file exists.
3166 # We need that when migration VMs to other nodes (files already moved)
3167 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3168 sub vm_stop {
3169     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3170
3171     $force = 1 if !defined($force) && !$shutdown;
3172
3173     if ($migratedfrom){
3174         my $pid = check_running($vmid, $nocheck, $migratedfrom);
3175         kill 15, $pid if $pid;
3176         my $conf = load_config($vmid, $migratedfrom);
3177         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive);
3178         return;
3179     }
3180
3181     lock_config($vmid, sub {
3182
3183         my $pid = check_running($vmid, $nocheck);
3184         return if !$pid;
3185
3186         my $conf;
3187         if (!$nocheck) {
3188             $conf = load_config($vmid);
3189             check_lock($conf) if !$skiplock;
3190             if (!defined($timeout) && $shutdown && $conf->{startup}) {
3191                 my $opts = parse_startup($conf->{startup});
3192                 $timeout = $opts->{down} if $opts->{down};
3193             }
3194         }
3195
3196         $timeout = 60 if !defined($timeout);
3197
3198         eval {
3199             if ($shutdown) {
3200                 $nocheck ? vm_mon_cmd_nocheck($vmid, "system_powerdown") : vm_mon_cmd($vmid, "system_powerdown");
3201
3202             } else {
3203                 $nocheck ? vm_mon_cmd_nocheck($vmid, "quit") : vm_mon_cmd($vmid, "quit");
3204             }
3205         };
3206         my $err = $@;
3207
3208         if (!$err) {
3209             my $count = 0;
3210             while (($count < $timeout) && check_running($vmid, $nocheck)) {
3211                 $count++;
3212                 sleep 1;
3213             }
3214
3215             if ($count >= $timeout) {
3216                 if ($force) {
3217                     warn "VM still running - terminating now with SIGTERM\n";
3218                     kill 15, $pid;
3219                 } else {
3220                     die "VM quit/powerdown failed - got timeout\n";
3221                 }
3222             } else {
3223                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3224                 return;
3225             }
3226         } else {
3227             if ($force) {
3228                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3229                 kill 15, $pid;
3230             } else {
3231                 die "VM quit/powerdown failed\n";
3232             }
3233         }
3234
3235         # wait again
3236         $timeout = 10;
3237
3238         my $count = 0;
3239         while (($count < $timeout) && check_running($vmid, $nocheck)) {
3240             $count++;
3241             sleep 1;
3242         }
3243
3244         if ($count >= $timeout) {
3245             warn "VM still running - terminating now with SIGKILL\n";
3246             kill 9, $pid;
3247             sleep 1;
3248         }
3249
3250         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3251    });
3252 }
3253
3254 sub vm_suspend {
3255     my ($vmid, $skiplock) = @_;
3256
3257     lock_config($vmid, sub {
3258
3259         my $conf = load_config($vmid);
3260
3261         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3262
3263         vm_mon_cmd($vmid, "stop");
3264     });
3265 }
3266
3267 sub vm_resume {
3268     my ($vmid, $skiplock) = @_;
3269
3270     lock_config($vmid, sub {
3271
3272         my $conf = load_config($vmid);
3273
3274         check_lock($conf) if !($skiplock || ($conf->{lock} && $conf->{lock} eq 'backup'));
3275
3276         vm_mon_cmd($vmid, "cont");
3277     });
3278 }
3279
3280 sub vm_sendkey {
3281     my ($vmid, $skiplock, $key) = @_;
3282
3283     lock_config($vmid, sub {
3284
3285         my $conf = load_config($vmid);
3286
3287         # there is no qmp command, so we use the human monitor command
3288         vm_human_monitor_command($vmid, "sendkey $key");
3289     });
3290 }
3291
3292 sub vm_destroy {
3293     my ($storecfg, $vmid, $skiplock) = @_;
3294
3295     lock_config($vmid, sub {
3296
3297         my $conf = load_config($vmid);
3298
3299         check_lock($conf) if !$skiplock;
3300
3301         if (!check_running($vmid)) {
3302             fairsched_rmnod($vmid); # try to destroy group
3303             destroy_vm($storecfg, $vmid);
3304         } else {
3305             die "VM $vmid is running - destroy failed\n";
3306         }
3307     });
3308 }
3309
3310 # pci helpers
3311
3312 sub file_write {
3313     my ($filename, $buf) = @_;
3314
3315     my $fh = IO::File->new($filename, "w");
3316     return undef if !$fh;
3317
3318     my $res = print $fh $buf;
3319
3320     $fh->close();
3321
3322     return $res;
3323 }
3324
3325 sub pci_device_info {
3326     my ($name) = @_;
3327
3328     my $res;
3329
3330     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3331     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3332
3333     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
3334     return undef if !defined($irq) || $irq !~ m/^\d+$/;
3335
3336     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
3337     return undef if !defined($vendor) || $vendor !~ s/^0x//;
3338
3339     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
3340     return undef if !defined($product) || $product !~ s/^0x//;
3341
3342     $res = {
3343         name => $name,
3344         vendor => $vendor,
3345         product => $product,
3346         domain => $domain,
3347         bus => $bus,
3348         slot => $slot,
3349         func => $func,
3350         irq => $irq,
3351         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
3352     };
3353
3354     return $res;
3355 }
3356
3357 sub pci_dev_reset {
3358     my ($dev) = @_;
3359
3360     my $name = $dev->{name};
3361
3362     my $fn = "$pcisysfs/devices/$name/reset";
3363
3364     return file_write($fn, "1");
3365 }
3366
3367 sub pci_dev_bind_to_stub {
3368     my ($dev) = @_;
3369
3370     my $name = $dev->{name};
3371
3372     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3373     return 1 if -d $testdir;
3374
3375     my $data = "$dev->{vendor} $dev->{product}";
3376     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
3377
3378     my $fn = "$pcisysfs/devices/$name/driver/unbind";
3379     if (!file_write($fn, $name)) {
3380         return undef if -f $fn;
3381     }
3382
3383     $fn = "$pcisysfs/drivers/pci-stub/bind";
3384     if (! -d $testdir) {
3385         return undef if !file_write($fn, $name);
3386     }
3387
3388     return -d $testdir;
3389 }
3390
3391 sub print_pci_addr {
3392     my ($id, $bridges) = @_;
3393
3394     my $res = '';
3395     my $devices = {
3396         piix3 => { bus => 0, addr => 1 },
3397         #addr2 : first videocard
3398         balloon0 => { bus => 0, addr => 3 },
3399         watchdog => { bus => 0, addr => 4 },
3400         scsihw0 => { bus => 0, addr => 5 },
3401         scsihw1 => { bus => 0, addr => 6 },
3402         ahci0 => { bus => 0, addr => 7 },
3403         qga0 => { bus => 0, addr => 8 },
3404         virtio0 => { bus => 0, addr => 10 },
3405         virtio1 => { bus => 0, addr => 11 },
3406         virtio2 => { bus => 0, addr => 12 },
3407         virtio3 => { bus => 0, addr => 13 },
3408         virtio4 => { bus => 0, addr => 14 },
3409         virtio5 => { bus => 0, addr => 15 },
3410         hostpci0 => { bus => 0, addr => 16 },
3411         hostpci1 => { bus => 0, addr => 17 },
3412         net0 => { bus => 0, addr => 18 },
3413         net1 => { bus => 0, addr => 19 },
3414         net2 => { bus => 0, addr => 20 },
3415         net3 => { bus => 0, addr => 21 },
3416         net4 => { bus => 0, addr => 22 },
3417         net5 => { bus => 0, addr => 23 },
3418         #addr29 : usb-host (pve-usb.cfg)
3419         'pci.1' => { bus => 0, addr => 30 },
3420         'pci.2' => { bus => 0, addr => 31 },
3421         'net6' => { bus => 1, addr => 1 },
3422         'net7' => { bus => 1, addr => 2 },
3423         'net8' => { bus => 1, addr => 3 },
3424         'net9' => { bus => 1, addr => 4 },
3425         'net10' => { bus => 1, addr => 5 },
3426         'net11' => { bus => 1, addr => 6 },
3427         'net12' => { bus => 1, addr => 7 },
3428         'net13' => { bus => 1, addr => 8 },
3429         'net14' => { bus => 1, addr => 9 },
3430         'net15' => { bus => 1, addr => 10 },
3431         'net16' => { bus => 1, addr => 11 },
3432         'net17' => { bus => 1, addr => 12 },
3433         'net18' => { bus => 1, addr => 13 },
3434         'net19' => { bus => 1, addr => 14 },
3435         'net20' => { bus => 1, addr => 15 },
3436         'net21' => { bus => 1, addr => 16 },
3437         'net22' => { bus => 1, addr => 17 },
3438         'net23' => { bus => 1, addr => 18 },
3439         'net24' => { bus => 1, addr => 19 },
3440         'net25' => { bus => 1, addr => 20 },
3441         'net26' => { bus => 1, addr => 21 },
3442         'net27' => { bus => 1, addr => 22 },
3443         'net28' => { bus => 1, addr => 23 },
3444         'net29' => { bus => 1, addr => 24 },
3445         'net30' => { bus => 1, addr => 25 },
3446         'net31' => { bus => 1, addr => 26 },
3447         'virtio6' => { bus => 2, addr => 1 },
3448         'virtio7' => { bus => 2, addr => 2 },
3449         'virtio8' => { bus => 2, addr => 3 },
3450         'virtio9' => { bus => 2, addr => 4 },
3451         'virtio10' => { bus => 2, addr => 5 },
3452         'virtio11' => { bus => 2, addr => 6 },
3453         'virtio12' => { bus => 2, addr => 7 },
3454         'virtio13' => { bus => 2, addr => 8 },
3455         'virtio14' => { bus => 2, addr => 9 },
3456         'virtio15' => { bus => 2, addr => 10 },
3457     };
3458
3459     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
3460            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
3461            my $bus = $devices->{$id}->{bus};
3462            $res = ",bus=pci.$bus,addr=$addr";
3463            $bridges->{$bus} = 1 if $bridges;
3464     }
3465     return $res;
3466
3467 }
3468
3469 # vzdump restore implementaion
3470
3471 sub tar_archive_read_firstfile {
3472     my $archive = shift;
3473
3474     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
3475
3476     # try to detect archive type first
3477     my $pid = open (TMP, "tar tf '$archive'|") ||
3478         die "unable to open file '$archive'\n";
3479     my $firstfile = <TMP>;
3480     kill 15, $pid;
3481     close TMP;
3482
3483     die "ERROR: archive contaions no data\n" if !$firstfile;
3484     chomp $firstfile;
3485
3486     return $firstfile;
3487 }
3488
3489 sub tar_restore_cleanup {
3490     my ($storecfg, $statfile) = @_;
3491
3492     print STDERR "starting cleanup\n";
3493
3494     if (my $fd = IO::File->new($statfile, "r")) {
3495         while (defined(my $line = <$fd>)) {
3496             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3497                 my $volid = $2;
3498                 eval {
3499                     if ($volid =~ m|^/|) {
3500                         unlink $volid || die 'unlink failed\n';
3501                     } else {
3502                         PVE::Storage::vdisk_free($storecfg, $volid);
3503                     }
3504                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
3505                 };
3506                 print STDERR "unable to cleanup '$volid' - $@" if $@;
3507             } else {
3508                 print STDERR "unable to parse line in statfile - $line";
3509             }
3510         }
3511         $fd->close();
3512     }
3513 }
3514
3515 sub restore_archive {
3516     my ($archive, $vmid, $user, $opts) = @_;
3517
3518     my $format = $opts->{format};
3519     my $comp;
3520
3521     if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
3522         $format = 'tar' if !$format;
3523         $comp = 'gzip';
3524     } elsif ($archive =~ m/\.tar$/) {
3525         $format = 'tar' if !$format;
3526     } elsif ($archive =~ m/.tar.lzo$/) {
3527         $format = 'tar' if !$format;
3528         $comp = 'lzop';
3529     } elsif ($archive =~ m/\.vma$/) {
3530         $format = 'vma' if !$format;
3531     } elsif ($archive =~ m/\.vma\.gz$/) {
3532         $format = 'vma' if !$format;
3533         $comp = 'gzip';
3534     } elsif ($archive =~ m/\.vma\.lzo$/) {
3535         $format = 'vma' if !$format;
3536         $comp = 'lzop';
3537     } else {
3538         $format = 'vma' if !$format; # default
3539     }
3540
3541     # try to detect archive format
3542     if ($format eq 'tar') {
3543         return restore_tar_archive($archive, $vmid, $user, $opts);
3544     } else {
3545         return restore_vma_archive($archive, $vmid, $user, $opts, $comp);
3546     }
3547 }
3548
3549 sub restore_update_config_line {
3550     my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
3551
3552     return if $line =~ m/^\#qmdump\#/;
3553     return if $line =~ m/^\#vzdump\#/;
3554     return if $line =~ m/^lock:/;
3555     return if $line =~ m/^unused\d+:/;
3556     return if $line =~ m/^parent:/;
3557     return if $line =~ m/^template:/; # restored VM is never a template
3558
3559     if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3560         # try to convert old 1.X settings
3561         my ($id, $ind, $ethcfg) = ($1, $2, $3);
3562         foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
3563             my ($model, $macaddr) = split(/\=/, $devconfig);
3564             $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $unique;
3565             my $net = {
3566                 model => $model,
3567                 bridge => "vmbr$ind",
3568                 macaddr => $macaddr,
3569             };
3570             my $netstr = print_net($net);
3571
3572             print $outfd "net$cookie->{netcount}: $netstr\n";
3573             $cookie->{netcount}++;
3574         }
3575     } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
3576         my ($id, $netstr) = ($1, $2);
3577         my $net = parse_net($netstr);
3578         $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
3579         $netstr = print_net($net);
3580         print $outfd "$id: $netstr\n";
3581     } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
3582         my $virtdev = $1;
3583         my $value = $3;
3584         if ($line =~ m/backup=no/) {
3585             print $outfd "#$line";
3586         } elsif ($virtdev && $map->{$virtdev}) {
3587             my $di = parse_drive($virtdev, $value);
3588             delete $di->{format}; # format can change on restore
3589             $di->{file} = $map->{$virtdev};
3590             $value = print_drive($vmid, $di);
3591             print $outfd "$virtdev: $value\n";
3592         } else {
3593             print $outfd $line;
3594         }
3595     } else {
3596         print $outfd $line;
3597     }
3598 }
3599
3600 sub scan_volids {
3601     my ($cfg, $vmid) = @_;
3602
3603     my $info = PVE::Storage::vdisk_list($cfg, undef, $vmid);
3604
3605     my $volid_hash = {};
3606     foreach my $storeid (keys %$info) {
3607         foreach my $item (@{$info->{$storeid}}) {
3608             next if !($item->{volid} && $item->{size});
3609             $item->{path} = PVE::Storage::path($cfg, $item->{volid});
3610             $volid_hash->{$item->{volid}} = $item;
3611         }
3612     }
3613
3614     return $volid_hash;
3615 }
3616
3617 sub update_disksize {
3618     my ($vmid, $conf, $volid_hash) = @_;
3619
3620     my $changes;
3621
3622     my $used = {};
3623
3624     # Note: it is allowed to define multiple storages with same path (alias), so
3625     # we need to check both 'volid' and real 'path' (two different volid can point
3626     # to the same path).
3627
3628     my $usedpath = {};
3629
3630     # update size info
3631     foreach my $opt (keys %$conf) {
3632         if (valid_drivename($opt)) {
3633             my $drive = parse_drive($opt, $conf->{$opt});
3634             my $volid = $drive->{file};
3635             next if !$volid;
3636
3637             $used->{$volid} = 1;
3638             if ($volid_hash->{$volid} &&
3639                 (my $path = $volid_hash->{$volid}->{path})) {
3640                 $usedpath->{$path} = 1;
3641             }
3642
3643             next if drive_is_cdrom($drive);
3644             next if !$volid_hash->{$volid};
3645
3646             $drive->{size} = $volid_hash->{$volid}->{size};
3647             my $new = print_drive($vmid, $drive);
3648             if ($new ne $conf->{$opt}) {
3649                 $changes = 1;
3650                 $conf->{$opt} = $new;
3651             }
3652         }
3653     }
3654
3655     # remove 'unusedX' entry if volume is used
3656     foreach my $opt (keys %$conf) {
3657         next if $opt !~ m/^unused\d+$/;
3658         my $volid = $conf->{$opt};
3659         my $path = $volid_hash->{$volid}->{path} if $volid_hash->{$volid};
3660         if ($used->{$volid} || ($path && $usedpath->{$path})) {
3661             $changes = 1;
3662             delete $conf->{$opt};
3663         }
3664     }
3665
3666     foreach my $volid (sort keys %$volid_hash) {
3667         next if $volid =~ m/vm-$vmid-state-/;
3668         next if $used->{$volid};
3669         my $path = $volid_hash->{$volid}->{path};
3670         next if !$path; # just to be sure
3671         next if $usedpath->{$path};
3672         $changes = 1;
3673         add_unused_volume($conf, $volid);
3674     }
3675
3676     return $changes;
3677 }
3678
3679 sub rescan {
3680     my ($vmid, $nolock) = @_;
3681
3682     my $cfg = PVE::Cluster::cfs_read_file("storage.cfg");
3683
3684     my $volid_hash = scan_volids($cfg, $vmid);
3685
3686     my $updatefn =  sub {
3687         my ($vmid) = @_;
3688
3689         my $conf = load_config($vmid);
3690
3691         check_lock($conf);
3692
3693         my $vm_volids = {};
3694         foreach my $volid (keys %$volid_hash) {
3695             my $info = $volid_hash->{$volid};
3696             $vm_volids->{$volid} = $info if $info->{vmid} && $info->{vmid} == $vmid;
3697         }
3698
3699         my $changes = update_disksize($vmid, $conf, $vm_volids);
3700
3701         update_config_nolock($vmid, $conf, 1) if $changes;
3702     };
3703
3704     if (defined($vmid)) {
3705         if ($nolock) {
3706             &$updatefn($vmid);
3707         } else {
3708             lock_config($vmid, $updatefn, $vmid);
3709         }
3710     } else {
3711         my $vmlist = config_list();
3712         foreach my $vmid (keys %$vmlist) {
3713             if ($nolock) {
3714                 &$updatefn($vmid);
3715             } else {
3716                 lock_config($vmid, $updatefn, $vmid);
3717             }
3718         }
3719     }
3720 }
3721
3722 sub restore_vma_archive {
3723     my ($archive, $vmid, $user, $opts, $comp) = @_;
3724
3725     my $input = $archive eq '-' ? "<&STDIN" : undef;
3726     my $readfrom = $archive;
3727
3728     my $uncomp = '';
3729     if ($comp) {
3730         $readfrom = '-';
3731         my $qarchive = PVE::Tools::shellquote($archive);
3732         if ($comp eq 'gzip') {
3733             $uncomp = "zcat $qarchive|";
3734         } elsif ($comp eq 'lzop') {
3735             $uncomp = "lzop -d -c $qarchive|";
3736         } else {
3737             die "unknown compression method '$comp'\n";
3738         }
3739
3740     }
3741
3742     my $tmpdir = "/var/tmp/vzdumptmp$$";
3743     rmtree $tmpdir;
3744
3745     # disable interrupts (always do cleanups)
3746     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
3747         warn "got interrupt - ignored\n";
3748     };
3749
3750     my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
3751     POSIX::mkfifo($mapfifo, 0600);
3752     my $fifofh;
3753
3754     my $openfifo = sub {
3755         open($fifofh, '>', $mapfifo) || die $!;
3756     };
3757
3758     my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
3759
3760     my $oldtimeout;
3761     my $timeout = 5;
3762
3763     my $devinfo = {};
3764
3765     my $rpcenv = PVE::RPCEnvironment::get();
3766
3767     my $conffile = config_file($vmid);
3768     my $tmpfn = "$conffile.$$.tmp";
3769
3770     # Note: $oldconf is undef if VM does not exists
3771     my $oldconf = PVE::Cluster::cfs_read_file(cfs_config_path($vmid));
3772
3773     my $print_devmap = sub {
3774         my $virtdev_hash = {};
3775
3776         my $cfgfn = "$tmpdir/qemu-server.conf";
3777
3778         # we can read the config - that is already extracted
3779         my $fh = IO::File->new($cfgfn, "r") ||
3780             "unable to read qemu-server.conf - $!\n";
3781
3782         while (defined(my $line = <$fh>)) {
3783             if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
3784                 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
3785                 die "archive does not contain data for drive '$virtdev'\n"
3786                     if !$devinfo->{$devname};
3787                 if (defined($opts->{storage})) {
3788                     $storeid = $opts->{storage} || 'local';
3789                 } elsif (!$storeid) {
3790                     $storeid = 'local';
3791                 }
3792                 $format = 'raw' if !$format;
3793                 $devinfo->{$devname}->{devname} = $devname;
3794                 $devinfo->{$devname}->{virtdev} = $virtdev;
3795                 $devinfo->{$devname}->{format} = $format;
3796                 $devinfo->{$devname}->{storeid} = $storeid;
3797
3798                 # check permission on storage
3799                 my $pool = $opts->{pool}; # todo: do we need that?
3800                 if ($user ne 'root@pam') {
3801                     $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
3802                 }
3803
3804                 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
3805             }
3806         }
3807
3808         foreach my $devname (keys %$devinfo) {
3809             die "found no device mapping information for device '$devname'\n"
3810                 if !$devinfo->{$devname}->{virtdev};
3811         }
3812
3813         my $cfg = cfs_read_file('storage.cfg');
3814
3815         # create empty/temp config
3816         if ($oldconf) {
3817             PVE::Tools::file_set_contents($conffile, "memory: 128\n");
3818             foreach_drive($oldconf, sub {
3819                 my ($ds, $drive) = @_;
3820
3821                 return if drive_is_cdrom($drive);
3822
3823                 my $volid = $drive->{file};
3824
3825                 return if !$volid || $volid =~ m|^/|;
3826
3827                 my ($path, $owner) = PVE::Storage::path($cfg, $volid);
3828                 return if !$path || !$owner || ($owner != $vmid);
3829
3830                 # Note: only delete disk we want to restore
3831                 # other volumes will become unused
3832                 if ($virtdev_hash->{$ds}) {
3833                     PVE::Storage::vdisk_free($cfg, $volid);
3834                 }
3835             });
3836         }
3837
3838         my $map = {};
3839         foreach my $virtdev (sort keys %$virtdev_hash) {
3840             my $d = $virtdev_hash->{$virtdev};
3841             my $alloc_size = int(($d->{size} + 1024 - 1)/1024);
3842             my $scfg = PVE::Storage::storage_config($cfg, $d->{storeid});
3843
3844             # test if requested format is supported
3845             my ($defFormat, $validFormats) = PVE::Storage::storage_default_format($cfg, $d->{storeid});
3846             my $supported = grep { $_ eq $d->{format} } @$validFormats;
3847             $d->{format} = $defFormat if !$supported;
3848
3849             my $volid = PVE::Storage::vdisk_alloc($cfg, $d->{storeid}, $vmid,
3850                                                   $d->{format}, undef, $alloc_size);
3851             print STDERR "new volume ID is '$volid'\n";
3852             $d->{volid} = $volid;
3853             my $path = PVE::Storage::path($cfg, $volid);
3854
3855             my $write_zeros = 1;
3856             # fixme: what other storages types initialize volumes with zero?
3857             if ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs' ||
3858                 $scfg->{type} eq 'sheepdog' || $scfg->{type} eq 'rbd') {
3859                 $write_zeros = 0;
3860             }
3861
3862             print $fifofh "${write_zeros}:$d->{devname}=$path\n";
3863
3864             print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
3865             $map->{$virtdev} = $volid;
3866         }
3867
3868         $fh->seek(0, 0) || die "seek failed - $!\n";
3869
3870         my $outfd = new IO::File ($tmpfn, "w") ||
3871             die "unable to write config for VM $vmid\n";
3872
3873         my $cookie = { netcount => 0 };
3874         while (defined(my $line = <$fh>)) {
3875             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
3876         }
3877
3878         $fh->close();
3879         $outfd->close();
3880     };
3881
3882     eval {
3883         # enable interrupts
3884         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
3885             die "interrupted by signal\n";
3886         };
3887         local $SIG{ALRM} = sub { die "got timeout\n"; };
3888
3889         $oldtimeout = alarm($timeout);
3890
3891         my $parser = sub {
3892             my $line = shift;
3893
3894             print "$line\n";
3895
3896             if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
3897                 my ($dev_id, $size, $devname) = ($1, $2, $3);
3898                 $devinfo->{$devname} = { size => $size, dev_id => $dev_id };
3899             } elsif ($line =~ m/^CTIME: /) {
3900                 &$print_devmap();
3901                 print $fifofh "done\n";
3902                 my $tmp = $oldtimeout || 0;
3903                 $oldtimeout = undef;
3904                 alarm($tmp);
3905                 close($fifofh);
3906             }
3907         };
3908
3909         print "restore vma archive: $cmd\n";
3910         run_command($cmd, input => $input, outfunc => $parser, afterfork => $openfifo);
3911     };
3912     my $err = $@;
3913
3914     alarm($oldtimeout) if $oldtimeout;
3915
3916     unlink $mapfifo;
3917
3918     if ($err) {
3919         rmtree $tmpdir;
3920         unlink $tmpfn;
3921
3922         my $cfg = cfs_read_file('storage.cfg');
3923         foreach my $devname (keys %$devinfo) {
3924             my $volid = $devinfo->{$devname}->{volid};
3925             next if !$volid;
3926             eval {
3927                 if ($volid =~ m|^/|) {
3928                     unlink $volid || die 'unlink failed\n';
3929                 } else {
3930                     PVE::Storage::vdisk_free($cfg, $volid);
3931                 }
3932                 print STDERR "temporary volume '$volid' sucessfuly removed\n";
3933             };
3934             print STDERR "unable to cleanup '$volid' - $@" if $@;
3935         }
3936         die $err;
3937     }
3938
3939     rmtree $tmpdir;
3940
3941     rename($tmpfn, $conffile) ||
3942         die "unable to commit configuration file '$conffile'\n";
3943
3944     PVE::Cluster::cfs_update(); # make sure we read new file
3945
3946     eval { rescan($vmid, 1); };
3947     warn $@ if $@;
3948 }
3949
3950 sub restore_tar_archive {
3951     my ($archive, $vmid, $user, $opts) = @_;
3952
3953     if ($archive ne '-') {
3954         my $firstfile = tar_archive_read_firstfile($archive);
3955         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
3956             if $firstfile ne 'qemu-server.conf';
3957     }
3958
3959     my $storecfg = cfs_read_file('storage.cfg');
3960
3961     # destroy existing data - keep empty config
3962     my $vmcfgfn = PVE::QemuServer::config_file($vmid);
3963     destroy_vm($storecfg, $vmid, 1) if -f $vmcfgfn;
3964
3965     my $tocmd = "/usr/lib/qemu-server/qmextract";
3966
3967     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
3968     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
3969     $tocmd .= ' --prealloc' if $opts->{prealloc};
3970     $tocmd .= ' --info' if $opts->{info};
3971
3972     # tar option "xf" does not autodetect compression when read from STDIN,
3973     # so we pipe to zcat
3974     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
3975         PVE::Tools::shellquote("--to-command=$tocmd");
3976
3977     my $tmpdir = "/var/tmp/vzdumptmp$$";
3978     mkpath $tmpdir;
3979
3980     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
3981     local $ENV{VZDUMP_VMID} = $vmid;
3982     local $ENV{VZDUMP_USER} = $user;
3983
3984     my $conffile = config_file($vmid);
3985     my $tmpfn = "$conffile.$$.tmp";
3986
3987     # disable interrupts (always do cleanups)
3988     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
3989         print STDERR "got interrupt - ignored\n";
3990     };
3991
3992     eval {
3993         # enable interrupts
3994         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
3995             die "interrupted by signal\n";
3996         };
3997
3998         if ($archive eq '-') {
3999             print "extracting archive from STDIN\n";
4000             run_command($cmd, input => "<&STDIN");
4001         } else {
4002             print "extracting archive '$archive'\n";
4003             run_command($cmd);
4004         }
4005
4006         return if $opts->{info};
4007
4008         # read new mapping
4009         my $map = {};
4010         my $statfile = "$tmpdir/qmrestore.stat";
4011         if (my $fd = IO::File->new($statfile, "r")) {
4012             while (defined (my $line = <$fd>)) {
4013                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
4014                     $map->{$1} = $2 if $1;
4015                 } else {
4016                     print STDERR "unable to parse line in statfile - $line\n";
4017                 }
4018             }
4019             $fd->close();
4020         }
4021
4022         my $confsrc = "$tmpdir/qemu-server.conf";
4023
4024         my $srcfd = new IO::File($confsrc, "r") ||
4025             die "unable to open file '$confsrc'\n";
4026
4027         my $outfd = new IO::File ($tmpfn, "w") ||
4028             die "unable to write config for VM $vmid\n";
4029
4030         my $cookie = { netcount => 0 };
4031         while (defined (my $line = <$srcfd>)) {
4032             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
4033         }
4034
4035         $srcfd->close();
4036         $outfd->close();
4037     };
4038     my $err = $@;
4039
4040     if ($err) {
4041
4042         unlink $tmpfn;
4043
4044         tar_restore_cleanup($storecfg, "$tmpdir/qmrestore.stat") if !$opts->{info};
4045
4046         die $err;
4047     }
4048
4049     rmtree $tmpdir;
4050
4051     rename $tmpfn, $conffile ||
4052         die "unable to commit configuration file '$conffile'\n";
4053
4054     PVE::Cluster::cfs_update(); # make sure we read new file
4055
4056     eval { rescan($vmid, 1); };
4057     warn $@ if $@;
4058 };
4059
4060
4061 # Internal snapshots
4062
4063 # NOTE: Snapshot create/delete involves several non-atomic
4064 # action, and can take a long time.
4065 # So we try to avoid locking the file and use 'lock' variable
4066 # inside the config file instead.
4067
4068 my $snapshot_copy_config = sub {
4069     my ($source, $dest) = @_;
4070
4071     foreach my $k (keys %$source) {
4072         next if $k eq 'snapshots';
4073         next if $k eq 'snapstate';
4074         next if $k eq 'snaptime';
4075         next if $k eq 'vmstate';
4076         next if $k eq 'lock';
4077         next if $k eq 'digest';
4078         next if $k eq 'description';
4079         next if $k =~ m/^unused\d+$/;
4080
4081         $dest->{$k} = $source->{$k};
4082     }
4083 };
4084
4085 my $snapshot_apply_config = sub {
4086     my ($conf, $snap) = @_;
4087
4088     # copy snapshot list
4089     my $newconf = {
4090         snapshots => $conf->{snapshots},
4091     };
4092
4093     # keep description and list of unused disks
4094     foreach my $k (keys %$conf) {
4095         next if !($k =~ m/^unused\d+$/ || $k eq 'description');
4096         $newconf->{$k} = $conf->{$k};
4097     }
4098
4099     &$snapshot_copy_config($snap, $newconf);
4100
4101     return $newconf;
4102 };
4103
4104 sub foreach_writable_storage {
4105     my ($conf, $func) = @_;
4106
4107     my $sidhash = {};
4108
4109     foreach my $ds (keys %$conf) {
4110         next if !valid_drivename($ds);
4111
4112         my $drive = parse_drive($ds, $conf->{$ds});
4113         next if !$drive;
4114         next if drive_is_cdrom($drive);
4115
4116         my $volid = $drive->{file};
4117
4118         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
4119         $sidhash->{$sid} = $sid if $sid;
4120     }
4121
4122     foreach my $sid (sort keys %$sidhash) {
4123         &$func($sid);
4124     }
4125 }
4126
4127 my $alloc_vmstate_volid = sub {
4128     my ($storecfg, $vmid, $conf, $snapname) = @_;
4129
4130     # Note: we try to be smart when selecting a $target storage
4131
4132     my $target;
4133
4134     # search shared storage first
4135     foreach_writable_storage($conf, sub {
4136         my ($sid) = @_;
4137         my $scfg = PVE::Storage::storage_config($storecfg, $sid);
4138         return if !$scfg->{shared};
4139
4140         $target = $sid if !$target || $scfg->{path}; # prefer file based storage
4141     });
4142
4143     if (!$target) {
4144         # now search local storage
4145         foreach_writable_storage($conf, sub {
4146             my ($sid) = @_;
4147             my $scfg = PVE::Storage::storage_config($storecfg, $sid);
4148             return if $scfg->{shared};
4149
4150             $target = $sid if !$target || $scfg->{path}; # prefer file based storage;
4151         });
4152     }
4153
4154     $target = 'local' if !$target;
4155
4156     my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
4157     # we abort live save after $conf->{memory}, so we need at max twice that space
4158     my $size = $conf->{memory}*2 + $driver_state_size;
4159
4160     my $name = "vm-$vmid-state-$snapname";
4161     my $scfg = PVE::Storage::storage_config($storecfg, $target);
4162     $name .= ".raw" if $scfg->{path}; # add filename extension for file base storage
4163     my $volid = PVE::Storage::vdisk_alloc($storecfg, $target, $vmid, 'raw', $name, $size*1024);
4164
4165     return $volid;
4166 };
4167
4168 my $snapshot_prepare = sub {
4169     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
4170
4171     my $snap;
4172
4173     my $updatefn =  sub {
4174
4175         my $conf = load_config($vmid);
4176
4177         die "you can't take a snapshot if it's a template\n"
4178             if is_template($conf);
4179
4180         check_lock($conf);
4181
4182         $conf->{lock} = 'snapshot';
4183
4184         die "snapshot name '$snapname' already used\n"
4185             if defined($conf->{snapshots}->{$snapname});
4186
4187         my $storecfg = PVE::Storage::config();
4188         die "snapshot feature is not available" if !has_feature('snapshot', $conf, $storecfg);
4189
4190         $snap = $conf->{snapshots}->{$snapname} = {};
4191
4192         if ($save_vmstate && check_running($vmid)) {
4193             $snap->{vmstate} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
4194         }
4195
4196         &$snapshot_copy_config($conf, $snap);
4197
4198         $snap->{snapstate} = "prepare";
4199         $snap->{snaptime} = time();
4200         $snap->{description} = $comment if $comment;
4201
4202         update_config_nolock($vmid, $conf, 1);
4203     };
4204
4205     lock_config($vmid, $updatefn);
4206
4207     return $snap;
4208 };
4209
4210 my $snapshot_commit = sub {
4211     my ($vmid, $snapname) = @_;
4212
4213     my $updatefn = sub {
4214
4215         my $conf = load_config($vmid);
4216
4217         die "missing snapshot lock\n"
4218             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
4219
4220         my $snap = $conf->{snapshots}->{$snapname};
4221
4222         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4223
4224         die "wrong snapshot state\n"
4225             if !($snap->{snapstate} && $snap->{snapstate} eq "prepare");
4226
4227         delete $snap->{snapstate};
4228         delete $conf->{lock};
4229
4230         my $newconf = &$snapshot_apply_config($conf, $snap);
4231
4232         $newconf->{parent} = $snapname;
4233
4234         update_config_nolock($vmid, $newconf, 1);
4235     };
4236
4237     lock_config($vmid, $updatefn);
4238 };
4239
4240 sub snapshot_rollback {
4241     my ($vmid, $snapname) = @_;
4242
4243     my $snap;
4244
4245     my $prepare = 1;
4246
4247     my $storecfg = PVE::Storage::config();
4248
4249     my $updatefn = sub {
4250
4251         my $conf = load_config($vmid);
4252
4253         die "you can't rollback if vm is a template\n" if is_template($conf);
4254
4255         $snap = $conf->{snapshots}->{$snapname};
4256
4257         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4258
4259         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
4260             if $snap->{snapstate};
4261
4262         if ($prepare) {
4263             check_lock($conf);
4264             vm_stop($storecfg, $vmid, undef, undef, 5, undef, undef);
4265         }
4266
4267         die "unable to rollback vm $vmid: vm is running\n"
4268             if check_running($vmid);
4269
4270         if ($prepare) {
4271             $conf->{lock} = 'rollback';
4272         } else {
4273             die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
4274             delete $conf->{lock};
4275         }
4276
4277         if (!$prepare) {
4278             # copy snapshot config to current config
4279             $conf = &$snapshot_apply_config($conf, $snap);
4280             $conf->{parent} = $snapname;
4281         }
4282
4283         update_config_nolock($vmid, $conf, 1);
4284
4285         if (!$prepare && $snap->{vmstate}) {
4286             my $statefile = PVE::Storage::path($storecfg, $snap->{vmstate});
4287             vm_start($storecfg, $vmid, $statefile);
4288         }
4289     };
4290
4291     lock_config($vmid, $updatefn);
4292
4293     foreach_drive($snap, sub {
4294         my ($ds, $drive) = @_;
4295
4296         return if drive_is_cdrom($drive);
4297
4298         my $volid = $drive->{file};
4299         my $device = "drive-$ds";
4300
4301         PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
4302     });
4303
4304     $prepare = 0;
4305     lock_config($vmid, $updatefn);
4306 }
4307
4308 my $savevm_wait = sub {
4309     my ($vmid) = @_;
4310
4311     for(;;) {
4312         my $stat = vm_mon_cmd_nocheck($vmid, "query-savevm");
4313         if (!$stat->{status}) {
4314             die "savevm not active\n";
4315         } elsif ($stat->{status} eq 'active') {
4316             sleep(1);
4317             next;
4318         } elsif ($stat->{status} eq 'completed') {
4319             last;
4320         } else {
4321             die "query-savevm returned status '$stat->{status}'\n";
4322         }
4323     }
4324 };
4325
4326 sub snapshot_create {
4327     my ($vmid, $snapname, $save_vmstate, $freezefs, $comment) = @_;
4328
4329     my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
4330
4331     $freezefs = $save_vmstate = 0 if !$snap->{vmstate}; # vm is not running
4332
4333     my $drivehash = {};
4334
4335     my $running = check_running($vmid);
4336
4337     eval {
4338         # create internal snapshots of all drives
4339
4340         my $storecfg = PVE::Storage::config();
4341
4342         if ($running) {
4343             if ($snap->{vmstate}) {
4344                 my $path = PVE::Storage::path($storecfg, $snap->{vmstate});
4345                 vm_mon_cmd($vmid, "savevm-start", statefile => $path);
4346                 &$savevm_wait($vmid);
4347             } else {
4348                 vm_mon_cmd($vmid, "savevm-start");
4349             }
4350         };
4351
4352         qga_freezefs($vmid) if $running && $freezefs;
4353
4354         foreach_drive($snap, sub {
4355             my ($ds, $drive) = @_;
4356
4357             return if drive_is_cdrom($drive);
4358
4359             my $volid = $drive->{file};
4360             my $device = "drive-$ds";
4361
4362             qemu_volume_snapshot($vmid, $device, $storecfg, $volid, $snapname);
4363             $drivehash->{$ds} = 1;
4364        });
4365     };
4366     my $err = $@;
4367
4368     eval { gqa_unfreezefs($vmid) if $running && $freezefs; };
4369     warn $@ if $@;
4370
4371     eval { vm_mon_cmd($vmid, "savevm-end") if $running; };
4372     warn $@ if $@;
4373
4374     if ($err) {
4375         warn "snapshot create failed: starting cleanup\n";
4376         eval { snapshot_delete($vmid, $snapname, 0, $drivehash); };
4377         warn $@ if $@;
4378         die $err;
4379     }
4380
4381     &$snapshot_commit($vmid, $snapname);
4382 }
4383
4384 # Note: $drivehash is only set when called from snapshot_create.
4385 sub snapshot_delete {
4386     my ($vmid, $snapname, $force, $drivehash) = @_;
4387
4388     my $prepare = 1;
4389
4390     my $snap;
4391     my $unused = [];
4392
4393     my $unlink_parent = sub {
4394         my ($confref, $new_parent) = @_;
4395
4396         if ($confref->{parent} && $confref->{parent} eq $snapname) {
4397             if ($new_parent) {
4398                 $confref->{parent} = $new_parent;
4399             } else {
4400                 delete $confref->{parent};
4401             }
4402         }
4403     };
4404
4405     my $updatefn =  sub {
4406         my ($remove_drive) = @_;
4407
4408         my $conf = load_config($vmid);
4409
4410         if (!$drivehash) {
4411             check_lock($conf);
4412             die "you can't delete a snapshot if vm is a template\n"
4413                 if is_template($conf);
4414         }
4415
4416         $snap = $conf->{snapshots}->{$snapname};
4417
4418         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4419
4420         # remove parent refs
4421         &$unlink_parent($conf, $snap->{parent});
4422         foreach my $sn (keys %{$conf->{snapshots}}) {
4423             next if $sn eq $snapname;
4424             &$unlink_parent($conf->{snapshots}->{$sn}, $snap->{parent});
4425         }
4426
4427         if ($remove_drive) {
4428             if ($remove_drive eq 'vmstate') {
4429                 delete $snap->{$remove_drive};
4430             } else {
4431                 my $drive = parse_drive($remove_drive, $snap->{$remove_drive});
4432                 my $volid = $drive->{file};
4433                 delete $snap->{$remove_drive};
4434                 add_unused_volume($conf, $volid);
4435             }
4436         }
4437
4438         if ($prepare) {
4439             $snap->{snapstate} = 'delete';
4440         } else {
4441             delete $conf->{snapshots}->{$snapname};
4442             delete $conf->{lock} if $drivehash;
4443             foreach my $volid (@$unused) {
4444                 add_unused_volume($conf, $volid);
4445             }
4446         }
4447
4448         update_config_nolock($vmid, $conf, 1);
4449     };
4450
4451     lock_config($vmid, $updatefn);
4452
4453     # now remove vmstate file
4454
4455     my $storecfg = PVE::Storage::config();
4456
4457     if ($snap->{vmstate}) {
4458         eval {  PVE::Storage::vdisk_free($storecfg, $snap->{vmstate}); };
4459         if (my $err = $@) {
4460             die $err if !$force;
4461             warn $err;
4462         }
4463         # save changes (remove vmstate from snapshot)
4464         lock_config($vmid, $updatefn, 'vmstate') if !$force;
4465     };
4466
4467     # now remove all internal snapshots
4468     foreach_drive($snap, sub {
4469         my ($ds, $drive) = @_;
4470
4471         return if drive_is_cdrom($drive);
4472
4473         my $volid = $drive->{file};
4474         my $device = "drive-$ds";
4475
4476         if (!$drivehash || $drivehash->{$ds}) {
4477             eval { qemu_volume_snapshot_delete($vmid, $device, $storecfg, $volid, $snapname); };
4478             if (my $err = $@) {
4479                 die $err if !$force;
4480                 warn $err;
4481             }
4482         }
4483
4484         # save changes (remove drive fron snapshot)
4485         lock_config($vmid, $updatefn, $ds) if !$force;
4486         push @$unused, $volid;
4487     });
4488
4489     # now cleanup config
4490     $prepare = 0;
4491     lock_config($vmid, $updatefn);
4492 }
4493
4494 sub has_feature {
4495     my ($feature, $conf, $storecfg, $snapname, $running) = @_;
4496
4497     my $err;
4498     foreach_drive($conf, sub {
4499         my ($ds, $drive) = @_;
4500
4501         return if drive_is_cdrom($drive);
4502         my $volid = $drive->{file};
4503         $err = 1 if !PVE::Storage::volume_has_feature($storecfg, $feature, $volid, $snapname, $running);
4504     });
4505
4506     return $err ? 0 : 1;
4507 }
4508
4509 sub template_create {
4510     my ($vmid, $conf, $disk) = @_;
4511
4512     my $storecfg = PVE::Storage::config();
4513
4514     foreach_drive($conf, sub {
4515         my ($ds, $drive) = @_;
4516
4517         return if drive_is_cdrom($drive);
4518         return if $disk && $ds ne $disk;
4519
4520         my $volid = $drive->{file};
4521         return if !PVE::Storage::volume_has_feature($storecfg, 'template', $volid);
4522
4523         my $voliddst = PVE::Storage::vdisk_create_base($storecfg, $volid);
4524         $drive->{file} = $voliddst;
4525         $conf->{$ds} = PVE::QemuServer::print_drive($vmid, $drive);
4526         PVE::QemuServer::update_config_nolock($vmid, $conf, 1);
4527     });
4528 }
4529
4530 sub is_template {
4531     my ($conf) = @_;
4532
4533     return 1 if defined $conf->{template} && $conf->{template} == 1;
4534 }
4535
4536 sub qemu_img_convert {
4537     my ($src_volid, $dst_volid, $size, $snapname) = @_;
4538
4539     my $storecfg = PVE::Storage::config();
4540     my ($src_storeid, $src_volname) = PVE::Storage::parse_volume_id($src_volid, 1);
4541     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
4542
4543     if ($src_storeid && $dst_storeid) {
4544         my $src_scfg = PVE::Storage::storage_config($storecfg, $src_storeid);
4545         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
4546
4547         my $src_format = qemu_img_format($src_scfg, $src_volname);
4548         my $dst_format = qemu_img_format($dst_scfg, $dst_volname);
4549
4550         my $src_path = PVE::Storage::path($storecfg, $src_volid, $snapname);
4551         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
4552
4553         my $cmd = [];
4554         push @$cmd, '/usr/bin/qemu-img', 'convert', '-t', 'writeback', '-p', '-C';
4555         push @$cmd, '-s', $snapname if($snapname && $src_format eq "qcow2");
4556         push @$cmd, '-f', $src_format, '-O', $dst_format, $src_path, $dst_path;
4557
4558         my $parser = sub {
4559             my $line = shift;
4560             if($line =~ m/\((\S+)\/100\%\)/){
4561                 my $percent = $1;
4562                 my $transferred = int($size * $percent / 100);
4563                 my $remaining = $size - $transferred;
4564
4565                 print "transferred: $transferred bytes remaining: $remaining bytes total: $size bytes progression: $percent %\n";
4566             }
4567
4568         };
4569
4570         eval  { run_command($cmd, timeout => undef, outfunc => $parser); };
4571         my $err = $@;
4572         die "copy failed: $err" if $err;
4573     }
4574 }
4575
4576 sub qemu_img_format {
4577     my ($scfg, $volname) = @_;
4578
4579     if ($scfg->{path} && $volname =~ m/\.(raw|qcow2|qed|vmdk)$/) {
4580         return $1;
4581     } elsif ($scfg->{type} eq 'iscsi') {
4582         return "host_device";
4583     } else {
4584         return "raw";
4585     }
4586 }
4587
4588 sub qemu_drive_mirror {
4589     my ($vmid, $drive, $dst_volid, $vmiddst, $maxwait) = @_;
4590
4591     my $count = 1;
4592     my $old_len = 0;
4593     my $frozen = undef;
4594
4595     my $storecfg = PVE::Storage::config();
4596     my ($dst_storeid, $dst_volname) = PVE::Storage::parse_volume_id($dst_volid, 1);
4597
4598     if ($dst_storeid) {
4599         my $dst_scfg = PVE::Storage::storage_config($storecfg, $dst_storeid);
4600
4601         my $format = undef;
4602         if ($dst_volname =~ m/\.(raw|qcow2)$/){
4603             $format = $1;
4604         }
4605
4606         my $dst_path = PVE::Storage::path($storecfg, $dst_volid);
4607
4608         if($format){
4609             #fixme : sometime drive-mirror timeout, but works fine after. (I have see the problem with big volume > 200GB), so we need to eval
4610             eval{ PVE::QemuServer::vm_mon_cmd($vmid, "drive-mirror", timeout => 10, device => "drive-$drive", mode => "existing", sync => "full", target => $dst_path, format => $format); };
4611         }else{
4612             eval{ PVE::QemuServer::vm_mon_cmd($vmid, "drive-mirror", timeout => 10, device => "drive-$drive", mode => "existing", sync => "full", target => $dst_path); };
4613         }
4614         eval{
4615             while (1) {
4616                 my $stats = PVE::QemuServer::vm_mon_cmd($vmid, "query-block-jobs");
4617                 my $stat = @$stats[0];
4618                 die "mirroring job seem to have die. Maybe do you have bad sectors?" if !$stat;
4619                 die "error job is not mirroring" if $stat->{type} ne "mirror";
4620
4621                 my $transferred = $stat->{offset};
4622                 my $total = $stat->{len};
4623                 my $remaining = $total - $transferred;
4624                 my $percent = sprintf "%.2f", ($transferred * 100 / $total);
4625
4626                 print "transferred: $transferred bytes remaining: $remaining bytes total: $total bytes progression: $percent %\n";
4627
4628                 last if ($stat->{len} == $stat->{offset});
4629                 if ($old_len == $stat->{offset}) {
4630                     if ($maxwait && $count > $maxwait) {
4631                     # if writes to disk occurs the disk needs to be freezed
4632                     # to be able to complete the migration
4633                         vm_suspend($vmid,1);
4634                         $count = 0;
4635                         $frozen = 1;
4636                     }else {
4637                         $count++ unless $frozen;
4638                     }
4639                 }
4640                 elsif ($frozen) {
4641                         vm_resume($vmid,1);
4642                         $count = 0;
4643                 }
4644                 $old_len = $stat->{offset};
4645                 sleep 1;
4646             }
4647         };
4648         if (my $err = $@) {
4649             eval { PVE::QemuServer::vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive"); };
4650             die "mirroring error: $err";
4651         }
4652
4653         if($vmiddst != $vmid){
4654             #if we clone a disk for a new target vm, we don't switch the disk
4655             PVE::QemuServer::vm_mon_cmd($vmid, "block-job-cancel", device => "drive-$drive");
4656         }else{
4657             #if source and destination are on the same guest
4658             PVE::QemuServer::vm_mon_cmd($vmid, "block-job-complete", device => "drive-$drive");
4659         }
4660     }
4661 }
4662
4663 1;