PVE/QemuServer.pm

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