PVE/QemuServer.pm

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