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 Conroe Penryn Nehalem Westmere SandyBridge Haswell Opteron_G1 Opteron_G2 Opteron_G3 Opteron_G4 Opteron_G5 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+)?)[,\s]/) {
 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_nocheck($vmid, "cont"); };
2937             warn $@ if $@;
2938         }
2939
2940         if($migratedfrom) {
2941             my $capabilities = {};
2942             $capabilities->{capability} =  "xbzrle";
2943             $capabilities->{state} = JSON::true;
2944             eval { PVE::QemuServer::vm_mon_cmd_nocheck($vmid, "migrate-set-capabilities", capabilities => [$capabilities]); };
2945         }
2946
2947         vm_mon_cmd_nocheck($vmid, "balloon", value => $conf->{balloon}*1024*1024)
2948             if $conf->{balloon};
2949     });
2950 }
2951
2952 sub vm_mon_cmd {
2953     my ($vmid, $execute, %params) = @_;
2954
2955     my $cmd = { execute => $execute, arguments => \%params };
2956     vm_qmp_command($vmid, $cmd);
2957 }
2958
2959 sub vm_mon_cmd_nocheck {
2960     my ($vmid, $execute, %params) = @_;
2961
2962     my $cmd = { execute => $execute, arguments => \%params };
2963     vm_qmp_command($vmid, $cmd, 1);
2964 }
2965
2966 sub vm_qmp_command {
2967     my ($vmid, $cmd, $nocheck) = @_;
2968
2969     my $res;
2970
2971     my $timeout;
2972     if ($cmd->{arguments} && $cmd->{arguments}->{timeout}) {
2973         $timeout = $cmd->{arguments}->{timeout};
2974         delete $cmd->{arguments}->{timeout};
2975     }
2976
2977     eval {
2978         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
2979         my $sname = PVE::QemuServer::qmp_socket($vmid);
2980         if (-e $sname) {
2981             my $qmpclient = PVE::QMPClient->new();
2982
2983             $res = $qmpclient->cmd($vmid, $cmd, $timeout);
2984         } elsif (-e "${var_run_tmpdir}/$vmid.mon") {
2985             die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
2986                 if scalar(%{$cmd->{arguments}});
2987             vm_monitor_command($vmid, $cmd->{execute}, $nocheck);
2988         } else {
2989             die "unable to open monitor socket\n";
2990         }
2991     };
2992     if (my $err = $@) {
2993         syslog("err", "VM $vmid qmp command failed - $err");
2994         die $err;
2995     }
2996
2997     return $res;
2998 }
2999
3000 sub vm_human_monitor_command {
3001     my ($vmid, $cmdline) = @_;
3002
3003     my $res;
3004
3005     my $cmd = {
3006         execute => 'human-monitor-command',
3007         arguments => { 'command-line' => $cmdline},
3008     };
3009
3010     return vm_qmp_command($vmid, $cmd);
3011 }
3012
3013 sub vm_commandline {
3014     my ($storecfg, $vmid) = @_;
3015
3016     my $conf = load_config($vmid);
3017
3018     my $defaults = load_defaults();
3019
3020     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
3021
3022     return join(' ', @$cmd);
3023 }
3024
3025 sub vm_reset {
3026     my ($vmid, $skiplock) = @_;
3027
3028     lock_config($vmid, sub {
3029
3030         my $conf = load_config($vmid);
3031
3032         check_lock($conf) if !$skiplock;
3033
3034         vm_mon_cmd($vmid, "system_reset");
3035     });
3036 }
3037
3038 sub get_vm_volumes {
3039     my ($conf) = @_;
3040
3041     my $vollist = [];
3042     foreach_volid($conf, sub {
3043         my ($volid, $is_cdrom) = @_;
3044
3045         return if $volid =~ m|^/|;
3046
3047         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
3048         return if !$sid;
3049
3050         push @$vollist, $volid;
3051     });
3052
3053     return $vollist;
3054 }
3055
3056 sub vm_stop_cleanup {
3057     my ($storecfg, $vmid, $conf, $keepActive) = @_;
3058
3059     eval {
3060         fairsched_rmnod($vmid); # try to destroy group
3061
3062         if (!$keepActive) {
3063             my $vollist = get_vm_volumes($conf);
3064             PVE::Storage::deactivate_volumes($storecfg, $vollist);
3065         }
3066
3067         foreach my $ext (qw(mon qmp pid vnc qga)) {
3068             unlink "/var/run/qemu-server/${vmid}.$ext";
3069         }
3070     };
3071     warn $@ if $@; # avoid errors - just warn
3072 }
3073
3074 # Note: use $nockeck to skip tests if VM configuration file exists.
3075 # We need that when migration VMs to other nodes (files already moved)
3076 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3077 sub vm_stop {
3078     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3079
3080     $force = 1 if !defined($force) && !$shutdown;
3081
3082     if ($migratedfrom){
3083         my $pid = check_running($vmid, $nocheck, $migratedfrom);
3084         kill 15, $pid if $pid;
3085         my $conf = load_config($vmid, $migratedfrom);
3086         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive);
3087         return;
3088     }
3089
3090     lock_config($vmid, sub {
3091
3092         my $pid = check_running($vmid, $nocheck);
3093         return if !$pid;
3094
3095         my $conf;
3096         if (!$nocheck) {
3097             $conf = load_config($vmid);
3098             check_lock($conf) if !$skiplock;
3099             if (!defined($timeout) && $shutdown && $conf->{startup}) {
3100                 my $opts = parse_startup($conf->{startup});
3101                 $timeout = $opts->{down} if $opts->{down};
3102             }
3103         }
3104
3105         $timeout = 60 if !defined($timeout);
3106
3107         eval {
3108             if ($shutdown) {
3109                 $nocheck ? vm_mon_cmd_nocheck($vmid, "system_powerdown") : vm_mon_cmd($vmid, "system_powerdown");
3110
3111             } else {
3112                 $nocheck ? vm_mon_cmd_nocheck($vmid, "quit") : vm_mon_cmd($vmid, "quit");
3113             }
3114         };
3115         my $err = $@;
3116
3117         if (!$err) {
3118             my $count = 0;
3119             while (($count < $timeout) && check_running($vmid, $nocheck)) {
3120                 $count++;
3121                 sleep 1;
3122             }
3123
3124             if ($count >= $timeout) {
3125                 if ($force) {
3126                     warn "VM still running - terminating now with SIGTERM\n";
3127                     kill 15, $pid;
3128                 } else {
3129                     die "VM quit/powerdown failed - got timeout\n";
3130                 }
3131             } else {
3132                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3133                 return;
3134             }
3135         } else {
3136             if ($force) {
3137                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3138                 kill 15, $pid;
3139             } else {
3140                 die "VM quit/powerdown failed\n";
3141             }
3142         }
3143
3144         # wait again
3145         $timeout = 10;
3146
3147         my $count = 0;
3148         while (($count < $timeout) && check_running($vmid, $nocheck)) {
3149             $count++;
3150             sleep 1;
3151         }
3152
3153         if ($count >= $timeout) {
3154             warn "VM still running - terminating now with SIGKILL\n";
3155             kill 9, $pid;
3156             sleep 1;
3157         }
3158
3159         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3160    });
3161 }
3162
3163 sub vm_suspend {
3164     my ($vmid, $skiplock) = @_;
3165
3166     lock_config($vmid, sub {
3167
3168         my $conf = load_config($vmid);
3169
3170         check_lock($conf) if !$skiplock;
3171
3172         vm_mon_cmd($vmid, "stop");
3173     });
3174 }
3175
3176 sub vm_resume {
3177     my ($vmid, $skiplock) = @_;
3178
3179     lock_config($vmid, sub {
3180
3181         my $conf = load_config($vmid);
3182
3183         check_lock($conf) if !$skiplock;
3184
3185         vm_mon_cmd($vmid, "cont");
3186     });
3187 }
3188
3189 sub vm_sendkey {
3190     my ($vmid, $skiplock, $key) = @_;
3191
3192     lock_config($vmid, sub {
3193
3194         my $conf = load_config($vmid);
3195
3196         # there is no qmp command, so we use the human monitor command
3197         vm_human_monitor_command($vmid, "sendkey $key");
3198     });
3199 }
3200
3201 sub vm_destroy {
3202     my ($storecfg, $vmid, $skiplock) = @_;
3203
3204     lock_config($vmid, sub {
3205
3206         my $conf = load_config($vmid);
3207
3208         check_lock($conf) if !$skiplock;
3209
3210         if (!check_running($vmid)) {
3211             fairsched_rmnod($vmid); # try to destroy group
3212             destroy_vm($storecfg, $vmid);
3213         } else {
3214             die "VM $vmid is running - destroy failed\n";
3215         }
3216     });
3217 }
3218
3219 # pci helpers
3220
3221 sub file_write {
3222     my ($filename, $buf) = @_;
3223
3224     my $fh = IO::File->new($filename, "w");
3225     return undef if !$fh;
3226
3227     my $res = print $fh $buf;
3228
3229     $fh->close();
3230
3231     return $res;
3232 }
3233
3234 sub pci_device_info {
3235     my ($name) = @_;
3236
3237     my $res;
3238
3239     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3240     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3241
3242     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
3243     return undef if !defined($irq) || $irq !~ m/^\d+$/;
3244
3245     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
3246     return undef if !defined($vendor) || $vendor !~ s/^0x//;
3247
3248     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
3249     return undef if !defined($product) || $product !~ s/^0x//;
3250
3251     $res = {
3252         name => $name,
3253         vendor => $vendor,
3254         product => $product,
3255         domain => $domain,
3256         bus => $bus,
3257         slot => $slot,
3258         func => $func,
3259         irq => $irq,
3260         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
3261     };
3262
3263     return $res;
3264 }
3265
3266 sub pci_dev_reset {
3267     my ($dev) = @_;
3268
3269     my $name = $dev->{name};
3270
3271     my $fn = "$pcisysfs/devices/$name/reset";
3272
3273     return file_write($fn, "1");
3274 }
3275
3276 sub pci_dev_bind_to_stub {
3277     my ($dev) = @_;
3278
3279     my $name = $dev->{name};
3280
3281     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3282     return 1 if -d $testdir;
3283
3284     my $data = "$dev->{vendor} $dev->{product}";
3285     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
3286
3287     my $fn = "$pcisysfs/devices/$name/driver/unbind";
3288     if (!file_write($fn, $name)) {
3289         return undef if -f $fn;
3290     }
3291
3292     $fn = "$pcisysfs/drivers/pci-stub/bind";
3293     if (! -d $testdir) {
3294         return undef if !file_write($fn, $name);
3295     }
3296
3297     return -d $testdir;
3298 }
3299
3300 sub print_pci_addr {
3301     my ($id, $bridges) = @_;
3302
3303     my $res = '';
3304     my $devices = {
3305         #addr1 : ide,parallel,serial (motherboard)
3306         #addr2 : first videocard
3307         balloon0 => { bus => 0, addr => 3 },
3308         watchdog => { bus => 0, addr => 4 },
3309         scsihw0 => { bus => 0, addr => 5 },
3310         scsihw1 => { bus => 0, addr => 6 },
3311         ahci0 => { bus => 0, addr => 7 },
3312         qga0 => { bus => 0, addr => 8 },
3313         virtio0 => { bus => 0, addr => 10 },
3314         virtio1 => { bus => 0, addr => 11 },
3315         virtio2 => { bus => 0, addr => 12 },
3316         virtio3 => { bus => 0, addr => 13 },
3317         virtio4 => { bus => 0, addr => 14 },
3318         virtio5 => { bus => 0, addr => 15 },
3319         hostpci0 => { bus => 0, addr => 16 },
3320         hostpci1 => { bus => 0, addr => 17 },
3321         net0 => { bus => 0, addr => 18 },
3322         net1 => { bus => 0, addr => 19 },
3323         net2 => { bus => 0, addr => 20 },
3324         net3 => { bus => 0, addr => 21 },
3325         net4 => { bus => 0, addr => 22 },
3326         net5 => { bus => 0, addr => 23 },
3327         #addr29 : usb-host (pve-usb.cfg)
3328         'pci.1' => { bus => 0, addr => 30 },
3329         'pci.2' => { bus => 0, addr => 31 },
3330         'net6' => { bus => 1, addr => 1 },
3331         'net7' => { bus => 1, addr => 2 },
3332         'net8' => { bus => 1, addr => 3 },
3333         'net9' => { bus => 1, addr => 4 },
3334         'net10' => { bus => 1, addr => 5 },
3335         'net11' => { bus => 1, addr => 6 },
3336         'net12' => { bus => 1, addr => 7 },
3337         'net13' => { bus => 1, addr => 8 },
3338         'net14' => { bus => 1, addr => 9 },
3339         'net15' => { bus => 1, addr => 10 },
3340         'net16' => { bus => 1, addr => 11 },
3341         'net17' => { bus => 1, addr => 12 },
3342         'net18' => { bus => 1, addr => 13 },
3343         'net19' => { bus => 1, addr => 14 },
3344         'net20' => { bus => 1, addr => 15 },
3345         'net21' => { bus => 1, addr => 16 },
3346         'net22' => { bus => 1, addr => 17 },
3347         'net23' => { bus => 1, addr => 18 },
3348         'net24' => { bus => 1, addr => 19 },
3349         'net25' => { bus => 1, addr => 20 },
3350         'net26' => { bus => 1, addr => 21 },
3351         'net27' => { bus => 1, addr => 22 },
3352         'net28' => { bus => 1, addr => 23 },
3353         'net29' => { bus => 1, addr => 24 },
3354         'net30' => { bus => 1, addr => 25 },
3355         'net31' => { bus => 1, addr => 26 },
3356         'virtio6' => { bus => 2, addr => 1 },
3357         'virtio7' => { bus => 2, addr => 2 },
3358         'virtio8' => { bus => 2, addr => 3 },
3359         'virtio9' => { bus => 2, addr => 4 },
3360         'virtio10' => { bus => 2, addr => 5 },
3361         'virtio11' => { bus => 2, addr => 6 },
3362         'virtio12' => { bus => 2, addr => 7 },
3363         'virtio13' => { bus => 2, addr => 8 },
3364         'virtio14' => { bus => 2, addr => 9 },
3365         'virtio15' => { bus => 2, addr => 10 },
3366     };
3367
3368     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
3369            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
3370            my $bus = $devices->{$id}->{bus};
3371            $res = ",bus=pci.$bus,addr=$addr";
3372            $bridges->{$bus} = 1 if $bridges;
3373     }
3374     return $res;
3375
3376 }
3377
3378 sub vm_balloonset {
3379     my ($vmid, $value) = @_;
3380
3381     vm_mon_cmd($vmid, "balloon", value => $value*1024*1024);
3382 }
3383
3384 # vzdump restore implementaion
3385
3386 sub archive_read_firstfile {
3387     my $archive = shift;
3388
3389     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
3390
3391     # try to detect archive type first
3392     my $pid = open (TMP, "tar tf '$archive'|") ||
3393         die "unable to open file '$archive'\n";
3394     my $firstfile = <TMP>;
3395     kill 15, $pid;
3396     close TMP;
3397
3398     die "ERROR: archive contaions no data\n" if !$firstfile;
3399     chomp $firstfile;
3400
3401     return $firstfile;
3402 }
3403
3404 sub restore_cleanup {
3405     my $statfile = shift;
3406
3407     print STDERR "starting cleanup\n";
3408
3409     if (my $fd = IO::File->new($statfile, "r")) {
3410         while (defined(my $line = <$fd>)) {
3411             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3412                 my $volid = $2;
3413                 eval {
3414                     if ($volid =~ m|^/|) {
3415                         unlink $volid || die 'unlink failed\n';
3416                     } else {
3417                         my $cfg = cfs_read_file('storage.cfg');
3418                         PVE::Storage::vdisk_free($cfg, $volid);
3419                     }
3420                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
3421                 };
3422                 print STDERR "unable to cleanup '$volid' - $@" if $@;
3423             } else {
3424                 print STDERR "unable to parse line in statfile - $line";
3425             }
3426         }
3427         $fd->close();
3428     }
3429 }
3430
3431 sub restore_archive {
3432     my ($archive, $vmid, $user, $opts) = @_;
3433
3434     if ($archive ne '-') {
3435         my $firstfile = archive_read_firstfile($archive);
3436         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
3437             if $firstfile ne 'qemu-server.conf';
3438     }
3439
3440     my $tocmd = "/usr/lib/qemu-server/qmextract";
3441
3442     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
3443     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
3444     $tocmd .= ' --prealloc' if $opts->{prealloc};
3445     $tocmd .= ' --info' if $opts->{info};
3446
3447     # tar option "xf" does not autodetect compression when read from STDIN,
3448     # so we pipe to zcat
3449     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
3450         PVE::Tools::shellquote("--to-command=$tocmd");
3451
3452     my $tmpdir = "/var/tmp/vzdumptmp$$";
3453     mkpath $tmpdir;
3454
3455     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
3456     local $ENV{VZDUMP_VMID} = $vmid;
3457     local $ENV{VZDUMP_USER} = $user;
3458
3459     my $conffile = PVE::QemuServer::config_file($vmid);
3460     my $tmpfn = "$conffile.$$.tmp";
3461
3462     # disable interrupts (always do cleanups)
3463     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
3464         print STDERR "got interrupt - ignored\n";
3465     };
3466
3467     eval {
3468         # enable interrupts
3469         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
3470             die "interrupted by signal\n";
3471         };
3472
3473         if ($archive eq '-') {
3474             print "extracting archive from STDIN\n";
3475             run_command($cmd, input => "<&STDIN");
3476         } else {
3477             print "extracting archive '$archive'\n";
3478             run_command($cmd);
3479         }
3480
3481         return if $opts->{info};
3482
3483         # read new mapping
3484         my $map = {};
3485         my $statfile = "$tmpdir/qmrestore.stat";
3486         if (my $fd = IO::File->new($statfile, "r")) {
3487             while (defined (my $line = <$fd>)) {
3488                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3489                     $map->{$1} = $2 if $1;
3490                 } else {
3491                     print STDERR "unable to parse line in statfile - $line\n";
3492                 }
3493             }
3494             $fd->close();
3495         }
3496
3497         my $confsrc = "$tmpdir/qemu-server.conf";
3498
3499         my $srcfd = new IO::File($confsrc, "r") ||
3500             die "unable to open file '$confsrc'\n";
3501
3502         my $outfd = new IO::File ($tmpfn, "w") ||
3503             die "unable to write config for VM $vmid\n";
3504
3505         my $netcount = 0;
3506
3507         while (defined (my $line = <$srcfd>)) {
3508             next if $line =~ m/^\#vzdump\#/;
3509             next if $line =~ m/^lock:/;
3510             next if $line =~ m/^unused\d+:/;
3511
3512             if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3513                 # try to convert old 1.X settings
3514                 my ($id, $ind, $ethcfg) = ($1, $2, $3);
3515                 foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
3516                     my ($model, $macaddr) = split(/\=/, $devconfig);
3517                     $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $opts->{unique};
3518                     my $net = {
3519                         model => $model,
3520                         bridge => "vmbr$ind",
3521                         macaddr => $macaddr,
3522                     };
3523                     my $netstr = print_net($net);
3524                     print $outfd "net${netcount}: $netstr\n";
3525                     $netcount++;
3526                 }
3527             } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && ($opts->{unique})) {
3528                 my ($id, $netstr) = ($1, $2);
3529                 my $net = parse_net($netstr);
3530                 $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
3531                 $netstr = print_net($net);
3532                 print $outfd "$id: $netstr\n";
3533             } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
3534                 my $virtdev = $1;
3535                 my $value = $2;
3536                 if ($line =~ m/backup=no/) {
3537                     print $outfd "#$line";
3538                 } elsif ($virtdev && $map->{$virtdev}) {
3539                     my $di = PVE::QemuServer::parse_drive($virtdev, $value);
3540                     $di->{file} = $map->{$virtdev};
3541                     $value = PVE::QemuServer::print_drive($vmid, $di);
3542                     print $outfd "$virtdev: $value\n";
3543                 } else {
3544                     print $outfd $line;
3545                 }
3546             } else {
3547                 print $outfd $line;
3548             }
3549         }
3550
3551         $srcfd->close();
3552         $outfd->close();
3553     };
3554     my $err = $@;
3555
3556     if ($err) {
3557
3558         unlink $tmpfn;
3559
3560         restore_cleanup("$tmpdir/qmrestore.stat") if !$opts->{info};
3561
3562         die $err;
3563     }
3564
3565     rmtree $tmpdir;
3566
3567     rename $tmpfn, $conffile ||
3568         die "unable to commit configuration file '$conffile'\n";
3569 };
3570
3571
3572 # Internal snapshots
3573
3574 # NOTE: Snapshot create/delete involves several non-atomic
3575 # action, and can take a long time.
3576 # So we try to avoid locking the file and use 'lock' variable
3577 # inside the config file instead.
3578
3579 my $snapshot_copy_config = sub {
3580     my ($source, $dest) = @_;
3581
3582     foreach my $k (keys %$source) {
3583         next if $k eq 'snapshots';
3584         next if $k eq 'snapstate';
3585         next if $k eq 'snaptime';
3586         next if $k eq 'vmstate';
3587         next if $k eq 'lock';
3588         next if $k eq 'digest';
3589         next if $k eq 'description';
3590         next if $k =~ m/^unused\d+$/;
3591
3592         $dest->{$k} = $source->{$k};
3593     }
3594 };
3595
3596 my $snapshot_apply_config = sub {
3597     my ($conf, $snap) = @_;
3598
3599     # copy snapshot list
3600     my $newconf = {
3601         snapshots => $conf->{snapshots},
3602     };
3603
3604     # keep description and list of unused disks
3605     foreach my $k (keys %$conf) {
3606         next if !($k =~ m/^unused\d+$/ || $k eq 'description');
3607         $newconf->{$k} = $conf->{$k};
3608     }
3609
3610     &$snapshot_copy_config($snap, $newconf);
3611
3612     return $newconf;
3613 };
3614
3615 sub foreach_writable_storage {
3616     my ($conf, $func) = @_;
3617
3618     my $sidhash = {};
3619
3620     foreach my $ds (keys %$conf) {
3621         next if !valid_drivename($ds);
3622
3623         my $drive = parse_drive($ds, $conf->{$ds});
3624         next if !$drive;
3625         next if drive_is_cdrom($drive);
3626
3627         my $volid = $drive->{file};
3628
3629         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
3630         $sidhash->{$sid} = $sid if $sid;
3631     }
3632
3633     foreach my $sid (sort keys %$sidhash) {
3634         &$func($sid);
3635     }
3636 }
3637
3638 my $alloc_vmstate_volid = sub {
3639     my ($storecfg, $vmid, $conf, $snapname) = @_;
3640
3641     # Note: we try to be smart when selecting a $target storage
3642
3643     my $target;
3644
3645     # search shared storage first
3646     foreach_writable_storage($conf, sub {
3647         my ($sid) = @_;
3648         my $scfg = PVE::Storage::storage_config($storecfg, $sid);
3649         return if !$scfg->{shared};
3650
3651         $target = $sid if !$target || $scfg->{path}; # prefer file based storage
3652     });
3653
3654     if (!$target) {
3655         # now search local storage
3656         foreach_writable_storage($conf, sub {
3657             my ($sid) = @_;
3658             my $scfg = PVE::Storage::storage_config($storecfg, $sid);
3659             return if $scfg->{shared};
3660
3661             $target = $sid if !$target || $scfg->{path}; # prefer file based storage;
3662         });
3663     }
3664
3665     $target = 'local' if !$target;
3666
3667     my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
3668     # we abort live save after $conf->{memory}, so we need at max twice that space
3669     my $size = $conf->{memory}*2 + $driver_state_size;
3670
3671     my $name = "vm-$vmid-state-$snapname";
3672     my $scfg = PVE::Storage::storage_config($storecfg, $target);
3673     $name .= ".raw" if $scfg->{path}; # add filename extension for file base storage
3674     my $volid = PVE::Storage::vdisk_alloc($storecfg, $target, $vmid, 'raw', $name, $size*1024);
3675
3676     return $volid;
3677 };
3678
3679 my $snapshot_prepare = sub {
3680     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
3681
3682     my $snap;
3683
3684     my $updatefn =  sub {
3685
3686         my $conf = load_config($vmid);
3687
3688         check_lock($conf);
3689
3690         $conf->{lock} = 'snapshot';
3691
3692         die "snapshot name '$snapname' already used\n"
3693             if defined($conf->{snapshots}->{$snapname});
3694
3695         my $storecfg = PVE::Storage::config();
3696
3697         foreach_drive($conf, sub {
3698             my ($ds, $drive) = @_;
3699
3700             return if drive_is_cdrom($drive);
3701             my $volid = $drive->{file};
3702
3703             my ($storeid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
3704             if ($storeid) {
3705                 my $scfg = PVE::Storage::storage_config($storecfg, $storeid);
3706                 die "can't snapshot volume '$volid'\n"
3707                     if !(($scfg->{path} && $volname =~ m/\.qcow2$/) ||
3708                          ($scfg->{type} eq 'nexenta') ||
3709                          ($scfg->{type} eq 'rbd') ||
3710                          ($scfg->{type} eq 'sheepdog'));
3711             } elsif ($volid =~ m|^(/.+)$| && -e $volid) {
3712                 die "snapshot device '$volid' is not possible\n";
3713             } else {
3714                 die "can't snapshot volume '$volid'\n";
3715             }
3716         });
3717
3718
3719         $snap = $conf->{snapshots}->{$snapname} = {};
3720
3721         if ($save_vmstate && check_running($vmid)) {
3722             $snap->{vmstate} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
3723         }
3724
3725         &$snapshot_copy_config($conf, $snap);
3726
3727         $snap->{snapstate} = "prepare";
3728         $snap->{snaptime} = time();
3729         $snap->{description} = $comment if $comment;
3730
3731         update_config_nolock($vmid, $conf, 1);
3732     };
3733
3734     lock_config($vmid, $updatefn);
3735
3736     return $snap;
3737 };
3738
3739 my $snapshot_commit = sub {
3740     my ($vmid, $snapname) = @_;
3741
3742     my $updatefn = sub {
3743
3744         my $conf = load_config($vmid);
3745
3746         die "missing snapshot lock\n"
3747             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
3748
3749         my $snap = $conf->{snapshots}->{$snapname};
3750
3751         die "snapshot '$snapname' does not exist\n" if !defined($snap);
3752
3753         die "wrong snapshot state\n"
3754             if !($snap->{snapstate} && $snap->{snapstate} eq "prepare");
3755
3756         delete $snap->{snapstate};
3757         delete $conf->{lock};
3758
3759         my $newconf = &$snapshot_apply_config($conf, $snap);
3760
3761         $newconf->{parent} = $snapname;
3762
3763         update_config_nolock($vmid, $newconf, 1);
3764     };
3765
3766     lock_config($vmid, $updatefn);
3767 };
3768
3769 sub snapshot_rollback {
3770     my ($vmid, $snapname) = @_;
3771
3772     my $snap;
3773
3774     my $prepare = 1;
3775
3776     my $storecfg = PVE::Storage::config();
3777
3778     my $updatefn = sub {
3779
3780         my $conf = load_config($vmid);
3781
3782         $snap = $conf->{snapshots}->{$snapname};
3783
3784         die "snapshot '$snapname' does not exist\n" if !defined($snap);
3785
3786         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
3787             if $snap->{snapstate};
3788
3789         if ($prepare) {
3790             check_lock($conf);
3791             vm_stop($storecfg, $vmid, undef, undef, 5, undef, undef);
3792         }
3793
3794         die "unable to rollback vm $vmid: vm is running\n"
3795             if check_running($vmid);
3796
3797         if ($prepare) {
3798             $conf->{lock} = 'rollback';
3799         } else {
3800             die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
3801             delete $conf->{lock};
3802         }
3803
3804         if (!$prepare) {
3805             # copy snapshot config to current config
3806             $conf = &$snapshot_apply_config($conf, $snap);
3807             $conf->{parent} = $snapname;
3808         }
3809
3810         update_config_nolock($vmid, $conf, 1);
3811
3812         if (!$prepare && $snap->{vmstate}) {
3813             my $statefile = PVE::Storage::path($storecfg, $snap->{vmstate});
3814             # fixme: this only forws for files currently
3815             vm_start($storecfg, $vmid, $statefile);
3816         }
3817
3818     };
3819
3820     lock_config($vmid, $updatefn);
3821
3822     foreach_drive($snap, sub {
3823         my ($ds, $drive) = @_;
3824
3825         return if drive_is_cdrom($drive);
3826
3827         my $volid = $drive->{file};
3828         my $device = "drive-$ds";
3829
3830         PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
3831     });
3832
3833     $prepare = 0;
3834     lock_config($vmid, $updatefn);
3835 }
3836
3837 my $savevm_wait = sub {
3838     my ($vmid) = @_;
3839
3840     for(;;) {
3841         my $stat = PVE::QemuServer::vm_mon_cmd_nocheck($vmid, "query-savevm");
3842         if (!$stat->{status}) {
3843             die "savevm not active\n";
3844         } elsif ($stat->{status} eq 'active') {
3845             sleep(1);
3846             next;
3847         } elsif ($stat->{status} eq 'completed') {
3848             last;
3849         } else {
3850             die "query-savevm returned status '$stat->{status}'\n";
3851         }
3852     }
3853 };
3854
3855 sub snapshot_create {
3856     my ($vmid, $snapname, $save_vmstate, $freezefs, $comment) = @_;
3857
3858     my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
3859
3860     $freezefs = $save_vmstate = 0 if !$snap->{vmstate}; # vm is not running
3861
3862     my $drivehash = {};
3863
3864     my $running = check_running($vmid);
3865
3866     eval {
3867         # create internal snapshots of all drives
3868
3869         my $storecfg = PVE::Storage::config();
3870
3871         if ($running) {
3872             if ($snap->{vmstate}) {
3873                 my $path = PVE::Storage::path($storecfg, $snap->{vmstate});
3874                 vm_mon_cmd($vmid, "savevm-start", statefile => $path);
3875                 &$savevm_wait($vmid);
3876             } else {
3877                 vm_mon_cmd($vmid, "savevm-start");
3878             }
3879         };
3880
3881         qga_freezefs($vmid) if $running && $freezefs;
3882
3883         foreach_drive($snap, sub {
3884             my ($ds, $drive) = @_;
3885
3886             return if drive_is_cdrom($drive);
3887
3888             my $volid = $drive->{file};
3889             my $device = "drive-$ds";
3890
3891             qemu_volume_snapshot($vmid, $device, $storecfg, $volid, $snapname);
3892             $drivehash->{$ds} = 1;
3893        });
3894     };
3895     my $err = $@;
3896
3897     eval { gqa_unfreezefs($vmid) if $running && $freezefs; };
3898     warn $@ if $@;
3899
3900     eval { vm_mon_cmd($vmid, "savevm-end") if $running; };
3901     warn $@ if $@;
3902
3903     if ($err) {
3904         warn "snapshot create failed: starting cleanup\n";
3905         eval { snapshot_delete($vmid, $snapname, 0, $drivehash); };
3906         warn $@ if $@;
3907         die $err;
3908     }
3909
3910     &$snapshot_commit($vmid, $snapname);
3911 }
3912
3913 # Note: $drivehash is only set when called from snapshot_create.
3914 sub snapshot_delete {
3915     my ($vmid, $snapname, $force, $drivehash) = @_;
3916
3917     my $prepare = 1;
3918
3919     my $snap;
3920     my $unused = [];
3921
3922     my $unlink_parent = sub {
3923         my ($confref, $new_parent) = @_;
3924
3925         if ($confref->{parent} && $confref->{parent} eq $snapname) {
3926             if ($new_parent) {
3927                 $confref->{parent} = $new_parent;
3928             } else {
3929                 delete $confref->{parent};
3930             }
3931         }
3932     };
3933
3934     my $updatefn =  sub {
3935         my ($remove_drive) = @_;
3936
3937         my $conf = load_config($vmid);
3938
3939         check_lock($conf) if !$drivehash;
3940
3941         $snap = $conf->{snapshots}->{$snapname};
3942
3943         die "snapshot '$snapname' does not exist\n" if !defined($snap);
3944
3945         # remove parent refs
3946         &$unlink_parent($conf, $snap->{parent});
3947         foreach my $sn (keys %{$conf->{snapshots}}) {
3948             next if $sn eq $snapname;
3949             &$unlink_parent($conf->{snapshots}->{$sn}, $snap->{parent});
3950         }
3951
3952         if ($remove_drive) {
3953             if ($remove_drive eq 'vmstate') {
3954                 delete $snap->{$remove_drive};
3955             } else {
3956                 my $drive = parse_drive($remove_drive, $snap->{$remove_drive});
3957                 my $volid = $drive->{file};
3958                 delete $snap->{$remove_drive};
3959                 add_unused_volume($conf, $volid);
3960             }
3961         }
3962
3963         if ($prepare) {
3964             $snap->{snapstate} = 'delete';
3965         } else {
3966             delete $conf->{snapshots}->{$snapname};
3967             delete $conf->{lock} if $drivehash;
3968             foreach my $volid (@$unused) {
3969                 add_unused_volume($conf, $volid);
3970             }
3971         }
3972
3973         update_config_nolock($vmid, $conf, 1);
3974     };
3975
3976     lock_config($vmid, $updatefn);
3977
3978     # now remove vmstate file
3979
3980     my $storecfg = PVE::Storage::config();
3981
3982     if ($snap->{vmstate}) {
3983         eval {  PVE::Storage::vdisk_free($storecfg, $snap->{vmstate}); };
3984         if (my $err = $@) {
3985             die $err if !$force;
3986             warn $err;
3987         }
3988         # save changes (remove vmstate from snapshot)
3989         lock_config($vmid, $updatefn, 'vmstate') if !$force;
3990     };
3991
3992     # now remove all internal snapshots
3993     foreach_drive($snap, sub {
3994         my ($ds, $drive) = @_;
3995
3996         return if drive_is_cdrom($drive);
3997
3998         my $volid = $drive->{file};
3999         my $device = "drive-$ds";
4000
4001         if (!$drivehash || $drivehash->{$ds}) {
4002             eval { qemu_volume_snapshot_delete($vmid, $device, $storecfg, $volid, $snapname); };
4003             if (my $err = $@) {
4004                 die $err if !$force;
4005                 warn $err;
4006             }
4007         }
4008
4009         # save changes (remove drive fron snapshot)
4010         lock_config($vmid, $updatefn, $ds) if !$force;
4011         push @$unused, $volid;
4012     });
4013
4014     # now cleanup config
4015     $prepare = 0;
4016     lock_config($vmid, $updatefn);
4017 }
4018
4019 1;