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