PVE/QemuServer.pm

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