PVE/QemuServer.pm

   1 package PVE::QemuServer;
   2
   3 use strict;
   4 use POSIX;
   5 use IO::Handle;
   6 use IO::Select;
   7 use IO::File;
   8 use IO::Dir;
   9 use IO::Socket::UNIX;
  10 use File::Basename;
  11 use File::Path;
  12 use File::stat;
  13 use Getopt::Long;
  14 use Digest::SHA;
  15 use Fcntl ':flock';
  16 use Cwd 'abs_path';
  17 use IPC::Open3;
  18 use JSON;
  19 use Fcntl;
  20 use PVE::SafeSyslog;
  21 use Storable qw(dclone);
  22 use PVE::Exception qw(raise raise_param_exc);
  23 use PVE::Storage;
  24 use PVE::Tools qw(run_command lock_file file_read_firstline);
  25 use PVE::JSONSchema qw(get_standard_option);
  26 use PVE::Cluster qw(cfs_register_file cfs_read_file cfs_write_file cfs_lock_file);
  27 use PVE::INotify;
  28 use PVE::ProcFSTools;
  29 use PVE::QMPClient;
  30 use PVE::RPCEnvironment;
  31 use Time::HiRes qw(gettimeofday);
  32
  33 my $cpuinfo = PVE::ProcFSTools::read_cpuinfo();
  34
  35 # Note about locking: we use flock on the config file protect
  36 # against concurent actions.
  37 # Aditionaly, we have a 'lock' setting in the config file. This
  38 # can be set to 'migrate', 'backup', 'snapshot' or 'rollback'. Most actions are not
  39 # allowed when such lock is set. But you can ignore this kind of
  40 # lock with the --skiplock flag.
  41
  42 cfs_register_file('/qemu-server/',
  43                   \&parse_vm_config,
  44                   \&write_vm_config);
  45
  46 PVE::JSONSchema::register_standard_option('skiplock', {
  47     description => "Ignore locks - only root is allowed to use this option.",
  48     type => 'boolean',
  49     optional => 1,
  50 });
  51
  52 PVE::JSONSchema::register_standard_option('pve-qm-stateuri', {
  53     description => "Some command save/restore state from this location.",
  54     type => 'string',
  55     maxLength => 128,
  56     optional => 1,
  57 });
  58
  59 PVE::JSONSchema::register_standard_option('pve-snapshot-name', {
  60     description => "The name of the snapshot.",
  61     type => 'string', format => 'pve-configid',
  62     maxLength => 40,
  63 });
  64
  65 #no warnings 'redefine';
  66
  67 unless(defined(&_VZSYSCALLS_H_)) {
  68     eval 'sub _VZSYSCALLS_H_ () {1;}' unless defined(&_VZSYSCALLS_H_);
  69     require 'sys/syscall.ph';
  70     if(defined(&__x86_64__)) {
  71         eval 'sub __NR_fairsched_vcpus () {499;}' unless defined(&__NR_fairsched_vcpus);
  72         eval 'sub __NR_fairsched_mknod () {504;}' unless defined(&__NR_fairsched_mknod);
  73         eval 'sub __NR_fairsched_rmnod () {505;}' unless defined(&__NR_fairsched_rmnod);
  74         eval 'sub __NR_fairsched_chwt () {506;}' unless defined(&__NR_fairsched_chwt);
  75         eval 'sub __NR_fairsched_mvpr () {507;}' unless defined(&__NR_fairsched_mvpr);
  76         eval 'sub __NR_fairsched_rate () {508;}' unless defined(&__NR_fairsched_rate);
  77         eval 'sub __NR_setluid () {501;}' unless defined(&__NR_setluid);
  78         eval 'sub __NR_setublimit () {502;}' unless defined(&__NR_setublimit);
  79     }
  80     elsif(defined( &__i386__) ) {
  81         eval 'sub __NR_fairsched_mknod () {500;}' unless defined(&__NR_fairsched_mknod);
  82         eval 'sub __NR_fairsched_rmnod () {501;}' unless defined(&__NR_fairsched_rmnod);
  83         eval 'sub __NR_fairsched_chwt () {502;}' unless defined(&__NR_fairsched_chwt);
  84         eval 'sub __NR_fairsched_mvpr () {503;}' unless defined(&__NR_fairsched_mvpr);
  85         eval 'sub __NR_fairsched_rate () {504;}' unless defined(&__NR_fairsched_rate);
  86         eval 'sub __NR_fairsched_vcpus () {505;}' unless defined(&__NR_fairsched_vcpus);
  87         eval 'sub __NR_setluid () {511;}' unless defined(&__NR_setluid);
  88         eval 'sub __NR_setublimit () {512;}' unless defined(&__NR_setublimit);
  89     } else {
  90         die("no fairsched syscall for this arch");
  91     }
  92     require 'asm/ioctl.ph';
  93     eval 'sub KVM_GET_API_VERSION () { &_IO(0xAE, 0x);}' unless defined(&KVM_GET_API_VERSION);
  94 }
  95
  96 sub fairsched_mknod {
  97     my ($parent, $weight, $desired) = @_;
  98
  99     return syscall(&__NR_fairsched_mknod, int($parent), int($weight), int($desired));
 100 }
 101
 102 sub fairsched_rmnod {
 103     my ($id) = @_;
 104
 105     return syscall(&__NR_fairsched_rmnod, int($id));
 106 }
 107
 108 sub fairsched_mvpr {
 109     my ($pid, $newid) = @_;
 110
 111     return syscall(&__NR_fairsched_mvpr, int($pid), int($newid));
 112 }
 113
 114 sub fairsched_vcpus {
 115     my ($id, $vcpus) = @_;
 116
 117     return syscall(&__NR_fairsched_vcpus, int($id), int($vcpus));
 118 }
 119
 120 sub fairsched_rate {
 121     my ($id, $op, $rate) = @_;
 122
 123     return syscall(&__NR_fairsched_rate, int($id), int($op), int($rate));
 124 }
 125
 126 use constant FAIRSCHED_SET_RATE  => 0;
 127 use constant FAIRSCHED_DROP_RATE => 1;
 128 use constant FAIRSCHED_GET_RATE  => 2;
 129
 130 sub fairsched_cpulimit {
 131     my ($id, $limit) = @_;
 132
 133     my $cpulim1024 = int($limit * 1024 / 100);
 134     my $op = $cpulim1024 ? FAIRSCHED_SET_RATE : FAIRSCHED_DROP_RATE;
 135
 136     return fairsched_rate($id, $op, $cpulim1024);
 137 }
 138
 139 my $nodename = PVE::INotify::nodename();
 140
 141 mkdir "/etc/pve/nodes/$nodename";
 142 my $confdir = "/etc/pve/nodes/$nodename/qemu-server";
 143 mkdir $confdir;
 144
 145 my $var_run_tmpdir = "/var/run/qemu-server";
 146 mkdir $var_run_tmpdir;
 147
 148 my $lock_dir = "/var/lock/qemu-server";
 149 mkdir $lock_dir;
 150
 151 my $pcisysfs = "/sys/bus/pci";
 152
 153 my $confdesc = {
 154     onboot => {
 155         optional => 1,
 156         type => 'boolean',
 157         description => "Specifies whether a VM will be started during system bootup.",
 158         default => 0,
 159     },
 160     autostart => {
 161         optional => 1,
 162         type => 'boolean',
 163         description => "Automatic restart after crash (currently ignored).",
 164         default => 0,
 165     },
 166     hotplug => {
 167         optional => 1,
 168         type => 'boolean',
 169         description => "Activate hotplug for disk and network device",
 170         default => 0,
 171     },
 172     reboot => {
 173         optional => 1,
 174         type => 'boolean',
 175         description => "Allow reboot. If set to '0' the VM exit on reboot.",
 176         default => 1,
 177     },
 178     lock => {
 179         optional => 1,
 180         type => 'string',
 181         description => "Lock/unlock the VM.",
 182         enum => [qw(migrate backup snapshot rollback)],
 183     },
 184     cpulimit => {
 185         optional => 1,
 186         type => 'integer',
 187         description => "Limit of CPU usage in per cent. Note if the computer has 2 CPUs, it has total of 200% CPU time. Value '0' indicates no CPU limit.\n\nNOTE: This option is currently ignored.",
 188         minimum => 0,
 189         default => 0,
 190     },
 191     cpuunits => {
 192         optional => 1,
 193         type => 'integer',
 194         description => "CPU weight for a VM. Argument is used in the kernel fair scheduler. The larger the number is, the more CPU time this VM gets. Number is relative to weights of all the other running VMs.\n\nNOTE: You can disable fair-scheduler configuration by setting this to 0.",
 195         minimum => 0,
 196         maximum => 500000,
 197         default => 1000,
 198     },
 199     memory => {
 200         optional => 1,
 201         type => 'integer',
 202         description => "Amount of RAM for the VM in MB. This is the maximum available memory when you use the balloon device.",
 203         minimum => 16,
 204         default => 512,
 205     },
 206     balloon => {
 207         optional => 1,
 208         type => 'integer',
 209         description => "Amount of target RAM for the VM in MB.",
 210         minimum => 16,
 211     },
 212     keyboard => {
 213         optional => 1,
 214         type => 'string',
 215         description => "Keybord layout for vnc server. Default is read from the datacenter configuration file.",
 216         enum => PVE::Tools::kvmkeymaplist(),
 217         default => 'en-us',
 218     },
 219     name => {
 220         optional => 1,
 221         type => 'string', format => 'dns-name',
 222         description => "Set a name for the VM. Only used on the configuration web interface.",
 223     },
 224     scsihw => {
 225         optional => 1,
 226         type => 'string',
 227         description => "scsi controller model",
 228         enum => [qw(lsi virtio-scsi-pci megasas)],
 229         default => 'lsi',
 230     },
 231     description => {
 232         optional => 1,
 233         type => 'string',
 234         description => "Description for the VM. Only used on the configuration web interface. This is saved as comment inside the configuration file.",
 235     },
 236     ostype => {
 237         optional => 1,
 238         type => 'string',
 239         enum => [qw(other wxp w2k w2k3 w2k8 wvista win7 win8 l24 l26)],
 240         description => <<EODESC,
 241 Used to enable special optimization/features for specific
 242 operating systems:
 243
 244 other  => unspecified OS
 245 wxp    => Microsoft Windows XP
 246 w2k    => Microsoft Windows 2000
 247 w2k3   => Microsoft Windows 2003
 248 w2k8   => Microsoft Windows 2008
 249 wvista => Microsoft Windows Vista
 250 win7   => Microsoft Windows 7
 251 win8   => Microsoft Windows 8/2012
 252 l24    => Linux 2.4 Kernel
 253 l26    => Linux 2.6/3.X Kernel
 254
 255 other|l24|l26                       ... no special behaviour
 256 wxp|w2k|w2k3|w2k8|wvista|win7|win8  ... use --localtime switch
 257 EODESC
 258     },
 259     boot => {
 260         optional => 1,
 261         type => 'string',
 262         description => "Boot on floppy (a), hard disk (c), CD-ROM (d), or network (n).",
 263         pattern => '[acdn]{1,4}',
 264         default => 'cdn',
 265     },
 266     bootdisk => {
 267         optional => 1,
 268         type => 'string', format => 'pve-qm-bootdisk',
 269         description => "Enable booting from specified disk.",
 270         pattern => '(ide|sata|scsi|virtio)\d+',
 271     },
 272     smp => {
 273         optional => 1,
 274         type => 'integer',
 275         description => "The number of CPUs. Please use option -sockets instead.",
 276         minimum => 1,
 277         default => 1,
 278     },
 279     sockets => {
 280         optional => 1,
 281         type => 'integer',
 282         description => "The number of CPU sockets.",
 283         minimum => 1,
 284         default => 1,
 285     },
 286     cores => {
 287         optional => 1,
 288         type => 'integer',
 289         description => "The number of cores per socket.",
 290         minimum => 1,
 291         default => 1,
 292     },
 293     acpi => {
 294         optional => 1,
 295         type => 'boolean',
 296         description => "Enable/disable ACPI.",
 297         default => 1,
 298     },
 299     agent => {
 300         optional => 1,
 301         type => 'boolean',
 302         description => "Enable/disable Qemu GuestAgent.",
 303         default => 0,
 304     },
 305     kvm => {
 306         optional => 1,
 307         type => 'boolean',
 308         description => "Enable/disable KVM hardware virtualization.",
 309         default => 1,
 310     },
 311     tdf => {
 312         optional => 1,
 313         type => 'boolean',
 314         description => "Enable/disable time drift fix.",
 315         default => 0,
 316     },
 317     localtime => {
 318         optional => 1,
 319         type => 'boolean',
 320         description => "Set the real time clock to local time. This is enabled by default if ostype indicates a Microsoft OS.",
 321     },
 322     freeze => {
 323         optional => 1,
 324         type => 'boolean',
 325         description => "Freeze CPU at startup (use 'c' monitor command to start execution).",
 326     },
 327     vga => {
 328         optional => 1,
 329         type => 'string',
 330         description => "Select VGA type. If you want to use high resolution modes (>= 1280x1024x16) then you should use option 'std' or 'vmware'. Default is 'std' for win8/win7/w2k8, and 'cirrur' for other OS types",
 331         enum => [qw(std cirrus vmware)],
 332     },
 333     watchdog => {
 334         optional => 1,
 335         type => 'string', format => 'pve-qm-watchdog',
 336         typetext => '[[model=]i6300esb|ib700] [,[action=]reset|shutdown|poweroff|pause|debug|none]',
 337         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)",
 338     },
 339     startdate => {
 340         optional => 1,
 341         type => 'string',
 342         typetext => "(now | YYYY-MM-DD | YYYY-MM-DDTHH:MM:SS)",
 343         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'.",
 344         pattern => '(now|\d{4}-\d{1,2}-\d{1,2}(T\d{1,2}:\d{1,2}:\d{1,2})?)',
 345         default => 'now',
 346     },
 347     startup => {
 348         optional => 1,
 349         type => 'string', format => 'pve-qm-startup',
 350         typetext => '[[order=]\d+] [,up=\d+] [,down=\d+] ',
 351         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.",
 352     },
 353     args => {
 354         optional => 1,
 355         type => 'string',
 356         description => <<EODESCR,
 357 Note: this option is for experts only. It allows you to pass arbitrary arguments to kvm, for example:
 358
 359 args: -no-reboot -no-hpet
 360 EODESCR
 361     },
 362     tablet => {
 363         optional => 1,
 364         type => 'boolean',
 365         default => 1,
 366         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.",
 367     },
 368     migrate_speed => {
 369         optional => 1,
 370         type => 'integer',
 371         description => "Set maximum speed (in MB/s) for migrations. Value 0 is no limit.",
 372         minimum => 0,
 373         default => 0,
 374     },
 375     migrate_downtime => {
 376         optional => 1,
 377         type => 'integer',
 378         description => "Set maximum tolerated downtime (in seconds) for migrations.",
 379         minimum => 0,
 380         default => 1,
 381     },
 382     cdrom => {
 383         optional => 1,
 384         type => 'string', format => 'pve-qm-drive',
 385         typetext => 'volume',
 386         description => "This is an alias for option -ide2",
 387     },
 388     cpu => {
 389         optional => 1,
 390         description => "Emulated CPU type.",
 391         type => 'string',
 392         enum => [ qw(486 athlon pentium pentium2 pentium3 coreduo core2duo kvm32 kvm64 qemu32 qemu64 phenom Conroe Penryn Nehalem Westmere SandyBridge Haswell Opteron_G1 Opteron_G2 Opteron_G3 Opteron_G4 Opteron_G5 host) ],
 393         default => 'qemu64',
 394     },
 395     parent => get_standard_option('pve-snapshot-name', {
 396         optional => 1,
 397         description => "Parent snapshot name. This is used internally, and should not be modified.",
 398     }),
 399     snaptime => {
 400         optional => 1,
 401         description => "Timestamp for snapshots.",
 402         type => 'integer',
 403         minimum => 0,
 404     },
 405     vmstate => {
 406         optional => 1,
 407         type => 'string', format => 'pve-volume-id',
 408         description => "Reference to a volume which stores the VM state. This is used internally for snapshots.",
 409     },
 410 };
 411
 412 # what about other qemu settings ?
 413 #cpu => 'string',
 414 #machine => 'string',
 415 #fda => 'file',
 416 #fdb => 'file',
 417 #mtdblock => 'file',
 418 #sd => 'file',
 419 #pflash => 'file',
 420 #snapshot => 'bool',
 421 #bootp => 'file',
 422 ##tftp => 'dir',
 423 ##smb => 'dir',
 424 #kernel => 'file',
 425 #append => 'string',
 426 #initrd => 'file',
 427 ##soundhw => 'string',
 428
 429 while (my ($k, $v) = each %$confdesc) {
 430     PVE::JSONSchema::register_standard_option("pve-qm-$k", $v);
 431 }
 432
 433 my $MAX_IDE_DISKS = 4;
 434 my $MAX_SCSI_DISKS = 14;
 435 my $MAX_VIRTIO_DISKS = 16;
 436 my $MAX_SATA_DISKS = 6;
 437 my $MAX_USB_DEVICES = 5;
 438 my $MAX_NETS = 32;
 439 my $MAX_UNUSED_DISKS = 8;
 440 my $MAX_HOSTPCI_DEVICES = 2;
 441 my $MAX_SERIAL_PORTS = 4;
 442 my $MAX_PARALLEL_PORTS = 3;
 443
 444 my $nic_model_list = ['rtl8139', 'ne2k_pci', 'e1000',  'pcnet',  'virtio',
 445                       'ne2k_isa', 'i82551', 'i82557b', 'i82559er'];
 446 my $nic_model_list_txt = join(' ', sort @$nic_model_list);
 447
 448 my $netdesc = {
 449     optional => 1,
 450     type => 'string', format => 'pve-qm-net',
 451     typetext => "MODEL=XX:XX:XX:XX:XX:XX [,bridge=<dev>][,rate=<mbps>][,tag=<vlanid>]",
 452     description => <<EODESCR,
 453 Specify network devices.
 454
 455 MODEL is one of: $nic_model_list_txt
 456
 457 XX:XX:XX:XX:XX:XX should be an unique MAC address. This is
 458 automatically generated if not specified.
 459
 460 The bridge parameter can be used to automatically add the interface to a bridge device. The Proxmox VE standard bridge is called 'vmbr0'.
 461
 462 Option 'rate' is used to limit traffic bandwidth from and to this interface. It is specified as floating point number, unit is 'Megabytes per second'.
 463
 464 If you specify no bridge, we create a kvm 'user' (NATed) network device, which provides DHCP and DNS services. The following addresses are used:
 465
 466 10.0.2.2   Gateway
 467 10.0.2.3   DNS Server
 468 10.0.2.4   SMB Server
 469
 470 The DHCP server assign addresses to the guest starting from 10.0.2.15.
 471
 472 EODESCR
 473 };
 474 PVE::JSONSchema::register_standard_option("pve-qm-net", $netdesc);
 475
 476 for (my $i = 0; $i < $MAX_NETS; $i++)  {
 477     $confdesc->{"net$i"} = $netdesc;
 478 }
 479
 480 my $drivename_hash;
 481
 482 my $idedesc = {
 483     optional => 1,
 484     type => 'string', format => 'pve-qm-drive',
 485     typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe|directsync] [,format=f] [,backup=yes|no] [,rerror=ignore|report|stop] [,werror=enospc|ignore|report|stop] [,aio=native|threads]',
 486     description => "Use volume as IDE hard disk or CD-ROM (n is 0 to " .($MAX_IDE_DISKS -1) . ").",
 487 };
 488 PVE::JSONSchema::register_standard_option("pve-qm-ide", $idedesc);
 489
 490 my $scsidesc = {
 491     optional => 1,
 492     type => 'string', format => 'pve-qm-drive',
 493     typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe|directsync] [,format=f] [,backup=yes|no] [,rerror=ignore|report|stop] [,werror=enospc|ignore|report|stop] [,aio=native|threads]',
 494     description => "Use volume as SCSI hard disk or CD-ROM (n is 0 to " . ($MAX_SCSI_DISKS - 1) . ").",
 495 };
 496 PVE::JSONSchema::register_standard_option("pve-qm-scsi", $scsidesc);
 497
 498 my $satadesc = {
 499     optional => 1,
 500     type => 'string', format => 'pve-qm-drive',
 501     typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe|directsync] [,format=f] [,backup=yes|no] [,rerror=ignore|report|stop] [,werror=enospc|ignore|report|stop] [,aio=native|threads]',
 502     description => "Use volume as SATA hard disk or CD-ROM (n is 0 to " . ($MAX_SATA_DISKS - 1). ").",
 503 };
 504 PVE::JSONSchema::register_standard_option("pve-qm-sata", $satadesc);
 505
 506 my $virtiodesc = {
 507     optional => 1,
 508     type => 'string', format => 'pve-qm-drive',
 509     typetext => '[volume=]volume,] [,media=cdrom|disk] [,cyls=c,heads=h,secs=s[,trans=t]] [,snapshot=on|off] [,cache=none|writethrough|writeback|unsafe|directsync] [,format=f] [,backup=yes|no] [,rerror=ignore|report|stop] [,werror=enospc|ignore|report|stop] [,aio=native|threads]',
 510     description => "Use volume as VIRTIO hard disk (n is 0 to " . ($MAX_VIRTIO_DISKS - 1) . ").",
 511 };
 512 PVE::JSONSchema::register_standard_option("pve-qm-virtio", $virtiodesc);
 513
 514 my $usbdesc = {
 515     optional => 1,
 516     type => 'string', format => 'pve-qm-usb-device',
 517     typetext => 'host=HOSTUSBDEVICE',
 518     description => <<EODESCR,
 519 Configure an USB device (n is 0 to 4). This can be used to
 520 pass-through usb devices to the guest. HOSTUSBDEVICE syntax is:
 521
 522 'bus-port(.port)*' (decimal numbers) or
 523 'vendor_id:product_id' (hexadeciaml numbers)
 524
 525 You can use the 'lsusb -t' command to list existing usb devices.
 526
 527 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 528
 529 EODESCR
 530 };
 531 PVE::JSONSchema::register_standard_option("pve-qm-usb", $usbdesc);
 532
 533 my $hostpcidesc = {
 534         optional => 1,
 535         type => 'string', format => 'pve-qm-hostpci',
 536         typetext => "HOSTPCIDEVICE",
 537         description => <<EODESCR,
 538 Map host pci devices. HOSTPCIDEVICE syntax is:
 539
 540 'bus:dev.func' (hexadecimal numbers)
 541
 542 You can us the 'lspci' command to list existing pci devices.
 543
 544 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 545
 546 Experimental: user reported problems with this option.
 547 EODESCR
 548 };
 549 PVE::JSONSchema::register_standard_option("pve-qm-hostpci", $hostpcidesc);
 550
 551 my $serialdesc = {
 552         optional => 1,
 553         type => 'string',
 554         pattern => '/dev/ttyS\d+',
 555         description =>  <<EODESCR,
 556 Map host serial devices (n is 0 to 3).
 557
 558 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 559
 560 Experimental: user reported problems with this option.
 561 EODESCR
 562 };
 563
 564 my $paralleldesc= {
 565         optional => 1,
 566         type => 'string',
 567         pattern => '/dev/parport\d+',
 568         description =>  <<EODESCR,
 569 Map host parallel devices (n is 0 to 2).
 570
 571 Note: This option allows direct access to host hardware. So it is no longer possible to migrate such machines - use with special care.
 572
 573 Experimental: user reported problems with this option.
 574 EODESCR
 575 };
 576
 577 for (my $i = 0; $i < $MAX_PARALLEL_PORTS; $i++)  {
 578     $confdesc->{"parallel$i"} = $paralleldesc;
 579 }
 580
 581 for (my $i = 0; $i < $MAX_SERIAL_PORTS; $i++)  {
 582     $confdesc->{"serial$i"} = $serialdesc;
 583 }
 584
 585 for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
 586     $confdesc->{"hostpci$i"} = $hostpcidesc;
 587 }
 588
 589 for (my $i = 0; $i < $MAX_IDE_DISKS; $i++)  {
 590     $drivename_hash->{"ide$i"} = 1;
 591     $confdesc->{"ide$i"} = $idedesc;
 592 }
 593
 594 for (my $i = 0; $i < $MAX_SATA_DISKS; $i++)  {
 595     $drivename_hash->{"sata$i"} = 1;
 596     $confdesc->{"sata$i"} = $satadesc;
 597 }
 598
 599 for (my $i = 0; $i < $MAX_SCSI_DISKS; $i++)  {
 600     $drivename_hash->{"scsi$i"} = 1;
 601     $confdesc->{"scsi$i"} = $scsidesc ;
 602 }
 603
 604 for (my $i = 0; $i < $MAX_VIRTIO_DISKS; $i++)  {
 605     $drivename_hash->{"virtio$i"} = 1;
 606     $confdesc->{"virtio$i"} = $virtiodesc;
 607 }
 608
 609 for (my $i = 0; $i < $MAX_USB_DEVICES; $i++)  {
 610     $confdesc->{"usb$i"} = $usbdesc;
 611 }
 612
 613 my $unuseddesc = {
 614     optional => 1,
 615     type => 'string', format => 'pve-volume-id',
 616     description => "Reference to unused volumes.",
 617 };
 618
 619 for (my $i = 0; $i < $MAX_UNUSED_DISKS; $i++)  {
 620     $confdesc->{"unused$i"} = $unuseddesc;
 621 }
 622
 623 my $kvm_api_version = 0;
 624
 625 sub kvm_version {
 626
 627     return $kvm_api_version if $kvm_api_version;
 628
 629     my $fh = IO::File->new("</dev/kvm") ||
 630         return 0;
 631
 632     if (my $v = $fh->ioctl(KVM_GET_API_VERSION(), 0)) {
 633         $kvm_api_version = $v;
 634     }
 635
 636     $fh->close();
 637
 638     return  $kvm_api_version;
 639 }
 640
 641 my $kvm_user_version;
 642
 643 sub kvm_user_version {
 644
 645     return $kvm_user_version if $kvm_user_version;
 646
 647     $kvm_user_version = 'unknown';
 648
 649     my $tmp = `kvm -help 2>/dev/null`;
 650
 651     if ($tmp =~ m/^QEMU( PC)? emulator version (\d+\.\d+(\.\d+)?)[,\s]/) {
 652         $kvm_user_version = $2;
 653     }
 654
 655     return $kvm_user_version;
 656
 657 }
 658
 659 my $kernel_has_vhost_net = -c '/dev/vhost-net';
 660
 661 sub disknames {
 662     # order is important - used to autoselect boot disk
 663     return ((map { "ide$_" } (0 .. ($MAX_IDE_DISKS - 1))),
 664             (map { "scsi$_" } (0 .. ($MAX_SCSI_DISKS - 1))),
 665             (map { "virtio$_" } (0 .. ($MAX_VIRTIO_DISKS - 1))),
 666             (map { "sata$_" } (0 .. ($MAX_SATA_DISKS - 1))));
 667 }
 668
 669 sub valid_drivename {
 670     my $dev = shift;
 671
 672     return defined($drivename_hash->{$dev});
 673 }
 674
 675 sub option_exists {
 676     my $key = shift;
 677     return defined($confdesc->{$key});
 678 }
 679
 680 sub nic_models {
 681     return $nic_model_list;
 682 }
 683
 684 sub os_list_description {
 685
 686     return {
 687         other => 'Other',
 688         wxp => 'Windows XP',
 689         w2k => 'Windows 2000',
 690         w2k3 =>, 'Windows 2003',
 691         w2k8 => 'Windows 2008',
 692         wvista => 'Windows Vista',
 693         win7 => 'Windows 7',
 694         win8 => 'Windows 8/2012',
 695         l24 => 'Linux 2.4',
 696         l26 => 'Linux 2.6',
 697     };
 698 }
 699
 700 my $cdrom_path;
 701
 702 sub get_cdrom_path {
 703
 704     return  $cdrom_path if $cdrom_path;
 705
 706     return $cdrom_path = "/dev/cdrom" if -l "/dev/cdrom";
 707     return $cdrom_path = "/dev/cdrom1" if -l "/dev/cdrom1";
 708     return $cdrom_path = "/dev/cdrom2" if -l "/dev/cdrom2";
 709 }
 710
 711 sub get_iso_path {
 712     my ($storecfg, $vmid, $cdrom) = @_;
 713
 714     if ($cdrom eq 'cdrom') {
 715         return get_cdrom_path();
 716     } elsif ($cdrom eq 'none') {
 717         return '';
 718     } elsif ($cdrom =~ m|^/|) {
 719         return $cdrom;
 720     } else {
 721         return PVE::Storage::path($storecfg, $cdrom);
 722     }
 723 }
 724
 725 # try to convert old style file names to volume IDs
 726 sub filename_to_volume_id {
 727     my ($vmid, $file, $media) = @_;
 728
 729     if (!($file eq 'none' || $file eq 'cdrom' ||
 730           $file =~ m|^/dev/.+| || $file =~ m/^([^:]+):(.+)$/)) {
 731
 732         return undef if $file =~ m|/|;
 733
 734         if ($media && $media eq 'cdrom') {
 735             $file = "local:iso/$file";
 736         } else {
 737             $file = "local:$vmid/$file";
 738         }
 739     }
 740
 741     return $file;
 742 }
 743
 744 sub verify_media_type {
 745     my ($opt, $vtype, $media) = @_;
 746
 747     return if !$media;
 748
 749     my $etype;
 750     if ($media eq 'disk') {
 751         $etype = 'images';
 752     } elsif ($media eq 'cdrom') {
 753         $etype = 'iso';
 754     } else {
 755         die "internal error";
 756     }
 757
 758     return if ($vtype eq $etype);
 759
 760     raise_param_exc({ $opt => "unexpected media type ($vtype != $etype)" });
 761 }
 762
 763 sub cleanup_drive_path {
 764     my ($opt, $storecfg, $drive) = @_;
 765
 766     # try to convert filesystem paths to volume IDs
 767
 768     if (($drive->{file} !~ m/^(cdrom|none)$/) &&
 769         ($drive->{file} !~ m|^/dev/.+|) &&
 770         ($drive->{file} !~ m/^([^:]+):(.+)$/) &&
 771         ($drive->{file} !~ m/^\d+$/)) {
 772         my ($vtype, $volid) = PVE::Storage::path_to_volume_id($storecfg, $drive->{file});
 773         raise_param_exc({ $opt => "unable to associate path '$drive->{file}' to any storage"}) if !$vtype;
 774         $drive->{media} = 'cdrom' if !$drive->{media} && $vtype eq 'iso';
 775         verify_media_type($opt, $vtype, $drive->{media});
 776         $drive->{file} = $volid;
 777     }
 778
 779     $drive->{media} = 'cdrom' if !$drive->{media} && $drive->{file} =~ m/^(cdrom|none)$/;
 780 }
 781
 782 sub create_conf_nolock {
 783     my ($vmid, $settings) = @_;
 784
 785     my $filename = config_file($vmid);
 786
 787     die "configuration file '$filename' already exists\n" if -f $filename;
 788
 789     my $defaults = load_defaults();
 790
 791     $settings->{name} = "vm$vmid" if !$settings->{name};
 792     $settings->{memory} = $defaults->{memory} if !$settings->{memory};
 793
 794     my $data = '';
 795     foreach my $opt (keys %$settings) {
 796         next if !$confdesc->{$opt};
 797
 798         my $value = $settings->{$opt};
 799         next if !$value;
 800
 801         $data .= "$opt: $value\n";
 802     }
 803
 804     PVE::Tools::file_set_contents($filename, $data);
 805 }
 806
 807 my $parse_size = sub {
 808     my ($value) = @_;
 809
 810     return undef if $value !~ m/^(\d+(\.\d+)?)([KMG])?$/;
 811     my ($size, $unit) = ($1, $3);
 812     if ($unit) {
 813         if ($unit eq 'K') {
 814             $size = $size * 1024;
 815         } elsif ($unit eq 'M') {
 816             $size = $size * 1024 * 1024;
 817         } elsif ($unit eq 'G') {
 818             $size = $size * 1024 * 1024 * 1024;
 819         }
 820     }
 821     return int($size);
 822 };
 823
 824 my $format_size = sub {
 825     my ($size) = @_;
 826
 827     $size = int($size);
 828
 829     my $kb = int($size/1024);
 830     return $size if $kb*1024 != $size;
 831
 832     my $mb = int($kb/1024);
 833     return "${kb}K" if $mb*1024 != $kb;
 834
 835     my $gb = int($mb/1024);
 836     return "${mb}M" if $gb*1024 != $mb;
 837
 838     return "${gb}G";
 839 };
 840
 841 # ideX = [volume=]volume-id[,media=d][,cyls=c,heads=h,secs=s[,trans=t]]
 842 #        [,snapshot=on|off][,cache=on|off][,format=f][,backup=yes|no]
 843 #        [,rerror=ignore|report|stop][,werror=enospc|ignore|report|stop]
 844 #        [,aio=native|threads]
 845
 846 sub parse_drive {
 847     my ($key, $data) = @_;
 848
 849     my $res = {};
 850
 851     # $key may be undefined - used to verify JSON parameters
 852     if (!defined($key)) {
 853         $res->{interface} = 'unknown'; # should not harm when used to verify parameters
 854         $res->{index} = 0;
 855     } elsif ($key =~ m/^([^\d]+)(\d+)$/) {
 856         $res->{interface} = $1;
 857         $res->{index} = $2;
 858     } else {
 859         return undef;
 860     }
 861
 862     foreach my $p (split (/,/, $data)) {
 863         next if $p =~ m/^\s*$/;
 864
 865         if ($p =~ m/^(file|volume|cyls|heads|secs|trans|media|snapshot|cache|format|rerror|werror|backup|aio|bps|mbps|bps_rd|mbps_rd|bps_wr|mbps_wr|iops|iops_rd|iops_wr|size)=(.+)$/) {
 866             my ($k, $v) = ($1, $2);
 867
 868             $k = 'file' if $k eq 'volume';
 869
 870             return undef if defined $res->{$k};
 871
 872             if ($k eq 'bps' || $k eq 'bps_rd' || $k eq 'bps_wr') {
 873                 return undef if !$v || $v !~ m/^\d+/;
 874                 $k = "m$k";
 875                 $v = sprintf("%.3f", $v / (1024*1024));
 876             }
 877             $res->{$k} = $v;
 878         } else {
 879             if (!$res->{file} && $p !~ m/=/) {
 880                 $res->{file} = $p;
 881             } else {
 882                 return undef;
 883             }
 884         }
 885     }
 886
 887     return undef if !$res->{file};
 888
 889     return undef if $res->{cache} &&
 890         $res->{cache} !~ m/^(off|none|writethrough|writeback|unsafe|directsync)$/;
 891     return undef if $res->{snapshot} && $res->{snapshot} !~ m/^(on|off)$/;
 892     return undef if $res->{cyls} && $res->{cyls} !~ m/^\d+$/;
 893     return undef if $res->{heads} && $res->{heads} !~ m/^\d+$/;
 894     return undef if $res->{secs} && $res->{secs} !~ m/^\d+$/;
 895     return undef if $res->{media} && $res->{media} !~ m/^(disk|cdrom)$/;
 896     return undef if $res->{trans} && $res->{trans} !~ m/^(none|lba|auto)$/;
 897     return undef if $res->{format} && $res->{format} !~ m/^(raw|cow|qcow|qcow2|vmdk|cloop)$/;
 898     return undef if $res->{rerror} && $res->{rerror} !~ m/^(ignore|report|stop)$/;
 899     return undef if $res->{werror} && $res->{werror} !~ m/^(enospc|ignore|report|stop)$/;
 900     return undef if $res->{backup} && $res->{backup} !~ m/^(yes|no)$/;
 901     return undef if $res->{aio} && $res->{aio} !~ m/^(native|threads)$/;
 902
 903
 904     return undef if $res->{mbps_rd} && $res->{mbps};
 905     return undef if $res->{mbps_wr} && $res->{mbps};
 906
 907     return undef if $res->{mbps} && $res->{mbps} !~ m/^\d+(\.\d+)?$/;
 908     return undef if $res->{mbps_rd} && $res->{mbps_rd} !~ m/^\d+(\.\d+)?$/;
 909     return undef if $res->{mbps_wr} && $res->{mbps_wr} !~ m/^\d+(\.\d+)?$/;
 910
 911     return undef if $res->{iops_rd} && $res->{iops};
 912     return undef if $res->{iops_wr} && $res->{iops};
 913     return undef if $res->{iops} && $res->{iops} !~ m/^\d+$/;
 914     return undef if $res->{iops_rd} && $res->{iops_rd} !~ m/^\d+$/;
 915     return undef if $res->{iops_wr} && $res->{iops_wr} !~ m/^\d+$/;
 916
 917
 918     if ($res->{size}) {
 919         return undef if !defined($res->{size} = &$parse_size($res->{size}));
 920     }
 921
 922     if ($res->{media} && ($res->{media} eq 'cdrom')) {
 923         return undef if $res->{snapshot} || $res->{trans} || $res->{format};
 924         return undef if $res->{heads} || $res->{secs} || $res->{cyls};
 925         return undef if $res->{interface} eq 'virtio';
 926     }
 927
 928     # rerror does not work with scsi drives
 929     if ($res->{rerror}) {
 930         return undef if $res->{interface} eq 'scsi';
 931     }
 932
 933     return $res;
 934 }
 935
 936 my @qemu_drive_options = qw(heads secs cyls trans media format cache snapshot rerror werror aio iops iops_rd iops_wr);
 937
 938 sub print_drive {
 939     my ($vmid, $drive) = @_;
 940
 941     my $opts = '';
 942     foreach my $o (@qemu_drive_options, 'mbps', 'mbps_rd', 'mbps_wr', 'backup') {
 943         $opts .= ",$o=$drive->{$o}" if $drive->{$o};
 944     }
 945
 946     if ($drive->{size}) {
 947         $opts .= ",size=" . &$format_size($drive->{size});
 948     }
 949
 950     return "$drive->{file}$opts";
 951 }
 952
 953 sub scsi_inquiry {
 954     my($fh, $noerr) = @_;
 955
 956     my $SG_IO = 0x2285;
 957     my $SG_GET_VERSION_NUM = 0x2282;
 958
 959     my $versionbuf = "\x00" x 8;
 960     my $ret = ioctl($fh, $SG_GET_VERSION_NUM, $versionbuf);
 961     if (!$ret) {
 962         die "scsi ioctl SG_GET_VERSION_NUM failoed - $!\n" if !$noerr;
 963         return undef;
 964     }
 965     my $version = unpack("I", $versionbuf);
 966     if ($version < 30000) {
 967         die "scsi generic interface too old\n"  if !$noerr;
 968         return undef;
 969     }
 970
 971     my $buf = "\x00" x 36;
 972     my $sensebuf = "\x00" x 8;
 973     my $cmd = pack("C x3 C x11", 0x12, 36);
 974
 975     # see /usr/include/scsi/sg.h
 976     my $sg_io_hdr_t = "i i C C s I P P P I I i P C C C C S S i I I";
 977
 978     my $packet = pack($sg_io_hdr_t, ord('S'), -3, length($cmd),
 979                       length($sensebuf), 0, length($buf), $buf,
 980                       $cmd, $sensebuf, 6000);
 981
 982     $ret = ioctl($fh, $SG_IO, $packet);
 983     if (!$ret) {
 984         die "scsi ioctl SG_IO failed - $!\n" if !$noerr;
 985         return undef;
 986     }
 987
 988     my @res = unpack($sg_io_hdr_t, $packet);
 989     if ($res[17] || $res[18]) {
 990         die "scsi ioctl SG_IO status error - $!\n" if !$noerr;
 991         return undef;
 992     }
 993
 994     my $res = {};
 995     ($res->{device}, $res->{removable}, $res->{venodor},
 996      $res->{product}, $res->{revision}) = unpack("C C x6 A8 A16 A4", $buf);
 997
 998     return $res;
 999 }
