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