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