1000
1001 sub path_is_scsi {
1002     my ($path) = @_;
1003
1004     my $fh = IO::File->new("+<$path") || return undef;
1005     my $res = scsi_inquiry($fh, 1);
1006     close($fh);
1007
1008     return $res;
1009 }
1010
1011 sub print_drivedevice_full {
1012     my ($storecfg, $conf, $vmid, $drive, $bridges) = @_;
1013
1014     my $device = '';
1015     my $maxdev = 0;
1016
1017     if ($drive->{interface} eq 'virtio') {
1018         my $pciaddr = print_pci_addr("$drive->{interface}$drive->{index}", $bridges);
1019         $device = "virtio-blk-pci,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}$pciaddr";
1020     } elsif ($drive->{interface} eq 'scsi') {
1021         $maxdev = ($conf->{scsihw} && $conf->{scsihw} ne 'lsi') ? 256 : 7;
1022         my $controller = int($drive->{index} / $maxdev);
1023         my $unit = $drive->{index} % $maxdev;
1024         my $devicetype = 'hd';
1025         my $path = '';
1026         if (drive_is_cdrom($drive)) {
1027               $devicetype = 'cd';
1028           } else {
1029               if ($drive->{file} =~ m|^/|) {
1030                   $path = $drive->{file};
1031               } else {
1032                   $path = PVE::Storage::path($storecfg, $drive->{file});
1033               }
1034
1035               if($path =~ m/^iscsi\:\/\//){
1036                  $devicetype = 'generic';
1037               }
1038               else {
1039                  $devicetype = 'block' if path_is_scsi($path);
1040               }
1041          }
1042
1043         if (!$conf->{scsihw} || $conf->{scsihw} eq 'lsi'){
1044             $device = "scsi-$devicetype,bus=scsihw$controller.0,scsi-id=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}" if !$conf->{scsihw} || $conf->{scsihw} eq 'lsi';
1045         } else {
1046             $device = "scsi-$devicetype,bus=scsihw$controller.0,channel=0,scsi-id=0,lun=$drive->{index},drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1047         }
1048
1049     } elsif ($drive->{interface} eq 'ide'){
1050         $maxdev = 2;
1051         my $controller = int($drive->{index} / $maxdev);
1052         my $unit = $drive->{index} % $maxdev;
1053         my $devicetype = ($drive->{media} && $drive->{media} eq 'cdrom') ? "cd" : "hd";
1054
1055         $device = "ide-$devicetype,bus=ide.$controller,unit=$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1056     } elsif ($drive->{interface} eq 'sata'){
1057         my $controller = int($drive->{index} / $MAX_SATA_DISKS);
1058         my $unit = $drive->{index} % $MAX_SATA_DISKS;
1059         $device = "ide-drive,bus=ahci$controller.$unit,drive=drive-$drive->{interface}$drive->{index},id=$drive->{interface}$drive->{index}";
1060     } elsif ($drive->{interface} eq 'usb') {
1061         die "implement me";
1062         #  -device ide-drive,bus=ide.1,unit=0,drive=drive-ide0-1-0,id=ide0-1-0
1063     } else {
1064         die "unsupported interface type";
1065     }
1066
1067     $device .= ",bootindex=$drive->{bootindex}" if $drive->{bootindex};
1068
1069     return $device;
1070 }
1071
1072 sub print_drive_full {
1073     my ($storecfg, $vmid, $drive) = @_;
1074
1075     my $opts = '';
1076     foreach my $o (@qemu_drive_options) {
1077         next if $o eq 'bootindex';
1078         $opts .= ",$o=$drive->{$o}" if $drive->{$o};
1079     }
1080
1081     foreach my $o (qw(bps bps_rd bps_wr)) {
1082         my $v = $drive->{"m$o"};
1083         $opts .= ",$o=" . int($v*1024*1024) if $v;
1084     }
1085
1086     # use linux-aio by default (qemu default is threads)
1087     $opts .= ",aio=native" if !$drive->{aio};
1088
1089     my $path;
1090     my $volid = $drive->{file};
1091     if (drive_is_cdrom($drive)) {
1092         $path = get_iso_path($storecfg, $vmid, $volid);
1093     } else {
1094         if ($volid =~ m|^/|) {
1095             $path = $volid;
1096         } else {
1097             $path = PVE::Storage::path($storecfg, $volid);
1098         }
1099         if (!$drive->{cache} && ($path =~ m|^/dev/| || $path =~ m|\.raw$|)) {
1100             $opts .= ",cache=none";
1101         }
1102     }
1103
1104     my $pathinfo = $path ? "file=$path," : '';
1105
1106     return "${pathinfo}if=none,id=drive-$drive->{interface}$drive->{index}$opts";
1107 }
1108
1109 sub print_netdevice_full {
1110     my ($vmid, $conf, $net, $netid, $bridges) = @_;
1111
1112     my $bootorder = $conf->{boot} || $confdesc->{boot}->{default};
1113
1114     my $device = $net->{model};
1115     if ($net->{model} eq 'virtio') {
1116          $device = 'virtio-net-pci';
1117      };
1118
1119     # qemu > 0.15 always try to boot from network - we disable that by
1120     # not loading the pxe rom file
1121     my $extra = ($bootorder !~ m/n/) ? "romfile=," : '';
1122     my $pciaddr = print_pci_addr("$netid", $bridges);
1123     my $tmpstr = "$device,${extra}mac=$net->{macaddr},netdev=$netid$pciaddr,id=$netid";
1124     $tmpstr .= ",bootindex=$net->{bootindex}" if $net->{bootindex} ;
1125     return $tmpstr;
1126 }
1127
1128 sub print_netdev_full {
1129     my ($vmid, $conf, $net, $netid) = @_;
1130
1131     my $i = '';
1132     if ($netid =~ m/^net(\d+)$/) {
1133         $i = int($1);
1134     }
1135
1136     die "got strange net id '$i'\n" if $i >= ${MAX_NETS};
1137
1138     my $ifname = "tap${vmid}i$i";
1139
1140     # kvm uses TUNSETIFF ioctl, and that limits ifname length
1141     die "interface name '$ifname' is too long (max 15 character)\n"
1142         if length($ifname) >= 16;
1143
1144     my $vhostparam = '';
1145     $vhostparam = ',vhost=on' if $kernel_has_vhost_net && $net->{model} eq 'virtio';
1146
1147     my $vmname = $conf->{name} || "vm$vmid";
1148
1149     if ($net->{bridge}) {
1150         return "type=tap,id=$netid,ifname=${ifname},script=/var/lib/qemu-server/pve-bridge$vhostparam";
1151     } else {
1152         return "type=user,id=$netid,hostname=$vmname";
1153     }
1154 }
1155
1156 sub drive_is_cdrom {
1157     my ($drive) = @_;
1158
1159     return $drive && $drive->{media} && ($drive->{media} eq 'cdrom');
1160
1161 }
1162
1163 sub parse_hostpci {
1164     my ($value) = @_;
1165
1166     return undef if !$value;
1167
1168     my $res = {};
1169
1170     if ($value =~ m/^[a-f0-9]{2}:[a-f0-9]{2}\.[a-f0-9]$/) {
1171        $res->{pciid} = $value;
1172     } else {
1173        return undef;
1174     }
1175
1176     return $res;
1177 }
1178
1179 # netX: e1000=XX:XX:XX:XX:XX:XX,bridge=vmbr0,rate=<mbps>
1180 sub parse_net {
1181     my ($data) = @_;
1182
1183     my $res = {};
1184
1185     foreach my $kvp (split(/,/, $data)) {
1186
1187         if ($kvp =~ m/^(ne2k_pci|e1000|rtl8139|pcnet|virtio|ne2k_isa|i82551|i82557b|i82559er)(=([0-9a-f]{2}(:[0-9a-f]{2}){5}))?$/i) {
1188             my $model = lc($1);
1189             my $mac = uc($3) || PVE::Tools::random_ether_addr();
1190             $res->{model} = $model;
1191             $res->{macaddr} = $mac;
1192         } elsif ($kvp =~ m/^bridge=(\S+)$/) {
1193             $res->{bridge} = $1;
1194         } elsif ($kvp =~ m/^rate=(\d+(\.\d+)?)$/) {
1195             $res->{rate} = $1;
1196         } elsif ($kvp =~ m/^tag=(\d+)$/) {
1197             $res->{tag} = $1;
1198         } else {
1199             return undef;
1200         }
1201
1202     }
1203
1204     return undef if !$res->{model};
1205
1206     return $res;
1207 }
1208
1209 sub print_net {
1210     my $net = shift;
1211
1212     my $res = "$net->{model}";
1213     $res .= "=$net->{macaddr}" if $net->{macaddr};
1214     $res .= ",bridge=$net->{bridge}" if $net->{bridge};
1215     $res .= ",rate=$net->{rate}" if $net->{rate};
1216     $res .= ",tag=$net->{tag}" if $net->{tag};
1217
1218     return $res;
1219 }
1220
1221 sub add_random_macs {
1222     my ($settings) = @_;
1223
1224     foreach my $opt (keys %$settings) {
1225         next if $opt !~ m/^net(\d+)$/;
1226         my $net = parse_net($settings->{$opt});
1227         next if !$net;
1228         $settings->{$opt} = print_net($net);
1229     }
1230 }
1231
1232 sub add_unused_volume {
1233     my ($config, $volid) = @_;
1234
1235     my $key;
1236     for (my $ind = $MAX_UNUSED_DISKS - 1; $ind >= 0; $ind--) {
1237         my $test = "unused$ind";
1238         if (my $vid = $config->{$test}) {
1239             return if $vid eq $volid; # do not add duplicates
1240         } else {
1241             $key = $test;
1242         }
1243     }
1244
1245     die "To many unused volume - please delete them first.\n" if !$key;
1246
1247     $config->{$key} = $volid;
1248
1249     return $key;
1250 }
1251
1252 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 'win8' || $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, win8, 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 'win8' || $ost eq 'w2k8' ||
2272             $ost eq 'wvista') {
2273             push @$globalFlags, 'kvm-pit.lost_tick_policy=discard';
2274             push @$cmd, '-no-hpet';
2275         }
2276     }
2277
2278     push @$rtcFlags, 'driftfix=slew' if $tdf;
2279
2280     if ($nokvm) {
2281         push @$machineFlags, 'accel=tcg';
2282     } else {
2283         die "No accelerator found!\n" if !$cpuinfo->{hvm};
2284     }
2285
2286     if ($conf->{startdate}) {
2287         push @$rtcFlags, "base=$conf->{startdate}";
2288     } elsif ($useLocaltime) {
2289         push @$rtcFlags, 'base=localtime';
2290     }
2291
2292     push @$cmd, '-S' if $conf->{freeze};
2293
2294     # set keyboard layout
2295     my $kb = $conf->{keyboard} || $defaults->{keyboard};
2296     push @$cmd, '-k', $kb if $kb;
2297
2298     # enable sound
2299     #my $soundhw = $conf->{soundhw} || $defaults->{soundhw};
2300     #push @$cmd, '-soundhw', 'es1370';
2301     #push @$cmd, '-soundhw', $soundhw if $soundhw;
2302
2303     if($conf->{agent}) {
2304         my $qgasocket = qga_socket($vmid);
2305         my $pciaddr = print_pci_addr("qga0", $bridges);
2306         push @$devices, '-chardev', "socket,path=$qgasocket,server,nowait,id=qga0";
2307         push @$devices, '-device', "virtio-serial,id=qga0$pciaddr";
2308         push @$devices, '-device', 'virtserialport,chardev=qga0,name=org.qemu.guest_agent.0';
2309     }
2310
2311     $pciaddr = print_pci_addr("balloon0", $bridges);
2312     push @$devices, '-device', "virtio-balloon-pci,id=balloon0$pciaddr" if $conf->{balloon};
2313
2314     if ($conf->{watchdog}) {
2315         my $wdopts = parse_watchdog($conf->{watchdog});
2316         $pciaddr = print_pci_addr("watchdog", $bridges);
2317         my $watchdog = $wdopts->{model} || 'i6300esb';
2318         push @$devices, '-device', "$watchdog$pciaddr";
2319         push @$devices, '-watchdog-action', $wdopts->{action} if $wdopts->{action};
2320     }
2321
2322     my $vollist = [];
2323     my $scsicontroller = {};
2324     my $ahcicontroller = {};
2325     my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : $defaults->{scsihw};
2326
2327     foreach_drive($conf, sub {
2328         my ($ds, $drive) = @_;
2329
2330         if (PVE::Storage::parse_volume_id($drive->{file}, 1)) {
2331             push @$vollist, $drive->{file};
2332         }
2333
2334         $use_virtio = 1 if $ds =~ m/^virtio/;
2335
2336         if (drive_is_cdrom ($drive)) {
2337             if ($bootindex_hash->{d}) {
2338                 $drive->{bootindex} = $bootindex_hash->{d};
2339                 $bootindex_hash->{d} += 1;
2340             }
2341         } else {
2342             if ($bootindex_hash->{c}) {
2343                 $drive->{bootindex} = $bootindex_hash->{c} if $conf->{bootdisk} && ($conf->{bootdisk} eq $ds);
2344                 $bootindex_hash->{c} += 1;
2345             }
2346         }
2347
2348         if ($drive->{interface} eq 'scsi') {
2349
2350             my $maxdev = ($scsihw ne 'lsi') ? 256 : 7;
2351             my $controller = int($drive->{index} / $maxdev);
2352             $pciaddr = print_pci_addr("scsihw$controller", $bridges);
2353             push @$devices, '-device', "$scsihw,id=scsihw$controller$pciaddr" if !$scsicontroller->{$controller};
2354             $scsicontroller->{$controller}=1;
2355         }
2356
2357         if ($drive->{interface} eq 'sata') {
2358            my $controller = int($drive->{index} / $MAX_SATA_DISKS);
2359            $pciaddr = print_pci_addr("ahci$controller", $bridges);
2360            push @$devices, '-device', "ahci,id=ahci$controller,multifunction=on$pciaddr" if !$ahcicontroller->{$controller};
2361            $ahcicontroller->{$controller}=1;
2362         }
2363
2364         push @$devices, '-drive',print_drive_full($storecfg, $vmid, $drive);
2365         push @$devices, '-device',print_drivedevice_full($storecfg, $conf, $vmid, $drive, $bridges);
2366     });
2367
2368     push @$cmd, '-m', $conf->{memory} || $defaults->{memory};
2369
2370     for (my $i = 0; $i < $MAX_NETS; $i++) {
2371          next if !$conf->{"net$i"};
2372          my $d = parse_net($conf->{"net$i"});
2373          next if !$d;
2374
2375          $use_virtio = 1 if $d->{model} eq 'virtio';
2376
2377          if ($bootindex_hash->{n}) {
2378             $d->{bootindex} = $bootindex_hash->{n};
2379             $bootindex_hash->{n} += 1;
2380          }
2381
2382          my $netdevfull = print_netdev_full($vmid,$conf,$d,"net$i");
2383          push @$devices, '-netdev', $netdevfull;
2384
2385          my $netdevicefull = print_netdevice_full($vmid,$conf,$d,"net$i",$bridges);
2386          push @$devices, '-device', $netdevicefull;
2387     }
2388
2389     #bridges
2390     while (my ($k, $v) = each %$bridges) {
2391         $pciaddr = print_pci_addr("pci.$k");
2392         unshift @$devices, '-device', "pci-bridge,id=pci.$k,chassis_nr=$k$pciaddr" if $k > 0;
2393     }
2394
2395
2396     # hack: virtio with fairsched is unreliable, so we do not use fairsched
2397     # when the VM uses virtio devices.
2398     if (!$use_virtio && $have_ovz) {
2399
2400         my $cpuunits = defined($conf->{cpuunits}) ?
2401             $conf->{cpuunits} : $defaults->{cpuunits};
2402
2403         push @$cmd, '-cpuunits', $cpuunits if $cpuunits;
2404
2405         # fixme: cpulimit is currently ignored
2406         #push @$cmd, '-cpulimit', $conf->{cpulimit} if $conf->{cpulimit};
2407     }
2408
2409     # add custom args
2410     if ($conf->{args}) {
2411         my $aa = PVE::Tools::split_args($conf->{args});
2412         push @$cmd, @$aa;
2413     }
2414
2415     push @$cmd, @$devices;
2416     push @$cmd, '-rtc', join(',', @$rtcFlags)
2417         if scalar(@$rtcFlags);
2418     push @$cmd, '-machine', join(',', @$machineFlags)
2419         if scalar(@$machineFlags);
2420     push @$cmd, '-global', join(',', @$globalFlags)
2421         if scalar(@$globalFlags);
2422
2423     return wantarray ? ($cmd, $vollist) : $cmd;
2424 }
2425
2426 sub vnc_socket {
2427     my ($vmid) = @_;
2428     return "${var_run_tmpdir}/$vmid.vnc";
2429 }
2430
2431 sub qmp_socket {
2432     my ($vmid) = @_;
2433     return "${var_run_tmpdir}/$vmid.qmp";
2434 }
2435
2436 sub qga_socket {
2437     my ($vmid) = @_;
2438     return "${var_run_tmpdir}/$vmid.qga";
2439 }
2440
2441 sub pidfile_name {
2442     my ($vmid) = @_;
2443     return "${var_run_tmpdir}/$vmid.pid";
2444 }
2445
2446 sub next_migrate_port {
2447
2448     for (my $p = 60000; $p < 60010; $p++) {
2449
2450         my $sock = IO::Socket::INET->new(Listen => 5,
2451                                          LocalAddr => 'localhost',
2452                                          LocalPort => $p,
2453                                          ReuseAddr => 1,
2454                                          Proto     => 0);
2455
2456         if ($sock) {
2457             close($sock);
2458             return $p;
2459         }
2460     }
2461
2462     die "unable to find free migration port";
2463 }
2464
2465 sub vm_devices_list {
2466     my ($vmid) = @_;
2467
2468     my $res = vm_mon_cmd($vmid, 'query-pci');
2469
2470     my $devices = {};
2471     foreach my $pcibus (@$res) {
2472         foreach my $device (@{$pcibus->{devices}}) {
2473             next if !$device->{'qdev_id'};
2474             $devices->{$device->{'qdev_id'}} = $device;
2475         }
2476     }
2477
2478     return $devices;
2479 }
2480
2481 sub vm_deviceplug {
2482     my ($storecfg, $conf, $vmid, $deviceid, $device) = @_;
2483
2484     return 1 if !check_running($vmid) || !$conf->{hotplug};
2485
2486     my $devices_list = vm_devices_list($vmid);
2487     return 1 if defined($devices_list->{$deviceid});
2488
2489     qemu_bridgeadd($storecfg, $conf, $vmid, $deviceid); #add bridge if we need it for the device
2490
2491     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2492         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2493         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
2494         qemu_deviceadd($vmid, $devicefull);
2495         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2496            qemu_drivedel($vmid, $deviceid);
2497            return undef;
2498         }
2499     }
2500
2501     if ($deviceid =~ m/^(scsihw)(\d+)$/) {
2502         my $scsihw = defined($conf->{scsihw}) ? $conf->{scsihw} : "lsi";
2503         my $pciaddr = print_pci_addr($deviceid);
2504         my $devicefull = "$scsihw,id=$deviceid$pciaddr";
2505         qemu_deviceadd($vmid, $devicefull);
2506         return undef if(!qemu_deviceaddverify($vmid, $deviceid));
2507     }
2508
2509     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2510         return 1 if ($conf->{scsihw} && $conf->{scsihw} ne 'lsi'); #virtio-scsi not yet support hotplug
2511         return undef if !qemu_findorcreatescsihw($storecfg,$conf, $vmid, $device);
2512         return undef if !qemu_driveadd($storecfg, $vmid, $device);
2513         my $devicefull = print_drivedevice_full($storecfg, $conf, $vmid, $device);
2514         if(!qemu_deviceadd($vmid, $devicefull)) {
2515            qemu_drivedel($vmid, $deviceid);
2516            return undef;
2517         }
2518     }
2519
2520     if ($deviceid =~ m/^(net)(\d+)$/) {
2521         return undef if !qemu_netdevadd($vmid, $conf, $device, $deviceid);
2522         my $netdevicefull = print_netdevice_full($vmid, $conf, $device, $deviceid);
2523         qemu_deviceadd($vmid, $netdevicefull);
2524         if(!qemu_deviceaddverify($vmid, $deviceid)) {
2525            qemu_netdevdel($vmid, $deviceid);
2526            return undef;
2527         }
2528     }
2529
2530     if ($deviceid =~ m/^(pci\.)(\d+)$/) {
2531         my $bridgeid = $2;
2532         my $pciaddr = print_pci_addr($deviceid);
2533         my $devicefull = "pci-bridge,id=pci.$bridgeid,chassis_nr=$bridgeid$pciaddr";
2534         qemu_deviceadd($vmid, $devicefull);
2535         return undef if !qemu_deviceaddverify($vmid, $deviceid);
2536     }
2537
2538     return 1;
2539 }
2540
2541 sub vm_deviceunplug {
2542     my ($vmid, $conf, $deviceid) = @_;
2543
2544     return 1 if !check_running ($vmid) || !$conf->{hotplug};
2545
2546     my $devices_list = vm_devices_list($vmid);
2547     return 1 if !defined($devices_list->{$deviceid});
2548
2549     die "can't unplug bootdisk" if $conf->{bootdisk} && $conf->{bootdisk} eq $deviceid;
2550
2551     if ($deviceid =~ m/^(virtio)(\d+)$/) {
2552         return undef if !qemu_drivedel($vmid, $deviceid);
2553         qemu_devicedel($vmid, $deviceid);
2554         return undef if !qemu_devicedelverify($vmid, $deviceid);
2555     }
2556
2557     if ($deviceid =~ m/^(lsi)(\d+)$/) {
2558         return undef if !qemu_devicedel($vmid, $deviceid);
2559     }
2560
2561     if ($deviceid =~ m/^(scsi)(\d+)$/) {
2562         return undef if !qemu_devicedel($vmid, $deviceid);
2563         return undef if !qemu_drivedel($vmid, $deviceid);
2564     }
2565
2566     if ($deviceid =~ m/^(net)(\d+)$/) {
2567         return undef if !qemu_netdevdel($vmid, $deviceid);
2568         qemu_devicedel($vmid, $deviceid);
2569         return undef if !qemu_devicedelverify($vmid, $deviceid);
2570     }
2571
2572     return 1;
2573 }
2574
2575 sub qemu_deviceadd {
2576     my ($vmid, $devicefull) = @_;
2577
2578     my $ret = vm_human_monitor_command($vmid, "device_add $devicefull");
2579     $ret =~ s/^\s+//;
2580     # Otherwise, if the command succeeds, no output is sent. So any non-empty string shows an error
2581     return 1 if $ret eq "";
2582     syslog("err", "error on hotplug device : $ret");
2583     return undef;
2584
2585 }
2586
2587 sub qemu_devicedel {
2588     my($vmid, $deviceid) = @_;
2589
2590     my $ret = vm_human_monitor_command($vmid, "device_del $deviceid");
2591     $ret =~ s/^\s+//;
2592     return 1 if $ret eq "";
2593     syslog("err", "detaching device $deviceid failed : $ret");
2594     return undef;
2595 }
2596
2597 sub qemu_driveadd {
2598     my($storecfg, $vmid, $device) = @_;
2599
2600     my $drive = print_drive_full($storecfg, $vmid, $device);
2601     my $ret = vm_human_monitor_command($vmid, "drive_add auto $drive");
2602     # If the command succeeds qemu prints: "OK"
2603     if ($ret !~ m/OK/s) {
2604         syslog("err", "adding drive failed: $ret");
2605         return undef;
2606     }
2607     return 1;
2608 }
2609
2610 sub qemu_drivedel {
2611     my($vmid, $deviceid) = @_;
2612
2613     my $ret = vm_human_monitor_command($vmid, "drive_del drive-$deviceid");
2614     $ret =~ s/^\s+//;
2615     if ($ret =~ m/Device \'.*?\' not found/s) {
2616         # NB: device not found errors mean the drive was auto-deleted and we ignore the error
2617     }
2618     elsif ($ret ne "") {
2619       syslog("err", "deleting drive $deviceid failed : $ret");
2620       return undef;
2621     }
2622     return 1;
2623 }
2624
2625 sub qemu_deviceaddverify {
2626     my ($vmid,$deviceid) = @_;
2627
2628     for (my $i = 0; $i <= 5; $i++) {
2629          my $devices_list = vm_devices_list($vmid);
2630          return 1 if defined($devices_list->{$deviceid});
2631          sleep 1;
2632     }
2633     syslog("err", "error on hotplug device $deviceid");
2634     return undef;
2635 }
2636
2637
2638 sub qemu_devicedelverify {
2639     my ($vmid,$deviceid) = @_;
2640
2641     #need to verify the device is correctly remove as device_del is async and empty return is not reliable
2642     for (my $i = 0; $i <= 5; $i++) {
2643          my $devices_list = vm_devices_list($vmid);
2644          return 1 if !defined($devices_list->{$deviceid});
2645          sleep 1;
2646     }
2647     syslog("err", "error on hot-unplugging device $deviceid");
2648     return undef;
2649 }
2650
2651 sub qemu_findorcreatescsihw {
2652     my ($storecfg, $conf, $vmid, $device) = @_;
2653
2654     my $maxdev = ($conf->{scsihw} && $conf->{scsihw} ne 'lsi') ? 256 : 7;
2655     my $controller = int($device->{index} / $maxdev);
2656     my $scsihwid="scsihw$controller";
2657     my $devices_list = vm_devices_list($vmid);
2658
2659     if(!defined($devices_list->{$scsihwid})) {
2660        return undef if !vm_deviceplug($storecfg, $conf, $vmid, $scsihwid);
2661     }
2662     return 1;
2663 }
2664
2665 sub qemu_bridgeadd {
2666     my ($storecfg, $conf, $vmid, $device) = @_;
2667
2668     my $bridges = {};
2669     my $bridgeid = undef;
2670     print_pci_addr($device, $bridges);
2671
2672     while (my ($k, $v) = each %$bridges) {
2673         $bridgeid = $k;
2674     }
2675     return if $bridgeid < 1;
2676     my $bridge = "pci.$bridgeid";
2677     my $devices_list = vm_devices_list($vmid);
2678
2679     if(!defined($devices_list->{$bridge})) {
2680         return undef if !vm_deviceplug($storecfg, $conf, $vmid, $bridge);
2681     }
2682     return 1;
2683 }
2684
2685 sub qemu_netdevadd {
2686     my ($vmid, $conf, $device, $deviceid) = @_;
2687
2688     my $netdev = print_netdev_full($vmid, $conf, $device, $deviceid);
2689     my $ret = vm_human_monitor_command($vmid, "netdev_add $netdev");
2690     $ret =~ s/^\s+//;
2691
2692     #if the command succeeds, no output is sent. So any non-empty string shows an error
2693     return 1 if $ret eq "";
2694     syslog("err", "adding netdev failed: $ret");
2695     return undef;
2696 }
2697
2698 sub qemu_netdevdel {
2699     my ($vmid, $deviceid) = @_;
2700
2701     my $ret = vm_human_monitor_command($vmid, "netdev_del $deviceid");
2702     $ret =~ s/^\s+//;
2703     #if the command succeeds, no output is sent. So any non-empty string shows an error
2704     return 1 if $ret eq "";
2705     syslog("err", "deleting netdev failed: $ret");
2706     return undef;
2707 }
2708
2709 sub qemu_block_set_io_throttle {
2710     my ($vmid, $deviceid, $bps, $bps_rd, $bps_wr, $iops, $iops_rd, $iops_wr) = @_;
2711
2712     return if !check_running($vmid) ;
2713
2714     $bps = 0 if !$bps;
2715     $bps_rd = 0 if !$bps_rd;
2716     $bps_wr = 0 if !$bps_wr;
2717     $iops = 0 if !$iops;
2718     $iops_rd = 0 if !$iops_rd;
2719     $iops_wr = 0 if !$iops_wr;
2720
2721     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));
2722
2723 }
2724
2725 # old code, only used to shutdown old VM after update
2726 sub __read_avail {
2727     my ($fh, $timeout) = @_;
2728
2729     my $sel = new IO::Select;
2730     $sel->add($fh);
2731
2732     my $res = '';
2733     my $buf;
2734
2735     my @ready;
2736     while (scalar (@ready = $sel->can_read($timeout))) {
2737         my $count;
2738         if ($count = $fh->sysread($buf, 8192)) {
2739             if ($buf =~ /^(.*)\(qemu\) $/s) {
2740                 $res .= $1;
2741                 last;
2742             } else {
2743                 $res .= $buf;
2744             }
2745         } else {
2746             if (!defined($count)) {
2747                 die "$!\n";
2748             }
2749             last;
2750         }
2751     }
2752
2753     die "monitor read timeout\n" if !scalar(@ready);
2754
2755     return $res;
2756 }
2757
2758 # old code, only used to shutdown old VM after update
2759 sub vm_monitor_command {
2760     my ($vmid, $cmdstr, $nocheck) = @_;
2761
2762     my $res;
2763
2764     eval {
2765         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
2766
2767         my $sname = "${var_run_tmpdir}/$vmid.mon";
2768
2769         my $sock = IO::Socket::UNIX->new( Peer => $sname ) ||
2770             die "unable to connect to VM $vmid socket - $!\n";
2771
2772         my $timeout = 3;
2773
2774         # hack: migrate sometime blocks the monitor (when migrate_downtime
2775         # is set)
2776         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2777             $timeout = 60*60; # 1 hour
2778         }
2779
2780         # read banner;
2781         my $data = __read_avail($sock, $timeout);
2782
2783         if ($data !~ m/^QEMU\s+(\S+)\s+monitor\s/) {
2784             die "got unexpected qemu monitor banner\n";
2785         }
2786
2787         my $sel = new IO::Select;
2788         $sel->add($sock);
2789
2790         if (!scalar(my @ready = $sel->can_write($timeout))) {
2791             die "monitor write error - timeout";
2792         }
2793
2794         my $fullcmd = "$cmdstr\r";
2795
2796         # syslog('info', "VM $vmid monitor command: $cmdstr");
2797
2798         my $b;
2799         if (!($b = $sock->syswrite($fullcmd)) || ($b != length($fullcmd))) {
2800             die "monitor write error - $!";
2801         }
2802
2803         return if ($cmdstr eq 'q') || ($cmdstr eq 'quit');
2804
2805         $timeout = 20;
2806
2807         if ($cmdstr =~ m/^(info\s+migrate|migrate\s)/) {
2808             $timeout = 60*60; # 1 hour
2809         } elsif ($cmdstr =~ m/^(eject|change)/) {
2810             $timeout = 60; # note: cdrom mount command is slow
2811         }
2812         if ($res = __read_avail($sock, $timeout)) {
2813
2814             my @lines = split("\r?\n", $res);
2815
2816             shift @lines if $lines[0] !~ m/^unknown command/; # skip echo
2817
2818             $res = join("\n", @lines);
2819             $res .= "\n";
2820         }
2821     };
2822
2823     my $err = $@;
2824
2825     if ($err) {
2826         syslog("err", "VM $vmid monitor command failed - $err");
2827         die $err;
2828     }
2829
2830     return $res;
2831 }
2832
2833 sub qemu_block_resize {
2834     my ($vmid, $deviceid, $storecfg, $volid, $size) = @_;
2835
2836     my $running = PVE::QemuServer::check_running($vmid);
2837
2838     return if !PVE::Storage::volume_resize($storecfg, $volid, $size, $running);
2839
2840     return if !$running;
2841
2842     vm_mon_cmd($vmid, "block_resize", device => $deviceid, size => int($size));
2843
2844 }
2845
2846 sub qemu_volume_snapshot {
2847     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
2848
2849     my $running = PVE::QemuServer::check_running($vmid);
2850
2851     return if !PVE::Storage::volume_snapshot($storecfg, $volid, $snap, $running);
2852
2853     return if !$running;
2854
2855     vm_mon_cmd($vmid, "snapshot-drive", device => $deviceid, name => $snap);
2856
2857 }
2858
2859 sub qemu_volume_snapshot_delete {
2860     my ($vmid, $deviceid, $storecfg, $volid, $snap) = @_;
2861
2862     my $running = PVE::QemuServer::check_running($vmid);
2863
2864     return if !PVE::Storage::volume_snapshot_delete($storecfg, $volid, $snap, $running);
2865
2866     return if !$running;
2867
2868     vm_mon_cmd($vmid, "delete-drive-snapshot", device => $deviceid, name => $snap);
2869 }
2870
2871 sub qga_freezefs {
2872     my ($vmid) = @_;
2873
2874     #need to impplement call to qemu-ga
2875 }
2876
2877 sub qga_unfreezefs {
2878     my ($vmid) = @_;
2879
2880     #need to impplement call to qemu-ga
2881 }
2882
2883 sub vm_start {
2884     my ($storecfg, $vmid, $statefile, $skiplock, $migratedfrom, $paused) = @_;
2885
2886     lock_config($vmid, sub {
2887         my $conf = load_config($vmid, $migratedfrom);
2888
2889         check_lock($conf) if !$skiplock;
2890
2891         die "VM $vmid already running\n" if check_running($vmid, undef, $migratedfrom);
2892
2893         my $defaults = load_defaults();
2894
2895         # set environment variable useful inside network script
2896         $ENV{PVE_MIGRATED_FROM} = $migratedfrom if $migratedfrom;
2897
2898         my ($cmd, $vollist) = config_to_command($storecfg, $vmid, $conf, $defaults);
2899
2900         my $migrate_port = 0;
2901
2902         if ($statefile) {
2903             if ($statefile eq 'tcp') {
2904                 $migrate_port = next_migrate_port();
2905                 my $migrate_uri = "tcp:localhost:${migrate_port}";
2906                 push @$cmd, '-incoming', $migrate_uri;
2907                 push @$cmd, '-S';
2908             } else {
2909                 push @$cmd, '-loadstate', $statefile;
2910             }
2911         } elsif ($paused) {
2912             push @$cmd, '-S';
2913         }
2914
2915         # host pci devices
2916         for (my $i = 0; $i < $MAX_HOSTPCI_DEVICES; $i++)  {
2917           my $d = parse_hostpci($conf->{"hostpci$i"});
2918           next if !$d;
2919           my $info = pci_device_info("0000:$d->{pciid}");
2920           die "IOMMU not present\n" if !check_iommu_support();
2921           die "no pci device info for device '$d->{pciid}'\n" if !$info;
2922           die "can't unbind pci device '$d->{pciid}'\n" if !pci_dev_bind_to_stub($info);
2923           die "can't reset pci device '$d->{pciid}'\n" if !pci_dev_reset($info);
2924         }
2925
2926         PVE::Storage::activate_volumes($storecfg, $vollist);
2927
2928         eval  { run_command($cmd, timeout => $statefile ? undef : 30,
2929                     umask => 0077); };
2930         my $err = $@;
2931         die "start failed: $err" if $err;
2932
2933         print "migration listens on port $migrate_port\n" if $migrate_port;
2934
2935         if ($statefile && $statefile ne 'tcp')  {
2936             eval { vm_mon_cmd($vmid, "cont"); };
2937             warn $@ if $@;
2938         }
2939
2940         # always set migrate speed (overwrite kvm default of 32m)
2941         # we set a very hight default of 8192m which is basically unlimited
2942         my $migrate_speed = $defaults->{migrate_speed} || 8192;
2943         $migrate_speed = $conf->{migrate_speed} || $migrate_speed;
2944         $migrate_speed = $migrate_speed * 1048576;
2945         eval {
2946             vm_mon_cmd($vmid, "migrate_set_speed", value => $migrate_speed);
2947         };
2948
2949         my $migrate_downtime = $defaults->{migrate_downtime};
2950         $migrate_downtime = $conf->{migrate_downtime} if defined($conf->{migrate_downtime});
2951         if (defined($migrate_downtime)) {
2952             eval { vm_mon_cmd($vmid, "migrate_set_downtime", value => $migrate_downtime); };
2953         }
2954
2955         if($migratedfrom) {
2956             my $capabilities = {};
2957             $capabilities->{capability} =  "xbzrle";
2958             $capabilities->{state} = JSON::true;
2959             eval { PVE::QemuServer::vm_mon_cmd_nocheck($vmid, "migrate-set-capabilities", capabilities => [$capabilities]); };
2960         }
2961
2962         vm_balloonset($vmid, $conf->{balloon}) if $conf->{balloon};
2963
2964     });
2965 }
2966
2967 sub vm_mon_cmd {
2968     my ($vmid, $execute, %params) = @_;
2969
2970     my $cmd = { execute => $execute, arguments => \%params };
2971     vm_qmp_command($vmid, $cmd);
2972 }
2973
2974 sub vm_mon_cmd_nocheck {
2975     my ($vmid, $execute, %params) = @_;
2976
2977     my $cmd = { execute => $execute, arguments => \%params };
2978     vm_qmp_command($vmid, $cmd, 1);
2979 }
2980
2981 sub vm_qmp_command {
2982     my ($vmid, $cmd, $nocheck) = @_;
2983
2984     my $res;
2985
2986     my $timeout;
2987     if ($cmd->{arguments} && $cmd->{arguments}->{timeout}) {
2988         $timeout = $cmd->{arguments}->{timeout};
2989         delete $cmd->{arguments}->{timeout};
2990     }
2991
2992     eval {
2993         die "VM $vmid not running\n" if !check_running($vmid, $nocheck);
2994         my $sname = PVE::QemuServer::qmp_socket($vmid);
2995         if (-e $sname) {
2996             my $qmpclient = PVE::QMPClient->new();
2997
2998             $res = $qmpclient->cmd($vmid, $cmd, $timeout);
2999         } elsif (-e "${var_run_tmpdir}/$vmid.mon") {
3000             die "can't execute complex command on old monitor - stop/start your vm to fix the problem\n"
3001                 if scalar(%{$cmd->{arguments}});
3002             vm_monitor_command($vmid, $cmd->{execute}, $nocheck);
3003         } else {
3004             die "unable to open monitor socket\n";
3005         }
3006     };
3007     if (my $err = $@) {
3008         syslog("err", "VM $vmid qmp command failed - $err");
3009         die $err;
3010     }
3011
3012     return $res;
3013 }
3014
3015 sub vm_human_monitor_command {
3016     my ($vmid, $cmdline) = @_;
3017
3018     my $res;
3019
3020     my $cmd = {
3021         execute => 'human-monitor-command',
3022         arguments => { 'command-line' => $cmdline},
3023     };
3024
3025     return vm_qmp_command($vmid, $cmd);
3026 }
3027
3028 sub vm_commandline {
3029     my ($storecfg, $vmid) = @_;
3030
3031     my $conf = load_config($vmid);
3032
3033     my $defaults = load_defaults();
3034
3035     my $cmd = config_to_command($storecfg, $vmid, $conf, $defaults);
3036
3037     return join(' ', @$cmd);
3038 }
3039
3040 sub vm_reset {
3041     my ($vmid, $skiplock) = @_;
3042
3043     lock_config($vmid, sub {
3044
3045         my $conf = load_config($vmid);
3046
3047         check_lock($conf) if !$skiplock;
3048
3049         vm_mon_cmd($vmid, "system_reset");
3050     });
3051 }
3052
3053 sub get_vm_volumes {
3054     my ($conf) = @_;
3055
3056     my $vollist = [];
3057     foreach_volid($conf, sub {
3058         my ($volid, $is_cdrom) = @_;
3059
3060         return if $volid =~ m|^/|;
3061
3062         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
3063         return if !$sid;
3064
3065         push @$vollist, $volid;
3066     });
3067
3068     return $vollist;
3069 }
3070
3071 sub vm_stop_cleanup {
3072     my ($storecfg, $vmid, $conf, $keepActive) = @_;
3073
3074     eval {
3075         fairsched_rmnod($vmid); # try to destroy group
3076
3077         if (!$keepActive) {
3078             my $vollist = get_vm_volumes($conf);
3079             PVE::Storage::deactivate_volumes($storecfg, $vollist);
3080         }
3081
3082         foreach my $ext (qw(mon qmp pid vnc qga)) {
3083             unlink "/var/run/qemu-server/${vmid}.$ext";
3084         }
3085     };
3086     warn $@ if $@; # avoid errors - just warn
3087 }
3088
3089 # Note: use $nockeck to skip tests if VM configuration file exists.
3090 # We need that when migration VMs to other nodes (files already moved)
3091 # Note: we set $keepActive in vzdump stop mode - volumes need to stay active
3092 sub vm_stop {
3093     my ($storecfg, $vmid, $skiplock, $nocheck, $timeout, $shutdown, $force, $keepActive, $migratedfrom) = @_;
3094
3095     $force = 1 if !defined($force) && !$shutdown;
3096
3097     if ($migratedfrom){
3098         my $pid = check_running($vmid, $nocheck, $migratedfrom);
3099         kill 15, $pid if $pid;
3100         my $conf = load_config($vmid, $migratedfrom);
3101         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive);
3102         return;
3103     }
3104
3105     lock_config($vmid, sub {
3106
3107         my $pid = check_running($vmid, $nocheck);
3108         return if !$pid;
3109
3110         my $conf;
3111         if (!$nocheck) {
3112             $conf = load_config($vmid);
3113             check_lock($conf) if !$skiplock;
3114             if (!defined($timeout) && $shutdown && $conf->{startup}) {
3115                 my $opts = parse_startup($conf->{startup});
3116                 $timeout = $opts->{down} if $opts->{down};
3117             }
3118         }
3119
3120         $timeout = 60 if !defined($timeout);
3121
3122         eval {
3123             if ($shutdown) {
3124                 $nocheck ? vm_mon_cmd_nocheck($vmid, "system_powerdown") : vm_mon_cmd($vmid, "system_powerdown");
3125
3126             } else {
3127                 $nocheck ? vm_mon_cmd_nocheck($vmid, "quit") : vm_mon_cmd($vmid, "quit");
3128             }
3129         };
3130         my $err = $@;
3131
3132         if (!$err) {
3133             my $count = 0;
3134             while (($count < $timeout) && check_running($vmid, $nocheck)) {
3135                 $count++;
3136                 sleep 1;
3137             }
3138
3139             if ($count >= $timeout) {
3140                 if ($force) {
3141                     warn "VM still running - terminating now with SIGTERM\n";
3142                     kill 15, $pid;
3143                 } else {
3144                     die "VM quit/powerdown failed - got timeout\n";
3145                 }
3146             } else {
3147                 vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3148                 return;
3149             }
3150         } else {
3151             if ($force) {
3152                 warn "VM quit/powerdown failed - terminating now with SIGTERM\n";
3153                 kill 15, $pid;
3154             } else {
3155                 die "VM quit/powerdown failed\n";
3156             }
3157         }
3158
3159         # wait again
3160         $timeout = 10;
3161
3162         my $count = 0;
3163         while (($count < $timeout) && check_running($vmid, $nocheck)) {
3164             $count++;
3165             sleep 1;
3166         }
3167
3168         if ($count >= $timeout) {
3169             warn "VM still running - terminating now with SIGKILL\n";
3170             kill 9, $pid;
3171             sleep 1;
3172         }
3173
3174         vm_stop_cleanup($storecfg, $vmid, $conf, $keepActive) if $conf;
3175    });
3176 }
3177
3178 sub vm_suspend {
3179     my ($vmid, $skiplock) = @_;
3180
3181     lock_config($vmid, sub {
3182
3183         my $conf = load_config($vmid);
3184
3185         check_lock($conf) if !$skiplock;
3186
3187         vm_mon_cmd($vmid, "stop");
3188     });
3189 }
3190
3191 sub vm_resume {
3192     my ($vmid, $skiplock) = @_;
3193
3194     lock_config($vmid, sub {
3195
3196         my $conf = load_config($vmid);
3197
3198         check_lock($conf) if !$skiplock;
3199
3200         vm_mon_cmd($vmid, "cont");
3201     });
3202 }
3203
3204 sub vm_sendkey {
3205     my ($vmid, $skiplock, $key) = @_;
3206
3207     lock_config($vmid, sub {
3208
3209         my $conf = load_config($vmid);
3210
3211         # there is no qmp command, so we use the human monitor command
3212         vm_human_monitor_command($vmid, "sendkey $key");
3213     });
3214 }
3215
3216 sub vm_destroy {
3217     my ($storecfg, $vmid, $skiplock) = @_;
3218
3219     lock_config($vmid, sub {
3220
3221         my $conf = load_config($vmid);
3222
3223         check_lock($conf) if !$skiplock;
3224
3225         if (!check_running($vmid)) {
3226             fairsched_rmnod($vmid); # try to destroy group
3227             destroy_vm($storecfg, $vmid);
3228         } else {
3229             die "VM $vmid is running - destroy failed\n";
3230         }
3231     });
3232 }
3233
3234 # pci helpers
3235
3236 sub file_write {
3237     my ($filename, $buf) = @_;
3238
3239     my $fh = IO::File->new($filename, "w");
3240     return undef if !$fh;
3241
3242     my $res = print $fh $buf;
3243
3244     $fh->close();
3245
3246     return $res;
3247 }
3248
3249 sub pci_device_info {
3250     my ($name) = @_;
3251
3252     my $res;
3253
3254     return undef if $name !~ m/^([a-f0-9]{4}):([a-f0-9]{2}):([a-f0-9]{2})\.([a-f0-9])$/;
3255     my ($domain, $bus, $slot, $func) = ($1, $2, $3, $4);
3256
3257     my $irq = file_read_firstline("$pcisysfs/devices/$name/irq");
3258     return undef if !defined($irq) || $irq !~ m/^\d+$/;
3259
3260     my $vendor = file_read_firstline("$pcisysfs/devices/$name/vendor");
3261     return undef if !defined($vendor) || $vendor !~ s/^0x//;
3262
3263     my $product = file_read_firstline("$pcisysfs/devices/$name/device");
3264     return undef if !defined($product) || $product !~ s/^0x//;
3265
3266     $res = {
3267         name => $name,
3268         vendor => $vendor,
3269         product => $product,
3270         domain => $domain,
3271         bus => $bus,
3272         slot => $slot,
3273         func => $func,
3274         irq => $irq,
3275         has_fl_reset => -f "$pcisysfs/devices/$name/reset" || 0,
3276     };
3277
3278     return $res;
3279 }
3280
3281 sub pci_dev_reset {
3282     my ($dev) = @_;
3283
3284     my $name = $dev->{name};
3285
3286     my $fn = "$pcisysfs/devices/$name/reset";
3287
3288     return file_write($fn, "1");
3289 }
3290
3291 sub pci_dev_bind_to_stub {
3292     my ($dev) = @_;
3293
3294     my $name = $dev->{name};
3295
3296     my $testdir = "$pcisysfs/drivers/pci-stub/$name";
3297     return 1 if -d $testdir;
3298
3299     my $data = "$dev->{vendor} $dev->{product}";
3300     return undef if !file_write("$pcisysfs/drivers/pci-stub/new_id", $data);
3301
3302     my $fn = "$pcisysfs/devices/$name/driver/unbind";
3303     if (!file_write($fn, $name)) {
3304         return undef if -f $fn;
3305     }
3306
3307     $fn = "$pcisysfs/drivers/pci-stub/bind";
3308     if (! -d $testdir) {
3309         return undef if !file_write($fn, $name);
3310     }
3311
3312     return -d $testdir;
3313 }
3314
3315 sub print_pci_addr {
3316     my ($id, $bridges) = @_;
3317
3318     my $res = '';
3319     my $devices = {
3320         #addr1 : ide,parallel,serial (motherboard)
3321         #addr2 : first videocard
3322         balloon0 => { bus => 0, addr => 3 },
3323         watchdog => { bus => 0, addr => 4 },
3324         scsihw0 => { bus => 0, addr => 5 },
3325         scsihw1 => { bus => 0, addr => 6 },
3326         ahci0 => { bus => 0, addr => 7 },
3327         qga0 => { bus => 0, addr => 8 },
3328         virtio0 => { bus => 0, addr => 10 },
3329         virtio1 => { bus => 0, addr => 11 },
3330         virtio2 => { bus => 0, addr => 12 },
3331         virtio3 => { bus => 0, addr => 13 },
3332         virtio4 => { bus => 0, addr => 14 },
3333         virtio5 => { bus => 0, addr => 15 },
3334         hostpci0 => { bus => 0, addr => 16 },
3335         hostpci1 => { bus => 0, addr => 17 },
3336         net0 => { bus => 0, addr => 18 },
3337         net1 => { bus => 0, addr => 19 },
3338         net2 => { bus => 0, addr => 20 },
3339         net3 => { bus => 0, addr => 21 },
3340         net4 => { bus => 0, addr => 22 },
3341         net5 => { bus => 0, addr => 23 },
3342         #addr29 : usb-host (pve-usb.cfg)
3343         'pci.1' => { bus => 0, addr => 30 },
3344         'pci.2' => { bus => 0, addr => 31 },
3345         'net6' => { bus => 1, addr => 1 },
3346         'net7' => { bus => 1, addr => 2 },
3347         'net8' => { bus => 1, addr => 3 },
3348         'net9' => { bus => 1, addr => 4 },
3349         'net10' => { bus => 1, addr => 5 },
3350         'net11' => { bus => 1, addr => 6 },
3351         'net12' => { bus => 1, addr => 7 },
3352         'net13' => { bus => 1, addr => 8 },
3353         'net14' => { bus => 1, addr => 9 },
3354         'net15' => { bus => 1, addr => 10 },
3355         'net16' => { bus => 1, addr => 11 },
3356         'net17' => { bus => 1, addr => 12 },
3357         'net18' => { bus => 1, addr => 13 },
3358         'net19' => { bus => 1, addr => 14 },
3359         'net20' => { bus => 1, addr => 15 },
3360         'net21' => { bus => 1, addr => 16 },
3361         'net22' => { bus => 1, addr => 17 },
3362         'net23' => { bus => 1, addr => 18 },
3363         'net24' => { bus => 1, addr => 19 },
3364         'net25' => { bus => 1, addr => 20 },
3365         'net26' => { bus => 1, addr => 21 },
3366         'net27' => { bus => 1, addr => 22 },
3367         'net28' => { bus => 1, addr => 23 },
3368         'net29' => { bus => 1, addr => 24 },
3369         'net30' => { bus => 1, addr => 25 },
3370         'net31' => { bus => 1, addr => 26 },
3371         'virtio6' => { bus => 2, addr => 1 },
3372         'virtio7' => { bus => 2, addr => 2 },
3373         'virtio8' => { bus => 2, addr => 3 },
3374         'virtio9' => { bus => 2, addr => 4 },
3375         'virtio10' => { bus => 2, addr => 5 },
3376         'virtio11' => { bus => 2, addr => 6 },
3377         'virtio12' => { bus => 2, addr => 7 },
3378         'virtio13' => { bus => 2, addr => 8 },
3379         'virtio14' => { bus => 2, addr => 9 },
3380         'virtio15' => { bus => 2, addr => 10 },
3381     };
3382
3383     if (defined($devices->{$id}->{bus}) && defined($devices->{$id}->{addr})) {
3384            my $addr = sprintf("0x%x", $devices->{$id}->{addr});
3385            my $bus = $devices->{$id}->{bus};
3386            $res = ",bus=pci.$bus,addr=$addr";
3387            $bridges->{$bus} = 1 if $bridges;
3388     }
3389     return $res;
3390
3391 }
3392
3393 sub vm_balloonset {
3394     my ($vmid, $value) = @_;
3395
3396     vm_mon_cmd($vmid, "balloon", value => $value*1024*1024);
3397 }
3398
3399 # vzdump restore implementaion
3400
3401 sub archive_read_firstfile {
3402     my $archive = shift;
3403
3404     die "ERROR: file '$archive' does not exist\n" if ! -f $archive;
3405
3406     # try to detect archive type first
3407     my $pid = open (TMP, "tar tf '$archive'|") ||
3408         die "unable to open file '$archive'\n";
3409     my $firstfile = <TMP>;
3410     kill 15, $pid;
3411     close TMP;
3412
3413     die "ERROR: archive contaions no data\n" if !$firstfile;
3414     chomp $firstfile;
3415
3416     return $firstfile;
3417 }
3418
3419 sub restore_cleanup {
3420     my $statfile = shift;
3421
3422     print STDERR "starting cleanup\n";
3423
3424     if (my $fd = IO::File->new($statfile, "r")) {
3425         while (defined(my $line = <$fd>)) {
3426             if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3427                 my $volid = $2;
3428                 eval {
3429                     if ($volid =~ m|^/|) {
3430                         unlink $volid || die 'unlink failed\n';
3431                     } else {
3432                         my $cfg = cfs_read_file('storage.cfg');
3433                         PVE::Storage::vdisk_free($cfg, $volid);
3434                     }
3435                     print STDERR "temporary volume '$volid' sucessfuly removed\n";
3436                 };
3437                 print STDERR "unable to cleanup '$volid' - $@" if $@;
3438             } else {
3439                 print STDERR "unable to parse line in statfile - $line";
3440             }
3441         }
3442         $fd->close();
3443     }
3444 }
3445
3446 sub restore_archive {
3447     my ($archive, $vmid, $user, $opts) = @_;
3448
3449     my $format = $opts->{format};
3450     my $comp;
3451
3452     if ($archive =~ m/\.tgz$/ || $archive =~ m/\.tar\.gz$/) {
3453         $format = 'tar' if !$format;
3454         $comp = 'gzip';
3455     } elsif ($archive =~ m/\.tar$/) {
3456         $format = 'tar' if !$format;
3457     } elsif ($archive =~ m/.tar.lzo$/) {
3458         $format = 'tar' if !$format;
3459         $comp = 'lzop';
3460     } elsif ($archive =~ m/\.vma$/) {
3461         $format = 'vma' if !$format;
3462     } elsif ($archive =~ m/\.vma\.gz$/) {
3463         $format = 'vma' if !$format;
3464         $comp = 'gzip';
3465     } elsif ($archive =~ m/\.vma\.lzo$/) {
3466         $format = 'vma' if !$format;
3467         $comp = 'lzop';
3468     } else {
3469         $format = 'vma' if !$format; # default
3470     }
3471
3472     # try to detect archive format
3473     if ($format eq 'tar') {
3474         return restore_tar_archive($archive, $vmid, $user, $opts);
3475     } else {
3476         return restore_vma_archive($archive, $vmid, $user, $opts, $comp);
3477     }
3478 }
3479
3480 sub restore_update_config_line {
3481     my ($outfd, $cookie, $vmid, $map, $line, $unique) = @_;
3482
3483     return if $line =~ m/^\#qmdump\#/;
3484     return if $line =~ m/^\#vzdump\#/;
3485     return if $line =~ m/^lock:/;
3486     return if $line =~ m/^unused\d+:/;
3487     return if $line =~ m/^parent:/;
3488
3489     if (($line =~ m/^(vlan(\d+)):\s*(\S+)\s*$/)) {
3490         # try to convert old 1.X settings
3491         my ($id, $ind, $ethcfg) = ($1, $2, $3);
3492         foreach my $devconfig (PVE::Tools::split_list($ethcfg)) {
3493             my ($model, $macaddr) = split(/\=/, $devconfig);
3494             $macaddr = PVE::Tools::random_ether_addr() if !$macaddr || $unique;
3495             my $net = {
3496                 model => $model,
3497                 bridge => "vmbr$ind",
3498                 macaddr => $macaddr,
3499             };
3500             my $netstr = print_net($net);
3501
3502             print $outfd "net$cookie->{netcount}: $netstr\n";
3503             $cookie->{netcount}++;
3504         }
3505     } elsif (($line =~ m/^(net\d+):\s*(\S+)\s*$/) && $unique) {
3506         my ($id, $netstr) = ($1, $2);
3507         my $net = parse_net($netstr);
3508         $net->{macaddr} = PVE::Tools::random_ether_addr() if $net->{macaddr};
3509         $netstr = print_net($net);
3510         print $outfd "$id: $netstr\n";
3511     } elsif ($line =~ m/^((ide|scsi|virtio|sata)\d+):\s*(\S+)\s*$/) {
3512         my $virtdev = $1;
3513         my $value = $2;
3514         if ($line =~ m/backup=no/) {
3515             print $outfd "#$line";
3516         } elsif ($virtdev && $map->{$virtdev}) {
3517             my $di = PVE::QemuServer::parse_drive($virtdev, $value);
3518             $di->{file} = $map->{$virtdev};
3519             $value = PVE::QemuServer::print_drive($vmid, $di);
3520             print $outfd "$virtdev: $value\n";
3521         } else {
3522             print $outfd $line;
3523         }
3524     } else {
3525         print $outfd $line;
3526     }
3527 }
3528
3529 sub scan_volids {
3530     my ($cfg, $vmid) = @_;
3531
3532     my $info = PVE::Storage::vdisk_list($cfg, undef, $vmid);
3533
3534     my $volid_hash = {};
3535     foreach my $storeid (keys %$info) {
3536         foreach my $item (@{$info->{$storeid}}) {
3537             next if !($item->{volid} && $item->{size});
3538             $volid_hash->{$item->{volid}} = $item;
3539         }
3540     }
3541
3542     return $volid_hash;
3543 }
3544
3545 sub update_disksize {
3546     my ($vmid, $conf, $volid_hash) = @_;
3547
3548     my $changes;
3549
3550     my $used = {};
3551
3552     # update size info
3553     foreach my $opt (keys %$conf) {
3554         if (PVE::QemuServer::valid_drivename($opt)) {
3555             my $drive = PVE::QemuServer::parse_drive($opt, $conf->{$opt});
3556             my $volid = $drive->{file};
3557             next if !$volid;
3558
3559             $used->{$volid} = 1;
3560
3561             next if PVE::QemuServer::drive_is_cdrom($drive);
3562             next if !$volid_hash->{$volid};
3563
3564             $drive->{size} = $volid_hash->{$volid}->{size};
3565             $changes = 1;
3566             $conf->{$opt} = PVE::QemuServer::print_drive($vmid, $drive);
3567         }
3568     }
3569
3570     foreach my $volid (sort keys %$volid_hash) {
3571         next if $volid =~ m/vm-$vmid-state-/;
3572         next if $used->{$volid};
3573         $changes = 1;
3574         PVE::QemuServer::add_unused_volume($conf, $volid);
3575     }
3576
3577     return $changes;
3578 }
3579
3580 sub rescan {
3581     my ($vmid, $nolock) = @_;
3582
3583     my $cfg = PVE::Cluster::cfs_read_file("storage.cfg");
3584
3585     my $volid_hash = scan_volids($cfg, $vmid);
3586
3587     my $updatefn =  sub {
3588         my ($vmid) = @_;
3589
3590         my $conf = PVE::QemuServer::load_config($vmid);
3591
3592         PVE::QemuServer::check_lock($conf);
3593
3594         my $changes = PVE::QemuServer::update_disksize($vmid, $conf, $volid_hash);
3595
3596         PVE::QemuServer::update_config_nolock($vmid, $conf, 1) if $changes;
3597     };
3598
3599     if (defined($vmid)) {
3600         if ($nolock) {
3601             &$updatefn($vmid);
3602         } else {
3603             PVE::QemuServer::lock_config($vmid, $updatefn, $vmid);
3604         }
3605     } else {
3606         my $vmlist = config_list();
3607         foreach my $vmid (keys %$vmlist) {
3608             if ($nolock) {
3609                 &$updatefn($vmid);
3610             } else {
3611                 PVE::QemuServer::lock_config($vmid, $updatefn, $vmid);
3612             }
3613         }
3614     }
3615 }
3616
3617 sub restore_vma_archive {
3618     my ($archive, $vmid, $user, $opts, $comp) = @_;
3619
3620     my $input = $archive eq '-' ? "<&STDIN" : undef;
3621     my $readfrom = $archive;
3622
3623     my $uncomp = '';
3624     if ($comp) {
3625         $readfrom = '-';
3626         my $qarchive = PVE::Tools::shellquote($archive);
3627         if ($comp eq 'gzip') {
3628             $uncomp = "zcat $qarchive|";
3629         } elsif ($comp eq 'lzop') {
3630             $uncomp = "lzop -d -c $qarchive|";
3631         } else {
3632             die "unknown compression method '$comp'\n";
3633         }
3634
3635     }
3636
3637     my $tmpdir = "/var/tmp/vzdumptmp$$";
3638     rmtree $tmpdir;
3639
3640     # disable interrupts (always do cleanups)
3641     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
3642         warn "got interrupt - ignored\n";
3643     };
3644
3645     my $mapfifo = "/var/tmp/vzdumptmp$$.fifo";
3646     POSIX::mkfifo($mapfifo, 0600);
3647     my $fifofh;
3648
3649     my $openfifo = sub {
3650         open($fifofh, '>', $mapfifo) || die $!;
3651     };
3652
3653     my $cmd = "${uncomp}vma extract -v -r $mapfifo $readfrom $tmpdir";
3654
3655     my $oldtimeout;
3656     my $timeout = 5;
3657
3658     my $devinfo = {};
3659
3660     my $rpcenv = PVE::RPCEnvironment::get();
3661
3662     my $conffile = PVE::QemuServer::config_file($vmid);
3663     my $tmpfn = "$conffile.$$.tmp";
3664
3665     my $print_devmap = sub {
3666         my $virtdev_hash = {};
3667
3668         my $cfgfn = "$tmpdir/qemu-server.conf";
3669
3670         # we can read the config - that is already extracted
3671         my $fh = IO::File->new($cfgfn, "r") ||
3672             "unable to read qemu-server.conf - $!\n";
3673
3674         while (defined(my $line = <$fh>)) {
3675             if ($line =~ m/^\#qmdump\#map:(\S+):(\S+):(\S*):(\S*):$/) {
3676                 my ($virtdev, $devname, $storeid, $format) = ($1, $2, $3, $4);
3677                 die "archive does not contain data for drive '$virtdev'\n"
3678                     if !$devinfo->{$devname};
3679                 if (defined($opts->{storage})) {
3680                     $storeid = $opts->{storage} || 'local';
3681                 } elsif (!$storeid) {
3682                     $storeid = 'local';
3683                 }
3684                 $format = 'raw' if !$format;
3685                 $devinfo->{$devname}->{devname} = $devname;
3686                 $devinfo->{$devname}->{virtdev} = $virtdev;
3687                 $devinfo->{$devname}->{format} = $format;
3688                 $devinfo->{$devname}->{storeid} = $storeid;
3689
3690                 # check permission on storage
3691                 my $pool = $opts->{pool}; # todo: do we need that?
3692                 if ($user ne 'root@pam') {
3693                     $rpcenv->check($user, "/storage/$storeid", ['Datastore.AllocateSpace']);
3694                 }
3695
3696                 $virtdev_hash->{$virtdev} = $devinfo->{$devname};
3697             }
3698         }
3699
3700         foreach my $devname (keys %$devinfo) {
3701             die "found no device mapping information for device '$devname'\n"
3702                 if !$devinfo->{$devname}->{virtdev};
3703         }
3704
3705         my $map = {};
3706         my $cfg = cfs_read_file('storage.cfg');
3707         foreach my $virtdev (sort keys %$virtdev_hash) {
3708             my $d = $virtdev_hash->{$virtdev};
3709             my $alloc_size = int(($d->{size} + 1024 - 1)/1024);
3710             my $scfg = PVE::Storage::storage_config($cfg, $d->{storeid});
3711             my $volid = PVE::Storage::vdisk_alloc($cfg, $d->{storeid}, $vmid,
3712                                                   $d->{format}, undef, $alloc_size);
3713             print STDERR "new volume ID is '$volid'\n";
3714             $d->{volid} = $volid;
3715             my $path = PVE::Storage::path($cfg, $volid);
3716
3717             my $write_zeros = 1;
3718             # fixme: what other storages types initialize volumes with zero?
3719             if ($scfg->{type} eq 'dir' || $scfg->{type} eq 'nfs') {
3720                 $write_zeros = 0;
3721             }
3722
3723             print $fifofh "${write_zeros}:$d->{devname}=$path\n";
3724
3725             print "map '$d->{devname}' to '$path' (write zeros = ${write_zeros})\n";
3726             $map->{$virtdev} = $volid;
3727         }
3728
3729         $fh->seek(0, 0) || die "seek failed - $!\n";
3730
3731         my $outfd = new IO::File ($tmpfn, "w") ||
3732             die "unable to write config for VM $vmid\n";
3733
3734         my $cookie = { netcount => 0 };
3735         while (defined(my $line = <$fh>)) {
3736             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
3737         }
3738
3739         $fh->close();
3740         $outfd->close();
3741     };
3742
3743     eval {
3744         # enable interrupts
3745         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
3746             die "interrupted by signal\n";
3747         };
3748         local $SIG{ALRM} = sub { die "got timeout\n"; };
3749
3750         $oldtimeout = alarm($timeout);
3751
3752         my $parser = sub {
3753             my $line = shift;
3754
3755             print "$line\n";
3756
3757             if ($line =~ m/^DEV:\sdev_id=(\d+)\ssize:\s(\d+)\sdevname:\s(\S+)$/) {
3758                 my ($dev_id, $size, $devname) = ($1, $2, $3);
3759                 $devinfo->{$devname} = { size => $size, dev_id => $dev_id };
3760             } elsif ($line =~ m/^CTIME: /) {
3761                 &$print_devmap();
3762                 print $fifofh "done\n";
3763                 my $tmp = $oldtimeout || 0;
3764                 $oldtimeout = undef;
3765                 alarm($tmp);
3766                 close($fifofh);
3767             }
3768         };
3769
3770         print "restore vma archive: $cmd\n";
3771         run_command($cmd, input => $input, outfunc => $parser, afterfork => $openfifo);
3772     };
3773     my $err = $@;
3774
3775     alarm($oldtimeout) if $oldtimeout;
3776
3777     unlink $mapfifo;
3778
3779     if ($err) {
3780         rmtree $tmpdir;
3781         unlink $tmpfn;
3782
3783         my $cfg = cfs_read_file('storage.cfg');
3784         foreach my $devname (keys %$devinfo) {
3785             my $volid = $devinfo->{$devname}->{volid};
3786             next if !$volid;
3787             eval {
3788                 if ($volid =~ m|^/|) {
3789                     unlink $volid || die 'unlink failed\n';
3790                 } else {
3791                     PVE::Storage::vdisk_free($cfg, $volid);
3792                 }
3793                 print STDERR "temporary volume '$volid' sucessfuly removed\n";
3794             };
3795             print STDERR "unable to cleanup '$volid' - $@" if $@;
3796         }
3797         die $err;
3798     }
3799
3800     rmtree $tmpdir;
3801
3802     rename $tmpfn, $conffile ||
3803         die "unable to commit configuration file '$conffile'\n";
3804
3805     eval { rescan($vmid, 1); };
3806     warn $@ if $@;
3807 }
3808
3809 sub restore_tar_archive {
3810     my ($archive, $vmid, $user, $opts) = @_;
3811
3812     if ($archive ne '-') {
3813         my $firstfile = archive_read_firstfile($archive);
3814         die "ERROR: file '$archive' dos not lock like a QemuServer vzdump backup\n"
3815             if $firstfile ne 'qemu-server.conf';
3816     }
3817
3818     my $tocmd = "/usr/lib/qemu-server/qmextract";
3819
3820     $tocmd .= " --storage " . PVE::Tools::shellquote($opts->{storage}) if $opts->{storage};
3821     $tocmd .= " --pool " . PVE::Tools::shellquote($opts->{pool}) if $opts->{pool};
3822     $tocmd .= ' --prealloc' if $opts->{prealloc};
3823     $tocmd .= ' --info' if $opts->{info};
3824
3825     # tar option "xf" does not autodetect compression when read from STDIN,
3826     # so we pipe to zcat
3827     my $cmd = "zcat -f|tar xf " . PVE::Tools::shellquote($archive) . " " .
3828         PVE::Tools::shellquote("--to-command=$tocmd");
3829
3830     my $tmpdir = "/var/tmp/vzdumptmp$$";
3831     mkpath $tmpdir;
3832
3833     local $ENV{VZDUMP_TMPDIR} = $tmpdir;
3834     local $ENV{VZDUMP_VMID} = $vmid;
3835     local $ENV{VZDUMP_USER} = $user;
3836
3837     my $conffile = PVE::QemuServer::config_file($vmid);
3838     my $tmpfn = "$conffile.$$.tmp";
3839
3840     # disable interrupts (always do cleanups)
3841     local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = sub {
3842         print STDERR "got interrupt - ignored\n";
3843     };
3844
3845     eval {
3846         # enable interrupts
3847         local $SIG{INT} = $SIG{TERM} = $SIG{QUIT} = $SIG{HUP} = $SIG{PIPE} = sub {
3848             die "interrupted by signal\n";
3849         };
3850
3851         if ($archive eq '-') {
3852             print "extracting archive from STDIN\n";
3853             run_command($cmd, input => "<&STDIN");
3854         } else {
3855             print "extracting archive '$archive'\n";
3856             run_command($cmd);
3857         }
3858
3859         return if $opts->{info};
3860
3861         # read new mapping
3862         my $map = {};
3863         my $statfile = "$tmpdir/qmrestore.stat";
3864         if (my $fd = IO::File->new($statfile, "r")) {
3865             while (defined (my $line = <$fd>)) {
3866                 if ($line =~ m/vzdump:([^\s:]*):(\S+)$/) {
3867                     $map->{$1} = $2 if $1;
3868                 } else {
3869                     print STDERR "unable to parse line in statfile - $line\n";
3870                 }
3871             }
3872             $fd->close();
3873         }
3874
3875         my $confsrc = "$tmpdir/qemu-server.conf";
3876
3877         my $srcfd = new IO::File($confsrc, "r") ||
3878             die "unable to open file '$confsrc'\n";
3879
3880         my $outfd = new IO::File ($tmpfn, "w") ||
3881             die "unable to write config for VM $vmid\n";
3882
3883         my $cookie = { netcount => 0 };
3884         while (defined (my $line = <$srcfd>)) {
3885             restore_update_config_line($outfd, $cookie, $vmid, $map, $line, $opts->{unique});
3886         }
3887
3888         $srcfd->close();
3889         $outfd->close();
3890     };
3891     my $err = $@;
3892
3893     if ($err) {
3894
3895         unlink $tmpfn;
3896
3897         restore_cleanup("$tmpdir/qmrestore.stat") if !$opts->{info};
3898
3899         die $err;
3900     }
3901
3902     rmtree $tmpdir;
3903
3904     rename $tmpfn, $conffile ||
3905         die "unable to commit configuration file '$conffile'\n";
3906
3907     eval { rescan($vmid, 1); };
3908     warn $@ if $@;
3909 };
3910
3911
3912 # Internal snapshots
3913
3914 # NOTE: Snapshot create/delete involves several non-atomic
3915 # action, and can take a long time.
3916 # So we try to avoid locking the file and use 'lock' variable
3917 # inside the config file instead.
3918
3919 my $snapshot_copy_config = sub {
3920     my ($source, $dest) = @_;
3921
3922     foreach my $k (keys %$source) {
3923         next if $k eq 'snapshots';
3924         next if $k eq 'snapstate';
3925         next if $k eq 'snaptime';
3926         next if $k eq 'vmstate';
3927         next if $k eq 'lock';
3928         next if $k eq 'digest';
3929         next if $k eq 'description';
3930         next if $k =~ m/^unused\d+$/;
3931
3932         $dest->{$k} = $source->{$k};
3933     }
3934 };
3935
3936 my $snapshot_apply_config = sub {
3937     my ($conf, $snap) = @_;
3938
3939     # copy snapshot list
3940     my $newconf = {
3941         snapshots => $conf->{snapshots},
3942     };
3943
3944     # keep description and list of unused disks
3945     foreach my $k (keys %$conf) {
3946         next if !($k =~ m/^unused\d+$/ || $k eq 'description');
3947         $newconf->{$k} = $conf->{$k};
3948     }
3949
3950     &$snapshot_copy_config($snap, $newconf);
3951
3952     return $newconf;
3953 };
3954
3955 sub foreach_writable_storage {
3956     my ($conf, $func) = @_;
3957
3958     my $sidhash = {};
3959
3960     foreach my $ds (keys %$conf) {
3961         next if !valid_drivename($ds);
3962
3963         my $drive = parse_drive($ds, $conf->{$ds});
3964         next if !$drive;
3965         next if drive_is_cdrom($drive);
3966
3967         my $volid = $drive->{file};
3968
3969         my ($sid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
3970         $sidhash->{$sid} = $sid if $sid;
3971     }
3972
3973     foreach my $sid (sort keys %$sidhash) {
3974         &$func($sid);
3975     }
3976 }
3977
3978 my $alloc_vmstate_volid = sub {
3979     my ($storecfg, $vmid, $conf, $snapname) = @_;
3980
3981     # Note: we try to be smart when selecting a $target storage
3982
3983     my $target;
3984
3985     # search shared storage first
3986     foreach_writable_storage($conf, sub {
3987         my ($sid) = @_;
3988         my $scfg = PVE::Storage::storage_config($storecfg, $sid);
3989         return if !$scfg->{shared};
3990
3991         $target = $sid if !$target || $scfg->{path}; # prefer file based storage
3992     });
3993
3994     if (!$target) {
3995         # now search local storage
3996         foreach_writable_storage($conf, sub {
3997             my ($sid) = @_;
3998             my $scfg = PVE::Storage::storage_config($storecfg, $sid);
3999             return if $scfg->{shared};
4000
4001             $target = $sid if !$target || $scfg->{path}; # prefer file based storage;
4002         });
4003     }
4004
4005     $target = 'local' if !$target;
4006
4007     my $driver_state_size = 500; # assume 32MB is enough to safe all driver state;
4008     # we abort live save after $conf->{memory}, so we need at max twice that space
4009     my $size = $conf->{memory}*2 + $driver_state_size;
4010
4011     my $name = "vm-$vmid-state-$snapname";
4012     my $scfg = PVE::Storage::storage_config($storecfg, $target);
4013     $name .= ".raw" if $scfg->{path}; # add filename extension for file base storage
4014     my $volid = PVE::Storage::vdisk_alloc($storecfg, $target, $vmid, 'raw', $name, $size*1024);
4015
4016     return $volid;
4017 };
4018
4019 my $snapshot_prepare = sub {
4020     my ($vmid, $snapname, $save_vmstate, $comment) = @_;
4021
4022     my $snap;
4023
4024     my $updatefn =  sub {
4025
4026         my $conf = load_config($vmid);
4027
4028         check_lock($conf);
4029
4030         $conf->{lock} = 'snapshot';
4031
4032         die "snapshot name '$snapname' already used\n"
4033             if defined($conf->{snapshots}->{$snapname});
4034
4035         my $storecfg = PVE::Storage::config();
4036
4037         foreach_drive($conf, sub {
4038             my ($ds, $drive) = @_;
4039
4040             return if drive_is_cdrom($drive);
4041             my $volid = $drive->{file};
4042
4043             my ($storeid, $volname) = PVE::Storage::parse_volume_id($volid, 1);
4044             if ($storeid) {
4045                 my $scfg = PVE::Storage::storage_config($storecfg, $storeid);
4046                 die "can't snapshot volume '$volid'\n"
4047                     if !(($scfg->{path} && $volname =~ m/\.qcow2$/) ||
4048                          ($scfg->{type} eq 'nexenta') ||
4049                          ($scfg->{type} eq 'rbd') ||
4050                          ($scfg->{type} eq 'sheepdog'));
4051             } elsif ($volid =~ m|^(/.+)$| && -e $volid) {
4052                 die "snapshot device '$volid' is not possible\n";
4053             } else {
4054                 die "can't snapshot volume '$volid'\n";
4055             }
4056         });
4057
4058
4059         $snap = $conf->{snapshots}->{$snapname} = {};
4060
4061         if ($save_vmstate && check_running($vmid)) {
4062             $snap->{vmstate} = &$alloc_vmstate_volid($storecfg, $vmid, $conf, $snapname);
4063         }
4064
4065         &$snapshot_copy_config($conf, $snap);
4066
4067         $snap->{snapstate} = "prepare";
4068         $snap->{snaptime} = time();
4069         $snap->{description} = $comment if $comment;
4070
4071         update_config_nolock($vmid, $conf, 1);
4072     };
4073
4074     lock_config($vmid, $updatefn);
4075
4076     return $snap;
4077 };
4078
4079 my $snapshot_commit = sub {
4080     my ($vmid, $snapname) = @_;
4081
4082     my $updatefn = sub {
4083
4084         my $conf = load_config($vmid);
4085
4086         die "missing snapshot lock\n"
4087             if !($conf->{lock} && $conf->{lock} eq 'snapshot');
4088
4089         my $snap = $conf->{snapshots}->{$snapname};
4090
4091         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4092
4093         die "wrong snapshot state\n"
4094             if !($snap->{snapstate} && $snap->{snapstate} eq "prepare");
4095
4096         delete $snap->{snapstate};
4097         delete $conf->{lock};
4098
4099         my $newconf = &$snapshot_apply_config($conf, $snap);
4100
4101         $newconf->{parent} = $snapname;
4102
4103         update_config_nolock($vmid, $newconf, 1);
4104     };
4105
4106     lock_config($vmid, $updatefn);
4107 };
4108
4109 sub snapshot_rollback {
4110     my ($vmid, $snapname) = @_;
4111
4112     my $snap;
4113
4114     my $prepare = 1;
4115
4116     my $storecfg = PVE::Storage::config();
4117
4118     my $updatefn = sub {
4119
4120         my $conf = load_config($vmid);
4121
4122         $snap = $conf->{snapshots}->{$snapname};
4123
4124         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4125
4126         die "unable to rollback to incomplete snapshot (snapstate = $snap->{snapstate})\n"
4127             if $snap->{snapstate};
4128
4129         if ($prepare) {
4130             check_lock($conf);
4131             vm_stop($storecfg, $vmid, undef, undef, 5, undef, undef);
4132         }
4133
4134         die "unable to rollback vm $vmid: vm is running\n"
4135             if check_running($vmid);
4136
4137         if ($prepare) {
4138             $conf->{lock} = 'rollback';
4139         } else {
4140             die "got wrong lock\n" if !($conf->{lock} && $conf->{lock} eq 'rollback');
4141             delete $conf->{lock};
4142         }
4143
4144         if (!$prepare) {
4145             # copy snapshot config to current config
4146             $conf = &$snapshot_apply_config($conf, $snap);
4147             $conf->{parent} = $snapname;
4148         }
4149
4150         update_config_nolock($vmid, $conf, 1);
4151
4152         if (!$prepare && $snap->{vmstate}) {
4153             my $statefile = PVE::Storage::path($storecfg, $snap->{vmstate});
4154             vm_start($storecfg, $vmid, $statefile);
4155         }
4156     };
4157
4158     lock_config($vmid, $updatefn);
4159
4160     foreach_drive($snap, sub {
4161         my ($ds, $drive) = @_;
4162
4163         return if drive_is_cdrom($drive);
4164
4165         my $volid = $drive->{file};
4166         my $device = "drive-$ds";
4167
4168         PVE::Storage::volume_snapshot_rollback($storecfg, $volid, $snapname);
4169     });
4170
4171     $prepare = 0;
4172     lock_config($vmid, $updatefn);
4173 }
4174
4175 my $savevm_wait = sub {
4176     my ($vmid) = @_;
4177
4178     for(;;) {
4179         my $stat = PVE::QemuServer::vm_mon_cmd_nocheck($vmid, "query-savevm");
4180         if (!$stat->{status}) {
4181             die "savevm not active\n";
4182         } elsif ($stat->{status} eq 'active') {
4183             sleep(1);
4184             next;
4185         } elsif ($stat->{status} eq 'completed') {
4186             last;
4187         } else {
4188             die "query-savevm returned status '$stat->{status}'\n";
4189         }
4190     }
4191 };
4192
4193 sub snapshot_create {
4194     my ($vmid, $snapname, $save_vmstate, $freezefs, $comment) = @_;
4195
4196     my $snap = &$snapshot_prepare($vmid, $snapname, $save_vmstate, $comment);
4197
4198     $freezefs = $save_vmstate = 0 if !$snap->{vmstate}; # vm is not running
4199
4200     my $drivehash = {};
4201
4202     my $running = check_running($vmid);
4203
4204     eval {
4205         # create internal snapshots of all drives
4206
4207         my $storecfg = PVE::Storage::config();
4208
4209         if ($running) {
4210             if ($snap->{vmstate}) {
4211                 my $path = PVE::Storage::path($storecfg, $snap->{vmstate});
4212                 vm_mon_cmd($vmid, "savevm-start", statefile => $path);
4213                 &$savevm_wait($vmid);
4214             } else {
4215                 vm_mon_cmd($vmid, "savevm-start");
4216             }
4217         };
4218
4219         qga_freezefs($vmid) if $running && $freezefs;
4220
4221         foreach_drive($snap, sub {
4222             my ($ds, $drive) = @_;
4223
4224             return if drive_is_cdrom($drive);
4225
4226             my $volid = $drive->{file};
4227             my $device = "drive-$ds";
4228
4229             qemu_volume_snapshot($vmid, $device, $storecfg, $volid, $snapname);
4230             $drivehash->{$ds} = 1;
4231        });
4232     };
4233     my $err = $@;
4234
4235     eval { gqa_unfreezefs($vmid) if $running && $freezefs; };
4236     warn $@ if $@;
4237
4238     eval { vm_mon_cmd($vmid, "savevm-end") if $running; };
4239     warn $@ if $@;
4240
4241     if ($err) {
4242         warn "snapshot create failed: starting cleanup\n";
4243         eval { snapshot_delete($vmid, $snapname, 0, $drivehash); };
4244         warn $@ if $@;
4245         die $err;
4246     }
4247
4248     &$snapshot_commit($vmid, $snapname);
4249 }
4250
4251 # Note: $drivehash is only set when called from snapshot_create.
4252 sub snapshot_delete {
4253     my ($vmid, $snapname, $force, $drivehash) = @_;
4254
4255     my $prepare = 1;
4256
4257     my $snap;
4258     my $unused = [];
4259
4260     my $unlink_parent = sub {
4261         my ($confref, $new_parent) = @_;
4262
4263         if ($confref->{parent} && $confref->{parent} eq $snapname) {
4264             if ($new_parent) {
4265                 $confref->{parent} = $new_parent;
4266             } else {
4267                 delete $confref->{parent};
4268             }
4269         }
4270     };
4271
4272     my $updatefn =  sub {
4273         my ($remove_drive) = @_;
4274
4275         my $conf = load_config($vmid);
4276
4277         check_lock($conf) if !$drivehash;
4278
4279         $snap = $conf->{snapshots}->{$snapname};
4280
4281         die "snapshot '$snapname' does not exist\n" if !defined($snap);
4282
4283         # remove parent refs
4284         &$unlink_parent($conf, $snap->{parent});
4285         foreach my $sn (keys %{$conf->{snapshots}}) {
4286             next if $sn eq $snapname;
4287             &$unlink_parent($conf->{snapshots}->{$sn}, $snap->{parent});
4288         }
4289
4290         if ($remove_drive) {
4291             if ($remove_drive eq 'vmstate') {
4292                 delete $snap->{$remove_drive};
4293             } else {
4294                 my $drive = parse_drive($remove_drive, $snap->{$remove_drive});
4295                 my $volid = $drive->{file};
4296                 delete $snap->{$remove_drive};
4297                 add_unused_volume($conf, $volid);
4298             }
4299         }
4300
4301         if ($prepare) {
4302             $snap->{snapstate} = 'delete';
4303         } else {
4304             delete $conf->{snapshots}->{$snapname};
4305             delete $conf->{lock} if $drivehash;
4306             foreach my $volid (@$unused) {
4307                 add_unused_volume($conf, $volid);
4308             }
4309         }
4310
4311         update_config_nolock($vmid, $conf, 1);
4312     };
4313
4314     lock_config($vmid, $updatefn);
4315
4316     # now remove vmstate file
4317
4318     my $storecfg = PVE::Storage::config();
4319
4320     if ($snap->{vmstate}) {
4321         eval {  PVE::Storage::vdisk_free($storecfg, $snap->{vmstate}); };
4322         if (my $err = $@) {
4323             die $err if !$force;
4324             warn $err;
4325         }
4326         # save changes (remove vmstate from snapshot)
4327         lock_config($vmid, $updatefn, 'vmstate') if !$force;
4328     };
4329
4330     # now remove all internal snapshots
4331     foreach_drive($snap, sub {
4332         my ($ds, $drive) = @_;
4333
4334         return if drive_is_cdrom($drive);
4335
4336         my $volid = $drive->{file};
4337         my $device = "drive-$ds";
4338
4339         if (!$drivehash || $drivehash->{$ds}) {
4340             eval { qemu_volume_snapshot_delete($vmid, $device, $storecfg, $volid, $snapname); };
4341             if (my $err = $@) {
4342                 die $err if !$force;
4343                 warn $err;
4344             }
4345         }
4346
4347         # save changes (remove drive fron snapshot)
4348         lock_config($vmid, $updatefn, $ds) if !$force;
4349         push @$unused, $volid;
4350     });
4351
4352     # now cleanup config
4353     $prepare = 0;
4354     lock_config($vmid, $updatefn);
4355 }
4356
4357 1;