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