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