PVE/QemuServer.pm

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