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